ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add "guix pull".

Browse source 
* guix/scripts/pull.scm: New file.
* Makefile.am (MODULES): Add it.
* doc/guix.texi (Invoking guix pull): New node.
  (Invoking guix package): Add cross-ref to it.
* guix/ui.scm (config-directory): New procedure.
* scripts/guix.in: When `GUIX_UNINSTALLED' is undefined, add
  $XDG_CONFIG_HOME/guix/latest to the search path.
* po/POTFILES.in: Add guix/scripts/pull.scm.
This commit is contained in:
Ludovic Courtès 2013-02-20 23:46:38 +01:00
parent 9bb2b96aab
commit f651b477b7
6 changed files with 288 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
Makefile.am
View file

@ -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 \

33
doc/guix.texi
View file

@ -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

222
guix/scripts/pull.scm Normal file
View file

@ -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))))))))

21
guix/ui.scm
View file

@ -41,6 +41,7 @@ (define-module (guix ui)
location->string
call-with-temporary-output-file
switch-symlinks
config-directory
fill-paragraph
string->recutils
package->recutils
@ -178,6 +179,26 @@ (define (switch-symlinks link target)
(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.

1
po/POTFILES.in
View file

@ -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

12
scripts/guix.in
View file

@ -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))