guix-install.sh: don't throw away release candidates when picking the latest version

* etc/guix-install.sh (guix_get_bin_list): modify regexes to allow rcN syntax

Signed-off-by: Ludovic Courtès <ludo@gnu.org>

.dir-locals.el

@@ -11,23 +11,34 @@
       . "<https?://\\(debbugs\\|bugs\\)\\.gnu\\.org/\\([0-9]+\\)>")
 
      ;; Emacs-Guix
-     (eval . (setq guix-directory
-                   (locate-dominating-file default-directory ".dir-locals.el")))
+     (eval . (setq-local guix-directory
+                         (locate-dominating-file default-directory
+                                                 ".dir-locals.el")))
 
      ;; Geiser
      ;; This allows automatically setting the `geiser-guile-load-path'
      ;; variable when using various Guix checkouts (e.g., via git worktrees).
-     (eval . (let* ((root-dir (expand-file-name
-                               (locate-dominating-file
-                                default-directory ".dir-locals.el")))
-                    ;; Workaround for bug https://issues.guix.gnu.org/43818.
-                    (root-dir* (directory-file-name root-dir)))
-               (unless (boundp 'geiser-guile-load-path)
-                 (defvar geiser-guile-load-path '()))
-               (make-local-variable 'geiser-guile-load-path)
-               (require 'cl-lib)
-               (cl-pushnew root-dir* geiser-guile-load-path
-                           :test #'string-equal)))))
+     (eval . (let ((root-dir-unexpanded (locate-dominating-file
+                                         default-directory ".dir-locals.el")))
+               ;; While Guix should in theory always have a .dir-locals.el
+               ;; (we are reading this file, after all) there seems to be a
+               ;; strange problem where this code "escapes" to some other buffers,
+               ;; at least vc-mode.  See:
+               ;;   https://lists.gnu.org/archive/html/guix-devel/2020-11/msg00296.html
+               ;; Upstream report: <https://bugs.gnu.org/44698>
+               ;; Hence the following "when", which might otherwise be unnecessary;
+               ;; it prevents causing an error when root-dir-unexpanded is nil.
+               (when root-dir-unexpanded
+                 (let* ((root-dir (expand-file-name root-dir-unexpanded))
+                        ;; Workaround for bug https://issues.guix.gnu.org/43818.
+                        (root-dir* (directory-file-name root-dir)))
+
+                   (unless (boundp 'geiser-guile-load-path)
+                     (defvar geiser-guile-load-path '()))
+                   (make-local-variable 'geiser-guile-load-path)
+                   (require 'cl-lib)
+                   (cl-pushnew root-dir* geiser-guile-load-path
+                               :test #'string-equal)))))))
 
  (c-mode          . ((c-file-style . "gnu")))
  (scheme-mode

Makefile.am

@@ -562,7 +562,7 @@ dist_zshcompletion_DATA = etc/completion/zsh/_guix
 dist_fishcompletion_DATA = etc/completion/fish/guix.fish
 
 # SELinux policy
-nodist_selinux_policy_DATA = etc/guix-daemon.cil.in
+nodist_selinux_policy_DATA = etc/guix-daemon.cil
 
 EXTRA_DIST +=						\
   HACKING						\
@@ -570,6 +570,7 @@ EXTRA_DIST +=						\
   TODO							\
   CODE-OF-CONDUCT					\
   .dir-locals.el					\
+  .guix-authorizations					\
   .guix-channel						\
   scripts/guix.in					\
   etc/guix-install.sh					\
@@ -730,8 +731,8 @@ distcheck-hook: assert-binaries-available assert-final-inputs-self-contained
 
 EXTRA_DIST += $(top_srcdir)/.version
 BUILT_SOURCES += $(top_srcdir)/.version
-$(top_srcdir)/.version:
-	echo $(VERSION) > "$@-t" && mv "$@-t" "$@"
+$(top_srcdir)/.version: config.status
+	$(AM_V_GEN)echo $(VERSION) > "$@-t" && mv "$@-t" "$@"
 
 gen-tarball-version:
 	echo $(VERSION) > "$(distdir)/.tarball-version"

etc/guix-daemon.cil.in

@@ -1,6 +1,8 @@
 ; -*- lisp -*-
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2020 Daniel Brooks <db48x@db48x.net>
+;;; Copyright © 2020 Marius Bakke <marius@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +23,18 @@
 ;; Intermediate Language (CIL).  It refers to types that must be defined in
 ;; the system's base policy.
 
+;; If you, like me, need advice about fixing an SELinux policy, I recommend
+;; reading https://danwalsh.livejournal.com/55324.html
+
+;; In particular, you can run semanage permissive -a guix_daemon.guix_daemon_t
+;; to allow guix-daemon to do whatever it wants. SELinux will still check its
+;; permissions, and when it doesn't have permission it will still send an
+;; audit message to your system logs. This lets you know what permissions it
+;; ought to have. Use ausearch --raw to find the permissions violations, then
+;; pipe that to audit2allow to generate an updated policy. You'll still need
+;; to translate that policy into CIL in order to update this file, but that's
+;; fairly straight-forward. Annoying, but easy.
+
 (block guix_daemon
   ;; Require existing types
   (typeattributeset cil_gen_require init_t)
@@ -34,14 +48,19 @@
   (roletype object_r guix_daemon_t)
   (type guix_daemon_conf_t)
   (roletype object_r guix_daemon_conf_t)
+  (typeattributeset file_type guix_daemon_conf_t)
   (type guix_daemon_exec_t)
   (roletype object_r guix_daemon_exec_t)
+  (typeattributeset file_type guix_daemon_exec_t)
   (type guix_daemon_socket_t)
   (roletype object_r guix_daemon_socket_t)
+  (typeattributeset file_type guix_daemon_socket_t)
   (type guix_store_content_t)
   (roletype object_r guix_store_content_t)
+  (typeattributeset file_type guix_store_content_t)
   (type guix_profiles_t)
   (roletype object_r guix_profiles_t)
+  (typeattributeset file_type guix_profiles_t)
 
   ;; These types are domains, thereby allowing process rules
   (typeattributeset domain (guix_daemon_t guix_daemon_exec_t))
@@ -55,6 +74,30 @@
   (typetransition guix_store_content_t guix_daemon_exec_t
                   process guix_daemon_t)
 
+  (roletype system_r guix_daemon_t)
+
+  ;; allow init_t to read and execute guix files
+  (allow init_t
+         guix_profiles_t
+         (lnk_file (read)))
+  (allow init_t
+         guix_daemon_exec_t
+         (file (execute)))
+  (allow init_t
+         guix_daemon_t
+         (process (transition)))
+  (allow init_t
+         guix_store_content_t
+         (lnk_file (read)))
+  (allow init_t
+         guix_store_content_t
+         (file (open read execute)))
+
+  ;; guix-daemon needs to know the names of users
+  (allow guix_daemon_t
+         passwd_file_t
+         (file (getattr open read)))
+
   ;; Permit communication with NSCD
   (allow guix_daemon_t
          nscd_var_run_t
@@ -71,25 +114,44 @@
   (allow guix_daemon_t
          nscd_t
          (unix_stream_socket (connectto)))
+  (allow guix_daemon_t nscd_t
+         (nscd (getgrp gethost getpwd getserv shmemgrp shmemhost shmempwd shmemserv)))
+
+  ;; permit downloading packages via HTTP(s)
+  (allow guix_daemon_t http_port_t
+         (tcp_socket (name_connect)))
+  (allow guix_daemon_t ftp_port_t
+         (tcp_socket (name_connect)))
+  (allow guix_daemon_t ephemeral_port_t
+         (tcp_socket (name_connect)))
 
   ;; Permit logging and temp file access
   (allow guix_daemon_t
          tmp_t
-         (lnk_file (setattr unlink)))
+         (lnk_file (create rename setattr unlink)))
   (allow guix_daemon_t
          tmp_t
-         (dir (create
-               rmdir
+         (file (link rename create execute execute_no_trans write unlink setattr map relabelto)))
+  (allow guix_daemon_t
+         tmp_t
+         (fifo_file (open read write create getattr ioctl setattr unlink)))
+  (allow guix_daemon_t
+         tmp_t
+         (dir (create rename
+               rmdir relabelto
                add_name remove_name
                open read write
                getattr setattr
                search)))
+  (allow guix_daemon_t
+         tmp_t
+         (sock_file (create getattr setattr unlink write)))
   (allow guix_daemon_t
          var_log_t
          (file (create getattr open write)))
   (allow guix_daemon_t
          var_log_t
-         (dir (getattr write add_name)))
+         (dir (getattr create write add_name)))
   (allow guix_daemon_t
          var_run_t
          (lnk_file (read)))
@@ -100,10 +162,10 @@
   ;; Spawning processes, execute helpers
   (allow guix_daemon_t
          self
-         (process (fork)))
+         (process (fork execmem setrlimit setpgid setsched)))
   (allow guix_daemon_t
          guix_daemon_exec_t
-         (file (execute execute_no_trans read open)))
+         (file (execute execute_no_trans read open entrypoint map)))
 
   ;; TODO: unknown
   (allow guix_daemon_t
@@ -119,38 +181,51 @@
   ;; Build isolation
   (allow guix_daemon_t
          guix_store_content_t
-         (file (mounton)))
+         (file (ioctl mounton)))
   (allow guix_store_content_t
          fs_t
          (filesystem (associate)))
   (allow guix_daemon_t
          guix_store_content_t
-         (dir (mounton)))
+         (dir (read mounton)))
   (allow guix_daemon_t
          guix_daemon_t
          (capability (net_admin
                       fsetid fowner
                       chown setuid setgid
                       dac_override dac_read_search
-                      sys_chroot)))
+                      sys_chroot
+                      sys_admin)))
   (allow guix_daemon_t
          fs_t
          (filesystem (unmount)))
+  (allow guix_daemon_t
+         devpts_t
+         (dir (search)))
   (allow guix_daemon_t
          devpts_t
          (filesystem (mount)))
   (allow guix_daemon_t
          devpts_t
-         (chr_file (setattr getattr)))
+         (chr_file (ioctl open read write setattr getattr)))
   (allow guix_daemon_t
          tmpfs_t
-         (filesystem (mount)))
+         (filesystem (getattr mount)))
   (allow guix_daemon_t
          tmpfs_t
-         (dir (getattr)))
+         (file (create open read unlink write)))
+  (allow guix_daemon_t
+         tmpfs_t
+         (dir (getattr add_name remove_name write)))
   (allow guix_daemon_t
          proc_t
-         (filesystem (mount)))
+         (file (getattr open read)))
+  (allow guix_daemon_t
+         proc_t
+         (dir (read)))
+  (allow guix_daemon_t
+         proc_t
+         (filesystem (associate mount)))
   (allow guix_daemon_t
          null_device_t
          (chr_file (getattr open read write)))
@@ -179,7 +254,7 @@
                search rename
                add_name remove_name
                open write
-               rmdir)))
+               rmdir relabelfrom)))
   (allow guix_daemon_t
          guix_store_content_t
          (file (create
@@ -189,7 +264,7 @@
                 link unlink
                 map
                 rename
-                open read write)))
+                open read write relabelfrom)))
   (allow guix_daemon_t
          guix_store_content_t
          (lnk_file (create
@@ -197,17 +272,23 @@
                     link unlink
                     read
                     rename)))
+  (allow guix_daemon_t
+         guix_store_content_t
+         (fifo_file (create getattr open read unlink write)))
+  (allow guix_daemon_t
+         guix_store_content_t
+         (sock_file (create getattr unlink write)))
 
   ;; Access to configuration files and directories
   (allow guix_daemon_t
          guix_daemon_conf_t
-         (dir (search
+         (dir (search create
                setattr getattr
                add_name remove_name
                open read write)))
   (allow guix_daemon_t
          guix_daemon_conf_t
-         (file (create
+         (file (create rename
                 lock
                 map
                 getattr setattr
@@ -216,11 +297,17 @@
   (allow guix_daemon_t
          guix_daemon_conf_t
          (lnk_file (create getattr rename unlink)))
+  (allow guix_daemon_t net_conf_t
+         (file (getattr open read)))
+  (allow guix_daemon_t net_conf_t
+         (lnk_file (read)))
+  (allow guix_daemon_t NetworkManager_var_run_t
+         (dir (search)))
 
   ;; Access to profiles
   (allow guix_daemon_t
          guix_profiles_t
-         (dir (getattr setattr read open)))
+         (dir (search getattr setattr read write open create add_name)))
   (allow guix_daemon_t
          guix_profiles_t
          (lnk_file (read getattr)))
@@ -233,8 +320,22 @@
   (allow guix_daemon_t
          user_home_t
          (dir (search)))
+  (allow guix_daemon_t
+         cache_home_t
+         (dir (search)))
+
+  ;; self upgrades
+  (allow guix_daemon_t
+         self
+         (dir (add_name write)))
+  (allow guix_daemon_t
+         self
+         (netlink_route_socket (bind create getattr nlmsg_read read write)))
 
   ;; Socket operations
+  (allow guix_daemon_t
+         guix_daemon_socket_t
+         (sock_file (unlink)))
   (allow guix_daemon_t
          init_t
          (fd (use)))
@@ -253,12 +354,53 @@
                               read write
                               connect bind accept
                               getopt setopt)))
+  (allow guix_daemon_t
+         self
+         (tcp_socket (accept listen bind connect create setopt getopt getattr ioctl read write shutdown)))
+  (allow guix_daemon_t
+         unreserved_port_t
+         (tcp_socket (name_bind name_connect accept listen)))
+  (allow guix_daemon_t
+         self
+         (udp_socket (connect getattr bind getopt setopt)))
   (allow guix_daemon_t
          self
          (fifo_file (write read)))
   (allow guix_daemon_t
          self
          (udp_socket (ioctl create)))
+  (allow guix_daemon_t
+         self
+         (unix_stream_socket (connectto)))
+
+  (allow guix_daemon_t
+         node_t
+         (tcp_socket (node_bind)))
+  (allow guix_daemon_t
+         node_t
+         (udp_socket (node_bind)))
+  (allow guix_daemon_t
+         port_t
+         (tcp_socket (name_connect)))
+  (allow guix_daemon_t
+         rtp_media_port_t
+         (udp_socket (name_bind)))
+  (allow guix_daemon_t
+         vnc_port_t
+         (tcp_socket (name_bind)))
+
+  ;; I guess sometimes it needs random numbers
+  (allow guix_daemon_t
+         random_device_t
+         (chr_file (read)))
+
+  ;; guix system vm
+  (allow guix_daemon_t
+         kvm_device_t
+         (chr_file (ioctl open read write)))
+  (allow guix_daemon_t
+         kernel_t
+         (system (ipc_info)))
 
   ;; Label file system
   (filecon "@guix_sysconfdir@/guix(/.*)?"
@@ -277,5 +419,7 @@
            file (system_u object_r guix_daemon_exec_t (low low)))
   (filecon "@storedir@/.+-(guix-.+|profile)/bin/guix-daemon"
            file (system_u object_r guix_daemon_exec_t (low low)))
+  (filecon "@storedir@/[a-z0-9]+-guix-daemon"
+           file (system_u object_r guix_daemon_exec_t (low low)))
   (filecon "@guix_localstatedir@/guix/daemon-socket/socket"
            any (system_u object_r guix_daemon_socket_t (low low))))

etc/guix-install.sh

@@ -6,6 +6,7 @@
 # Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 # Copyright © 2020 Morgan Smith <Morgan.J.Smith@outlook.com>
 # Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
+# Copyright © 2020 Daniel Brooks <db48x@db48x.net>
 #
 # This file is part of GNU Guix.
 #
@@ -60,6 +61,7 @@ INF="[ INFO ] "
 
 DEBUG=0
 GNU_URL="https://ftp.gnu.org/gnu/guix/"
+#GNU_URL="https://alpha.gnu.org/gnu/guix/"
 OPENPGP_SIGNING_KEY_ID="3CE464558A84FDC69DB40CFB090B11993D9AEBB5"
 
 # This script needs to know where root's home directory is.  However, we
@@ -228,11 +230,11 @@ guix_get_bin_list()
 
     # Filter only version and architecture
     bin_ver_ls=("$(wget -qO- "$gnu_url" \
-        | sed -n -e 's/.*guix-binary-\([0-9.]*\)\..*.tar.xz.*/\1/p' \
+        | sed -n -e 's/.*guix-binary-\([0-9.]*[a-z0-9]*\)\..*.tar.xz.*/\1/p' \
         | sort -Vu)")
 
     latest_ver="$(echo "$bin_ver_ls" \
-                       | grep -oE "([0-9]{1,2}\.){2}[0-9]{1,2}" \
+                       | grep -oE "([0-9]{1,2}\.){2}[0-9]{1,2}[a-z0-9]*" \
                        | tail -n1)"
 
     default_ver="guix-binary-${latest_ver}.${ARCH_OS}"

gnu/installer/parted.scm

@@ -41,6 +41,7 @@
   #:use-module (ice-9 regex)
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
@@ -318,7 +319,7 @@ PARTED-OBJECT field equals PARTITION, return #f if not found."
 fail. See rereadpt function in wipefs.c of util-linux for an explanation."
   ;; Kernel always return EINVAL for BLKRRPART on loopdevices.
   (and (not (string-match "/dev/loop*" file-name))
-       (let loop ((try 4))
+       (let loop ((try 16))
          (usleep 250000)
          (let ((in-use? (device-in-use? file-name)))
            (if (and in-use? (> try 0))
@@ -339,15 +340,12 @@ fail. See rereadpt function in wipefs.c of util-linux for an explanation."
 (define (non-install-devices)
   "Return all the available devices, except the busy one, allegedly the
 install device. DEVICE-IS-BUSY? is a parted call, checking if the device is
-mounted. The install image uses an overlayfs so the install device does not
-appear as mounted and won't be considered as busy. So use also DEVICE-IN-USE?
-from (guix build syscalls) module, who will try to re-read the device's
-partition table to determine whether or not it is already used (like sfdisk
-from util-linux)."
+mounted."
+  ;; FIXME: The install image uses an overlayfs so the install device does not
+  ;; appear as mounted and won't be considered as busy.
   (remove (lambda (device)
             (let ((file-name (device-path device)))
-              (or (device-is-busy? device)
-                  (with-delay-device-in-use? file-name))))
+              (device-is-busy? device)))
           (devices)))
 
 
@@ -1390,9 +1388,12 @@ the devices not to be used before returning."
   (let ((device-file-names (map device-path devices)))
     (for-each force-device-sync devices)
     (for-each (lambda (file-name)
-                (let ((in-use? (with-delay-device-in-use? file-name)))
-                  (and in-use?
-                       (error
-                        (format #f (G_ "Device ~a is still in use.")
-                                file-name)))))
+                (let/time ((time in-use?
+                                 (with-delay-device-in-use? file-name)))
+                  (if in-use?
+                      (error
+                       (format #f (G_ "Device ~a is still in use.")
+                               file-name))
+                      (syslog "Syncing ~a took ~a seconds.~%"
+                              file-name (time-second time)))))
               device-file-names)))

gnu/installer/utils.scm

@@ -22,6 +22,7 @@
   #:use-module (guix build utils)
   #:use-module (guix i18n)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-34)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
@@ -36,6 +37,8 @@
 
             syslog-port
             syslog
+            call-with-time
+            let/time
 
             with-server-socket
             current-server-socket
@@ -117,6 +120,17 @@ COMMAND exited successfully, #f otherwise."
 ;;; Logging.
 ;;;
 
+(define (call-with-time thunk kont)
+  "Call THUNK and pass KONT the elapsed time followed by THUNK's return
+values."
+  (let* ((start  (current-time time-monotonic))
+         (result (call-with-values thunk list))
+         (end    (current-time time-monotonic)))
+    (apply kont (time-difference end start) result)))
+
+(define-syntax-rule (let/time ((time result exp)) body ...)
+  (call-with-time (lambda () exp) (lambda (time result) body ...)))
+
 (define (open-syslog-port)
   "Return an open port (a socket) to /dev/log or #f if that wasn't possible."
   (let ((sock (socket AF_UNIX SOCK_DGRAM 0)))

gnu/packages/bioinformatics.scm

@@ -12,7 +12,7 @@
 ;;; Copyright © 2018 Joshua Sierles, Nextjournal <joshua@nextjournal.com>
 ;;; Copyright © 2018 Gábor Boskovits <boskovits@gmail.com>
 ;;; Copyright © 2018, 2019, 2020 Mădălin Ionel Patrașcu <madalinionel.patrascu@mdc-berlin.de>
-;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2019, 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2019 Brian Leung <bkleung89@gmail.com>
 ;;; Copyright © 2019 Brett Gilio <brettg@gnu.org>
 ;;; Copyright © 2020 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
@@ -1894,7 +1894,7 @@ multiple sequence alignments.")
 (define-public python-pysam
   (package
     (name "python-pysam")
-    (version "0.15.1")
+    (version "0.16.0.1")
     (source (origin
               (method git-fetch)
               ;; Test data is missing on PyPi.
@@ -1904,7 +1904,7 @@ multiple sequence alignments.")
               (file-name (git-file-name name version))
               (sha256
                (base32
-                "1vj367w6xbn9bpmksm162l1aipf7cj97h1q83y7jcpm33ihwpf7x"))
+                "168bwwm8c2k22m7paip8q0yajyl7xdxgnik0bgjl7rhqg0majz0f"))
               (modules '((guix build utils)))
               (snippet '(begin
                           ;; Drop bundled htslib. TODO: Also remove samtools
@@ -1934,8 +1934,13 @@ multiple sequence alignments.")
              ;; This file contains tests that require a connection to the
              ;; internet.
              (delete-file "tests/tabix_test.py")
-             ;; FIXME: This test fails
+             ;; These tests fail (see:
+             ;; https://github.com/pysam-developers/pysam/issues/939).
+             (delete-file "tests/compile_test.py")
              (delete-file "tests/AlignmentFile_test.py")
+             (delete-file "tests/AlignmentFileHeader_test.py")
+             (delete-file "tests/StreamFiledescriptors_test.py")
+             (delete-file "tests/VariantRecord_test.py")
              ;; Add first subdirectory of "build" directory to PYTHONPATH.
              (setenv "PYTHONPATH"
                      (string-append
@@ -1965,7 +1970,8 @@ multiple sequence alignments.")
        ;; Dependencies below are are for tests only.
        ("samtools" ,samtools)
        ("bcftools" ,bcftools)
-       ("python-nose" ,python-nose)))
+       ("python-nose" ,python-nose)
+       ("python-pytest" ,python-pytest)))
     (home-page "https://github.com/pysam-developers/pysam")
     (synopsis "Python bindings to the SAMtools C API")
     (description

gnu/packages/package-management.scm

@@ -130,9 +130,9 @@
   ;; Latest version of Guix, which may or may not correspond to a release.
   ;; Note: the 'update-guix-package.scm' script expects this definition to
   ;; start precisely like this.
-  (let ((version "1.1.0")
-        (commit "5e7cf66fb35780f930ad0bc5fe21ac330df4411d")
-        (revision 32))
+  (let ((version "1.2.0rc1")
+        (commit "3ba6ffd0dd092ae879d014e4971989f231eaa56d")
+        (revision 1))
     (package
       (name "guix")
 
@@ -148,7 +148,7 @@
                       (commit commit)))
                 (sha256
                  (base32
-                  "15clfjp845gvl0p6qw0b1gdibqfq20zwzr6dbxvq8l9fgzj1kb6b"))
+                  "1wa67gdipmzqr400hp0cw5ih0rlfvj345h65rqbk9s4g3bkg38hm"))
                 (file-name (string-append "guix-" version "-checkout"))))
       (build-system gnu-build-system)
       (arguments
@@ -336,7 +336,13 @@ $(prefix)/etc/init.d\n")))
                             (let ((bash (assoc-ref inputs "bash")))
                               (substitute* (string-append out "/bin/guix")
                                 (("^#!.*/bash") (string-append "#! " bash "/bin/bash")))))
-                          #t))))))
+                          #t)))
+
+                    ;; The 'guix' executable has 'OUT/libexec/guix/guile' as
+                    ;; its shebang; that should remain unchanged, thus remove
+                    ;; the 'patch-shebangs' phase, which would otherwise
+                    ;; change it to 'GUILE/bin/guile'.
+                    (delete 'patch-shebangs))))
       (native-inputs `(("pkg-config" ,pkg-config)
 
                        ;; Guile libraries are needed here for

gnu/services/base.scm

@@ -106,6 +106,12 @@
             agetty-service-type
 
             mingetty-configuration
+            mingetty-configuration-tty
+            mingetty-configuration-auto-login
+            mingetty-configuration-login-program
+            mingetty-configuration-login-pause?
+            mingetty-configuration-clear-on-logout?
+            mingetty-configuration-mingetty
             mingetty-configuration?
             mingetty-service
             mingetty-service-type

gnu/services/shepherd.scm

@@ -224,16 +224,21 @@ which is not provided by any service")
 
   (for-each assert-satisfied-requirements services))
 
+(define %store-characters
+  ;; Valid store characters; see 'checkStoreName' in the daemon.
+  (string->char-set
+   "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+-._?="))
+
 (define (shepherd-service-file-name service)
   "Return the file name where the initialization code for SERVICE is to be
 stored."
   (let ((provisions (string-join (map symbol->string
                                       (shepherd-service-provision service)))))
     (string-append "shepherd-"
-                   (string-map (match-lambda
-                                 (#\/ #\-)
-                                 (#\  #\-)
-                                 (chr chr))
+                   (string-map (lambda (chr)
+                                 (if (char-set-contains? %store-characters chr)
+                                     chr
+                                     #\-))
                                provisions)
                    ".scm")))
 

guix/scripts/build.scm

@@ -51,7 +51,9 @@
   #:use-module ((guix progress) #:select (current-terminal-columns))
   #:use-module ((guix build syscalls) #:select (terminal-columns))
   #:use-module (guix transformations)
-  #:export (%standard-build-options
+  #:export (log-url
+
+            %standard-build-options
             set-build-options-from-command-line
             set-build-options-from-command-line*
             show-build-options-help

guix/scripts/pack.scm

@@ -59,11 +59,16 @@
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
   #:export (compressor?
+            compressor-name
+            compressor-extenstion
+            compressor-command
+            %compressors
             lookup-compressor
             self-contained-tarball
             docker-image
             squashfs-image
 
+            %formats
             guix-pack))
 
 ;; Type of a compression tool.

guix/scripts/publish.scm

@@ -2,6 +2,7 @@
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
 ;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -250,6 +251,21 @@ usage."
     ("WantMassQuery" . 0)
     ("Priority" . 100)))
 
+;;; A common buffer size value used for the TCP socket SO_SNDBUF option and
+;;; the gzip compressor buffer size.
+(define %default-buffer-size
+  (* 208 1024))
+
+(define %default-socket-options
+  ;; List of options passed to 'setsockopt' when transmitting files.
+  (list (list SO_SNDBUF %default-buffer-size)))
+
+(define* (configure-socket socket #:key (level SOL_SOCKET)
+                           (options %default-socket-options))
+  "Apply multiple option tuples in OPTIONS to SOCKET, using LEVEL."
+  (for-each (cut apply setsockopt socket level <>)
+            options))
+
 (define (signed-string s)
   "Sign the hash of the string S with the daemon's key.  Return a canonical
 sexp for the signature."
@@ -569,7 +585,7 @@ requested using POOL."
        (lambda (port)
          (write-file item port))
        #:level (compression-level compression)
-       #:buffer-size (* 128 1024))
+       #:buffer-size %default-buffer-size)
      (rename-file (string-append nar ".tmp") nar))
     ('lzip
      ;; Note: the file port gets closed along with the lzip port.
@@ -866,7 +882,7 @@ or if EOF is reached."
      ;; 'make-gzip-output-port' wants a file port.
      (make-gzip-output-port (response-port response)
                             #:level level
-                            #:buffer-size (* 64 1024)))
+                            #:buffer-size %default-buffer-size))
     (($ <compression> 'lzip level)
      (make-lzip-output-port (response-port response)
                             #:level level))
@@ -891,8 +907,7 @@ blocking."
                                             client))
                (port        (begin
                               (force-output client)
-                              (setsockopt client SOL_SOCKET
-                                          SO_SNDBUF (* 128 1024))
+                              (configure-socket client)
                               (nar-response-port response compression))))
           ;; XXX: Given our ugly workaround for <http://bugs.gnu.org/21093> in
           ;; 'render-nar', BODY here is just the file name of the store item.
@@ -922,7 +937,7 @@ blocking."
                                                                          size)
                                                     client))
                           (output   (response-port response)))
-                     (setsockopt client SOL_SOCKET SO_SNDBUF (* 128 1024))
+                     (configure-socket client)
                      (if (file-port? output)
                          (sendfile output input size)
                          (dump-port input output))
@@ -1067,7 +1082,8 @@ methods, return the applicable compression."
 (define (open-server-socket address)
   "Return a TCP socket bound to ADDRESS, a socket address."
   (let ((sock (socket (sockaddr:fam address) SOCK_STREAM 0)))
-    (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
+    (configure-socket sock #:options (cons (list SO_REUSEADDR 1)
+                                           %default-socket-options))
     (bind sock address)
     sock))
 

guix/scripts/pull.scm

@@ -385,7 +385,7 @@ previous generation.  Return true if there are news to display."
     (and=> (relative-generation profile -1)
            (cut generation-file-name profile <>)))
 
-  (when previous
+  (and previous
     (let ((old-channels (profile-channels previous))
           (new-channels (profile-channels profile)))
       ;; Find the channels present in both PROFILE and PREVIOUS, and print

guix/self.scm

@@ -400,6 +400,12 @@ a list of extra files, such as '(\"contributing\")."
                         (find-files directory
                                     "\\.[a-z]{2}(_[A-Z]{2})?\\.po$")))
 
+          (define parallel-jobs
+            ;; Limit thread creation by 'n-par-for-each'.  Going beyond can
+            ;; lead libgc 8.0.4 to abort with:
+            ;; mmap(PROT_NONE) failed
+            (min (parallel-job-count) 4))
+
           (mkdir #$output)
           (copy-recursively #$documentation "."
                             #:log (%make-void-port "w"))
@@ -415,14 +421,14 @@ a list of extra files, such as '(\"contributing\")."
           (setenv "LC_ALL" "en_US.UTF-8")
           (setlocale LC_ALL "en_US.UTF-8")
 
-          (n-par-for-each (parallel-job-count)
+          (n-par-for-each parallel-jobs
                           (match-lambda
                             ((language . po)
                              (translate-texi "guix" po language
                                              #:extras '("contributing"))))
                           (available-translations "." "guix-manual"))
 
-          (n-par-for-each (parallel-job-count)
+          (n-par-for-each parallel-jobs
                           (match-lambda
                             ((language . po)
                              (translate-texi "guix-cookbook" po language)))

tests/build-utils.scm

@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2015, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2015, 2016, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -174,7 +174,7 @@ echo hello world"))
        (let ((script-file-name (string-append directory "/foo")))
          (call-with-output-file script-file-name
            (lambda (port)
-             (format port script-contents)))
+             (display script-contents port)))
          (chmod script-file-name #o777)
          (wrap-script script-file-name
                       `("GUIX_FOO" prefix ("/some/path"