Merge branch 'install-config-channels' into 'master'

Add prefilled channels.scm to install image.

See merge request nonguix/nonguix!100

nongnu/system/build-image.scm

@@ -0,0 +1,98 @@
+
+#!/usr/bin/env -S guile \\
+-e build-image -s
+!#
+; Guile uses a meta switch '\' which env requires escaping to passthru.
+; See: https://pingus.seul.org/~grumbel/tmp/guile-1.6.0/guile_10.html#SEC27
+
+;;; Copyright © 2021 Kyle Cassidy <123_kbc@pm.me>
+;;;
+;;; This program 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.
+;;;
+;;; This program 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 this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;; Generate a bootable image with:
+;; $ chmod +x build-image.scm && ./build-image.scm
+
+(use-modules (ice-9 pretty-print))
+
+; Searches through Scheme file for 'define and 'define* expressions
+; such as (define <name> ... ) or (define (<name> ...) ...)
+(define (search-for-define scheme-file define-name)
+  (call-with-input-file scheme-file
+    (lambda (port)
+      (let next ((exp (read port)))
+        (cond ((eof-object? exp) #f)
+              ((and (list? exp)
+                 (or (equal? 'define (car exp))
+                     (equal? 'define* (car exp)))
+                 (if (list? (cadr exp))
+                     (equal? define-name (caadr exp))
+                   (equal? define-name (cadr exp))))
+               exp)
+              (#t (next (read port))))))))
+
+; Writes channel-list to a temp file
+(define (make-temp-channel channel-list)
+  (let ((port (mkstemp! (string-copy "/tmp/guix-channel-XXXXXX") "a")))
+    (map (lambda (_) (pretty-print _ port))
+      channel-list)
+    (force-output port)
+    (port-filename port)))
+
+; Main function called when run at command line.
+;   Parses "nongnu/system/install.scm" for channel definition
+;     (current-filename) used to locate in same dir as this file
+;   Creates a temp file containing channel definition
+;   Performs a guix pull using temp file as channel file
+;   Deletes temp file
+;   Builds image (currently iso only)
+;     supports "--uncompressed" command line argument
+;   If "--roll-back" is used as an argument, reverts guix pull
+;   Returns #t if exit-code is 0, else returns #f
+(define (build-image args)
+  (let* ((image-type 'iso) ; TODO: parse args for supported image types
+         (image-label "nonguix-install")
+         (config-dir (dirname (current-filename)))
+         (config-file-name "install.scm")
+         (install-config (string-append config-dir
+                        file-name-separator-string
+                        config-file-name))
+         (name-to-search 'nonguix-channels) ; lookup in install-config
+         (channels (caddr (search-for-define
+                            install-config
+                            name-to-search)))
+         (temp-channel-file-path (make-temp-channel (cadr channels)))
+         (exit-code #f))
+    (system* "guix" "pull" (string-append "--channels=" temp-channel-file-path))
+    (delete-file temp-channel-file-path)
+
+    (cond ((equal? image-type 'iso)
+           (let ((image-link (string-append config-dir
+                               file-name-separator-string
+                               image-label
+                               ".iso")))
+             (set! exit-code
+               (system* "guix"
+                        "system"
+                        "image"
+                        (if (member "--uncompressed" args)
+                            "--image-type=uncompressed-iso9660"
+                          "--image-type=iso9660") ; remove once image types supported
+                        (string-append "--label=" image-label)
+                        (string-append "--root=" image-link)
+                        install-config)))))
+
+    (and (member "--roll-back" args)
+      (system* "guix" "pull" "--roll-back"))
+      
+    (equal? exit-code 0)))

nongnu/system/install.scm

@@ -1,5 +1,6 @@
 ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
 ;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
+;;; Copyright © 2021 Kyle Cassidy <123_kbc@pm.me>
 ;;;
 ;;; This program is free software: you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -21,12 +22,52 @@
   #:use-module (gnu system)
   #:use-module (gnu system install)
   #:use-module (nongnu packages linux)
+  #:use-module (guix ci)
+  #:use-module (guix gexp)
+  #:use-module (ice-9 pretty-print)
   #:export (installation-os-nonfree))
 
+; Guix channel for the "/etc/skel/.config/guix/channels.scm" file.
+; %default-guix-channel is configured to pull package definitions from
+; the Guix substitute server, to save compiling during a guix pull.
+(define nonguix-channels
+ '((use-modules (guix ci)) ; required for channel-with-substitutes-available
+   (list (channel
+           (name 'nonguix)
+           (url "https://gitlab.com/nonguix/nonguix")
+           (introduction
+             (make-channel-introduction
+              "897c1a470da759236cc11798f4e0a5f7d4d59fbc"
+               (openpgp-fingerprint
+                "2A39 3FFF 68F4 EF7A 3D29  12AF 6F51 20A0 22FB B2D5"))))
+     (channel-with-substitutes-available
+      %default-guix-channel
+      "https://ci.guix.gnu.org"))))
+
+; Create the plain-file definition of "channels.scm" to add to the install.
+(define %channels-file
+  (let ((port (open-output-string)))
+    (map (lambda (_) (pretty-print _ port))
+      nonguix-channels)
+    (plain-file "channels.scm"
+      (get-output-string port))))
+
+; Currently the best way to add the "channels.scm" file to the install is via
+; the skeletons record type.
+; The following service definition for the global channel file is also viable:
+;   (service special-files-service-type
+;    `(("/etc/guix/channels.scm" ,%channel-file)))
+; However even when using (operating-system-services installation-os) without
+; modifying it, a "more than one target service of type 'account" error occurs.
 (define installation-os-nonfree
   (operating-system
     (inherit installation-os)
     (kernel linux)
-    (firmware (list linux-firmware))))
+    (firmware (list linux-firmware))
+    (skeletons
+      (cons ; adds "channels.scm" to "/etc/skel/.config/guix/"
+       `(".config" ,(file-union "guix"
+                                `(("guix/channels.scm" ,%channels-file))))
+        (operating-system-skeletons installation-os)))))
 
 installation-os-nonfree