#: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)
system-service-type
provenance-service-type
+ sexp->system-provenance
system-provenance
boot-service-type
cleanup-service-type
(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
(mbegin %store-monad
(let ((config-file (cond ((string? config-file)
- (local-file config-file "configuration.scm"))
+ ;; CONFIG-FILE has been passed typically via
+ ;; 'guix system reconfigure CONFIG-FILE' so we
+ ;; can assume it's valid: tell 'local-file' to
+ ;; not emit a warning.
+ (local-file (assume-valid-file-name config-file)
+ "configuration.scm"))
((not config-file)
#f)
(else
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
#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))))
\f
"Return a gexp that runs the activation script containing GEXPS."
#~(primitive-load #$(activation-script gexps)))
+(define (activation-profile-entry gexps)
+ "Return, as a monadic value, an entry for the activation script in the
+system directory."
+ (mlet %store-monad ((activate (lower-object (activation-script gexps))))
+ (return `(("activate" ,activate)))))
+
(define (second-argument a b) b)
(define activation-service-type
(service-type (name 'activate)
(extensions
(list (service-extension boot-service-type
- gexps->activation-gexp)))
+ gexps->activation-gexp)
+ (service-extension system-service-type
+ activation-profile-entry)))
(compose identity)
(extend second-argument)
(description
(() #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
(define (packages->profile-entry packages)
"Return a system entry for the profile containing PACKAGES."
- (with-monad %store-monad
+ ;; XXX: 'mlet' is needed here for one reason: to get the proper
+ ;; '%current-target' and '%current-target-system' bindings when
+ ;; 'packages->manifest' is called, and thus when the 'package-inputs'
+ ;; etc. procedures are called on PACKAGES. That way, conditionals in those
+ ;; inputs see the "correct" value of these two parameters. See
+ ;; <https://issues.guix.gnu.org/44952>.
+ (mlet %store-monad ((_ (current-target-system)))
(return `(("profile" ,(profile
(content (packages->manifest
(delete-duplicates packages eq?)))))))))
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