summary refs log tree commit diff
path: root/gnu/system/pam.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-11-03 18:08:47 +0100
committerLudovic Courtès <ludo@gnu.org>2015-11-03 18:11:45 +0100
commit6e82863463c641571e852291481e2b64401c2fe2 (patch)
tree9deeba90a72e3d931e85d46e875409ab0a900db1 /gnu/system/pam.scm
parent1c52181f33ec6c2b91f1361f7251769dd29c6ef2 (diff)
downloadguix-6e82863463c641571e852291481e2b64401c2fe2.tar.gz
system: Rename (gnu system linux) to (gnu system pam).
* gnu/system/linux.scm: Rename to...
* gnu/system/pam.scm: ... this.
* gnu-system.am (GNU_SYSTEM_MODULES): Adjust accordingly.
* gnu.scm, gnu/services/base.scm, gnu/services/desktop.scm,
  gnu/services/networking.scm, gnu/services/ssh.scm,
  gnu/services/xorg.scm, gnu/system.scm, gnu/system/vm.scm: Likewise.
Diffstat (limited to 'gnu/system/pam.scm')
-rw-r--r--gnu/system/pam.scm213
1 files changed, 213 insertions, 0 deletions
diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm
new file mode 100644
index 0000000000..d8470f02a3
--- /dev/null
+++ b/gnu/system/pam.scm
@@ -0,0 +1,213 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system pam)
+  #:use-module (guix records)
+  #:use-module (guix derivations)
+  #:use-module (guix gexp)
+  #:use-module (gnu services)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module ((guix utils) #:select (%current-system))
+  #:export (pam-service
+            pam-entry
+            pam-services->directory
+            unix-pam-service
+            base-pam-services
+
+            pam-root-service-type
+            pam-root-service))
+
+;;; Commentary:
+;;;
+;;; Configuration of the pluggable authentication modules (PAM).
+;;;
+;;; Code:
+
+;; PAM services (see
+;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-file.html>.)
+(define-record-type* <pam-service> pam-service
+  make-pam-service
+  pam-service?
+  (name       pam-service-name)                   ; string
+
+  ;; The four "management groups".
+  (account    pam-service-account                 ; list of <pam-entry>
+              (default '()))
+  (auth       pam-service-auth
+              (default '()))
+  (password   pam-service-password
+              (default '()))
+  (session    pam-service-session
+              (default '())))
+
+(define-record-type* <pam-entry> pam-entry
+  make-pam-entry
+  pam-entry?
+  (control    pam-entry-control)         ; string
+  (module     pam-entry-module)          ; file name
+  (arguments  pam-entry-arguments        ; list of string-valued g-expressions
+              (default '())))
+
+(define (pam-service->configuration service)
+  "Return the derivation building the configuration file for SERVICE, to be
+dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE."
+  (define (entry->gexp type entry)
+    (match entry
+      (($ <pam-entry> control module (arguments ...))
+       #~(format #t "~a ~a ~a ~a~%"
+                 #$type #$control #$module
+                 (string-join (list #$@arguments))))))
+
+  (match service
+    (($ <pam-service> name account auth password session)
+     (define builder
+       #~(begin
+           (with-output-to-file #$output
+             (lambda ()
+               #$@(append (map (cut entry->gexp "account" <>) account)
+                          (map (cut entry->gexp "auth" <>) auth)
+                          (map (cut entry->gexp "password" <>) password)
+                          (map (cut entry->gexp "session" <>) session))
+               #t))))
+
+     (computed-file name builder))))
+
+(define (pam-services->directory services)
+  "Return the derivation to build the configuration directory to be used as
+/etc/pam.d for SERVICES."
+  (let ((names (map pam-service-name services))
+        (files (map pam-service->configuration services)))
+    (define builder
+      #~(begin
+          (use-modules (ice-9 match)
+                       (srfi srfi-1))
+
+          (mkdir #$output)
+          (for-each (match-lambda
+                      ((name file)
+                       (symlink file (string-append #$output "/" name))))
+
+                    ;; Since <pam-service> objects cannot be compared with
+                    ;; 'equal?' since they contain gexps, which contain
+                    ;; closures, use 'delete-duplicates' on the build-side
+                    ;; instead.  See <http://bugs.gnu.org/20037>.
+                    (delete-duplicates '#$(zip names files)))))
+
+    (computed-file "pam.d" builder)))
+
+(define %pam-other-services
+  ;; The "other" PAM configuration, which denies everything (see
+  ;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.)
+  (let ((deny (pam-entry
+               (control "required")
+               (module "pam_deny.so"))))
+    (pam-service
+     (name "other")
+     (account (list deny))
+     (auth (list deny))
+     (password (list deny))
+     (session (list deny)))))
+
+(define unix-pam-service
+  (let ((unix (pam-entry
+               (control "required")
+               (module "pam_unix.so"))))
+    (lambda* (name #:key allow-empty-passwords? motd)
+      "Return a standard Unix-style PAM service for NAME.  When
+ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords.  When MOTD is true, it
+should be a file-like object used as the message-of-the-day."
+      ;; See <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.
+      (let ((name* name))
+        (pam-service
+         (name name*)
+         (account (list unix))
+         (auth (list (if allow-empty-passwords?
+                         (pam-entry
+                          (control "required")
+                          (module "pam_unix.so")
+                          (arguments '("nullok")))
+                         unix)))
+         (password (list (pam-entry
+                          (control "required")
+                          (module "pam_unix.so")
+                          ;; Store SHA-512 encrypted passwords in /etc/shadow.
+                          (arguments '("sha512" "shadow")))))
+         (session (if motd
+                      (list unix
+                            (pam-entry
+                             (control "optional")
+                             (module "pam_motd.so")
+                             (arguments
+                              (list #~(string-append "motd=" #$motd)))))
+                      (list unix))))))))
+
+(define (rootok-pam-service command)
+  "Return a PAM service for COMMAND such that 'root' does not need to
+authenticate to run COMMAND."
+  (let ((unix (pam-entry
+               (control "required")
+               (module "pam_unix.so"))))
+    (pam-service
+     (name command)
+     (account (list unix))
+     (auth (list (pam-entry
+                  (control "sufficient")
+                  (module "pam_rootok.so"))))
+     (password (list unix))
+     (session (list unix)))))
+
+(define* (base-pam-services #:key allow-empty-passwords?)
+  "Return the list of basic PAM services everyone would want."
+  ;; TODO: Add other Shadow programs?
+  (append (list %pam-other-services)
+
+          ;; These programs are setuid-root.
+          (map (cut unix-pam-service <>
+                    #:allow-empty-passwords? allow-empty-passwords?)
+               '("su" "passwd" "sudo"))
+
+          ;; These programs are not setuid-root, and we want root to be able
+          ;; to run them without having to authenticate (notably because
+          ;; 'useradd' and 'groupadd' are run during system activation.)
+          (map rootok-pam-service
+               '("useradd" "userdel" "usermod"
+                 "groupadd" "groupdel" "groupmod"))))
+
+
+;;;
+;;; PAM root service.
+;;;
+
+(define (/etc-entry services)
+  `(("pam.d" ,(pam-services->directory services))))
+
+(define pam-root-service-type
+  (service-type (name 'pam)
+                (extensions (list (service-extension etc-service-type
+                                                     /etc-entry)))
+                (compose concatenate)
+                (extend append)))
+
+(define (pam-root-service base)
+  "The \"root\" PAM service, which collects <pam-service> instance and turns
+them into a /etc/pam.d directory, including the <pam-service> listed in BASE."
+  (service pam-root-service-type base))
+
+;;; linux.scm ends here