diff --git a/secrets b/secrets index 41f6850..1cc3e74 100755 --- a/secrets +++ b/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 #<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))]))) @@ -168,9 +145,15 @@ EOF (let ([line (read-line)]) (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."))