Re: guix-package --roll-back

[Nikita Karetnikov <nikita@karetnikov.org>]

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

Hi,

I changed 'roll-back', but didn't add the command-line option.  Could
you add it?

Why do these lines raise the "non-literal format string" warning?

+        (format (current-error-port)
+                "error: '~a' is not a valid profile~%"
+                profile)

Also, is it possible to remove nested if statements?

+    (if (= number 0)
+        (format (current-error-port)
+                "error: '~a' is not a valid profile~%"
+                profile)
+        (if (file-exists? previous-profile)
+            (switch-link)
+            (format (current-error-port)
+                    (string-append "error: previous profile doesn't exist; "
+                                   "not rolling back~%"))))))

> I think it works even if PROFILE is not an absolute file name, no?

Maybe I misunderstood, but the following doesn't work.

scheme@(guile-user)> (define %current-profile "/nix/var/nix/profiles/per-user/root/guix-profile")
scheme@(guile-user)> (profile-number %current-profile)
$1 = 1
scheme@(guile-user)> (profile-number (basename %current-profile))
$2 = 0

Nikita


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

--- guix-package-orig	2013-01-16 20:56:13.000000000 +0000
+++ guix-package	2013-01-16 21:05:09.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.
 ;;;
@@ -89,13 +90,14 @@
     (_
      (error "unsupported manifest format" manifest))))
 
+(define (profile-regexp 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.
@@ -131,16 +133,17 @@
              (sort files entry<?))))
 
   (match (scandir (dirname profile)
-                  (cut regexp-exec %profile-rx <>))
+                  (cut regexp-exec (profile-regexp profile) <>))
     (#f                                         ; no profile directory
      0)
     (()                                         ; no profiles
      0)
     ((profiles ...)                             ; former profiles around
-     (let ((numbers (map (compose string->number
-                                  (cut match:substring <> 1)
-                                  (cut regexp-exec %profile-rx <>))
-                         profiles)))
+     (let ((numbers
+            (map (compose string->number
+                          (cut match:substring <> 1)
+                          (cut regexp-exec (profile-regexp profile) <>))
+                 profiles)))
        (fold (lambda (number highest)
                (if (> number highest)
                    number
@@ -179,6 +182,41 @@
                                      packages)
                                 #:modules '((guix build union))))
 
+(define (profile-number profile)
+  "Return PROFILE's number or 0.  An absolute file name must be used."
+  (or (and=> (false-if-exception (regexp-exec (profile-regexp profile)
+                                              (basename (readlink profile))))
+             (compose string->number (cut match:substring <> 1)))
+      0))
+
+(define (roll-back profile)
+  "Roll back to the previous generation of PROFILE."
+  (let* ((number (profile-number profile))
+         (previous-number (1- number))
+         (previous-profile
+          (string-append profile "-" (number->string previous-number) "-link"))
+         (manifest (string-append previous-profile "/manifest")))
+
+    (define (switch-link)
+      (let ((tmp-profile (string-append (dirname profile)
+                                        "/tmp-"
+                                        (basename previous-profile))))
+
+        (format #t "switching from generation ~a to ~a~%"
+                number previous-number)
+        (symlink previous-profile tmp-profile)
+        (rename-file tmp-profile profile)))
+
+    (if (= number 0)
+        (format (current-error-port)
+                "error: '~a' is not a valid profile~%"
+                profile)
+        (if (file-exists? previous-profile)
+            (switch-link)
+            (format (current-error-port)
+                    (string-append "error: previous profile doesn't exist; "
+                                   "not rolling back~%"))))))
+
 \f
 ;;;
 ;;; Command-line options.
@@ -203,6 +241,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"))
@@ -237,6 +277,9 @@
         (option '(#\r "remove") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'remove arg result)))
+        ;; (option '("roll-back") #f #f
+        ;;         (lambda (opt name arg result)
+        ;;           (alist-cons 'roll-back 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 --]