(define-module (nbde system initrd)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages bash)
  #:use-module (gnu packages base)
  #:use-module (gnu packages curl)
  #:use-module (gnu packages cryptsetup)
  #:use-module (gnu packages jose)
  #:use-module (gnu packages linux)
  #:use-module (gnu system linux-initrd)
  #:use-module (guix gexp)
  #:use-module (guix modules)
  #:use-module (guix records)
  #:use-module (nbde packages crypto)
  #:export (nbde-network-configuration
            nbde-network-configuration?
            nbde-network-configuration-interface
            nbde-network-configuration-timeout
            clevis-initrd-helper-packages
            clevis-initrd-network-pre-mount
            clevis-initrd))

(define-record-type* <nbde-network-configuration>
  nbde-network-configuration make-nbde-network-configuration
  nbde-network-configuration?
  (interface nbde-network-configuration-interface
             (default "eth0"))
  (timeout nbde-network-configuration-timeout
           (default 20)))

(define (clevis-initrd-helper-packages)
  (list bash-minimal
        coreutils
        cryptsetup-static
        curl
        dhcpcd
        e2fsck/static
        grep
        iproute
        jose
        sed
        clevis))

(define (clevis-initrd-network-pre-mount config)
  "Return a pre-mount gexp that performs a minimal DHCP-based network bring-up
for initrds that need Tang."
  #~(let ((ip-bin #$(file-append iproute "/sbin/ip"))
          (dhcpcd-bin #$(file-append dhcpcd "/sbin/dhcpcd"))
          (shell-bin #$(file-append bash-minimal "/bin/sh"))
          (interface #$(nbde-network-configuration-interface config))
          (timeout #$(number->string
                      (nbde-network-configuration-timeout config))))
      (mkdir-p "/run")
      (mkdir-p "/run/dhcpcd")
      (mkdir-p "/var")
      (mkdir-p "/var/db")
      (mkdir-p "/var/db/dhcpcd")
      (mkdir-p "/var/run")
      (mkdir-p "/var/run/dhcpcd")
      (mkdir-p "/etc")
      (unless (file-exists? "/etc/resolv.conf")
        (call-with-output-file "/etc/resolv.conf"
          (lambda (_) #t)))
      (invoke shell-bin "-c"
              (string-append
               "set -eu; "
               "preferred='" interface "'; "
               "candidates=''; "
               "if [ -n \"$preferred\" ] && [ -d \"/sys/class/net/$preferred\" ]; then "
               "  candidates=\"$preferred\"; "
               "fi; "
               "for path in /sys/class/net/*; do "
               "  name=${path##*/}; "
               "  [ \"$name\" = lo ] && continue; "
               "  case \" $candidates \" in "
               "    *\" $name \"*) continue ;; "
               "  esac; "
               "  candidates=\"$candidates $name\"; "
               "done; "
               "for iface in $candidates; do "
               "  echo \"nbde: trying DHCP on $iface\" >/dev/console; "
               "  '" ip-bin "' link set dev \"$iface\" up >/dev/console 2>&1 || continue; "
               "  if '" dhcpcd-bin "' -w -t " timeout " \"$iface\" >/dev/console 2>&1; then "
               "    echo \"nbde: using interface $iface\" >/dev/console; "
               "    '" ip-bin "' -4 addr show dev \"$iface\" >/dev/console 2>&1 || true; "
               "    '" ip-bin "' -4 route show >/dev/console 2>&1 || true; "
               "    exit 0; "
               "  fi; "
               "done; "
               "echo \"nbde: no usable network interface found\" >/dev/console; "
               "exit 1"))))

(define* (clevis-initrd file-systems
                        #:key
                        linux
                        (linux-modules '())
                        (mapped-devices '())
                        keyboard-layout
                        (helper-packages '())
                        network
                        qemu-networking?
                        volatile-root?
                        (on-error 'backtrace))
  "Build an initrd with the helper packages needed for Clevis/Tang based root
unlock.  NETWORK is an optional @code{<nbde-network-configuration>} record used
to request a minimal DHCP pre-mount hook."
  (raw-initrd
   file-systems
   #:linux linux
   #:linux-modules linux-modules
   #:mapped-devices mapped-devices
   #:keyboard-layout keyboard-layout
   #:helper-packages
   (append (clevis-initrd-helper-packages) helper-packages)
   #:pre-mount
   (and network
        (clevis-initrd-network-pre-mount network))
   #:qemu-networking? qemu-networking?
   #:volatile-root? volatile-root?
   #:on-error on-error))