mpuppe/secrets
1
0
Fork 0
mirror of https://codeberg.org/puppe/secrets.git synced 2025-12-20 00:42:17 +01:00
Code Issues Projects Releases Packages Wiki Activity

Change to Typed Racket

Browse source
This commit is contained in:
Martin Puppe 2020-12-02 16:01:38 +01:00
parent 88b66fe6bc
commit 30c05af694
1 changed files with 72 additions and 80 deletions
Download patch file Download diff file Expand all files Collapse all files

150
secrets
View file

@ -1,68 +1,47 @@
#! /usr/bin/env racket #! /usr/bin/env racket
#lang racket #lang typed/racket
(require json) (require typed/json)
(struct secret-file (source-path (struct secret-file ([source-path : Path]
name [name : String]
size [size : Nonnegative-Integer]
owner [owner : String]
group [group : String]
mode) [mode : String])
#:transparent) #:transparent)
(define file-contract (define-type Config
(and/c (HashTable Symbol (U Config-Host Config-Basedir Config-FileList)))
(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/contract (make-file file-config source-basedir) (define-type Config-Host String)
(-> (or/c string? file-contract) path-string? secret-file?) (define-type Config-Basedir String)
(let* ([file-config (if (string? file-config) (define-type Config-FileList (Listof Config-File))
(hash 'source file-config) (define-type Config-File (U String (HashTable Symbol String)))
file-config)]
(: 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 [source-path (simplify-path
(path->complete-path (dict-ref file-config 'source) (path->complete-path (hash-ref file-hash 'source)
source-basedir))] source-basedir))]
[fs (file-size source-path)] [fs (file-size source-path)]
[name (dict-ref file-config 'name (file-name-from-path source-path))] [name (or (hash-ref file-hash 'name #f)
[owner (dict-ref file-config 'owner "root")] (path->string
[group (dict-ref file-config 'group "root")] (assert (file-name-from-path source-path))))]
[mode (dict-ref file-config 'mode "400")]) [owner (or (hash-ref file-hash 'owner #f) "root")]
(secret-file source-path name fs owner group mode))) [group (or (hash-ref file-hash 'group #f) "root")]
[mode (or (hash-ref file-hash 'mode #f) "400")])
(define/contract (dict-has-keys? d keys) (secret-file source-path
(-> dict? (or/c generic-set?) boolean?) name
fs
(stream-empty? (stream-filter owner
(negate (curry dict-has-key? d)) group
(set->stream keys)))) mode)))
(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])])))
(define receive-script #<<EOF (define receive-script #<<EOF
#!/usr/bin/env bash #!/usr/bin/env bash
@ -91,6 +70,7 @@ done
EOF EOF
) )
(: string->base64 (-> String String))
(define (string->base64 str) (define (string->base64 str)
(with-input-from-string str (with-input-from-string str
(lambda () (lambda ()
@ -109,23 +89,16 @@ sudo -S bash "$scriptfile"
EOF EOF
(string->base64 receive-script))) (string->base64 receive-script)))
(define (read-loop input-port) (: deploy-secrets (-> Config Path Void))
(let ([line (read-line input-port)]) (define (deploy-secrets config
(if (eof-object? line) [source-basedir (current-directory)])
(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?)
(: handle-stderr (-> Input-Port (Channelof Symbol) Void))
(define (handle-stderr stderr 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 : (U Char False) #f]
[char (read-char stderr)]) [char (read-char stderr)])
(match (list displayed last-char char) (match (list displayed last-char char)
[(list _ (? char? _) (? eof-object? _)) [(list _ (? char? _) (? eof-object? _))
@ -154,12 +127,16 @@ EOF
(channel-put phase-channel 'password) (channel-put phase-channel 'password)
(loop "" #f (read-char stderr))] (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) [(list _ #\newline _) (display last-char p)
(assert char char?)
(loop "" char (read-char stderr))] (loop "" char (read-char stderr))]
[(list _ _ _) (display last-char p) [(list _ _ _) (display last-char p)
(assert last-char char?)
(assert char char?)
(loop (string-append displayed (string last-char)) (loop (string-append displayed (string last-char))
char (read-char stderr))]))) char (read-char stderr))])))
@ -169,8 +146,14 @@ EOF
(system "stty echo") (system "stty echo")
line)) line))
(: handle-stdin (-> Output-Port
(Channelof Symbol)
Path-String
(Listof secret-file)
Void))
(define (handle-stdin stdin phase-channel basedir files) (define (handle-stdin stdin phase-channel basedir files)
(: send-data (-> Void))
(define (send-data) (define (send-data)
(displayln basedir stdin) (displayln basedir stdin)
(let send-files ([files files]) (let send-files ([files files])
@ -180,7 +163,8 @@ EOF
(displayln (secret-file-name f) stdin) (displayln (secret-file-name f) stdin)
(displayln (secret-file-size f) stdin) (displayln (secret-file-size f) stdin)
(call-with-input-file (secret-file-source-path f) (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-owner f) stdin)
(displayln (secret-file-group f) stdin) (displayln (secret-file-group f) stdin)
(displayln (secret-file-mode f) stdin) (displayln (secret-file-mode f) stdin)
@ -197,20 +181,26 @@ EOF
(send-data) (send-data)
(close-output-port stdin))]))) (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 [files (map
(curryr make-file source-basedir) (lambda
(dict-ref config 'files))] ([f : Config-File])
[host (dict-ref config 'host)]) (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 (let-values ([(sp _ stdin stderr) (subprocess
(current-output-port) #f #f (current-output-port) #f #f
(find-executable-path "ssh") (assert
(find-executable-path "ssh") path?)
host host
(format (format
"bash -c '~a'" "bash -c '~a'"
(string-replace bootstrap-script (string-replace bootstrap-script
"'" "\'")))]) "'" "\'")))])
(let* ([phase-channel (make-channel)] (let* ([phase-channel : (Channelof Symbol) (make-channel)]
[stderr-thread (thread [stderr-thread (thread
(lambda () (lambda ()
(handle-stderr stderr phase-channel)))] (handle-stderr stderr phase-channel)))]
@ -223,11 +213,13 @@ EOF
(void)) (void))
(define cfg-file (make-parameter #f)) (: cfg-file (Parameterof String))
(define cfg-file (make-parameter ""))
(command-line (command-line
#:args ([config-file "secrets.json"]) #: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)]) (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.")) (displayln "Done."))