First working version

This commit is contained in:
Martin Puppe 2020-11-24 20:18:16 +01:00
parent a754091989
commit d3e45ee306

179
secrets Normal file → Executable file
View file

@ -3,8 +3,9 @@
(require json) (require json)
(struct file (source-path (struct secret-file (source-path
destination-path name
size
owner owner
group group
mode) mode)
@ -27,23 +28,16 @@
[(group) string?] [(group) string?]
[(mode) string?])]))) [(mode) string?])])))
(define/contract (make-file basedir file-config) (define/contract (make-file file-config)
(-> path-string? (or/c string? raw-file-contract) file?) (-> (or/c string? raw-file-contract) secret-file?)
(let* ([file-config (if (string? file-config) (hash 'source file-config) file-config)] (let* ([file-config (if (string? file-config) (hash 'source file-config) file-config)]
[source-path (string->path (dict-ref file-config 'source))] [source-path (string->path (dict-ref file-config 'source))]
[fs (file-size source-path)]
[name (dict-ref file-config 'name (file-name-from-path source-path))] [name (dict-ref file-config 'name (file-name-from-path source-path))]
[destination-path (build-path basedir name)]
[owner (dict-ref file-config 'owner "root")] [owner (dict-ref file-config 'owner "root")]
[group (dict-ref file-config 'owner "root")] [group (dict-ref file-config 'group "root")]
[mode (dict-ref file-config 'mode "600")]) [mode (dict-ref file-config 'mode "400")])
(file source-path destination-path owner group mode))) (secret-file source-path name fs owner group mode)))
(struct config (host basedir files) #:transparent)
(define (make-config attrs)
(config (dict-ref attrs '#:host)
(dict-ref attrs '#:basedir "/var/lib/secrets")
(dict-ref attrs '#:files '())))
(define (raw-config? obj) (define (raw-config? obj)
@ -112,26 +106,6 @@
(values (cdr seperate-lists))) (values (cdr seperate-lists)))
(keyword-apply proc keywords values args))) (keyword-apply proc keywords values args)))
(define/contract (process-config raw-config)
(-> raw-config-contract config?)
(define (file-entry-to-file entry)
(if (string? entry)
(make-file entry)
(begin
(let* ([source (dict-ref entry 'source)]
[entry (if (dict-mutable? entry) (dict-copy entry) entry)]
[entry (dict-remove entry 'source)])
(simple-keyword-apply make-file entry (list source))))))
(define (process-file-entries entries)
(map file-entry-to-file entries))
(let* ([host (dict-ref raw-config 'host)]
[files (dict-ref raw-config 'files)])
(make-config #:host (dict-ref raw-config 'host)
#:files (process-file-entries (dict-ref raw-config 'files)))))
(define (read-loop input-port) (define (read-loop input-port)
(let ([line (read-line input-port)]) (let ([line (read-line input-port)])
(if (eof-object? line) (if (eof-object? line)
@ -142,33 +116,27 @@
(define receive-script #<<EOF (define receive-script #<<EOF
#!/usr/bin/env bash #!/usr/bin/env bash
set -euxo pipefail set -euo pipefail
rm $0 rm "$0"
echo "!*data" >&2 echo "!*data" >&2
read foo
echo $foo
exit
echo "Hello, this is the receiving script"
read foo
echo $foo
exit 1
read basedir read basedir
echo rm -r "$basedir" if test -d "$basedir"; then
echo mkdir "$basedir" rm -rf "$basedir"
fi
mkdir -p "$basedir"
chown root:root "$basedir" chown root:root "$basedir"
chmod 755 "$basedir" chmod 755 "$basedir"
while read path; do while read name; do
fullpath="$basedir/$path" fullpath="$basedir/$name"
echo "\$fullpath: $fullpath" read size
read filesize head --bytes="$size" - > "$fullpath"
echo "head --bytes=$size - > $fullpath"
read owner read owner
read group read group
read mode read mode
echo "chown $owner:$group $fullpath" chown "$owner":"$group" "$fullpath"
echo "chmod $mode $fullpath" chmod "$mode" "$fullpath"
done done
EOF EOF
) )
@ -182,8 +150,7 @@ EOF
(define transfer-script (define transfer-script
(format #<<EOF (format #<<EOF
set -euxo pipefail set -euo pipefail
uname -a
script=~s script=~s
scriptfile=$(mktemp) scriptfile=$(mktemp)
echo $script | base64 --decode > "$scriptfile" echo $script | base64 --decode > "$scriptfile"
@ -192,97 +159,109 @@ sudo -S bash "$scriptfile"
EOF EOF
(script-as-base64))) (script-as-base64)))
(define/contract (deploy-secrets config) (define/contract (deploy-secrets raw-config)
(-> raw-config-contract void?) (-> raw-config-contract void?)
(define (read-err err phase-channel) (define (handle-stderr stderr phase-channel)
(define p (current-error-port)) (define p (current-error-port))
(let loop ([displayed ""] (let loop ([displayed ""]
[last-char #f] [last-char #f]
[char (read-char err)]) [char (read-char stderr)])
(match (list displayed last-char char) (match (list displayed last-char char)
[(list _ (? char? _) (? eof-object? _)) [(list _ (? char? _) (? eof-object? _))
(display last-char p) (display last-char p)
(close-input-port err)] (close-input-port stderr)]
[(list _ _ (? eof-object? _)) (close-input-port err)] [(list _ _ (? eof-object? _)) (close-input-port stderr)]
[(list "" #\! #\*) [(list "" #\! #\*)
(match (read-line err) (match (read-line stderr)
["data" (channel-put phase-channel 'data) ["data" (channel-put phase-channel 'data)
(copy-port err (current-error-port)) (copy-port stderr (current-error-port))
(close-input-port err)] (close-input-port stderr)]
[(? eof-object? _) (display last-char p) [(? eof-object? _) (display last-char p)
(display char p) (display char p)
(close-input-port err)] (close-input-port stderr)]
[line (display last-char p) [line (display last-char p)
(display char p) (display char p)
(displayln line p) (displayln line p)
(loop "" #f (read-char err))])] (loop "" #f (read-char stderr))])]
[(list (pregexp #px"^\\[sudo\\] password for \\S*") #\: #\space) [(list (pregexp #px"^\\[sudo\\] password for \\S*") #\: #\space)
(display last-char p) (display last-char p)
(display char p) (display char p)
(channel-put phase-channel 'password) (channel-put phase-channel 'password)
(loop "" #f (read-char err))] (loop "" #f (read-char stderr))]
[(list _ #f _) (loop "" char (read-char err))] [(list _ #f _) (loop "" char (read-char stderr))]
[(list _ #\newline _) (display last-char p) [(list _ #\newline _) (display last-char p)
(loop "" char (read-char err))] (loop "" char (read-char stderr))]
[(list _ _ _) (display last-char p) [(list _ _ _) (display last-char p)
(loop (string-append displayed (string last-char)) (loop (string-append displayed (string last-char))
char (read-char err))]))) char (read-char stderr))])))
(define (read-password) (define (read-password)
(define script #<<EOF (system "stty -echo")
read -s password (let ([line (read-line)])
echo "$password" (system "stty echo")
EOF line))
)
(define password-with-newline (define (handle-stdin stdin phase-channel basedir files)
(with-output-to-string
(lambda ()
(system (format "bash -c '~a'" script)))))
;; clean trailing newline (define (send-data)
(string-replace password-with-newline #rx"\n$" "")) (displayln basedir stdin)
(let send-files ([files files])
(match files
[(list-rest (and (struct secret-file _) f) rest)
(printf "Transfer ~a …\n" (secret-file-name f))
(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))
(displayln (secret-file-owner f) stdin)
(displayln (secret-file-group f) stdin)
(displayln (secret-file-mode f) stdin)
(send-files rest)]
[(list) (void)])))
(define (foo in phase-channel) (let loop ()
(match (channel-get phase-channel) (match (channel-get phase-channel)
['password (displayln (read-password) in) ['password (displayln (read-password) stdin)
(displayln "" (current-error-port)) (displayln "" (current-error-port))
(flush-output in) (flush-output stdin)
(foo in phase-channel)] (loop)]
['data (begin ['data (begin
(displayln "PAYLOAD" in) (send-data)
(close-output-port in))])) (close-output-port stdin))])))
(let* ([basedir (dict-ref config 'basedir "/var/lib/secrets")] (let* ([basedir (dict-ref raw-config 'basedir "/var/lib/secrets")]
[files (map (curry make-file basedir) (dict-ref config 'files))] [files (map make-file (dict-ref raw-config 'files))]
[host (dict-ref config 'host)]) [host (dict-ref raw-config 'host)])
(printf "basedir: ~s\n" basedir) (let-values ([(sp _ stdin stderr) (subprocess
(printf "files: ~s\n" files)
(let-values ([(sp _ in err) (subprocess
(current-output-port) #f #f (current-output-port) #f #f
(find-executable-path "ssh") (find-executable-path "ssh")
"giles.mpuppe.de" host
(format (format
"bash -c '~a'" "bash -c '~a'"
(string-replace transfer-script "'" "\'")))]) (string-replace transfer-script
"'" "\'")))])
(let* ([phase-channel (make-channel)] (let* ([phase-channel (make-channel)]
[err-thread (thread (lambda () (read-err err phase-channel)))] [stderr-thread (thread
[foo-thread (thread (lambda () (foo in phase-channel)))]) (lambda ()
(handle-stderr stderr phase-channel)))]
[stdin-thread (thread
(lambda ()
(handle-stdin stdin phase-channel basedir files)))])
(thread-wait err-thread) (thread-wait stderr-thread)
(thread-wait foo-thread)))) (thread-wait stdin-thread))))
(void)) (void))
(let* ([config (call-with-input-file "config.json" read-json)]) (let* ([config (call-with-input-file "config.json" read-json)])
(printf "config: ~s\n" config) (deploy-secrets config)
(deploy-secrets config)) (displayln "Done."))