From 996ed73948e92eb2005a2a282856753d707f452c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 4 Feb 2015 21:58:15 +0100 Subject: system: Add bindings to configure libc's NSS. * gnu/system/nss.scm: New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add it. * gnu.scm (%public-modules): Add it. * gnu/system.scm ()[name-service-switch]: New field. (etc-directory): Add #:nss parameter and honor it. (operating-system-etc-directory): Adjust call accordingly. * doc/guix.texi (operating-system Reference): Document 'name-service-switch'. (Name Service Switch): New section. --- gnu/system/nss.scm | 213 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 213 insertions(+) create mode 100644 gnu/system/nss.scm (limited to 'gnu/system/nss.scm') diff --git a/gnu/system/nss.scm b/gnu/system/nss.scm new file mode 100644 index 0000000000..ec2d2517e7 --- /dev/null +++ b/gnu/system/nss.scm @@ -0,0 +1,213 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 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 nss) + #:use-module (rnrs enums) + #:use-module (guix records) + #:use-module (srfi srfi-9) + #:use-module (ice-9 match) + #:export (name-service-switch? + name-service-switch + name-service? + name-service + + lookup-specification + + %default-nss + %files + %compat + %dns + + name-service-switch->string)) + +;;; Commentary: +;;; +;;; Bindings for libc's name service switch (NSS) configuration. +;;; +;;; Code: + +(define-record-type* name-service + make-name-service + name-service? + (name name-service-name) + (reaction name-service-reaction + (default (lookup-specification)))) + +;; Lookup specification (info "(libc) Actions in the NSS Configuration"). + +(define-enumeration lookup-action + (return continue) + make-lookup-action) + +(define-enumeration lookup-status + (success + not-found + unavailable + try-again) + make-lookup-status) + +(define-record-type + (lookup-status-negation status) + lookup-status-negation? + (status lookup-status-negation-status)) + +(define-record-type + (make-lookup-reaction status action) + lookup-reaction? + (status lookup-reaction-status) + (action lookup-reaction-action)) + +(define-syntax lookup-reaction + (syntax-rules (not =>) + ((_ ((not status) => action)) + (make-lookup-reaction (lookup-status-negation (lookup-status status)) + (lookup-action action))) + ((_ (status => action)) + (make-lookup-reaction (lookup-status status) + (lookup-action action))))) + +(define-syntax-rule (lookup-specification reaction ...) + "Return an NSS lookup specification." + (list (lookup-reaction reaction) ...)) + + +;;; +;;; Common name services and default NSS configuration. +;;; + +(define %compat + (name-service + (name "compat") + (reaction (lookup-specification (not-found => return))))) + +(define %files + (name-service (name "files"))) + +(define %dns + ;; DNS is supposed to be authoritative, so unless it's unavailable, return + ;; what it finds. + (name-service + (name "dns") + (reaction (lookup-specification ((not unavailable) => return))))) + +;; The NSS. We list all the databases here because that allows us to +;; statically ensure that the user's configuration refers to existing +;; databases. See libc/nss/databases.def for the list of databases. Default +;; values obtained by looking for "DEFAULT_CONFIG" in libc/nss/*.c. +;; +;; Although libc places 'dns' before 'files' in the default configurations of +;; the 'hosts' and 'networks' databases, we choose to put 'files' before 'dns' +;; by default, so that users can override host/address mappings in /etc/hosts +;; and bypass DNS to improve their privacy and escape NSA's MORECOWBELL. +(define-record-type* name-service-switch + make-name-service-switch + name-service-switch? + (aliases name-service-switch-aliases + (default '())) + (ethers name-service-switch-ethers + (default '())) + (group name-service-switch-group + (default (list %compat %files))) + (gshadow name-service-switch-gshadow + (default '())) + (hosts name-service-switch-hosts + (default (list %files %dns))) + (initgroups name-service-switch-initgroups + (default '())) + (netgroup name-service-switch-netgroup + (default '())) + (networks name-service-switch-networks + (default (list %files %dns))) + (password name-service-switch-password + (default (list %compat %files))) + (public-key name-service-switch-public-key + (default '())) + (rpc name-service-switch-rpc + (default '())) + (services name-service-switch-services + (default '())) + (shadow name-service-switch-shadow + (default (list %compat %files)))) + +(define %default-nss + ;; Default NSS configuration. + (name-service-switch)) + + +;;; +;;; Serialization. +;;; + +(define (lookup-status->string status) + (match status + ('success "SUCCESS") + ('not-found "NOTFOUND") + ('unavailable "UNAVAIL") + ('try-again "TRYAGAIN") + (($ status) + (string-append "!" (lookup-status->string status))))) + +(define lookup-reaction->string + (match-lambda + (($ status action) + (string-append (lookup-status->string status) "=" + (symbol->string action))))) + +(define name-service->string + (match-lambda + (($ name ()) + name) + (($ name reactions) + (string-append name " [" + (string-join (map lookup-reaction->string reactions)) + "]")))) + +(define (name-service-switch->string nss) + "Return the 'nsswitch.conf' contents for NSS as a string. See \"NSS +Configuration File\" in the libc manual." + (let-syntax ((->string + (syntax-rules () + ((_ name field) + (match (field nss) + (() ;keep the default config + "") + ((services (... ...)) + (string-append name ":\t" + (string-join + (map name-service->string services)) + "\n"))))))) + (string-append (->string "aliases" name-service-switch-aliases) + (->string "ethers" name-service-switch-ethers) + (->string "group" name-service-switch-group) + (->string "gshadow" name-service-switch-gshadow) + (->string "hosts" name-service-switch-hosts) + (->string "initgroups" name-service-switch-initgroups) + (->string "netgroup" name-service-switch-netgroup) + (->string "networks" name-service-switch-networks) + (->string "passwd" name-service-switch-password) + (->string "publickey" name-service-switch-public-key) + (->string "rpc" name-service-switch-rpc) + (->string "services" name-service-switch-services) + (->string "shadow" name-service-switch-shadow)))) + +;;; Local Variables: +;;; eval: (put 'name-service 'scheme-indent-function 0) +;;; eval: (put 'name-service-switch 'scheme-indent-function 0) +;;; End: + +;;; nss.scm ends here -- cgit 1.4.1