From fad70955ebae0edb3e7e185c48f0095d09d51c0b Mon Sep 17 00:00:00 2001
From: Martin Puppe <dev@mpuppe.de>
Date: Tue, 24 Nov 2020 20:38:09 +0100
Subject: [PATCH] Reorganize and clean up

---
 secrets | 96 +++++++++++++++------------------------------------------
 1 file changed, 25 insertions(+), 71 deletions(-)

diff --git a/secrets b/secrets
index 3d83906..c9f8ee0 100755
--- a/secrets
+++ b/secrets
@@ -11,7 +11,7 @@
                      mode)
   #:transparent)
 
-(define raw-file-contract
+(define file-contract
   (and/c
      (curryr dict-has-key? 'source)
      (hash/dc
@@ -29,7 +29,7 @@
             [(mode) string?])])))
 
 (define/contract (make-file file-config)
-  (-> (or/c string? raw-file-contract) secret-file?)
+  (-> (or/c string? 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)]
@@ -39,18 +39,6 @@
          [mode (dict-ref file-config 'mode "400")])
     (secret-file source-path name fs owner group mode)))
 
-(define (raw-config? obj)
-
-  (define required-keys (seteq 'host 'files))
-  (define optional-keys (seteq 'basedir))
-  (define permitted-keys
-    (set-union required-keys optional-keys))
-  
-  (and (hash? obj)
-       (hash-has-key? obj 'host)
-       (hash-has-key? obj 'files)
-       (empty? (filter (lambda (k) (not (set-member? permitted-keys k))) (hash-keys obj)))))
-
 (define/contract (dict-has-keys? d keys)
   (-> dict? (or/c generic-set?) boolean?)
 
@@ -58,61 +46,19 @@
                   (negate (curry dict-has-key? d))
                   (set->stream keys))))
 
-(define raw-file-list-contract
+(define file-list-contract
   (listof
    (or/c
     path-string?
-    raw-file-contract)))
+    file-contract)))
 
-(define raw-config-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) raw-file-list-contract])])))
-
-(define/contract (simple-keyword-apply proc kwargs args)
-  (-> procedure? (hash/c (or/c symbol? string? keyword?) any/c) (listof any/c) any/c)
-
-  (define (ensure-keyword x)
-    (if (keyword? x)
-        x
-        (if (symbol? x)
-            (string->keyword (symbol->string x))
-            (string->keyword x))))
-
-  (define (convert-key-to-keyword pair)
-    (let ((key (ensure-keyword (car pair)))
-          (value (cdr pair)))
-      (cons key value)))
-
-  (define (split-pair pair lists)
-    ""
-    (let* ([keys (car lists)]
-           [values (cdr lists)]
-          (new-keys (cons (car pair) keys))
-          (new-values (cons (cdr pair) values)))
-      (cons new-keys new-values)))
-
-  (let* ((sorted-list (sort
-                       (sequence->list
-                        (sequence-map convert-key-to-keyword
-                                      (in-dict-pairs kwargs)))
-                       keyword<?
-                       #:key car))
-         (seperate-lists (foldr split-pair '(() . ()) sorted-list))
-         (keywords (car seperate-lists))
-         (values (cdr seperate-lists)))
-    (keyword-apply proc keywords values args)))
-
-(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)))))
+                           [(files) file-list-contract])])))
 
 (define receive-script #<<EOF
 #!/usr/bin/env bash
@@ -141,14 +87,14 @@ done
 EOF
   )
 
-(define (script-as-base64)
-  (with-input-from-string receive-script
+(define (string->base64 str)
+  (with-input-from-string str
     (lambda ()
       (with-output-to-string
         (lambda ()
           (system "base64 -w 0"))))))
 
-(define transfer-script
+(define bootstrap-script
   (format #<<EOF
 set -euo pipefail
 script=~s
@@ -157,10 +103,18 @@ echo $script | base64 --decode > "$scriptfile"
 exec env LC_ALL=C \
 sudo -S bash "$scriptfile"
 EOF
-          (script-as-base64)))
+          (string->base64 receive-script)))
 
-(define/contract (deploy-secrets raw-config)
-  (-> raw-config-contract void?)
+(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)
+  (-> config-contract void?)
 
   (define (handle-stderr stderr phase-channel)
     (define p (current-error-port))
@@ -238,16 +192,16 @@ EOF
                  (send-data)
                  (close-output-port stdin))])))
   
-  (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* ([basedir (dict-ref config 'basedir "/var/lib/secrets")]
+         [files (map make-file (dict-ref config 'files))]
+         [host (dict-ref 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
+                                        (string-replace bootstrap-script
                                                         "'" "\'")))])
       (let* ([phase-channel (make-channel)]
              [stderr-thread (thread
@@ -264,4 +218,4 @@ EOF
 
 (let* ([config (call-with-input-file "config.json" read-json)])
   (deploy-secrets config)
-  (displayln "Done."))
\ No newline at end of file
+  (displayln "Done."))