Merge branch 'master' into core-updates

9 files changed, 59 insertions, 28 deletions

diff --git a/guix/channels.scm b/guix/channels.scm
index c40fc0c507..476d62e1f4 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -657,10 +657,11 @@ that unconditionally resumes the continuation."
               store))))
 
 (define* (build-from-source instance
-                            #:key core verbose? (dependencies '()))
+                            #:key core verbose? (dependencies '()) system)
   "Return a derivation to build Guix from INSTANCE, using the self-build
 script contained therein.  When CORE is true, build package modules under
-SOURCE using CORE, an instance of Guix."
+SOURCE using CORE, an instance of Guix.  By default, build for the current
+system, or SYSTEM if specified."
   (define name
     (symbol->string
      (channel-name (channel-instance-channel instance))))
@@ -700,20 +701,22 @@ SOURCE using CORE, an instance of Guix."
           (with-trivial-build-handler
            (build source
                   #:verbose? verbose? #:version commit
+                  #:system system
                   #:channel-metadata (channel-instance->sexp instance)
                   #:pull-version %pull-version))))
 
       ;; Build a set of modules that extend Guix using the standard method.
       (standard-module-derivation name source core dependencies)))
 
-(define* (build-channel-instance instance
+(define* (build-channel-instance instance system
                                  #:optional core (dependencies '()))
   "Return, as a monadic value, the derivation for INSTANCE, a channel
-instance.  DEPENDENCIES is a list of extensions providing Guile modules that
-INSTANCE depends on."
+instance, for SYSTEM.  DEPENDENCIES is a list of extensions providing Guile
+modules that INSTANCE depends on."
   (build-from-source instance
                      #:core core
-                     #:dependencies dependencies))
+                     #:dependencies dependencies
+                     #:system system))
 
 (define (resolve-dependencies instances)
   "Return a procedure that, given one of the elements of INSTANCES, returns
@@ -743,9 +746,9 @@ list of instances it depends on."
   (lambda (instance)
     (vhash-foldq* cons '() instance edges)))
 
-(define (channel-instance-derivations instances)
+(define* (channel-instance-derivations instances #:key system)
   "Return the list of derivations to build INSTANCES, in the same order as
-INSTANCES."
+INSTANCES.  Build for the current system by default, or SYSTEM if specified."
   (define core-instance
     ;; The 'guix' channel is treated specially: it's an implicit dependency of
     ;; all the other channels.
@@ -757,13 +760,13 @@ INSTANCES."
     (resolve-dependencies instances))
 
   (define (instance->derivation instance)
-    (mlet %store-monad ((system (current-system)))
+    (mlet %store-monad ((system (if system (return system) (current-system))))
       (mcached (if (eq? instance core-instance)
-                   (build-channel-instance instance)
+                   (build-channel-instance instance system)
                    (mlet %store-monad ((core (instance->derivation core-instance))
                                        (deps (mapm %store-monad instance->derivation
                                                    (edges instance))))
-                     (build-channel-instance instance core deps)))
+                     (build-channel-instance instance system core deps)))
                instance
                system)))
 
@@ -865,9 +868,10 @@ derivation."
                     intro))))))
             '()))))
 
-(define (channel-instances->manifest instances)
+(define* (channel-instances->manifest instances #:key system)
   "Return a profile manifest with entries for all of INSTANCES, a list of
-channel instances."
+channel instances.  By default, build for the current system, or SYSTEM if
+specified."
   (define (instance->entry instance drv)
     (let ((commit  (channel-instance-commit instance))
           (channel (channel-instance-channel instance)))
@@ -883,7 +887,8 @@ channel instances."
         (properties
          `((source ,(channel-instance->sexp instance)))))))
 
-  (mlet* %store-monad ((derivations (channel-instance-derivations instances))
+  (mlet* %store-monad ((derivations (channel-instance-derivations instances
+                                                                  #:system system))
                        (entries ->  (map instance->entry instances derivations)))
     (return (manifest entries))))
 
diff --git a/guix/describe.scm b/guix/describe.scm
index 0683ad8a27..711b7b4290 100644
--- a/guix/describe.scm
+++ b/guix/describe.scm
@@ -122,15 +122,24 @@ lives in, or the empty list if this is not applicable."
   (mlambda ()
     "Return the list of channels currently available, including the 'guix'
 channel.  Return the empty list if this information is missing."
+    (define (build-time-metadata)
+      (match (channel-metadata)
+        (#f '())
+        (sexp (or (and=> (sexp->channel sexp 'guix) list) '()))))
+
     (match (current-profile-entries)
       (()
        ;; As a fallback, if we're not running from a profile, use 'guix'
        ;; channel metadata from (guix config).
-       (match (channel-metadata)
-         (#f '())
-         (sexp (or (and=> (sexp->channel sexp 'guix) list) '()))))
+       (build-time-metadata))
       (entries
-       (filter-map manifest-entry-channel entries)))))
+       (match (filter-map manifest-entry-channel entries)
+         (()
+          ;; This profile lacks provenance metadata, so fall back to
+          ;; build-time metadata as returned by 'channel-metadata'.
+          (build-time-metadata))
+         (lst
+          lst))))))
 
 (define (package-path-entries)
   "Return two values: the list of package path entries to be added to the
diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index 4ec3be99ca..07477f816e 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -253,10 +253,11 @@ taken since we do not import the archives."
 NARINFO."
   (let*-values (((uri compression size)
                  (narinfo-best-uri narinfo))
-                ((port response)
+                ((port actual-size)
                  (http-fetch uri)))
     (define reporter
-      (progress-reporter/file (narinfo-path narinfo) size
+      (progress-reporter/file (narinfo-path narinfo)
+                              (max size (or actual-size 0)) ;defensive
                               #:abbreviation (const (uri-host uri))))
 
     (define result
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index b5f6249176..a3e3338f7e 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -301,4 +301,11 @@ text.  The hyperlink links to a web view of COMMIT, when available."
            (channels
             (display-profile-info #f format channels))))
         (profile
-         (display-profile-info (canonicalize-profile profile) format))))))
+         ;; For the current profile, resort to 'current-channels', which has a
+         ;; fallback to metadata from (guix config) in case PROFILE lacks it.
+         (let ((channels (if (and (current-profile)
+                                  (string=? profile (current-profile)))
+                             (current-channels)
+                             (profile-channels profile))))
+           (display-profile-info (canonicalize-profile profile)
+                                 format channels)))))))
diff --git a/guix/scripts/import/go.scm b/guix/scripts/import/go.scm
index 04b07f80cc..74e8e60cce 100644
--- a/guix/scripts/import/go.scm
+++ b/guix/scripts/import/go.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020 Katherine Cox-Buday <cox.katherine.e@gmail.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 Zheng Junjie <873216071@qq.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -68,9 +69,7 @@ that are not yet in Guix"))
                    (alist-cons 'recursive #t result)))
          (option '(#\p "goproxy") #t #f
                  (lambda (opt name arg result)
-                   (alist-cons 'goproxy
-                               (string->symbol arg)
-                               (alist-delete 'goproxy result))))
+                   (alist-cons 'goproxy arg (alist-delete 'goproxy result))))
          (option '("pin-versions") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'pin-versions? #t result)))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0a051ee4e3..40401d7e03 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -717,6 +717,7 @@ checking this by themselves in their 'check' procedure."
        (lower-object (system-image image)))
       ((docker-image)
        (system-docker-image os
+                            #:memory-size 1024
                             #:shared-network? container-shared-network?)))))
 
 (define (maybe-suggest-running-guix-pull)
diff --git a/guix/self.scm b/guix/self.scm
index cdbb606a0b..666245321b 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -63,6 +63,7 @@
       ("guile-zstd" (ref '(gnu packages guile) 'guile-zstd))
       ("guile-gcrypt"  (ref '(gnu packages gnupg) 'guile-gcrypt))
       ("gnutls"     (ref '(gnu packages tls) 'gnutls))
+      ("disarchive" (ref '(gnu packages backup) 'disarchive))
       ("gzip"       (ref '(gnu packages compression) 'gzip))
       ("bzip2"      (ref '(gnu packages compression) 'bzip2))
       ("xz"         (ref '(gnu packages compression) 'xz))
@@ -842,6 +843,9 @@ itself."
   (define gnutls
     (specification->package "gnutls"))
 
+  (define disarchive
+    (specification->package "disarchive"))
+
   (define dependencies
     (append-map transitive-package-dependencies
                 (list guile-gcrypt gnutls guile-git guile-avahi
@@ -1026,7 +1030,8 @@ itself."
          (let* ((modules  (built-modules (compose list node-source+compiled)))
                 (command  (guix-command modules
                                         #:source source
-                                        #:dependencies dependencies
+                                        #:dependencies
+                                        (cons disarchive dependencies)
                                         #:guile guile-for-build
                                         #:guile-version guile-version)))
            (whole-package name modules dependencies
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 77a9732ce5..232b6bfe94 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -268,7 +268,7 @@ EXP never returns or calls 'primitive-exit' when it's done."
 
        ;; Use 'connect-to-daemon' to honor GUIX_DAEMON_SOCKET.
        (let ((sock    (connect-to-daemon (or (getenv "GUIX_DAEMON_SOCKET")
-                                             socket-name)))
+                                             ,socket-name)))
              (stdin   (current-input-port))
              (stdout  (current-output-port))
              (select* (lambda (read write except)
diff --git a/guix/swh.scm b/guix/swh.scm
index 3005323fd1..06d2957252 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -455,7 +455,11 @@ URL could not be found."
   (match (lookup-origin url)
     (#f #f)
     (origin
-      (match (filter visit-snapshot-url (origin-visits origin))
+      (match (filter (lambda (visit)
+                       ;; Return #f if (visit-snapshot VISIT) would return #f.
+                       (and (visit-snapshot-url visit)
+                            (eq? 'full (visit-status visit))))
+                     (origin-visits origin))
         ((visit . _)
          (let ((snapshot (visit-snapshot visit)))
            (match (and=> (find (lambda (branch)