Merge branch 'master' into staging

12 files changed, 378 insertions, 97 deletions

diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm
index f794bf006b..630b99e2bf 100644
--- a/guix/build-system/asdf.scm
+++ b/guix/build-system/asdf.scm
@@ -230,7 +230,10 @@ set up using CL source package conventions."
              ((#:phases phases) (list phases-transformer phases))))
           (inputs (new-inputs package-inputs))
           (propagated-inputs (new-propagated-inputs))
-          (native-inputs (new-inputs package-native-inputs))
+          (native-inputs (append (if target-is-source?
+                                     (list (list (package-name pkg) pkg))
+                                     '())
+                                 (new-inputs package-native-inputs)))
           (outputs (if target-is-source?
                        '("out")
                        (package-outputs pkg)))))
diff --git a/guix/build-system/guile.scm b/guix/build-system/guile.scm
index 3693014694..45e735b987 100644
--- a/guix/build-system/guile.scm
+++ b/guix/build-system/guile.scm
@@ -29,6 +29,10 @@
   #:export (%guile-build-system-modules
             guile-build-system))
 
+(define %scheme-file-regexp
+  ;; Regexp to match Scheme files.
+  "\\.(scm|sls)$")
+
 (define %guile-build-system-modules
   ;; Build-side modules imported by default.
   `((guix build guile-build-system)
@@ -80,6 +84,7 @@
                       (system (%current-system))
                       (source-directory ".")
                       not-compiled-file-regexp
+                      (scheme-file-regexp %scheme-file-regexp)
                       (compile-flags %compile-flags)
                       (imported-modules %guile-build-system-modules)
                       (modules '((guix build guile-build-system)
@@ -97,6 +102,7 @@
                                 (source
                                  source))
                     #:source-directory ,source-directory
+                    #:scheme-file-regexp ,scheme-file-regexp
                     #:not-compiled-file-regexp ,not-compiled-file-regexp
                     #:compile-flags ,compile-flags
                     #:phases ,phases
diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm
index f3f4b49bcf..25dd031962 100644
--- a/guix/build/asdf-build-system.scm
+++ b/guix/build/asdf-build-system.scm
@@ -85,7 +85,8 @@ valid."
     ;; files before compiling.
     (for-each (lambda (file)
                 (let ((s (lstat file)))
-                  (unless (eq? (stat:type s) 'symlink)
+                  (unless (or (eq? (stat:type s) 'symlink)
+                              (not (access? file W_OK)))
                     (utime file 0 0 0 0))))
               (find-files source #:directories? #t))
     (copy-recursively source target #:keep-mtime? #t)
@@ -97,12 +98,53 @@ valid."
      (find-files target "\\.asd$"))
     #t))
 
-(define* (install #:key outputs #:allow-other-keys)
-  "Copy and symlink all the source files."
+(define* (install #:key inputs outputs #:allow-other-keys)
+  "Copy and symlink all the source files.
+The source files are taken from the corresponding compile package (e.g. SBCL)
+if it's present in the native-inputs."
   (define output (assoc-ref outputs "out"))
-  (copy-files-to-output output
-                        (package-name->name+version
-                         (strip-store-file-name output))))
+  (define package-name
+    (package-name->name+version
+     (strip-store-file-name output)))
+  (define (no-prefix pkgname)
+    (if (string-index pkgname #\-)
+        (string-drop pkgname (1+ (string-index pkgname #\-)))
+        pkgname))
+  (define parent
+    (match (assoc package-name inputs
+                  (lambda (key alist-car)
+                    (let* ((alt-key (no-prefix key))
+                           (alist-car (no-prefix alist-car)))
+                      (or (string=? alist-car key)
+                          (string=? alist-car alt-key)))))
+      (#f #f)
+      (p (cdr p))))
+  (define parent-name
+    (and parent
+         (package-name->name+version (strip-store-file-name parent))))
+  (define parent-source
+    (and parent
+         (string-append parent "/share/common-lisp/"
+                        (string-take parent-name
+                                     (string-index parent-name #\-))
+                        "-source")))
+
+  (define (first-subdirectory directory) ; From gnu-build-system.
+    "Return the file name of the first sub-directory of DIRECTORY."
+    (match (scandir directory
+                    (lambda (file)
+                      (and (not (member file '("." "..")))
+                           (file-is-directory? (string-append directory "/"
+                                                              file)))))
+      ((first . _) first)))
+  (define source-directory
+    (if (and parent-source
+             (file-exists? parent-source))
+        (string-append parent-source "/" (first-subdirectory parent-source))
+        "."))
+
+  (with-directory-excursion source-directory
+    (copy-files-to-output output package-name)))
 
 (define* (copy-source #:key outputs asd-system-name #:allow-other-keys)
   "Copy the source to the library output."
diff --git a/guix/build/minify-build-system.scm b/guix/build/minify-build-system.scm
index 563def88e9..92158a033f 100644
--- a/guix/build/minify-build-system.scm
+++ b/guix/build/minify-build-system.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -54,8 +55,12 @@
   (let* ((out (assoc-ref outputs "out"))
          (js  (string-append out "/share/javascript/")))
     (mkdir-p js)
-    (for-each (cut install-file <> js)
-              (find-files "guix/build" "\\.min\\.js$")))
+    (for-each
+      (lambda (file)
+        (if (not (zero? (stat:size (stat file))))
+          (install-file file js)
+          (error "File is empty: " file)))
+      (find-files "guix/build" "\\.min\\.js$")))
   #t)
 
 (define %standard-phases
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index ff008c5b78..8070c5546f 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -1315,62 +1315,131 @@ bytes."
       40
       32))
 
-(define-c-struct sockaddr-in                      ;<linux/in.h>
-  sizeof-sockaddrin
+(define-c-struct sockaddr-in/linux                ;<linux/in.h>
+  sizeof-sockaddr-in/linux
   (lambda (family port address)
     (make-socket-address family address port))
-  read-sockaddr-in
-  write-sockaddr-in!
+  read-sockaddr-in/linux
+  write-sockaddr-in!/linux
   (family    unsigned-short)
   (port      (int16 ~ big))
   (address   (int32 ~ big)))
 
-(define-c-struct sockaddr-in6                     ;<linux/in6.h>
-  sizeof-sockaddr-in6
+(define-c-struct sockaddr-in/hurd                 ;<netinet/in.h>
+  sizeof-sockaddr-in/hurd
+  (lambda (len family port address zero)
+    (make-socket-address family address port))
+  read-sockaddr-in/hurd
+  write-sockaddr-in!/hurd
+  (len       uint8)
+  (family    uint8)
+  (port      (int16 ~ big))
+  (address   (int32 ~ big))
+  (zero      (array uint8 8)))
+
+(define-c-struct sockaddr-in6/linux               ;<linux/in6.h>
+  sizeof-sockaddr-in6/linux
   (lambda (family port flowinfo address scopeid)
     (make-socket-address family address port flowinfo scopeid))
-  read-sockaddr-in6
-  write-sockaddr-in6!
+  read-sockaddr-in6/linux
+  write-sockaddr-in6!/linux
   (family    unsigned-short)
   (port      (int16 ~ big))
   (flowinfo  (int32 ~ big))
   (address   (int128 ~ big))
   (scopeid   int32))
 
-(define (write-socket-address! sockaddr bv index)
+(define-c-struct sockaddr-in6/hurd                ;<netinet/in.h>
+  sizeof-sockaddr-in6/hurd
+  (lambda (len family port flowinfo address scopeid)
+    (make-socket-address family address port flowinfo scopeid))
+  read-sockaddr-in6/hurd
+  write-sockaddr-in6!/hurd
+  (len       uint8)
+  (family    uint8)
+  (port      (int16 ~ big))
+  (flowinfo  (int32 ~ big))
+  (address   (int128 ~ big))
+  (scopeid   int32))
+
+(define (write-socket-address!/linux sockaddr bv index)
+  "Write SOCKADDR, a socket address as returned by 'make-socket-address', to
+bytevector BV at INDEX."
+  (let ((family (sockaddr:fam sockaddr)))
+    (cond ((= family AF_INET)
+           (write-sockaddr-in!/linux bv index
+                                     family
+                                     (sockaddr:port sockaddr)
+                                     (sockaddr:addr sockaddr)))
+          ((= family AF_INET6)
+           (write-sockaddr-in6!/linux bv index
+                                      family
+                                      (sockaddr:port sockaddr)
+                                      (sockaddr:flowinfo sockaddr)
+                                      (sockaddr:addr sockaddr)
+                                      (sockaddr:scopeid sockaddr)))
+          (else
+           (error "unsupported socket address" sockaddr)))))
+
+(define (write-socket-address!/hurd sockaddr bv index)
   "Write SOCKADDR, a socket address as returned by 'make-socket-address', to
 bytevector BV at INDEX."
   (let ((family (sockaddr:fam sockaddr)))
     (cond ((= family AF_INET)
-           (write-sockaddr-in! bv index
-                               family
-                               (sockaddr:port sockaddr)
-                               (sockaddr:addr sockaddr)))
+           (write-sockaddr-in!/hurd bv index
+                                    sizeof-sockaddr-in/hurd
+                                    family
+                                    (sockaddr:port sockaddr)
+                                    (sockaddr:addr sockaddr)
+                                    '(0 0 0 0 0 0 0 0)))
           ((= family AF_INET6)
-           (write-sockaddr-in6! bv index
-                                family
-                                (sockaddr:port sockaddr)
-                                (sockaddr:flowinfo sockaddr)
-                                (sockaddr:addr sockaddr)
-                                (sockaddr:scopeid sockaddr)))
+           (write-sockaddr-in6!/hurd bv index
+                                     sizeof-sockaddr-in6/hurd
+                                     family
+                                     (sockaddr:port sockaddr)
+                                     (sockaddr:flowinfo sockaddr)
+                                     (sockaddr:addr sockaddr)
+                                     (sockaddr:scopeid sockaddr)))
           (else
            (error "unsupported socket address" sockaddr)))))
 
+(define write-socket-address!
+  (if (string-suffix? "linux-gnu" %host-type)
+      write-socket-address!/linux
+      write-socket-address!/hurd))
+
 (define PF_PACKET 17)                             ;<bits/socket.h>
 (define AF_PACKET PF_PACKET)
 
-(define* (read-socket-address bv #:optional (index 0))
+(define* (read-socket-address/linux bv #:optional (index 0))
+  "Read a socket address from bytevector BV at INDEX."
+  (let ((family (bytevector-u16-native-ref bv index)))
+    (cond ((= family AF_INET)
+           (read-sockaddr-in/linux bv index))
+          ((= family AF_INET6)
+           (read-sockaddr-in6/linux bv index))
+          (else
+           ;; XXX: Unsupported address family, such as AF_PACKET.  Return a
+           ;; vector such that the vector can at least call 'sockaddr:fam'.
+           (vector family)))))
+
+(define* (read-socket-address/hurd bv #:optional (index 0))
   "Read a socket address from bytevector BV at INDEX."
   (let ((family (bytevector-u16-native-ref bv index)))
     (cond ((= family AF_INET)
-           (read-sockaddr-in bv index))
+           (read-sockaddr-in/hurd bv index))
           ((= family AF_INET6)
-           (read-sockaddr-in6 bv index))
+           (read-sockaddr-in6/hurd bv index))
           (else
            ;; XXX: Unsupported address family, such as AF_PACKET.  Return a
            ;; vector such that the vector can at least call 'sockaddr:fam'.
            (vector family)))))
 
+(define read-socket-address
+  (if (string-suffix? "linux-gnu" %host-type)
+      read-socket-address/linux
+      read-socket-address/hurd))
+
 (define %ioctl
   ;; The most terrible interface, live from Scheme.
   (syscall->procedure int "ioctl" (list int unsigned-long '*)))
diff --git a/guix/channels.scm b/guix/channels.scm
index aca8302ba0..f0174de767 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -347,6 +347,21 @@ to '%package-module-path'."
       (((predicate . guile) rest ...)
        (if (predicate source) (guile) (loop rest))))))
 
+(define (call-with-guile guile thunk)
+  (lambda (store)
+    (values (parameterize ((%guile-for-build
+                            (if guile
+                                (package-derivation store guile)
+                                (%guile-for-build))))
+              (run-with-store store (thunk)))
+            store)))
+
+(define-syntax-rule (with-guile guile exp ...)
+  "Set GUILE as the '%guile-for-build' parameter for the dynamic extent of
+EXP, a series of monadic expressions."
+  (call-with-guile guile (lambda ()
+                           (mbegin %store-monad exp ...))))
+
 (define (with-trivial-build-handler mvalue)
   "Run MVALUE, a monadic value, with a \"trivial\" build handler installed
 that unconditionally resumes the continuation."
@@ -385,10 +400,7 @@ package modules under SOURCE using CORE, an instance of Guix."
         ;; Note: BUILD can return #f if it does not support %PULL-VERSION.  In
         ;; the future we'll fall back to a previous version of the protocol
         ;; when that happens.
-        (mbegin %store-monad
-          (mwhen guile
-            (set-guile-for-build guile))
-
+        (with-guile guile
           ;; BUILD is usually quite costly.  Install a "trivial" build handler
           ;; so we don't bounce an outer build-accumulator handler that could
           ;; cause us to redo half of the BUILD computation several times just
@@ -750,3 +762,7 @@ NEW.  When OLD is omitted or is #f, return all the news entries of CHANNEL."
       (if (= GIT_ENOTFOUND (git-error-code error))
           '()
           (apply throw key error rest)))))
+
+;;; Local Variables:
+;;; eval: (put 'with-guile 'scheme-indent-function 1)
+;;; End:
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 2a4b36519c..78b8af6fbc 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -37,6 +37,7 @@
             gexp?
             with-imported-modules
             with-extensions
+            let-system
 
             gexp-input
             gexp-input?
@@ -195,7 +196,9 @@ returns its output file name of OBJ's OUTPUT."
     ((? derivation? drv)
      (derivation->output-path drv output))
     ((? string? file)
-     file)))
+     file)
+    ((? self-quoting? obj)
+     obj)))
 
 (define (register-compiler! compiler)
   "Register COMPILER as a gexp compiler."
@@ -226,32 +229,62 @@ procedure to expand it; otherwise return #f."
 corresponding to OBJ for SYSTEM, cross-compiling for TARGET if TARGET is true.
 OBJ must be an object that has an associated gexp compiler, such as a
 <package>."
-  (match (lookup-compiler obj)
-    (#f
-     (raise (condition (&gexp-input-error (input obj)))))
-    (lower
-     ;; Cache in STORE the result of lowering OBJ.
-     (mlet %store-monad ((target (if (eq? target 'current)
-                                     (current-target-system)
-                                     (return target)))
-                         (graft? (grafting?)))
-       (mcached (let ((lower (lookup-compiler obj)))
-                  (lower obj system target))
-                obj
-                system target graft?)))))
+  (mlet %store-monad ((target (if (eq? target 'current)
+                                  (current-target-system)
+                                  (return target)))
+                      (graft? (grafting?)))
+    (let loop ((obj obj))
+      (match (lookup-compiler obj)
+        (#f
+         (raise (condition (&gexp-input-error (input obj)))))
+        (lower
+         ;; Cache in STORE the result of lowering OBJ.
+         (mcached (mlet %store-monad ((lowered (lower obj system target)))
+                    (if (and (struct? lowered)
+                             (not (derivation? lowered)))
+                        (loop lowered)
+                        (return lowered)))
+                  obj
+                  system target graft?))))))
+
+(define* (lower+expand-object obj
+                              #:optional (system (%current-system))
+                              #:key target (output "out"))
+  "Return as a value in %STORE-MONAD the output of object OBJ expands to for
+SYSTEM and TARGET.  Object such as <package>, <file-append>, or <plain-file>
+expand to file names, but it's possible to expand to a plain data type."
+  (let loop ((obj obj)
+             (expand (and (struct? obj) (lookup-expander obj))))
+    (match (lookup-compiler obj)
+      (#f
+       (raise (condition (&gexp-input-error (input obj)))))
+      (lower
+       (mlet* %store-monad ((graft?  (grafting?))
+                            (lowered (mcached (lower obj system target)
+                                              obj
+                                              system target graft?)))
+         ;; LOWER might return something that needs to be further
+         ;; lowered.
+         (if (struct? lowered)
+             ;; If we lack an expander, delegate to that of LOWERED.
+             (if (not expand)
+                 (loop lowered (lookup-expander lowered))
+                 (return (expand obj lowered output)))
+             (return lowered)))))))               ;self-quoting
 
 (define-syntax define-gexp-compiler
   (syntax-rules (=> compiler expander)
     "Define NAME as a compiler for objects matching PREDICATE encountered in
 gexps.
 
-In the simplest form of the macro, BODY must return a derivation for PARAM, an
-object that matches PREDICATE, for SYSTEM and TARGET (the latter of which is
-#f except when cross-compiling.)
+In the simplest form of the macro, BODY must return (1) a derivation for
+a record of the specified type, for SYSTEM and TARGET (the latter of which is
+#f except when cross-compiling), (2) another record that can itself be
+compiled down to a derivation, or (3) an object of a primitive data type.
 
 The more elaborate form allows you to specify an expander:
 
-  (define-gexp-compiler something something?
+  (define-gexp-compiler something-compiler <something>
     compiler => (lambda (param system target) ...)
     expander => (lambda (param drv output) ...))
 
@@ -299,6 +332,52 @@ The expander specifies how an object is converted to its sexp representation."
 
 
 ;;;
+;;; System dependencies.
+;;;
+
+;; Binding form for the current system and cross-compilation target.
+(define-record-type <system-binding>
+  (system-binding proc)
+  system-binding?
+  (proc system-binding-proc))
+
+(define-syntax let-system
+  (syntax-rules ()
+    "Introduce a system binding in a gexp.  The simplest form is:
+
+  (let-system system
+    (cond ((string=? system \"x86_64-linux\") ...)
+          (else ...)))
+
+which binds SYSTEM to the currently targeted system.  The second form is
+similar, but it also shows the cross-compilation target:
+
+  (let-system (system target)
+    ...)
+
+Here TARGET is bound to the cross-compilation triplet or #f."
+    ((_ (system target) exp0 exp ...)
+     (system-binding (lambda (system target)
+                       exp0 exp ...)))
+    ((_ system exp0 exp ...)
+     (system-binding (lambda (system target)
+                       exp0 exp ...)))))
+
+(define-gexp-compiler system-binding-compiler <system-binding>
+  compiler => (lambda (binding system target)
+                (match binding
+                  (($ <system-binding> proc)
+                   (with-monad %store-monad
+                     ;; PROC is expected to return a lowerable object.
+                     ;; 'lower-object' takes care of residualizing it to a
+                     ;; derivation or similar.
+                     (return (proc system target))))))
+
+  ;; Delegate to the expander of the object returned by PROC.
+  expander => #f)
+
+
+;;;
 ;;; File declarations.
 ;;;
 
@@ -676,6 +755,15 @@ GEXP) is false, meaning that GEXP is a plain Scheme object, return the empty
 list."
   (gexp-attribute gexp gexp-self-extensions))
 
+(define (self-quoting? x)
+  (letrec-syntax ((one-of (syntax-rules ()
+                            ((_) #f)
+                            ((_ pred rest ...)
+                             (or (pred x)
+                                 (one-of rest ...))))))
+    (one-of symbol? string? keyword? pair? null? array?
+            number? boolean? char?)))
+
 (define* (lower-inputs inputs
                        #:key system target)
   "Turn any object from INPUTS into a derivation input for SYSTEM or a store
@@ -684,23 +772,32 @@ When TARGET is true, use it as the cross-compilation target triplet."
   (define (store-item? obj)
     (and (string? obj) (store-path? obj)))
 
+  (define filterm
+    (lift1 (cut filter ->bool <>) %store-monad))
+
   (with-monad %store-monad
-    (mapm/accumulate-builds
-     (match-lambda
-       (((? struct? thing) sub-drv ...)
-        (mlet %store-monad ((obj (lower-object
-                                  thing system #:target target)))
-          (return (match obj
-                    ((? derivation? drv)
-                     (let ((outputs (if (null? sub-drv)
-                                        '("out")
-                                        sub-drv)))
-                       (derivation-input drv outputs)))
-                    ((? store-item? item)
-                     item)))))
-       (((? store-item? item))
-        (return item)))
-     inputs)))
+    (>>= (mapm/accumulate-builds
+          (match-lambda
+            (((? struct? thing) sub-drv ...)
+             (mlet %store-monad ((obj (lower-object
+                                       thing system #:target target)))
+               (return (match obj
+                         ((? derivation? drv)
+                          (let ((outputs (if (null? sub-drv)
+                                             '("out")
+                                             sub-drv)))
+                            (derivation-input drv outputs)))
+                         ((? store-item? item)
+                          item)
+                         ((? self-quoting?)
+                          ;; Some inputs such as <system-binding> can lower to
+                          ;; a self-quoting object that FILTERM will filter
+                          ;; out.
+                          #f)))))
+            (((? store-item? item))
+             (return item)))
+          inputs)
+         filterm)))
 
 (define* (lower-reference-graphs graphs #:key system target)
   "Given GRAPHS, a list of (FILE-NAME INPUT ...) lists for use as a
@@ -1116,15 +1213,6 @@ references; otherwise, return only non-native references."
                      (target (%current-target-system)))
   "Return (monadically) the sexp corresponding to EXP for the given OUTPUT,
 and in the current monad setting (system type, etc.)"
-  (define (self-quoting? x)
-    (letrec-syntax ((one-of (syntax-rules ()
-                              ((_) #f)
-                              ((_ pred rest ...)
-                               (or (pred x)
-                                   (one-of rest ...))))))
-      (one-of symbol? string? keyword? pair? null? array?
-              number? boolean? char?)))
-
   (define* (reference->sexp ref #:optional native?)
     (with-monad %store-monad
       (match ref
@@ -1148,12 +1236,10 @@ and in the current monad setting (system type, etc.)"
                   (or n? native?)))
                refs))
         (($ <gexp-input> (? struct? thing) output n?)
-         (let ((target (if (or n? native?) #f target))
-               (expand (lookup-expander thing)))
-           (mlet %store-monad ((obj (lower-object thing system
-                                                  #:target target)))
-             ;; OBJ must be either a derivation or a store file name.
-             (return (expand thing obj output)))))
+         (let ((target (if (or n? native?) #f target)))
+           (lower+expand-object thing system
+                                #:target target
+                                #:output output)))
         (($ <gexp-input> (? self-quoting? x))
          (return x))
         (($ <gexp-input> x)
diff --git a/guix/licenses.scm b/guix/licenses.scm
index a16d2241ad..bf72a33c92 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2014, 2015, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2014, 2015, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013, 2015 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
@@ -644,7 +644,7 @@ which may be a file:// URI pointing the package's tree."
 
 (define zlib
   (license "Zlib"
-           "http://www.gzip.org/zlib/zlib_license.html"
+           "https://zlib.net/zlib_license.html"
            "https://www.gnu.org/licenses/license-list#ZLib"))
 
 (define hpnd
diff --git a/guix/quirks.scm b/guix/quirks.scm
index 483169e70d..d180bd2c09 100644
--- a/guix/quirks.scm
+++ b/guix/quirks.scm
@@ -19,6 +19,7 @@
 (define-module (guix quirks)
   #:use-module ((guix build utils) #:select (substitute*))
   #:use-module (srfi srfi-9)
+  #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
   #:export (%quirks
 
@@ -117,8 +118,42 @@ corresponds to the given Guix COMMIT, a SHA1 hexadecimal string."
 
    (patch missing-ice-9-threads-import? add-missing-ice-9-threads-import)))
 
+(define %bug-41214-patch
+  ;; Patch for <https://bugs.gnu.org/41214>.  Around v1.0.0, (guix build
+  ;; compile) would use Guile 2.2 procedures to access the set of available
+  ;; compilation options.  These procedures no longer exist in 3.0.
+  (let ()
+    (define (accesses-guile-2.2-optimization-options? source commit)
+      (catch 'system-error
+        (lambda ()
+          (match (call-with-input-file
+                     (string-append source "/guix/build/compile.scm")
+                   read)
+            (('define-module ('guix 'build 'compile)
+               _ ...
+               #:use-module ('language 'tree-il 'optimize)
+               #:use-module ('language 'cps 'optimize)
+               #:export ('%default-optimizations
+                         '%lightweight-optimizations
+                         'compile-files))
+             #t)
+            (_ #f)))
+        (const #f)))
+
+    (define (build-with-guile-2.2 source)
+      (substitute* (string-append source "/" %self-build-file)
+        (("\\(default-guile\\)")
+         (object->string '(car (find-best-packages-by-name "guile" "2.2"))))
+        (("\\(find-best-packages-by-name \"guile-gcrypt\" #f\\)")
+         (object->string '(find-best-packages-by-name "guile2.2-gcrypt" #f))))
+      #t)
+
+    (patch accesses-guile-2.2-optimization-options?
+           build-with-guile-2.2)))
+
 (define %patches
   ;; Bits of past Guix revisions can become incompatible with newer Guix and
   ;; Guile.  This variable lists <patch> records for the Guix source tree that
   ;; apply to the Guix source.
-  (list %bug-41028-patch))
+  (list %bug-41028-patch
+        %bug-41214-patch))
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index f13f221da9..7a2dbc453a 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2020 Ekaitz Zarraga <ekaitz@elenq.tech>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -41,14 +42,26 @@
 ;;;
 ;;; Command-line options.
 ;;;
+(define %available-formats '("human" "channels" "json" "recutils"))
+
+(define (list-formats)
+  (display (G_ "The available formats are:\n"))
+  (newline)
+  (for-each (lambda (f)
+              (format #t "  - ~a~%" f))
+            %available-formats))
 
 (define %options
   ;; Specifications of the command-line options.
   (list (option '(#\f "format") #t #f
                 (lambda (opt name arg result)
-                  (unless (member arg '("human" "channels" "json" "recutils"))
+                  (unless (member arg %available-formats)
                     (leave (G_ "~a: unsupported output format~%") arg))
                   (alist-cons 'format (string->symbol arg) result)))
+        (option '("list-formats") #f #f
+                (lambda (opt name arg result)
+                  (list-formats)
+                  (exit 0)))
         (option '(#\p "profile") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'profile (canonicalize-profile arg)
@@ -71,6 +84,8 @@ Display information about the channels currently in use.\n"))
   (display (G_ "
   -f, --format=FORMAT    display information in the given FORMAT"))
   (display (G_ "
+      --list-formats     display available formats"))
+  (display (G_ "
   -p, --profile=PROFILE  display information about PROFILE"))
   (newline)
   (display (G_ "
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index f5b2f5fd4e..a00f08f9d9 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -851,6 +851,7 @@ blocking."
                                                                          size)
                                                     client))
                           (output   (response-port response)))
+                     (setsockopt client SOL_SOCKET SO_SNDBUF (* 128 1024))
                      (if (file-port? output)
                          (sendfile output input size)
                          (dump-port input output))
diff --git a/guix/utils.scm b/guix/utils.scm
index 3e8e59b8dc..d7b197fa44 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -490,18 +490,21 @@ a character other than '@'."
   (and target
        (string-suffix? "-mingw32" target)))
 
-(define (target-arm32?)
-  (string-prefix? "arm" (or (%current-target-system) (%current-system))))
+(define* (target-arm32? #:optional (target (or (%current-target-system)
+                                               (%current-system))))
+  (string-prefix? "arm" target))
 
-(define (target-aarch64?)
-  (string-prefix? "aarch64" (or (%current-target-system) (%current-system))))
+(define* (target-aarch64? #:optional (target (or (%current-target-system)
+                                                 (%current-system))))
+  (string-prefix? "aarch64" target))
 
-(define (target-arm?)
-  (or (target-arm32?) (target-aarch64?)))
+(define* (target-arm? #:optional (target (or (%current-target-system)
+                                             (%current-system))))
+  (or (target-arm32? target) (target-aarch64? target)))
 
-(define (target-64bit?)
-  (let ((system (or (%current-target-system) (%current-system))))
-    (any (cut string-prefix? <> system) '("x86_64" "aarch64" "mips64" "ppc64"))))
+(define* (target-64bit? #:optional (system (or (%current-target-system)
+                                               (%current-system))))
+  (any (cut string-prefix? <> system) '("x86_64" "aarch64" "mips64" "ppc64")))
 
 (define version-compare
   (let ((strverscmp