Merge branch 'master' into staging

3 files changed, 49 insertions, 55 deletions

diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 63f6129279..c27edc7982 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -33,6 +33,7 @@
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:use-module (gnu build linux-container)
+  #:use-module (gnu build accounts)
   #:use-module (gnu system linux-container)
   #:use-module (gnu system file-systems)
   #:use-module (gnu packages)
@@ -458,10 +459,20 @@ will be used for the passwd entry.  LINK-PROFILE? creates a symbolic link from
     (return
      (let* ((cwd      (getcwd))
             (home     (getenv "HOME"))
-            (passwd   (mock-passwd (getpwuid (getuid))
-                                   user
-                                   bash))
-            (home-dir (passwd:dir passwd))
+            (passwd   (let ((pwd (getpwuid (getuid))))
+                        (password-entry
+                         (name (or user (passwd:name pwd)))
+                         (real-name (if user
+                                        ""
+                                        (passwd:gecos pwd)))
+                         (uid 0) (gid 0) (shell bash)
+                         (directory (if user
+                                        (string-append "/home/" user)
+                                        (passwd:dir pwd))))))
+            (groups   (list (group-entry (name "users") (gid 0))
+                            (group-entry (gid 65534) ;the overflow GID
+                                         (name "overflow"))))
+            (home-dir (password-entry-directory passwd))
             ;; Bind-mount all requisite store items, user-specified mappings,
             ;; /bin/sh, the current working directory, and possibly networking
             ;; configuration files within the container.
@@ -519,17 +530,8 @@ will be used for the passwd entry.  LINK-PROFILE? creates a symbolic link from
             ;; to read it, such as 'git clone' over SSH, a valid use-case when
             ;; sharing the host's network namespace.
             (mkdir-p "/etc")
-            (call-with-output-file "/etc/passwd"
-              (lambda (port)
-                (display (string-join (list (passwd:name passwd)
-                                            "x" ; but there is no shadow
-                                            "0" "0" ; user is now root
-                                            (passwd:gecos passwd)
-                                            (passwd:dir passwd)
-                                            bash)
-                                      ":")
-                         port)
-                (newline port)))
+            (write-passwd (list passwd))
+            (write-group groups)
 
             ;; For convenience, start in the user's current working
             ;; directory rather than the root directory.
@@ -543,32 +545,6 @@ will be used for the passwd entry.  LINK-PROFILE? creates a symbolic link from
                            (delq 'net %namespaces) ; share host network
                            %namespaces)))))))
 
-(define (mock-passwd passwd user-override shell)
-  "Generate mock information for '/etc/passwd'.  If USER-OVERRIDE is not '#f',
-it is expected to be a string representing the mock username; it will produce
-a user of that name, with a home directory of '/home/USER-OVERRIDE', and no
-GECOS field.  If USER-OVERRIDE is '#f', data will be inherited from PASSWD.
-In either case, the shadow password and UID/GID are cleared, since the user
-runs as root within the container.  SHELL will always be used in place of the
-shell in PASSWD.
-
-The resulting vector is suitable for use with Guile's POSIX user procedures.
-
-See passwd(5) for more information each of the fields."
-  (if user-override
-      (vector
-       user-override
-        "x" "0" "0"  ;; no shadow, user is now root
-        ""           ;; no personal information
-        (user-override-home user-override)
-        shell)
-      (vector
-       (passwd:name passwd)
-        "x" "0" "0"  ;; no shadow, user is now root
-        (passwd:gecos passwd)
-        (passwd:dir passwd)
-        shell)))
-
 (define (user-override-home user)
   "Return home directory for override user USER."
   (string-append "/home/" user))
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 730b6a0bf2..2aaf1cc44a 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -181,6 +181,7 @@ Download and deploy the latest version of Guix.\n"))
            (new (profile-package-alist
                  (generation-file-name profile current))))
        (display-new/upgraded-packages old new
+                                      #:concise? #t
                                       #:heading (G_ "New in this revision:\n"))))
     (_ #t)))
 
@@ -377,11 +378,33 @@ of packages upgraded in ALIST2."
                                alist2)))
     (values new upgraded)))
 
+(define* (ellipsis #:optional (port (current-output-port)))
+  "Return HORIZONTAL ELLIPSIS three dots if PORT's encoding cannot represent
+it."
+  (match (port-encoding port)
+    ("UTF-8" "…")
+    (_       "...")))
+
 (define* (display-new/upgraded-packages alist1 alist2
-                                        #:key (heading ""))
+                                        #:key (heading "") concise?)
   "Given the two package name/version alists ALIST1 and ALIST2, display the
 list of new and upgraded packages going from ALIST1 to ALIST2.  When ALIST1
-and ALIST2 differ, display HEADING upfront."
+and ALIST2 differ, display HEADING upfront.  When CONCISE? is true, do not
+display long package lists that would fill the user's screen."
+  (define (pretty str column)
+    (indented-string (fill-paragraph str (- (%text-width) 4)
+                                     column)
+                     4))
+
+  (define list->enumeration
+    (if concise?
+        (lambda* (lst #:optional (max 12))
+          (if (> (length lst) max)
+              (string-append (string-join (take lst max) ", ")
+                             ", " (ellipsis))
+              (string-join lst ", ")))
+        (cut string-join <> ", ")))
+
   (let-values (((new upgraded) (new/upgraded-packages alist1 alist2)))
     (unless (and (null? new) (null? upgraded))
       (display heading))
@@ -392,21 +415,16 @@ and ALIST2 differ, display HEADING upfront."
        (format #t (N_ "  ~h new package: ~a~%"
                       "  ~h new packages: ~a~%" count)
                count
-               (indented-string
-                (fill-paragraph (string-join (sort (map first new) string<?)
-                                             ", ")
-                                (- (%text-width) 4) 30)
-                4))))
+               (pretty (list->enumeration (sort (map first new) string<?))
+                       30))))
     (match (length upgraded)
       (0 #t)
       (count
        (format #t (N_ "  ~h package upgraded: ~a~%"
                       "  ~h packages upgraded: ~a~%" count)
                count
-               (indented-string
-                (fill-paragraph (string-join (sort upgraded string<?) ", ")
-                                (- (%text-width) 4) 35)
-                4))))))
+               (pretty (list->enumeration (sort upgraded string<?))
+                       35))))))
 
 (define (display-profile-content-diff profile gen1 gen2)
   "Display the changes in PROFILE GEN2 compared to generation GEN1."
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 5b0f345cde..dd7026a6a4 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -297,7 +297,7 @@ KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
 values: 'interactive' (default), 'always', and 'never'.  When WARN? is true,
 warn about packages that have no matching updater."
   (if (lookup-updater package updaters)
-      (let-values (((version tarball changes)
+      (let-values (((version tarball source)
                     (package-update store package updaters
                                     #:key-download key-download))
                    ((loc)
@@ -330,10 +330,10 @@ warn about packages that have no matching updater."
                               (G_ "~a: consider removing this propagated input: ~a~%")))
                            (package-name package)
                            (upstream-input-change-name change)))
-                 (changes))
+                 (upstream-source-input-changes source))
                 (let ((hash (call-with-input-file tarball
                               port-sha256)))
-                  (update-package-source package version hash)))
+                  (update-package-source package source hash)))
               (warning (G_ "~a: version ~a could not be \
 downloaded and authenticated; not updating~%")
                        (package-name package) version))))