Subject: bug#37978: closed (Re: [bug#37978] [PATCH] guix: new command "guix time-machine")

From: [email-masked] (GNU bug Tracking System)
Date: Fri, 15 Nov 2019 22:37:02 +0000

Your bug report

#37978: [PATCH] guix: new command "guix time-machine"

which was filed against the guix-patches package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
37978: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=37978
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: [bug#37978] [PATCH] guix: new command "guix time-machine"
From: Ludovic Courtès <[email-masked]>
To: Konrad Hinsen <[email-masked]>
Cc: [email-masked]
Date: Fri, 15 Nov 2019 23:35:52 +0100
List-Id: <debbugs-submit.debbugs.gnu.org>

Hi Konrad,

Konrad Hinsen <[email-masked]> skribis:

> Konrad Hinsen <[email-masked]> writes:
>
>> Thanks for your detailed comments, most of which I agree with, and I
>> will make the required changes.
>
> I just submitted two new patches. Looking forward to everyone's feedbck!

I’ve just applied them, thank you!

I followed up with one commit to gracefully handle Git errors (e.g.,
when one type ‘--commit=foobar’) and another one to handle build options
like the other commands.  Let me know if anything looks wrong.

Anyway, I can do things like this:

--8<---------------cut here---------------start------------->8---
$ ./pre-inst-env guix time-machine --commit=65956ad3526ba09e1f7a40722c96c6ef7c0936fe -- package -A |wc -l
Updating channel 'guix' from Git repository at 'https://git.savannah.gnu.org/git/guix.git'...
guile: warning: failed to install locale
warning: failed to install locale: Invalid argument
7666
--8<---------------cut here---------------end--------------->8---

… where the commit in question is from June 2018.  Pretty fun!

It would be neat if the “Updating…” message wouldn’t show up when in
fact everything is already available.  Also, it’d be nice if we could
write (and in ‘guix pull’ too) ‘--date=2019-07-07’ or
‘--date=last-month’.  Future work!  :-)

Thanks again for this nifty command!

Ludo’.

Subject: [PATCH] guix: new command "guix time-machine"
From: Konrad Hinsen <[email-masked]>
To: [email-masked]
Date: Fri, 25 Oct 2019 17:42:21 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

* guix/scripts/time-machine.scm: New file.
* guix/scripts/pull.scm: Export function channel-list.
* guix/inferior.scm: New function cached-guix-filetree-for-channels.
* doc/guix.texi: Document "git time-machine"
---
 doc/guix.texi                 |  47 +++++++++++++++-
 guix/inferior.scm             |  38 +++++++++----
 guix/scripts/pull.scm         |   1 +
 guix/scripts/time-machine.scm | 101 ++++++++++++++++++++++++++++++++++
 4 files changed, 174 insertions(+), 13 deletions(-)
 create mode 100644 guix/scripts/time-machine.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index 7cc33c6e22..a147f16088 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -247,6 +247,7 @@ Utilities
 * Invoking guix container::     Process isolation.
 * Invoking guix weather::       Assessing substitute availability.
 * Invoking guix processes::     Listing client processes.
+* Invoking guix time-machine::  Running an older version of Guix.
 
 Invoking @command{guix build}
 
@@ -4142,7 +4143,10 @@ say, on another machine, by providing a channel specification in
 @end lisp
 
 The @command{guix describe --format=channels} command can even generate this
-list of channels directly (@pxref{Invoking guix describe}).
+list of channels directly (@pxref{Invoking guix describe}). The resulting
+file can be used with the -C options of @command{guix pull}
+(@pxref{Invoking guix pull}) or @command{guix time-machine}
+(@pxref{Invoking guix time-machine}).
 
 At this point the two machines run the @emph{exact same Guix}, with access to
 the @emph{exact same packages}.  The output of @command{guix build gimp} on
@@ -7894,6 +7898,7 @@ the Scheme programming interface of Guix in a convenient way.
 * Invoking guix container::     Process isolation.
 * Invoking guix weather::       Assessing substitute availability.
 * Invoking guix processes::     Listing client processes.
+* Invoking guix time-machine::  Running an older version of Guix.
 @end menu
 
 @node Invoking guix build
@@ -10563,6 +10568,46 @@ ClientPID: 19419
 ClientCommand: cuirass --cache-directory /var/cache/cuirass @dots{}
 @end example
 
+@node Invoking guix time-machine
+@section Invoking @command{guix time-machine}
+
+@cindex @command{guix time-machine}
+@cindex pinning, channels
+@cindex replicating Guix
+@cindex reproducibility, of Guix
+
+The @command{guix time-machine} command provides access to older
+versions of Guix, for example to install older versions of packages,
+or to reproduce a computation in an identical environment. The version
+of Guix to be used is defined by a commit or by a channel
+description file created by @command{guix describe}
+(@pxref{Invoking guix describe}).
+
+The general syntax is:
+
+@example
+guix time-machine @var{channels} -- @var{command} @var {arg}@dots{}
+@end example
+
+where @var{command} and @var{arg}@dots{} are passed unmodified to the
+@command{guix} command in its old version.  The @var{channels} that define
+this version can be specified using the following options:
+
+@table @code
+@item --url=@var{url}
+@itemx --commit=@var{commit}
+@itemx --branch=@var{branch}
+Use the @code{guix} channel from the specified @var{url}, at the
+given @var{commit} (a valid Git commit ID represented as a hexadecimal
+string), or @var{branch}.
+
+@item --channels=@var{file}
+@itemx -C @var{file}
+Read the list of channels from @var{file}.  @var{file} must contain
+Scheme code that evaluates to a list of channel objects.
+@xref{Channels} for more information.
+@end table
+
 
 @node System Configuration
 @chapter System Configuration
diff --git a/guix/inferior.scm b/guix/inferior.scm
index b8e2f21f42..cb80bb43d5 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -89,6 +89,7 @@
             gexp->derivation-in-inferior
 
             %inferior-cache-directory
+            cached-guix-filetree-for-channels
             inferior-for-channels))
 
 ;;; Commentary:
@@ -635,16 +636,13 @@ failing when GUIX is too old and lacks the 'guix repl' command."
   (make-parameter (string-append (cache-directory #:ensure? #f)
                                  "/inferiors")))
 
-(define* (inferior-for-channels channels
-                                #:key
-                                (cache-directory (%inferior-cache-directory))
-                                (ttl (* 3600 24 30)))
-  "Return an inferior for CHANNELS, a list of channels.  Use the cache at
-CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds.  This
-procedure opens a new connection to the build daemon.
-
-This is a convenience procedure that people may use in manifests passed to
-'guix package -m', for instance."
+(define* (cached-guix-filetree-for-channels channels
+                                            #:key
+                                            (cache-directory (%inferior-cache-directory))
+                                            (ttl (* 3600 24 30)))
+  "Return a directory containing a guix filetree defined by CHANNELS, a list of channels.
+The directory is a subdirectory of CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds.
+This procedure opens a new connection to the build daemon."
   (with-store store
     (let ()
       (define instances
@@ -680,7 +678,7 @@ This is a convenience procedure that people may use in manifests passed to
                                           (file-expiration-time ttl))
 
       (if (file-exists? cached)
-          (open-inferior cached)
+          cached
           (run-with-store store
             (mlet %store-monad ((profile
                                  (channel-instances->derivation instances)))
@@ -689,4 +687,20 @@ This is a convenience procedure that people may use in manifests passed to
                 (built-derivations (list profile))
                 (symlink* (derivation->output-path profile) cached)
                 (add-indirect-root* cached)
-                (return (open-inferior cached)))))))))
+                (return cached))))))))
+
+(define* (inferior-for-channels channels
+                                #:key
+                                (cache-directory (%inferior-cache-directory))
+                                (ttl (* 3600 24 30)))
+  "Return an inferior for CHANNELS, a list of channels.  Use the cache at
+CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds.  This
+procedure opens a new connection to the build daemon.
+
+This is a convenience procedure that people may use in manifests passed to
+'guix package -m', for instance."
+  (define cached
+    (cached-guix-filetree-for-channels channels
+                                       #:cache-directory cache-directory
+                                       #:ttl ttl))
+  (open-inferior cached))
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 80d070652b..a508e817b2 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -56,6 +56,7 @@
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 format)
   #:export (display-profile-content
+            channel-list
             guix-pull))
 
 
diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm
new file mode 100644
index 0000000000..8e954d51e1
--- /dev/null
+++ b/guix/scripts/time-machine.scm
@@ -0,0 +1,101 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Konrad Hinsen <[email-masked]>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts time-machine)
+  #:use-module (guix ui)
+  #:use-module (guix scripts)
+  #:use-module (guix inferior)
+  #:use-module (guix channels)
+  #:use-module ((guix scripts pull) #:select (channel-list))
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-37)
+  #:export (guix-time-machine))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define (show-help)
+  (display (G_ "Usage: guix time-machine [OPTION] -- COMMAND ARGS...
+Execute COMMAND ARGS... in an older version of Guix.\n"))
+  (display (G_ "
+  -C, --channels=FILE    deploy the channels defined in FILE"))
+  (display (G_ "
+      --url=URL          use the Git repository at URL"))
+  (display (G_ "
+      --commit=COMMIT    use the specified COMMIT"))
+  (display (G_ "
+      --branch=BRANCH    use the tip of the specified BRANCH"))
+  (display (G_ "
+  -h, --help             display this help and exit"))
+  (display (G_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define %options
+  ;; Specifications of the command-line options.
+  (list (option '(#\C "channels") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'channel-file arg result)))
+         (option '("url") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'repository-url arg
+                               (alist-delete 'repository-url result))))
+         (option '("commit") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'ref `(commit . ,arg) result)))
+         (option '("branch") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'ref `(branch . ,arg) result)))
+        (option '(#\h "help") #f #f
+                (lambda args
+                  (show-help)
+                  (exit 0)))
+        (option '(#\V "version") #f #f
+                (lambda args
+                  (show-version-and-exit "guix time-machine")))))
+
+(define (parse-args args)
+  "Parse the list of command line arguments ARGS."
+  ;; The '--' token is used to separate the command to run from the rest of
+  ;; the operands.
+  (let-values (((args command) (break (cut string=? "--" <>) args)))
+    (let ((opts (parse-command-line args %options '(()) #:build-options? #f)))
+      (match command
+        (() opts)
+        (("--") opts)
+        (("--" command ...) (alist-cons 'exec command opts))))))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-time-machine . args)
+  (with-error-handling
+    (let* ((opts         (parse-args args))
+           (channels     (channel-list opts))
+           (command-line (assoc-ref opts 'exec))
+           (directory    (cached-guix-filetree-for-channels channels))
+           (executable   (string-append directory "/bin/guix")))
+      (apply system* (cons executable command-line)))))
-- 
2.23.0