11 files changed, 333 insertions, 194 deletions
diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index 4fa1d1683d..b2b184db34 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -250,6 +250,9 @@ derivations for SYSTEM.  Include propagated inputs in the result."
                            inputs))))
 
 (define standard-inputs
+  ;; FIXME: Memoization should be associated with the open store (as for
+  ;; 'add-text-to-store'), otherwise we get .drv that may not be valid when
+  ;; switching to another store.
   (memoize
    (lambda (system)
      "Return the list of implicit standard inputs used with the GNU Build
diff --git a/guix/build/activation.scm b/guix/build/activation.scm
index 9464d2157d..b04b017881 100644
--- a/guix/build/activation.scm
+++ b/guix/build/activation.scm
@@ -36,13 +36,14 @@
 ;;;
 ;;; Code:
 
-(define* (add-group name #:key gid password
+(define* (add-group name #:key gid password system?
                     (log-port (current-error-port)))
   "Add NAME as a user group, with the given numeric GID if specified."
   ;; Use 'groupadd' from the Shadow package.
   (format log-port "adding group '~a'...~%" name)
   (let ((args `(,@(if gid `("-g" ,(number->string gid)) '())
                 ,@(if password `("-p" ,password) '())
+                ,@(if system? `("--system") '())
                 ,name)))
     (zero? (apply system* "groupadd" args))))
 
@@ -128,9 +129,11 @@ numeric gid or #f."
 
   ;; Then create the groups.
   (for-each (match-lambda
-             ((name password gid)
+             ((name password gid system?)
               (unless (false-if-exception (getgrnam name))
-                (add-group name #:gid gid #:password password))))
+                (add-group name
+                           #:gid gid #:password password
+                           #:system? system?))))
             groups)
 
   ;; Finally create the other user accounts.
diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm
index abf86f6a77..662f7967e3 100644
--- a/guix/build/linux-initrd.scm
+++ b/guix/build/linux-initrd.scm
@@ -40,6 +40,7 @@
             find-partition-by-label
             canonicalize-device-spec
 
+            mount-flags->bit-mask
             check-file-system
             mount-file-system
             bind-mount
@@ -393,6 +394,9 @@ networking values.)  Return #t if INTERFACE is up, #f otherwise."
 
 ;; Linux mount flags, from libc's <sys/mount.h>.
 (define MS_RDONLY 1)
+(define MS_NOSUID 2)
+(define MS_NODEV  4)
+(define MS_NOEXEC 8)
 (define MS_BIND 4096)
 (define MS_MOVE 8192)
 
@@ -494,6 +498,24 @@ UNIONFS."
                fsck code device)
        (start-repl)))))
 
+(define (mount-flags->bit-mask flags)
+  "Return the number suitable for the 'flags' argument of 'mount' that
+corresponds to the symbols listed in FLAGS."
+  (let loop ((flags flags))
+    (match flags
+      (('read-only rest ...)
+       (logior MS_RDONLY (loop rest)))
+      (('bind-mount rest ...)
+       (logior MS_BIND (loop rest)))
+      (('no-suid rest ...)
+       (logior MS_NOSUID (loop rest)))
+      (('no-dev rest ...)
+       (logior MS_NODEV (loop rest)))
+      (('no-exec rest ...)
+       (logior MS_NOEXEC (loop rest)))
+      (()
+       0))))
+
 (define* (mount-file-system spec #:key (root "/root"))
   "Mount the file system described by SPEC under ROOT.  SPEC must have the
 form:
@@ -503,15 +525,6 @@ form:
 DEVICE, MOUNT-POINT, and TYPE must be strings; OPTIONS can be a string or #f;
 FLAGS must be a list of symbols.  CHECK? is a Boolean indicating whether to
 run a file system check."
-  (define flags->bit-mask
-    (match-lambda
-     (('read-only rest ...)
-      (or MS_RDONLY (flags->bit-mask rest)))
-     (('bind-mount rest ...)
-      (or MS_BIND (flags->bit-mask rest)))
-     (()
-      0)))
-
   (match spec
     ((source title mount-point type (flags ...) options check?)
      (let ((source      (canonicalize-device-spec source title))
@@ -519,7 +532,7 @@ run a file system check."
        (when check?
          (check-file-system source type))
        (mkdir-p mount-point)
-       (mount source mount-point type (flags->bit-mask flags)
+       (mount source mount-point type (mount-flags->bit-mask flags)
               (if options
                   (string->pointer options)
                   %null-pointer))
@@ -528,7 +541,7 @@ run a file system check."
        (mkdir-p (string-append root "/etc"))
        (let ((port (open-file (string-append root "/etc/mtab") "a")))
          (format port "~a ~a ~a ~a 0 0~%"
-                 source mount-point type options)
+                 source mount-point type (or options ""))
          (close-port port))))))
 
 (define (switch-root root)
@@ -670,11 +683,6 @@ to it are lost."
              (switch-root "/root")
              (format #t "loading '~a'...\n" to-load)
 
-             ;; Obviously this has to be done each time we boot.  Do it from here
-             ;; so that statfs(2) returns DEVPTS_SUPER_MAGIC like libc's getpt(3)
-             ;; expects (and thus openpty(3) and its users, such as xterm.)
-             (mount "none" "/dev/pts" "devpts")
-
              ;; TODO: Remove /lib, /share, and /loader.go.
              (primitive-load to-load)
 
diff --git a/guix/monads.scm b/guix/monads.scm
index c2c6f1a03d..4af2b704ab 100644
--- a/guix/monads.scm
+++ b/guix/monads.scm
@@ -55,6 +55,7 @@
             run-with-store
             text-file
             text-file*
+            interned-file
             package-file
             origin->derivation
             package->derivation
@@ -362,6 +363,18 @@ and store file names; the resulting store file holds references to all these."
     (derivation-expression name (builder inputs)
                            #:inputs inputs)))
 
+(define* (interned-file file #:optional name
+                        #:key (recursive? #t))
+  "Return the name of FILE once interned in the store.  Use NAME as its store
+name, or the basename of FILE if NAME is omitted.
+
+When RECURSIVE? is true, the contents of FILE are added recursively; if FILE
+designates a flat file and RECURSIVE? is true, its contents are added, and its
+permission bits are kept."
+  (lambda (store)
+    (add-to-store store (or name (basename file))
+                  recursive? "sha256" file)))
+
 (define* (package-file package
                        #:optional file
                        #:key (system (%current-system)) (output "out"))
diff --git a/guix/packages.scm b/guix/packages.scm
index 985a573fd3..1939373f35 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -75,6 +75,7 @@
             package-location
             package-field-location
 
+            package-direct-inputs
             package-transitive-inputs
             package-transitive-target-inputs
             package-transitive-native-inputs
@@ -484,12 +485,17 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
       ((input rest ...)
        (loop rest (cons input result))))))
 
+(define (package-direct-inputs package)
+  "Return all the direct inputs of PACKAGE---i.e, its direct inputs along
+with their propagated inputs."
+  (append (package-native-inputs package)
+          (package-inputs package)
+          (package-propagated-inputs package)))
+
 (define (package-transitive-inputs package)
   "Return the transitive inputs of PACKAGE---i.e., its direct inputs along
 with their propagated inputs, recursively."
-  (transitive-inputs (append (package-native-inputs package)
-                             (package-inputs package)
-                             (package-propagated-inputs package))))
+  (transitive-inputs (package-direct-inputs package)))
 
 (define (package-transitive-target-inputs package)
   "Return the transitive target inputs of PACKAGE---i.e., its direct inputs
@@ -521,6 +527,8 @@ recursively."
 (define (cache package system thunk)
   "Memoize the return values of THUNK as the derivation of PACKAGE on
 SYSTEM."
+  ;; FIXME: This memoization should be associated with the open store, because
+  ;; otherwise it breaks when switching to a different store.
   (let ((vals (call-with-values thunk list)))
     ;; Use `hashq-set!' instead of `hash-set!' because `hash' returns the
     ;; same value for all structs (as of Guile 2.0.6), and because pointer
diff --git a/guix/profiles.scm b/guix/profiles.scm
index c1fa8272ba..5e69e012f9 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -22,6 +22,7 @@
   #:use-module (guix records)
   #:use-module (guix derivations)
   #:use-module (guix packages)
+  #:use-module (guix gexp)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 ftw)
@@ -39,21 +40,18 @@
             manifest-entry-name
             manifest-entry-version
             manifest-entry-output
-            manifest-entry-path
+            manifest-entry-item
             manifest-entry-dependencies
 
             manifest-pattern
             manifest-pattern?
 
-            read-manifest
-            write-manifest
-
             manifest-remove
             manifest-installed?
             manifest-matching-entries
-            manifest=?
 
             profile-manifest
+            package->manifest-entry
             profile-derivation
             generation-number
             generation-numbers
@@ -88,11 +86,9 @@
   (version      manifest-entry-version)           ; string
   (output       manifest-entry-output             ; string
                 (default "out"))
-  (path         manifest-entry-path)              ; store path
-  (dependencies manifest-entry-dependencies       ; list of store paths
-                (default '()))
-  (inputs       manifest-entry-inputs             ; list of inputs to build
-                (default '())))                   ; this entry
+  (item         manifest-entry-item)              ; package | store path
+  (dependencies manifest-entry-dependencies       ; (store path | package)*
+                (default '())))
 
 (define-record-type* <manifest-pattern> manifest-pattern
   make-manifest-pattern
@@ -110,17 +106,36 @@
         (call-with-input-file file read-manifest)
         (manifest '()))))
 
-(define (manifest->sexp manifest)
-  "Return a representation of MANIFEST as an sexp."
-  (define (entry->sexp entry)
+(define* (package->manifest-entry package #:optional output)
+  "Return a manifest entry for the OUTPUT of package PACKAGE.  When OUTPUT is
+omitted or #f, use the first output of PACKAGE."
+  (let ((deps (map (match-lambda
+                    ((label package)
+                     `(,package "out"))
+                    ((label package output)
+                     `(,package ,output)))
+                   (package-transitive-propagated-inputs package))))
+    (manifest-entry
+     (name (package-name package))
+     (version (package-version package))
+     (output (or output (car (package-outputs package))))
+     (item package)
+     (dependencies (delete-duplicates deps)))))
+
+(define (manifest->gexp manifest)
+  "Return a representation of MANIFEST as a gexp."
+  (define (entry->gexp entry)
     (match entry
-      (($ <manifest-entry> name version path output (deps ...))
-       (list name version path output deps))))
+      (($ <manifest-entry> name version output (? string? path) (deps ...))
+       #~(#$name #$version #$output #$path #$deps))
+      (($ <manifest-entry> name version output (? package? package) (deps ...))
+       #~(#$name #$version #$output
+                 (ungexp package (or output "out")) #$deps))))
 
   (match manifest
     (($ <manifest> (entries ...))
-     `(manifest (version 1)
-                (packages ,(map entry->sexp entries))))))
+     #~(manifest (version 1)
+                 (packages #$(map entry->gexp entries))))))
 
 (define (sexp->manifest sexp)
   "Parse SEXP as a manifest."
@@ -133,7 +148,7 @@
               (name name)
               (version version)
               (output output)
-              (path path)))
+              (item path)))
            name version output path)))
 
     ;; Version 1 adds a list of propagated inputs to the
@@ -146,7 +161,7 @@
               (name name)
               (version version)
               (output output)
-              (path path)
+              (item path)
               (dependencies deps)))
            name version output path deps)))
 
@@ -157,10 +172,6 @@
   "Return the packages listed in MANIFEST."
   (sexp->manifest (read port)))
 
-(define (write-manifest manifest port)
-  "Write MANIFEST to PORT."
-  (write (manifest->sexp manifest) port))
-
 (define (entry-predicate pattern)
   "Return a procedure that returns #t when passed a manifest entry that
 matches NAME/OUTPUT/VERSION.  OUTPUT and VERSION may be #f, in which case they
@@ -203,62 +214,41 @@ must be a manifest-pattern."
 
   (filter matches? (manifest-entries manifest)))
 
-(define (manifest=? m1 m2)
-  "Return #t if manifests M1 and M2 are equal.  This differs from 'equal?' in
-that the 'inputs' field is ignored for the comparison, since it is know to
-have no effect on the manifest contents."
-  (equal? (manifest->sexp m1)
-          (manifest->sexp m2)))
-
 
 ;;;
 ;;; Profiles.
 ;;;
 
-(define* (lower-input store input #:optional (system (%current-system)))
-  "Lower INPUT so that it contains derivations instead of packages."
-  (match input
-    ((name (? package? package))
-     `(,name ,(package-derivation store package system)))
-    ((name (? package? package) output)
-     `(,name ,(package-derivation store package system)
-             ,output))
-    (_ input)))
-
-(define (profile-derivation store manifest)
+(define (profile-derivation manifest)
   "Return a derivation that builds a profile (aka. 'user environment') with
 the given MANIFEST."
+  (define inputs
+    (append-map (match-lambda
+                 (($ <manifest-entry> name version
+                                      output (? package? package) deps)
+                  `((,package ,output) ,@deps))
+                 (($ <manifest-entry> name version output path deps)
+                  ;; Assume PATH and DEPS are already valid.
+                  `(,path ,@deps)))
+                (manifest-entries manifest)))
+
   (define builder
-    `(begin
-       (use-modules (ice-9 pretty-print)
-                    (guix build union))
-
-       (setvbuf (current-output-port) _IOLBF)
-       (setvbuf (current-error-port) _IOLBF)
-
-       (let ((output (assoc-ref %outputs "out"))
-             (inputs (map cdr %build-inputs)))
-         (union-build output inputs
-                      #:log-port (%make-void-port "w"))
-         (call-with-output-file (string-append output "/manifest")
-           (lambda (p)
-             (pretty-print ',(manifest->sexp manifest) p))))))
-
-  (build-expression->derivation store "profile" builder
-                                #:inputs
-                                (append-map (match-lambda
-                                             (($ <manifest-entry> name version
-                                                 output path deps (inputs ..1))
-                                              (map (cute lower-input store <>)
-                                                   inputs))
-                                             (($ <manifest-entry> name version
-                                                 output path deps)
-                                              ;; Assume PATH and DEPS are
-                                              ;; already valid.
-                                              `((,name ,path) ,@deps)))
-                                            (manifest-entries manifest))
-                                #:modules '((guix build union))
-                                #:local-build? #t))
+    #~(begin
+        (use-modules (ice-9 pretty-print)
+                     (guix build union))
+
+        (setvbuf (current-output-port) _IOLBF)
+        (setvbuf (current-error-port) _IOLBF)
+
+        (union-build #$output '#$inputs
+                     #:log-port (%make-void-port "w"))
+        (call-with-output-file (string-append #$output "/manifest")
+          (lambda (p)
+            (pretty-print '#$(manifest->gexp manifest) p)))))
+
+  (gexp->derivation "profile" builder
+                    #:modules '((guix build union))
+                    #:local-build? #t))
 
 (define (profile-regexp profile)
   "Return a regular expression that matches PROFILE's name and number."
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 1c3209f905..31da773a53 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -24,6 +24,7 @@
   #:use-module (guix derivations)
   #:use-module (guix packages)
   #:use-module (guix profiles)
+  #:use-module (guix monads)
   #:use-module (guix utils)
   #:use-module (guix config)
   #:use-module (guix scripts build)
@@ -82,7 +83,8 @@ return PROFILE unchanged.  The goal is to treat '-p ~/.guix-profile' as if
 
 (define (link-to-empty-profile generation)
   "Link GENERATION, a string, to the empty profile."
-  (let* ((drv  (profile-derivation (%store) (manifest '())))
+  (let* ((drv  (run-with-store (%store)
+                 (profile-derivation (manifest '()))))
          (prof (derivation->output-path drv "out")))
     (when (not (build-derivations (%store) (list drv)))
           (leave (_ "failed to build the empty profile~%")))
@@ -205,10 +207,14 @@ packages that will/would be installed and removed."
                    remove))))
     (_ #f))
   (match install
-    ((($ <manifest-entry> name version output path _) ..1)
+    ((($ <manifest-entry> name version output item _) ..1)
      (let ((len     (length name))
-           (install (map (cut format #f "   ~a-~a\t~a\t~a" <> <> <> <>)
-                         name version output path)))
+           (install (map (lambda (name version output item)
+                           (format #f "   ~a-~a\t~a\t~a" name version output
+                                   (if (package? item)
+                                       (package-output (%store) item output)
+                                       item)))
+                         name version output item)))
        (if dry-run?
            (format (current-error-port)
                    (N_ "The following package would be installed:~%~{~a~%~}~%"
@@ -253,17 +259,6 @@ RX."
                 (package-name p2))))
    same-location?))
 
-(define (input->name+path input)
-  "Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple."
-  (let loop ((input input))
-    (match input
-      ((name (? package? package))
-       (loop `(,name ,package "out")))
-      ((name (? package? package) sub-drv)
-       `(,name ,(package-output (%store) package sub-drv)))
-      (_
-       input))))
-
 (define %sigint-prompt
   ;; The prompt to jump to upon SIGINT.
   (make-prompt-tag "interruptible"))
@@ -517,6 +512,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
   (display (_ "
   -A, --list-available[=REGEXP]
                          list available packages matching REGEXP"))
+  (display (_ "
+  --show=PACKAGE         show details about PACKAGE"))
   (newline)
   (show-build-options-help)
   (newline)
@@ -615,6 +612,11 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                    (values (cons `(query list-available ,(or arg ""))
                                  result)
                            #f)))
+         (option '("show") #t #t
+                 (lambda (opt name arg result arg-handler)
+                   (values (cons `(query show ,arg)
+                                 result)
+                           #f)))
 
          %standard-build-options))
 
@@ -639,22 +641,11 @@ return the new list of manifest entries."
 
     (delete-duplicates deps same?))
 
-  (define (package->manifest-entry p output)
-    ;; Return a manifest entry for the OUTPUT of package P.
-    (check-package-freshness p)
+  (define (package->manifest-entry* package output)
+    (check-package-freshness package)
     ;; When given a package via `-e', install the first of its
     ;; outputs (XXX).
-    (let* ((output (or output (car (package-outputs p))))
-           (path   (package-output (%store) p output))
-           (deps   (deduplicate (package-transitive-propagated-inputs p))))
-      (manifest-entry
-       (name (package-name p))
-       (version (package-version p))
-       (output output)
-       (path path)
-       (dependencies (map input->name+path deps))
-       (inputs (cons (list (package-name p) p output)
-                     deps)))))
+    (package->manifest-entry package output))
 
   (define upgrade-regexps
     (filter-map (match-lambda
@@ -685,7 +676,7 @@ return the new list of manifest entries."
   (define to-upgrade
     (map (match-lambda
           ((package output)
-           (package->manifest-entry package output)))
+           (package->manifest-entry* package output)))
          packages-to-upgrade))
 
   (define packages-to-install
@@ -703,7 +694,7 @@ return the new list of manifest entries."
   (define to-install
     (append (map (match-lambda
                   ((package output)
-                   (package->manifest-entry package output)))
+                   (package->manifest-entry* package output)))
                  packages-to-install)
             (filter-map (match-lambda
                          (('install . (? package?))
@@ -716,7 +707,7 @@ return the new list of manifest entries."
                              (name name)
                              (version version)
                              (output #f)
-                             (path path))))
+                             (item path))))
                          (_ #f))
                         opts)))
 
@@ -743,6 +734,16 @@ removed from MANIFEST."
   (unless (string=? profile %current-profile)
     (add-indirect-root store (canonicalize-path profile))))
 
+(define (readlink* file)
+  "Call 'readlink' until the result is not a symlink."
+  (catch 'system-error
+    (lambda ()
+      (readlink* (readlink file)))
+    (lambda args
+      (if (= EINVAL (system-error-errno args))
+          file
+          (apply throw args)))))
+
 
 ;;;
 ;;; Entry point.
@@ -914,36 +915,41 @@ more information.~%"))
              (when (equal? profile %current-profile)
                (ensure-default-profile))
 
-             (if (manifest=? new manifest)
-                 (format (current-error-port) (_ "nothing to be done~%"))
-                 (let ((prof-drv (profile-derivation (%store) new))
-                       (remove   (manifest-matching-entries manifest remove)))
-                   (show-what-to-remove/install remove install dry-run?)
-                   (show-what-to-build (%store) (list prof-drv)
-                                       #:use-substitutes?
-                                       (assoc-ref opts 'substitutes?)
-                                       #:dry-run? dry-run?)
-
-                   (or dry-run?
-                       (let* ((prof   (derivation->output-path prof-drv))
-                              (number (generation-number profile))
-
-                              ;; Always use NUMBER + 1 for the new profile,
-                              ;; possibly overwriting a "previous future
-                              ;; generation".
-                              (name   (generation-file-name profile
-                                                            (+ 1 number))))
-                         (and (build-derivations (%store) (list prof-drv))
-                              (let ((count (length entries)))
-                                (switch-symlinks name prof)
-                                (switch-symlinks profile name)
-                                (maybe-register-gc-root (%store) profile)
-                                (format #t (N_ "~a package in profile~%"
-                                               "~a packages in profile~%"
-                                               count)
-                                        count)
-                                (display-search-paths entries
-                                                      profile)))))))))))
+             (unless (and (null? install) (null? remove))
+               (let* ((prof-drv (run-with-store (%store)
+                                  (profile-derivation new)))
+                      (prof     (derivation->output-path prof-drv))
+                      (remove   (manifest-matching-entries manifest remove)))
+                 (show-what-to-remove/install remove install dry-run?)
+                 (show-what-to-build (%store) (list prof-drv)
+                                     #:use-substitutes?
+                                     (assoc-ref opts 'substitutes?)
+                                     #:dry-run? dry-run?)
+
+                 (cond
+                  (dry-run? #t)
+                  ((and (file-exists? profile)
+                        (and=> (readlink* profile) (cut string=? prof <>)))
+                   (format (current-error-port) (_ "nothing to be done~%")))
+                  (else
+                   (let* ((number (generation-number profile))
+
+                          ;; Always use NUMBER + 1 for the new profile,
+                          ;; possibly overwriting a "previous future
+                          ;; generation".
+                          (name   (generation-file-name profile
+                                                        (+ 1 number))))
+                     (and (build-derivations (%store) (list prof-drv))
+                          (let ((count (length entries)))
+                            (switch-symlinks name prof)
+                            (switch-symlinks profile name)
+                            (maybe-register-gc-root (%store) profile)
+                            (format #t (N_ "~a package in profile~%"
+                                           "~a packages in profile~%"
+                                           count)
+                                    count)
+                            (display-search-paths entries
+                                                  profile))))))))))))
 
   (define (process-query opts)
     ;; Process any query specified by OPTS.  Return #t when a query was
@@ -1042,6 +1048,14 @@ more information.~%"))
                       (find-packages-by-description regexp)))
            #t))
 
+        (('show requested-name)
+         (let-values (((name version)
+                       (package-name->name+version requested-name)))
+           (leave-on-EPIPE
+            (for-each (cute package->recutils <> (current-output-port))
+                      (find-packages-by-name name version)))
+           #t))
+
         (('search-paths)
          (let* ((manifest (profile-manifest profile))
                 (entries  (manifest-entries manifest))
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index af7beb748b..a91ea69b1f 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +30,8 @@
   #:use-module ((gnu packages base) #:select (%final-inputs))
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module (ice-9 vlist)
+  #:use-module (ice-9 format)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -59,6 +62,9 @@
                     (x
                      (leave (_ "~a: invalid selection; expected `core' or `non-core'")
                             arg)))))
+        (option '(#\l "list-dependent") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'list-dependent? #t result)))
 
         (option '("key-server") #t #f
                 (lambda (opt name arg result)
@@ -96,6 +102,9 @@ specified with `--select'.\n"))
   (display (_ "
   -s, --select=SUBSET    select all the packages in SUBSET, one of
                          `core' or `non-core'"))
+  (display (_ "
+  -l, --list-dependent   list top-level dependent packages that would need to
+                         be rebuilt as a result of upgrading PACKAGE..."))
   (newline)
   (display (_ "
       --key-server=HOST  use HOST as the OpenPGP key server"))
@@ -193,9 +202,10 @@ update would trigger a complete rebuild."
         ;; XXX: Fails to catch MPFR/MPC, whose *source* is used as input.
         (member (package-name package) names))))
 
-  (let* ((opts         (parse-options))
-         (update?      (assoc-ref opts 'update?))
-         (key-download (assoc-ref opts 'key-download))
+  (let* ((opts            (parse-options))
+         (update?         (assoc-ref opts 'update?))
+         (list-dependent? (assoc-ref opts 'list-dependent?))
+         (key-download    (assoc-ref opts 'key-download))
          (packages
           (match (concatenate
                   (filter-map (match-lambda
@@ -220,26 +230,48 @@ update would trigger a complete rebuild."
                  (some                        ; user-specified packages
                   some))))
     (with-error-handling
-      (if update?
-          (let ((store (open-connection)))
-            (parameterize ((%openpgp-key-server
-                            (or (assoc-ref opts 'key-server)
-                                (%openpgp-key-server)))
-                           (%gpg-command
-                            (or (assoc-ref opts 'gpg-command)
-                                (%gpg-command))))
-              (for-each
-               (cut update-package store <> #:key-download key-download)
-               packages)))
-          (for-each (lambda (package)
-                      (match (false-if-exception (package-update-path package))
-                        ((new-version . directory)
-                         (let ((loc (or (package-field-location package 'version)
-                                        (package-location package))))
-                           (format (current-error-port)
-                                   (_ "~a: ~a would be upgraded from ~a to ~a~%")
-                                   (location->string loc)
-                                   (package-name package) (package-version package)
-                                   new-version)))
-                        (_ #f)))
-                    packages)))))
+      (cond
+       (list-dependent?
+        (let* ((rebuilds (map package-full-name
+                              (package-covering-dependents packages)))
+               (total-dependents
+                (length (package-transitive-dependents packages))))
+          (if (= total-dependents 0)
+              (format (current-output-port)
+                      (N_ "No dependents other than itself: ~{~a~}~%"
+                          "No dependents other than themselves: ~{~a~^ ~}~%"
+                          (length packages))
+                      (map package-full-name packages))
+              (format (current-output-port)
+                      (N_ (N_ "A single dependent package: ~2*~{~a~}~%"
+                              "Building the following package would ensure ~d \
+dependent packages are rebuilt; ~*~{~a~^ ~}~%"
+                              total-dependents)
+                          "Building the following ~d packages would ensure ~d \
+dependent packages are rebuilt: ~{~a~^ ~}~%"
+                          (length rebuilds))
+                      (length rebuilds) total-dependents rebuilds))))
+       (update?
+        (let ((store (open-connection)))
+          (parameterize ((%openpgp-key-server
+                          (or (assoc-ref opts 'key-server)
+                              (%openpgp-key-server)))
+                         (%gpg-command
+                          (or (assoc-ref opts 'gpg-command)
+                              (%gpg-command))))
+            (for-each
+             (cut update-package store <> #:key-download key-download)
+             packages))))
+       (else
+        (for-each (lambda (package)
+                    (match (false-if-exception (package-update-path package))
+                      ((new-version . directory)
+                       (let ((loc (or (package-field-location package 'version)
+                                      (package-location package))))
+                         (format (current-error-port)
+                                 (_ "~a: ~a would be upgraded from ~a to ~a~%")
+                                 (location->string loc)
+                                 (package-name package) (package-version package)
+                                 new-version)))
+                      (_ #f)))
+                  packages))))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 66ad9192c1..4f1869af38 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -95,8 +95,8 @@
   (store-lift show-what-to-build))
 
 
-(define* (copy-closure item target
-                       #:key (log-port (current-error-port)))
+(define* (copy-item item target
+                    #:key (log-port (current-error-port)))
   "Copy ITEM to the store under root directory TARGET and register it."
   (mlet* %store-monad ((refs (references* item)))
     (let ((dest  (string-append target item))
@@ -118,6 +118,18 @@
 
       (return #t))))
 
+(define* (copy-closure item target
+                       #:key (log-port (current-error-port)))
+  "Copy ITEM and all its dependencies to the store under root directory
+TARGET, and register them."
+  (mlet* %store-monad ((refs    (references* item))
+                       (to-copy (topologically-sorted*
+                                 (delete-duplicates (cons item refs)
+                                                    string=?))))
+    (sequence %store-monad
+              (map (cut copy-item <> target #:log-port log-port)
+                   to-copy))))
+
 (define* (install os-drv target
                   #:key (log-port (current-output-port))
                   grub? grub.cfg device)
@@ -136,16 +148,10 @@ When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG."
             (mkdir-p (string-append target (%store-prefix)))
 
             ;; Copy items to the new store.
-            (sequence %store-monad
-                      (map (cut copy-closure <> target #:log-port log-port)
-                           to-copy))))))
+            (copy-closure to-copy target #:log-port log-port)))))
 
   (mlet* %store-monad ((os-dir -> (derivation->output-path os-drv))
-                       (refs      (references* os-dir))
-                       (lst    -> (delete-duplicates (cons os-dir refs)
-                                                     string=?))
-                       (to-copy   (topologically-sorted* lst))
-                       (%         (maybe-copy to-copy)))
+                       (%         (maybe-copy os-dir)))
 
     ;; Create a bunch of additional files.
     (format log-port "populating '~a'...~%" target)
@@ -166,6 +172,16 @@ When GRUB? is true, install GRUB on DEVICE, using GRUB.CFG."
   ;; The system profile.
   (string-append %state-directory "/profiles/system"))
 
+(define-syntax-rule (save-environment-excursion body ...)
+  "Save the current environment variables, run BODY..., and restore them."
+  (let ((env (environ)))
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        body ...)
+      (lambda ()
+        (environ env)))))
+
 (define* (switch-to-system os
                            #:optional (profile %system-profile))
   "Make a new generation of PROFILE pointing to the directory of OS, switch to
@@ -179,7 +195,11 @@ it atomically, and then run OS's activation script."
       (switch-symlinks profile generation)
 
       (format #t (_ "activating system...~%"))
-      (return (primitive-load (derivation->output-path script)))
+
+      ;; The activation script may change $PATH, among others, so protect
+      ;; against that.
+      (return (save-environment-excursion
+               (primitive-load (derivation->output-path script))))
 
       ;; TODO: Run 'deco reload ...'.
       )))
@@ -293,7 +313,8 @@ actions."
              (mlet %store-monad ((% (switch-to-system os)))
                (when grub?
                  (unless (false-if-exception
-                          (install-grub grub.cfg device "/"))
+                          (install-grub (derivation->output-path grub.cfg)
+                                        device "/"))
                    (leave (_ "failed to install GRUB on device '~a'~%")
                           device)))
                (return #t)))
diff --git a/guix/ui.scm b/guix/ui.scm
index 7338b82401..9112d55daf 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -453,9 +453,23 @@ WIDTH columns."
        (fill-paragraph str width
                        (string-length "description: ")))))
 
+  (define (dependencies->recutils packages)
+    (let ((list (string-join (map package-full-name
+                                  (sort packages package<?)) " ")))
+      (string->recutils
+       (fill-paragraph list width
+                       (string-length "dependencies: ")))))
+
+  (define (package<? p1 p2)
+    (string<? (package-full-name p1) (package-full-name p2)))
+
   ;; Note: Don't i18n field names so that people can post-process it.
   (format port "name: ~a~%" (package-name p))
   (format port "version: ~a~%" (package-version p))
+  (format port "dependencies: ~a~%"
+          (match (package-direct-inputs p)
+            (((labels inputs . _) ...)
+             (dependencies->recutils (filter package? inputs)))))
   (format port "location: ~a~%"
           (or (and=> (package-location p) location->string)
               (_ "unknown")))
diff --git a/guix/utils.scm b/guix/utils.scm
index 700a191d71..b61ff2477d 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -72,6 +73,8 @@
             call-with-temporary-output-file
             with-atomic-file-output
             fold2
+            fold-tree
+            fold-tree-leaves
 
             filtered-port
             compressed-port
@@ -649,6 +652,36 @@ output port, and PROC's result is returned."
              (lambda (result1 result2)
                (fold2 proc result1 result2 (cdr lst1) (cdr lst2)))))))))
 
+(define (fold-tree proc init children roots)
+  "Call (PROC NODE RESULT) for each node in the tree that is reachable from
+ROOTS, using INIT as the initial value of RESULT.  The order in which nodes
+are traversed is not specified, however, each node is visited only once, based
+on an eq? check.  Children of a node to be visited are generated by
+calling (CHILDREN NODE), the result of which should be a list of nodes that
+are connected to NODE in the tree, or '() or #f if NODE is a leaf node."
+  (let loop ((result init)
+             (seen vlist-null)
+             (lst roots))
+    (match lst
+      (() result)
+      ((head . tail)
+       (if (not (vhash-assq head seen))
+           (loop (proc head result)
+                 (vhash-consq head #t seen)
+                 (match (children head)
+                   ((or () #f) tail)
+                   (children (append tail children))))
+           (loop result seen tail))))))
+
+(define (fold-tree-leaves proc init children roots)
+  "Like fold-tree, but call (PROC NODE RESULT) only for leaf nodes."
+  (fold-tree
+   (lambda (node result)
+     (match (children node)
+       ((or () #f) (proc node result))
+       (else result)))
+   init children roots))
+
 
 ;;;
 ;;; Source location.