diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | doc/guix.texi | 33 | ||||
| -rw-r--r-- | guix/scripts/pull.scm | 222 | ||||
| -rw-r--r-- | guix/ui.scm | 21 | ||||
| -rw-r--r-- | po/POTFILES.in | 1 | ||||
| -rw-r--r-- | scripts/guix.in | 12 |
6 files changed, 288 insertions, 2 deletions
diff --git a/Makefile.am b/Makefile.am index cabbe21cdd..bed4d06ec0 100644 --- a/Makefile.am +++ b/Makefile.am @@ -30,6 +30,7 @@ MODULES = \ guix/scripts/import.scm \ guix/scripts/package.scm \ guix/scripts/gc.scm \ + guix/scripts/pull.scm \ guix/base32.scm \ guix/utils.scm \ guix/derivations.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 9245bd00f5..6a9ebab1f6 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -393,6 +393,7 @@ management tools it provides. * Features:: How Guix will make your life brighter. * Invoking guix package:: Package installation, removal, etc. * Invoking guix gc:: Running the garbage collector. +* Invoking guix pull:: Fetching the latest Guix and distribution. @end menu @node Features @@ -521,6 +522,11 @@ Remove @var{package}. @itemx -u @var{regexp} Upgrade all the installed packages matching @var{regexp}. +Note that this upgrades package to the latest version of packages found +in the distribution currently installed. To update your distribution, +you should regularly run @command{guix pull} (@pxref{Invoking guix +pull}). + @item --roll-back Roll back to the previous @dfn{generation} of the profile---i.e., undo the last transaction. @@ -654,6 +660,33 @@ Show the list of live store files and directories. @end table +@node Invoking guix pull +@section Invoking @command{guix pull} + +Packages are installed or upgraded to the latest version available in +the distribution currently available on your local machine. To update +that distribution, along with the Guix tools, you must run @command{guix +pull}: the command downloads the latest Guix source code and package +descriptions, and deploys it. + +On completion, @command{guix package} will use packages and package +versions from this just-retrieved copy of Guix. Not only that, but all +the Guix commands and Scheme modules will also be taken from that latest +version. New @command{guix} sub-commands added by the update also +become available. + +The @command{guix pull} command is usually invoked with no arguments, +but it supports the following options: + +@table @code +@item --verbose +Produce verbose output, writing build logs to the standard error output. + +@item --bootstrap +Use the bootstrap Guile to build the latest Guix. This option is only +useful to Guix developers. +@end table + @c ********************************************************************* @node Programming Interface @chapter Programming Interface diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm new file mode 100644 index 0000000000..f12133fff7 --- /dev/null +++ b/guix/scripts/pull.scm @@ -0,0 +1,222 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.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 scripts pull) + #:use-module (guix ui) + #:use-module (guix store) + #:use-module (guix config) + #:use-module (guix packages) + #:use-module (guix derivations) + #:use-module (guix build download) + #:use-module (gnu packages base) + #:use-module ((gnu packages bootstrap) + #:select (%bootstrap-guile)) + #:use-module (gnu packages compression) + #:use-module (gnu packages gnupg) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:export (guix-pull)) + +(define %snapshot-url + "http://hydra.gnu.org/job/guix/master/tarball/latest/download" + ;;"http://git.savannah.gnu.org/cgit/guix.git/snapshot/guix-master.tar.gz" + ) + +(define (download-and-store store) + "Download the latest Guix tarball, add it to STORE, and return its store +path." + ;; FIXME: Authenticate the downloaded file! + ;; FIXME: Optimize data transfers using rsync, Git, bsdiff, or GNUnet's DHT. + (call-with-temporary-output-file + (lambda (temp port) + (let ((result + (parameterize ((current-output-port (current-error-port))) + (url-fetch %snapshot-url temp)))) + (close port) + (and result + (add-to-store store "guix-latest.tar.gz" #f "sha256" temp)))))) + +(define (unpack store tarball) + "Return a derivation that unpacks TARBALL into STORE and compiles Scheme +files." + (define builder + `(begin + (use-modules (guix build utils) + (system base compile) + (ice-9 ftw) + (ice-9 match)) + + (let ((out (assoc-ref %outputs "out")) + (tar (assoc-ref %build-inputs "tar")) + (gzip (assoc-ref %build-inputs "gzip")) + (gcrypt (assoc-ref %build-inputs "gcrypt")) + (tarball (assoc-ref %build-inputs "tarball"))) + (setenv "PATH" (string-append tar "/bin:" gzip "/bin")) + + (system* "tar" "xvf" tarball) + (match (scandir "." (lambda (name) + (and (not (member name '("." ".."))) + (file-is-directory? name)))) + ((dir) + (chdir dir)) + (x + (error "tarball did not produce a single source directory" x))) + + (format #t "copying and compiling Guix to `~a'...~%" out) + + ;; Copy everything under guix/ and gnu/ plus guix.scm. + (file-system-fold (lambda (dir stat result) ; enter? + (or (string-prefix? "./guix" dir) + (string-prefix? "./gnu" dir) + (string=? "." dir))) + (lambda (file stat result) ; leaf + (when (or (not (string=? (dirname file) ".")) + (string=? (basename file) "guix.scm")) + (let ((target (string-drop file 1))) + (copy-file file + (string-append out target))))) + (lambda (dir stat result) ; down + (mkdir (string-append out + (string-drop dir 1)))) + (const #t) ; up + (const #t) ; skip + (lambda (file stat errno result) + (error "cannot access file" + file (strerror errno))) + #f + "." + lstat) + + ;; Add a fake (guix config) module to allow the other modules to be + ;; compiled. The user's (guix config) is the one that will be used. + (copy-file "guix/config.scm.in" + (string-append out "/guix/config.scm")) + (substitute* (string-append out "/guix/config.scm") + (("@LIBGCRYPT@") + (string-append gcrypt "/lib/libgcrypt"))) + + ;; Augment the search path so Scheme code can be compiled. + (set! %load-path (cons out %load-path)) + (set! %load-compiled-path (cons out %load-compiled-path)) + + ;; Compile the .scm files. + (for-each (lambda (file) + (when (string-suffix? ".scm" file) + (let ((go (string-append (string-drop-right file 4) + ".go"))) + (compile-file file + #:output-file go + #:opts %auto-compilation-options)))) + (find-files out "\\.scm")) + + ;; Remove the "fake" (guix config). + (delete-file (string-append out "/guix/config.scm")) + (delete-file (string-append out "/guix/config.go"))))) + + (build-expression->derivation store "guix-latest" (%current-system) + builder + `(("tar" ,(package-derivation store tar)) + ("gzip" ,(package-derivation store gzip)) + ("gcrypt" ,(package-derivation store + libgcrypt)) + ("tarball" ,tarball)) + #:modules '((guix build utils)))) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + ;; Alist of default option values. + '()) + +(define (show-help) + (display (_ "Usage: guix pull [OPTION]... +Download and deploy the latest version of Guix.\n")) + (display (_ " + --verbose produce verbose output")) + (display (_ " + --bootstrap use the bootstrap Guile to build the new Guix")) + (newline) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specifications of the command-line options. + (list (option '("verbose") #f #f + (lambda (opt name arg result) + (alist-cons 'verbose? #t result))) + (option '("bootstrap") #f #f + (lambda (opt name arg result) + (alist-cons 'bootstrap? #t result))) + + (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix pull"))))) + +(define (guix-pull . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (leave (_ "~A: unexpected argument~%") arg)) + %default-options)) + + (let ((opts (parse-options)) + (store (open-connection))) + (with-error-handling + (let ((tarball (download-and-store store))) + (unless tarball + (leave (_ "failed to download up-to-date source, exiting\n"))) + (parameterize ((%guile-for-build + (package-derivation store + (if (assoc-ref opts 'bootstrap?) + %bootstrap-guile + guile-final))) + (current-build-output-port + (if (assoc-ref opts 'verbose?) + (current-error-port) + (%make-void-port "w")))) + (let*-values (((config-dir) + (config-directory)) + ((source drv) + (unpack store tarball)) + ((source-dir) + (derivation-output-path + (assoc-ref (derivation-outputs drv) "out")))) + (show-what-to-build store (list source)) + (if (build-derivations store (list source)) + (let ((latest (string-append config-dir "/latest"))) + (add-indirect-root store latest) + (switch-symlinks latest source-dir) + (format #t + (_ "updated ~a successfully deployed under `~a'~%") + %guix-package-name latest) + #t)))))))) diff --git a/guix/ui.scm b/guix/ui.scm index 2b75504573..7d1ea2bcbd 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -41,6 +41,7 @@ location->string call-with-temporary-output-file switch-symlinks + config-directory fill-paragraph string->recutils package->recutils @@ -178,6 +179,26 @@ both when LINK already exists and when it does not." (symlink target pivot) (rename-file pivot link))) +(define (config-directory) + "Return the name of the configuration directory, after making sure that it +exists. Honor the XDG specs, +<http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>." + (let ((dir (and=> (or (getenv "XDG_CONFIG_HOME") + (and=> (getenv "HOME") + (cut string-append <> "/.config"))) + (cut string-append <> "/guix")))) + (catch 'system-error + (lambda () + (mkdir dir) + dir) + (lambda args + (match (system-error-errno args) + ((or EEXIST 0) + dir) + (err + (leave (_ "failed to create configuration directory `~a': ~a~%") + dir (strerror err)))))))) + (define* (fill-paragraph str width #:optional (column 0)) "Fill STR such that each line contains at most WIDTH characters, assuming that the first character is at COLUMN. diff --git a/po/POTFILES.in b/po/POTFILES.in index 5c0f131c06..bdb894db20 100644 --- a/po/POTFILES.in +++ b/po/POTFILES.in @@ -8,4 +8,5 @@ guix/scripts/build.scm guix/scripts/download.scm guix/scripts/package.scm guix/scripts/gc.scm +guix/scripts/pull.scm guix/ui.scm diff --git a/scripts/guix.in b/scripts/guix.in index 2fdde7d13a..1315789a9c 100644 --- a/scripts/guix.in +++ b/scripts/guix.in @@ -22,7 +22,8 @@ ;; IMPORTANT: We must avoid loading any modules from Guix here, ;; because we need to adjust the guile load paths first. ;; It's okay to import modules from core Guile though. -(use-modules (ice-9 regex)) +(use-modules (ice-9 regex) + (srfi srfi-26)) (let () (define-syntax-rule (push! elt v) (set! v (cons elt v))) @@ -45,7 +46,14 @@ (unless (getenv "GUIX_UNINSTALLED") (let ((module-dir (config-lookup "guilemoduledir"))) (push! module-dir %load-path) - (push! module-dir %load-compiled-path)))) + (push! module-dir %load-compiled-path)) + (let ((updates-dir (and=> (or (getenv "XDG_CONFIG_HOME") + (and=> (getenv "HOME") + (cut string-append <> "/.config"))) + (cut string-append <> "/guix/latest")))) + (when (file-exists? updates-dir) + (push! updates-dir %load-path) + (push! updates-dir %load-compiled-path))))) (define (run-guix-main) (let ((guix-main (module-ref (resolve-interface '(guix ui)) |