diff options
| -rw-r--r-- | build-aux/hydra/demo-os.scm | 4 | ||||
| -rw-r--r-- | gnu/system.scm | 33 | ||||
| -rw-r--r-- | gnu/system/linux.scm | 11 | ||||
| -rw-r--r-- | guix/build/activation.scm | 36 |
4 files changed, 76 insertions, 8 deletions
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 diff --git a/gnu/system.scm b/gnu/system.scm index 4a85857582..ba105e2df1 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -106,7 +106,12 @@ (locale operating-system-locale) ; string (services operating-system-services ; list of monadic services - (default %base-services))) + (default %base-services)) + + (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 @@ -191,6 +196,7 @@ export TZ=\"" timezone "\" export TZDIR=\"" tzdata "/share/zoneinfo\" export PATH=$HOME/.guix-profile/bin:" profile "/bin:" profile "/sbin +export PATH=/run/setuid-programs:$PATH export CPATH=$HOME/.guix-profile/include:" profile "/include export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib alias ls='ls -p --color' @@ -238,8 +244,8 @@ alias ll='ls -l' (pam-services -> ;; Services known to PAM. (delete-duplicates - (cons %pam-other-services - (append-map service-pam-services services)))) + (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) @@ -250,15 +256,29 @@ alias ll='ls -l' #:timezone (operating-system-timezone os) #:profile profile-drv))) +(define %setuid-programs + ;; Default set of setuid-root programs. + (let ((shadow (@ (gnu packages admin) shadow))) + (list #~(string-append #$shadow "/bin/passwd") + #~(string-append #$shadow "/bin/su") + #~(string-append #$inetutils "/bin/ping")))) + (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." + (define %modules + '((guix build activation) + (guix build utils))) + (mlet* %store-monad ((services (sequence %store-monad (operating-system-services os))) (etc (operating-system-etc-directory os)) - (modules (imported-modules '((guix build activation)))) - (compiled (compiled-modules '((guix build activation)))) + (modules (imported-modules %modules)) + (compiled (compiled-modules %modules)) (dmd-conf (dmd-configuration-file services))) + (define setuid-progs + (operating-system-setuid-programs os)) + (gexp->file "boot" #~(begin (eval-when (expand load eval) @@ -272,6 +292,9 @@ we're running in the final root." ;; Populate /etc. (activate-etc #$etc) + ;; Activate setuid programs. + (activate-setuid-programs (list #$@setuid-progs)) + ;; Start dmd. (execl (string-append #$dmd "/bin/dmd") "dmd" "--config" #$dmd-conf))))) diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm index efe27c55c3..4030d8860e 100644 --- a/gnu/system/linux.scm +++ b/gnu/system/linux.scm @@ -29,8 +29,8 @@ #:export (pam-service pam-entry pam-services->directory - %pam-other-services - unix-pam-service)) + unix-pam-service + base-pam-services)) ;;; Commentary: ;;; @@ -152,4 +152,11 @@ should be the name of a file used as the message-of-the-day." (list #~(string-append "motd=" #$motd))))) (list unix)))))))) +(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?))) + ;;; linux.scm ends here diff --git a/guix/build/activation.scm b/guix/build/activation.scm index c8491677d3..6930a8c585 100644 --- a/guix/build/activation.scm +++ b/guix/build/activation.scm @@ -17,8 +17,10 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix build activation) + #:use-module (guix build utils) #:use-module (ice-9 ftw) - #:export (activate-etc)) + #:export (activate-etc + activate-setuid-programs)) ;;; Commentary: ;;; @@ -60,4 +62,36 @@ (rm-f "/var/guix/gcroots/etc-directory") (symlink etc "/var/guix/gcroots/etc-directory"))) +(define %setuid-directory + ;; Place where setuid programs are stored. + "/run/setuid-programs") + +(define (activate-setuid-programs programs) + "Turn PROGRAMS, a list of file names, into setuid programs stored under +%SETUID-DIRECTORY." + (define (make-setuid-program prog) + (let ((target (string-append %setuid-directory + "/" (basename prog)))) + (catch 'system-error + (lambda () + (link prog target)) + (lambda args + ;; Perhaps PROG and TARGET live in a different file system, so copy + ;; PROG. + (copy-file prog target))) + (chown target 0 0) + (chmod target #o6555))) + + (format #t "setting up setuid programs in '~a'...~%" + %setuid-directory) + (if (file-exists? %setuid-directory) + (for-each delete-file + (scandir %setuid-directory + (lambda (file) + (not (member file '("." "..")))) + string<?)) + (mkdir-p %setuid-directory)) + + (for-each make-setuid-program programs)) + ;;; activation.scm ends here |