gnu/system/pam.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 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             session-environment-service
  54             session-environment-service-type
  55
  56             pam-root-service-type
  57             pam-root-service))
  58
  59 ;;; Commentary:
  60 ;;;
  61 ;;; Configuration of the pluggable authentication modules (PAM).
  62 ;;;
  63 ;;; Code:
  64
  65 ;; PAM services (see
  66 ;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-file.html>.)
  67 (define-record-type* <pam-service> pam-service
  68   make-pam-service
  69   pam-service?
  70   (name       pam-service-name)                   ; string
  71
  72   ;; The four "management groups".
  73   (account    pam-service-account                 ; list of <pam-entry>
  74               (default '()))
  75   (auth       pam-service-auth
  76               (default '()))
  77   (password   pam-service-password
  78               (default '()))
  79   (session    pam-service-session
  80               (default '())))
  81
  82 (define-record-type* <pam-entry> pam-entry
  83   make-pam-entry
  84   pam-entry?
  85   (control    pam-entry-control)         ; string
  86   (module     pam-entry-module)          ; file name
  87   (arguments  pam-entry-arguments        ; list of string-valued g-expressions
  88               (default '())))
  89
  90 ;; PAM limits entries are used by the pam_limits PAM module to set or override
  91 ;; limits on system resources for user sessions.  The format is specified
  92 ;; here: http://linux-pam.org/Linux-PAM-html/sag-pam_limits.html
  93 (define-record-type <pam-limits-entry>
  94   (make-pam-limits-entry domain type item value)
  95   pam-limits-entry?
  96   (domain     pam-limits-entry-domain)   ; string
  97   (type       pam-limits-entry-type)     ; symbol
  98   (item       pam-limits-entry-item)     ; symbol
  99   (value      pam-limits-entry-value))   ; symbol or number
 100
 101 (define (pam-limits-entry domain type item value)
 102   "Construct a pam-limits-entry ensuring that the provided values are valid."
 103   (define (valid? value)
 104     (case item
 105       ((priority) (number? value))
 106       ((nice)     (and (number? value)
 107                        (>= value -20)
 108                        (<= value 19)))
 109       (else       (or (and (number? value)
 110                            (>= value -1))
 111                       (member value '(unlimited infinity))))))
 112   (define items
 113     (list 'core      'data       'fsize
 114           'memlock   'nofile     'rss
 115           'stack     'cpu        'nproc
 116           'as        'maxlogins  'maxsyslogins
 117           'priority  'locks      'sigpending
 118           'msgqueue  'nice       'rtprio))
 119   (when (not (member type '(hard soft both)))
 120     (error "invalid limit type" type))
 121   (when (not (member item items))
 122     (error "invalid limit item" item))
 123   (when (not (valid? value))
 124     (error "invalid limit value" value))
 125   (make-pam-limits-entry domain type item value))
 126
 127 (define (pam-limits-entry->string entry)
 128   "Convert a pam-limits-entry record to a string."
 129   (match entry
 130     (($ <pam-limits-entry> domain type item value)
 131      (string-join (list domain
 132                         (if (eq? type 'both)
 133                             "-"
 134                             (symbol->string type))
 135                         (symbol->string item)
 136                         (cond
 137                          ((symbol? value)
 138                           (symbol->string value))
 139                          (else
 140                           (number->string value))))
 141                   "     "))))
 142
 143 (define (pam-service->configuration service)
 144   "Return the derivation building the configuration file for SERVICE, to be
 145 dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE."
 146   (define (entry->gexp type entry)
 147     (match entry
 148       (($ <pam-entry> control module (arguments ...))
 149        #~(format #t "~a ~a ~a ~a~%"
 150                  #$type #$control #$module
 151                  (string-join (list #$@arguments))))))
 152
 153   (match service
 154     (($ <pam-service> name account auth password session)
 155      (define builder
 156        #~(begin
 157            (with-output-to-file #$output
 158              (lambda ()
 159                #$@(append (map (cut entry->gexp "account" <>) account)
 160                           (map (cut entry->gexp "auth" <>) auth)
 161                           (map (cut entry->gexp "password" <>) password)
 162                           (map (cut entry->gexp "session" <>) session))
 163                #t))))
 164
 165      (computed-file name builder))))
 166
 167 (define (pam-services->directory services)
 168   "Return the derivation to build the configuration directory to be used as
 169 /etc/pam.d for SERVICES."
 170   (let ((names (map pam-service-name services))
 171         (files (map pam-service->configuration services)))
 172     (define builder
 173       #~(begin
 174           (use-modules (ice-9 match)
 175                        (srfi srfi-1))
 176
 177           (mkdir #$output)
 178           (for-each (match-lambda
 179                       ((name file)
 180                        (symlink file (string-append #$output "/" name))))
 181
 182                     ;; Since <pam-service> objects cannot be compared with
 183                     ;; 'equal?' since they contain gexps, which contain
 184                     ;; closures, use 'delete-duplicates' on the build-side
 185                     ;; instead.  See <http://bugs.gnu.org/20037>.
 186                     (delete-duplicates '#$(zip names files)))))
 187
 188     (computed-file "pam.d" builder)))
 189
 190 (define %pam-other-services
 191   ;; The "other" PAM configuration, which denies everything (see
 192   ;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.)
 193   (let ((deny (pam-entry
 194                (control "required")
 195                (module "pam_deny.so"))))
 196     (pam-service
 197      (name "other")
 198      (account (list deny))
 199      (auth (list deny))
 200      (password (list deny))
 201      (session (list deny)))))
 202
 203 (define unix-pam-service
 204   (let ((unix (pam-entry
 205                (control "required")
 206                (module "pam_unix.so")))
 207         (env  (pam-entry ; to honor /etc/environment.
 208                (control "required")
 209                (module "pam_env.so"))))
 210     (lambda* (name #:key allow-empty-passwords? (allow-root? #f) motd
 211                    login-uid?)
 212       "Return a standard Unix-style PAM service for NAME.  When
 213 ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords.  When ALLOW-ROOT? is
 214 true, allow root to run the command without authentication.  When MOTD is
 215 true, it should be a file-like object used as the message-of-the-day.
 216 When LOGIN-UID? is true, require the 'pam_loginuid' module; that module sets
 217 /proc/self/loginuid, which the libc 'getlogin' function relies on."
 218       ;; See <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.
 219       (pam-service
 220        (name name)
 221        (account (list unix))
 222        (auth (append (if allow-root?
 223                          (list (pam-entry
 224                                 (control "sufficient")
 225                                 (module "pam_rootok.so")))
 226                          '())
 227                      (list (if allow-empty-passwords?
 228                                (pam-entry
 229                                 (control "required")
 230                                 (module "pam_unix.so")
 231                                 (arguments '("nullok")))
 232                                unix))))
 233        (password (list (pam-entry
 234                         (control "required")
 235                         (module "pam_unix.so")
 236                         ;; Store SHA-512 encrypted passwords in /etc/shadow.
 237                         (arguments '("sha512" "shadow")))))
 238        (session `(,@(if motd
 239                         (list (pam-entry
 240                                (control "optional")
 241                                (module "pam_motd.so")
 242                                (arguments
 243                                 (list #~(string-append "motd=" #$motd)))))
 244                         '())
 245                   ,@(if login-uid?
 246                         (list (pam-entry       ;to fill in /proc/self/loginuid
 247                                (control "required")
 248                                (module "pam_loginuid.so")))
 249                         '())
 250                   ,env ,unix))))))
 251
 252 (define (rootok-pam-service command)
 253   "Return a PAM service for COMMAND such that 'root' does not need to
 254 authenticate to run COMMAND."
 255   (let ((unix (pam-entry
 256                (control "required")
 257                (module "pam_unix.so"))))
 258     (pam-service
 259      (name command)
 260      (account (list unix))
 261      (auth (list (pam-entry
 262                   (control "sufficient")
 263                   (module "pam_rootok.so"))))
 264      (password (list unix))
 265      (session (list unix)))))
 266
 267 (define* (base-pam-services #:key allow-empty-passwords?)
 268   "Return the list of basic PAM services everyone would want."
 269   ;; TODO: Add other Shadow programs?
 270   (append (list %pam-other-services)
 271
 272           ;; These programs are setuid-root.
 273           (map (cut unix-pam-service <>
 274                     #:allow-empty-passwords? allow-empty-passwords?)
 275                '("passwd" "sudo"))
 276           ;; This is setuid-root, as well.  Allow root to run "su" without
 277           ;; authenticating.
 278           (list (unix-pam-service "su"
 279                                   #:allow-empty-passwords? allow-empty-passwords?
 280                                   #:allow-root? #t))
 281
 282           ;; These programs are not setuid-root, and we want root to be able
 283           ;; to run them without having to authenticate (notably because
 284           ;; 'useradd' and 'groupadd' are run during system activation.)
 285           (map rootok-pam-service
 286                '("useradd" "userdel" "usermod"
 287                  "groupadd" "groupdel" "groupmod"))))
 288
 289 \f
 290 ;;;
 291 ;;; System-wide environment variables.
 292 ;;;
 293
 294 (define (environment-variables->environment-file vars)
 295   "Return a file for pam_env(8) that contains environment variables VARS."
 296   (apply mixed-text-file "environment"
 297          (append-map (match-lambda
 298                        ((key . value)
 299                         (list key "=" value "\n")))
 300                      vars)))
 301
 302 (define session-environment-service-type
 303   (service-type
 304    (name 'session-environment)
 305    (extensions
 306     (list (service-extension
 307            etc-service-type
 308            (lambda (vars)
 309              (list `("environment"
 310                      ,(environment-variables->environment-file vars)))))))
 311    (compose concatenate)
 312    (extend append)
 313    (description
 314     "Populate @file{/etc/environment}, which is honored by @code{pam_env},
 315 with the specified environment variables.  The value of this service is a list
 316 of name/value pairs for environments variables, such as:
 317
 318 @example
 319 '((\"TZ\" . \"Canada/Pacific\"))
 320 @end example\n")))
 321
 322 (define (session-environment-service vars)
 323   "Return a service that builds the @file{/etc/environment}, which can be read
 324 by PAM-aware applications to set environment variables for sessions.
 325
 326 VARS should be an association list in which both the keys and the values are
 327 strings or string-valued gexps."
 328   (service session-environment-service-type vars))
 329
 330
 331 \f
 332 ;;;
 333 ;;; PAM root service.
 334 ;;;
 335
 336 ;; Overall PAM configuration: a list of services, plus a procedure that takes
 337 ;; one <pam-service> and returns a <pam-service>.  The procedure is used to
 338 ;; implement cross-cutting concerns such as the use of the 'elogind.so'
 339 ;; session module that keeps track of logged-in users.
 340 (define-record-type* <pam-configuration>
 341   pam-configuration make-pam-configuration? pam-configuration?
 342   (services  pam-configuration-services)          ;list of <pam-service>
 343   (transform pam-configuration-transform))        ;procedure
 344
 345 (define (/etc-entry config)
 346   "Return the /etc/pam.d entry corresponding to CONFIG."
 347   (match config
 348     (($ <pam-configuration> services transform)
 349      (let ((services (map transform services)))
 350        `(("pam.d" ,(pam-services->directory services)))))))
 351
 352 (define (extend-configuration initial extensions)
 353   "Extend INITIAL with NEW."
 354   (let-values (((services procs)
 355                 (partition pam-service? extensions)))
 356     (pam-configuration
 357      (services (append (pam-configuration-services initial)
 358                        services))
 359      (transform (apply compose
 360                        (pam-configuration-transform initial)
 361                        procs)))))
 362
 363 (define pam-root-service-type
 364   (service-type (name 'pam)
 365                 (extensions (list (service-extension etc-service-type
 366                                                      /etc-entry)))
 367
 368                 ;; Arguments include <pam-service> as well as procedures.
 369                 (compose concatenate)
 370                 (extend extend-configuration)
 371                 (description
 372                  "Configure the Pluggable Authentication Modules (PAM) for all
 373 the specified @dfn{PAM services}.  Each PAM service corresponds to a program,
 374 such as @command{login} or @command{sshd}, and specifies for instance how the
 375 program may authenticate users or what it should do when opening a new
 376 session.")))
 377
 378 (define* (pam-root-service base #:key (transform identity))
 379   "The \"root\" PAM service, which collects <pam-service> instance and turns
 380 them into a /etc/pam.d directory, including the <pam-service> listed in BASE.
 381 TRANSFORM is a procedure that takes a <pam-service> and returns a
 382 <pam-service>.  It can be used to implement cross-cutting concerns that affect
 383 all the PAM services."
 384   (service pam-root-service-type
 385            (pam-configuration (services base)
 386                               (transform transform))))
 387
 388