Merge branch 'master' into core-updates

7 files changed, 144 insertions, 30 deletions

diff --git a/guix/build-system/texlive.scm b/guix/build-system/texlive.scm
index b6a86a1c62..ad99d1e2d0 100644
--- a/guix/build-system/texlive.scm
+++ b/guix/build-system/texlive.scm
@@ -30,6 +30,7 @@
             texlive-build
             texlive-build-system
             texlive-ref
+            texlive-origin
             %texlive-tag
             %texlive-revision))
 
@@ -44,6 +45,20 @@
 (define %texlive-tag "texlive-2018.2")
 (define %texlive-revision 49435)
 
+(define (texlive-origin name version locations hash)
+  "Return an <origin> object for a TeX Live package consisting of multiple
+LOCATIONS with a provided HASH.  Use NAME and VERSION to compute a prettier
+name for the checkout directory."
+  (origin
+    (method svn-multi-fetch)
+    (uri (svn-multi-reference
+          (url (string-append "svn://www.tug.org/texlive/tags/"
+                              %texlive-tag "/Master/texmf-dist/"))
+          (locations locations)
+          (revision %texlive-revision)))
+    (file-name (string-append name "-" version "-checkout"))
+    (sha256 hash)))
+
 (define (texlive-ref component id)
   "Return a <svn-reference> object for the package ID, which is part of the
 given Texlive COMPONENT."
diff --git a/guix/build/ant-build-system.scm b/guix/build/ant-build-system.scm
index d79a2d55ed..49549c1b4b 100644
--- a/guix/build/ant-build-system.scm
+++ b/guix/build/ant-build-system.scm
@@ -43,7 +43,8 @@
   (call-with-output-file "build.xml"
     (lambda (port)
       (sxml->xml
-       `(project (@ (basedir "."))
+       `(project (@ (basedir ".")
+                    (name ,jar-name))
                  (property (@ (name "classes.dir")
                               (value "${basedir}/build/classes")))
                  (property (@ (name "manifest.dir")
@@ -118,10 +119,9 @@
                  (target (@ (name "jar")
                             (depends "compile, manifest"))
                          (mkdir (@ (dir "${jar.dir}")))
-                         (exec (@ (executable "jar"))
-                               (arg (@ (line ,(string-append "-cmf ${manifest.file} "
-                                                             "${jar.dir}/" jar-name
-                                                             " -C ${classes.dir} ."))))))
+                         (jar (@ (destfile ,(string-append "${jar.dir}/" jar-name))
+                                 (manifest "${manifest.file}")
+                                 (basedir "${classes.dir}"))))
 
                  (target (@ (name "install"))
                          (copy (@ (todir "${dist.dir}"))
diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm
index f38de16cf7..7d363a18a5 100644
--- a/guix/build/cargo-build-system.scm
+++ b/guix/build/cargo-build-system.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2016 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Ivan Petkov <ivanppetkov@gmail.com>
+;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,6 +40,21 @@
 ;;
 ;; Code:
 
+;; TODO: Move this to (guix build cargo-utils). Will cause a full rebuild
+;; of all rust compilers.
+
+(define (generate-all-checksums dir-name)
+  (for-each
+    (lambda (filename)
+      (let* ((dir (dirname filename))
+             (checksum-file (string-append dir "/.cargo-checksum.json")))
+        (when (file-exists? checksum-file) (delete-file checksum-file))
+        (display (string-append
+                   "patch-cargo-checksums: generate-checksums for "
+                   dir "\n"))
+        (generate-checksums dir)))
+    (find-files dir-name "Cargo.toml$")))
+
 (define (manifest-targets)
   "Extract all targets from the Cargo.toml manifest"
   (let* ((port (open-input-pipe "cargo read-manifest"))
@@ -94,8 +110,7 @@ Cargo.toml file present at its root."
               ;; so that we can generate any cargo checksums.
               ;; The --strip-components argument is needed to prevent creating
               ;; an extra directory within `crate-dir`.
-              (invoke "tar" "xvf" path "-C" crate-dir "--strip-components" "1")
-              (generate-checksums crate-dir)))))
+              (invoke "tar" "xvf" path "-C" crate-dir "--strip-components" "1")))))
     inputs)
 
   ;; Configure cargo to actually use this new directory.
@@ -121,6 +136,31 @@ directory = '" port)
   (setenv "CC" (string-append (assoc-ref inputs "gcc") "/bin/gcc"))
   #t)
 
+;; The Cargo.lock file tells the build system which crates are required for
+;; building and hardcodes their version and checksum.  In order to build with
+;; the inputs we provide, we need to recreate the file with our inputs.
+(define* (update-cargo-lock #:key
+                            (vendor-dir "guix-vendor")
+                            #:allow-other-keys)
+  "Regenerate the Cargo.lock file with the current build inputs."
+  (when (file-exists? "Cargo.lock")
+    (begin
+      ;; Unfortunately we can't generate a Cargo.lock file until the checksums
+      ;; are generated, so we have an extra round of generate-all-checksums here.
+      (generate-all-checksums vendor-dir)
+      (delete-file "Cargo.lock")
+      (invoke "cargo" "generate-lockfile")))
+  #t)
+
+;; After the 'patch-generated-file-shebangs phase any vendored crates who have
+;; their shebangs patched will have a mismatch on their checksum.
+(define* (patch-cargo-checksums #:key
+                                (vendor-dir "guix-vendor")
+                                #:allow-other-keys)
+  "Patch the checksums of the vendored crates after patching their shebangs."
+  (generate-all-checksums vendor-dir)
+  #t)
+
 (define* (build #:key
                 skip-build?
                 (cargo-build-flags '("--release"))
@@ -162,7 +202,9 @@ directory = '" port)
     (replace 'configure configure)
     (replace 'build build)
     (replace 'check check)
-    (replace 'install install)))
+    (replace 'install install)
+    (add-after 'configure 'update-cargo-lock update-cargo-lock)
+    (add-after 'patch-generated-file-shebangs 'patch-cargo-checksums patch-cargo-checksums)))
 
 (define* (cargo-build #:key inputs (phases %standard-phases)
                       #:allow-other-keys #:rest args)
diff --git a/guix/build/svn.scm b/guix/build/svn.scm
index 913f89471b..e3188add3e 100644
--- a/guix/build/svn.scm
+++ b/guix/build/svn.scm
@@ -36,7 +36,7 @@
   "Fetch REVISION from URL into DIRECTORY.  REVISION must be an integer, and a
 valid Subversion revision.  Return #t on success, #f otherwise."
   (apply invoke svn-command
-         "checkout" "--non-interactive"
+         "export" "--non-interactive"
          ;; Trust the server certificate.  This is OK as we
          ;; verify the checksum later.  This can be removed when
          ;; ca-certificates package is added.
@@ -46,13 +46,6 @@ valid Subversion revision.  Return #t on success, #f otherwise."
                        (string-append "--password=" password))
                  '())
            ,url ,directory))
-
-  ;; The contents of '.svn' vary as a function of the current status
-  ;; of the repo.  Since we want a fixed output, this directory needs
-  ;; to be taken out.
-  (with-directory-excursion directory
-    (for-each delete-file-recursively (find-files "." "^\\.svn$" #:directories? #t)))
-
   #t)
 
 ;;; svn.scm ends here
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm
index 52bba3f3bf..ebc99e52cc 100644
--- a/guix/scripts/deploy.scm
+++ b/guix/scripts/deploy.scm
@@ -19,6 +19,7 @@
 
 (define-module (guix scripts deploy)
   #:use-module (gnu machine)
+  #:use-module (guix discovery)
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:use-module (guix store)
@@ -74,7 +75,10 @@ Perform the deployment specified by FILE.\n"))
 
 (define (load-source-file file)
   "Load FILE as a user module."
-  (let ((module (make-user-module '((gnu) (gnu machine) (gnu machine ssh)))))
+  (let* ((guix-path (dirname (search-path %load-path "guix.scm")))
+         (environment-modules (scheme-modules* guix-path "gnu/machine"))
+         (module (make-user-module (append '((gnu) (gnu machine))
+                                           environment-modules))))
     (load* file module)))
 
 (define (guix-deploy . args)
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 8c7d461585..579b7fffbe 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -161,12 +161,7 @@ services as defined by OS."
                                              target-services)
                                         (map live-service-canonical-name
                                              live-services)))
-             (service-files
-              (map shepherd-service-file
-                   (filter (lambda (service)
-                             (memq (shepherd-service-canonical-name service)
-                                   to-start))
-                           target-services))))
+             (service-files (map shepherd-service-file target-services)))
         (eval #~(primitive-load #$(upgrade-services-program service-files
                                                             to-start
                                                             to-unload
@@ -200,21 +195,31 @@ BOOTLOADER-PACKAGE."
                         (srfi srfi-34)
                         (srfi srfi-35))
            (let* ((gc-root (string-append #$target %gc-roots-directory "/bootcfg"))
-                  (temp-gc-root (string-append gc-root ".new")))
-             (switch-symlinks temp-gc-root gc-root)
-             (install-boot-config #$bootcfg #$bootcfg-file #$target)
+                  (new-gc-root (string-append gc-root ".new")))
+             ;; #$bootcfg has dependencies.
+             ;; The bootloader magically loads the configuration from
+             ;; (string-append #$target #$bootcfg-file) (for example
+             ;; "/boot/grub/grub.cfg").
+             ;; If we didn't do something special, the garbage collector
+             ;; would remove the dependencies of #$bootcfg.
+             ;; Register #$bootcfg as a GC root.
              ;; Preserve the previous activation's garbage collector root
              ;; until the bootloader installer has run, so that a failure in
              ;; the bootloader's installer script doesn't leave the user with
              ;; a broken installation.
+             (switch-symlinks new-gc-root #$bootcfg)
+             (install-boot-config #$bootcfg #$bootcfg-file #$target)
              (when #$installer
                (catch #t
                  (lambda ()
                    (#$installer #$bootloader-package #$device #$target))
                  (lambda args
-                   (delete-file temp-gc-root)
+                   (delete-file new-gc-root)
                    (apply throw args))))
-             (rename-file temp-gc-root gc-root)))))))
+             ;; We are sure that the installation of the bootloader
+             ;; succeeded, so we can replace the old GC root by the new
+             ;; GC root now.
+             (rename-file new-gc-root gc-root)))))))
 
 (define* (install-bootloader eval configuration bootcfg
                              #:key
diff --git a/guix/svn-download.scm b/guix/svn-download.scm
index c118869af1..5c25437059 100644
--- a/guix/svn-download.scm
+++ b/guix/svn-download.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
-;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2017, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,7 +32,14 @@
             svn-reference-url
             svn-reference-revision
             svn-fetch
-            download-svn-to-store))
+            download-svn-to-store
+
+            svn-multi-reference
+            svn-multi-reference?
+            svn-multi-reference-url
+            svn-multi-reference-revision
+            svn-multi-reference-locations
+            svn-multi-fetch))
 
 ;;; Commentary:
 ;;;
@@ -83,6 +90,54 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
                       #:guile-for-build guile
                       #:local-build? #t)))
 
+(define-record-type* <svn-multi-reference>
+  svn-multi-reference make-svn-multi-reference
+  svn-multi-reference?
+  (url        svn-multi-reference-url)                 ; string
+  (revision   svn-multi-reference-revision)            ; number
+  (locations  svn-multi-reference-locations)           ; list of strings
+  (user-name  svn-multi-reference-user-name (default #f))
+  (password   svn-multi-reference-password (default #f)))
+
+(define* (svn-multi-fetch ref hash-algo hash
+                          #:optional name
+                          #:key (system (%current-system)) (guile (default-guile))
+                          (svn (subversion-package)))
+  "Return a fixed-output derivation that fetches REF, a <svn-multi-reference>
+object.  The output is expected to have recursive hash HASH of type
+HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
+  (define build
+    (with-imported-modules '((guix build svn)
+                             (guix build utils))
+      #~(begin
+          (use-modules (guix build svn)
+                       (guix build utils)
+                       (srfi srfi-1))
+          (every (lambda (location)
+                   ;; The directory must exist if we are to fetch only a
+                   ;; single file.
+                   (unless (string-suffix? "/" location)
+                     (mkdir-p (string-append #$output "/" (dirname location))))
+                   (svn-fetch (string-append '#$(svn-multi-reference-url ref)
+                                             "/" location)
+                              '#$(svn-multi-reference-revision ref)
+                              (if (string-suffix? "/" location)
+                                  (string-append #$output "/" location)
+                                  (string-append #$output "/" (dirname location)))
+                              #:svn-command (string-append #+svn "/bin/svn")
+                              #:user-name #$(svn-multi-reference-user-name ref)
+                              #:password #$(svn-multi-reference-password ref)))
+                 '#$(svn-multi-reference-locations ref)))))
+
+  (mlet %store-monad ((guile (package->derivation guile system)))
+    (gexp->derivation (or name "svn-checkout") build
+                      #:system system
+                      #:hash-algo hash-algo
+                      #:hash hash
+                      #:recursive? #t
+                      #:guile-for-build guile
+                      #:local-build? #t)))
+
 (define* (download-svn-to-store store ref
                                 #:optional (name (basename (svn-reference-url ref)))
                                 #:key (log (current-error-port)))