From 696893801c9d4b83adc9a15ce60103142e7c1a79 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 1 May 2014 15:29:24 +0200
Subject: system: Add 'sudo' to the setuid programs, and handle /etc/sudoers.

* gnu/system.scm (<operating-system>)[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(-)

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
+  ;; <http://www.sudo.ws/sudo/man/1.8.10/sudoers.man.html>.
+  ;; 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