gnu/system/pam.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016 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 pam)
  20   #:use-module (guix records)
  21   #:use-module (guix derivations)
  22   #:use-module (guix gexp)
  23   #:use-module (gnu services)
  24   #:use-module (ice-9 match)
  25   #:use-module (srfi srfi-1)
  26   #:use-module (srfi srfi-9)
  27   #:use-module (srfi srfi-11)
  28   #:use-module (srfi srfi-26)
  29   #:use-module ((guix utils) #:select (%current-system))
  30   #:export (pam-service
  31             pam-service-name
  32             pam-service-account
  33             pam-service-auth
  34             pam-service-password
  35             pam-service-session
  36
  37             pam-entry
  38             pam-entry-control
  39             pam-entry-module
  40             pam-entry-arguments
  41
  42             pam-limits-entry
  43             pam-limits-entry-domain
  44             pam-limits-entry-type
  45             pam-limits-entry-item
  46             pam-limits-entry-value
  47             pam-limits-entry->string
  48
  49             pam-services->directory
  50             unix-pam-service
  51             base-pam-services
  52
  53             pam-root-service-type
  54             pam-root-service))
  55
  56 ;;; Commentary:
  57 ;;;
  58 ;;; Configuration of the pluggable authentication modules (PAM).
  59 ;;;
  60 ;;; Code:
  61
  62 ;; PAM services (see
  63 ;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-file.html>.)
  64 (define-record-type* <pam-service> pam-service
  65   make-pam-service
  66   pam-service?
  67   (name       pam-service-name)                   ; string
  68
  69   ;; The four "management groups".
  70   (account    pam-service-account                 ; list of <pam-entry>
  71               (default '()))
  72   (auth       pam-service-auth
  73               (default '()))
  74   (password   pam-service-password
  75               (default '()))
  76   (session    pam-service-session
  77               (default '())))
  78
  79 (define-record-type* <pam-entry> pam-entry
  80   make-pam-entry
  81   pam-entry?
  82   (control    pam-entry-control)         ; string
  83   (module     pam-entry-module)          ; file name
  84   (arguments  pam-entry-arguments        ; list of string-valued g-expressions
  85               (default '())))
  86
  87 ;; PAM limits entries are used by the pam_limits PAM module to set or override
  88 ;; limits on system resources for user sessions.  The format is specified
  89 ;; here: http://linux-pam.org/Linux-PAM-html/sag-pam_limits.html
  90 (define-record-type <pam-limits-entry>
  91   (make-pam-limits-entry domain type item value)
  92   pam-limits-entry?
  93   (domain     pam-limits-entry-domain)   ; string
  94   (type       pam-limits-entry-type)     ; symbol
  95   (item       pam-limits-entry-item)     ; symbol
  96   (value      pam-limits-entry-value))   ; symbol or number
  97
  98 (define (pam-limits-entry domain type item value)
  99   "Construct a pam-limits-entry ensuring that the provided values are valid."
 100   (define (valid? value)
 101     (case item
 102       ((priority) (number? value))
 103       ((nice)     (and (number? value)
 104                        (>= value -20)
 105                        (<= value 19)))
 106       (else       (or (and (number? value)
 107                            (>= value -1))
 108                       (member value '(unlimited infinity))))))
 109   (define items
 110     (list 'core      'data       'fsize
 111           'memlock   'nofile     'rss
 112           'stack     'cpu        'nproc
 113           'as        'maxlogins  'maxsyslogins
 114           'priority  'locks      'sigpending
 115           'msgqueue  'nice       'rtprio))
 116   (when (not (member type '(hard soft both)))
 117     (error "invalid limit type" type))
 118   (when (not (member item items))
 119     (error "invalid limit item" item))
 120   (when (not (valid? value))
 121     (error "invalid limit value" value))
 122   (make-pam-limits-entry domain type item value))
 123
 124 (define (pam-limits-entry->string entry)
 125   "Convert a pam-limits-entry record to a string."
 126   (match entry
 127     (($ <pam-limits-entry> domain type item value)
 128      (string-join (list domain
 129                         (if (eq? type 'both)
 130                             "-"
 131                             (symbol->string type))
 132                         (symbol->string item)
 133                         (cond
 134                          ((symbol? value)
 135                           (symbol->string value))
 136                          (else
 137                           (number->string value))))
 138                   "     "))))
 139
 140 (define (pam-service->configuration service)
 141   "Return the derivation building the configuration file for SERVICE, to be
 142 dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE."
 143   (define (entry->gexp type entry)
 144     (match entry
 145       (($ <pam-entry> control module (arguments ...))
 146        #~(format #t "~a ~a ~a ~a~%"
 147                  #$type #$control #$module
 148                  (string-join (list #$@arguments))))))
 149
 150   (match service
 151     (($ <pam-service> name account auth password session)
 152      (define builder
 153        #~(begin
 154            (with-output-to-file #$output
 155              (lambda ()
 156                #$@(append (map (cut entry->gexp "account" <>) account)
 157                           (map (cut entry->gexp "auth" <>) auth)
 158                           (map (cut entry->gexp "password" <>) password)
 159                           (map (cut entry->gexp "session" <>) session))
 160                #t))))
 161
 162      (computed-file name builder))))
 163
 164 (define (pam-services->directory services)
 165   "Return the derivation to build the configuration directory to be used as
 166 /etc/pam.d for SERVICES."
 167   (let ((names (map pam-service-name services))
 168         (files (map pam-service->configuration services)))
 169     (define builder
 170       #~(begin
 171           (use-modules (ice-9 match)
 172                        (srfi srfi-1))
 173
 174           (mkdir #$output)
 175           (for-each (match-lambda
 176                       ((name file)
 177                        (symlink file (string-append #$output "/" name))))
 178
 179                     ;; Since <pam-service> objects cannot be compared with
 180                     ;; 'equal?' since they contain gexps, which contain
 181                     ;; closures, use 'delete-duplicates' on the build-side
 182                     ;; instead.  See <http://bugs.gnu.org/20037>.
 183                     (delete-duplicates '#$(zip names files)))))
 184
 185     (computed-file "pam.d" builder)))
 186
 187 (define %pam-other-services
 188   ;; The "other" PAM configuration, which denies everything (see
 189   ;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.)
 190   (let ((deny (pam-entry
 191                (control "required")
 192                (module "pam_deny.so"))))
 193     (pam-service
 194      (name "other")
 195      (account (list deny))
 196      (auth (list deny))
 197      (password (list deny))
 198      (session (list deny)))))
 199
 200 (define unix-pam-service
 201   (let ((unix (pam-entry
 202                (control "required")
 203                (module "pam_unix.so")))
 204         (env  (pam-entry ; to honor /etc/environment.
 205                (control "required")
 206                (module "pam_env.so"))))
 207     (lambda* (name #:key allow-empty-passwords? motd)
 208       "Return a standard Unix-style PAM service for NAME.  When
 209 ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords.  When MOTD is true, it
 210 should be a file-like object used as the message-of-the-day."
 211       ;; See <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.
 212       (let ((name* name))
 213         (pam-service
 214          (name name*)
 215          (account (list unix))
 216          (auth (list (if allow-empty-passwords?
 217                          (pam-entry
 218                           (control "required")
 219                           (module "pam_unix.so")
 220                           (arguments '("nullok")))
 221                          unix)))
 222          (password (list (pam-entry
 223                           (control "required")
 224                           (module "pam_unix.so")
 225                           ;; Store SHA-512 encrypted passwords in /etc/shadow.
 226                           (arguments '("sha512" "shadow")))))
 227          (session (if motd
 228                       (list env unix
 229                             (pam-entry
 230                              (control "optional")
 231                              (module "pam_motd.so")
 232                              (arguments
 233                               (list #~(string-append "motd=" #$motd)))))
 234                       (list env unix))))))))
 235
 236 (define (rootok-pam-service command)
 237   "Return a PAM service for COMMAND such that 'root' does not need to
 238 authenticate to run COMMAND."
 239   (let ((unix (pam-entry
 240                (control "required")
 241                (module "pam_unix.so"))))
 242     (pam-service
 243      (name command)
 244      (account (list unix))
 245      (auth (list (pam-entry
 246                   (control "sufficient")
 247                   (module "pam_rootok.so"))))
 248      (password (list unix))
 249      (session (list unix)))))
 250
 251 (define* (base-pam-services #:key allow-empty-passwords?)
 252   "Return the list of basic PAM services everyone would want."
 253   ;; TODO: Add other Shadow programs?
 254   (append (list %pam-other-services)
 255
 256           ;; These programs are setuid-root.
 257           (map (cut unix-pam-service <>
 258                     #:allow-empty-passwords? allow-empty-passwords?)
 259                '("su" "passwd" "sudo"))
 260
 261           ;; These programs are not setuid-root, and we want root to be able
 262           ;; to run them without having to authenticate (notably because
 263           ;; 'useradd' and 'groupadd' are run during system activation.)
 264           (map rootok-pam-service
 265                '("useradd" "userdel" "usermod"
 266                  "groupadd" "groupdel" "groupmod"))))
 267
 268 \f
 269 ;;;
 270 ;;; PAM root service.
 271 ;;;
 272
 273 ;; Overall PAM configuration: a list of services, plus a procedure that takes
 274 ;; one <pam-service> and returns a <pam-service>.  The procedure is used to
 275 ;; implement cross-cutting concerns such as the use of the 'elogind.so'
 276 ;; session module that keeps track of logged-in users.
 277 (define-record-type* <pam-configuration>
 278   pam-configuration make-pam-configuration? pam-configuration?
 279   (services  pam-configuration-services)          ;list of <pam-service>
 280   (transform pam-configuration-transform))        ;procedure
 281
 282 (define (/etc-entry config)
 283   "Return the /etc/pam.d entry corresponding to CONFIG."
 284   (match config
 285     (($ <pam-configuration> services transform)
 286      (let ((services (map transform services)))
 287        `(("pam.d" ,(pam-services->directory services)))))))
 288
 289 (define (extend-configuration initial extensions)
 290   "Extend INITIAL with NEW."
 291   (let-values (((services procs)
 292                 (partition pam-service? extensions)))
 293     (pam-configuration
 294      (services (append (pam-configuration-services initial)
 295                        services))
 296      (transform (apply compose
 297                        (pam-configuration-transform initial)
 298                        procs)))))
 299
 300 (define pam-root-service-type
 301   (service-type (name 'pam)
 302                 (extensions (list (service-extension etc-service-type
 303                                                      /etc-entry)))
 304
 305                 ;; Arguments include <pam-service> as well as procedures.
 306                 (compose concatenate)
 307                 (extend extend-configuration)))
 308
 309 (define* (pam-root-service base #:key (transform identity))
 310   "The \"root\" PAM service, which collects <pam-service> instance and turns
 311 them into a /etc/pam.d directory, including the <pam-service> listed in BASE.
 312 TRANSFORM is a procedure that takes a <pam-service> and returns a
 313 <pam-service>.  It can be used to implement cross-cutting concerns that affect
 314 all the PAM services."
 315   (service pam-root-service-type
 316            (pam-configuration (services base)
 317                               (transform transform))))
 318
 319