You've already forked guix-tribes
105 lines
4.9 KiB
Scheme
105 lines
4.9 KiB
Scheme
(define-module (nbde system mapped-devices)
|
|
#:use-module (guix gexp)
|
|
#:use-module (guix modules)
|
|
#:use-module (gnu packages bash)
|
|
#:use-module (gnu system mapped-devices)
|
|
#:use-module (gnu system uuid)
|
|
#:autoload (gnu packages cryptsetup) (cryptsetup-static)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (nbde packages crypto)
|
|
#:export (clevis-luks-device-mapping))
|
|
|
|
(define* (open-clevis-luks-device source targets
|
|
#:key
|
|
(clevis-package clevis)
|
|
key-file
|
|
allow-discards?
|
|
(extra-options '()))
|
|
"Return a gexp that first tries to unlock SOURCE using Clevis and falls back
|
|
to interactive cryptsetup when that fails. The fallback path intentionally
|
|
keeps a manual recovery slot available."
|
|
(with-imported-modules (source-module-closure
|
|
'((gnu build file-systems)
|
|
(guix build utils)))
|
|
(match targets
|
|
((target)
|
|
#~(let ((source #$(if (uuid? source)
|
|
(uuid-bytevector source)
|
|
source))
|
|
(keyfile #$key-file))
|
|
(mkdir-p "/run/cryptsetup/")
|
|
|
|
(let* ((partition
|
|
(if (bytevector? source)
|
|
(or (let loop ((tries-left 60))
|
|
(and (positive? tries-left)
|
|
(or (find-partition-by-luks-uuid source)
|
|
(begin
|
|
(format #t "nbde: waiting for LUKS partition (~a tries left)~%"
|
|
tries-left)
|
|
(force-output)
|
|
(sleep 1)
|
|
(loop (- tries-left 1))))))
|
|
(error "LUKS partition not found" source))
|
|
(or (let loop ((tries-left 60))
|
|
(and (positive? tries-left)
|
|
(or (and (file-exists? source) source)
|
|
(begin
|
|
(sleep 1)
|
|
(loop (- tries-left 1))))))
|
|
(error "LUKS partition not found" source))))
|
|
(shell-bin #$(file-append bash-minimal "/bin/sh"))
|
|
(clevis-bin #$(file-append clevis-package "/bin/clevis"))
|
|
(cryptsetup-bin #$(file-append cryptsetup-static
|
|
"/sbin/cryptsetup"))
|
|
(cryptsetup-flags
|
|
(append
|
|
(list "open" "--type" "luks")
|
|
(if #$allow-discards?
|
|
'("--allow-discards")
|
|
'())
|
|
'#$extra-options
|
|
(list partition #$target))))
|
|
(or (zero? (system* shell-bin "-c"
|
|
(string-append
|
|
"attempt=0; "
|
|
"while :; do "
|
|
"attempt=$((attempt + 1)); "
|
|
"echo \"nbde: clevis unlock attempt ${attempt} "
|
|
partition " -> " #$target "\" >/dev/console; "
|
|
"'" clevis-bin "' luks list -d '" partition
|
|
"' >/dev/console 2>&1 || true; "
|
|
"if '" clevis-bin "' luks unlock"
|
|
" -d '" partition "'"
|
|
" -n '" #$target "'"
|
|
" >/dev/console 2>&1; then "
|
|
"exit 0; "
|
|
"fi; "
|
|
"if [ \"$attempt\" -ge 5 ]; then "
|
|
"exit 1; "
|
|
"fi; "
|
|
"sleep 2; "
|
|
"done")))
|
|
(and keyfile
|
|
(zero? (apply system*/tty cryptsetup-bin
|
|
"--key-file" keyfile
|
|
cryptsetup-flags)))
|
|
(zero? (apply system*/tty cryptsetup-bin
|
|
cryptsetup-flags)))))))))
|
|
|
|
(define* (close-clevis-luks-device source targets #:rest _)
|
|
(match targets
|
|
((target)
|
|
#~(zero? (system* #$(file-append cryptsetup-static "/sbin/cryptsetup")
|
|
"close" #$target)))))
|
|
|
|
(define clevis-luks-device-mapping
|
|
(mapped-device-kind
|
|
(open open-clevis-luks-device)
|
|
(close close-clevis-luks-device)
|
|
(modules '((rnrs bytevectors)
|
|
((gnu build file-systems)
|
|
#:select (find-partition-by-luks-uuid system*/tty))
|
|
((guix build utils)
|
|
#:select (mkdir-p))))))
|