First working version

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

205
secrets Normal file → Executable file
View file

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