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
--- 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 <[email protected]> +;;; Copyright © 2013 Nikita Karetnikov <[email protected]> ;;; ;;; 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~%")))))) + ;;; ;;; 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
pgpTNGm3iZQ4B.pgp
Description: PGP signature
