From 65797bfffd1b4d9126f11ffb6b59a1a7a18d48f0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 26 Oct 2015 21:24:26 +0100 Subject: guix system: Add the 'list-generations' command. * guix/scripts/system.scm (display-system-generation, list-generations): New procedures. (process-action): Clarify docstring. (process-command): New procedure. (guix-system)[parse-sub-command]: Add 'list-generations' Call 'process-command' instead of 'process-action'. * doc/guix.texi (Using the Configuration System): Mention generations, rollback, and 'list-generations'. (Invoking guix system): Document 'list-generations'. --- guix/scripts/system.scm | 72 +++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 67 insertions(+), 5 deletions(-) (limited to 'guix/scripts/system.scm') diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 6db6a01ac9..d847c75444 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -42,6 +42,8 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-37) #:use-module (ice-9 match) #:export (guix-system @@ -351,6 +353,48 @@ list of services." (label dmd-service-node-label) (edges (lift1 (dmd-service-back-edges services) %store-monad)))) + +;;; +;;; Generations. +;;; + +(define* (display-system-generation number + #:optional (profile %system-profile)) + "Display a summary of system generation NUMBER in a human-readable format." + (unless (zero? number) + (let* ((generation (generation-file-name profile number)) + (param-file (string-append generation "/parameters")) + (params (call-with-input-file param-file read-boot-parameters))) + (display-generation profile number) + (format #t (_ " file name: ~a~%") generation) + (format #t (_ " canonical file name: ~a~%") (readlink* generation)) + (match params + (($ label root kernel) + ;; TRANSLATORS: Please preserve the two-space indentation. + (format #t (_ " label: ~a~%") label) + (format #t (_ " root device: ~a~%") root) + (format #t (_ " kernel: ~a~%") kernel)) + (_ + #f))))) + +(define* (list-generations pattern #:optional (profile %system-profile)) + "Display in a human-readable format all the system generations matching +PATTERN, a string. When PATTERN is #f, display all the system generations." + (cond ((not (file-exists? profile)) ; XXX: race condition + (raise (condition (&profile-not-found-error + (profile profile))))) + ((string-null? pattern) + (for-each display-system-generation (profile-generations profile))) + ((matching-generations pattern profile) + => + (lambda (numbers) + (if (null-list? numbers) + (exit 1) + (leave-on-EPIPE + (for-each display-system-generation numbers))))) + (else + (leave (_ "invalid syntax: ~a~%") pattern)))) + ;;; ;;; Action. @@ -468,13 +512,15 @@ building anything." ;;; (define (show-help) - (display (_ "Usage: guix system [OPTION] ACTION FILE + (display (_ "Usage: guix system [OPTION] ACTION [FILE] Build the operating system declared in FILE according to ACTION.\n")) (newline) (display (_ "The valid values for ACTION are:\n")) (newline) (display (_ "\ reconfigure switch to a new operating system configuration\n")) + (display (_ "\ + list-generations list the system generations\n")) (display (_ "\ build build the operating system without installing anything\n")) (display (_ "\ @@ -577,8 +623,10 @@ Build the operating system declared in FILE according to ACTION.\n")) ;;; (define (process-action action args opts) - "Process ACTION, a sub-command, whose arguments are listed in ARGS. OPTS is -the raw alist of options resulting from command-line parsing." + "Process ACTION, a sub-command, with the arguments are listed in ARGS. +ACTION must be one of the sub-commands that takes an operating system +declaration as an argument (a file name.) OPTS is the raw alist of options +resulting from command-line parsing." (let* ((file (match args (() #f) ((x . _) x))) @@ -625,6 +673,20 @@ the raw alist of options resulting from command-line parsing." #:target target #:device device)))) #:system system)))) +(define (process-command command args opts) + "Process COMMAND, one of the 'guix system' sub-commands. ARGS is its +argument list and OPTS is the option alist." + (case command + ((list-generations) + ;; List generations. No need to connect to the daemon, etc. + (let ((pattern (match args + (() "") + ((pattern) pattern) + (x (leave (_ "wrong number of arguments~%")))))) + (list-generations pattern))) + (else + (process-action command args opts)))) + (define (guix-system . args) (define (parse-sub-command arg result) ;; Parse sub-command ARG and augment RESULT accordingly. @@ -633,7 +695,7 @@ the raw alist of options resulting from command-line parsing." (let ((action (string->symbol arg))) (case action ((build vm vm-image disk-image reconfigure init - extension-graph dmd-graph) + extension-graph dmd-graph list-generations) (alist-cons 'action action result)) (else (leave (_ "~a: unknown action~%") action)))))) @@ -676,6 +738,6 @@ the raw alist of options resulting from command-line parsing." parse-sub-command)) (args (option-arguments opts)) (command (assoc-ref opts 'action))) - (process-action command args opts)))) + (process-command command args opts)))) ;;; system.scm ends here -- cgit v1.2.3