;;; GNU Guix --- Functional package management for GNU
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu bootloader uki)
  #:use-module (gnu bootloader)
  #:use-module (gnu packages bootloaders)
  #:use-module (gnu packages efi)
  #:use-module (gnu packages linux)
  #:use-module (guix gexp)
  #:use-module (guix modules))

;; config generator makes script creating uki images
;; install runs script
;; install device is path to uefi dir

(define* (uefi-uki-configuration-file #:optional cert privkey)
  (lambda* (config entries #:key (old-entires '()) #:allow-other-keys)

    (define (menu-entry->uki e)
      (define stub (file-append systemd-stub "/libexec/" (systemd-stub-name)))
      (computed-file "uki.efi"
        (with-imported-modules (source-module-closure '((guix build utils)))
          #~(let ((args (list #$@(menu-entry-linux-arguments e))))
              (use-modules (guix build utils))
              (invoke #$(file-append ukify "/bin/ukify") "build"
                "--linux" #$(menu-entry-linux e)
                "--initrd" #$(menu-entry-initrd e)
                "--os-release" #$(menu-entry-label e)
                "--cmdline" (string-join args)
                "--stub" #$stub
                "-o" #$output)))))

    (program-file "install-uki"
      (with-imported-modules (source-module-closure '((guix build utils)))
        #~(let* ((target (cadr (command-line)))
                 (vendir (string-append target "/EFI/Guix"))
                 (schema (string-append vendir "/boot.mgr"))
                 (findmnt #$(file-append util-linux "/bin/findmnt"))
                 (efibootmgr #$(file-append efibootmgr "/sbin/efibootmgr")))
            (use-modules (guix build utils) (ice-9 popen) (ice-9 textual-ports))

            (define disk
              (call-with-port
                (open-pipe* OPEN_READ findmnt "-fnro" "SOURCE" "-T" target)
                (lambda (port) (get-line port)))) ; only 1 line: the device

            (when (file-exists? schema)
              (call-with-input-file schema
                (lambda (port)
                  (for-each (lambda (l)
                              (unless (string-null? l)
                                (system* efibootmgr "-B" "-L" l)))
                    (string-split (get-string-all port) #\lf)))))
            (when (directory-exists? vendir) (delete-file-recursively vendir))

            (mkdir-p vendir)
            (call-with-output-file schema
              (lambda (port)
                (for-each (lambda (uki label)
                            (let* ((base (basename uki))
                                   (out (string-append vendir "/" base)))
                              #$(if cert ; sign here so we can access root certs
                                  #~(invoke
                                      #$(file-append sbsigntools "/bin/sbsign")
                                      "--cert" #$cert "--key" #$privkey
                                      "--output" out uki)
                                  #~(copy-file uki out))
                              (invoke efibootmgr "-c" "-L" label "-d" disk "-l"
                                (string-append "\\EFI\\Guix\\" base))
                              (put-string port label)
                              (put-char port #\lf)))
                  (list #$@(map-in-order menu-entry->uki entries))
                  (list #$@(map-in-order menu-entry-label entries))))))))))

(define install-uefi-uki
  #~(lambda (bootloader target mount-point)
      (invoke (string-append mount-point "/boot/install-uki.scm")
              (string-append mount-point target))))

(define* (make-uefi-uki-bootloader #:optional cert privkey)
  (bootloader
    (name 'uefi-uki)
    (package systemd-stub)
    (installer install-uefi-uki)
    (disk-image-installer #f)
    (configuration-file "/boot/install-uki.scm")
    (configuration-file-generator (uefi-uki-configuration-file cert privkey))))

(define-public uefi-uki-bootloader (make-uefi-uki-bootloader))
;; use ukify genkey to generate cert and privkey. DO NOT include in store.
(define-public (uefi-uki-signed-bootloader cert privkey)
  (make-uefi-uki-bootloader cert privkey))