X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/55ccc388b73312c9636857bb083f63a968b4255b..8a6d273137a1485da2ba4c76c41e40c81f8f2f30:/gnu/system.scm?ds=sidebyside

diff --git a/gnu/system.scm b/gnu/system.scm
index 06bec40cef..dc8f9ef41c 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -26,7 +26,11 @@
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
   #:use-module (gnu packages admin)
+  #:use-module (gnu packages linux)
   #:use-module (gnu packages package-management)
+  #:use-module (gnu packages which)
+  #:use-module (gnu packages less)
+  #:use-module (gnu packages zile)
   #:use-module (gnu services)
   #:use-module (gnu services dmd)
   #:use-module (gnu services base)
@@ -50,14 +54,18 @@
             operating-system-initrd
             operating-system-users
             operating-system-groups
+            operating-system-issue
             operating-system-packages
             operating-system-timezone
             operating-system-locale
             operating-system-file-systems
+            operating-system-activation-script
 
             operating-system-derivation
             operating-system-profile
-            operating-system-grub.cfg))
+            operating-system-grub.cfg
+
+            %base-packages))
 
 ;;; Commentary:
 ;;;
@@ -79,32 +87,24 @@
 
   (host-name operating-system-host-name)          ; string
 
-  (file-systems operating-system-file-systems     ; list of fs
-                (default '()))
+  (file-systems operating-system-file-systems)    ; list of fs
 
   (users operating-system-users                   ; list of user accounts
          (default '()))
   (groups operating-system-groups                 ; list of user groups
-          (default (list (user-group
-                          (name "root")
-                          (id 0)))))
+          (default %base-groups))
 
   (skeletons operating-system-skeletons           ; list of name/monadic value
              (default (default-skeletons)))
+  (issue operating-system-issue                   ; string
+         (default %default-issue))
 
   (packages operating-system-packages             ; list of (PACKAGE OUTPUT...)
-            (default (list coreutils              ; or just PACKAGE
-                           grep
-                           sed
-                           findutils
-                           guile
-                           bash
-                           (@ (gnu packages dmd) dmd)
-                           guix
-                           tzdata)))
+            (default %base-packages))             ; or just PACKAGE
 
   (timezone operating-system-timezone)            ; string
-  (locale   operating-system-locale)              ; string
+  (locale   operating-system-locale               ; string
+            (default "en_US.UTF-8"))
 
   (services operating-system-user-services        ; list of monadic services
             (default %base-services))
@@ -178,8 +178,10 @@ as 'needed-for-boot'."
 
   (sequence %store-monad
             (map (match-lambda
-                  (($ <file-system> device target type flags opts #f check?)
+                  (($ <file-system> device title target type flags opts
+                                    #f check?)
                    (file-system-service device target type
+                                        #:title title
                                         #:check? check?
                                         #:options opts)))
                  file-systems)))
@@ -210,8 +212,29 @@ explicitly appear in OS."
 ;;; /etc.
 ;;;
 
+(define %base-packages
+  ;; Default set of packages globally visible.  It should include anything
+  ;; required for basic administrator tasks.
+  (cons* procps psmisc less zile
+         guile-final (@ (gnu packages admin) dmd) guix
+         util-linux inetutils isc-dhcp
+         net-tools                        ; XXX: remove when Inetutils suffices
+         module-init-tools udev kbd
+
+         ;; The packages below are also in %FINAL-INPUTS, so take them from
+         ;; there to avoid duplication.
+         (map canonical-package
+              (list bash coreutils findutils grep sed))))
+
+(define %default-issue
+  ;; Default contents for /etc/issue.
+  "
+This is the GNU system.  Welcome.\n")
+
 (define* (etc-directory #:key
+                        kernel
                         (locale "C") (timezone "Europe/Paris")
+                        (issue "Hello!\n")
                         (skeletons '())
                         (pam-services '())
                         (profile "/run/current-system/profile")
@@ -226,15 +249,7 @@ explicitly appear in OS."
 /bin/sh
 /run/current-system/profile/bin/sh
 /run/current-system/profile/bin/bash\n"))
-       (issue      (text-file "issue" "
-This is an alpha preview of the GNU system.  Welcome.
-
-This image features the GNU Guix package manager, which was used to
-build it (http://www.gnu.org/software/guix/).  The init system is
-GNU dmd (http://www.gnu.org/software/dmd/).
-
-You can log in as 'guest' or 'root' with no password.
-"))
+       (issue      (text-file "issue" issue))
 
        ;; TODO: Generate bashrc from packages' search-paths.
        (bashrc    (text-file* "bashrc"  "
@@ -244,8 +259,13 @@ export LC_ALL=\"" locale "\"
 export TZ=\"" timezone "\"
 export TZDIR=\"" tzdata "/share/zoneinfo\"
 
-export PATH=/run/setuid-programs:/run/current-system/profile/sbin
-export PATH=$HOME/.guix-profile/bin:/run/current-system/profile/bin:$PATH
+# Tell 'modprobe' & co. where to look for modules.
+# XXX: The downside of doing it here is that when switching to a new config
+# without rebooting, this variable possibly becomes invalid.
+export LINUX_MODULE_DIRECTORY=" kernel "/lib/modules
+
+export PATH=$HOME/.guix-profile/bin:/run/current-system/profile/bin
+export PATH=/run/setuid-programs:/run/current-system/profile/sbin:$PATH
 export CPATH=$HOME/.guix-profile/include:" profile "/include
 export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib
 alias ls='ls -p --color'
@@ -306,8 +326,10 @@ alias ll='ls -l'
                               (append-map service-pam-services services))))
        (profile-drv (operating-system-profile os))
        (skeletons   (operating-system-skeletons os)))
-   (etc-directory #:pam-services pam-services
+   (etc-directory #:kernel (operating-system-kernel os)
+                  #:pam-services pam-services
                   #:skeletons skeletons
+                  #:issue (operating-system-issue os)
                   #:locale (operating-system-locale os)
                   #:timezone (operating-system-timezone os)
                   #:sudoers (operating-system-sudoers os)
@@ -319,7 +341,8 @@ alias ll='ls -l'
     (list #~(string-append #$shadow "/bin/passwd")
           #~(string-append #$shadow "/bin/su")
           #~(string-append #$inetutils "/bin/ping")
-          #~(string-append #$sudo "/bin/sudo"))))
+          #~(string-append #$sudo "/bin/sudo")
+          #~(string-append #$fuse "/bin/fusermount"))))
 
 (define %sudoers-specification
   ;; Default /etc/sudoers contents: 'root' and all members of the 'wheel'
@@ -382,7 +405,7 @@ etc."
     (define group-specs
       (map user-group->gexp groups))
 
-    (gexp->file "boot"
+    (gexp->file "activate"
                 #~(begin
                     (eval-when (expand load eval)
                       ;; Make sure 'use-modules' below succeeds.
@@ -445,7 +468,7 @@ we're running in the final root."
 (define (operating-system-root-file-system os)
   "Return the root file system of OS."
   (find (match-lambda
-         (($ <file-system> _ "/") #t)
+         (($ <file-system> _ _ "/") #t)
          (_ #f))
         (operating-system-file-systems os)))
 
@@ -453,9 +476,10 @@ we're running in the final root."
   "Return a gexp denoting the initrd file of OS."
   (define boot-file-systems
     (filter (match-lambda
-             (($ <file-system> device "/")
+             (($ <file-system> device title "/")
               #t)
-             (($ <file-system> device mount-point type flags options boot?)
+             (($ <file-system> device title mount-point type flags
+                               options boot?)
               boot?))
             (operating-system-file-systems os)))
 
@@ -463,17 +487,22 @@ we're running in the final root."
       ((initrd ((operating-system-initrd os) boot-file-systems)))
     (return #~(string-append #$initrd "/initrd"))))
 
-(define (operating-system-grub.cfg os)
-  "Return the GRUB configuration file for OS."
+(define (kernel->grub-label kernel)
+  "Return a label for the GRUB menu entry that boots KERNEL."
+  (string-append "GNU system with "
+                 (string-titlecase (package-name kernel)) " "
+                 (package-version kernel)
+                 " (technology preview)"))
+
+(define* (operating-system-grub.cfg os #:optional (old-entries '()))
+  "Return the GRUB configuration file for OS.  Use OLD-ENTRIES to populate the
+\"old entries\" menu."
   (mlet* %store-monad
       ((system      (operating-system-derivation os))
        (root-fs ->  (operating-system-root-file-system os))
        (kernel ->   (operating-system-kernel os))
        (entries ->  (list (menu-entry
-                           (label (string-append
-                                   "GNU system with "
-                                   (package-full-name kernel)
-                                   " (technology preview)"))
+                           (label (kernel->grub-label kernel))
                            (linux kernel)
                            (linux-arguments
                             (list (string-append "--root="
@@ -482,7 +511,22 @@ we're running in the final root."
                                   #~(string-append "--load=" #$system
                                                    "/boot")))
                            (initrd #~(string-append #$system "/initrd"))))))
-    (grub-configuration-file (operating-system-bootloader os) entries)))
+    (grub-configuration-file (operating-system-bootloader os) entries
+                             #:old-entries old-entries)))
+
+(define (operating-system-parameters-file os)
+  "Return a file that describes the boot parameters of OS.  The primary use of
+this file is the reconstruction of GRUB menu entries for old configurations."
+  (mlet %store-monad ((initrd   (operating-system-initrd-file os))
+                      (root ->  (operating-system-root-file-system os))
+                      (label -> (kernel->grub-label
+                                 (operating-system-kernel os))))
+    (gexp->file "parameters"
+                #~(boot-parameters (version 0)
+                                   (label #$label)
+                                   (root-device #$(file-system-device root))
+                                   (kernel #$(operating-system-kernel os))
+                                   (initrd #$initrd)))))
 
 (define (operating-system-derivation os)
   "Return a derivation that builds OS."
@@ -491,10 +535,12 @@ we're running in the final root."
        (etc         (operating-system-etc-directory os))
        (boot        (operating-system-boot-script os))
        (kernel  ->  (operating-system-kernel os))
-       (initrd      (operating-system-initrd-file os)))
+       (initrd      (operating-system-initrd-file os))
+       (params      (operating-system-parameters-file os)))
     (file-union "system"
                 `(("boot" ,#~#$boot)
                   ("kernel" ,#~#$kernel)
+                  ("parameters" ,#~#$params)
                   ("initrd" ,initrd)
                   ("profile" ,#~#$profile)
                   ("etc" ,#~#$etc)))))