From 09e028f45feca1c415cd961ac5c79e5c7d5f3ae7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 30 Apr 2014 22:17:56 +0200 Subject: system: Add support for setuid binaries. * gnu/system.scm ()[pam-services, setuid-programs]: New fields. (etc-directory)[bashrc]: Prepend /run/setuid-programs to $PATH. (operating-system-etc-directory): Honor 'operating-system-pam-services'. (%setuid-programs): New variable. (operating-system-boot-script): Add (guix build utils) to the set of imported modules. Call 'activate-setuid-programs' in boot script. * gnu/system/linux.scm (base-pam-services): New procedure. * guix/build/activation.scm (%setuid-directory): New variable. (activate-setuid-programs): New procedure. * build-aux/hydra/demo-os.scm: Add 'pam-services' field. --- build-aux/hydra/demo-os.scm | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'build-aux/hydra/demo-os.scm') diff --git a/build-aux/hydra/demo-os.scm b/build-aux/hydra/demo-os.scm index c2ff012a1b..3987c4048d 100644 --- a/build-aux/hydra/demo-os.scm +++ b/build-aux/hydra/demo-os.scm @@ -34,6 +34,7 @@ (gnu packages package-management) (gnu system shadow) ; 'user-account' + (gnu system linux) ; 'base-pam-services' (gnu services base) (gnu services networking) (gnu services xorg)) @@ -56,6 +57,9 @@ #:gateway "10.0.2.2") %base-services)) + (pam-services + ;; Explicitly allow for empty passwords. + (base-pam-services #:allow-empty-passwords? #t)) (packages (list bash coreutils findutils grep sed procps psmisc less guile-2.0 dmd guix util-linux inetutils -- cgit v1.2.3 From 696893801c9d4b83adc9a15ce60103142e7c1a79 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 1 May 2014 15:29:24 +0200 Subject: system: Add 'sudo' to the setuid programs, and handle /etc/sudoers. * gnu/system.scm ()[groups]: Change default to just the 'root' group. [sudoers]: New field. (etc-directory): Add #:sudoers parameter. Add 'sudoers' to the file union. (operating-system-etc-directory): Pass #:sudoers to 'etc-directory'. (%setuid-programs): Add 'sudo'. (%sudoers-specification): New variable. * gnu/system/linux.scm (base-pam-services): Add 'sudo'. * build-aux/hydra/demo-os.scm: Add 'groups' field; add 'guest' to the 'wheel' group. --- build-aux/hydra/demo-os.scm | 9 +++++++++ gnu/system.scm | 30 +++++++++++++++++++++--------- gnu/system/linux.scm | 2 ++ 3 files changed, 32 insertions(+), 9 deletions(-) (limited to 'build-aux/hydra/demo-os.scm') diff --git a/build-aux/hydra/demo-os.scm b/build-aux/hydra/demo-os.scm index 3987c4048d..03449abda2 100644 --- a/build-aux/hydra/demo-os.scm +++ b/build-aux/hydra/demo-os.scm @@ -48,6 +48,15 @@ (uid 1000) (gid 100) (comment "Guest of GNU") (home-directory "/home/guest")))) + (groups (list (user-group (name "root") (id 0)) + (user-group + (name "wheel") + (id 1) + (members '("guest"))) ; allow 'guest' to use sudo + (user-group + (name "users") + (id 100) + (members '("guest"))))) (services (cons* (slim-service #:auto-login? #t #:default-user "guest") diff --git a/gnu/system.scm b/gnu/system.scm index ba105e2df1..6c94eb90c5 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -85,11 +85,7 @@ (groups operating-system-groups ; list of user groups (default (list (user-group (name "root") - (id 0)) - (user-group - (name "users") - (id 100) - (members '("guest")))))) + (id 0))))) (packages operating-system-packages ; list of (PACKAGE OUTPUT...) (default (list coreutils ; or just PACKAGE @@ -111,8 +107,10 @@ (pam-services operating-system-pam-services ; list of PAM services (default (base-pam-services))) (setuid-programs operating-system-setuid-programs - (default %setuid-programs))) ; list of string-valued gexps + (default %setuid-programs)) ; list of string-valued gexps + (sudoers operating-system-sudoers ; /etc/sudoers contents + (default %sudoers-specification))) ;;; @@ -164,13 +162,15 @@ file." (accounts '()) (groups '()) (pam-services '()) - (profile "/var/run/current-system/profile")) + (profile "/var/run/current-system/profile") + (sudoers "")) "Return a derivation that builds the static part of the /etc directory." (mlet* %store-monad ((passwd (passwd-file accounts)) (shadow (passwd-file accounts #:shadow? #t)) (group (group-file groups)) (pam.d (pam-services->directory pam-services)) + (sudoers (text-file "sudoers" sudoers)) (login.defs (text-file "login.defs" "# Empty for now.\n")) (shells (text-file "shells" ; used by xterm and others "\ @@ -215,7 +215,9 @@ alias ll='ls -l' #$timezone)) ("passwd" ,#~#$passwd) ("shadow" ,#~#$shadow) - ("group" ,#~#$group))))) + ("group" ,#~#$group) + + ("sudoers" ,#~#$sudoers))))) (define (operating-system-profile os) "Return a derivation that builds the default profile of OS." @@ -254,6 +256,7 @@ alias ll='ls -l' #:pam-services pam-services #:locale (operating-system-locale os) #:timezone (operating-system-timezone os) + #:sudoers (operating-system-sudoers os) #:profile profile-drv))) (define %setuid-programs @@ -261,7 +264,16 @@ alias ll='ls -l' (let ((shadow (@ (gnu packages admin) shadow))) (list #~(string-append #$shadow "/bin/passwd") #~(string-append #$shadow "/bin/su") - #~(string-append #$inetutils "/bin/ping")))) + #~(string-append #$inetutils "/bin/ping") + #~(string-append #$sudo "/bin/sudo")))) + +(define %sudoers-specification + ;; Default /etc/sudoers contents: 'root' and all members of the 'wheel' + ;; group can do anything. See + ;; . + ;; TODO: Add a declarative API. + "root ALL=(ALL) ALL +%wheel ALL=(ALL) ALL\n") (define (operating-system-boot-script os) "Return the boot script for OS---i.e., the code started by the initrd once diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm index 4030d8860e..3a43eb45e3 100644 --- a/gnu/system/linux.scm +++ b/gnu/system/linux.scm @@ -157,6 +157,8 @@ should be the name of a file used as the message-of-the-day." (list %pam-other-services (unix-pam-service "su" #:allow-empty-passwords? allow-empty-passwords?) (unix-pam-service "passwd" + #:allow-empty-passwords? allow-empty-passwords?) + (unix-pam-service "sudo" #:allow-empty-passwords? allow-empty-passwords?))) ;;; linux.scm ends here -- cgit v1.2.3 From ab6a279abbfa39b1e1bec0e363744d241972f844 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 11 May 2014 22:41:01 +0200 Subject: system: Make accounts and groups at activation time. * gnu/services/base.scm (guix-build-accounts): Remove #:gid parameter; add #:group. Remove 'password' and 'gid' fields in 'user-account' form, and add 'group'. (guix-service): Remove #:build-user-gid parameter. Remove 'id' field in 'user-group' form. * gnu/system.scm (etc-directory): Remove #:groups and #:accounts. No longer produce files "passwd", "shadow", and "group". Adjust caller accordingly. (%root-account): New variable. (operating-system-accounts): Add 'users' variable. Add %ROOT-ACCOUNT only of 'operating-system-users' doesn't already contain a root account. (user-group->gexp, user-account->gexp): New procedures. (operating-system-boot-script): Add calls to 'setenv' and 'activate-users+groups' in gexp. * gnu/system/linux.scm (base-pam-services): Add PAM services for "user{add,del,mode}" and "group{add,del,mod}". * gnu/system/shadow.scm ()[gid]: Rename to... [group]: ... this. [supplementary-groups]: New field. [uid, password]: Default to #f. ()[id]: Default to #f. (group-file, passwd-file): Remove. * gnu/system/vm.scm (operating-system-default-contents)[user-directories]: Remove. Add "/home" to the directives. * guix/build/activation.scm (add-group, add-user, activate-users+groups): New procedures. --- build-aux/hydra/demo-os.scm | 3 +- gnu/services/base.scm | 10 ++--- gnu/system.scm | 95 +++++++++++++++++++++++++++++--------------- gnu/system/linux.scm | 14 ++++--- gnu/system/shadow.scm | 61 +++++----------------------- gnu/system/vm.scm | 15 +------ guix/build/activation.scm | 97 ++++++++++++++++++++++++++++++++++++++++++++- 7 files changed, 186 insertions(+), 109 deletions(-) (limited to 'build-aux/hydra/demo-os.scm') diff --git a/build-aux/hydra/demo-os.scm b/build-aux/hydra/demo-os.scm index 03449abda2..4116c063f4 100644 --- a/build-aux/hydra/demo-os.scm +++ b/build-aux/hydra/demo-os.scm @@ -45,7 +45,8 @@ (locale "en_US.UTF-8") (users (list (user-account (name "guest") - (uid 1000) (gid 100) + (group "wheel") + (password "") (comment "Guest of GNU") (home-directory "/home/guest")))) (groups (list (user-group (name "root") (id 0)) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 6431a3aaba..1f5ff3e4cb 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -237,8 +237,8 @@ stopped before 'kill' is called." (stop #~(make-kill-destructor)))))) (define* (guix-build-accounts count #:key + (group "guixbuild") (first-uid 30001) - (gid 30000) (shadow shadow)) "Return a list of COUNT user accounts for Guix build users, with UIDs starting at FIRST-UID, and under GID." @@ -247,9 +247,8 @@ starting at FIRST-UID, and under GID." (lambda (n) (user-account (name (format #f "guixbuilder~2,'0d" n)) - (password "!") (uid (+ first-uid n -1)) - (gid gid) + (group group) (comment (format #f "Guix Build User ~2d" n)) (home-directory "/var/empty") (shell #~(string-append #$shadow "/sbin/nologin")))) @@ -257,11 +256,11 @@ starting at FIRST-UID, and under GID." 1)))) (define* (guix-service #:key (guix guix) (builder-group "guixbuild") - (build-user-gid 30000) (build-accounts 10)) + (build-accounts 10)) "Return a service that runs the build daemon from GUIX, and has BUILD-ACCOUNTS user accounts available under BUILD-USER-GID." (mlet %store-monad ((accounts (guix-build-accounts build-accounts - #:gid build-user-gid))) + #:group builder-group))) (return (service (provision '(guix-daemon)) (requirement '(user-processes)) @@ -274,7 +273,6 @@ BUILD-ACCOUNTS user accounts available under BUILD-USER-GID." (user-accounts accounts) (user-groups (list (user-group (name builder-group) - (id build-user-gid) (members (map user-account-name user-accounts))))))))) diff --git a/gnu/system.scm b/gnu/system.scm index d76c3670f0..bd69532a89 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -224,17 +224,12 @@ explicitly appear in OS." (define* (etc-directory #:key (locale "C") (timezone "Europe/Paris") - (accounts '()) - (groups '()) (pam-services '()) (profile "/var/run/current-system/profile") (sudoers "")) "Return a derivation that builds the static part of the /etc directory." (mlet* %store-monad - ((passwd (passwd-file accounts)) - (shadow (passwd-file accounts #:shadow? #t)) - (group (group-file groups)) - (pam.d (pam-services->directory pam-services)) + ((pam.d (pam-services->directory pam-services)) (sudoers (text-file "sudoers" sudoers)) (login.defs (text-file "login.defs" "# Empty for now.\n")) (shells (text-file "shells" ; used by xterm and others @@ -278,10 +273,6 @@ alias ll='ls -l' ("profile" ,#~#$bashrc) ("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/" #$timezone)) - ("passwd" ,#~#$passwd) - ("shadow" ,#~#$shadow) - ("group" ,#~#$group) - ("sudoers" ,#~#$sudoers))))) (define (operating-system-profile os) @@ -290,18 +281,28 @@ alias ll='ls -l' (union (operating-system-packages os) #:name "default-profile")) +(define %root-account + ;; Default root account. + (user-account + (name "root") + (password "") + (uid 0) (group "root") + (comment "System administrator") + (home-directory "/root"))) + (define (operating-system-accounts os) "Return the user accounts for OS, including an obligatory 'root' account." + (define users + ;; Make sure there's a root account. + (if (find (lambda (user) + (and=> (user-account-uid user) zero?)) + (operating-system-users os)) + (operating-system-users os) + (cons %root-account (operating-system-users os)))) + (mlet %store-monad ((services (operating-system-services os))) - (return (cons (user-account - (name "root") - (password "") - (uid 0) (gid 0) - (comment "System administrator") - (home-directory "/root")) - (append (operating-system-users os) - (append-map service-user-accounts - services)))))) + (return (append users + (append-map service-user-accounts services))))) (define (operating-system-etc-directory os) "Return that static part of the /etc directory of OS." @@ -312,12 +313,8 @@ alias ll='ls -l' (delete-duplicates (append (operating-system-pam-services os) (append-map service-pam-services services)))) - (accounts (operating-system-accounts os)) - (profile-drv (operating-system-profile os)) - (groups -> (append (operating-system-groups os) - (append-map service-user-groups services)))) - (etc-directory #:accounts accounts #:groups groups - #:pam-services pam-services + (profile-drv (operating-system-profile os))) + (etc-directory #:pam-services pam-services #:locale (operating-system-locale os) #:timezone (operating-system-timezone os) #:sudoers (operating-system-sudoers os) @@ -339,6 +336,25 @@ alias ll='ls -l' "root ALL=(ALL) ALL %wheel ALL=(ALL) ALL\n") +(define (user-group->gexp group) + "Turn GROUP, a object, into a list-valued gexp suitable for +'active-groups'." + #~(list #$(user-group-name group) + #$(user-group-password group) + #$(user-group-id group))) + +(define (user-account->gexp account) + "Turn ACCOUNT, a object, into a list-valued gexp suitable for +'activate-users'." + #~`(#$(user-account-name account) + #$(user-account-uid account) + #$(user-account-group account) + #$(user-account-supplementary-groups account) + #$(user-account-comment account) + #$(user-account-home-directory account) + ,#$(user-account-shell account) ; this one is a gexp + #$(user-account-password account))) + (define (operating-system-boot-script os) "Return the boot script for OS---i.e., the code started by the initrd once we're running in the final root." @@ -346,15 +362,25 @@ we're running in the final root." '((guix build activation) (guix build utils))) - (mlet* %store-monad - ((services (operating-system-services os)) - (etc (operating-system-etc-directory os)) - (modules (imported-modules %modules)) - (compiled (compiled-modules %modules)) - (dmd-conf (dmd-configuration-file services))) + (mlet* %store-monad ((services (operating-system-services os)) + (etc (operating-system-etc-directory os)) + (modules (imported-modules %modules)) + (compiled (compiled-modules %modules)) + (dmd-conf (dmd-configuration-file services)) + (accounts (operating-system-accounts os))) (define setuid-progs (operating-system-setuid-programs os)) + (define user-specs + (map user-account->gexp accounts)) + + (define groups + (append (operating-system-groups os) + (append-map service-user-groups services))) + + (define group-specs + (map user-group->gexp groups)) + (gexp->file "boot" #~(begin (eval-when (expand load eval) @@ -368,6 +394,13 @@ we're running in the final root." ;; Populate /etc. (activate-etc #$etc) + ;; Add users and user groups. + (setenv "PATH" + (string-append #$(@ (gnu packages admin) shadow) + "/sbin")) + (activate-users+groups (list #$@user-specs) + (list #$@group-specs)) + ;; Activate setuid programs. (activate-setuid-programs (list #$@setuid-progs)) diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm index 3a43eb45e3..5440f5852f 100644 --- a/gnu/system/linux.scm +++ b/gnu/system/linux.scm @@ -154,11 +154,13 @@ should be the name of a file used as the message-of-the-day." (define* (base-pam-services #:key allow-empty-passwords?) "Return the list of basic PAM services everyone would want." - (list %pam-other-services - (unix-pam-service "su" #:allow-empty-passwords? allow-empty-passwords?) - (unix-pam-service "passwd" - #:allow-empty-passwords? allow-empty-passwords?) - (unix-pam-service "sudo" - #:allow-empty-passwords? allow-empty-passwords?))) + (cons %pam-other-services + (map (cut unix-pam-service <> + #:allow-empty-passwords? allow-empty-passwords?) + '("su" "passwd" "sudo" + "useradd" "userdel" "usermod" + "groupadd" "groupdel" "groupmod" + ;; TODO: Add other Shadow programs? + )))) ;;; linux.scm ends here diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index 52242ee4e0..8745ddb876 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -30,9 +30,10 @@ #:export (user-account user-account? user-account-name - user-account-pass + user-account-password user-account-uid - user-account-gid + user-account-group + user-account-supplementary-groups user-account-comment user-account-home-directory user-account-shell @@ -42,11 +43,7 @@ user-group-name user-group-password user-group-id - user-group-members - - passwd-file - group-file - guix-build-accounts)) + user-group-members)) ;;; Commentary: ;;; @@ -58,9 +55,11 @@ user-account make-user-account user-account? (name user-account-name) - (password user-account-pass (default "")) - (uid user-account-uid) - (gid user-account-gid) + (password user-account-password (default #f)) + (uid user-account-uid (default #f)) + (group user-account-group) ; number | string + (supplementary-groups user-account-supplementary-groups + (default '())) ; list of strings (comment user-account-comment (default "")) (home-directory user-account-home-directory) (shell user-account-shell ; gexp @@ -71,47 +70,7 @@ user-group? (name user-group-name) (password user-group-password (default #f)) - (id user-group-id) + (id user-group-id (default #f)) (members user-group-members (default '()))) -(define (group-file groups) - "Return a /etc/group file for GROUPS, a list of objects." - (define contents - (let loop ((groups groups) - (result '())) - (match groups - ((($ name _ gid (users ...)) rest ...) - ;; XXX: Ignore the group password. - (loop rest - (cons (string-append name "::" (number->string gid) - ":" (string-join users ",")) - result))) - (() - (string-join (reverse result) "\n" 'suffix))))) - - (text-file "group" contents)) - -(define* (passwd-file accounts #:key shadow?) - "Return a password file for ACCOUNTS, a list of objects. If -SHADOW? is true, then it is a /etc/shadow file, otherwise it is a /etc/passwd -file." - ;; XXX: The resulting file is world-readable, so beware when SHADOW? is #t! - (define account-exp - (match-lambda - (($ name pass uid gid comment home-dir shell) - (if shadow? ; XXX: use (crypt PASS …)? - #~(format #t "~a::::::::~%" #$name) - #~(format #t "~a:x:~a:~a:~a:~a:~a~%" - #$name #$(number->string uid) #$(number->string gid) - #$comment #$home-dir #$shell))))) - - (define builder - #~(begin - (with-output-to-file #$output - (lambda () - #$@(map account-exp accounts) - #t)))) - - (gexp->derivation (if shadow? "shadow" "passwd") builder)) - ;;; shadow.scm ends here diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 2520853205..ede7ea7726 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -267,16 +267,6 @@ such as /etc files." (define (operating-system-default-contents os) "Return a list of directives suitable for 'system-qemu-image' describing the basic contents of the root file system of OS." - (define (user-directories user) - (let ((home (user-account-home-directory user)) - ;; XXX: Deal with automatically allocated ids. - (uid (or (user-account-uid user) 0)) - (gid (or (user-account-gid user) 0)) - (root (string-append "/var/guix/profiles/per-user/" - (user-account-name user)))) - #~((directory #$root #$uid #$gid) - (directory #$home #$uid #$gid)))) - (mlet* %store-monad ((os-drv (operating-system-derivation os)) (build-gid (operating-system-build-gid os)) (profile (operating-system-profile os))) @@ -293,9 +283,8 @@ basic contents of the root file system of OS." (directory "/tmp") (directory "/var/guix/profiles/per-user/root" 0 0) - (directory "/root" 0 0) ; an exception - #$@(append-map user-directories - (operating-system-users os)))))) + (directory "/root" 0 0) ; an exception + (directory "/home" 0 0))))) (define* (system-qemu-image os #:key diff --git a/guix/build/activation.scm b/guix/build/activation.scm index f9d9ba5cbd..895f2bca5b 100644 --- a/guix/build/activation.scm +++ b/guix/build/activation.scm @@ -19,8 +19,11 @@ (define-module (guix build activation) #:use-module (guix build utils) #:use-module (ice-9 ftw) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) - #:export (activate-etc + #:export (activate-users+groups + activate-etc activate-setuid-programs)) ;;; Commentary: @@ -31,6 +34,98 @@ ;;; ;;; Code: +(define* (add-group name #:key gid password + (log-port (current-error-port))) + "Add NAME as a user group, with the given numeric GID if specified." + ;; Use 'groupadd' from the Shadow package. + (format log-port "adding group '~a'...~%" name) + (let ((args `(,@(if gid `("-g" ,(number->string gid)) '()) + ,@(if password `("-p" ,password) '()) + ,name))) + (zero? (apply system* "groupadd" args)))) + +(define* (add-user name group + #:key uid comment home shell password + (supplementary-groups '()) + (log-port (current-error-port))) + "Create an account for user NAME part of GROUP, with the specified +properties. Return #t on success." + (format log-port "adding user '~a'...~%" name) + + (if (and uid (zero? uid)) + + ;; 'useradd' fails with "Cannot determine your user name" if the root + ;; account doesn't exist. Thus, for bootstrapping purposes, create that + ;; one manually. + (begin + (call-with-output-file "/etc/shadow" + (cut format <> "~a::::::::~%" name)) + (call-with-output-file "/etc/passwd" + (cut format <> "~a:x:~a:~a:~a:~a:~a~%" + name "0" "0" comment home shell)) + (chmod "/etc/shadow" #o600) + #t) + + ;; Use 'useradd' from the Shadow package. + (let ((args `(,@(if uid `("-u" ,(number->string uid)) '()) + "-g" ,(if (number? group) (number->string group) group) + ,@(if (pair? supplementary-groups) + `("-G" ,(string-join supplementary-groups ",")) + '()) + ,@(if comment `("-c" ,comment) '()) + ,@(if home `("-d" ,home "--create-home") '()) + ,@(if shell `("-s" ,shell) '()) + ,@(if password `("-p" ,password) '()) + ,name))) + (zero? (apply system* "useradd" args))))) + +(define (activate-users+groups users groups) + "Make sure the accounts listed in USERS and the user groups listed in GROUPS +are all available. + +Each item in USERS is a list of all the characteristics of a user account; +each item in GROUPS is a tuple with the group name, group password or #f, and +numeric gid or #f." + (define (touch file) + (call-with-output-file file (const #t))) + + (define activate-user + (match-lambda + ((name uid group supplementary-groups comment home shell password) + (unless (false-if-exception (getpwnam name)) + (let ((profile-dir (string-append "/var/guix/profiles/per-user/" + name))) + (add-user name group + #:uid uid + #:supplementary-groups supplementary-groups + #:comment comment + #:home home + #:shell shell + #:password password) + + ;; Create the profile directory for the new account. + (let ((pw (getpwnam name))) + (mkdir-p profile-dir) + (chown profile-dir (passwd:uid pw) (passwd:gid pw)))))))) + + ;; 'groupadd' aborts if the file doesn't already exist. + (touch "/etc/group") + + ;; Create the root account so we can use 'useradd' and 'groupadd'. + (activate-user (find (match-lambda + ((name (? zero?) _ ...) #t) + (_ #f)) + users)) + + ;; Then create the groups. + (for-each (match-lambda + ((name password gid) + (add-group name #:gid gid #:password password))) + groups) + + ;; Finally create the other user accounts. + (for-each activate-user users)) + (define (activate-etc etc) "Install ETC, a directory in the store, as the source of static files for /etc." -- cgit v1.2.3 From 2717a89a84f9af72f1e0d32d96e192ea088a5124 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 14 May 2014 23:17:03 +0200 Subject: system: Provide declarations for the 'fusectl' and 'binfmt_misc' file systems. * gnu/system.scm (%fuse-control-file-system, %binary-format-file-system): New variables. * build-aux/hydra/demo-os.scm (file-systems): New field. --- build-aux/hydra/demo-os.scm | 5 +++++ gnu/system.scm | 26 +++++++++++++++++++++++++- 2 files changed, 30 insertions(+), 1 deletion(-) (limited to 'build-aux/hydra/demo-os.scm') diff --git a/build-aux/hydra/demo-os.scm b/build-aux/hydra/demo-os.scm index 4116c063f4..fd14bfc7e4 100644 --- a/build-aux/hydra/demo-os.scm +++ b/build-aux/hydra/demo-os.scm @@ -43,6 +43,11 @@ (host-name "gnu") (timezone "Europe/Paris") (locale "en_US.UTF-8") + (file-systems + ;; We don't provide a file system for /, but that's OK because the VM build + ;; code will automatically declare the / file system for us. + (list %fuse-control-file-system + %binary-format-file-system)) (users (list (user-account (name "guest") (group "wheel") diff --git a/gnu/system.scm b/gnu/system.scm index f78df7ce19..9ce94d0230 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -64,7 +64,10 @@ file-system-type file-system-needed-for-boot? file-system-flags - file-system-options)) + file-system-options + + %fuse-control-file-system + %binary-format-file-system)) ;;; Commentary: ;;; @@ -126,6 +129,11 @@ (sudoers operating-system-sudoers ; /etc/sudoers contents (default %sudoers-specification))) + +;;; +;;; File systems. +;;; + ;; File system declaration. (define-record-type* file-system make-file-system @@ -142,6 +150,22 @@ (check? file-system-check? ; Boolean (default #t))) +(define %fuse-control-file-system + ;; Control file system for Linux' file systems in user-space (FUSE). + (file-system + (device "fusectl") + (mount-point "/sys/fs/fuse/connections") + (type "fusectl") + (check? #f))) + +(define %binary-format-file-system + ;; Support for arbitrary executable binary format. + (file-system + (device "binfmt_misc") + (mount-point "/proc/sys/fs/binfmt_misc") + (type "binfmt_misc") + (check? #f))) + ;;; ;;; Derivation. -- cgit v1.2.3 From c336a66fe825e062052f0812cc729c5b04411117 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 15 May 2014 22:47:53 +0200 Subject: build: Remove fusectl from the default file systems in the demo OS. * build-aux/hydra/demo-os.scm (file-systems): Comment out %FUSE-CONTROL-FILE-SYSTEM, since fuse.ko is missing by default in the freestanding VM image. --- build-aux/hydra/demo-os.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'build-aux/hydra/demo-os.scm') diff --git a/build-aux/hydra/demo-os.scm b/build-aux/hydra/demo-os.scm index fd14bfc7e4..e36a9ca17d 100644 --- a/build-aux/hydra/demo-os.scm +++ b/build-aux/hydra/demo-os.scm @@ -46,7 +46,7 @@ (file-systems ;; We don't provide a file system for /, but that's OK because the VM build ;; code will automatically declare the / file system for us. - (list %fuse-control-file-system + (list ;; %fuse-control-file-system ; needs fuse.ko %binary-format-file-system)) (users (list (user-account (name "guest") -- cgit v1.2.3 From d216323f0ae66f9e95cfd370318a2231d0845981 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 16 May 2014 21:57:11 +0200 Subject: hydra: Add dummy root file system declaration. * build-aux/hydra/demo-os.scm (file-systems): Add "/" file system. --- build-aux/hydra/demo-os.scm | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'build-aux/hydra/demo-os.scm') diff --git a/build-aux/hydra/demo-os.scm b/build-aux/hydra/demo-os.scm index e36a9ca17d..32c6fa3abf 100644 --- a/build-aux/hydra/demo-os.scm +++ b/build-aux/hydra/demo-os.scm @@ -44,9 +44,13 @@ (timezone "Europe/Paris") (locale "en_US.UTF-8") (file-systems - ;; We don't provide a file system for /, but that's OK because the VM build + ;; We provide a dummy file system for /, but that's OK because the VM build ;; code will automatically declare the / file system for us. - (list ;; %fuse-control-file-system ; needs fuse.ko + (list (file-system + (mount-point "/") + (device "dummy") + (type "dummy")) + ;; %fuse-control-file-system ; needs fuse.ko %binary-format-file-system)) (users (list (user-account (name "guest") -- cgit v1.2.3 From d5b429abda948c21a61032a1da9d472410edaa90 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 18 May 2014 21:58:01 +0200 Subject: system: Add 'grub-configuration' record. * gnu/system/grub.scm (): New record type. (grub-configuration-file): Add 'config' parameter; remove #:default-entry and #:timeout. Honor CONFIG. * gnu/system.scm (): Remove 'bootloader-entries' field; remove default value for 'bootloader' field. (operating-system-grub.cfg): Pass the 'bootloader' field to 'grub-configuration-file'. * build-aux/hydra/demo-os.scm (bootloader): New field. --- build-aux/hydra/demo-os.scm | 3 +++ gnu/system.scm | 11 +++++------ gnu/system/grub.scm | 39 ++++++++++++++++++++++++++++++--------- 3 files changed, 38 insertions(+), 15 deletions(-) (limited to 'build-aux/hydra/demo-os.scm') diff --git a/build-aux/hydra/demo-os.scm b/build-aux/hydra/demo-os.scm index 32c6fa3abf..fe9c77242e 100644 --- a/build-aux/hydra/demo-os.scm +++ b/build-aux/hydra/demo-os.scm @@ -33,6 +33,7 @@ (gnu packages tor) (gnu packages package-management) + (gnu system grub) ; 'grub-configuration' (gnu system shadow) ; 'user-account' (gnu system linux) ; 'base-pam-services' (gnu services base) @@ -43,6 +44,8 @@ (host-name "gnu") (timezone "Europe/Paris") (locale "en_US.UTF-8") + (bootloader (grub-configuration + (device "/dev/sda"))) (file-systems ;; We provide a dummy file system for /, but that's OK because the VM build ;; code will automatically declare the / file system for us. diff --git a/gnu/system.scm b/gnu/system.scm index ec3e2fcd6c..dd44878462 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -39,10 +39,11 @@ #:use-module (srfi srfi-26) #:export (operating-system operating-system? + + operating-system-bootloader operating-system-services operating-system-user-services operating-system-packages - operating-system-bootloader-entries operating-system-host-name operating-system-kernel operating-system-initrd @@ -83,10 +84,8 @@ operating-system? (kernel operating-system-kernel ; package (default linux-libre)) - (bootloader operating-system-bootloader ; package - (default grub)) - (bootloader-entries operating-system-bootloader-entries ; list - (default '())) + (bootloader operating-system-bootloader) ; + (initrd operating-system-initrd ; (list fs) -> M derivation (default qemu-initrd)) @@ -504,7 +503,7 @@ we're running in the final root." #~(string-append "--load=" #$system "/boot"))) (initrd #~(string-append #$system "/initrd")))))) - (grub-configuration-file entries))) + (grub-configuration-file (operating-system-bootloader os) entries))) (define (operating-system-derivation os) "Return a derivation that builds OS." diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index 1893672a2a..e789e4c591 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -25,8 +25,13 @@ #:use-module (guix gexp) #:use-module (ice-9 match) #:use-module (srfi srfi-1) - #:export (menu-entry + #:export (grub-configuration + grub-configuration? + grub-configuration-device + + menu-entry menu-entry? + grub-configuration-file)) ;;; Commentary: @@ -35,6 +40,19 @@ ;;; ;;; Code: +(define-record-type* + grub-configuration make-grub-configuration + grub-configuration? + (grub grub-configuration-grub ; package + (default (@ (gnu packages grub) grub))) + (device grub-configuration-device) ; string + (menu-entries grub-configuration-menu-entries ; list + (default '())) + (default-entry grub-configuration-default-entry ; integer + (default 1)) + (timeout grub-configuration-timeout ; integer + (default 5))) + (define-record-type* menu-entry make-menu-entry menu-entry? @@ -44,11 +62,13 @@ (default '())) ; list of string-valued gexps (initrd menu-entry-initrd)) ; file name of the initrd as a gexp -(define* (grub-configuration-file entries - #:key (default-entry 1) (timeout 5) - (system (%current-system))) - "Return the GRUB configuration file for ENTRIES, a list of - objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT." +(define* (grub-configuration-file config entries + #:key (system (%current-system))) + "Return the GRUB configuration file corresponding to CONFIG, a + object." + (define all-entries + (append entries (grub-configuration-menu-entries config))) + (define entry->gexp (match-lambda (($ label linux arguments initrd) @@ -67,12 +87,13 @@ set default=~a set timeout=~a search.file ~a/bzImage~%" - #$default-entry #$timeout + #$(grub-configuration-default-entry config) + #$(grub-configuration-timeout config) #$(any (match-lambda (($ _ linux) linux)) - entries)) - #$@(map entry->gexp entries)))) + all-entries)) + #$@(map entry->gexp all-entries)))) (gexp->derivation "grub.cfg" builder)) -- cgit v1.2.3 From c5df183956016cf3205971f4fa30aa834dca3281 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 20 May 2014 21:59:08 +0200 Subject: Add (gnu system file-systems). This fixes a circular dependency between (gnu system) and (gnu system linux-initrd), where the latter could end up being compiled before 'file-system-type' was defined as a macro. * gnu/system.scm (, %fuse-control-file-system, %binary-format-file-system): Move to... * gnu/system/file-systems.scm: ... here. New file. * build-aux/hydra/demo-os.scm, gnu/system/linux-initrd.scm, gnu/system/vm.scm: Use it. * gnu-system.am (GNU_SYSTEM_MODULES): Add it. --- build-aux/hydra/demo-os.scm | 2 ++ gnu-system.am | 1 + gnu/system.scm | 53 ++------------------------------- gnu/system/file-systems.scm | 72 +++++++++++++++++++++++++++++++++++++++++++++ gnu/system/linux-initrd.scm | 2 +- gnu/system/vm.scm | 1 + 6 files changed, 79 insertions(+), 52 deletions(-) create mode 100644 gnu/system/file-systems.scm (limited to 'build-aux/hydra/demo-os.scm') diff --git a/build-aux/hydra/demo-os.scm b/build-aux/hydra/demo-os.scm index fe9c77242e..5f0fd6a6f8 100644 --- a/build-aux/hydra/demo-os.scm +++ b/build-aux/hydra/demo-os.scm @@ -36,6 +36,8 @@ (gnu system grub) ; 'grub-configuration' (gnu system shadow) ; 'user-account' (gnu system linux) ; 'base-pam-services' + (gnu system file-systems) ; 'file-systems' + (gnu services base) (gnu services networking) (gnu services xorg)) diff --git a/gnu-system.am b/gnu-system.am index 66d54cba95..84a5e939f4 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -248,6 +248,7 @@ GNU_SYSTEM_MODULES = \ gnu/services/xorg.scm \ \ gnu/system.scm \ + gnu/system/file-systems.scm \ gnu/system/grub.scm \ gnu/system/linux.scm \ gnu/system/linux-initrd.scm \ diff --git a/gnu/system.scm b/gnu/system.scm index dd44878462..6cb7d303db 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -34,6 +34,7 @@ #:use-module (gnu system shadow) #:use-module (gnu system linux) #:use-module (gnu system linux-initrd) + #:use-module (gnu system file-systems) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) @@ -56,20 +57,7 @@ operating-system-derivation operating-system-profile - operating-system-grub.cfg - - - file-system - file-system? - file-system-device - file-system-mount-point - file-system-type - file-system-needed-for-boot? - file-system-flags - file-system-options - - %fuse-control-file-system - %binary-format-file-system)) + operating-system-grub.cfg)) ;;; Commentary: ;;; @@ -129,43 +117,6 @@ (sudoers operating-system-sudoers ; /etc/sudoers contents (default %sudoers-specification))) - -;;; -;;; File systems. -;;; - -;; File system declaration. -(define-record-type* file-system - make-file-system - file-system? - (device file-system-device) ; string - (mount-point file-system-mount-point) ; string - (type file-system-type) ; string - (flags file-system-flags ; list of symbols - (default '())) - (options file-system-options ; string or #f - (default #f)) - (needed-for-boot? file-system-needed-for-boot? ; Boolean - (default #f)) - (check? file-system-check? ; Boolean - (default #t))) - -(define %fuse-control-file-system - ;; Control file system for Linux' file systems in user-space (FUSE). - (file-system - (device "fusectl") - (mount-point "/sys/fs/fuse/connections") - (type "fusectl") - (check? #f))) - -(define %binary-format-file-system - ;; Support for arbitrary executable binary format. - (file-system - (device "binfmt_misc") - (mount-point "/proc/sys/fs/binfmt_misc") - (type "binfmt_misc") - (check? #f))) - ;;; ;;; Derivation. diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm new file mode 100644 index 0000000000..485150ea51 --- /dev/null +++ b/gnu/system/file-systems.scm @@ -0,0 +1,72 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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. +;;; +;;; GNU Guix 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 GNU Guix. If not, see . + +(define-module (gnu system file-systems) + #:use-module (guix records) + #:export ( + file-system + file-system? + file-system-device + file-system-mount-point + file-system-type + file-system-needed-for-boot? + file-system-flags + file-system-options + + %fuse-control-file-system + %binary-format-file-system)) + +;;; Commentary: +;;; +;;; Declaring file systems to be mounted. +;;; +;;; Code: + +;; File system declaration. +(define-record-type* file-system + make-file-system + file-system? + (device file-system-device) ; string + (mount-point file-system-mount-point) ; string + (type file-system-type) ; string + (flags file-system-flags ; list of symbols + (default '())) + (options file-system-options ; string or #f + (default #f)) + (needed-for-boot? file-system-needed-for-boot? ; Boolean + (default #f)) + (check? file-system-check? ; Boolean + (default #t))) + +(define %fuse-control-file-system + ;; Control file system for Linux' file systems in user-space (FUSE). + (file-system + (device "fusectl") + (mount-point "/sys/fs/fuse/connections") + (type "fusectl") + (check? #f))) + +(define %binary-format-file-system + ;; Support for arbitrary executable binary format. + (file-system + (device "binfmt_misc") + (mount-point "/proc/sys/fs/binfmt_misc") + (type "binfmt_misc") + (check? #f))) + +;;; file-systems.scm ends here diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 749dfa313f..03199e0c39 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -30,7 +30,7 @@ #:use-module (gnu packages guile) #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) - #:use-module (gnu system) ; for 'file-system' + #:use-module (gnu system file-systems) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (srfi srfi-1) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index ee9ac81ce7..0d41791d87 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -42,6 +42,7 @@ #:use-module (gnu system linux) #:use-module (gnu system linux-initrd) #:use-module (gnu system grub) + #:use-module (gnu system file-systems) #:use-module (gnu system) #:use-module (gnu services) -- cgit v1.2.3 From c9384945984c393ef1a15efb5c07e272a27a2215 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 22 May 2014 23:20:12 +0200 Subject: Add (gnu) module. * gnu.scm: New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add it. * build-aux/hydra/demo-os.scm: Use (gnu) and strip import list accordingly. * doc/guix.texi (Using the Configuration System): Adjust example accordingly. --- build-aux/hydra/demo-os.scm | 11 +++-------- doc/guix.texi | 3 +-- gnu-system.am | 1 + gnu.scm | 46 +++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 51 insertions(+), 10 deletions(-) create mode 100644 gnu.scm (limited to 'build-aux/hydra/demo-os.scm') diff --git a/build-aux/hydra/demo-os.scm b/build-aux/hydra/demo-os.scm index 5f0fd6a6f8..863371291e 100644 --- a/build-aux/hydra/demo-os.scm +++ b/build-aux/hydra/demo-os.scm @@ -22,9 +22,10 @@ ;;; machine images that we build. ;;; -(use-modules (gnu packages zile) +(use-modules (gnu) + + (gnu packages zile) (gnu packages xorg) - (gnu packages base) (gnu packages admin) (gnu packages guile) (gnu packages bash) @@ -33,12 +34,6 @@ (gnu packages tor) (gnu packages package-management) - (gnu system grub) ; 'grub-configuration' - (gnu system shadow) ; 'user-account' - (gnu system linux) ; 'base-pam-services' - (gnu system file-systems) ; 'file-systems' - - (gnu services base) (gnu services networking) (gnu services xorg)) diff --git a/doc/guix.texi b/doc/guix.texi index 57c9e4e52a..edb1dceeab 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3109,9 +3109,8 @@ Linux-Libre kernel, initial RAM disk, and boot loader looks like this: @findex operating-system @lisp -(use-modules (gnu services base) ; for '%base-services' +(use-modules (gnu) ; for 'user-account', '%base-services', etc. (gnu services ssh) ; for 'lsh-service' - (gnu system shadow) ; for 'user-account' (gnu packages base) ; Coreutils, grep, etc. (gnu packages bash) ; Bash (gnu packages admin) ; dmd, Inetutils diff --git a/gnu-system.am b/gnu-system.am index 84a5e939f4..314db3e536 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -22,6 +22,7 @@ # binaries. GNU_SYSTEM_MODULES = \ + gnu.scm \ gnu/packages.scm \ gnu/packages/acct.scm \ gnu/packages/acl.scm \ diff --git a/gnu.scm b/gnu.scm new file mode 100644 index 0000000000..e573de6531 --- /dev/null +++ b/gnu.scm @@ -0,0 +1,46 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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. +;;; +;;; GNU Guix 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 GNU Guix. If not, see . + +(define-module (gnu)) + +;;; Commentary: +;;; +;;; This composite module re-exports core parts the (gnu …) public modules. +;;; +;;; Code: + +(eval-when (eval load compile) + (begin + (define %public-modules + '((gnu system) + (gnu system file-systems) + (gnu system grub) ; 'grub-configuration' + (gnu system linux) ; 'base-pam-services' + (gnu system shadow) ; 'user-account' + (gnu system linux-initrd) + (gnu services) + (gnu services base) + (gnu packages) + (gnu packages base))) + + (for-each (let ((i (module-public-interface (current-module)))) + (lambda (m) + (module-use! i (resolve-interface m)))) + %public-modules))) + +;;; gnu.scm ends here -- cgit v1.2.3