155 lines
5.6 KiB
Scheme
155 lines
5.6 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
|
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
|
|
;;;
|
|
;;; 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 <http://www.gnu.org/licenses/>.
|
|
|
|
(define-module (gnu system linux)
|
|
#:use-module (guix store)
|
|
#:use-module (guix records)
|
|
#:use-module (guix derivations)
|
|
#:use-module (guix monads)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-26)
|
|
#:use-module ((guix utils) #:select (%current-system))
|
|
#:export (pam-service
|
|
pam-entry
|
|
pam-services->directory
|
|
%pam-other-services
|
|
unix-pam-service))
|
|
|
|
;;; Commentary:
|
|
;;;
|
|
;;; Configuration of Linux-related things, including pluggable authentication
|
|
;;; modules (PAM).
|
|
;;;
|
|
;;; Code:
|
|
|
|
;; PAM services (see
|
|
;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-file.html>.)
|
|
(define-record-type* <pam-service> pam-service
|
|
make-pam-service
|
|
pam-service?
|
|
(name pam-service-name) ; string
|
|
|
|
;; The four "management groups".
|
|
(account pam-service-account ; list of <pam-entry>
|
|
(default '()))
|
|
(auth pam-service-auth
|
|
(default '()))
|
|
(password pam-service-password
|
|
(default '()))
|
|
(session pam-service-session
|
|
(default '())))
|
|
|
|
(define-record-type* <pam-entry> pam-entry
|
|
make-pam-entry
|
|
pam-entry?
|
|
(control pam-entry-control) ; string
|
|
(module pam-entry-module) ; file name
|
|
(arguments pam-entry-arguments ; list of strings
|
|
(default '())))
|
|
|
|
(define (pam-service->configuration service)
|
|
"Return the configuration string for SERVICE, to be dumped in
|
|
/etc/pam.d/NAME, where NAME is the name of SERVICE."
|
|
(define (entry->string type entry)
|
|
(match entry
|
|
(($ <pam-entry> control module (arguments ...))
|
|
(string-append type " "
|
|
control " " module " "
|
|
(string-join arguments)
|
|
"\n"))))
|
|
|
|
(match service
|
|
(($ <pam-service> name account auth password session)
|
|
(string-concatenate
|
|
(append (map (cut entry->string "account" <>) account)
|
|
(map (cut entry->string "auth" <>) auth)
|
|
(map (cut entry->string "password" <>) password)
|
|
(map (cut entry->string "session" <>) session))))))
|
|
|
|
(define (pam-services->directory services)
|
|
"Return the derivation to build the configuration directory to be used as
|
|
/etc/pam.d for SERVICES."
|
|
(mlet %store-monad
|
|
((names -> (map pam-service-name services))
|
|
(files (mapm %store-monad
|
|
(match-lambda
|
|
((and service ($ <pam-service> name))
|
|
(let ((config (pam-service->configuration service)))
|
|
(text-file (string-append name ".pam") config))))
|
|
|
|
;; XXX: Eventually, SERVICES may be a list of monadic
|
|
;; values instead of plain values.
|
|
(map return services))))
|
|
(define builder
|
|
'(begin
|
|
(use-modules (ice-9 match))
|
|
|
|
(let ((out (assoc-ref %outputs "out")))
|
|
(mkdir out)
|
|
(for-each (match-lambda
|
|
((name . file)
|
|
(symlink file (string-append out "/" name))))
|
|
%build-inputs)
|
|
#t)))
|
|
|
|
(derivation-expression "pam.d" (%current-system) builder (zip names files))))
|
|
|
|
(define %pam-other-services
|
|
;; The "other" PAM configuration, which denies everything (see
|
|
;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.)
|
|
(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"))))
|
|
(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 the name of a file used as the message-of-the-day."
|
|
;; See <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.
|
|
(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 unix))
|
|
(session (if motd
|
|
(list unix
|
|
(pam-entry
|
|
(control "optional")
|
|
(module "pam_motd.so")
|
|
(arguments (list (string-append "motd=" motd)))))
|
|
(list unix))))))))
|
|
|
|
;;; linux.scm ends here
|