mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
services: Add 'provenance-service-type'.
* gnu/services.scm (object->pretty-string) (channel->code, channel->sexp, provenance-file) (provenance-entry): New procedures. (provenance-service-type): New variable. * gnu/system.scm (operating-system-with-provenance): New procedure. * doc/guix.texi (Service Reference): Document 'provenance-service-type'.
This commit is contained in:
parent
362bcdb1b0
commit
33b7cb7a59
3 changed files with 141 additions and 0 deletions
|
@ -27043,6 +27043,50 @@ programs under @file{/run/current-system/profile}. Other services can
|
||||||
extend it by passing it lists of packages to add to the system profile.
|
extend it by passing it lists of packages to add to the system profile.
|
||||||
@end defvr
|
@end defvr
|
||||||
|
|
||||||
|
@cindex provenance tracking, of the operating system
|
||||||
|
@defvr {Scheme Variable} provenance-service-type
|
||||||
|
This is the type of the service that records @dfn{provenance meta-data}
|
||||||
|
in the system itself. It creates several files under
|
||||||
|
@file{/run/current-system}:
|
||||||
|
|
||||||
|
@table @file
|
||||||
|
@item channels.scm
|
||||||
|
This is a ``channel file'' that can be passed to @command{guix pull -C}
|
||||||
|
or @command{guix time-machine -C}, and which describes the channels used
|
||||||
|
to build the system, if that information was available
|
||||||
|
(@pxref{Channels}).
|
||||||
|
|
||||||
|
@item configuration.scm
|
||||||
|
This is the file that was passed as the value for this
|
||||||
|
@code{provenance-service-type} service. By default, @command{guix
|
||||||
|
system reconfigure} automatically passes the OS configuration file it
|
||||||
|
received on the command line.
|
||||||
|
|
||||||
|
@item provenance
|
||||||
|
This contains the same information as the two other files but in a
|
||||||
|
format that is more readily processable.
|
||||||
|
@end table
|
||||||
|
|
||||||
|
In general, these two pieces of information (channels and configuration
|
||||||
|
file) are enough to reproduce the operating system ``from source''.
|
||||||
|
|
||||||
|
@quotation Caveats
|
||||||
|
This information is necessary to rebuild your operating system, but it
|
||||||
|
is not always sufficient. In particular, @file{configuration.scm}
|
||||||
|
itself is insufficient if it is not self-contained---if it refers to
|
||||||
|
external Guile modules or to extra files. If you want
|
||||||
|
@file{configuration.scm} to be self-contained, we recommend that modules
|
||||||
|
or files it refers to be part of a channel.
|
||||||
|
|
||||||
|
Besides, provenance meta-data is ``silent'' in the sense that it does
|
||||||
|
not change the bits contained in your system, @emph{except for the
|
||||||
|
meta-data bits themselves}. Two different OS configurations or sets of
|
||||||
|
channels can lead to the same system, bit-for-bit; when
|
||||||
|
@code{provenance-service-type} is used, these two systems will have
|
||||||
|
different meta-data and thus different store file names, which makes
|
||||||
|
comparison less trivial.
|
||||||
|
@end quotation
|
||||||
|
@end defvr
|
||||||
|
|
||||||
@node Shepherd Services
|
@node Shepherd Services
|
||||||
@subsection Shepherd Services
|
@subsection Shepherd Services
|
||||||
|
|
|
@ -25,6 +25,8 @@ (define-module (gnu services)
|
||||||
#:use-module (guix profiles)
|
#:use-module (guix profiles)
|
||||||
#:use-module (guix discovery)
|
#:use-module (guix discovery)
|
||||||
#:use-module (guix combinators)
|
#:use-module (guix combinators)
|
||||||
|
#:use-module (guix channels)
|
||||||
|
#:use-module (guix describe)
|
||||||
#:use-module (guix sets)
|
#:use-module (guix sets)
|
||||||
#:use-module (guix ui)
|
#:use-module (guix ui)
|
||||||
#:use-module ((guix utils) #:select (source-properties->location))
|
#:use-module ((guix utils) #:select (source-properties->location))
|
||||||
|
@ -39,6 +41,7 @@ (define-module (gnu services)
|
||||||
#:use-module (srfi srfi-35)
|
#:use-module (srfi srfi-35)
|
||||||
#:use-module (ice-9 vlist)
|
#:use-module (ice-9 vlist)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
|
#:autoload (ice-9 pretty-print) (pretty-print)
|
||||||
#:export (service-extension
|
#:export (service-extension
|
||||||
service-extension?
|
service-extension?
|
||||||
service-extension-target
|
service-extension-target
|
||||||
|
@ -82,6 +85,7 @@ (define-module (gnu services)
|
||||||
ambiguous-target-service-error-target-type
|
ambiguous-target-service-error-target-type
|
||||||
|
|
||||||
system-service-type
|
system-service-type
|
||||||
|
provenance-service-type
|
||||||
boot-service-type
|
boot-service-type
|
||||||
cleanup-service-type
|
cleanup-service-type
|
||||||
activation-service-type
|
activation-service-type
|
||||||
|
@ -370,6 +374,89 @@ (define %boot-service
|
||||||
;; The service that produces the boot script.
|
;; The service that produces the boot script.
|
||||||
(service boot-service-type #t))
|
(service boot-service-type #t))
|
||||||
|
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Provenance tracking.
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(define (object->pretty-string obj)
|
||||||
|
"Like 'object->string', but using 'pretty-print'."
|
||||||
|
(call-with-output-string
|
||||||
|
(lambda (port)
|
||||||
|
(pretty-print obj port))))
|
||||||
|
|
||||||
|
(define (channel->code channel)
|
||||||
|
"Return code to build CHANNEL, ready to be dropped in a 'channels.scm'
|
||||||
|
file."
|
||||||
|
`(channel (name ',(channel-name channel))
|
||||||
|
(url ,(channel-url channel))
|
||||||
|
(branch ,(channel-branch channel))
|
||||||
|
(commit ,(channel-commit channel))))
|
||||||
|
|
||||||
|
(define (channel->sexp channel)
|
||||||
|
"Return an sexp describing CHANNEL. The sexp is _not_ code and is meant to
|
||||||
|
be parsed by tools; it's potentially more future-proof than code."
|
||||||
|
`(channel (name ,(channel-name channel))
|
||||||
|
(url ,(channel-url channel))
|
||||||
|
(branch ,(channel-branch channel))
|
||||||
|
(commit ,(channel-commit channel))))
|
||||||
|
|
||||||
|
(define (provenance-file channels config-file)
|
||||||
|
"Return a 'provenance' file describing CHANNELS, a list of channels, and
|
||||||
|
CONFIG-FILE, which can be either #f or a <local-file> containing the OS
|
||||||
|
configuration being used."
|
||||||
|
(scheme-file "provenance"
|
||||||
|
#~(provenance
|
||||||
|
(version 0)
|
||||||
|
(channels #+@(if channels
|
||||||
|
(map channel->sexp channels)
|
||||||
|
'()))
|
||||||
|
(configuration-file #+config-file))))
|
||||||
|
|
||||||
|
(define (provenance-entry config-file)
|
||||||
|
"Return system entries describing the operating system provenance: the
|
||||||
|
channels in use and CONFIG-FILE, if it is true."
|
||||||
|
(define profile
|
||||||
|
(current-profile))
|
||||||
|
|
||||||
|
(define channels
|
||||||
|
(and=> profile profile-channels))
|
||||||
|
|
||||||
|
(mbegin %store-monad
|
||||||
|
(let ((config-file (cond ((string? config-file)
|
||||||
|
(local-file config-file "configuration.scm"))
|
||||||
|
((not config-file)
|
||||||
|
#f)
|
||||||
|
(else
|
||||||
|
config-file))))
|
||||||
|
(return `(("provenance" ,(provenance-file channels config-file))
|
||||||
|
,@(if channels
|
||||||
|
`(("channels.scm"
|
||||||
|
,(plain-file "channels.scm"
|
||||||
|
(object->pretty-string
|
||||||
|
`(list
|
||||||
|
,@(map channel->code channels))))))
|
||||||
|
'())
|
||||||
|
,@(if config-file
|
||||||
|
`(("configuration.scm" ,config-file))
|
||||||
|
'()))))))
|
||||||
|
|
||||||
|
(define provenance-service-type
|
||||||
|
(service-type (name 'provenance)
|
||||||
|
(extensions
|
||||||
|
(list (service-extension system-service-type
|
||||||
|
provenance-entry)))
|
||||||
|
(default-value #f) ;the OS config file
|
||||||
|
(description
|
||||||
|
"Store provenance information about the system in the system
|
||||||
|
itself: the channels used when building the system, and its configuration
|
||||||
|
file, when available.")))
|
||||||
|
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Cleanup.
|
||||||
|
;;;
|
||||||
|
|
||||||
(define (cleanup-gexp _)
|
(define (cleanup-gexp _)
|
||||||
"Return a gexp to clean up /tmp and similar places upon boot."
|
"Return a gexp to clean up /tmp and similar places upon boot."
|
||||||
(with-imported-modules '((guix build utils))
|
(with-imported-modules '((guix build utils))
|
||||||
|
|
|
@ -110,6 +110,7 @@ (define-module (gnu system)
|
||||||
|
|
||||||
system-linux-image-file-name
|
system-linux-image-file-name
|
||||||
operating-system-with-gc-roots
|
operating-system-with-gc-roots
|
||||||
|
operating-system-with-provenance
|
||||||
|
|
||||||
boot-parameters
|
boot-parameters
|
||||||
boot-parameters?
|
boot-parameters?
|
||||||
|
@ -540,6 +541,15 @@ (define (operating-system-with-gc-roots os roots)
|
||||||
gc-root-service-type roots)
|
gc-root-service-type roots)
|
||||||
(operating-system-user-services os)))))
|
(operating-system-user-services os)))))
|
||||||
|
|
||||||
|
(define* (operating-system-with-provenance os #:optional config-file)
|
||||||
|
"Return a variant of OS that stores its own provenance information,
|
||||||
|
including CONFIG-FILE, if available. This is achieved by adding an instance
|
||||||
|
of PROVENANCE-SERVICE-TYPE to its services."
|
||||||
|
(operating-system
|
||||||
|
(inherit os)
|
||||||
|
(services (cons (service provenance-service-type config-file)
|
||||||
|
(operating-system-user-services os)))))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; /etc.
|
;;; /etc.
|
||||||
|
|
Loading…
Reference in a new issue