25/43: system: gnu: Populate "/etc" from "/boot/activation".

[guix-commits]

janneke pushed a commit to branch wip-hurd-vm
in repository guix.

commit 15533660583f9b3a9b533ade6716a6ac56782a41
Author: Jan (janneke) Nieuwenhuizen <address@hidden>
AuthorDate: Mon Apr 13 17:15:10 2020 +0200

    system: gnu: Populate "/etc" from "/boot/activation".
    
    * gnu/system/hurd.scm (hurd-essential-services, hurd-etc-service): New
    function.
    (%hurd-os): Clear fields from Linux defaults and unsupported features.  Set
    hurd-essential-services.
    (cross-hurd-image): Create "/boot/activation" from
    services.  Remove manual creation of etc-profile, sshd_config, 
/etc/protocols,
    etc/services.
    * gnu/packages/hurd.scm (hurd-rc-script): Remove ssh-keygen generation hack;
    invoke /boot/activation instead.
---
 gnu/packages/hurd.scm |  5 ++-
 gnu/services.scm      | 60 +++++++++++++++++++++++++----------
 gnu/services/hurd.scm |  1 +
 gnu/system/hurd.scm   | 87 ++++++++++++++++++++++++++++++++++-----------------
 4 files changed, 106 insertions(+), 47 deletions(-)

diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm
index 2637883..e6f2881 100644
--- a/gnu/packages/hurd.scm
+++ b/gnu/packages/hurd.scm
@@ -349,9 +349,8 @@ boot, since this cannot be done from GNU/Linux."
                          (apply invoke "settrans" "-c" node command))))
                     '#$translators)
 
-          ;; Generate the ssh host keys.
-          (invoke "/run/current-system/profile/bin/ssh-keygen" "-A")
-          (mkdir-p "/var/run")                    ;for the PID files
+          ;; Activate the system
+          (invoke "/run/current-system/profile/bin/sh" "/boot/activation")
           ;; Hand over to the Shepherd
           (false-if-exception (delete-file "/var/run/shepherd/socket"))
           (invoke "/run/current-system/profile/bin/shepherd"
diff --git a/gnu/services.scm b/gnu/services.scm
index 832d698..61e24f9 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -29,10 +29,12 @@
   #:use-module (guix describe)
   #:use-module (guix sets)
   #:use-module (guix ui)
-  #:use-module ((guix utils) #:select (source-properties->location))
+  #:use-module ((guix utils) #:select (source-properties->location
+                                       %current-target-system))
   #:use-module (guix modules)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
+  #:use-module (gnu packages hurd)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
@@ -517,6 +519,44 @@ ACTIVATION-SCRIPT-TYPE."
 
 (define (activation-script gexps)
   "Return the system's activation script, which evaluates GEXPS."
+
+  (program-file "activate.scm" (if (hurd-target?)
+                                   (hurd-activation-script gexps)
+                                   (gnu/linux-activation-script gexps))))
+
+(define (gnu/linux-activation-script gexps)
+  "Return a GNU/Linux system activation script, which evaluates GEXPS."
+
+  (define actions
+    (map (cut program-file "activate-service.scm" <>) gexps))
+
+  (with-imported-modules (source-module-closure
+                          '((gnu build activation)
+                            (guix build utils)))
+    #~(begin
+        (use-modules (gnu build activation)
+                     (guix build utils))
+
+        ;; Make sure the user accounting database exists.  If it
+        ;; does not exist, 'setutxent' does not create it and
+        ;; thus there is no accounting at all.
+        (close-port (open-file "/var/run/utmpx" "a0"))
+
+        ;; Same for 'wtmp', which is populated by mingetty et
+        ;; al.
+        (close-port (open-file "/var/log/wtmp" "a0"))
+
+        ;; Set up /run/current-system.  Among other things this
+        ;; sets up locales, which the activation snippets
+        ;; executed below may expect.
+        (activate-current-system)
+
+        ;; Run the services' activation snippets.
+        ;; TODO: Use 'load-compiled'.
+        (for-each primitive-load '#$actions))))
+
+(define (hurd-activation-script gexps)
+  "Return the Hurd activation script, which evaluates GEXPS."
   (define actions
     (map (cut program-file "activate-service.scm" <>) gexps))
 
@@ -528,23 +568,11 @@ ACTIVATION-SCRIPT-TYPE."
                       (use-modules (gnu build activation)
                                    (guix build utils))
 
-                      ;; Make sure the user accounting database exists.  If it
-                      ;; does not exist, 'setutxent' does not create it and
-                      ;; thus there is no accounting at all.
-                      (close-port (open-file "/var/run/utmpx" "a0"))
-
-                      ;; Same for 'wtmp', which is populated by mingetty et
-                      ;; al.
+                      (mkdir-p "/var/run") ;for the PID files
                       (mkdir-p "/var/log")
-                      (close-port (open-file "/var/log/wtmp" "a0"))
-
-                      ;; Set up /run/current-system.  Among other things this
-                      ;; sets up locales, which the activation snippets
-                      ;; executed below may expect.
-                      (activate-current-system)
 
-                      ;; Run the services' activation snippets.
-                      ;; TODO: Use 'load-compiled'.
+                      ;; XXX TODO
+                      ;; (activate-hurd-system)
                       (for-each primitive-load '#$actions)))))
 
 (define (gexps->activation-gexp gexps)
diff --git a/gnu/services/hurd.scm b/gnu/services/hurd.scm
index 820c4cc..bdc7be52 100644
--- a/gnu/services/hurd.scm
+++ b/gnu/services/hurd.scm
@@ -27,6 +27,7 @@
   #:use-module (guix modules)
   #:use-module (guix records)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:export (hurd-console-configuration
             hurd-console-service-type
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index b035a0b..bfeb5f5 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -37,6 +37,7 @@
   #:use-module (gnu services hurd)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system)
+  #:use-module (gnu system shadow)
   #:use-module (gnu system vm)
   #:export (cross-hurd-image))
 
@@ -83,9 +84,58 @@
   (operating-system
     (host-name "guixygnu")
     (bootloader #f)
+    (kernel #f)
+    (initrd-modules '())
     (file-systems '())
+    (swap-devices '())
     (timezone "GNUrope")
-    (services %base-services/hurd)))
+    (name-service-switch #f)
+    (essential-services (hurd-essential-services this-operating-system))
+    (services %base-services/hurd)
+    (pam-services '())
+    (setuid-programs '())))
+
+(define operating-system-accounts
+  (@@ (gnu system) operating-system-accounts))
+
+(define operating-system-etc-directory
+  (@@ (gnu system) operating-system-etc-directory))
+
+(define (hurd-etc-service os)
+  "Return a <service> that builds containing the static part of the /etc
+directory."
+  (let ((net-base (with-parameters ((%current-target-system
+                                     "i586-pc-gnu"))
+                    net-base))
+        (profile (mixed-text-file "profile"  "\
+# Generated by hurd-etc-services
+export PS1='\\u@\\h\\$ '
+
+GUIX_PROFILE=\"/run/current-system/profile\"
+. \"$GUIX_PROFILE/etc/profile\"
+
+GUIX_PROFILE=\"$HOME/.guix-profile\"
+if [ -f \"$GUIX_PROFILE/etc/profile\" ]; then
+  . \"$GUIX_PROFILE/etc/profile\"
+fi\n")))
+    (etc-service
+     `(("services" ,(file-append net-base "/etc/services"))
+       ("protocols" ,(file-append net-base "/etc/protocols"))
+       ("profile" ,#~#$profile)
+       ("hostname" ,(plain-file "hostname" (operating-system-host-name 
os)))))))
+
+(define (hurd-essential-services os)
+  (list (service system-service-type '() ;;entries
+                 )
+        %boot-service
+        %shepherd-root-service
+        %activation-service
+        (account-service (append (operating-system-accounts os)
+                                 (operating-system-groups os))
+                         (operating-system-skeletons os))
+        (hurd-etc-service os)
+        (service profile-service-type
+                 (operating-system-packages os))))
 
 (define (hurd-shepherd-services os)
   (append-map hurd-service->shepherd-service (operating-system-services os)))
@@ -209,19 +259,6 @@ guixbuilder:x:1:1:guixbuilder:/var/empty:/bin/no-sh
                 "root::0:0:0:0:::
 "))
 
-  (define etc-profile
-    (plain-file "profile"
-                "\
-export PS1='\\u@\\h\\$ '
-
-GUIX_PROFILE=\"/run/current-system/profile\"
-. \"$GUIX_PROFILE/etc/profile\"
-
-GUIX_PROFILE=\"$HOME/.guix-profile\"
-if [ -f \"$GUIX_PROFILE/etc/profile\" ]; then
-  . \"$GUIX_PROFILE/etc/profile\"
-fi\n"))
-
   ;; XXX This still gives 64bit .go files
   ;; (define shepherd.conf
   ;;   (with-parameters ((%current-target-system "i586-pc-gnu"))
@@ -231,6 +268,10 @@ fi\n"))
     (with-parameters ((%current-target-system "i586-pc-gnu"))
       (hurd-shepherd-configuration-file (hurd-shepherd-services %hurd-os))))
 
+  (define boot-activation
+    (with-parameters ((%current-target-system "i586-pc-gnu"))
+      (operating-system-activation-script %hurd-os)))
+
   (define hurd-directives
     `((directory "/servers")
       ,@(map (lambda (server)
@@ -248,6 +289,7 @@ fi\n"))
       ("/servers/socket/inet6" -> "16")
       (directory "/boot")
       ("/boot/grub.cfg" -> ,grub.cfg)   ;XXX: not strictly needed
+      ("/boot/activation" -> ,boot-activation)
       ("/hurd" -> ,(file-append (with-parameters ((%current-target-system
                                                    "i586-pc-gnu"))
                                   hurd)
@@ -263,22 +305,13 @@ fi\n"))
       (directory "/run")
       (directory "/run/current-system")
       ("/run/current-system/profile" -> ,system-profile)
-      ("/etc/profile" -> ,etc-profile)
       ("/etc/fstab" -> ,fstab)
+      ;; Hmm, someone runs chown which before (or while?) we run 
/boot/activation
       ("/etc/group" -> ,group)
       ("/etc/passwd" -> ,passwd)
       ("/etc/shadow" -> ,shadow)
-      (file "/etc/hostname" "guixygnu")
       (file "/etc/resolv.conf"
             "nameserver 10.0.2.3\n")
-      ("/etc/services" -> ,(file-append (with-parameters 
((%current-target-system
-                                                           "i586-pc-gnu"))
-                                          net-base)
-                                        "/etc/services"))
-      ("/etc/protocols" -> ,(file-append (with-parameters 
((%current-target-system
-                                                            "i586-pc-gnu"))
-                                           net-base)
-                                         "/etc/protocols"))
       ("/etc/motd" -> ,(file-append (with-parameters ((%current-target-system
                                                        "i586-pc-gnu"))
                                       hurd)
@@ -287,8 +320,6 @@ fi\n"))
                                                         "i586-pc-gnu"))
                                        hurd)
                                      "/etc/login"))
-
-
       ;; XXX can we instead, harmlessly set _PATH_TTYS (from glibc) in 
runttys.c?
       ("/etc/ttys" -> ,(file-append (with-parameters ((%current-target-system
                                                        "i586-pc-gnu"))
@@ -308,9 +339,9 @@ fi\n"))
                          ("fstab" ,fstab)
                          ("passwd" ,passwd)
                          ("group" ,group)
-                         ("etc-profile" ,etc-profile)
                          ("shadow" ,shadow)
-                         ("shepherd.conf" ,shepherd.conf))
+                         ("shepherd.conf" ,shepherd.conf)
+                         ("boot-activation" ,boot-activation))
               #:copy-inputs? #t
               #:os system-profile
               #:bootcfg-drv grub.cfg