mirror of
https://codeberg.org/puppe/secrets.git
synced 2025-12-20 00:42:17 +01:00
Reorganize and clean up
This commit is contained in:
parent
d3e45ee306
commit
fad70955eb
1 changed files with 25 additions and 71 deletions
94
secrets
94
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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue