Merge remote-tracking branch 'origin/master' into core-updates-frozen

6 files changed, 44 insertions, 13 deletions

diff --git a/guix/build-system/haskell.scm b/guix/build-system/haskell.scm
index 3770304745..dc83512d30 100644
--- a/guix/build-system/haskell.scm
+++ b/guix/build-system/haskell.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com>
 ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,7 +33,9 @@
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
-  #:export (%haskell-build-system-modules
+  #:export (hackage-uri
+
+            %haskell-build-system-modules
             haskell-build
             haskell-build-system))
 
@@ -43,6 +46,12 @@
 ;;
 ;; Code:
 
+(define (hackage-uri name version)
+  "Return a URI string for the Haskell package hosted on Hackage corresponding
+to NAME and VERSION."
+  (string-append "https://hackage.haskell.org/package/" name "/"
+                 name "-" version ".tar.gz"))
+
 (define %haskell-build-system-modules
   ;; Build-side modules imported by default.
   `((guix build haskell-build-system)
diff --git a/guix/build/emacs-build-system.scm b/guix/build/emacs-build-system.scm
index ba2c1b4aad..e6b88ad640 100644
--- a/guix/build/emacs-build-system.scm
+++ b/guix/build/emacs-build-system.scm
@@ -53,8 +53,7 @@
 
 ;; These are the default inclusion/exclusion regexps for the install phase.
 (define %default-include '("^[^/]*\\.el$" "^[^/]*\\.info$" "^doc/.*\\.info$"))
-(define %default-exclude '("^\\.dir-locals\\.el$" "-pkg\\.el$"
-                           "^[^/]*tests?\\.el$"))
+(define %default-exclude '("^\\.dir-locals\\.el$" "^[^/]*tests?\\.el$"))
 
 (define gnu:unpack (assoc-ref gnu:%standard-phases 'unpack))
 
diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index d73fbe6a81..6ef1e7a675 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -41,6 +41,7 @@
   #:use-module (guix memoization)
   #:use-module (guix upstream)
   #:use-module (guix packages)
+  #:autoload   (guix build-system haskell) (hackage-uri)
   #:use-module ((guix utils) #:select (call-with-temporary-output-file))
   #:export (%hackage-url
             hackage->guix-package
@@ -302,7 +303,7 @@ the hash of the Cabal file."
         (version ,version)
         (source (origin
                   (method url-fetch)
-                  (uri (string-append ,@(factorize-uri source-url version)))
+                  (uri (hackage-uri ,name version))
                   (sha256
                    (base32
                     ,(if tarball
@@ -366,7 +367,7 @@ respectively."
                (hackage-cabal-url hackage-name))
        #f)
       ((_ *** ("version" (version)))
-       (let ((url (hackage-source-url hackage-name version)))
+       (let ((url (hackage-uri hackage-name version)))
          (upstream-source
           (package (package-name package))
           (version version)
diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index 2b33b3b8bc..343e7c0a0a 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -10,6 +10,7 @@
 ;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -113,7 +114,7 @@
   (url          distribution-url)                  ;string
   (digests      distribution-digests)              ;list of string pairs
   (file-name    distribution-file-name "filename") ;string
-  (has-signature? distribution-has-signature? "hash_sig") ;Boolean
+  (has-signature? distribution-has-signature? "has_sig") ;Boolean
   (package-type distribution-package-type "packagetype") ;"bdist_wheel" | ...
   (python-version distribution-package-python-version
                   "python_version"))
@@ -533,10 +534,14 @@ VERSION, SOURCE-URL, HOME-PAGE, SYNOPSIS, DESCRIPTION, and LICENSE."
          (guard (c ((missing-source-error? c) #f))
            (let* ((info    (pypi-project-info pypi-package))
                   (version (project-info-version info))
-                  (url     (distribution-url
-                            (source-release pypi-package))))
+                  (dist    (source-release pypi-package))
+                  (url     (distribution-url dist)))
              (upstream-source
               (urls (list url))
+              (signature-urls
+               (if (distribution-has-signature? dist)
+                   (list (string-append url ".asc"))
+                   #f))
               (input-changes
                (changed-inputs package
                                (pypi->guix-package pypi-name)))
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 81958baaa5..febac29766 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -785,6 +785,9 @@ determines whether CHANNELS are authenticated."
   (define add-indirect-root*
     (store-lift add-indirect-root))
 
+  (define add-temp-root*
+    (store-lift add-temp-root))
+
   (mkdir-p cache-directory)
   (maybe-remove-expired-cache-entries cache-directory
                                       cache-entries
@@ -805,11 +808,15 @@ determines whether CHANNELS are authenticated."
             ;; what's going to be built.
             (built-derivations (list profile))
 
-            ;; Note: Caching is fine even when AUTHENTICATE? is false because
-            ;; we always call 'latest-channel-instances?'.
-            (symlink* (derivation->output-path profile) cached)
-            (add-indirect-root* cached)
-            (return cached))))))
+            ;; Cache if and only if AUTHENTICATE? is true.
+            (if authenticate?
+                (mbegin %store-monad
+                  (symlink* (derivation->output-path profile) cached)
+                  (add-indirect-root* cached)
+                  (return cached))
+                (mbegin %store-monad
+                  (add-temp-root* profile)
+                  (return profile))))))))
 
 (define* (inferior-for-channels channels
                                 #:key
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 7faa92fd7d..1db788a534 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -689,6 +689,7 @@ checking this by themselves in their 'check' procedure."
 (define* (system-derivation-for-action image action
                                        #:key
                                        full-boot?
+                                       (graphic? #t)
                                        container-shared-network?
                                        mappings)
   "Return as a monadic value the derivation for IMAGE according to ACTION."
@@ -706,6 +707,7 @@ checking this by themselves in their 'check' procedure."
       ((vm)
        (system-qemu-image/shared-store-script os
                                               #:full-boot? full-boot?
+                                              #:graphic? graphic?
                                               #:disk-image-size
                                               (if full-boot?
                                                   image-size
@@ -772,6 +774,7 @@ and TARGET arguments."
                          dry-run? derivations-only?
                          use-substitutes? target
                          full-boot?
+                         (graphic? #t)
                          container-shared-network?
                          (mappings '())
                          (gc-root #f))
@@ -825,6 +828,7 @@ static checks."
   (mlet* %store-monad
       ((sys       (system-derivation-for-action image action
                                                 #:full-boot? full-boot?
+                                                #:graphic? graphic?
                                                 #:container-shared-network? container-shared-network?
                                                 #:mappings mappings))
 
@@ -1013,6 +1017,8 @@ Some ACTIONS support additional ARGS.\n"))
   (display (G_ "
       --full-boot        for 'vm', make a full boot sequence"))
   (display (G_ "
+      --no-graphic       for 'vm', use the tty that we are started in for IO"))
+  (display (G_ "
       --skip-checks      skip file system and initrd module safety checks"))
   (display (G_ "
       --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
@@ -1081,6 +1087,9 @@ Some ACTIONS support additional ARGS.\n"))
          (option '("full-boot") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'full-boot? #t result)))
+         (option '("no-graphic") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'no-graphic? #t result)))
          (option '("save-provenance") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'save-provenance? #t result)))
@@ -1266,6 +1275,7 @@ resulting from command-line parsing."
                                #:validate-reconfigure
                                (assoc-ref opts 'validate-reconfigure)
                                #:full-boot? (assoc-ref opts 'full-boot?)
+                               #:graphic? (not (assoc-ref opts 'no-graphic?))
                                #:container-shared-network?
                                (assoc-ref opts 'container-shared-network?)
                                #:mappings (filter-map (match-lambda