From d3e45ee3068ec091ea27d82dd61d270797858606 Mon Sep 17 00:00:00 2001
From: Martin Puppe <dev@mpuppe.de>
Date: Tue, 24 Nov 2020 20:18:16 +0100
Subject: [PATCH] First working version

---
 secrets | 205 +++++++++++++++++++++++++-------------------------------
 1 file changed, 92 insertions(+), 113 deletions(-)
 mode change 100644 => 100755 secrets

diff --git a/secrets b/secrets
old mode 100644
new mode 100755
index 3459571..3d83906
--- a/secrets
+++ b/secrets
@@ -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))
\ No newline at end of file
+  (deploy-secrets config)
+  (displayln "Done."))
\ No newline at end of file