;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès ;;; ;;; 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 . (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-9) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module ((guix utils) #:select (%current-system)) #:export (pam-service pam-service-name
aboutsummaryrefslogtreecommitdiff
blob: 43c8352b2828e13928367526134f509b8e16a3ca (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
comparison_with_undefined: {
    options = {
        comparisons: true,
    }
    input: {
        a == undefined;
        a != undefined;
        a === undefined;
        a !== undefined;

        undefined == a;
        undefined != a;
        undefined === a;
        undefined !== a;

        void 0 == a;
        void 0 != a;
        void 0 === a;
        void 0 !== a;
    }
    expect: {
        null == a;
        null != a;
        void 0 === a;
        void 0 !== a;

        null == a;
        null != a;
        void 0 === a;
        void 0 !== a;

        null == a;
        null != a;
        void 0 === a;
        void 0 !== a;
    }
}
#$type #$control #$module (string-join (list #$@arguments)))))) (match 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 objects cannot be compared with ;; 'equal?' since they contain gexps, which contain ;; closures, use 'delete-duplicates' on the build-side ;; instead. See . (delete-duplicates '#$(zip names files))))) (computed-file "pam.d" builder))) (define %pam-other-services ;; The "other" PAM configuration, which denies everything (see ;; .) (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"))) (env (pam-entry ; to honor /etc/environment. (control "required") (module "pam_env.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 . (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 env unix (pam-entry (control "optional") (module "pam_motd.so") (arguments (list #~(string-append "motd=" #$motd))))) (list env 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. ;;; ;; Overall PAM configuration: a list of services, plus a procedure that takes ;; one and returns a . The procedure is used to ;; implement cross-cutting concerns such as the use of the 'elogind.so' ;; session module that keeps track of logged-in users. (define-record-type* pam-configuration make-pam-configuration? pam-configuration? (services pam-configuration-services) ;list of (transform pam-configuration-transform)) ;procedure (define (/etc-entry config) "Return the /etc/pam.d entry corresponding to CONFIG." (match config (($ services transform) (let ((services (map transform services))) `(("pam.d" ,(pam-services->directory services))))))) (define (extend-configuration initial extensions) "Extend INITIAL with NEW." (let-values (((services procs) (partition pam-service? extensions))) (pam-configuration (services (append (pam-configuration-services initial) services)) (transform (apply compose (pam-configuration-transform initial) procs))))) (define pam-root-service-type (service-type (name 'pam) (extensions (list (service-extension etc-service-type /etc-entry))) ;; Arguments include as well as procedures. (compose concatenate) (extend extend-configuration))) (define* (pam-root-service base #:key (transform identity)) "The \"root\" PAM service, which collects instance and turns them into a /etc/pam.d directory, including the listed in BASE. TRANSFORM is a procedure that takes a and returns a . It can be used to implement cross-cutting concerns that affect all the PAM services." (service pam-root-service-type (pam-configuration (services base) (transform transform))))