From c061eb587cbb8590a5cd4793b56a01560af747a8 Mon Sep 17 00:00:00 2001 From: 宋文武 Date: Fri, 8 Jun 2018 23:12:37 +0800 Subject: services: dnsmasq: Use 'negative-cache?' instead of 'no-negcache?'. The 'no-negcache?' option is mapped to the '--no-negcache' command-line argument directly, but we're in the scheme world, where the general guideline is to avoid double-negations in identifiers. * gnu/services/dns.scm : Replace the 'no-negcache?' field with 'negative-cache?'. * doc/guix.texi (DNS Services)[Dnsmasq Service]: Adjust accordingly. --- gnu/services/dns.scm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm index d0913e90ed..1b39d0f508 100644 --- a/gnu/services/dns.scm +++ b/gnu/services/dns.scm @@ -622,8 +622,8 @@ (default '())) ;list of string (cache-size dnsmasq-configuration-cache-size (default 150)) ;integer - (no-negcache? dnsmasq-configuration-no-negcache? - (default #f))) ;boolean + (negative-cache? dnsmasq-configuration-negative-cache? + (default #t))) ;boolean (define dnsmasq-shepherd-service (match-lambda @@ -631,7 +631,7 @@ no-hosts? port local-service? listen-addresses resolv-file no-resolv? servers - cache-size no-negcache?) + cache-size negative-cache?) (shepherd-service (provision '(dnsmasq)) (requirement '(networking)) @@ -656,9 +656,9 @@ #$@(map (cut format #f "--server=~a" <>) servers) #$(format #f "--cache-size=~a" cache-size) - #$@(if no-negcache? - '("--no-negcache") - '())) + #$@(if negative-cache? + '() + '("--no-negcache"))) #:pid-file "/run/dnsmasq.pid")) (stop #~(make-kill-destructor)))))) -- cgit 1.4.1 From 0d4c2d35aff1bb28e2c105b9d7efc8c2a12d4601 Mon Sep 17 00:00:00 2001 From: 宋文武 Date: Fri, 8 Jun 2018 23:31:31 +0800 Subject: services: dnsmasq-service-type: Add default configuration and description. * gnu/services/dns.scm (dnsmasq-service-type) [default-value, description]: New fields. --- gnu/services/dns.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm index 1b39d0f508..2c57a36b84 100644 --- a/gnu/services/dns.scm +++ b/gnu/services/dns.scm @@ -667,4 +667,6 @@ (name 'dnsmasq) (extensions (list (service-extension shepherd-root-service-type - (compose list dnsmasq-shepherd-service)))))) + (compose list dnsmasq-shepherd-service)))) + (default-value (dnsmasq-configuration)) + (description "Run the dnsmasq DNS server."))) -- cgit 1.4.1 From 25e071ead9ddf701485750eec41fd869e310eab0 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 16 Feb 2018 18:19:42 +0000 Subject: services: nginx: Support extra content in the http block. This helpful when adding content to the nginx configuration file, which isn't supported by the record type used for the configuration. For example, like adding proxy_cache_path configuration. * gnu/packages/web.scm (): Add new extra-content field. (nginx-configuration-extra-content): New field accessor. (default-nginx-config): Add support for the extra-content field. * doc/guix.texi (NGINX): Document the new extra-content field. --- doc/guix.texi | 4 ++++ gnu/services/web.scm | 9 +++++++-- 2 files changed, 11 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 13b42f59f3..e734147681 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -15938,6 +15938,10 @@ use the size of the processors cache line. @item @code{server-names-hash-bucket-max-size} (default: @code{#f}) Maximum bucket size for the server names hash tables. +@item @code{extra-content} (default: @code{""}) +Extra content for the @code{http} block. Should be string or a string +valued G-expression. + @end table @end deffn diff --git a/gnu/services/web.scm b/gnu/services/web.scm index aae2f3db0d..9a58eff5ef 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -77,6 +77,7 @@ nginx-configuration-upstream-blocks nginx-configuration-server-names-hash-bucket-size nginx-configuration-server-names-hash-bucket-max-size + nginx-configuration-extra-content nginx-configuration-file @@ -431,6 +432,8 @@ (default #f)) (server-names-hash-bucket-max-size nginx-configuration-server-names-hash-bucket-max-size (default #f)) + (extra-content nginx-configuration-extra-content + (default "")) (file nginx-configuration-file ;#f | string | file-like (default #f))) @@ -521,7 +524,8 @@ of index files." (nginx log-directory run-directory server-blocks upstream-blocks server-names-hash-bucket-size - server-names-hash-bucket-max-size) + server-names-hash-bucket-max-size + extra-content) (apply mixed-text-file "nginx.conf" (flatten "user nginx nginx;\n" @@ -550,7 +554,8 @@ of index files." "\n" (map emit-nginx-upstream-config upstream-blocks) (map emit-nginx-server-config server-blocks) - "}\n" + extra-content + "\n}\n" "events {}\n")))) (define %nginx-accounts -- cgit 1.4.1 From 0975ca3fd4c65bfdd08fe887812ed6b5df9c5567 Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Thu, 14 Jun 2018 04:41:18 +0200 Subject: services: tor: Mark end of auto-generated configuration block. * gnu/services/networking.scm (tor-configuration->torrc): Clearly demarcate auto-generated lines. --- gnu/services/networking.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index e4441f6475..d5d0cf9d1d 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2017 Clément Lassieur ;;; Copyright © 2017 Thomas Danckaert ;;; Copyright © 2017 Marius Bakke +;;; Copyright © 2018 Tobias Geerinckx-Rice ;;; ;;; This file is part of GNU Guix. ;;; @@ -608,7 +609,7 @@ demand."))) (call-with-output-file #$output (lambda (port) (display "\ -# The beginning was automatically added. +### These lines were generated from your system configuration: User tor DataDirectory /var/lib/tor Log notice syslog\n" port) @@ -628,6 +629,9 @@ HiddenServicePort ~a ~a~%" (cons name mapping))) services)) + (display "\ +### End of automatically generated lines.\n\n" port) + ;; Append the user's config file. (call-with-input-file #$config-file (lambda (input) -- cgit 1.4.1 From 6892f0a247a06ac12c8c462692f8b3f93e872911 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 4 Jun 2018 22:06:34 +0200 Subject: store-copy: 'read-reference-graph' returns a list of records. The previous implementation of 'read-reference-graph' was good enough for many use cases, but it discarded the graph structure, which is useful information in some cases. * guix/build/store-copy.scm (): New record type. (read-reference-graph): Rewrite to return a list of . (closure-size, populate-store): Adjust accordingly. * gnu/services/base.scm (references-file): Adjust accordingly. * gnu/system/vm.scm (system-docker-image): Likewise. * guix/scripts/pack.scm (squashfs-image, docker-image): Likewise. * tests/gexp.scm ("gexp->derivation #:references-graphs"): Likewise. --- gnu/services/base.scm | 5 +- gnu/system/vm.scm | 6 ++- guix/build/store-copy.scm | 120 +++++++++++++++++++++++++++++++++++++++------- guix/scripts/pack.scm | 10 ++-- tests/gexp.scm | 17 ++++--- 5 files changed, 128 insertions(+), 30 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index b34bb7132b..68411439db 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1592,8 +1592,9 @@ failed to register hydra.gnu.org public key: ~a~%" status)))))))) (call-with-output-file #$output (lambda (port) - (write (call-with-input-file "graph" - read-reference-graph) + (write (map store-info-item + (call-with-input-file "graph" + read-reference-graph)) port))))) #:options `(#:local-build? #f #:references-graphs (("graph" ,item)))) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 544c0e294d..4aea53d1cd 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -466,8 +466,10 @@ should set REGISTER-CLOSURES? to #f." (build-docker-image (string-append "/xchg/" #$name) ;; The output file. (cons* root-directory - (call-with-input-file (string-append "/xchg/" #$graph) - read-reference-graph)) + (map store-info-item + (call-with-input-file + (string-append "/xchg/" #$graph) + read-reference-graph))) #$os-drv #:compressor '(#+(file-append gzip "/bin/gzip") "-9n") #:creation-time (make-time time-utc 0 1) diff --git a/guix/build/store-copy.scm b/guix/build/store-copy.scm index fe2eb6f69a..bad1c09cba 100644 --- a/guix/build/store-copy.scm +++ b/guix/build/store-copy.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2017 Ludovic Courtès +;;; Copyright © 2013, 2014, 2017, 2018 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,10 +18,21 @@ (define-module (guix build store-copy) #:use-module (guix build utils) + #:use-module (guix sets) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-26) + #:use-module (ice-9 match) #:use-module (ice-9 rdelim) #:use-module (ice-9 ftw) - #:export (read-reference-graph + #:use-module (ice-9 vlist) + #:export (store-info? + store-info-item + store-info-deriver + store-info-references + + read-reference-graph + closure-size populate-store)) @@ -34,19 +45,94 @@ ;;; ;;; Code: +;; Information about a store item as produced by #:references-graphs. +(define-record-type + (store-info item deriver references) + store-info? + (item store-info-item) ;string + (deriver store-info-deriver) ;#f | string + (references store-info-references)) ;? + +;; TODO: Factorize with that in (guix store). +(define (topological-sort nodes edges) + "Return NODES in topological order according to EDGES. EDGES must be a +one-argument procedure that takes a node and returns the nodes it is connected +to." + (define (traverse) + ;; Do a simple depth-first traversal of all of PATHS. + (let loop ((nodes nodes) + (visited (setq)) + (result '())) + (match nodes + ((head tail ...) + (if (set-contains? visited head) + (loop tail visited result) + (call-with-values + (lambda () + (loop (edges head) + (set-insert head visited) + result)) + (lambda (visited result) + (loop tail visited (cons head result)))))) + (() + (values visited result))))) + + (call-with-values traverse + (lambda (_ result) + (reverse result)))) + (define (read-reference-graph port) - "Return a list of store paths from the reference graph at PORT. -The data at PORT is the format produced by #:references-graphs." - (let loop ((line (read-line port)) - (result '())) - (cond ((eof-object? line) - (delete-duplicates result)) - ((string-prefix? "/" line) - (loop (read-line port) - (cons line result))) - (else - (loop (read-line port) - result))))) + "Read the reference graph as produced by #:references-graphs from PORT and +return it as a list of records in topological order--i.e., leaves +come first. IOW, store items in the resulting list can be registered in the +order in which they appear. + +The reference graph format consists of sequences of lines like this: + + FILE + DERIVER + NUMBER-OF-REFERENCES + REF1 + ... + REFN + +It is meant as an internal format." + (let loop ((result '()) + (table vlist-null) + (referrers vlist-null)) + (match (read-line port) + ((? eof-object?) + ;; 'guix-daemon' gives us something that's in "reverse topological + ;; order"--i.e., leaves (items with zero references) come last. Here + ;; we compute the topological order that we want: leaves come first. + (let ((unreferenced? (lambda (item) + (let ((referrers (vhash-fold* cons '() + (store-info-item item) + referrers))) + (or (null? referrers) + (equal? (list item) referrers)))))) + (topological-sort (filter unreferenced? result) + (lambda (item) + (map (lambda (item) + (match (vhash-assoc item table) + ((_ . node) node))) + (store-info-references item)))))) + (item + (let* ((deriver (match (read-line port) + ("" #f) + (line line))) + (count (string->number (read-line port))) + (refs (unfold-right (cut >= <> count) + (lambda (n) + (read-line port)) + 1+ + 0)) + (item (store-info item deriver refs))) + (loop (cons item result) + (vhash-cons (store-info-item item) item table) + (fold (cut vhash-cons <> item <>) + referrers + refs))))))) (define (file-size file) "Return the size of bytes of FILE, entering it if FILE is a directory." @@ -72,7 +158,8 @@ The data at PORT is the format produced by #:references-graphs." "Return an estimate of the size of the closure described by REFERENCE-GRAPHS, a list of reference-graph files." (define (graph-from-file file) - (call-with-input-file file read-reference-graph)) + (map store-info-item + (call-with-input-file file read-reference-graph))) (define items (delete-duplicates (append-map graph-from-file reference-graphs))) @@ -88,7 +175,8 @@ REFERENCE-GRAPHS, a list of reference-graph files." (define (things-to-copy) ;; Return the list of store files to copy to the image. (define (graph-from-file file) - (call-with-input-file file read-reference-graph)) + (map store-info-item + (call-with-input-file file read-reference-graph))) (delete-duplicates (append-map graph-from-file reference-graphs))) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 76729d8e10..78bfd01eff 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -251,8 +251,9 @@ added to the pack." ;; ancestor directories and only keeps the basename. We fix this ;; in the following invocations of mksquashfs. (apply invoke "mksquashfs" - `(,@(call-with-input-file "profile" - read-reference-graph) + `(,@(map store-info-item + (call-with-input-file "profile" + read-reference-graph)) ,#$output ;; Do not perform duplicate checking because we @@ -352,8 +353,9 @@ the image." (setenv "PATH" (string-append #$archiver "/bin")) (build-docker-image #$output - (call-with-input-file "profile" - read-reference-graph) + (map store-info-item + (call-with-input-file "profile" + read-reference-graph)) #$profile #:system (or #$target (utsname:machine (uname))) #:symlinks '#$symlinks diff --git a/tests/gexp.scm b/tests/gexp.scm index a560adfc5c..83fe811546 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -615,6 +615,7 @@ `(("graph" ,two)) #:modules '((guix build store-copy) + (guix sets) (guix build utils)))) (ok? (built-derivations (list drv))) (out -> (derivation->output-path drv))) @@ -815,21 +816,25 @@ (two (gexp->derivation "two" #~(symlink #$one #$output:chbouib))) (build -> (with-imported-modules '((guix build store-copy) + (guix sets) (guix build utils)) #~(begin (use-modules (guix build store-copy)) (with-output-to-file #$output (lambda () - (write (call-with-input-file "guile" - read-reference-graph)))) + (write (map store-info-item + (call-with-input-file "guile" + read-reference-graph))))) (with-output-to-file #$output:one (lambda () - (write (call-with-input-file "one" - read-reference-graph)))) + (write (map store-info-item + (call-with-input-file "one" + read-reference-graph))))) (with-output-to-file #$output:two (lambda () - (write (call-with-input-file "two" - read-reference-graph))))))) + (write (map store-info-item + (call-with-input-file "two" + read-reference-graph)))))))) (drv (gexp->derivation "ref-graphs" build #:references-graphs `(("one" ,one) ("two" ,two "chbouib") -- cgit 1.4.1 From 6a18183f4b82688bd4417d075d3f7ba20e008119 Mon Sep 17 00:00:00 2001 From: Nils Gillmann Date: Wed, 20 Jun 2018 08:39:20 +0000 Subject: services: Fix GPLv3 header in cuirass and pm modules. * gnu/services/cuirass.scm, gnu/services/pm.scm: Adjust to canonical GPLv3 header used throughout Guix. Signed-off-by: Leo Famulari --- gnu/services/cuirass.scm | 2 +- gnu/services/pm.scm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index c5e9fcbb22..a9ef9881b3 100644 --- a/gnu/services/cuirass.scm +++ b/gnu/services/cuirass.scm @@ -6,7 +6,7 @@ ;;; ;;; This file is part of GNU Guix. ;;; -;;; GNU Guix is free software: you can redistribute it and/or modify +;;; 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. diff --git a/gnu/services/pm.scm b/gnu/services/pm.scm index d40cb993e2..3817bd09de 100644 --- a/gnu/services/pm.scm +++ b/gnu/services/pm.scm @@ -3,7 +3,7 @@ ;;; ;;; This file is part of GNU Guix. ;;; -;;; GNU Guix is free software: you can redistribute it and/or modify +;;; 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. -- cgit 1.4.1 From 378daa8cb677121e1893f9173af1db060720d6e4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 20 Jun 2018 11:01:07 +0200 Subject: services: boot: Take gexps instead of monadic gexps. * gnu/services.scm (compute-boot-script): Rename 'mexps' to 'gexps' and remove 'mlet' form. (boot-service-type): Update comment. (cleanup-gexp): Remove 'with-monad' and 'return'. (activation-script): Rewrite in non-monadic style: use 'scheme-file' instead of 'gexp->file'. (gexps->activation-gexp): Remove 'mlet', return a gexp. * gnu/services/shepherd.scm (shepherd-boot-gexp): Remove 'with-monad' and 'return'. * gnu/system.scm (operating-system-boot-script): Remove outdated comment. * gnu/tests/base.scm (%cleanup-os): For 'dirty-service', remove 'with-monad' and 'return'. --- gnu/services.scm | 164 ++++++++++++++++++++++------------------------ gnu/services/shepherd.scm | 40 ++++++----- gnu/system.scm | 1 - gnu/tests/base.scm | 27 ++++---- 4 files changed, 110 insertions(+), 122 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services.scm b/gnu/services.scm index 51edb4868d..49cf01a4f8 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -337,15 +337,14 @@ containing the given entries." turn refers to everything the operating system needs: its kernel, initrd, system profile, boot script, and so on."))) -(define (compute-boot-script _ mexps) - ;; Reverse MEXPS so that extensions appear in the boot script in the right +(define (compute-boot-script _ gexps) + ;; Reverse GEXPS so that extensions appear in the boot script in the right ;; order. That is, user extensions would come first, and extensions added ;; by 'essential-services' (e.g., running shepherd) are guaranteed to come ;; last. - (mlet %store-monad ((gexps (sequence %store-monad (reverse mexps)))) - (gexp->file "boot" - ;; Clean up and activate the system, then spawn shepherd. - #~(begin #$@gexps)))) + (gexp->file "boot" + ;; Clean up and activate the system, then spawn shepherd. + #~(begin #$@(reverse gexps)))) (define (boot-script-entry mboot) "Return, as a monadic value, an entry for the boot script in the system @@ -354,9 +353,9 @@ directory." (return `(("boot" ,boot))))) (define boot-service-type - ;; The service of this type is extended by being passed gexps as monadic - ;; values. It aggregates them in a single script, as a monadic value, which - ;; becomes its 'parameters'. It is the only service that extends nothing. + ;; The service of this type is extended by being passed gexps. It + ;; aggregates them in a single script, as a monadic value, which becomes its + ;; value. (service-type (name 'boot) (extensions (list (service-extension system-service-type @@ -372,48 +371,46 @@ by the initrd once the root file system is mounted."))) (service boot-service-type #t)) (define (cleanup-gexp _) - "Return as a monadic value a gexp to clean up /tmp and similar places upon -boot." - (with-monad %store-monad - (with-imported-modules '((guix build utils)) - (return #~(begin - (use-modules (guix build utils)) - - ;; Clean out /tmp and /var/run. - ;; - ;; XXX This needs to happen before service activations, so it - ;; has to be here, but this also implicitly assumes that /tmp - ;; and /var/run are on the root partition. - (letrec-syntax ((fail-safe (syntax-rules () - ((_ exp rest ...) - (begin - (catch 'system-error - (lambda () exp) - (const #f)) - (fail-safe rest ...))) - ((_) - #t)))) - ;; Ignore I/O errors so the system can boot. - (fail-safe - ;; Remove stale Shadow lock files as they would lead to - ;; failures of 'useradd' & co. - (delete-file "/etc/group.lock") - (delete-file "/etc/passwd.lock") - (delete-file "/etc/.pwd.lock") ;from 'lckpwdf' - - ;; Force file names to be decoded as UTF-8. See - ;; . - (setenv "GUIX_LOCPATH" - #+(file-append glibc-utf8-locales "/lib/locale")) - (setlocale LC_CTYPE "en_US.utf8") - (delete-file-recursively "/tmp") - (delete-file-recursively "/var/run") - - (mkdir "/tmp") - (chmod "/tmp" #o1777) - (mkdir "/var/run") - (chmod "/var/run" #o755) - (delete-file-recursively "/run/udev/watch.old")))))))) + "Return a gexp to clean up /tmp and similar places upon boot." + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + ;; Clean out /tmp and /var/run. + ;; + ;; XXX This needs to happen before service activations, so it + ;; has to be here, but this also implicitly assumes that /tmp + ;; and /var/run are on the root partition. + (letrec-syntax ((fail-safe (syntax-rules () + ((_ exp rest ...) + (begin + (catch 'system-error + (lambda () exp) + (const #f)) + (fail-safe rest ...))) + ((_) + #t)))) + ;; Ignore I/O errors so the system can boot. + (fail-safe + ;; Remove stale Shadow lock files as they would lead to + ;; failures of 'useradd' & co. + (delete-file "/etc/group.lock") + (delete-file "/etc/passwd.lock") + (delete-file "/etc/.pwd.lock") ;from 'lckpwdf' + + ;; Force file names to be decoded as UTF-8. See + ;; . + (setenv "GUIX_LOCPATH" + #+(file-append glibc-utf8-locales "/lib/locale")) + (setlocale LC_CTYPE "en_US.utf8") + (delete-file-recursively "/tmp") + (delete-file-recursively "/var/run") + + (mkdir "/tmp") + (chmod "/tmp" #o1777) + (mkdir "/var/run") + (chmod "/var/run" #o755) + (delete-file-recursively "/run/udev/watch.old")))))) (define cleanup-service-type ;; Service that cleans things up in /tmp and similar. @@ -432,44 +429,39 @@ ACTIVATION-SCRIPT-TYPE." (define (activation-script gexps) "Return the system's activation script, which evaluates GEXPS." - (define (service-activations) - ;; Return the activation scripts for SERVICES. - (mapm %store-monad - (cut gexp->file "activate-service" <>) - gexps)) - - (mlet* %store-monad ((actions (service-activations))) - (gexp->file "activate" - (with-imported-modules (source-module-closure - '((gnu build activation) - (guix build utils))) - #~(begin - (use-modules (gnu build activation) - (guix build utils)) - - ;; Make sure the user accounting database exists. If it - ;; does not exist, 'setutxent' does not create it and - ;; thus there is no accounting at all. - (close-port (open-file "/var/run/utmpx" "a0")) - - ;; Same for 'wtmp', which is populated by mingetty et - ;; al. - (mkdir-p "/var/log") - (close-port (open-file "/var/log/wtmp" "a0")) - - ;; Set up /run/current-system. Among other things this - ;; sets up locales, which the activation snippets - ;; executed below may expect. - (activate-current-system) - - ;; Run the services' activation snippets. - ;; TODO: Use 'load-compiled'. - (for-each primitive-load '#$actions)))))) + (define actions + (map (cut scheme-file "activate-service" <>) gexps)) + + (scheme-file "activate" + (with-imported-modules (source-module-closure + '((gnu build activation) + (guix build utils))) + #~(begin + (use-modules (gnu build activation) + (guix build utils)) + + ;; Make sure the user accounting database exists. If it + ;; does not exist, 'setutxent' does not create it and + ;; thus there is no accounting at all. + (close-port (open-file "/var/run/utmpx" "a0")) + + ;; Same for 'wtmp', which is populated by mingetty et + ;; al. + (mkdir-p "/var/log") + (close-port (open-file "/var/log/wtmp" "a0")) + + ;; Set up /run/current-system. Among other things this + ;; sets up locales, which the activation snippets + ;; executed below may expect. + (activate-current-system) + + ;; Run the services' activation snippets. + ;; TODO: Use 'load-compiled'. + (for-each primitive-load '#$actions))))) (define (gexps->activation-gexp gexps) "Return a gexp that runs the activation script containing GEXPS." - (mlet %store-monad ((script (activation-script gexps))) - (return #~(primitive-load #$script)))) + #~(primitive-load #$(activation-script gexps))) (define (second-argument a b) b) diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm index 000e85eb86..6ca53faa3d 100644 --- a/gnu/services/shepherd.scm +++ b/gnu/services/shepherd.scm @@ -22,7 +22,6 @@ #:use-module (guix sets) #:use-module (guix gexp) #:use-module (guix store) - #:use-module (guix monads) #:use-module (guix records) #:use-module (guix derivations) ;imported-modules, etc. #:use-module (gnu services) @@ -66,26 +65,25 @@ (define (shepherd-boot-gexp services) - (with-monad %store-monad - (return #~(begin - ;; Keep track of the booted system. - (false-if-exception (delete-file "/run/booted-system")) - (symlink (readlink "/run/current-system") - "/run/booted-system") - - ;; Close any remaining open file descriptors to be on the safe - ;; side. This must be the very last thing we do, because - ;; Guile has internal FDs such as 'sleep_pipe' that need to be - ;; alive. - (let loop ((fd 3)) - (when (< fd 1024) - (false-if-exception (close-fdes fd)) - (loop (+ 1 fd)))) - - ;; Start shepherd. - (execl #$(file-append shepherd "/bin/shepherd") - "shepherd" "--config" - #$(shepherd-configuration-file services)))))) + #~(begin + ;; Keep track of the booted system. + (false-if-exception (delete-file "/run/booted-system")) + (symlink (readlink "/run/current-system") + "/run/booted-system") + + ;; Close any remaining open file descriptors to be on the safe + ;; side. This must be the very last thing we do, because + ;; Guile has internal FDs such as 'sleep_pipe' that need to be + ;; alive. + (let loop ((fd 3)) + (when (< fd 1024) + (false-if-exception (close-fdes fd)) + (loop (+ 1 fd)))) + + ;; Start shepherd. + (execl #$(file-append shepherd "/bin/shepherd") + "shepherd" "--config" + #$(shepherd-configuration-file services)))) (define shepherd-root-service-type (service-type diff --git a/gnu/system.scm b/gnu/system.scm index 7c51c4da97..84eab5f84f 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -819,7 +819,6 @@ we're running in the final root. When CONTAINER? is true, skip all hardware-related operations as necessary when booting a Linux container." (let* ((services (operating-system-services os #:container? container?)) (boot (fold-services services #:target-type boot-service-type))) - ;; BOOT is the script as a monadic value. (service-value boot))) (define (operating-system-user-accounts os) diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index d209066a74..4c24cf57f6 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -484,20 +484,19 @@ in a loop. See .") (simple-operating-system (simple-service 'dirty-things boot-service-type - (with-monad %store-monad - (let ((script (plain-file - "create-utf8-file.sh" - (string-append - "echo $0: dirtying /tmp...\n" - "set -e; set -x\n" - "touch /witness\n" - "exec touch /tmp/λαμβδα")))) - (with-imported-modules '((guix build utils)) - (return #~(begin - (setenv "PATH" - #$(file-append coreutils "/bin")) - (invoke #$(file-append bash "/bin/sh") - #$script))))))))) + (let ((script (plain-file + "create-utf8-file.sh" + (string-append + "echo $0: dirtying /tmp...\n" + "set -e; set -x\n" + "touch /witness\n" + "exec touch /tmp/λαμβδα")))) + (with-imported-modules '((guix build utils)) + #~(begin + (setenv "PATH" + #$(file-append coreutils "/bin")) + (invoke #$(file-append bash "/bin/sh") + #$script))))))) (define (run-cleanup-test name) (define os -- cgit 1.4.1 From 86cd3f97230fe8914cfbbf0df0b26ea2c9b9502d Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 22 Jun 2018 12:37:19 +0200 Subject: services: cups: Add description. * gnu/services/cups.scm (cups-service-type): Add description. --- gnu/services/cups.scm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/cups.scm b/gnu/services/cups.scm index 4c62e6a6f7..715d333a71 100644 --- a/gnu/services/cups.scm +++ b/gnu/services/cups.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Andy Wingo ;;; Copyright © 2017 Clément Lassieur +;;; Copyright © 2018 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -1024,7 +1025,9 @@ extensions that it uses." (append (opaque-cups-configuration-extensions config) extensions))))))) - (default-value (cups-configuration)))) + (default-value (cups-configuration)) + (description + "Run the CUPS print server."))) ;; A little helper to make it easier to document all those fields. (define (generate-cups-documentation) -- cgit 1.4.1 From a64160d246e439c88108694102124e8abcbdeb80 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 22 Jun 2018 12:37:58 +0200 Subject: services: cuirass: Add description. * gnu/services/cuirass.scm (cuirass-service-type): Add description. --- gnu/services/cuirass.scm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index a9ef9881b3..4664a36dcf 100644 --- a/gnu/services/cuirass.scm +++ b/gnu/services/cuirass.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2016, 2017 Ludovic Courtès ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2017 Jan Nieuwenhuizen +;;; Copyright © 2018 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. ;;; @@ -172,5 +173,7 @@ (service-extension rottlog-service-type cuirass-log-rotations) (service-extension activation-service-type cuirass-activation) (service-extension shepherd-root-service-type cuirass-shepherd-service) - (service-extension account-service-type cuirass-account))))) + (service-extension account-service-type cuirass-account))) + (description + "Run the Cuirass continuous integration service."))) -- cgit 1.4.1 From 7f93bbd5aadf0427190769fba8f478c29e37b4f4 Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Wed, 30 May 2018 19:44:15 +0200 Subject: services: Add fingerprint identification service. * gnu/services/authentication.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. * doc/guix.texi (Miscellaneous Services): Document it. --- doc/guix.texi | 15 +++++++++++++++ gnu/local.mk | 1 + gnu/services/authentication.scm | 41 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 57 insertions(+) create mode 100644 gnu/services/authentication.scm (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 1ecb110020..74c10e4bbf 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -20043,6 +20043,21 @@ The port to bind the server to. @node Miscellaneous Services @subsubsection Miscellaneous Services +@cindex fingerprint +@subsubheading Fingerprint Service + +The @code{(gnu services fingerprint)} module provides a DBus service to +read and identify fingerprints via a fingerprint sensor. + +@defvr {Scheme Variable} fprintd-service-type +The service type for @command{fprintd}, which provides the fingerprint +reading capability. + +@example +(service fprintd-service-type) +@end example +@end defvr + @cindex sysctl @subsubheading System Control Service diff --git a/gnu/local.mk b/gnu/local.mk index 8a9559328b..9d8947d55d 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -471,6 +471,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/desktop.scm \ %D%/services/dict.scm \ %D%/services/dns.scm \ + %D%/services/authentication.scm \ %D%/services/games.scm \ %D%/services/kerberos.scm \ %D%/services/lirc.scm \ diff --git a/gnu/services/authentication.scm b/gnu/services/authentication.scm new file mode 100644 index 0000000000..1ab2b03003 --- /dev/null +++ b/gnu/services/authentication.scm @@ -0,0 +1,41 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 Danny Milosavljevic +;;; +;;; 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 services fingerprint) + #:use-module (gnu services) + #:use-module (gnu services dbus) + #:use-module (gnu packages freedesktop) + #:use-module (guix gexp) + #:use-module (guix records) + #:export (fprintd-configuration + fprintd-configuration? + fprintd-service-type)) + +(define-record-type* + fprintd-configuration make-fprintd-configuration + fprintd-configuration? + (ntp fprintd-configuration-fprintd + (default fprintd))) + +(define fprintd-service-type + (service-type (name 'fprintd) + (extensions + (list (service-extension dbus-root-service-type + list))) + (description + "Run fprintd, a fingerprint management daemon."))) -- cgit 1.4.1 From 812f6bd82dd584cc0551a687ec52315ae8ee4afb Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Sat, 23 Jun 2018 00:21:23 +0200 Subject: services: Fix "authentication" service name. Follow-up to 7f93bbd5aadf0427190769fba8f478c29e37b4f4. * gnu/services/authentication.scm: Fix module name. --- gnu/services/authentication.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/authentication.scm b/gnu/services/authentication.scm index 1ab2b03003..1a2629d475 100644 --- a/gnu/services/authentication.scm +++ b/gnu/services/authentication.scm @@ -16,7 +16,7 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . -(define-module (gnu services fingerprint) +(define-module (gnu services authentication) #:use-module (gnu services) #:use-module (gnu services dbus) #:use-module (gnu packages freedesktop) -- cgit 1.4.1 From 1e3861eb00a2e9531bc4326b37a31405e34cc0ff Mon Sep 17 00:00:00 2001 From: Oleg Pykhalov Date: Sun, 24 Jun 2018 13:18:53 +0300 Subject: services: alsa-service-type: Fix the loading of 'pulse' plugin. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . * gnu/services/sound.scm ()[alsa-plugins]: New field. (alsa-config-file): Use 'pcm_type.pulse' and 'ctl_type.pulse' to specify file paths to the 'pulse' plugin. * doc/guix.texi (Sound Services): Document this. Co-authored-by: 宋文武 --- doc/guix.texi | 3 +++ gnu/services/sound.scm | 34 ++++++++++++++++++++++++---------- 2 files changed, 27 insertions(+), 10 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 74c10e4bbf..e5366ac6b7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -13152,6 +13152,9 @@ See below for details about @code{alsa-configuration}. Data type representing the configuration for @code{alsa-service}. @table @asis +@item @code{alsa-plugins} (default: @var{alsa-plugins}) +@code{alsa-plugins} package to use. + @item @code{pulseaudio?} (default: @var{#t}) Whether ALSA applications should transparently be made to use the @uref{http://www.pulseaudio.org/, PulseAudio} sound server. diff --git a/gnu/services/sound.scm b/gnu/services/sound.scm index 5fe555e8b6..f2dd24402f 100644 --- a/gnu/services/sound.scm +++ b/gnu/services/sound.scm @@ -26,6 +26,7 @@ #:use-module (guix packages) #:use-module (guix records) #:use-module (guix store) + #:use-module (gnu packages linux) #:use-module (gnu packages pulseaudio) #:use-module (ice-9 match) #:export (alsa-configuration @@ -44,17 +45,31 @@ (define-record-type* alsa-configuration make-alsa-configuration alsa-configuration? + (alsa-plugins alsa-configuration-alsa-plugins ; + (default alsa-plugins)) (pulseaudio? alsa-configuration-pulseaudio? ;boolean (default #t)) (extra-options alsa-configuration-extra-options ;string (default ""))) -(define (alsa-config-file config) - "Return the ALSA configuration file corresponding to CONFIG." - (plain-file "asound.conf" - (string-append "# Generated by 'alsa-service'.\n\n" - (if (alsa-configuration-pulseaudio? config) - "# Use PulseAudio by default +(define alsa-config-file + ;; Return the ALSA configuration file. + (match-lambda + (($ alsa-plugins pulseaudio? extra-options) + (apply mixed-text-file "asound.conf" + `("# Generated by 'alsa-service'.\n\n" + ,@(if pulseaudio? + `("# Use PulseAudio by default +pcm_type.pulse { + lib \"" ,#~(string-append #$alsa-plugins:pulseaudio + "/lib/alsa-lib/libasound_module_pcm_pulse.so") "\" +} + +ctl_type.pulse { + lib \"" ,#~(string-append #$alsa-plugins:pulseaudio + "/lib/alsa-lib/libasound_module_ctl_pulse.so") "\" +} + pcm.!default { type pulse fallback \"sysdefault\" @@ -67,10 +82,9 @@ pcm.!default { ctl.!default { type pulse fallback \"sysdefault\" -} -" - "") - (alsa-configuration-extra-options config)))) +}\n\n") + '()) + ,extra-options))))) (define (alsa-etc-service config) (list `("asound.conf" ,(alsa-config-file config)))) -- cgit 1.4.1