1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2015, 2018 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
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.
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.
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/>.
19 (define-module (gnu system nss)
20 #:use-module (rnrs enums)
21 #:use-module (guix records)
22 #:use-module (srfi srfi-9)
23 #:use-module (ice-9 match)
24 #:export (name-service-switch?
38 name-service-switch->string))
42 ;;; Bindings for libc's name service switch (NSS) configuration.
46 (define-record-type* <name-service> name-service
49 (name name-service-name)
50 (reaction name-service-reaction
51 (default (lookup-specification))))
53 ;; Lookup specification (info "(libc) Actions in the NSS Configuration").
55 (define-enumeration lookup-action
59 (define-enumeration lookup-status
66 (define-record-type <lookup-status-negation>
67 (lookup-status-negation status)
68 lookup-status-negation?
69 (status lookup-status-negation-status))
71 (define-record-type <lookup-reaction>
72 (make-lookup-reaction status action)
74 (status lookup-reaction-status)
75 (action lookup-reaction-action))
77 (define-syntax lookup-reaction
78 (syntax-rules (not =>)
79 ((_ ((not status) => action))
80 (make-lookup-reaction (lookup-status-negation (lookup-status status))
81 (lookup-action action)))
82 ((_ (status => action))
83 (make-lookup-reaction (lookup-status status)
84 (lookup-action action)))))
86 (define-syntax-rule (lookup-specification reaction ...)
87 "Return an NSS lookup specification."
88 (list (lookup-reaction reaction) ...))
92 ;;; Common name services and default NSS configuration.
96 ;; Note: Starting from version 2.26, libc no longer provides libnss_compat
97 ;; so this specification has become useless.
100 (reaction (lookup-specification (not-found => return)))))
103 (name-service (name "files")))
106 ;; DNS is supposed to be authoritative, so unless it's unavailable, return
110 (reaction (lookup-specification ((not unavailable) => return)))))
112 ;; The NSS. We list all the databases here because that allows us to
113 ;; statically ensure that the user's configuration refers to existing
114 ;; databases. See libc/nss/databases.def for the list of databases. Default
115 ;; values obtained by looking for "DEFAULT_CONFIG" in libc/nss/*.c.
117 ;; Although libc places 'dns' before 'files' in the default configurations of
118 ;; the 'hosts' and 'networks' databases, we choose to put 'files' before 'dns'
119 ;; by default, so that users can override host/address mappings in /etc/hosts
120 ;; and bypass DNS to improve their privacy and escape NSA's MORECOWBELL.
121 (define-record-type* <name-service-switch> name-service-switch
122 make-name-service-switch
124 (aliases name-service-switch-aliases
126 (ethers name-service-switch-ethers
128 (group name-service-switch-group
129 (default (list %files)))
130 (gshadow name-service-switch-gshadow
132 (hosts name-service-switch-hosts
133 (default (list %files %dns)))
134 (initgroups name-service-switch-initgroups
136 (netgroup name-service-switch-netgroup
138 (networks name-service-switch-networks
139 (default (list %files %dns)))
140 (password name-service-switch-password
141 (default (list %files)))
142 (public-key name-service-switch-public-key
144 (rpc name-service-switch-rpc
146 (services name-service-switch-services
148 (shadow name-service-switch-shadow
149 (default (list %files))))
152 ;; Default NSS configuration.
153 (name-service-switch))
155 (define %mdns-host-lookup-nss
157 (hosts (list %files ;first, check /etc/hosts
159 ;; If the above did not succeed, try with 'mdns_minimal'.
161 (name "mdns_minimal")
163 ;; 'mdns_minimal' is authoritative for '.local'. When it
164 ;; returns "not found", no need to try the next methods.
165 (reaction (lookup-specification
166 (not-found => return))))
168 ;; Then fall back to DNS.
172 ;; Finally, try with the "full" 'mdns'.
181 (define (lookup-status->string status)
184 ('not-found "NOTFOUND")
185 ('unavailable "UNAVAIL")
186 ('try-again "TRYAGAIN")
187 (($ <lookup-status-negation> status)
188 (string-append "!" (lookup-status->string status)))))
190 (define lookup-reaction->string
192 (($ <lookup-reaction> status action)
193 (string-append (lookup-status->string status) "="
194 (symbol->string action)))))
196 (define name-service->string
198 (($ <name-service> name ())
200 (($ <name-service> name reactions)
201 (string-append name " ["
202 (string-join (map lookup-reaction->string reactions))
205 (define (name-service-switch->string nss)
206 "Return the 'nsswitch.conf' contents for NSS as a string. See \"NSS
207 Configuration File\" in the libc manual."
208 (let-syntax ((->string
212 (() ;keep the default config
214 ((services (... ...))
215 (string-append name ":\t"
217 (map name-service->string services))
219 (string-append (->string "aliases" name-service-switch-aliases)
220 (->string "ethers" name-service-switch-ethers)
221 (->string "group" name-service-switch-group)
222 (->string "gshadow" name-service-switch-gshadow)
223 (->string "hosts" name-service-switch-hosts)
224 (->string "initgroups" name-service-switch-initgroups)
225 (->string "netgroup" name-service-switch-netgroup)
226 (->string "networks" name-service-switch-networks)
227 (->string "passwd" name-service-switch-password)
228 (->string "publickey" name-service-switch-public-key)
229 (->string "rpc" name-service-switch-rpc)
230 (->string "services" name-service-switch-services)
231 (->string "shadow" name-service-switch-shadow))))
234 ;;; eval: (put 'name-service 'scheme-indent-function 0)
235 ;;; eval: (put 'name-service-switch 'scheme-indent-function 0)
238 ;;; nss.scm ends here