gnu: Move helper code to (gnu system …) modules.
* gnu/packages/grub.scm (<menu-entry>, grub-configuration-file): Move
to...
* gnu/system/grub.scm: ... here. New file.
* gnu/packages/linux.scm (<pam-service>, <pam-entry>,
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.
This commit is contained in:
Ludovic Courtès
parent
aedb72fbe0
commit
0ded70f37d
|
|
@ -179,6 +179,10 @@ GNU_SYSTEM_MODULES = \
|
||||||
gnu/packages/yasm.scm \
|
gnu/packages/yasm.scm \
|
||||||
gnu/packages/zile.scm \
|
gnu/packages/zile.scm \
|
||||||
gnu/packages/zip.scm \
|
gnu/packages/zip.scm \
|
||||||
|
\
|
||||||
|
gnu/system/grub.scm \
|
||||||
|
gnu/system/linux.scm \
|
||||||
|
gnu/system/shadow.scm \
|
||||||
gnu/system/vm.scm
|
gnu/system/vm.scm
|
||||||
|
|
||||||
patchdir = $(guilemoduledir)/gnu/packages/patches
|
patchdir = $(guilemoduledir)/gnu/packages/patches
|
||||||
|
|
|
||||||
|
|
@ -19,9 +19,6 @@
|
||||||
(define-module (gnu packages grub)
|
(define-module (gnu packages grub)
|
||||||
#:use-module (guix download)
|
#:use-module (guix download)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix records)
|
|
||||||
#:use-module (guix store)
|
|
||||||
#:use-module (guix derivations)
|
|
||||||
#:use-module ((guix licenses) #:select (gpl3+))
|
#:use-module ((guix licenses) #:select (gpl3+))
|
||||||
#:use-module (guix build-system gnu)
|
#:use-module (guix build-system gnu)
|
||||||
#:use-module (gnu packages)
|
#:use-module (gnu packages)
|
||||||
|
|
@ -33,11 +30,7 @@
|
||||||
#:use-module (gnu packages qemu)
|
#:use-module (gnu packages qemu)
|
||||||
#:use-module (gnu packages ncurses)
|
#:use-module (gnu packages ncurses)
|
||||||
#:use-module (gnu packages cdrom)
|
#:use-module (gnu packages cdrom)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1))
|
||||||
#:use-module (ice-9 match)
|
|
||||||
#:export (menu-entry
|
|
||||||
menu-entry?
|
|
||||||
grub-configuration-file))
|
|
||||||
|
|
||||||
(define qemu-for-tests
|
(define qemu-for-tests
|
||||||
;; Newer QEMU versions, such as 1.5.1, no longer support the 'shutdown'
|
;; Newer QEMU versions, such as 1.5.1, no longer support the 'shutdown'
|
||||||
|
|
@ -117,56 +110,3 @@ computer starts. It is responsible for loading and transferring control to
|
||||||
the operating system kernel software (such as the Hurd or the Linux). The
|
the operating system kernel software (such as the Hurd or the Linux). The
|
||||||
kernel, in turn, initializes the rest of the operating system (e.g., GNU).")
|
kernel, in turn, initializes the rest of the operating system (e.g., GNU).")
|
||||||
(license gpl3+)))
|
(license gpl3+)))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
|
||||||
;;; Configuration.
|
|
||||||
;;;
|
|
||||||
|
|
||||||
(define-record-type* <menu-entry>
|
|
||||||
menu-entry make-menu-entry
|
|
||||||
menu-entry?
|
|
||||||
(label menu-entry-label)
|
|
||||||
(linux menu-entry-linux)
|
|
||||||
(linux-arguments menu-entry-linux-arguments
|
|
||||||
(default '()))
|
|
||||||
(initrd menu-entry-initrd))
|
|
||||||
|
|
||||||
(define* (grub-configuration-file store entries
|
|
||||||
#:key (default-entry 1) (timeout 5)
|
|
||||||
(system (%current-system)))
|
|
||||||
"Return the GRUB configuration file in STORE for ENTRIES, a list of
|
|
||||||
<menu-entry> objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT."
|
|
||||||
(define prologue
|
|
||||||
(format #f "
|
|
||||||
set default=~a
|
|
||||||
set timeout=~a
|
|
||||||
search.file ~a~%"
|
|
||||||
default-entry timeout
|
|
||||||
(any (match-lambda
|
|
||||||
(($ <menu-entry> _ linux)
|
|
||||||
(let* ((drv (package-derivation store linux system))
|
|
||||||
(out (derivation-path->output-path drv)))
|
|
||||||
(string-append out "/bzImage"))))
|
|
||||||
entries)))
|
|
||||||
|
|
||||||
(define entry->text
|
|
||||||
(match-lambda
|
|
||||||
(($ <menu-entry> label linux arguments initrd)
|
|
||||||
(let ((linux-drv (package-derivation store linux system))
|
|
||||||
(initrd-drv (package-derivation store initrd system)))
|
|
||||||
;; XXX: Assume that INITRD is a directory containing an 'initrd' file.
|
|
||||||
(format #f "menuentry ~s {
|
|
||||||
linux ~a/bzImage ~a
|
|
||||||
initrd ~a/initrd
|
|
||||||
}~%"
|
|
||||||
label
|
|
||||||
(derivation-path->output-path linux-drv)
|
|
||||||
(string-join arguments)
|
|
||||||
(derivation-path->output-path initrd-drv))))))
|
|
||||||
|
|
||||||
(add-text-to-store store "grub.cfg"
|
|
||||||
(string-append prologue
|
|
||||||
(string-concatenate
|
|
||||||
(map entry->text entries)))
|
|
||||||
'()))
|
|
||||||
|
|
|
||||||
|
|
@ -32,18 +32,7 @@
|
||||||
#:use-module (gnu packages algebra)
|
#:use-module (gnu packages algebra)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix download)
|
#:use-module (guix download)
|
||||||
#:use-module (guix build-system gnu)
|
#:use-module (guix build-system gnu))
|
||||||
#:use-module (guix store)
|
|
||||||
#:use-module (guix derivations)
|
|
||||||
#:use-module (guix records)
|
|
||||||
#:use-module (srfi srfi-1)
|
|
||||||
#:use-module (srfi srfi-26)
|
|
||||||
#:use-module (ice-9 match)
|
|
||||||
#:export (pam-service
|
|
||||||
pam-entry
|
|
||||||
pam-services->directory
|
|
||||||
%pam-other-services
|
|
||||||
unix-pam-service))
|
|
||||||
|
|
||||||
(define-public (system->linux-architecture arch)
|
(define-public (system->linux-architecture arch)
|
||||||
"Return the Linux architecture name for ARCH, a Guix system name such as
|
"Return the Linux architecture name for ARCH, a Guix system name such as
|
||||||
|
|
@ -271,111 +260,6 @@ be used through the PAM API to perform tasks, like authenticating a user
|
||||||
at login. Local and dynamic reconfiguration are its key features")
|
at login. Local and dynamic reconfiguration are its key features")
|
||||||
(license bsd-3)))
|
(license bsd-3)))
|
||||||
|
|
||||||
;; 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 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 ($ <pam-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
|
|
||||||
;; <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?)
|
|
||||||
"Return a standard Unix-style PAM service for NAME. When
|
|
||||||
ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords."
|
|
||||||
;; 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 (list unix)))))))
|
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; Miscellaneous.
|
;;; Miscellaneous.
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,84 @@
|
||||||
|
;;; 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 grub)
|
||||||
|
#:use-module (guix store)
|
||||||
|
#:use-module (guix packages)
|
||||||
|
#:use-module (guix derivations)
|
||||||
|
#:use-module (guix records)
|
||||||
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (srfi srfi-1)
|
||||||
|
#:export (menu-entry
|
||||||
|
menu-entry?
|
||||||
|
grub-configuration-file))
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
;;;
|
||||||
|
;;; Configuration of GNU GRUB.
|
||||||
|
;;;
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(define-record-type* <menu-entry>
|
||||||
|
menu-entry make-menu-entry
|
||||||
|
menu-entry?
|
||||||
|
(label menu-entry-label)
|
||||||
|
(linux menu-entry-linux)
|
||||||
|
(linux-arguments menu-entry-linux-arguments
|
||||||
|
(default '()))
|
||||||
|
(initrd menu-entry-initrd))
|
||||||
|
|
||||||
|
(define* (grub-configuration-file store entries
|
||||||
|
#:key (default-entry 1) (timeout 5)
|
||||||
|
(system (%current-system)))
|
||||||
|
"Return the GRUB configuration file in STORE for ENTRIES, a list of
|
||||||
|
<menu-entry> objects, defaulting to DEFAULT-ENTRY and with the given TIMEOUT."
|
||||||
|
(define prologue
|
||||||
|
(format #f "
|
||||||
|
set default=~a
|
||||||
|
set timeout=~a
|
||||||
|
search.file ~a~%"
|
||||||
|
default-entry timeout
|
||||||
|
(any (match-lambda
|
||||||
|
(($ <menu-entry> _ linux)
|
||||||
|
(let* ((drv (package-derivation store linux system))
|
||||||
|
(out (derivation-path->output-path drv)))
|
||||||
|
(string-append out "/bzImage"))))
|
||||||
|
entries)))
|
||||||
|
|
||||||
|
(define entry->text
|
||||||
|
(match-lambda
|
||||||
|
(($ <menu-entry> label linux arguments initrd)
|
||||||
|
(let ((linux-drv (package-derivation store linux system))
|
||||||
|
(initrd-drv (package-derivation store initrd system)))
|
||||||
|
;; XXX: Assume that INITRD is a directory containing an 'initrd' file.
|
||||||
|
(format #f "menuentry ~s {
|
||||||
|
linux ~a/bzImage ~a
|
||||||
|
initrd ~a/initrd
|
||||||
|
}~%"
|
||||||
|
label
|
||||||
|
(derivation-path->output-path linux-drv)
|
||||||
|
(string-join arguments)
|
||||||
|
(derivation-path->output-path initrd-drv))))))
|
||||||
|
|
||||||
|
(add-text-to-store store "grub.cfg"
|
||||||
|
(string-append prologue
|
||||||
|
(string-concatenate
|
||||||
|
(map entry->text entries)))
|
||||||
|
'()))
|
||||||
|
|
||||||
|
;;; grub.scm ends here
|
||||||
|
|
@ -0,0 +1,145 @@
|
||||||
|
;;; 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 (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 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 ($ <pam-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
|
||||||
|
;; <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?)
|
||||||
|
"Return a standard Unix-style PAM service for NAME. When
|
||||||
|
ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords."
|
||||||
|
;; 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 (list unix)))))))
|
||||||
|
|
||||||
|
;;; linux.scm ends here
|
||||||
|
|
@ -0,0 +1,57 @@
|
||||||
|
;;; 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 shadow)
|
||||||
|
#:use-module (guix store)
|
||||||
|
#:use-module (ice-9 match)
|
||||||
|
#:export (passwd-file))
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
;;;
|
||||||
|
;;; Utilities for configuring the Shadow tool suite ('login', 'passwd', etc.)
|
||||||
|
;;;
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(define* (passwd-file store accounts #:key shadow?)
|
||||||
|
"Return a password file for ACCOUNTS, a list of vectors as returned by
|
||||||
|
'getpwnam'. If SHADOW? is true, then it is a /etc/shadow file, otherwise it
|
||||||
|
is a /etc/passwd file."
|
||||||
|
;; XXX: The resulting file is world-readable, so beware when SHADOW? is #t!
|
||||||
|
(define contents
|
||||||
|
(let loop ((accounts accounts)
|
||||||
|
(result '()))
|
||||||
|
(match accounts
|
||||||
|
((#(name pass uid gid comment home-dir shell) rest ...)
|
||||||
|
(loop rest
|
||||||
|
(cons (if shadow?
|
||||||
|
(string-append name
|
||||||
|
":" ; XXX: use (crypt PASS …)?
|
||||||
|
":::::::")
|
||||||
|
(string-append name
|
||||||
|
":" "x"
|
||||||
|
":" (number->string uid)
|
||||||
|
":" (number->string gid)
|
||||||
|
":" comment ":" home-dir ":" shell))
|
||||||
|
result)))
|
||||||
|
(()
|
||||||
|
(string-join (reverse result) "\n" 'suffix)))))
|
||||||
|
|
||||||
|
(add-text-to-store store (if shadow? "shadow" "passwd")
|
||||||
|
contents '()))
|
||||||
|
|
||||||
|
;;; shadow.scm ends here
|
||||||
|
|
@ -34,9 +34,15 @@
|
||||||
#:use-module ((gnu packages make-bootstrap)
|
#:use-module ((gnu packages make-bootstrap)
|
||||||
#:select (%guile-static-stripped))
|
#:select (%guile-static-stripped))
|
||||||
#:use-module (gnu packages system)
|
#:use-module (gnu packages system)
|
||||||
|
|
||||||
|
#:use-module (gnu system shadow)
|
||||||
|
#:use-module (gnu system linux)
|
||||||
|
#:use-module (gnu system grub)
|
||||||
|
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
|
|
||||||
#:export (expression->derivation-in-linux-vm
|
#:export (expression->derivation-in-linux-vm
|
||||||
qemu-image
|
qemu-image
|
||||||
system-qemu-image))
|
system-qemu-image))
|
||||||
|
|
@ -346,33 +352,6 @@ It can be used to provide additional files, such as /etc files."
|
||||||
;;; Stand-alone VM image.
|
;;; Stand-alone VM image.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(define* (passwd-file store accounts #:key shadow?)
|
|
||||||
"Return a password file for ACCOUNTS, a list of vectors as returned by
|
|
||||||
'getpwnam'. If SHADOW? is true, then it is a /etc/shadow file, otherwise it
|
|
||||||
is a /etc/passwd file."
|
|
||||||
;; XXX: The resulting file is world-readable, so beware when SHADOW? is #t!
|
|
||||||
(define contents
|
|
||||||
(let loop ((accounts accounts)
|
|
||||||
(result '()))
|
|
||||||
(match accounts
|
|
||||||
((#(name pass uid gid comment home-dir shell) rest ...)
|
|
||||||
(loop rest
|
|
||||||
(cons (if shadow?
|
|
||||||
(string-append name
|
|
||||||
":" ; XXX: use (crypt PASS …)?
|
|
||||||
":::::::")
|
|
||||||
(string-append name
|
|
||||||
":" "x"
|
|
||||||
":" (number->string uid)
|
|
||||||
":" (number->string gid)
|
|
||||||
":" comment ":" home-dir ":" shell))
|
|
||||||
result)))
|
|
||||||
(()
|
|
||||||
(string-join (reverse result) "\n" 'suffix)))))
|
|
||||||
|
|
||||||
(add-text-to-store store (if shadow? "shadow" "passwd")
|
|
||||||
contents '()))
|
|
||||||
|
|
||||||
(define (system-qemu-image store)
|
(define (system-qemu-image store)
|
||||||
"Return the derivation of a QEMU image of the GNU system."
|
"Return the derivation of a QEMU image of the GNU system."
|
||||||
(define %pam-services
|
(define %pam-services
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue