Merge branch 'master' into core-updates

13 files changed, 161 insertions, 38 deletions

diff --git a/guix/build-system/ant.scm b/guix/build-system/ant.scm
index e0870a605c..b5626bd42d 100644
--- a/guix/build-system/ant.scm
+++ b/guix/build-system/ant.scm
@@ -99,6 +99,9 @@
                     (make-flags ''())
                     (build-target "jar")
                     (jar-name #f)
+                    (main-class #f)
+                    (test-include (list "**/*Test.java"))
+                    (test-exclude (list "**/Abstract*.java"))
                     (source-dir "src")
                     (test-dir "src/test")
                     (phases '(@ (guix build ant-build-system)
@@ -130,6 +133,9 @@
                   #:test-target ,test-target
                   #:build-target ,build-target
                   #:jar-name ,jar-name
+                  #:main-class ,main-class
+                  #:test-include (list ,@test-include)
+                  #:test-exclude (list ,@test-exclude)
                   #:source-dir ,source-dir
                   #:test-dir ,test-dir
                   #:phases ,phases
diff --git a/guix/build/ant-build-system.scm b/guix/build/ant-build-system.scm
index 4042630a10..a440daf054 100644
--- a/guix/build/ant-build-system.scm
+++ b/guix/build/ant-build-system.scm
@@ -36,7 +36,9 @@
 ;; Code:
 
 (define* (default-build.xml jar-name prefix #:optional
-                            (source-dir ".") (test-dir "./test"))
+                            (source-dir ".") (test-dir "./test") (main-class #f)
+                            (test-include '("**/*Test.java"))
+                            (test-exclude '("**/Abstract*Test.java")))
   "Create a simple build.xml with standard targets for Ant."
   (call-with-output-file "build.xml"
     (lambda (port)
@@ -44,6 +46,10 @@
        `(project (@ (basedir "."))
                  (property (@ (name "classes.dir")
                               (value "${basedir}/build/classes")))
+                 (property (@ (name "manifest.dir")
+                              (value "${basedir}/build/manifest")))
+                 (property (@ (name "manifest.file")
+                              (value "${manifest.dir}/MANIFEST.MF")))
                  (property (@ (name "jar.dir")
                               (value "${basedir}/build/jar")))
                  (property (@ (name "dist.dir")
@@ -60,6 +66,17 @@
                  (path (@ (id "classpath"))
                        (pathelement (@ (location "${env.CLASSPATH}"))))
 
+                 (target (@ (name "manifest"))
+                         (mkdir (@ (dir "${manifest.dir}")))
+                         (echo (@ (file "${manifest.file}")
+                                  (message ,(string-append
+                                              (if main-class
+                                                (string-append
+                                                  "Main-Class: " main-class
+                                                  "${line.separator}")
+                                                "")
+                                              "")))))
+
                  (target (@ (name "compile"))
                          (mkdir (@ (dir "${classes.dir}")))
                          (javac (@ (includeantruntime "false")
@@ -94,13 +111,19 @@
                                 (batchtest (@ (fork "yes")
                                               (todir "${test.home}/test-reports"))
                                            (fileset (@ (dir "${test.home}/java"))
-                                                    (include (@ (name "**/*Test.java" )))))))
+                                                    ,@(map (lambda (file)
+                                                            `(include (@ (name ,file))))
+                                                       test-include)
+                                                    ,@(map (lambda (file)
+                                                            `(exclude (@ (name ,file))))
+                                                       test-exclude)))))
 
                  (target (@ (name "jar")
-                            (depends "compile"))
+                            (depends "compile, manifest"))
                          (mkdir (@ (dir "${jar.dir}")))
                          (exec (@ (executable "jar"))
-                               (arg (@ (line ,(string-append "-cf ${jar.dir}/" jar-name
+                               (arg (@ (line ,(string-append "-cmf ${manifest.file} "
+                                                             "${jar.dir}/" jar-name
                                                              " -C ${classes.dir} ."))))))
 
                  (target (@ (name "install"))
@@ -133,12 +156,15 @@ to the default GNU unpack strategy."
 
 (define* (configure #:key inputs outputs (jar-name #f)
                     (source-dir "src")
-                    (test-dir "src/test") #:allow-other-keys)
+                    (test-dir "src/test")
+                    (main-class #f)
+                    (test-include '("**/*Test.java"))
+                    (test-exclude '("**/Abstract*.java")) #:allow-other-keys)
   (when jar-name
     (default-build.xml jar-name
                        (string-append (assoc-ref outputs "out")
                                       "/share/java")
-                       source-dir test-dir))
+                       source-dir test-dir main-class test-include test-exclude))
   (setenv "JAVA_HOME" (assoc-ref inputs "jdk"))
   (setenv "CLASSPATH" (generate-classpath inputs)))
 
diff --git a/guix/build/pull.scm b/guix/build/pull.scm
index 03b0f925a7..1ae35ab382 100644
--- a/guix/build/pull.scm
+++ b/guix/build/pull.scm
@@ -178,7 +178,8 @@ containing the source code.  Write any debugging output to DEBUG-PORT."
         ;; Make sure compilation related modules are loaded before starting to
         ;; compile files in parallel.
         (compile #f)
-        (par-for-each
+        (n-par-for-each
+         (parallel-job-count)
          (lambda (file)
            (with-mutex mutex
              (display #\cr log-port)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 55b0df3911..e5779cbd0b 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -773,6 +773,7 @@ Turning finalization off shuts down the finalization thread as a side effect."
                        ("x86_64" 56)
                        ("mips64" 5055)
                        ("armv7l" 120)
+                       ("aarch64" 220)
                        (_ #f))))
     (lambda (flags)
       "Create a new child process by duplicating the current parent process.
diff --git a/guix/download.scm b/guix/download.scm
index a1560de1a1..449521c199 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -235,6 +235,7 @@
        "http://archive.debian.org/debian/")
       (kde
        "http://download.kde.org"
+       "http://download.kde.org/Attic" ; for when it gets archived.
        ;; Mirrors from http://files.kde.org/extra/mirrors.html
        ;; Europe
        "http://mirror.easyname.at/kde"
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 57bbeec465..fc61f0b547 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -33,6 +33,7 @@
   #:use-module (guix licenses)
   #:use-module (guix records)
   #:use-module (guix ui)
+  #:use-module (guix upstream)
   #:use-module (guix utils)
   #:use-module (guix memoization)
   #:use-module (guix scripts)
@@ -73,6 +74,7 @@
             check-mirror-url
             check-license
             check-vulnerabilities
+            check-for-updates
             check-formatting
             run-checkers
 
@@ -826,6 +828,17 @@ from ~s: ~a (~s)~%")
                                  (string-join (map vulnerability-id unpatched)
                                               ", ")))))))))
 
+(define (check-for-updates package)
+  "Check if there is an update available for PACKAGE."
+  (match (package-latest-release* package (force %updaters))
+    ((? upstream-source? source)
+     (when (version>? (upstream-source-version source)
+                      (package-version package))
+       (emit-warning package
+                     (format #f (G_ "can be upgraded to ~a")
+                             (upstream-source-version source)))))
+    (#f #f))) ; cannot find newer upstream release
+
 
 ;;;
 ;;; Source code formatting.
@@ -992,6 +1005,10 @@ or a list thereof")
  (CVE) database")
      (check       check-vulnerabilities))
    (lint-checker
+     (name        'refresh)
+     (description "Check the package for new upstream releases")
+     (check       check-for-updates))
+   (lint-checker
      (name        'formatting)
      (description "Look for formatting issues in the source")
      (check       check-formatting))))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 4adc705220..0e365018a9 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -604,12 +604,12 @@ and upgrades."
     (options->upgrade-predicate opts))
 
   (define upgraded
-    (fold (lambda (entry transaction)
-            (if (upgrade? (manifest-entry-name entry))
-                (transaction-upgrade-entry entry transaction)
-                transaction))
-          transaction
-          (manifest-entries manifest)))
+    (fold-right (lambda (entry transaction)
+                  (if (upgrade? (manifest-entry-name entry))
+                      (transaction-upgrade-entry entry transaction)
+                      transaction))
+                transaction
+                (manifest-entries manifest)))
 
   (define to-install
     (filter-map (match-lambda
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index ade3c49a54..dd54f03996 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -484,9 +484,11 @@ requested using POOL."
          #:buffer-size (* 128 1024))
        (rename-file (string-append nar ".tmp") nar))
       ('none
-       ;; When compression is disabled, we retrieve files directly from the
-       ;; store; no need to cache them.
-       #t))
+       ;; Cache nars even when compression is disabled so that we can
+       ;; guarantee the TTL (see <https://bugs.gnu.org/28664>.)
+       (with-atomic-file-output nar
+         (lambda (port)
+           (write-file item port)))))
 
     (mkdir-p (dirname narinfo))
     (with-atomic-file-output narinfo
@@ -788,8 +790,11 @@ blocking."
           ;; /nar/<store-item>
           ((components ... store-item)
            (if (nar-path? components)
-               (render-nar store request store-item
-                           #:compression %no-compression)
+               (if cache
+                   (render-nar/cached store cache request store-item
+                                      #:compression %no-compression)
+                   (render-nar store request store-item
+                               #:compression %no-compression))
                (not-found request)))
 
           (x (not-found request)))
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index b1c87c870e..2400198000 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -82,7 +82,7 @@ Install it by running:
                (resolve-interface '(git))))
 
 (define %repository-url
-  "https://git.savannah.gnu.org/git/guix.git")
+  (or (getenv "GUIX_PULL_URL") "https://git.savannah.gnu.org/git/guix.git"))
 
 
 ;;;
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 5add64d8e8..d638d744af 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -30,7 +30,6 @@
   #:use-module (guix packages)
   #:use-module (guix profiles)
   #:use-module (guix upstream)
-  #:use-module (guix discovery)
   #:use-module (guix graph)
   #:use-module (guix scripts graph)
   #:use-module (guix monads)
@@ -46,8 +45,7 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 binary-ports)
-  #:export (guix-refresh
-            %updaters))
+  #:export (guix-refresh))
 
 
 ;;;
@@ -162,22 +160,6 @@ specified with `--select'.\n"))
 ;;; Updates.
 ;;;
 
-(define (importer-modules)
-  "Return the list of importer modules."
-  (cons (resolve-interface '(guix gnu-maintenance))
-        (all-modules (map (lambda (entry)
-                            `(,entry . "guix/import"))
-                          %load-path))))
-
-(define %updaters
-  ;; The list of publically-known updaters.
-  (delay (fold-module-public-variables (lambda (obj result)
-                                         (if (upstream-updater? obj)
-                                             (cons obj result)
-                                             result))
-                                       '()
-                                       (importer-modules))))
-
 (define (lookup-updater-by-name name)
   "Return the updater called NAME."
   (or (find (lambda (updater)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 567d8bb643..e50f1d8ac7 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -37,6 +37,8 @@
   #:use-module (guix scripts graph)
   #:use-module (guix build utils)
   #:use-module (gnu build install)
+  #:autoload   (gnu build file-systems)
+                 (find-partition-by-label find-partition-by-uuid)
   #:use-module (gnu system)
   #:use-module (gnu bootloader)
   #:use-module (gnu system file-systems)
@@ -404,6 +406,7 @@ NUMBERS, which is a list of generation numbers."
   "Roll back the system profile to its previous generation.  STORE is an open
 connection to the store."
   (switch-to-system-generation store "-1"))
+
 
 ;;;
 ;;; Switch generations.
@@ -556,6 +559,61 @@ PATTERN, a string.  When PATTERN is #f, display all the system generations."
 
 
 ;;;
+;;; File system declaration checks.
+;;;
+
+(define (check-file-system-availability file-systems)
+  "Check whether the UUIDs or partition labels that FILE-SYSTEMS refer to, if
+any, are available.  Raise an error if they're not."
+  (define relevant
+    (filter (lambda (fs)
+              (and (file-system-mount? fs)
+                   (not (string=? "tmpfs" (file-system-type fs)))
+                   (not (memq 'bind-mount (file-system-flags fs)))))
+            file-systems))
+
+  (define labeled
+    (filter (lambda (fs)
+              (eq? (file-system-title fs) 'label))
+            relevant))
+
+  (define uuid
+    (filter (lambda (fs)
+              (eq? (file-system-title fs) 'uuid))
+            relevant))
+
+  (define fail? #f)
+
+  (define (file-system-location* fs)
+    (location->string
+     (source-properties->location
+      (file-system-location fs))))
+
+  (let-syntax ((error (syntax-rules ()
+                        ((_ args ...)
+                         (begin
+                           (set! fail? #t)
+                           (format (current-error-port)
+                                   args ...))))))
+    (for-each (lambda (fs)
+                (unless (find-partition-by-label (file-system-device fs))
+                  (error (G_ "~a: error: file system with label '~a' not found~%")
+                         (file-system-location* fs)
+                         (file-system-device fs))))
+              labeled)
+    (for-each (lambda (fs)
+                (unless (find-partition-by-uuid (file-system-device fs))
+                  (error (G_ "~a: error: file system with UUID '~a' not found~%")
+                         (file-system-location* fs)
+                         (uuid->string (file-system-device fs)))))
+              uuid)
+
+    (when fail?
+      ;; Better be safe than sorry.
+      (exit 1))))
+
+
+;;;
 ;;; Action.
 ;;;
 
@@ -637,6 +695,13 @@ output when building a system derivation, such as a disk image."
   (when (eq? action 'reconfigure)
     (maybe-suggest-running-guix-pull))
 
+  ;; Check whether the declared file systems exist.  This is better than
+  ;; instantiating a broken configuration.  Assume that we can only check if
+  ;; running as root.
+  (when (and (memq action '(init reconfigure))
+             (zero? (getuid)))
+    (check-file-system-availability (operating-system-file-systems os)))
+
   (mlet* %store-monad
       ((sys       (system-derivation-for-action os action
                                                 #:file-system-type file-system-type
diff --git a/guix/store.scm b/guix/store.scm
index d571122021..f336df85cc 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -41,6 +41,7 @@
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 threads)
+  #:use-module (ice-9 format)
   #:use-module (web uri)
   #:export (%daemon-socket-uri
             %gc-roots-directory
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 6ad52ac960..0fe3308876 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -20,6 +20,7 @@
 (define-module (guix upstream)
   #:use-module (guix records)
   #:use-module (guix utils)
+  #:use-module (guix discovery)
   #:use-module ((guix download)
                 #:select (download-to-store))
   #:use-module (guix gnupg)
@@ -55,6 +56,7 @@
             upstream-updater-predicate
             upstream-updater-latest
 
+            %updaters
             lookup-updater
 
             download-tarball
@@ -146,6 +148,22 @@ correspond to the same version."
   (pred        upstream-updater-predicate)
   (latest      upstream-updater-latest))
 
+(define (importer-modules)
+  "Return the list of importer modules."
+  (cons (resolve-interface '(guix gnu-maintenance))
+        (all-modules (map (lambda (entry)
+                            `(,entry . "guix/import"))
+                          %load-path))))
+
+(define %updaters
+  ;; The list of publically-known updaters.
+  (delay (fold-module-public-variables (lambda (obj result)
+                                         (if (upstream-updater? obj)
+                                             (cons obj result)
+                                             result))
+                                       '()
+                                       (importer-modules))))
+
 (define (lookup-updater package updaters)
   "Return an updater among UPDATERS that matches PACKAGE, or #f if none of
 them matches."