[bug#27865] [PATCH 0/3] Use Guile-Git for 'guix pull'

[bug#27865] [PATCH 0/3] Use Guile-Git for 'guix pull'

[Ludovic Courtès]

Hello Guix!

This is the long-awaited change where ‘guix pull’ fetches code over Git
instead of stupidly grabbing a full snapshot generated on-the-fly by the
poor Savannah servers.

As a side-effect, ‘guix pull’ gains a ‘--commit’ and a ‘--branch’
option.  Also, ‘guix --version’ will now show a Git commit ID instead of
a date.

This change makes Guile-Git a hard dependency.  The transition might be
somewhat bumpy since it’s possible that users not having Guile-Git
installed will run ‘guix pull’ and, upon completion, will get an error
when they re-run ‘guix pull’.  This will be fixed by installing
‘guile-git’.  Thinking about it, (guix scripts pull) could perhaps try
to be smart and have an error message saying “please install Guile-Git”
or something.

Thoughts?

Another (minor) issue is that there hasn’t been an official release of
Guile-Git yet, and things are still changing a little bit.  However I
think most of the important things are in place.

Guile-Git currently lacks bindings for the progress-report API when
cloning the repo.  We’ll use it when it’s available.

Feedback welcome!

Thanks,
Ludo’.

Ludovic Courtès (3):
  build: Make Guile-Git a hard requirement.
  pull: Fetch source code from Git.
  pull: Use the commit ID as the version string.

 Makefile.am           |   8 +-
 configure.ac          |  10 ++-
 doc/guix.texi         |  29 ++++---
 guix/scripts/pull.scm | 219 ++++++++++++++++++++++++--------------------------
 4 files changed, 124 insertions(+), 142 deletions(-)

-- 
2.13.3

[bug#27865] [PATCH 1/3] build: Make Guile-Git a hard requirement.

[Ludovic Courtès]

* configure.ac: Error out when (git) is missing.
* doc/guix.texi (Requirements): Mention Guile-Git.
* Makefile.am (MODULES): Add guix/git.scm unconditionally.
---
 Makefile.am   |  8 +-------
 configure.ac  | 10 ++++++----
 doc/guix.texi |  4 ++++
 3 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/Makefile.am b/Makefile.am
index 5888bc026..0a7e375c2 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -66,6 +66,7 @@ MODULES =					\
   guix/gnu-maintenance.scm			\
   guix/upstream.scm				\
   guix/licenses.scm				\
+  guix/git.scm					\
   guix/graph.scm				\
   guix/cache.scm				\
   guix/cve.scm					\
@@ -207,13 +208,6 @@ MODULES +=					\
 
 endif HAVE_GUILE_SSH
 
-if HAVE_GUILE_GIT
-
-MODULES +=					\
-  guix/git.scm
-
-endif HAVE_GUILE_GIT
-
 if BUILD_DAEMON_OFFLOAD
 
 MODULES +=					\
diff --git a/configure.ac b/configure.ac
index 2b75c900c..9ad7598f8 100644
--- a/configure.ac
+++ b/configure.ac
@@ -100,14 +100,16 @@ if test "x$have_gnutls" != "xyes"; then
   AC_MSG_ERROR([The Guile bindings of GnuTLS are missing; please install them.])
 fi
 
+dnl Check for Guile-Git.
+GUILE_MODULE_AVAILABLE([have_guile_git], [(git)])
+if test "x$have_guile_git" != "xyes"; then
+  AC_MSG_ERROR([Guile-Git is missing; please install it.])
+fi
+
 dnl Guile-JSON is used in various places.
 GUILE_MODULE_AVAILABLE([have_guile_json], [(json)])
 AM_CONDITIONAL([HAVE_GUILE_JSON], [test "x$have_guile_json" = "xyes"])
 
-dnl Check for Guile-Git.
-GUILE_MODULE_AVAILABLE([have_guile_git], [(git)])
-AM_CONDITIONAL([HAVE_GUILE_GIT], [test "x$have_guile_git" = "xyes"])
-
 dnl Make sure we have a full-fledged Guile.
 GUIX_ASSERT_GUILE_FEATURES([regex posix socket net-db threads])
 
diff --git a/doc/guix.texi b/doc/guix.texi
index e8c4e0eaf..3a58c389c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -579,6 +579,10 @@ later, including 2.2.x;
 @uref{http://gnutls.org/, GnuTLS}, specifically its Guile bindings
 (@pxref{Guile Preparations, how to install the GnuTLS bindings for
 Guile,, gnutls-guile, GnuTLS-Guile});
+@item
+@c FIXME: Specify a version number once a release has been made.
+@uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, from August
+2017 or later;
 @item @url{http://www.gnu.org/software/make/, GNU Make}.
 @end itemize
 
-- 
2.13.3

[bug#27865] [PATCH 2/3] pull: Fetch source code from Git.

[Ludovic Courtès]

* guix/scripts/pull.scm (%snapshot-url, with-environment-variable)
(with-PATH): Remove.
(%repository-url): New variable.
(%default-options): Add 'repository-url' and 'ref'.
(show-help, %options): Add '--commit' and '--url'.
(temporary-directory, first-directory, interned-then-deleted)
(unpack): Remove.
(build-from-source): Rename 'tarball' to 'source'.  Remove call to
'unpack'.
(build-and-install): Rename 'tarball' to 'source'.
(honor-lets-encrypt-certificates!, report-git-error): New procedures.
(with-git-error-handling): New macro.
(guix-pull)[fetch-tarball]: Remove.
Wrap body in 'with-git-error-handling'.  Rewrite to use
'latest-repository-commit'.
* doc/guix.texi (Invoking guix pull): Mention Git.  Document '--commit'
and '--branch'.
---
 doc/guix.texi         |  25 +++---
 guix/scripts/pull.scm | 210 +++++++++++++++++++++++---------------------------
 2 files changed, 107 insertions(+), 128 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 3a58c389c..1dc6e75a2 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2476,7 +2476,8 @@ Packages are installed or upgraded to the latest version available in
 the distribution currently available on your local machine.  To update
 that distribution, along with the Guix tools, you must run @command{guix
 pull}: the command downloads the latest Guix source code and package
-descriptions, and deploys it.
+descriptions, and deploys it.  Source code is downloaded from a
+@uref{https://git-scm.com, Git} repository.
 
 On completion, @command{guix package} will use packages and package
 versions from this just-retrieved copy of Guix.  Not only that, but all
@@ -2502,24 +2503,18 @@ but it supports the following options:
 Produce verbose output, writing build logs to the standard error output.
 
 @item --url=@var{url}
-Download the source tarball of Guix from @var{url}.
+Download Guix from the Git repository at @var{url}.
 
-By default, the tarball is taken from its canonical address at
+By default, the source is taken from its canonical Git repository at
 @code{gnu.org}, for the stable branch of Guix.
 
-With some Git servers, this can be used to deploy any version of Guix.
-For example, to download and deploy version 0.12.0 of Guix from the
-canonical Git repo:
+@item --commit=@var{commit}
+Deploy @var{commit}, a valid Git commit ID represented as a hexadecimal
+string.
 
-@example
-guix pull --url=https://git.savannah.gnu.org/cgit/guix.git/snapshot/v0.12.0.tar.gz
-@end example
-
-It can also be used to deploy arbitrary Git revisions:
-
-@example
-guix pull --url=https://git.savannah.gnu.org/cgit/guix.git/snapshot/74d862e8a.tar.gz
-@end example
+@item --branch=@var{branch}
+Deploy the tip of @var{branch}, the name of a Git branch available on
+the repository at @var{url}.
 
 @item --bootstrap
 Use the bootstrap Guile to build the latest Guix.  This option is only
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 58b87d4df..5f6733cf9 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -28,6 +28,8 @@
   #:use-module (guix download)
   #:use-module (guix gexp)
   #:use-module (guix monads)
+  #:use-module (guix git)
+  #:use-module (git)
   #:use-module (guix scripts build)
   #:use-module ((guix build utils)
                 #:select (with-directory-excursion delete-file-recursively))
@@ -41,6 +43,7 @@
   #:use-module (gnu packages compression)
   #:use-module (gnu packages gnupg)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
@@ -48,23 +51,8 @@
   #:use-module (ice-9 match)
   #:export (guix-pull))
 
-(define %snapshot-url
-  ;; "http://hydra.gnu.org/job/guix/master/tarball/latest/download"
-  "https://git.savannah.gnu.org/cgit/guix.git/snapshot/master.tar.gz"
-  )
-
-(define-syntax-rule (with-environment-variable variable value body ...)
-  (let ((original (getenv variable)))
-    (dynamic-wind
-      (lambda ()
-        (setenv variable value))
-      (lambda ()
-        body ...)
-      (lambda ()
-        (setenv variable original)))))
-
-(define-syntax-rule (with-PATH value body ...)
-  (with-environment-variable "PATH" value body ...))
+(define %repository-url
+  "https://git.savannah.gnu.org/git/guix.git")
 
 \f
 ;;;
@@ -73,7 +61,8 @@
 
 (define %default-options
   ;; Alist of default option values.
-  `((tarball-url . ,%snapshot-url)
+  `((repository-url . ,%repository-url)
+    (ref . (branch . "origin/master"))
     (system . ,(%current-system))
     (substitutes? . #t)
     (graft? . #t)
@@ -86,7 +75,11 @@ Download and deploy the latest version of Guix.\n"))
   (display (G_ "
       --verbose          produce verbose output"))
   (display (G_ "
-      --url=URL          download the Guix tarball from URL"))
+      --url=URL          download from the Git repository at URL"))
+  (display (G_ "
+      --commit=COMMIT    download the specified COMMIT"))
+  (display (G_ "
+      --branch=BRANCH    download the tip of the specified BRANCH"))
   (display (G_ "
       --bootstrap        use the bootstrap Guile to build the new Guix"))
   (newline)
@@ -105,8 +98,15 @@ Download and deploy the latest version of Guix.\n"))
                    (alist-cons 'verbose? #t result)))
          (option '("url") #t #f
                  (lambda (opt name arg result)
-                   (alist-cons 'tarball-url arg
-                               (alist-delete 'tarball-url 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 . ,(string-append "origin/" arg))
+                               result)))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'dry-run? #t (alist-cons 'graft? #f result))))
@@ -129,81 +129,28 @@ Download and deploy the latest version of Guix.\n"))
 (define indirect-root-added
   (store-lift add-indirect-root))
 
-(define (temporary-directory)
-  "Make a temporary directory and return its name."
-  (let ((name (tmpnam)))
-    (mkdir name)
-    (chmod name #o700)
-    name))
-
-(define (first-directory directory)
-  "Return a the name of the first file found under DIRECTORY."
-  (match (scandir directory
-                  (lambda (name)
-                    (and (not (member name '("." "..")))
-                         (file-is-directory? name))))
-    ((directory)
-     directory)
-    (x
-     (raise (condition
-             (&message
-              (message "tarball did not produce a single source directory")))))))
-
-(define (interned-then-deleted directory name)
-  "Add DIRECTORY to the store under NAME, and delete it.  Return the resulting
-store file name."
-  (mlet %store-monad ((result (interned-file directory name
-                                             #:recursive? #t)))
-    (delete-file-recursively directory)
-    (return result)))
-
-(define (unpack tarball)
-  "Return the name of the directory where TARBALL has been unpacked."
-  (mlet* %store-monad ((format -> (lift format %store-monad))
-                       (tar  (package->derivation tar))
-                       (gzip (package->derivation gzip)))
-    (mbegin %store-monad
-      (what-to-build (list tar gzip))
-      (built-derivations (list tar gzip))
-      (format #t (G_ "unpacking '~a'...~%") tarball)
-
-      (let ((source (temporary-directory)))
-        (with-directory-excursion source
-          (with-PATH (string-append (derivation->output-path gzip) "/bin")
-            (unless (zero? (system* (string-append (derivation->output-path tar)
-                                                   "/bin/tar")
-                                    "xf" tarball))
-              (raise (condition
-                      (&message (message "failed to unpack source code"))))))
-
-          (interned-then-deleted (string-append source "/"
-                                                (first-directory source))
-                                 "guix-source"))))))
-
 (define %self-build-file
   ;; The file containing code to build Guix.  This serves the same purpose as
   ;; a makefile, and, similarly, is intended to always keep this name.
   "build-aux/build-self.scm")
 
-(define* (build-from-source tarball #:key verbose?)
-  "Return a derivation to build Guix from TARBALL, using the self-build script
+(define* (build-from-source source #:key verbose?)
+  "Return a derivation to build Guix from SOURCE, using the self-build script
 contained therein."
   ;; Running the self-build script makes it easier to update the build
   ;; procedure: the self-build script of the Guix-to-be-installed contains the
   ;; right dependencies, build procedure, etc., which the Guix-in-use may not
   ;; be know.
-  (mlet* %store-monad ((source (unpack tarball))
-                       (script -> (string-append source "/"
-                                                 %self-build-file))
-                       (build -> (primitive-load script)))
+  (let* ((script (string-append source "/" %self-build-file))
+         (build  (primitive-load script)))
     ;; BUILD must be a monadic procedure of at least one argument: the source
     ;; tree.
     (build source #:verbose? verbose?)))
 
-(define* (build-and-install tarball config-dir
+(define* (build-and-install source config-dir
                             #:key verbose?)
-  "Build the tool from TARBALL, and install it in CONFIG-DIR."
-  (mlet* %store-monad ((source        (build-from-source tarball
+  "Build the tool from SOURCE, and install it in CONFIG-DIR."
+  (mlet* %store-monad ((source        (build-from-source source
                                                          #:verbose? verbose?))
                        (source-dir -> (derivation->output-path source))
                        (to-do?        (what-to-build (list source)))
@@ -227,44 +174,81 @@ contained therein."
                 (return #t))))
         (leave (G_ "failed to update Guix, check the build log~%")))))
 
+(define (honor-lets-encrypt-certificates! store)
+  "Tell Guile-Git to use the Let's Encrypt certificates."
+  (let* ((drv   (package-derivation store le-certs))
+         (certs (string-append (derivation->output-path drv)
+                               "/etc/ssl/certs")))
+    (build-derivations store (list drv))
+
+    ;; In the past Guile-Git would not provide this procedure.
+    (if (module-defined? (resolve-interface '(git))
+                         'set-tls-certificate-locations!)
+        (set-tls-certificate-locations! certs)
+        (begin
+          ;; In this case we end up using whichever certificates OpenSSL
+          ;; chooses to use: $SSL_CERT_FILE, $SSL_CERT_DIR, or /etc/ssl/certs.
+          (warning (G_ "cannot enforce use of the Let's Encrypt \
+certificates~%"))
+          (warning (G_ "please upgrade Guile-Git~%"))))))
+
+(define (report-git-error error)
+  "Report the given Guile-Git error."
+  ;; Prior to Guile-Git commit b6b2760c2fd6dfaa5c0fedb43eeaff06166b3134,
+  ;; errors would be represented by integers.
+  (match error
+    ((? integer? error)                           ;old Guile-Git
+     (leave (G_ "Git error ~a~%") error))
+    ((? git-error? error)                         ;new Guile-Git
+     (leave (G_ "Git error: ~a~%") (git-error-message error)))))
+
+(define-syntax-rule (with-git-error-handling body ...)
+  (catch 'git-error
+    (lambda ()
+      body ...)
+    (lambda (key err)
+      (report-git-error err))))
+
 \f
 (define (guix-pull . args)
   (define (use-le-certs? url)
     (string-prefix? "https://git.savannah.gnu.org/" url))
 
-  (define (fetch-tarball store url)
-    (download-to-store store url "guix-latest.tar.gz"))
-
   (with-error-handling
-    (let* ((opts  (parse-command-line args %options
-                                      (list %default-options)))
-           (url   (assoc-ref opts 'tarball-url)))
-      (unless (assoc-ref opts 'dry-run?)          ;XXX: not very useful
-        (with-store store
-          (set-build-options-from-command-line store opts)
-          (let ((tarball
-                 (if (use-le-certs? url)
-                     (let* ((drv (package-derivation store le-certs))
-                            (certs (string-append (derivation->output-path drv)
-                                                  "/etc/ssl/certs")))
-                       (build-derivations store (list drv))
-                       (parameterize ((%x509-certificate-directory certs))
-                         (fetch-tarball store url)))
-                     (fetch-tarball store url))))
-            (unless tarball
-              (leave (G_ "failed to download up-to-date source, exiting\n")))
-            (parameterize ((%guile-for-build
-                            (package-derivation store
-                                                (if (assoc-ref opts 'bootstrap?)
-                                                    %bootstrap-guile
-                                                    (canonical-package guile-2.0)))))
-              (run-with-store store
-                (build-and-install tarball (config-directory)
-                                   #:verbose? (assoc-ref opts 'verbose?))))))))))
+    (with-git-error-handling
+     (let* ((opts  (parse-command-line args %options
+                                       (list %default-options)))
+            (url   (assoc-ref opts 'repository-url))
+            (ref   (assoc-ref opts 'ref))
+            (cache (string-append (cache-directory) "/pull")))
+       (unless (assoc-ref opts 'dry-run?)         ;XXX: not very useful
+         (with-store store
+           (set-build-options-from-command-line store opts)
 
-;; Local Variables:
-;; eval: (put 'with-PATH 'scheme-indent-function 1)
-;; eval: (put 'with-temporary-directory 'scheme-indent-function 1)
-;; End:
+           ;; For reproducibility, always refer to the LE certificates when we
+           ;; know we're talking to Savannah.
+           (when (use-le-certs? url)
+             (honor-lets-encrypt-certificates! store))
+
+           (format (current-error-port)
+                   (G_ "updating from Git repository at '~a'...~%")
+                   url)
+
+           (let-values (((checkout commit)
+                         (latest-repository-commit store url
+                                                   #:ref ref
+                                                   #:cache-directory cache)))
+
+             (format (current-error-port)
+                     (G_ "building from Git commit ~a...~%")
+                     commit)
+             (parameterize ((%guile-for-build
+                             (package-derivation store
+                                                 (if (assoc-ref opts 'bootstrap?)
+                                                     %bootstrap-guile
+                                                     (canonical-package guile-2.0)))))
+               (run-with-store store
+                 (build-and-install checkout (config-directory)
+                                    #:verbose? (assoc-ref opts 'verbose?)))))))))))
 
 ;;; pull.scm ends here
-- 
2.13.3

[bug#27865] [PATCH 2/3] pull: Fetch source code from Git.

[Mathieu Othacehe]

Hi Ludo,

Nice job ! Error code handling in git is really a welcome addition too
:)

> +    ((? integer? error)                           ;old Guile-Git
> +     (leave (G_ "Git error ~a~%") error))
> +    ((? git-error? error)                         ;new Guile-Git
> +     (leave (G_ "Git error: ~a~%") (git-error-message error)))))

If an old Guile-Git (without error support) is used git-error? and
git-error-message won't be available anyway, so it is really necessary
to test for an integer ?

I'll use the same piece of code in Cuirass soon.

Thanks,

Mathieu

[bug#27865] [PATCH 2/3] pull: Fetch source code from Git.

[Ludovic Courtès]

Hi Mathieu,

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

> Nice job ! Error code handling in git is really a welcome addition too
> :)
>
>> +    ((? integer? error)                           ;old Guile-Git
>> +     (leave (G_ "Git error ~a~%") error))
>> +    ((? git-error? error)                         ;new Guile-Git
>> +     (leave (G_ "Git error: ~a~%") (git-error-message error)))))
>
> If an old Guile-Git (without error support) is used git-error? and
> git-error-message won't be available anyway, so it is really necessary
> to test for an integer ?

We could use (defined? 'git-error?), but I thought the above thing was
slightly clearer.

> I'll use the same piece of code in Cuirass soon.

In Cuirass you might even assume you have the latest Guile-Git version
available (maybe with a configure check to be on the safe side).  We
don’t have to be as cautious there.

Thanks for your feedback!

Ludo’.

[bug#27865] [PATCH 2/3] pull: Fetch source code from Git.

[Mathieu Othacehe]

[-- Attachment #1: Type: text/plain, Size: 247 bytes --]


Hi Ludo,

> In Cuirass you might even assume you have the latest Guile-Git version
> available (maybe with a configure check to be on the safe side).  We
> don’t have to be as cautious there.

Would the attached patch be ok ?

Thanks,

Mathieu

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-base-Report-git-errors.patch --]
[-- Type: text/x-patch, Size: 5202 bytes --]

From 6d6b0e48856998251284539e69bbc39e6d21635f Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Mon, 31 Jul 2017 11:08:32 +0200
Subject: [PATCH] base: Report git errors.

* src/cuirass/base.scm (report-git-error): New procedure.
(with-git-error-handling): New macro.
(process-specs): Use with-git-error-handling to catch and report git errors.
* build-aux/guix.scm (package)[inputs]: Add guile-git.
* configure.ac: Check for (git) module. Also check that (git) exports
git-error-message procedure.
---
 build-aux/guix.scm   |  1 +
 configure.ac         |  4 ++++
 src/cuirass/base.scm | 58 ++++++++++++++++++++++++++++++++--------------------
 3 files changed, 41 insertions(+), 22 deletions(-)

diff --git a/build-aux/guix.scm b/build-aux/guix.scm
index 583ef7e..c2f6cdb 100644
--- a/build-aux/guix.scm
+++ b/build-aux/guix.scm
@@ -80,6 +80,7 @@
         '("guile@2.2"
           "guile-json"
           "guile-sqlite3"
+          "guile-git"
           "guix")))
   (native-inputs
    (map spec+package-list
diff --git a/configure.ac b/configure.ac
index d7f111c..9c6a597 100644
--- a/configure.ac
+++ b/configure.ac
@@ -48,9 +48,13 @@ AS_IF([test -z "$ac_cv_path_GUILD"],
 
 GUILE_MODULE_REQUIRED([guix])
 GUILE_MODULE_REQUIRED([guix git])
+GUILE_MODULE_REQUIRED([git])
 GUILE_MODULE_REQUIRED([json])
 GUILE_MODULE_REQUIRED([sqlite3])
 
+# We depend on new Guile-Git errors.
+GUILE_MODULE_REQUIRED_EXPORT([(git)], git-error-message)
+
 AC_CONFIG_FILES([Makefile])
 AC_CONFIG_FILES([pre-inst-env:build-aux/pre-inst-env.in],
   [chmod +x pre-inst-env])
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index cc3dd39..f119c45 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -25,6 +25,7 @@
   #:use-module (guix derivations)
   #:use-module (guix store)
   #:use-module (guix git)
+  #:use-module (git)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 popen)
@@ -92,6 +93,17 @@ values."
                 duration)
         (acons #:duration duration result)))))
 
+(define (report-git-error error)
+  "Report the given Guile-Git error."
+  (format #t "Git error: ~a~%" (git-error-message error)))
+
+(define-syntax-rule (with-git-error-handling body ...)
+  (catch 'git-error
+    (lambda ()
+      body ...)
+    (lambda (key err)
+      (report-git-error err))))
+
 (define (fetch-repository store spec)
   "Get the latest version of repository specified in SPEC.  Return two
 values: the content of the git repository at URL copied into a store
@@ -209,30 +221,32 @@ directory and the sha1 of the top level commit in this directory."
   (define (process spec)
     (with-store store
       (let ((stamp (db-get-stamp db spec)))
-        (receive (checkout commit)
-            (fetch-repository store spec)
-          (when commit
-            (unless (string=? commit stamp)
-              (copy-repository-cache checkout spec)
+        ;; Catch and report git errors.
+        (with-git-error-handling
+         (receive (checkout commit)
+             (fetch-repository store spec)
+           (when commit
+             (unless (string=? commit stamp)
+               (copy-repository-cache checkout spec)
 
-              (unless (assq-ref spec #:no-compile?)
-                (compile (string-append (%package-cachedir) "/"
-                                        (assq-ref spec #:name))))
-              ;; Always set #:keep-going? so we don't stop on the first build
-              ;; failure.
-              (set-build-options store
-                                 #:use-substitutes? (%use-substitutes?)
-                                 #:fallback? (%fallback?)
-                                 #:keep-going? #t)
+               (unless (assq-ref spec #:no-compile?)
+                 (compile (string-append (%package-cachedir) "/"
+                                         (assq-ref spec #:name))))
+               ;; Always set #:keep-going? so we don't stop on the first build
+               ;; failure.
+               (set-build-options store
+                                  #:use-substitutes? (%use-substitutes?)
+                                  #:fallback? (%fallback?)
+                                  #:keep-going? #t)
 
-              (guard (c ((evaluation-error? c)
-                         (format #t "Failed to evaluate ~s specification.~%"
-                                 (evaluation-error-spec-name c))
-                         #f))
-                (let* ((spec* (acons #:current-commit commit spec))
-                       (jobs  (evaluate store db spec*)))
-                  (build-packages store db jobs))))
-            (db-add-stamp db spec commit))))))
+               (guard (c ((evaluation-error? c)
+                          (format #t "Failed to evaluate ~s specification.~%"
+                                  (evaluation-error-spec-name c))
+                          #f))
+                 (let* ((spec* (acons #:current-commit commit spec))
+                        (jobs  (evaluate store db spec*)))
+                   (build-packages store db jobs))))
+             (db-add-stamp db spec commit)))))))
 
   (for-each process jobspecs))
 
-- 
2.13.2

[bug#27865] [PATCH 2/3] pull: Fetch source code from Git.

[Ludovic Courtès]

Howdy Mathieu,

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

> From 6d6b0e48856998251284539e69bbc39e6d21635f Mon Sep 17 00:00:00 2001
> From: Mathieu Othacehe <m.othacehe@gmail.com>
> Date: Mon, 31 Jul 2017 11:08:32 +0200
> Subject: [PATCH] base: Report git errors.
>
> * src/cuirass/base.scm (report-git-error): New procedure.
> (with-git-error-handling): New macro.
> (process-specs): Use with-git-error-handling to catch and report git errors.
> * build-aux/guix.scm (package)[inputs]: Add guile-git.
> * configure.ac: Check for (git) module. Also check that (git) exports
> git-error-message procedure.

[...]

> +(define (report-git-error error)
> +  "Report the given Guile-Git error."
> +  (format #t "Git error: ~a~%" (git-error-message error)))

s/#t/(current-error-port)/

Otherwise LGTM!

Thanks,
Ludo’.

[bug#27865] [PATCH 2/3] pull: Fetch source code from Git.

[Mathieu Othacehe]

> s/#t/(current-error-port)/
>
> Otherwise LGTM!

Thanks, pushed !

Mathieu

[bug#27865] [PATCH 3/3] pull: Use the commit ID as the version string.

[Ludovic Courtès]

* guix/scripts/pull.scm (build-from-source): Add #:commit parameter.
Pass it to BUILD.
(build-and-install): Add #:commit and pass it to 'build-from-source'.
(guix-pull): Pass #:commit to 'build-and-install'.
---
 guix/scripts/pull.scm | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 5f6733cf9..263a727b3 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -134,9 +134,10 @@ Download and deploy the latest version of Guix.\n"))
   ;; a makefile, and, similarly, is intended to always keep this name.
   "build-aux/build-self.scm")
 
-(define* (build-from-source source #:key verbose?)
+(define* (build-from-source source
+                            #:key verbose? commit)
   "Return a derivation to build Guix from SOURCE, using the self-build script
-contained therein."
+contained therein.  Use COMMIT as the version string."
   ;; Running the self-build script makes it easier to update the build
   ;; procedure: the self-build script of the Guix-to-be-installed contains the
   ;; right dependencies, build procedure, etc., which the Guix-in-use may not
@@ -145,12 +146,13 @@ contained therein."
          (build  (primitive-load script)))
     ;; BUILD must be a monadic procedure of at least one argument: the source
     ;; tree.
-    (build source #:verbose? verbose?)))
+    (build source #:verbose? verbose? #:version commit)))
 
 (define* (build-and-install source config-dir
-                            #:key verbose?)
+                            #:key verbose? commit)
   "Build the tool from SOURCE, and install it in CONFIG-DIR."
   (mlet* %store-monad ((source        (build-from-source source
+                                                         #:commit commit
                                                          #:verbose? verbose?))
                        (source-dir -> (derivation->output-path source))
                        (to-do?        (what-to-build (list source)))
@@ -249,6 +251,7 @@ certificates~%"))
                                                      (canonical-package guile-2.0)))))
                (run-with-store store
                  (build-and-install checkout (config-directory)
+                                    #:commit commit
                                     #:verbose? (assoc-ref opts 'verbose?)))))))))))
 
 ;;; pull.scm ends here
-- 
2.13.3

[bug#27865] [PATCH 0/3] Use Guile-Git for 'guix pull'

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 605 bytes --]

Ludovic Courtès <ludo@gnu.org> skribis:

> This change makes Guile-Git a hard dependency.  The transition might be
> somewhat bumpy since it’s possible that users not having Guile-Git
> installed will run ‘guix pull’ and, upon completion, will get an error
> when they re-run ‘guix pull’.  This will be fixed by installing
> ‘guile-git’.  Thinking about it, (guix scripts pull) could perhaps try
> to be smart and have an error message saying “please install Guile-Git”
> or something.

I think we can go as far as installing Guile-Git in the user’s profile,
like this:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 781 bytes --]

diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm
index 8fb9af23c..2f636ec56 100644
--- a/build-aux/build-self.scm
+++ b/build-aux/build-self.scm
@@ -240,6 +240,17 @@ files."
 
                       #:guile-for-build guile)))
 
+(unless (false-if-exception (resolve-interface '(git)))
+  (if guile-git
+      (begin
+        (format (current-error-port)
+                "installing '~a', which is a new requirement of 'guix pull'...~%"
+                (package-name guile-git))
+        ((@ (guix scripts package) guix-package) "-i"
+         (package-name guile-git)))
+      (format (current-error-port)
+              "warning: Please install 'guile-git' upon completion!~%")))
+
 ;; This file is loaded by 'guix pull'; return it the build procedure.
 build
 

[-- Attachment #3: Type: text/plain, Size: 117 bytes --]


The other option is to simply print the warning and hope the user will
act accordingly.

Thoughts?

Ludo’.

bug#27865: [PATCH 0/3] Use Guile-Git for 'guix pull'

[Ludovic Courtès]

ludo@gnu.org (Ludovic Courtès) skribis:

> Ludovic Courtès <ludo@gnu.org> skribis:
>
>> This change makes Guile-Git a hard dependency.  The transition might be
>> somewhat bumpy since it’s possible that users not having Guile-Git
>> installed will run ‘guix pull’ and, upon completion, will get an error
>> when they re-run ‘guix pull’.  This will be fixed by installing
>> ‘guile-git’.  Thinking about it, (guix scripts pull) could perhaps try
>> to be smart and have an error message saying “please install Guile-Git”
>> or something.
>
> I think we can go as far as installing Guile-Git in the user’s profile,
> like this:

I pushed it as 59a16275189f55ddd692b0ea5b415c706fa1fd69 but came up with
something less radical: ‘guix pull’ errors out when Guile-Git is
missing, with a message explaining how to install it.

When upgrading from Guix before Feb. 2017, ‘guix pull’ simply refuses to
upgrade because those old versions lacked a ‘guile-git’ package.

I think this should make the transition mostly painless.
Please report any issues!

Ludo’.