Merge branch 'master' into core-updates

Conflicts:
	guix/packages.scm

4 files changed, 516 insertions, 335 deletions

diff --git a/guix/packages.scm b/guix/packages.scm
index 157013a496..9a2f08d862 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -41,6 +41,9 @@
             origin-patch-flags
             origin-patch-inputs
             origin-patch-guile
+            origin-snippet
+            origin-modules
+            origin-imported-modules
             base32
 
             <search-path-specification>
@@ -107,6 +110,7 @@
   (sha256    origin-sha256)                       ; bytevector
   (file-name origin-file-name (default #f))       ; optional file name
   (patches   origin-patches (default '()))        ; list of file names
+  (snippet   origin-snippet (default #f))         ; sexp or #f
   (patch-flags  origin-patch-flags                ; list of strings
                 (default '("-p1")))
 
@@ -114,6 +118,10 @@
   ;; used to specify these dependencies when needed.
   (patch-inputs origin-patch-inputs               ; input list or #f
                 (default #f))
+  (modules      origin-modules                    ; list of module names
+                (default '()))
+  (imported-modules origin-imported-modules       ; list of module names
+                    (default '()))
   (patch-guile origin-patch-guile                 ; package or #f
                (default #f)))
 
@@ -272,26 +280,38 @@ corresponds to the arguments expected by `set-path-environment-variable'."
   (let ((distro (resolve-interface '(gnu packages base))))
     (module-ref distro 'guile-final)))
 
-(define* (patch-and-repack store source patches inputs
+(define* (patch-and-repack store source patches
                            #:key
+                           (inputs '())
+                           (snippet #f)
                            (flags '("-p1"))
+                           (modules '())
+                           (imported-modules '())
                            (guile-for-build (%guile-for-build))
                            (system (%current-system)))
-  "Unpack SOURCE (a derivation), apply all of PATCHES, and repack the tarball
-using the tools listed in INPUTS."
+  "Unpack SOURCE (a derivation or store path), apply all of PATCHES, and
+repack the tarball using the tools listed in INPUTS.  When SNIPPET is true,
+it must be an s-expression that will run from within the directory where
+SOURCE was unpacked, after all of PATCHES have been applied.  MODULES and
+IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
+  (define source-file-name
+    ;; SOURCE is usually a derivation, but it could be a store file.
+    (if (derivation? source)
+        (derivation->output-path source)
+        source))
+
   (define decompression-type
-    (let ((out (derivation->output-path source)))
-      (cond ((string-suffix? "gz" out)  "gzip")
-            ((string-suffix? "bz2" out) "bzip2")
-            ((string-suffix? "lz" out)  "lzip")
-            (else "xz"))))
+    (cond ((string-suffix? "gz" source-file-name)  "gzip")
+          ((string-suffix? "bz2" source-file-name) "bzip2")
+          ((string-suffix? "lz" source-file-name)  "lzip")
+          (else "xz")))
 
   (define original-file-name
-    (let ((out (derivation->output-path source)))
-      ;; Remove the store prefix plus the slash, hash, and hyphen.
-      (let* ((sans (string-drop out (+ (string-length (%store-prefix)) 1)))
-             (dash (string-index sans #\-)))
-        (string-drop sans (+ 1 dash)))))
+    ;; Remove the store prefix plus the slash, hash, and hyphen.
+    (let* ((sans (string-drop source-file-name
+                              (+ (string-length (%store-prefix)) 1)))
+           (dash (string-index sans #\-)))
+      (string-drop sans (+ 1 dash))))
 
   (define patch-inputs
     (map (lambda (number patch)
@@ -331,7 +351,24 @@ using the tools listed in INPUTS."
                 (format (current-error-port)
                         "source is under '~a'~%" directory)
                 (chdir directory)
+
                 (and (every apply-patch ',(map car patch-inputs))
+
+                     ,@(if snippet
+                           `((let ((module (make-fresh-user-module)))
+                               (module-use-interfaces! module
+                                                       (map resolve-interface
+                                                            ',modules))
+                               (module-define! module '%build-inputs
+                                               %build-inputs)
+                               (module-define! module '%outputs %outputs)
+                               ((@ (system base compile) compile)
+                                ',snippet
+                                #:to 'value
+                                #:opts %auto-compilation-options
+                                #:env module)))
+                           '())
+
                      (begin (chdir "..") #t)
                      (zero? (system* tar "cvfa" out directory))))))))
 
@@ -351,19 +388,21 @@ using the tools listed in INPUTS."
                                  `(("source" ,source)
                                    ,@inputs
                                    ,@patch-inputs)
+                                 #:modules imported-modules
                                  #:guile-for-build guile-for-build)))
 
 (define* (package-source-derivation store source
                                     #:optional (system (%current-system)))
   "Return the derivation path for SOURCE, a package source, for SYSTEM."
   (match source
-    (($ <origin> uri method sha256 name ())
-     ;; No patches.
+    (($ <origin> uri method sha256 name () #f)
+     ;; No patches, no snippet: this is a fixed-output derivation.
      (method store uri 'sha256 sha256 name
              #:system system))
-    (($ <origin> uri method sha256 name (patches ...) (flags ...)
-        inputs guile-for-build)
-     ;; One or more patches.
+    (($ <origin> uri method sha256 name (patches ...) snippet
+        (flags ...) inputs (modules ...) (imported-modules ...)
+        guile-for-build)
+     ;; Patches and/or a snippet.
      (let ((source (method store uri 'sha256 sha256 name
                            #:system system))
            (guile  (match (or guile-for-build (%guile-for-build)
@@ -372,9 +411,13 @@ using the tools listed in INPUTS."
                       (package-derivation store p system))
                      ((? derivation? drv)
                       drv))))
-       (patch-and-repack store source patches inputs
+       (patch-and-repack store source patches
+                         #:inputs inputs
+                         #:snippet snippet
                          #:flags flags
                          #:system system
+                         #:modules modules
+                         #:imported-modules modules
                          #:guile-for-build guile)))
     ((and (? string?) (? store-path?) file)
      file)
diff --git a/guix/profiles.scm b/guix/profiles.scm
new file mode 100644
index 0000000000..1f62099e45
--- /dev/null
+++ b/guix/profiles.scm
@@ -0,0 +1,347 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix profiles)
+  #:use-module (guix utils)
+  #:use-module (guix records)
+  #:use-module (guix derivations)
+  #:use-module (guix packages)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 ftw)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-26)
+  #:export (manifest make-manifest
+            manifest?
+            manifest-entries
+
+            <manifest-entry>              ; FIXME: eventually make it internal
+            manifest-entry
+            manifest-entry?
+            manifest-entry-name
+            manifest-entry-version
+            manifest-entry-output
+            manifest-entry-path
+            manifest-entry-dependencies
+
+            manifest-pattern
+            manifest-pattern?
+
+            read-manifest
+            write-manifest
+
+            manifest-remove
+            manifest-installed?
+            manifest-matching-entries
+            manifest=?
+
+            profile-manifest
+            profile-derivation
+            generation-number
+            generation-numbers
+            previous-generation-number
+            generation-time
+            generation-file-name))
+
+;;; Commentary:
+;;;
+;;; Tools to create and manipulate profiles---i.e., the representation of a
+;;; set of installed packages.
+;;;
+;;; Code:
+
+
+;;;
+;;; Manifests.
+;;;
+
+(define-record-type <manifest>
+  (manifest entries)
+  manifest?
+  (entries manifest-entries))                     ; list of <manifest-entry>
+
+;; Convenient alias, to avoid name clashes.
+(define make-manifest manifest)
+
+(define-record-type* <manifest-entry> manifest-entry
+  make-manifest-entry
+  manifest-entry?
+  (name         manifest-entry-name)              ; string
+  (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
+
+(define-record-type* <manifest-pattern> manifest-pattern
+  make-manifest-pattern
+  manifest-pattern?
+  (name         manifest-pattern-name)            ; string
+  (version      manifest-pattern-version          ; string | #f
+                (default #f))
+  (output       manifest-pattern-output           ; string | #f
+                (default "out")))
+
+(define (profile-manifest profile)
+  "Return the PROFILE's manifest."
+  (let ((file (string-append profile "/manifest")))
+    (if (file-exists? file)
+        (call-with-input-file file read-manifest)
+        (manifest '()))))
+
+(define (manifest->sexp manifest)
+  "Return a representation of MANIFEST as an sexp."
+  (define (entry->sexp entry)
+    (match entry
+      (($ <manifest-entry> name version path output (deps ...))
+       (list name version path output deps))))
+
+  (match manifest
+    (($ <manifest> (entries ...))
+     `(manifest (version 1)
+                (packages ,(map entry->sexp entries))))))
+
+(define (sexp->manifest sexp)
+  "Parse SEXP as a manifest."
+  (match sexp
+    (('manifest ('version 0)
+                ('packages ((name version output path) ...)))
+     (manifest
+      (map (lambda (name version output path)
+             (manifest-entry
+              (name name)
+              (version version)
+              (output output)
+              (path path)))
+           name version output path)))
+
+    ;; Version 1 adds a list of propagated inputs to the
+    ;; name/version/output/path tuples.
+    (('manifest ('version 1)
+                ('packages ((name version output path deps) ...)))
+     (manifest
+      (map (lambda (name version output path deps)
+             (manifest-entry
+              (name name)
+              (version version)
+              (output output)
+              (path path)
+              (dependencies deps)))
+           name version output path deps)))
+
+    (_
+     (error "unsupported manifest format" manifest))))
+
+(define (read-manifest port)
+  "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
+are ignored."
+  (match pattern
+    (($ <manifest-pattern> name version output)
+     (match-lambda
+      (($ <manifest-entry> entry-name entry-version entry-output)
+       (and (string=? entry-name name)
+            (or (not entry-output) (not output)
+                (string=? entry-output output))
+            (or (not version)
+                (string=? entry-version version))))))))
+
+(define (manifest-remove manifest patterns)
+  "Remove entries for each of PATTERNS from MANIFEST.  Each item in PATTERNS
+must be a manifest-pattern."
+  (define (remove-entry pattern lst)
+    (remove (entry-predicate pattern) lst))
+
+  (make-manifest (fold remove-entry
+                       (manifest-entries manifest)
+                       patterns)))
+
+(define (manifest-installed? manifest pattern)
+  "Return #t if MANIFEST has an entry matching PATTERN (a manifest-pattern),
+#f otherwise."
+  (->bool (find (entry-predicate pattern)
+                (manifest-entries manifest))))
+
+(define (manifest-matching-entries manifest patterns)
+  "Return all the entries of MANIFEST that match one of the PATTERNS."
+  (define predicates
+    (map entry-predicate patterns))
+
+  (define (matches? entry)
+    (any (lambda (pred)
+           (pred entry))
+         predicates))
+
+  (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)
+  "Return a derivation that builds a profile (aka. 'user environment') with
+the given 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)))
+         (format #t "building profile '~a' with ~a packages...~%"
+                 output (length 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"
+                                (%current-system)
+                                builder
+                                (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))))
+
+(define (profile-regexp profile)
+  "Return a regular expression that matches PROFILE's name and number."
+  (make-regexp (string-append "^" (regexp-quote (basename profile))
+                              "-([0-9]+)")))
+
+(define (generation-number profile)
+  "Return PROFILE's number or 0.  An absolute file name must be used."
+  (or (and=> (false-if-exception (regexp-exec (profile-regexp profile)
+                                              (basename (readlink profile))))
+             (compose string->number (cut match:substring <> 1)))
+      0))
+
+(define (generation-numbers profile)
+  "Return the sorted list of generation numbers of PROFILE, or '(0) if no
+former profiles were found."
+  (define* (scandir name #:optional (select? (const #t))
+                    (entry<? (@ (ice-9 i18n) string-locale<?)))
+    ;; XXX: Bug-fix version introduced in Guile v2.0.6-62-g139ce19.
+    (define (enter? dir stat result)
+      (and stat (string=? dir name)))
+
+    (define (visit basename result)
+      (if (select? basename)
+          (cons basename result)
+          result))
+
+    (define (leaf name stat result)
+      (and result
+           (visit (basename name) result)))
+
+    (define (down name stat result)
+      (visit "." '()))
+
+    (define (up name stat result)
+      (visit ".." result))
+
+    (define (skip name stat result)
+      ;; All the sub-directories are skipped.
+      (visit (basename name) result))
+
+    (define (error name* stat errno result)
+      (if (string=? name name*)             ; top-level NAME is unreadable
+          result
+          (visit (basename name*) result)))
+
+    (and=> (file-system-fold enter? leaf down up skip error #f name lstat)
+           (lambda (files)
+             (sort files entry<?))))
+
+  (match (scandir (dirname profile)
+                  (cute regexp-exec (profile-regexp profile) <>))
+    (#f                                         ; no profile directory
+     '(0))
+    (()                                         ; no profiles
+     '(0))
+    ((profiles ...)                             ; former profiles around
+     (sort (map (compose string->number
+                         (cut match:substring <> 1)
+                         (cute regexp-exec (profile-regexp profile) <>))
+                profiles)
+           <))))
+
+(define (previous-generation-number profile number)
+  "Return the number of the generation before generation NUMBER of
+PROFILE, or 0 if none exists.  It could be NUMBER - 1, but it's not the
+case when generations have been deleted (there are \"holes\")."
+  (fold (lambda (candidate highest)
+          (if (and (< candidate number) (> candidate highest))
+              candidate
+              highest))
+        0
+        (generation-numbers profile)))
+
+(define (generation-file-name profile generation)
+  "Return the file name for PROFILE's GENERATION."
+  (format #f "~a-~a-link" profile generation))
+
+(define (generation-time profile number)
+  "Return the creation time of a generation in the UTC format."
+  (make-time time-utc 0
+             (stat:ctime (stat (generation-file-name profile number)))))
+
+;;; profiles.scm ends here
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 008ae53b47..bf39259922 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -23,22 +23,19 @@
   #:use-module (guix store)
   #:use-module (guix derivations)
   #:use-module (guix packages)
+  #:use-module (guix profiles)
   #:use-module (guix utils)
   #:use-module (guix config)
-  #:use-module (guix records)
   #:use-module ((guix build utils) #:select (directory-exists? mkdir-p))
   #:use-module ((guix ftp-client) #:select (ftp-open))
-  #:use-module (ice-9 ftw)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
-  #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-37)
   #:use-module (gnu packages)
   #:use-module ((gnu packages base) #:select (guile-final))
@@ -51,7 +48,7 @@
 
 
 ;;;
-;;; User profile.
+;;; Profiles.
 ;;;
 
 (define %user-profile-directory
@@ -69,240 +66,6 @@
   ;; coexist with Nix profiles.
   (string-append %profile-directory "/guix-profile"))
 
-
-;;;
-;;; Manifests.
-;;;
-
-(define-record-type <manifest>
-  (manifest entries)
-  manifest?
-  (entries manifest-entries))                     ; list of <manifest-entry>
-
-;; Convenient alias, to avoid name clashes.
-(define make-manifest manifest)
-
-(define-record-type* <manifest-entry> manifest-entry
-  make-manifest-entry
-  manifest-entry?
-  (name         manifest-entry-name)              ; string
-  (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
-
-(define (profile-manifest profile)
-  "Return the PROFILE's manifest."
-  (let ((file (string-append profile "/manifest")))
-    (if (file-exists? file)
-        (call-with-input-file file read-manifest)
-        (manifest '()))))
-
-(define (manifest->sexp manifest)
-  "Return a representation of MANIFEST as an sexp."
-  (define (entry->sexp entry)
-    (match entry
-      (($ <manifest-entry> name version path output (deps ...))
-       (list name version path output deps))))
-
-  (match manifest
-    (($ <manifest> (entries ...))
-     `(manifest (version 1)
-                (packages ,(map entry->sexp entries))))))
-
-(define (sexp->manifest sexp)
-  "Parse SEXP as a manifest."
-  (match sexp
-    (('manifest ('version 0)
-                ('packages ((name version output path) ...)))
-     (manifest
-      (map (lambda (name version output path)
-             (manifest-entry
-              (name name)
-              (version version)
-              (output output)
-              (path path)))
-           name version output path)))
-
-    ;; Version 1 adds a list of propagated inputs to the
-    ;; name/version/output/path tuples.
-    (('manifest ('version 1)
-                ('packages ((name version output path deps) ...)))
-     (manifest
-      (map (lambda (name version output path deps)
-             (manifest-entry
-              (name name)
-              (version version)
-              (output output)
-              (path path)
-              (dependencies deps)))
-           name version output path deps)))
-
-    (_
-     (error "unsupported manifest format" manifest))))
-
-(define (read-manifest port)
-  "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 (remove-manifest-entry name lst)
-  "Remove the manifest entry named NAME from LST."
-  (remove (match-lambda
-           (($ <manifest-entry> entry-name)
-            (string=? name entry-name)))
-          lst))
-
-(define (manifest-remove manifest names)
-  "Remove entries for each of NAMES from MANIFEST."
-  (make-manifest (fold remove-manifest-entry
-                       (manifest-entries manifest)
-                       names)))
-
-(define (manifest-installed? manifest name)
-  "Return #t if MANIFEST has an entry for NAME, #f otherwise."
-  (define (->bool x)
-    (not (not x)))
-
-  (->bool (find (match-lambda
-                 (($ <manifest-entry> entry-name)
-                  (string=? entry-name name)))
-                (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 (profile-regexp profile)
-  "Return a regular expression that matches PROFILE's name and number."
-  (make-regexp (string-append "^" (regexp-quote (basename profile))
-                              "-([0-9]+)")))
-
-(define (generation-numbers profile)
-  "Return the sorted list of generation numbers of PROFILE, or '(0) if no
-former profiles were found."
-  (define* (scandir name #:optional (select? (const #t))
-                    (entry<? (@ (ice-9 i18n) string-locale<?)))
-    ;; XXX: Bug-fix version introduced in Guile v2.0.6-62-g139ce19.
-    (define (enter? dir stat result)
-      (and stat (string=? dir name)))
-
-    (define (visit basename result)
-      (if (select? basename)
-          (cons basename result)
-          result))
-
-    (define (leaf name stat result)
-      (and result
-           (visit (basename name) result)))
-
-    (define (down name stat result)
-      (visit "." '()))
-
-    (define (up name stat result)
-      (visit ".." result))
-
-    (define (skip name stat result)
-      ;; All the sub-directories are skipped.
-      (visit (basename name) result))
-
-    (define (error name* stat errno result)
-      (if (string=? name name*)             ; top-level NAME is unreadable
-          result
-          (visit (basename name*) result)))
-
-    (and=> (file-system-fold enter? leaf down up skip error #f name lstat)
-           (lambda (files)
-             (sort files entry<?))))
-
-  (match (scandir (dirname profile)
-                  (cute regexp-exec (profile-regexp profile) <>))
-    (#f                                         ; no profile directory
-     '(0))
-    (()                                         ; no profiles
-     '(0))
-    ((profiles ...)                             ; former profiles around
-     (sort (map (compose string->number
-                         (cut match:substring <> 1)
-                         (cute regexp-exec (profile-regexp profile) <>))
-                profiles)
-           <))))
-
-(define (previous-generation-number profile number)
-  "Return the number of the generation before generation NUMBER of
-PROFILE, or 0 if none exists.  It could be NUMBER - 1, but it's not the
-case when generations have been deleted (there are \"holes\")."
-  (fold (lambda (candidate highest)
-          (if (and (< candidate number) (> candidate highest))
-              candidate
-              highest))
-        0
-        (generation-numbers profile)))
-
-(define (profile-derivation store manifest)
-  "Return a derivation that builds a profile (aka. 'user environment') with
-the given 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)))
-         (format #t "building profile '~a' with ~a packages...~%"
-                 output (length 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"
-                                (%current-system)
-                                builder
-                                (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))))
-
-(define (generation-number profile)
-  "Return PROFILE's number or 0.  An absolute file name must be used."
-  (or (and=> (false-if-exception (regexp-exec (profile-regexp profile)
-                                              (basename (readlink profile))))
-             (compose string->number (cut match:substring <> 1)))
-      0))
-
-(define (generation-file-name profile generation)
-  "Return the file name for PROFILE's GENERATION."
-  (format #f "~a-~a-link" profile generation))
-
 (define (link-to-empty-profile generation)
   "Link GENERATION, a string, to the empty profile."
   (let* ((drv  (profile-derivation (%store) (manifest '())))
@@ -340,11 +103,6 @@ the given MANIFEST."
           (else
            (switch-to-previous-generation profile)))))  ; anything else
 
-(define (generation-time profile number)
-  "Return the creation time of a generation in the UTC format."
-  (make-time time-utc 0
-             (stat:ctime (stat (generation-file-name profile number)))))
-
 (define* (matching-generations str #:optional (profile %current-profile)
                                #:key (duration-relation <=))
   "Return the list of available generations matching a pattern in STR.  See
@@ -411,6 +169,50 @@ DURATION-RELATION with the current time."
          filter-by-duration)
         (else #f)))
 
+(define (show-what-to-remove/install remove install dry-run?)
+  "Given the manifest entries listed in REMOVE and INSTALL, display the
+packages that will/would be installed and removed."
+  ;; TODO: Report upgrades more clearly.
+  (match remove
+    ((($ <manifest-entry> name version output path _) ..1)
+     (let ((len    (length name))
+           (remove (map (cut format #f "  ~a-~a\t~a\t~a" <> <> <> <>)
+                        name version output path)))
+       (if dry-run?
+           (format (current-error-port)
+                   (N_ "The following package would be removed:~%~{~a~%~}~%"
+                       "The following packages would be removed:~%~{~a~%~}~%"
+                       len)
+                   remove)
+           (format (current-error-port)
+                   (N_ "The following package will be removed:~%~{~a~%~}~%"
+                       "The following packages will be removed:~%~{~a~%~}~%"
+                       len)
+                   remove))))
+    (_ #f))
+  (match install
+    ((($ <manifest-entry> name version output path _) ..1)
+     (let ((len     (length name))
+           (install (map (cut format #f "   ~a-~a\t~a\t~a" <> <> <> <>)
+                         name version output path)))
+       (if dry-run?
+           (format (current-error-port)
+                   (N_ "The following package would be installed:~%~{~a~%~}~%"
+                       "The following packages would be installed:~%~{~a~%~}~%"
+                       len)
+                   install)
+           (format (current-error-port)
+                   (N_ "The following package will be installed:~%~{~a~%~}~%"
+                       "The following packages will be installed:~%~{~a~%~}~%"
+                       len)
+                   install))))
+    (_ #f)))
+
+
+;;;
+;;; Package specifications.
+;;;
+
 (define (find-packages-by-description rx)
   "Return the list of packages whose name, synopsis, or description matches
 RX."
@@ -437,16 +239,6 @@ RX."
                 (package-name p2))))
    same-location?))
 
-(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 (input->name+path input)
   "Convert the name/package/sub-drv tuple INPUT to a name/store-path tuple."
   (let loop ((input input))
@@ -500,11 +292,6 @@ return its return value."
        (format (current-error-port) "  interrupted by signal ~a~%" SIGINT)
        #f))))
 
-
-;;;
-;;; Package specifications.
-;;;
-
 (define newest-available-packages
   (memoize find-newest-available-packages))
 
@@ -536,13 +323,8 @@ version; if SPEC does not specify an output, return OUTPUT."
                (package-full-name p)
                sub-drv)))
 
-  (let*-values (((name sub-drv)
-                 (match (string-rindex spec #\:)
-                   (#f    (values spec output))
-                   (colon (values (substring spec 0 colon)
-                                  (substring spec (+ 1 colon))))))
-                ((name version)
-                 (package-name->name+version name)))
+  (let-values (((name version sub-drv)
+                (package-specification->name+version+output spec)))
     (match (find-best-packages-by-name name version)
       ((p)
        (values p (ensure-output p sub-drv)))
@@ -910,6 +692,22 @@ return the new list of manifest entries."
 
   (append to-upgrade to-install))
 
+(define (options->removable options manifest)
+  "Given options, return the list of manifest patterns of packages to be
+removed from MANIFEST."
+  (filter-map (match-lambda
+               (('remove . spec)
+                (call-with-values
+                    (lambda ()
+                      (package-specification->name+version+output spec))
+                  (lambda (name version output)
+                    (manifest-pattern
+                      (name name)
+                      (version version)
+                      (output output)))))
+               (_ #f))
+              options))
+
 
 ;;;
 ;;; Entry point.
@@ -989,44 +787,6 @@ more information.~%"))
          (and (equal? name entry-name)
               (equal? output entry-output)))))
 
-    (define (show-what-to-remove/install remove install dry-run?)
-      ;; Tell the user what's going to happen in high-level terms.
-      ;; TODO: Report upgrades more clearly.
-      (match remove
-        ((($ <manifest-entry> name version _ path _) ..1)
-         (let ((len    (length name))
-               (remove (map (cut format #f "  ~a-~a\t~a" <> <> <>)
-                            name version path)))
-           (if dry-run?
-               (format (current-error-port)
-                       (N_ "The following package would be removed:~% ~{~a~%~}~%"
-                           "The following packages would be removed:~% ~{~a~%~}~%"
-                           len)
-                       remove)
-               (format (current-error-port)
-                       (N_ "The following package will be removed:~% ~{~a~%~}~%"
-                           "The following packages will be removed:~% ~{~a~%~}~%"
-                           len)
-                       remove))))
-        (_ #f))
-      (match install
-        ((($ <manifest-entry> name version output path _) ..1)
-         (let ((len     (length name))
-               (install (map (cut format #f "   ~a-~a\t~a\t~a" <> <> <> <>)
-                             name version output path)))
-           (if dry-run?
-               (format (current-error-port)
-                       (N_ "The following package would be installed:~%~{~a~%~}~%"
-                           "The following packages would be installed:~%~{~a~%~}~%"
-                           len)
-                       install)
-               (format (current-error-port)
-                       (N_ "The following package will be installed:~%~{~a~%~}~%"
-                           "The following packages will be installed:~%~{~a~%~}~%"
-                           len)
-                       install))))
-        (_ #f)))
-
     (define current-generation-number
       (generation-number profile))
 
@@ -1095,16 +855,10 @@ more information.~%"))
             opts))
           (else
            (let* ((manifest (profile-manifest profile))
-                  (install* (options->installable opts manifest))
-                  (remove   (filter-map (match-lambda
-                                         (('remove . package)
-                                          package)
-                                         (_ #f))
-                                        opts))
-                  (remove*  (filter (cut manifest-installed? manifest <>)
-                                    remove))
+                  (install  (options->installable opts manifest))
+                  (remove   (options->removable opts manifest))
                   (entries
-                   (append install*
+                   (append install
                            (fold (lambda (package result)
                                    (match package
                                      (($ <manifest-entry> name _ out _ ...)
@@ -1114,7 +868,7 @@ more information.~%"))
                                               result))))
                                  (manifest-entries
                                   (manifest-remove manifest remove))
-                                 install*)))
+                                 install)))
                   (new      (make-manifest entries)))
 
              (when (equal? profile %current-profile)
@@ -1122,8 +876,9 @@ more information.~%"))
 
              (if (manifest=? new manifest)
                  (format (current-error-port) (_ "nothing to be done~%"))
-                 (let ((prof-drv (profile-derivation (%store) new)))
-                   (show-what-to-remove/install remove* install* dry-run?)
+                 (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?)
diff --git a/guix/ui.scm b/guix/ui.scm
index 7f8ed970d4..8a28574c3c 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -52,6 +52,7 @@
             fill-paragraph
             string->recutils
             package->recutils
+            package-specification->name+version+output
             string->generations
             string->duration
             args-fold*
@@ -136,6 +137,11 @@ messages."
   "Display version information for COMMAND and `(exit 0)'."
   (simple-format #t "~a (~a) ~a~%"
                  command %guix-package-name %guix-version)
+  (display (_ "Copyright (C) 2013 the Guix authors
+License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
+This is free software: you are free to change and redistribute it.
+There is NO WARRANTY, to the extent permitted by law.
+"))
   (exit 0))
 
 (define (show-bug-report-information)
@@ -358,6 +364,11 @@ converted to a space; sequences of more than one line break are preserved."
     ((_ _ chars)
      (list->string (reverse chars)))))
 
+
+;;;
+;;; Packages.
+;;;
+
 (define (string->recutils str)
   "Return a version of STR where newlines have been replaced by newlines
 followed by \"+ \", which makes for a valid multi-line field value in the
@@ -472,6 +483,31 @@ following patterns: \"1d\", \"1w\", \"1m\"."
            (hours->duration (* 24 30) match)))
         (else #f)))
 
+(define* (package-specification->name+version+output spec
+                                                     #:optional (output "out"))
+  "Parse package specification SPEC and return three value: the specified
+package name, version number (or #f), and output name (or OUTPUT).  SPEC may
+optionally contain a version number and an output name, as in these examples:
+
+  guile
+  guile-2.0.9
+  guile:debug
+  guile-2.0.9:debug
+"
+  (let*-values (((name sub-drv)
+                 (match (string-rindex spec #\:)
+                   (#f    (values spec output))
+                   (colon (values (substring spec 0 colon)
+                                  (substring spec (+ 1 colon))))))
+                ((name version)
+                 (package-name->name+version name)))
+    (values name version sub-drv)))
+
+
+;;;
+;;; Command-line option processing.
+;;;
+
 (define (args-fold* options unrecognized-option-proc operand-proc . seeds)
   "A wrapper on top of `args-fold' that does proper user-facing error
 reporting."