diff options
Diffstat (limited to 'gnu/services.scm')
| -rw-r--r-- | gnu/services.scm | 58 |
1 files changed, 32 insertions, 26 deletions
diff --git a/gnu/services.scm b/gnu/services.scm index 6509a9014e..11ba21e824 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -30,7 +30,7 @@ #:use-module (guix describe) #:use-module (guix sets) #:use-module (guix ui) - #:use-module ((guix utils) #:select (source-properties->location)) + #:use-module (guix diagnostics) #:autoload (guix openpgp) (openpgp-format-fingerprint) #:use-module (guix modules) #:use-module (gnu packages base) @@ -89,6 +89,7 @@ system-service-type provenance-service-type + sexp->system-provenance system-provenance boot-service-type cleanup-service-type @@ -242,13 +243,13 @@ TYPE does not have a default value, an error is raised." (if (eq? default &no-default-value) (let ((location (source-properties->location location))) (raise - (condition - (&missing-value-service-error (type type) (location location)) - (&message - (message (format #f (G_ "~a: no value specified \ + (make-compound-condition + (condition + (&missing-value-service-error (type type) (location location))) + (formatted-message (G_ "~a: no value specified \ for service of type '~a'") - (location->string location) - (service-type-name type))))))) + (location->string location) + (service-type-name type))))) (service type default)))) (define-condition-type &service-error &error @@ -488,6 +489,19 @@ channels in use and CONFIG-FILE, if it is true." itself: the channels used when building the system, and its configuration file, when available."))) +(define (sexp->system-provenance sexp) + "Parse SEXP, an s-expression read from /run/current-system/provenance or +similar, and return two values: the list of channels listed therein, and the +OS configuration file or #f." + (match sexp + (('provenance ('version 0) + ('channels channels ...) + ('configuration-file config-file)) + (values (map sexp->channel channels) + config-file)) + (_ + (values '() #f)))) + (define (system-provenance system) "Given SYSTEM, the file name of a system generation, return two values: the list of channels SYSTEM is built from, and its configuration file. If that @@ -495,15 +509,9 @@ information is missing, return the empty list (for channels) and possibly #false (for the configuration file)." (catch 'system-error (lambda () - (match (call-with-input-file (string-append system "/provenance") - read) - (('provenance ('version 0) - ('channels channels ...) - ('configuration-file config-file)) - (values (map sexp->channel channels) - config-file)) - (_ - (values '() #f)))) + (sexp->system-provenance + (call-with-input-file (string-append system "/provenance") + read))) (lambda _ (values '() #f)))) @@ -725,10 +733,8 @@ and FILE could be \"/usr/bin/env\"." (() #t) (((file _) rest ...) (when (set-contains? seen file) - (raise (condition - (&message - (message (format #f (G_ "duplicate '~a' entry for /etc") - file)))))) + (raise (formatted-message (G_ "duplicate '~a' entry for /etc") + file))) (loop rest (set-insert file seen)))))) ;; Detect duplicates early instead of letting them through, eventually @@ -1000,12 +1006,12 @@ TARGET-TYPE; return the root service adjusted accordingly." vlist-null)) (() (raise - (condition (&missing-target-service-error - (service #f) - (target-type target-type)) - (&message - (message (format #f (G_ "service of type '~a' not found") - (service-type-name target-type))))))) + (make-compound-condition + (condition (&missing-target-service-error + (service #f) + (target-type target-type))) + (formatted-message (G_ "service of type '~a' not found") + (service-type-name target-type))))) (x (raise (condition (&ambiguous-target-service-error |