Stage boot store items on activation

nbde/system/boot-store.scm

@@ -0,0 +1,51 @@
+(define-module (nbde system boot-store)
+  #:use-module (gnu services)
+  #:use-module (guix gexp)
+  #:export (boot-store-staging-service))
+
+(define (boot-store-staging-gexp)
+  (with-imported-modules '((guix build utils)
+                           (ice-9 regex)
+                           (ice-9 rdelim)
+                           (srfi srfi-1))
+    #~(begin
+        (use-modules (guix build utils)
+                     (ice-9 regex)
+                     (ice-9 rdelim)
+                     (srfi srfi-1))
+
+        (define grub-cfg "/boot/grub/grub.cfg")
+        (define boot-mount "/boot")
+        (define store-ref-rx (make-regexp "/gnu/store/[^\" )]*"))
+
+        (define (store-refs file)
+          (call-with-input-file file
+            (lambda (port)
+              (let loop ((line (read-line port 'concat))
+                         (refs '()))
+                (if (eof-object? line)
+                    (delete-duplicates (reverse refs))
+                    (let ((match (regexp-exec store-ref-rx line)))
+                      (loop (read-line port 'concat)
+                            (if match
+                                (cons (match:substring match 0) refs)
+                                refs))))))))
+
+        (define (stage-ref ref)
+          (let ((target (string-append boot-mount ref)))
+            (mkdir-p (dirname target))
+            (if (file-is-directory? ref)
+                (begin
+                  (mkdir-p target)
+                  (copy-recursively ref target))
+                (copy-file ref target))))
+
+        (when (and (file-exists? "/boot")
+                   (file-exists? grub-cfg))
+          (for-each stage-ref
+                    (filter file-exists? (store-refs grub-cfg)))))))
+
+(define (boot-store-staging-service)
+  (simple-service 'stage-grub-visible-store-items
+                  activation-service-type
+                  (boot-store-staging-gexp)))