gnu/system/linux.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu system linux)
  20   #:use-module (guix store)
  21   #:use-module (guix records)
  22   #:use-module (guix derivations)
  23   #:use-module (guix monads)
  24   #:use-module (guix gexp)
  25   #:use-module (ice-9 match)
  26   #:use-module (srfi srfi-1)
  27   #:use-module (srfi srfi-26)
  28   #:use-module ((guix utils) #:select (%current-system))
  29   #:export (pam-service
  30             pam-entry
  31             pam-services->directory
  32             unix-pam-service
  33             base-pam-services))
  34
  35 ;;; Commentary:
  36 ;;;
  37 ;;; Configuration of Linux-related things, including pluggable authentication
  38 ;;; modules (PAM).
  39 ;;;
  40 ;;; Code:
  41
  42 ;; PAM services (see
  43 ;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-file.html>.)
  44 (define-record-type* <pam-service> pam-service
  45   make-pam-service
  46   pam-service?
  47   (name       pam-service-name)                   ; string
  48
  49   ;; The four "management groups".
  50   (account    pam-service-account                 ; list of <pam-entry>
  51               (default '()))
  52   (auth       pam-service-auth
  53               (default '()))
  54   (password   pam-service-password
  55               (default '()))
  56   (session    pam-service-session
  57               (default '())))
  58
  59 (define-record-type* <pam-entry> pam-entry
  60   make-pam-entry
  61   pam-entry?
  62   (control    pam-entry-control)         ; string
  63   (module     pam-entry-module)          ; file name
  64   (arguments  pam-entry-arguments        ; list of string-valued g-expressions
  65               (default '())))
  66
  67 (define (pam-service->configuration service)
  68   "Return the derivation building the configuration file for SERVICE, to be
  69 dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE."
  70   (define (entry->gexp type entry)
  71     (match entry
  72       (($ <pam-entry> control module (arguments ...))
  73        #~(format #t "~a ~a ~a ~a~%"
  74                  #$type #$control #$module
  75                  (string-join (list #$@arguments))))))
  76
  77   (match service
  78     (($ <pam-service> name account auth password session)
  79      (define builder
  80        #~(begin
  81            (with-output-to-file #$output
  82              (lambda ()
  83                #$@(append (map (cut entry->gexp "account" <>) account)
  84                           (map (cut entry->gexp "auth" <>) auth)
  85                           (map (cut entry->gexp "password" <>) password)
  86                           (map (cut entry->gexp "session" <>) session))
  87                #t))))
  88
  89      (gexp->derivation name builder))))
  90
  91 (define (pam-services->directory services)
  92   "Return the derivation to build the configuration directory to be used as
  93 /etc/pam.d for SERVICES."
  94   (mlet %store-monad
  95       ((names -> (map pam-service-name services))
  96        (files (sequence %store-monad
  97                         (map pam-service->configuration
  98                              ;; XXX: Eventually, SERVICES may be a list of
  99                              ;; monadic values instead of plain values.
 100                              services))))
 101     (define builder
 102       #~(begin
 103           (use-modules (ice-9 match))
 104
 105           (mkdir #$output)
 106           (for-each (match-lambda
 107                      ((name file)
 108                       (symlink file (string-append #$output "/" name))))
 109                     '#$(zip names files))))
 110
 111     (gexp->derivation "pam.d" builder)))
 112
 113 (define %pam-other-services
 114   ;; The "other" PAM configuration, which denies everything (see
 115   ;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.)
 116   (let ((deny (pam-entry
 117                (control "required")
 118                (module "pam_deny.so"))))
 119     (pam-service
 120      (name "other")
 121      (account (list deny))
 122      (auth (list deny))
 123      (password (list deny))
 124      (session (list deny)))))
 125
 126 (define unix-pam-service
 127   (let ((unix (pam-entry
 128                (control "required")
 129                (module "pam_unix.so"))))
 130     (lambda* (name #:key allow-empty-passwords? motd)
 131       "Return a standard Unix-style PAM service for NAME.  When
 132 ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords.  When MOTD is true, it
 133 should be the name of a file used as the message-of-the-day."
 134       ;; See <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.
 135       (let ((name* name))
 136         (pam-service
 137          (name name*)
 138          (account (list unix))
 139          (auth (list (if allow-empty-passwords?
 140                          (pam-entry
 141                           (control "required")
 142                           (module "pam_unix.so")
 143                           (arguments '("nullok")))
 144                          unix)))
 145          (password (list unix))
 146          (session (if motd
 147                       (list unix
 148                             (pam-entry
 149                              (control "optional")
 150                              (module "pam_motd.so")
 151                              (arguments
 152                               (list #~(string-append "motd=" #$motd)))))
 153                       (list unix))))))))
 154
 155 (define* (base-pam-services #:key allow-empty-passwords?)
 156   "Return the list of basic PAM services everyone would want."
 157   (cons %pam-other-services
 158         (map (cut unix-pam-service <>
 159                   #:allow-empty-passwords? allow-empty-passwords?)
 160              '("su" "passwd" "sudo"
 161                "useradd" "userdel" "usermod"
 162                "groupadd" "groupdel" "groupmod"
 163                ;; TODO: Add other Shadow programs?
 164                ))))
 165
 166 ;;; linux.scm ends here