projects/guix·blob version-0.8.3 · refs

194 lines · 7.1 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013, 2014 Ludovic Courtès <[email protected]>
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
69dumped 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 (srfi srfi-1))
105
106 (mkdir #$output)
107 (for-each (match-lambda
108 ((name file)
109 (symlink file (string-append #$output "/" name))))
110
111 ;; Since <pam-service> objects cannot be compared with
112 ;; 'equal?' since they contain gexps, which contain
113 ;; closures, use 'delete-duplicates' on the build-side
114 ;; instead. See <http://bugs.gnu.org/20037>.
115 (delete-duplicates '#$(zip names files)))))
116
117 (gexp->derivation "pam.d" builder)))
118
119(define %pam-other-services
120 ;; The "other" PAM configuration, which denies everything (see
121 ;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.)
122 (let ((deny (pam-entry
123 (control "required")
124 (module "pam_deny.so"))))
125 (pam-service
126 (name "other")
127 (account (list deny))
128 (auth (list deny))
129 (password (list deny))
130 (session (list deny)))))
131
132(define unix-pam-service
133 (let ((unix (pam-entry
134 (control "required")
135 (module "pam_unix.so"))))
136 (lambda* (name #:key allow-empty-passwords? motd)
137 "Return a standard Unix-style PAM service for NAME. When
138ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords. When MOTD is true, it
139should be the name of a file used as the message-of-the-day."
140 ;; See <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.
141 (let ((name* name))
142 (pam-service
143 (name name*)
144 (account (list unix))
145 (auth (list (if allow-empty-passwords?
146 (pam-entry
147 (control "required")
148 (module "pam_unix.so")
149 (arguments '("nullok")))
150 unix)))
151 (password (list unix))
152 (session (if motd
153 (list unix
154 (pam-entry
155 (control "optional")
156 (module "pam_motd.so")
157 (arguments
158 (list #~(string-append "motd=" #$motd)))))
159 (list unix))))))))
160
161(define (rootok-pam-service command)
162 "Return a PAM service for COMMAND such that 'root' does not need to
163authenticate to run COMMAND."
164 (let ((unix (pam-entry
165 (control "required")
166 (module "pam_unix.so"))))
167 (pam-service
168 (name command)
169 (account (list unix))
170 (auth (list (pam-entry
171 (control "sufficient")
172 (module "pam_rootok.so"))))
173 (password (list unix))
174 (session (list unix)))))
175
176(define* (base-pam-services #:key allow-empty-passwords?)
177 "Return the list of basic PAM services everyone would want."
178 ;; TODO: Add other Shadow programs?
179 (append (list %pam-other-services)
180
181 ;; These programs are setuid-root.
182 (map (cut unix-pam-service <>
183 #:allow-empty-passwords? allow-empty-passwords?)
184 '("su" "passwd" "sudo"
185 "xlock" "xscreensaver"))
186
187 ;; These programs are not setuid-root, and we want root to be able
188 ;; to run them without having to authenticate (notably because
189 ;; 'useradd' and 'groupadd' are run during system activation.)
190 (map rootok-pam-service
191 '("useradd" "userdel" "usermod"
192 "groupadd" "groupdel" "groupmod"))))
193
194;;; linux.scm ends here