Merge branch 'master' into core-updates

 Conflicts:
	etc/news.scm
	gnu/local.mk
	gnu/packages/check.scm
	gnu/packages/cross-base.scm
	gnu/packages/gimp.scm
	gnu/packages/java.scm
	gnu/packages/mail.scm
	gnu/packages/sdl.scm
	gnu/packages/texinfo.scm
	gnu/packages/tls.scm
	gnu/packages/version-control.scm

4 files changed, 95 insertions, 77 deletions

diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index a4b38735a7..4f72304e57 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -1128,4 +1128,5 @@ to your package list.")))
                                         gc-root))
                       (return (format #t "~a~%"
                                       (derivation->output-path drv))))))
+                #:target target
                 #:system (assoc-ref opts 'system)))))))))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 304084796a..b2b734aadd 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -197,6 +197,10 @@ non-zero relevance score."
 (define (transaction-upgrade-entry store entry transaction)
   "Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a
 <manifest-entry>."
+  (define (lower-manifest-entry* entry)
+    (run-with-store store
+      (lower-manifest-entry entry (%current-system))))
+
   (define (supersede old new)
     (info (G_ "package '~a' has been superseded by '~a'~%")
           (manifest-entry-name old) (package-name new))
@@ -209,40 +213,44 @@ non-zero relevance score."
         (output (manifest-entry-output old)))
       transaction)))
 
-  (match (if (manifest-transaction-removal-candidate? entry transaction)
-             'dismiss
-             entry)
-    ('dismiss
-     transaction)
-    (($ <manifest-entry> name version output (? string? path))
-     (match (find-best-packages-by-name name #f)
-       ((pkg . rest)
-        (let ((candidate-version (package-version pkg)))
-          (match (package-superseded pkg)
-            ((? package? new)
-             (supersede entry new))
-            (#f
-             (case (version-compare candidate-version version)
-               ((>)
-                (manifest-transaction-install-entry
-                 (package->manifest-entry* pkg output)
-                 transaction))
-               ((<)
-                transaction)
-               ((=)
-                (let ((candidate-path (derivation->output-path
-                                       (package-derivation store pkg))))
-                  ;; XXX: When there are propagated inputs, assume we need to
-                  ;; upgrade the whole entry.
-                  (if (and (string=? path candidate-path)
-                           (null? (package-propagated-inputs pkg)))
-                      transaction
-                      (manifest-transaction-install-entry
-                       (package->manifest-entry* pkg output)
-                       transaction)))))))))
-       (()
-        (warning (G_ "package '~a' no longer exists~%") name)
-        transaction)))))
+  (define (upgrade entry)
+    (match entry
+      (($ <manifest-entry> name version output (? string? path))
+       (match (find-best-packages-by-name name #f)
+         ((pkg . rest)
+          (let ((candidate-version (package-version pkg)))
+            (match (package-superseded pkg)
+              ((? package? new)
+               (supersede entry new))
+              (#f
+               (case (version-compare candidate-version version)
+                 ((>)
+                  (manifest-transaction-install-entry
+                   (package->manifest-entry* pkg output)
+                   transaction))
+                 ((<)
+                  transaction)
+                 ((=)
+                  (let* ((new (package->manifest-entry* pkg output)))
+                    ;; Here we want to determine whether the NEW actually
+                    ;; differs from ENTRY, but we need to intercept
+                    ;; 'build-things' calls because they would prevent us from
+                    ;; displaying the list of packages to install/upgrade
+                    ;; upfront.  Thus, if lowering NEW triggers a build (due
+                    ;; to grafts), assume NEW differs from ENTRY.
+                    (if (with-build-handler (const #f)
+                          (manifest-entry=? (lower-manifest-entry* new)
+                                            entry))
+                        transaction
+                        (manifest-transaction-install-entry
+                         new transaction)))))))))
+         (()
+          (warning (G_ "package '~a' no longer exists~%") name)
+          transaction)))))
+
+  (if (manifest-transaction-removal-candidate? entry transaction)
+      transaction
+      (upgrade entry)))
 
 
 ;;;
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index a178761203..2664c66a30 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -258,7 +258,7 @@ expression in %STORE-MONAD."
       (lambda ()
         (guard (c ((shepherd-error? c)
                    (values (report-shepherd-error c) store)))
-          (values (run-with-store store (begin mbody ...))
+          (values (run-with-store store (mbegin %store-monad mbody ...))
                   store)))
       (lambda (key proc format-string format-args errno . rest)
         (warning (G_ "while talking to shepherd: ~a~%")
@@ -290,22 +290,6 @@ on service '~a':~%")
         ((not error)                              ;not an error
          #t)))
 
-(define (call-with-service-upgrade-info new-services mproc)
-  "Call MPROC, a monadic procedure in %STORE-MONAD, passing it the list of
-names of services to load (upgrade), and the list of names of services to
-unload."
-  (match (current-services)
-    ((services ...)
-     (let-values (((to-unload to-restart)
-                   (shepherd-service-upgrade services new-services)))
-       (mproc to-restart
-              (map (compose first live-service-provision)
-                   to-unload))))
-    (#f
-     (with-monad %store-monad
-       (warning (G_ "failed to obtain list of shepherd services~%"))
-       (return #f)))))
-
 (define-syntax-rule (unless-file-not-found exp)
   (catch 'system-error
     (lambda ()
@@ -825,10 +809,10 @@ static checks."
        ;; For 'init' and 'reconfigure', always build BOOTCFG, even if
        ;; --no-bootloader is passed, because we then use it as a GC root.
        ;; See <http://bugs.gnu.org/21068>.
-       (drvs      (mapm %store-monad lower-object
-                        (if (memq action '(init reconfigure))
-                            (list sys bootcfg)
-                            (list sys))))
+       (drvs      (mapm/accumulate-builds lower-object
+                                          (if (memq action '(init reconfigure))
+                                              (list sys bootcfg)
+                                              (list sys))))
        (%         (if derivations-only?
                       (return (for-each (compose println derivation-file-name)
                                         drvs))
@@ -853,7 +837,10 @@ static checks."
                   (info (G_ "bootloader successfully installed on '~a'~%")
                         (bootloader-configuration-target bootloader))))
                (with-shepherd-error-handling
-                  (upgrade-shepherd-services local-eval os))))
+                 (upgrade-shepherd-services local-eval os)
+                 (return (format #t (G_ "\
+To complete the upgrade, run 'herd restart SERVICE' to stop,
+upgrade, and restart each service that was not automatically restarted.\n"))))))
             ((init)
              (newline)
              (format #t (G_ "initializing operating system under '~a'...~%")
@@ -1294,7 +1281,6 @@ argument list and OPTS is the option alist."
           (process-command command args opts))))))
 
 ;;; Local Variables:
-;;; eval: (put 'call-with-service-upgrade-info 'scheme-indent-function 1)
 ;;; eval: (put 'with-store* 'scheme-indent-function 1)
 ;;; End:
 
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 77a72307b4..7885c33457 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -33,6 +33,7 @@
   #:use-module (guix modules)
   #:use-module (guix monads)
   #:use-module (guix store)
+  #:use-module ((guix self) #:select (make-config.scm))
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
@@ -60,6 +61,14 @@
 ;;; Profile creation.
 ;;;
 
+(define not-config?
+  ;; Select (guix …) and (gnu …) modules, except (guix config).
+  (match-lambda
+    (('guix 'config) #f)
+    (('guix rest ...) #t)
+    (('gnu rest ...) #t)
+    (_ #f)))
+
 (define* (switch-system-program os #:optional profile)
   "Return an executable store item that, upon being evaluated, will create a
 new generation of PROFILE pointing to the directory of OS, switch to it
@@ -67,9 +76,11 @@ atomically, and run OS's activation script."
   (program-file
    "switch-to-system.scm"
    (with-extensions (list guile-gcrypt)
-     (with-imported-modules (source-module-closure '((guix config)
-                                                     (guix profiles)
-                                                     (guix utils)))
+     (with-imported-modules `(,@(source-module-closure
+                                 '((guix profiles)
+                                   (guix utils))
+                                 #:select? not-config?)
+                              ((guix config) => ,(make-config.scm)))
        #~(begin
            (use-modules (guix config)
                         (guix profiles)
@@ -89,7 +100,8 @@ atomically, and run OS's activation script."
   "Using EVAL, a monadic procedure taking a single G-Expression as an argument,
 create a new generation of PROFILE pointing to the directory of OS, switch to
 it atomically, and run OS's activation script."
-  (eval #~(primitive-load #$(switch-system-program os profile))))
+  (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
+            (primitive-load #$(switch-system-program os profile)))))
 
 
 ;;;
@@ -165,10 +177,11 @@ services as defined by OS."
                                         (map live-service-canonical-name
                                              live-services)))
              (service-files (map shepherd-service-file target-services)))
-        (eval #~(primitive-load #$(upgrade-services-program service-files
-                                                            to-start
-                                                            to-unload
-                                                            to-restart)))))))
+        (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
+                  (primitive-load #$(upgrade-services-program service-files
+                                                              to-start
+                                                              to-unload
+                                                              to-restart))))))))
 
 
 ;;;
@@ -184,10 +197,13 @@ BOOTLOADER-PACKAGE."
   (program-file
    "install-bootloader.scm"
    (with-extensions (list guile-gcrypt)
-     (with-imported-modules (source-module-closure '((gnu build bootloader)
-                                                     (gnu build install)
-                                                     (guix store)
-                                                     (guix utils)))
+     (with-imported-modules `(,@(source-module-closure
+                                 '((gnu build bootloader)
+                                   (gnu build install)
+                                   (guix store)
+                                   (guix utils))
+                                 #:select? not-config?)
+                              ((guix config) => ,(make-config.scm)))
        #~(begin
            (use-modules (gnu build bootloader)
                         (gnu build install)
@@ -195,8 +211,10 @@ BOOTLOADER-PACKAGE."
                         (guix store)
                         (guix utils)
                         (ice-9 binary-ports)
+                        (ice-9 match)
                         (srfi srfi-34)
                         (srfi srfi-35))
+
            (let* ((gc-root (string-append #$target %gc-roots-directory "/bootcfg"))
                   (new-gc-root (string-append gc-root ".new")))
              ;; #$bootcfg has dependencies.
@@ -218,7 +236,11 @@ BOOTLOADER-PACKAGE."
                    (#$installer #$bootloader-package #$device #$target))
                  (lambda args
                    (delete-file new-gc-root)
-                   (apply throw args))))
+                   (match args
+                     (('%exception exception)     ;Guile 3 SRFI-34 or similar
+                      (raise-exception exception))
+                     ((key . args)
+                      (apply throw key args))))))
              ;; We are sure that the installation of the bootloader
              ;; succeeded, so we can replace the old GC root by the new
              ;; GC root now.
@@ -237,9 +259,10 @@ additional configurations specified by MENU-ENTRIES can be selected."
          (package (bootloader-package bootloader))
          (device (bootloader-configuration-target configuration))
          (bootcfg-file (bootloader-configuration-file bootloader)))
-    (eval #~(primitive-load #$(install-bootloader-program installer
-                                                          package
-                                                          bootcfg
-                                                          bootcfg-file
-                                                          device
-                                                          target)))))
+    (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
+              (primitive-load #$(install-bootloader-program installer
+                                                            package
+                                                            bootcfg
+                                                            bootcfg-file
+                                                            device
+                                                            target))))))