From 6e82863463c641571e852291481e2b64401c2fe2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 3 Nov 2015 18:08:47 +0100 Subject: system: Rename (gnu system linux) to (gnu system pam). * gnu/system/linux.scm: Rename to... * gnu/system/pam.scm: ... this. * gnu-system.am (GNU_SYSTEM_MODULES): Adjust accordingly. * gnu.scm, gnu/services/base.scm, gnu/services/desktop.scm, gnu/services/networking.scm, gnu/services/ssh.scm, gnu/services/xorg.scm, gnu/system.scm, gnu/system/vm.scm: Likewise. --- gnu/system/linux.scm | 214 --------------------------------------------------- gnu/system/pam.scm | 213 ++++++++++++++++++++++++++++++++++++++++++++++++++ gnu/system/vm.scm | 2 +- 3 files changed, 214 insertions(+), 215 deletions(-) delete mode 100644 gnu/system/linux.scm create mode 100644 gnu/system/pam.scm (limited to 'gnu/system') diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm deleted file mode 100644 index 487d379e65..0000000000 --- a/gnu/system/linux.scm +++ /dev/null @@ -1,214 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015 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 linux) - #: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-26) - #:use-module ((guix utils) #:select (%current-system)) - #:export (pam-service - pam-entry - pam-services->directory - unix-pam-service - base-pam-services - - pam-root-service-type - pam-root-service)) - -;;; Commentary: -;;; -;;; Configuration of Linux-related things, including pluggable authentication -;;; modules (PAM). -;;; -;;; Code: - -;; PAM services (see -;; .) -(define-record-type* pam-service - make-pam-service - pam-service? - (name pam-service-name) ; string - - ;; The four "management groups". - (account pam-service-account ; list of - (default '())) - (auth pam-service-auth - (default '())) - (password pam-service-password - (default '())) - (session pam-service-session - (default '()))) - -(define-record-type* pam-entry - make-pam-entry - pam-entry? - (control pam-entry-control) ; string - (module pam-entry-module) ; file name - (arguments pam-entry-arguments ; list of string-valued g-expressions - (default '()))) - -(define (pam-service->configuration service) - "Return the derivation building the configuration file for SERVICE, to be -dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE." - (define (entry->gexp type entry) - (match entry - (($ control module (arguments ...)) - #~(format #t "~a ~a ~a ~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")))) - (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 unix - (pam-entry - (control "optional") - (module "pam_motd.so") - (arguments - (list #~(string-append "motd=" #$motd))))) - (list 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. -;;; - -(define (/etc-entry services) - `(("pam.d" ,(pam-services->directory services)))) - -(define pam-root-service-type - (service-type (name 'pam) - (extensions (list (service-extension etc-service-type - /etc-entry))) - (compose concatenate) - (extend append))) - -(define (pam-root-service base) - "The \"root\" PAM service, which collects instance and turns -them into a /etc/pam.d directory, including the listed in BASE." - (service pam-root-service-type base)) - -;;; linux.scm ends here diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm new file mode 100644 index 0000000000..d8470f02a3 --- /dev/null +++ b/gnu/system/pam.scm @@ -0,0 +1,213 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014, 2015 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-26) + #:use-module ((guix utils) #:select (%current-system)) + #:export (pam-service + pam-entry + pam-services->directory + unix-pam-service + base-pam-services + + pam-root-service-type + pam-root-service)) + +;;; Commentary: +;;; +;;; Configuration of the pluggable authentication modules (PAM). +;;; +;;; Code: + +;; PAM services (see +;; .) +(define-record-type* pam-service + make-pam-service + pam-service? + (name pam-service-name) ; string + + ;; The four "management groups". + (account pam-service-account ; list of + (default '())) + (auth pam-service-auth + (default '())) + (password pam-service-password + (default '())) + (session pam-service-session + (default '()))) + +(define-record-type* pam-entry + make-pam-entry + pam-entry? + (control pam-entry-control) ; string + (module pam-entry-module) ; file name + (arguments pam-entry-arguments ; list of string-valued g-expressions + (default '()))) + +(define (pam-service->configuration service) + "Return the derivation building the configuration file for SERVICE, to be +dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE." + (define (entry->gexp type entry) + (match entry + (($ control module (arguments ...)) + #~(format #t "~a ~a ~a ~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")))) + (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 unix + (pam-entry + (control "optional") + (module "pam_motd.so") + (arguments + (list #~(string-append "motd=" #$motd))))) + (list 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. +;;; + +(define (/etc-entry services) + `(("pam.d" ,(pam-services->directory services)))) + +(define pam-root-service-type + (service-type (name 'pam) + (extensions (list (service-extension etc-service-type + /etc-entry))) + (compose concatenate) + (extend append))) + +(define (pam-root-service base) + "The \"root\" PAM service, which collects instance and turns +them into a /etc/pam.d directory, including the listed in BASE." + (service pam-root-service-type base)) + +;;; linux.scm ends here diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index dfb6996067..96ff27f90b 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -43,7 +43,7 @@ #:use-module (gnu packages admin) #:use-module (gnu system shadow) - #:use-module (gnu system linux) + #:use-module (gnu system pam) #:use-module (gnu system linux-initrd) #:use-module (gnu system grub) #:use-module (gnu system file-systems) -- cgit 1.4.1