mirror of
https://codeberg.org/puppe/secrets.git
synced 2025-12-20 00:42:17 +01:00
Change to Typed Racket
This commit is contained in:
parent
88b66fe6bc
commit
30c05af694
1 changed files with 72 additions and 80 deletions
150
secrets
150
secrets
|
|
@ -1,68 +1,47 @@
|
|||
#! /usr/bin/env racket
|
||||
#lang racket
|
||||
#lang typed/racket
|
||||
|
||||
(require json)
|
||||
(require typed/json)
|
||||
|
||||
(struct secret-file (source-path
|
||||
name
|
||||
size
|
||||
owner
|
||||
group
|
||||
mode)
|
||||
(struct secret-file ([source-path : Path]
|
||||
[name : String]
|
||||
[size : Nonnegative-Integer]
|
||||
[owner : String]
|
||||
[group : String]
|
||||
[mode : String])
|
||||
#:transparent)
|
||||
|
||||
(define file-contract
|
||||
(and/c
|
||||
(curryr dict-has-key? 'source)
|
||||
(hash/dc
|
||||
[k1 (or/c 'source
|
||||
'name
|
||||
'owner
|
||||
'group
|
||||
'mode)]
|
||||
[v1 (k1)
|
||||
(case k1
|
||||
[(source) path-string?]
|
||||
[(name) path-string?]
|
||||
[(owner) string?]
|
||||
[(group) string?]
|
||||
[(mode) string?])])))
|
||||
(define-type Config
|
||||
(HashTable Symbol (U Config-Host Config-Basedir Config-FileList)))
|
||||
|
||||
(define/contract (make-file file-config source-basedir)
|
||||
(-> (or/c string? file-contract) path-string? secret-file?)
|
||||
(let* ([file-config (if (string? file-config)
|
||||
(hash 'source file-config)
|
||||
file-config)]
|
||||
(define-type Config-Host String)
|
||||
(define-type Config-Basedir String)
|
||||
(define-type Config-FileList (Listof Config-File))
|
||||
(define-type Config-File (U String (HashTable Symbol String)))
|
||||
|
||||
(: make-file (-> Config-File Path secret-file))
|
||||
(define (make-file file-hash-or-string source-basedir)
|
||||
(let* ([file-hash : (HashTable Symbol String) (if(string?
|
||||
file-hash-or-string)
|
||||
(hash 'source
|
||||
file-hash-or-string)
|
||||
file-hash-or-string)]
|
||||
[source-path (simplify-path
|
||||
(path->complete-path (dict-ref file-config 'source)
|
||||
(path->complete-path (hash-ref file-hash 'source)
|
||||
source-basedir))]
|
||||
[fs (file-size source-path)]
|
||||
[name (dict-ref file-config 'name (file-name-from-path source-path))]
|
||||
[owner (dict-ref file-config 'owner "root")]
|
||||
[group (dict-ref file-config 'group "root")]
|
||||
[mode (dict-ref file-config 'mode "400")])
|
||||
(secret-file source-path name fs owner group mode)))
|
||||
|
||||
(define/contract (dict-has-keys? d keys)
|
||||
(-> dict? (or/c generic-set?) boolean?)
|
||||
|
||||
(stream-empty? (stream-filter
|
||||
(negate (curry dict-has-key? d))
|
||||
(set->stream keys))))
|
||||
|
||||
(define file-list-contract
|
||||
(listof
|
||||
(or/c
|
||||
path-string?
|
||||
file-contract)))
|
||||
|
||||
(define config-contract
|
||||
(and/c (curryr dict-has-keys? '(host files))
|
||||
(hash/dc [k (or/c 'host 'files 'basedir)]
|
||||
[v (k) (case k
|
||||
[(host) string?]
|
||||
[(basedir) string?]
|
||||
[(files) file-list-contract])])))
|
||||
[name (or (hash-ref file-hash 'name #f)
|
||||
(path->string
|
||||
(assert (file-name-from-path source-path))))]
|
||||
[owner (or (hash-ref file-hash 'owner #f) "root")]
|
||||
[group (or (hash-ref file-hash 'group #f) "root")]
|
||||
[mode (or (hash-ref file-hash 'mode #f) "400")])
|
||||
(secret-file source-path
|
||||
name
|
||||
fs
|
||||
owner
|
||||
group
|
||||
mode)))
|
||||
|
||||
(define receive-script #<<EOF
|
||||
#!/usr/bin/env bash
|
||||
|
|
@ -91,6 +70,7 @@ done
|
|||
EOF
|
||||
)
|
||||
|
||||
(: string->base64 (-> String String))
|
||||
(define (string->base64 str)
|
||||
(with-input-from-string str
|
||||
(lambda ()
|
||||
|
|
@ -109,23 +89,16 @@ sudo -S bash "$scriptfile"
|
|||
EOF
|
||||
(string->base64 receive-script)))
|
||||
|
||||
(define (read-loop input-port)
|
||||
(let ([line (read-line input-port)])
|
||||
(if (eof-object? line)
|
||||
(close-input-port input-port)
|
||||
(begin
|
||||
(printf "~a\n" line)
|
||||
(read-loop input-port)))))
|
||||
|
||||
(define/contract (deploy-secrets config
|
||||
[source-basedir (current-directory)])
|
||||
(->* (config-contract) (path-string?) void?)
|
||||
(: deploy-secrets (-> Config Path Void))
|
||||
(define (deploy-secrets config
|
||||
[source-basedir (current-directory)])
|
||||
|
||||
(: handle-stderr (-> Input-Port (Channelof Symbol) Void))
|
||||
(define (handle-stderr stderr phase-channel)
|
||||
(define p (current-error-port))
|
||||
|
||||
(let loop ([displayed ""]
|
||||
[last-char #f]
|
||||
[last-char : (U Char False) #f]
|
||||
[char (read-char stderr)])
|
||||
(match (list displayed last-char char)
|
||||
[(list _ (? char? _) (? eof-object? _))
|
||||
|
|
@ -154,12 +127,16 @@ EOF
|
|||
(channel-put phase-channel 'password)
|
||||
(loop "" #f (read-char stderr))]
|
||||
|
||||
[(list _ #f _) (loop "" char (read-char stderr))]
|
||||
[(list _ #f _) (assert char char?)
|
||||
(loop "" char (read-char stderr))]
|
||||
|
||||
[(list _ #\newline _) (display last-char p)
|
||||
(assert char char?)
|
||||
(loop "" char (read-char stderr))]
|
||||
|
||||
[(list _ _ _) (display last-char p)
|
||||
(assert last-char char?)
|
||||
(assert char char?)
|
||||
(loop (string-append displayed (string last-char))
|
||||
char (read-char stderr))])))
|
||||
|
||||
|
|
@ -169,8 +146,14 @@ EOF
|
|||
(system "stty echo")
|
||||
line))
|
||||
|
||||
(: handle-stdin (-> Output-Port
|
||||
(Channelof Symbol)
|
||||
Path-String
|
||||
(Listof secret-file)
|
||||
Void))
|
||||
(define (handle-stdin stdin phase-channel basedir files)
|
||||
|
||||
(: send-data (-> Void))
|
||||
(define (send-data)
|
||||
(displayln basedir stdin)
|
||||
(let send-files ([files files])
|
||||
|
|
@ -180,7 +163,8 @@ EOF
|
|||
(displayln (secret-file-name f) stdin)
|
||||
(displayln (secret-file-size f) stdin)
|
||||
(call-with-input-file (secret-file-source-path f)
|
||||
(curryr copy-port stdin))
|
||||
(lambda ([file-port : Input-Port])
|
||||
(copy-port file-port stdin)))
|
||||
(displayln (secret-file-owner f) stdin)
|
||||
(displayln (secret-file-group f) stdin)
|
||||
(displayln (secret-file-mode f) stdin)
|
||||
|
|
@ -197,20 +181,26 @@ EOF
|
|||
(send-data)
|
||||
(close-output-port stdin))])))
|
||||
|
||||
(let* ([basedir (dict-ref config 'basedir "/var/lib/secrets")]
|
||||
(let* ([basedir (assert (or
|
||||
(hash-ref config 'basedir #f) "/var/lib/secrets")
|
||||
string?)]
|
||||
[files (map
|
||||
(curryr make-file source-basedir)
|
||||
(dict-ref config 'files))]
|
||||
[host (dict-ref config 'host)])
|
||||
(lambda
|
||||
([f : Config-File])
|
||||
(make-file f source-basedir))
|
||||
(cast (hash-ref config 'files)
|
||||
(Listof Config-File)))]
|
||||
[host (assert (hash-ref config 'host) string?)])
|
||||
(let-values ([(sp _ stdin stderr) (subprocess
|
||||
(current-output-port) #f #f
|
||||
(find-executable-path "ssh")
|
||||
(assert
|
||||
(find-executable-path "ssh") path?)
|
||||
host
|
||||
(format
|
||||
"bash -c '~a'"
|
||||
(string-replace bootstrap-script
|
||||
"'" "\'")))])
|
||||
(let* ([phase-channel (make-channel)]
|
||||
(let* ([phase-channel : (Channelof Symbol) (make-channel)]
|
||||
[stderr-thread (thread
|
||||
(lambda ()
|
||||
(handle-stderr stderr phase-channel)))]
|
||||
|
|
@ -223,11 +213,13 @@ EOF
|
|||
|
||||
(void))
|
||||
|
||||
(define cfg-file (make-parameter #f))
|
||||
(: cfg-file (Parameterof String))
|
||||
(define cfg-file (make-parameter ""))
|
||||
(command-line
|
||||
#:args ([config-file "secrets.json"])
|
||||
(cfg-file config-file))
|
||||
(cfg-file (assert config-file string?)))
|
||||
|
||||
(let* ([config (call-with-input-file (cfg-file) read-json)])
|
||||
(deploy-secrets config (path->complete-path (path-only (cfg-file))))
|
||||
(deploy-secrets (cast config Config)
|
||||
(path->complete-path (assert (path-only (cfg-file)) path?)))
|
||||
(displayln "Done."))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue