aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-11-30 18:05:07 +0100
committerLudovic Courtès <ludo@gnu.org>2019-12-07 00:59:56 +0100
commit33b7cb7a595aa33051648039d417338110e5a45e (patch)
tree8df25d15565b5180b4bc17af7d9eeeb3101c3d10
parent362bcdb1b076c8c46f71781add56dfbe532736dc (diff)
downloadguix-33b7cb7a595aa33051648039d417338110e5a45e.tar
guix-33b7cb7a595aa33051648039d417338110e5a45e.tar.gz
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'.
-rw-r--r--doc/guix.texi44
-rw-r--r--gnu/services.scm87
-rw-r--r--gnu/system.scm10
3 files changed, 141 insertions, 0 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 7d50f31d20..33ee81b150 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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.
@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
@subsection Shepherd Services
diff --git a/gnu/services.scm b/gnu/services.scm
index 394470ba7d..e7a3a95e43 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -25,6 +25,8 @@
#:use-module (guix profiles)
#:use-module (guix discovery)
#:use-module (guix combinators)
+ #:use-module (guix channels)
+ #:use-module (guix describe)
#:use-module (guix sets)
#:use-module (guix ui)
#:use-module ((guix utils) #:select (source-properties->location))
@@ -39,6 +41,7 @@
#:use-module (srfi srfi-35)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
+ #:autoload (ice-9 pretty-print) (pretty-print)
#:export (service-extension
service-extension?
service-extension-target
@@ -82,6 +85,7 @@
ambiguous-target-service-error-target-type
system-service-type
+ provenance-service-type
boot-service-type
cleanup-service-type
activation-service-type
@@ -370,6 +374,89 @@ by the initrd once the root file system is mounted.")))
;; The service that produces the boot script.
(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 _)
"Return a gexp to clean up /tmp and similar places upon boot."
(with-imported-modules '((guix build utils))
diff --git a/gnu/system.scm b/gnu/system.scm
index 96c2b5aad3..abdbb081e6 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -110,6 +110,7 @@
system-linux-image-file-name
operating-system-with-gc-roots
+ operating-system-with-provenance
boot-parameters
boot-parameters?
@@ -540,6 +541,15 @@ bookkeeping."
gc-root-service-type roots)
(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.