operating-system-sudoers-file
operating-system-swap-devices
operating-system-kernel-loadable-modules
+ operating-system-location
operating-system-derivation
operating-system-profile
(default %setuid-programs)) ; list of string-valued gexps
(sudoers-file operating-system-sudoers-file ; file-like
- (default %sudoers-specification)))
+ (default %sudoers-specification))
+
+ (location operating-system-location ; <location>
+ (default (and=> (current-source-location)
+ source-properties->location))
+ (innate)))
(define (operating-system-kernel-arguments os root-device)
"Return all the kernel arguments, including the ones not specified
(('initrd ('string-append directory file)) ;the old format
(string-append directory file))
(('initrd (? string? file))
- file)))
+ file)
+ (#f #f)))
- (multiboot-modules (or (assq 'multiboot-modules rest) '()))
+ (multiboot-modules
+ (match (assq 'multiboot-modules rest)
+ ((_ args) args)
+ (#f '())))
(store-device
;; Linux device names like "/dev/sda1" are not suitable GRUB device
(device (boot-parameters-store-device conf))
(device-mount-point (boot-parameters-store-mount-point conf))
(linux (and (not multiboot?) kernel))
- (linux-arguments (if (not multiboot?) '
+ (linux-arguments (if (not multiboot?)
(boot-parameters-kernel-arguments conf)
'()))
(initrd (boot-parameters-initrd conf))
value of the SYSTEM-SERVICE-TYPE service."
(let* ((locale (operating-system-locale-directory os))
(kernel (operating-system-kernel os))
+ (hurd (operating-system-hurd os))
(modules (operating-system-kernel-loadable-modules os))
- (kernel (profile
- (content (packages->manifest
- (cons kernel
- (map (lambda (module)
- (if (package? module)
- (package-for-kernel kernel
- module)
- module))
- modules))))
- (hooks (list linux-module-database))))
- (initrd (operating-system-initrd-file os))
+ (kernel (if hurd
+ kernel
+ (profile
+ (content (packages->manifest
+ (cons kernel
+ (map (lambda (module)
+ (if (package? module)
+ (package-for-kernel kernel
+ module)
+ module))
+ modules))))
+ (hooks (list linux-module-database)))))
+ (initrd (and (not hurd) (operating-system-initrd-file os)))
(params (operating-system-boot-parameters-file os)))
`(("kernel" ,kernel)
+ ,@(if hurd `(("hurd" ,hurd)) '())
("parameters" ,params)
- ("initrd" ,initrd)
+ ,@(if initrd `(("initrd" ,initrd)) '())
("locale" ,locale)))) ;used by libc
(define (operating-system-default-essential-services os)
(operating-system-firmware os)))))))
(define (hurd-default-essential-services os)
- (list (service system-service-type '())
- (service profile-service-type '())))
+ (let ((entries (operating-system-directory-base-entries os)))
+ (list (service system-service-type entries)
+ %boot-service
+ %hurd-startup-service
+ %activation-service
+ %shepherd-root-service
+ (service user-processes-service-type)
+ (account-service (append (operating-system-accounts os)
+ (operating-system-groups os))
+ (operating-system-skeletons os))
+ (root-file-system-service)
+ (service file-system-service-type '())
+ (service fstab-service-type
+ (filter file-system-needed-for-boot?
+ (operating-system-file-systems os)))
+ (pam-root-service (operating-system-pam-services os))
+ (operating-system-etc-service os)
+ (service profile-service-type (operating-system-packages os)))))
(define* (operating-system-services os)
"Return all the services of OS, including \"essential\" services."
(define* (operating-system-etc-service os)
"Return a <service> that builds containing the static part of the /etc
directory."
- (let ((login.defs
+ (let* ((login.defs
(plain-file "login.defs"
(string-append
"# Default paths for non-login shells started by su(1).\n"
"/run/current-system/profile/bin:"
"/run/current-system/profile/sbin\n")))
- (issue (plain-file "issue" (operating-system-issue os)))
- (nsswitch (plain-file "nsswitch.conf"
- (name-service-switch->string
- (operating-system-name-service-switch os))))
+ (hurd (operating-system-hurd os))
+ (issue (plain-file "issue" (operating-system-issue os)))
+ (nsswitch (operating-system-name-service-switch os))
+ (nsswitch (and nsswitch
+ (plain-file "nsswitch.conf"
+ (name-service-switch->string nsswitch))))
+ (sudoers (operating-system-sudoers-file os))
;; Startup file for POSIX-compliant login shells, which set system-wide
;; environment variables.
("rpc" ,(file-append net-base "/etc/rpc"))
("login.defs" ,#~#$login.defs)
("issue" ,#~#$issue)
- ("nsswitch.conf" ,#~#$nsswitch)
+ ,@(if nsswitch `(("nsswitch.conf" ,#~#$nsswitch)) '())
("profile" ,#~#$profile)
("bashrc" ,#~#$bashrc)
("hosts" ,#~#$(or (operating-system-hosts-file os)
("timezone" ,(plain-file "timezone" (operating-system-timezone os)))
("localtime" ,(file-append tzdata "/share/zoneinfo/"
(operating-system-timezone os)))
- ("sudoers" ,(operating-system-sudoers-file os))))))
+ ,@(if sudoers `(("sudoers" ,sudoers)) '())
+ ,@(if hurd
+ `(("login" ,(file-append hurd "/etc/login"))
+ ("motd" ,(file-append hurd "/etc/motd"))
+ ("ttys" ,(file-append hurd "/etc/ttys")))
+ '())))))
(define %root-account
;; Default root account.
;; Default set of setuid-root programs.
(let ((shadow (@ (gnu packages admin) shadow)))
(list (file-append shadow "/bin/passwd")
+ (file-append shadow "/bin/sg")
(file-append shadow "/bin/su")
+ (file-append shadow "/bin/newgrp")
(file-append shadow "/bin/newuidmap")
(file-append shadow "/bin/newgidmap")
(file-append inetutils "/bin/ping")
(define (operating-system-root-file-system os)
"Return the root file system of OS."
- (find (lambda (fs)
- (string=? "/" (file-system-mount-point fs)))
- (operating-system-file-systems os)))
+ (or (find (lambda (fs)
+ (string=? "/" (file-system-mount-point fs)))
+ (operating-system-file-systems os))
+ (raise (condition
+ (&message (message "missing root file system"))
+ (&error-location
+ (location (operating-system-location os)))))))
(define (operating-system-initrd-file os)
"Return a gexp denoting the initrd file of OS."
(locale-directory definitions
#:libcs (operating-system-locale-libcs os)))
-(define (kernel->boot-label kernel)
+(define* (kernel->boot-label kernel #:key hurd)
"Return a label for the bootloader menu entry that boots KERNEL."
- (cond ((package? kernel)
+ (cond ((package? hurd)
+ (string-append "GNU with the "
+ (string-titlecase (package-name hurd)) " "
+ (package-version hurd)))
+ ((package? kernel)
(string-append "GNU with "
(string-titlecase (package-name kernel)) " "
(package-version kernel)))
(define (operating-system-default-label os)
"Return the default label for OS, as it will appear in the bootloader menu
entry."
- (kernel->boot-label (operating-system-kernel os)))
+ (kernel->boot-label (operating-system-kernel os)
+ #:hurd (operating-system-hurd os)))
(define (store-file-system file-systems)
"Return the file system object among FILE-SYSTEMS that contains the store."
"--device-master-port='${device-port}'"
"--exec-server-task='${exec-task}'"
"--store-type=typed"
+ "--x-xattr-translator-records"
"'${root}'" "'$(task-create)'" "'$(task-resume)'"))
(target (%current-target-system))
(libc (if target
"Return a monadic <boot-parameters> record that describes the boot
parameters of OS. When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments
such as '--root' and '--load' to <boot-parameters>."
- (let* ((initrd (and (not (hurd-target?))
+ (let* ((initrd (and (not (operating-system-hurd os))
(operating-system-initrd-file os)))
(store (operating-system-store-file-system os))
(bootloader (bootloader-configuration-bootloader
(kernel #$(boot-parameters-kernel params))
(kernel-arguments
#$(boot-parameters-kernel-arguments params))
- (initrd #$(boot-parameters-initrd params))
+ #$@(if (boot-parameters-initrd params)
+ #~((initrd #$(boot-parameters-initrd params)))
+ #~())
+ #$@(if (pair? (boot-parameters-multiboot-modules params))
+ #~((multiboot-modules
+ #$(boot-parameters-multiboot-modules params)))
+ #~())
(bootloader-name #$(boot-parameters-bootloader-name params))
(bootloader-menu-entries
#$(map menu-entry->sexp
HCoop / jackhill / guix / guix.git / blobdiff