Merge branch 'master' into core-updates

 Conflicts:
	gnu/local.mk
	gnu/packages/bioinformatics.scm
	gnu/packages/django.scm
	gnu/packages/gtk.scm
	gnu/packages/llvm.scm
	gnu/packages/python-web.scm
	gnu/packages/python.scm
	gnu/packages/tex.scm
	guix/build-system/asdf.scm
	guix/build/emacs-build-system.scm
	guix/profiles.scm

3 files changed, 135 insertions, 38 deletions

diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 4b8963eadd..b5263f5f0d 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -36,8 +36,10 @@
   #:use-module (gnu packages bootloaders)
   #:use-module (gnu packages commencement)       ;for 'guile-final'
   #:use-module (gnu packages cryptsetup)
+  #:use-module (gnu packages disk)
   #:use-module (gnu packages emacs)
   #:use-module (gnu packages emacs-xyz)
+  #:use-module (gnu packages firmware)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages ocr)
   #:use-module (gnu packages openbox)
@@ -73,6 +75,7 @@
             %test-lvm-separate-home-os
 
             %test-gui-installed-os
+            %test-gui-uefi-installed-os
             %test-gui-installed-os-encrypted
             %test-gui-installed-desktop-os-encrypted))
 
@@ -206,6 +209,15 @@ guix system init /mnt/etc/config.scm /mnt --no-substitutes
 sync
 reboot\n")
 
+(define (uefi-firmware system)
+  "Return the appropriate QEMU OVMF UEFI firmware for the given SYSTEM."
+  (cond
+   ((string-prefix? "x86_64" system)
+    (file-append ovmf "/share/firmware/ovmf_x64.bin"))
+   ((string-prefix? "i686" system)
+    (file-append ovmf "/share/firmware/ovmf_ia32.bin"))
+   (else #f)))
+
 (define* (run-install target-os target-os-source
                       #:key
                       (script %simple-installation-script)
@@ -224,6 +236,7 @@ reboot\n")
                            #:imported-modules '((gnu services herd)
                                                 (gnu installer tests)
                                                 (guix combinators))))
+                      (uefi-support? #f)
                       (installation-image-type 'efi-raw)
                       (install-size 'guess)
                       (target-size (* 2200 MiB)))
@@ -235,6 +248,8 @@ packages defined in installation-os."
   (mlet* %store-monad ((_      (set-grafting #f))
                        (system (current-system))
 
+                       (uefi-firmware -> (and uefi-support?
+                                              (uefi-firmware system)))
                        ;; Since the installation system has no network access,
                        ;; we cheat a little bit by adding TARGET to its GC
                        ;; roots.  This way, we know 'guix system init' will
@@ -273,6 +288,9 @@ packages defined in installation-os."
                `(,(which #$(qemu-command system))
                  "-no-reboot"
                  "-m" "1200"
+                 ,@(if #$uefi-firmware
+                       '("-bios" #$uefi-firmware)
+                       '())
                  #$@(cond
                      ((eq? 'efi-raw installation-image-type)
                       #~("-drive"
@@ -322,10 +340,15 @@ packages defined in installation-os."
     (gexp->derivation "installation" install
                       #:substitutable? #f)))      ;too big
 
-(define* (qemu-command/writable-image image #:key (memory-size 256))
+(define* (qemu-command/writable-image image
+                                      #:key
+                                      (uefi-support? #f)
+                                      (memory-size 256))
   "Return as a monadic value the command to run QEMU on a writable copy of
 IMAGE, a disk image.  The QEMU VM has access to MEMORY-SIZE MiB of RAM."
-  (mlet %store-monad ((system (current-system)))
+  (mlet* %store-monad ((system (current-system))
+                       (uefi-firmware -> (and uefi-support?
+                                              (uefi-firmware system))))
     (return #~(let ((image #$image))
                 ;; First we need a writable copy of the image.
                 (format #t "creating writable image from '~a'...~%" image)
@@ -343,6 +366,9 @@ IMAGE, a disk image.  The QEMU VM has access to MEMORY-SIZE MiB of RAM."
                   ,@(if (file-exists? "/dev/kvm")
                         '("-enable-kvm")
                         '())
+                  ,@(if #$uefi-firmware
+                        '("-bios" #$uefi-firmware)
+                        '())
                   "-no-reboot" "-m" #$(number->string memory-size)
                   "-drive" "file=disk.img,if=virtio")))))
 
@@ -1400,7 +1426,9 @@ build (current-guix) and then store a couple of full system images.")
 (define* (gui-test-program marionette
                            #:key
                            (desktop? #f)
-                           (encrypted? #f))
+                           (encrypted? #f)
+                           (uefi-support? #f)
+                           (system (%current-system)))
   #~(let ()
       (define (screenshot file)
         (marionette-control (string-append "screendump " file)
@@ -1466,7 +1494,8 @@ build (current-guix) and then store a couple of full system images.")
 
       (marionette-eval* '(choose-partitioning installer-socket
                                               #:encrypted? #$encrypted?
-                                              #:passphrase #$%luks-passphrase)
+                                              #:passphrase #$%luks-passphrase
+                                              #:uefi-support? #$uefi-support?)
                         #$marionette)
       (screenshot "installer-run.ppm")
 
@@ -1480,9 +1509,43 @@ build (current-guix) and then store a couple of full system images.")
                                    "/dev/vda2")
                           #$marionette))
 
-      (marionette-eval* '(conclude-installation installer-socket)
+      (marionette-eval* '(start-installation installer-socket)
                         #$marionette)
 
+      ;; XXX: The grub-install process uses efibootmgr to add an UEFI Guix
+      ;; boot entry. The corresponding UEFI variable is stored in RAM, and
+      ;; possibly saved persistently on QEMU reboot in a NvVars file, see:
+      ;; https://lists.gnu.org/archive/html/qemu-discuss/2018-04/msg00045.html.
+      ;;
+      ;; As we are running QEMU with the no-reboot flag, this variable is
+      ;; never saved persistently, QEMU fails to boot the installed system and
+      ;; an UEFI shell is displayed instead.
+      ;;
+      ;; To make the installed UEFI system bootable, register Grub as the
+      ;; default UEFI boot entry, in the same way as if grub-install was
+      ;; invoked with the --removable option.
+      (when #$uefi-support?
+        (marionette-eval*
+         '(begin
+            (use-modules (ice-9 match))
+            (let ((targets (cond
+                            ((string-prefix? "x86_64" #$system)
+                             '("grubx64.efi" "BOOTX64.EFI"))
+                            ((string-prefix? "i686" #$system)
+                             '("grubia32.efi" "BOOTIA32.EFI"))
+                            (else #f))))
+              (match targets
+                ((src dest)
+                 (rename-file "/mnt/boot/efi/EFI/Guix"
+                              "/mnt/boot/efi/EFI/BOOT")
+                 (rename-file
+                  (string-append "/mnt/boot/efi/EFI/BOOT/" src)
+                  (string-append "/mnt/boot/efi/EFI/BOOT/" dest)))
+                (_ #f))))
+         #$marionette))
+
+      (marionette-eval* '(complete-installation installer-socket)
+                        #$marionette)
       (sync)
       #t))
 
@@ -1490,7 +1553,7 @@ build (current-guix) and then store a couple of full system images.")
   ;; Packages needed when installing with an encrypted root.
   (list isc-dhcp
         lvm2-static cryptsetup-static e2fsck/static
-        loadkeys-static))
+        loadkeys-static grub-efi fatfsck/static dosfstools))
 
 (define installation-os-for-gui-tests
   ;; Operating system that contains all of %EXTRA-PACKAGES, needed for the
@@ -1509,9 +1572,22 @@ build (current-guix) and then store a couple of full system images.")
                         (guix combinators))))
 
 (define* (installation-target-os-for-gui-tests
-          #:key (encrypted? #f))
+          #:key
+          (encrypted? #f)
+          (uefi-support? #f))
   (operating-system
     (inherit %minimal-os-on-vda)
+    (file-systems `(,(file-system
+                       (device (file-system-label "my-root"))
+                       (mount-point "/")
+                       (type "ext4"))
+                    ,@(if uefi-support?
+                          (list (file-system
+                                  (device (uuid "1234-ABCD" 'fat))
+                                  (mount-point "/boot/efi")
+                                  (type "vfat")))
+                          '())
+                    ,@%base-file-systems))
     (users (append (list (user-account
                           (name "alice")
                           (comment "Bob's sister")
@@ -1569,6 +1645,7 @@ build (current-guix) and then store a couple of full system images.")
                                    #:key
                                    (desktop? #f)
                                    (encrypted? #f)
+                                   (uefi-support? #f)
                                    target-os
                                    (install-size 'guess)
                                    (target-size (* 2200 MiB)))
@@ -1581,6 +1658,7 @@ build (current-guix) and then store a couple of full system images.")
         ((image   (run-install target-os '(this is unused)
                                #:script #f
                                #:os installation-os-for-gui-tests
+                               #:uefi-support? uefi-support?
                                #:install-size install-size
                                #:target-size target-size
                                #:installation-image-type
@@ -1590,8 +1668,11 @@ build (current-guix) and then store a couple of full system images.")
                                  (gui-test-program
                                   marionette
                                   #:desktop? desktop?
-                                  #:encrypted? encrypted?))))
-         (command (qemu-command/writable-image image #:memory-size 512)))
+                                  #:encrypted? encrypted?
+                                  #:uefi-support? uefi-support?))))
+         (command (qemu-command/writable-image image
+                                               #:uefi-support? uefi-support?
+                                               #:memory-size 512)))
       (run-basic-test target-os command name
                       #:initialization (and encrypted? enter-luks-passphrase)
                       #:root-password %root-password
@@ -1602,6 +1683,15 @@ build (current-guix) and then store a couple of full system images.")
    "gui-installed-os"
    #:target-os (installation-target-os-for-gui-tests)))
 
+;; Test the UEFI installation of Guix System using the graphical installer.
+(define %test-gui-uefi-installed-os
+  (guided-installation-test
+   "gui-uefi-installed-os"
+   #:uefi-support? #t
+   #:target-os (installation-target-os-for-gui-tests
+                #:uefi-support? #t)
+   #:target-size (* 3200 MiB)))
+
 (define %test-gui-installed-os-encrypted
   (guided-installation-test
    "gui-installed-os-encrypted"
diff --git a/gnu/tests/ldap.scm b/gnu/tests/ldap.scm
index 2d4f15fb3c..197c1bfb28 100644
--- a/gnu/tests/ldap.scm
+++ b/gnu/tests/ldap.scm
@@ -84,7 +84,7 @@
 config_version = 2
 
 \n[slapd]
-root_password = SECRET
+root_password = SECRET_PASS
 user = root
 group = root
 
@@ -112,7 +112,7 @@ suffix = dc=example,dc=com")))
             (marionette-eval
              '(zero? (system* #$(file-append openldap "/bin/ldapwhoami")
                               "-H" "ldap://localhost" "-D"
-                              "cn=Directory Manager" "-w" "SECRET"))
+                              "cn=Directory Manager" "-w" "SECRET_PASS"))
              marionette))
 
           ;; Wait for nslcd to be up and running.
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index 7f4518acd2..61575f497d 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -65,6 +65,26 @@
         (lambda (port)
           (display #$%index.html-contents port)))))
 
+(define retry-on-error
+  #~(lambda* (f #:key times delay)
+      (let loop ((attempt 1))
+        (match (catch
+                 #t
+                 (lambda ()
+                   (cons #t
+                         (f)))
+                 (lambda args
+                   (cons #f
+                         args)))
+          ((#t . return-value)
+           return-value)
+          ((#f . error-args)
+           (if (>= attempt times)
+               error-args
+               (begin
+                 (sleep delay)
+                 (loop (+ 1 attempt)))))))))
+
 (define* (run-webserver-test name test-os #:key (log-file #f) (http-port 8080))
   "Run tests in %NGINX-OS, which has nginx running and listening on
 HTTP-PORT."
@@ -472,28 +492,9 @@ HTTP-PORT."
                 (start-service 'tailon))
              marionette))
 
-          (define* (retry-on-error f #:key times delay)
-            (let loop ((attempt 1))
-              (match (catch
-                      #t
-                      (lambda ()
-                        (cons #t
-                              (f)))
-                      (lambda args
-                        (cons #f
-                              args)))
-                ((#t . return-value)
-                 return-value)
-                ((#f . error-args)
-                 (if (>= attempt times)
-                     error-args
-                     (begin
-                       (sleep delay)
-                       (loop (+ 1 attempt))))))))
-
           (test-equal "http-get"
             200
-            (retry-on-error
+            (#$retry-on-error
              (lambda ()
                (let-values (((response text)
                              (http-get #$(format
@@ -607,12 +608,14 @@ HTTP-PORT."
   (define vm
     (virtual-machine
      (operating-system os)
-     (port-forwardings `((8080 . ,forwarded-port)))))
+     (port-forwardings `((8080 . ,forwarded-port)))
+     (memory-size 1024)))
 
   (define test
     (with-imported-modules '((gnu build marionette))
       #~(begin
           (use-modules (srfi srfi-11) (srfi srfi-64)
+                       (ice-9 match)
                        (gnu build marionette)
                        (web uri)
                        (web client)
@@ -647,12 +650,16 @@ HTTP-PORT."
 
           (test-equal "http-get"
             200
-            (let-values
-                (((response text)
-                  (http-get #$(simple-format
-                               #f "http://localhost:~A/" forwarded-port)
-                            #:decode-body? #t)))
-              (response-code response)))
+            (#$retry-on-error
+             (lambda ()
+               (let-values
+                   (((response text)
+                     (http-get #$(simple-format
+                                  #f "http://localhost:~A/" forwarded-port)
+                               #:decode-body? #t)))
+                 (response-code response)))
+             #:times 10
+             #:delay 5))
 
           (test-end)
           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))