Re: guix-package --roll-back

[Nikita Karetnikov <nikita@karetnikov.org>]

[-- Attachment #1.1: Type: text/plain, Size: 732 bytes --]

Hi,

I'm attaching a slightly modified version.

> Yeah, that’s expected.  Basically, if you do

>   guix-package -p /dev/null --roll-back

> it should fail with an error message saying that there is no previous
> profile or something like that.

'profile-number' will fail if I call it with a bogus file name.

For instance:

scheme@(guile-user)> (profile-number "/foo/bar")
ERROR: In procedure readlink:
ERROR: In procedure readlink: No such file or directory

What should I use to handle this error?  Please show an example.  The
ones from the manual aren't helpful.

I don't understand how to add a command-line option that should accept
an optional argument.  I commented out my attempts.

Nikita


[-- Attachment #1.2: guix-package.diff --]
[-- Type: text/x-diff, Size: 5438 bytes --]

--- guix-package-orig	2013-01-09 18:28:03.000000000 +0000
+++ guix-package	2013-01-09 18:38:23.000000000 +0000
@@ -13,6 +13,7 @@
 !#
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,6 +40,7 @@
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 optargs)
   #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
@@ -88,13 +90,14 @@
     (_
      (error "unsupported manifest format" manifest))))
 
+(define (profile-rx profile)
+  "Return a regular expression that matches PROFILE's name and number."
+  (make-regexp (string-append "^" (regexp-quote (basename profile))
+                              "-([0-9]+)")))
+
 (define (latest-profile-number profile)
   "Return the identifying number of the latest generation of PROFILE.
 PROFILE is the name of the symlink to the current generation."
-  (define %profile-rx
-    (make-regexp (string-append "^" (regexp-quote (basename profile))
-                                "-([0-9]+)")))
-
   (define* (scandir name #:optional (select? (const #t))
                     (entry<? (@ (ice-9 i18n) string-locale<?)))
     ;; XXX: Bug-fix version introduced in Guile v2.0.6-62-g139ce19.
@@ -130,7 +133,7 @@
              (sort files entry<?))))
 
   (match (scandir (dirname profile)
-                  (cut regexp-exec %profile-rx <>))
+                  (cut regexp-exec (profile-rx profile) <>))
     (#f                                         ; no profile directory
      0)
     (()                                         ; no profiles
@@ -138,7 +141,7 @@
     ((profiles ...)                             ; former profiles around
      (let ((numbers (map (compose string->number
                                   (cut match:substring <> 1)
-                                  (cut regexp-exec %profile-rx <>))
+                                  (cut regexp-exec (profile-rx profile) <>))
                          profiles)))
        (fold (lambda (number highest)
                (if (> number highest)
@@ -178,6 +181,41 @@
                                      packages)
                                 #:modules '((guix build union))))
 
+(define (profile-number profile)
+  "Return PROFILE's number.  An absolute file name must be used."
+  (and=> (regexp-exec (profile-rx profile)
+                      (basename (readlink profile)))
+         (cut match:substring <> 1)))
+
+(define* (roll-back #:optional profile)
+  "Roll back to the previous profile."
+  (let* ((current-profile-number
+          (string->number (profile-number (or profile %current-profile))))
+         (previous-profile-number (number->string (1- current-profile-number)))
+         (previous-profile
+          (string-append (or profile %current-profile) "-"
+                         previous-profile-number "-link"))
+         (manifest (string-append previous-profile "/manifest")))
+
+    (define (switch-link)
+      ;; Switch to the previous generation.
+      (let ((tmp-profile (string-append (dirname (or profile %current-profile))
+                                        "/tmp-"
+                                        (basename previous-profile))))
+
+        (simple-format #t "guix-package: switching from generation ~a to ~a~%"
+                       current-profile-number previous-profile-number)
+        (symlink previous-profile tmp-profile)
+        (rename-file tmp-profile (or profile %current-profile))))
+
+    (if (equal? (map (cut file-exists? <>)
+                     (list previous-profile manifest))
+                '(#t #t))
+        (switch-link)
+        (leave (_ (string-append
+                   "guix-package: previous profile doesn't exist; "
+                   "not rolling back~%"))))))
+
 \f
 ;;;
 ;;; Command-line options.
@@ -202,6 +240,8 @@
   (display (_ "
   -n, --dry-run          show what would be done without actually doing it"))
   (display (_ "
+      --roll-back        roll back to the previous generation"))
+  (display (_ "
       --bootstrap        use the bootstrap Guile to build the profile"))
   (display (_ "
       --verbose          produce verbose output"))
@@ -236,6 +276,25 @@
         (option '(#\r "remove") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'remove arg result)))
+
+        ;; (option '("roll-back") #f #t
+        ;;         (lambda (opt name arg result)
+        ;;           (roll-back (or arg #f))
+        ;;           (exit 0)))
+
+                ;; (lambda (opt name arg result)
+                ;;   (alist-cons 'roll-back arg result)))
+
+                ;; (lambda (opt name arg result)
+                ;;   (cons `(query roll-back ,(or arg #f))
+                ;;         result)))
+
+                ;; (lambda (opt name arg result)
+                ;;   (alist-cons 'roll-back (or arg #f) result)))
+
+                ;; (lambda (opt name arg result)
+                ;;   (alist-cons 'roll-back (or arg "") result)))
+
         (option '(#\p "profile") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'profile arg

[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]