aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--build-aux/hydra/demo-os.scm4
-rw-r--r--gnu/system.scm33
-rw-r--r--gnu/system/linux.scm11
-rw-r--r--guix/build/activation.scm36
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