From 0ded70f37d47579ca058f2f4ca27335129a96e25 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 11 Sep 2013 22:36:50 +0200 Subject: =?UTF-8?q?gnu:=20Move=20helper=20code=20to=20(gnu=20system=20?= =?UTF-8?q?=E2=80=A6)=20modules.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/grub.scm (, grub-configuration-file): Move to... * gnu/system/grub.scm: ... here. New file. * gnu/packages/linux.scm (, , pam-service->configuration, pam-service->directory, %pam-other-services, unix-pam-service): Move to... * gnu/system/linux.scm: ... here. New file. * gnu/system/vm.scm (passwd-file): Move to... * gnu/system/shadow.scm: ... here. New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add gnu/system/{grub,linux,shadow}.scm. --- gnu/system/linux.scm | 145 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 145 insertions(+) create mode 100644 gnu/system/linux.scm (limited to 'gnu/system/linux.scm') diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm new file mode 100644 index 0000000000..b2daa13e06 --- /dev/null +++ b/gnu/system/linux.scm @@ -0,0 +1,145 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 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 store) + #:use-module (guix records) + #:use-module (guix derivations) + #: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 +;; .) +(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 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 + (($ control module (arguments ...)) + (string-append type " " + control " " module " " + (string-join arguments) + "\n")))) + + (match 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 store 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 (match-lambda + ((and service ($ name)) + (let ((config (pam-service->configuration service))) + (add-text-to-store store + (string-append name ".pam") + config '())))) + 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))) + + (build-expression->derivation store "pam.d" (%current-system) + builder + (zip names files)))) + +(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?) + "Return a standard Unix-style PAM service for NAME. When +ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords." + ;; 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 unix)) + (session (list unix))))))) + +;;; linux.scm ends here -- cgit v1.2.3