From b5f4e686359d8842b329e6b161ef89fa6c04ebc3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 28 Apr 2014 23:07:08 +0200 Subject: services: Rewrite using gexps. * gnu/services.scm ()[inputs]: Remove. * gnu/system.scm (links): Remove. (etc-directory): Add PASSWD and SHADOW to #:inputs. (operating-system-boot-script): Pass ETC to 'dmd-configuration-file'. (operating-system-derivation): Remove EXTRAS from the union. * gnu/system/linux.scm (pam-service->configuration): Rewrite in terms of 'gexp->derivation'. Compute the contents on the build side. Expect 'arguments' to contain a list of gexps. (pam-services->directory): Rewrite in terms of 'gexp->derivation'. (unix-pam-service): Change 'arguments' to a list of one gexp. * gnu/system/shadow.scm ()[inputs]: Remove. [shell]: Change default value to a gexp. (passwd-file): Rewrite in terms of 'gexp->derivation'. Compute contents on the build side. * gnu/services/base.scm (host-name-service, mingetty-service, nscd-service, syslog-service, guix-service): Change 'start' and 'stop' to gexps; remove 'inputs' field. (guix-build-accounts): Change 'shell' field to a gexp. * gnu/services/networking.scm (static-networking-service): Change 'start' and 'stop' to gexps; remove 'inputs' field. * gnu/services/xorg.scm (slim-service): Likewise. * gnu/services/dmd.scm (dmd-configuration-file): Expect ETC to be a derivation. Change 'config' to a gexp. Use 'gexp->file' instead of 'text-file'. * doc/guix.texi (Defining Services): Update nscd example with gexps, and without 'inputs'. Add xref to "G-Expressions". --- gnu/system/linux.scm | 74 +++++++++++++++++++++++++-------------------------- gnu/system/shadow.scm | 48 ++++++++++++++------------------- 2 files changed, 57 insertions(+), 65 deletions(-) (limited to 'gnu/system') diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm index 65868ce9bf..efe27c55c3 100644 --- a/gnu/system/linux.scm +++ b/gnu/system/linux.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,6 +21,7 @@ #:use-module (guix records) #:use-module (guix derivations) #:use-module (guix monads) + #:use-module (guix gexp) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) @@ -58,58 +59,56 @@ (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 + (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 configuration string for SERVICE, to be dumped in -/etc/pam.d/NAME, where NAME is the name of SERVICE." - (define (entry->string type entry) + "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 ...)) - (string-append type " " - control " " module " " - (string-join arguments) - "\n")))) + #~(format #t "~a ~a ~a ~a~%" + #$type #$control #$module + (string-join (list #$@arguments)))))) (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 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)))) + + (gexp->derivation name builder)))) (define (pam-services->directory services) "Return the derivation to build the configuration directory to be used as /etc/pam.d for SERVICES." (mlet %store-monad ((names -> (map pam-service-name services)) - (files (mapm %store-monad - (match-lambda - ((and service ($ name)) - (let ((config (pam-service->configuration service))) - (text-file (string-append name ".pam") config)))) - - ;; XXX: Eventually, SERVICES may be a list of monadic - ;; values instead of plain values. - (map return services)))) + (files (sequence %store-monad + (map pam-service->configuration + ;; XXX: Eventually, SERVICES may be a list of + ;; monadic values instead of plain values. + services)))) (define builder - '(begin - (use-modules (ice-9 match)) + #~(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))) + (mkdir #$output) + (for-each (match-lambda + ((name file) + (symlink file (string-append #$output "/" name)))) + '#$(zip names files)))) - (derivation-expression "pam.d" builder - #:inputs (zip names files)))) + (gexp->derivation "pam.d" builder))) (define %pam-other-services ;; The "other" PAM configuration, which denies everything (see @@ -149,7 +148,8 @@ should be the name of a file used as the message-of-the-day." (pam-entry (control "optional") (module "pam_motd.so") - (arguments (list (string-append "motd=" motd))))) + (arguments + (list #~(string-append "motd=" #$motd))))) (list unix)))))))) ;;; linux.scm ends here diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index 2a85a20ebb..52242ee4e0 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,6 +20,7 @@ #:use-module (guix store) #:use-module (guix records) #:use-module (guix packages) + #:use-module (guix gexp) #:use-module (guix monads) #:use-module ((gnu packages admin) #:select (shadow)) @@ -35,7 +36,6 @@ user-account-comment user-account-home-directory user-account-shell - user-account-inputs user-group user-group? @@ -63,9 +63,8 @@ (gid user-account-gid) (comment user-account-comment (default "")) (home-directory user-account-home-directory) - (shell user-account-shell ; monadic value - (default (package-file bash "bin/bash"))) - (inputs user-account-inputs (default `(("bash" ,bash))))) + (shell user-account-shell ; gexp + (default #~(string-append #$bash "/bin/bash")))) (define-record-type* user-group make-user-group @@ -97,29 +96,22 @@ 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) - (with-monad %store-monad - (let loop ((accounts accounts) - (result '())) - (match accounts - ((($ name pass uid gid comment home-dir mshell) - rest ...) - (mlet %store-monad ((shell mshell)) - (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)))) - (() - (return (string-join (reverse result) "\n" 'suffix))))))) + (define account-exp + (match-lambda + (($ name pass uid gid comment home-dir shell) + (if shadow? ; XXX: use (crypt PASS …)? + #~(format #t "~a::::::::~%" #$name) + #~(format #t "~a:x:~a:~a:~a:~a:~a~%" + #$name #$(number->string uid) #$(number->string gid) + #$comment #$home-dir #$shell))))) - (mlet %store-monad ((contents (contents))) - (text-file (if shadow? "shadow" "passwd") contents))) + (define builder + #~(begin + (with-output-to-file #$output + (lambda () + #$@(map account-exp accounts) + #t)))) + + (gexp->derivation (if shadow? "shadow" "passwd") builder)) ;;; shadow.scm ends here -- cgit v1.2.3