synchronize with trunk

svn path=/nixpkgs/branches/stdenv-updates/; revision=30186
This commit is contained in:
Peter Simons
2011-11-02 10:28:32 +00:00
110 changed files with 830 additions and 520 deletions

View File

@@ -308,12 +308,17 @@ replaced by the result of their application to DERIVATIONS, a vhash."
;; DERIVATION lacks an "src" attribute.
(and=> (derivation-source derivation) source-output-path))
(define (open-nixpkgs nixpkgs)
(define* (open-nixpkgs nixpkgs #:optional attribute)
;; Return an input pipe to the XML representation of Nixpkgs. When
;; ATTRIBUTE is true, only that attribute is considered.
(let ((script (string-append nixpkgs
"/maintainers/scripts/eval-release.nix")))
(open-pipe* OPEN_READ "nix-instantiate"
"--strict" "--eval-only" "--xml"
script)))
(apply open-pipe* OPEN_READ
"nix-instantiate" "--strict" "--eval-only" "--xml"
`(,@(if attribute
`("-A" ,attribute)
'())
,script))))
(define (pipe-failed? pipe)
"Close pipe and return its status if it failed."
@@ -323,21 +328,36 @@ replaced by the result of their application to DERIVATIONS, a vhash."
status
#f)))
(define (nix-prefetch-url url)
;; Download URL in the Nix store and return the base32-encoded SHA256 hash
;; of the file at URL
(let* ((pipe (open-pipe* OPEN_READ "nix-prefetch-url" url))
(hash (read-line pipe)))
(if (or (pipe-failed? pipe)
(eof-object? hash))
(values #f #f)
(let* ((pipe (open-pipe* OPEN_READ "nix-store" "--print-fixed-path"
"sha256" hash (basename url)))
(path (read-line pipe)))
(if (or (pipe-failed? pipe)
(eof-object? path))
(values #f #f)
(values (string-trim-both hash) (string-trim-both path)))))))
(define (memoize proc)
"Return a memoizing version of PROC."
(let ((cache (make-hash-table)))
(lambda args
(let ((results (hash-ref cache args)))
(if results
(apply values results)
(let ((results (call-with-values (lambda ()
(apply proc args))
list)))
(hash-set! cache args results)
(apply values results)))))))
(define nix-prefetch-url
(memoize
(lambda (url)
"Download URL in the Nix store and return the base32-encoded SHA256 hash of
the file at URL."
(let* ((pipe (open-pipe* OPEN_READ "nix-prefetch-url" url))
(hash (read-line pipe)))
(if (or (pipe-failed? pipe)
(eof-object? hash))
(values #f #f)
(let* ((pipe (open-pipe* OPEN_READ "nix-store" "--print-fixed-path"
"sha256" hash (basename url)))
(path (read-line pipe)))
(if (or (pipe-failed? pipe)
(eof-object? path))
(values #f #f)
(values (string-trim-both hash) (string-trim-both path)))))))))
(define (update-nix-expression file
old-version old-hash
@@ -409,8 +429,7 @@ replaced by the result of their application to DERIVATIONS, a vhash."
(define %openpgp-key-server "keys.gnupg.net")
(define (gnupg-verify sig file)
"Verify signature SIG for FILE. Return a status s-exp or #f if GnuPG
failed."
"Verify signature SIG for FILE. Return a status s-exp if GnuPG failed."
(define (status-line->sexp line)
;; See file `doc/DETAILS' in GnuPG.
@@ -475,9 +494,10 @@ failed."
(let* ((pipe (open-pipe* OPEN_READ %gpg-command "--status-fd=1"
"--verify" sig file))
(status (parse-status pipe)))
(if (pipe-failed? pipe)
#f
status)))
;; Ignore PIPE's exit status since STATUS above should contain all the
;; info we need.
(close-pipe pipe)
status))
(define (gnupg-status-good-signature? status)
"If STATUS, as returned by `gnupg-verify', denotes a good signature, return
@@ -716,7 +736,8 @@ Return #t if the signature was good, #f otherwise."
(('attribute _ "description" value)
(string-prefix? "GNU" value))
(('attribute _ "homepage" (? string? value))
(string-contains value "www.gnu.org"))
(or (string-contains value "gnu.org")
(string-contains value "gnupg.org")))
(('attribute _ "homepage" ((? string? value) ...))
(any (cut string-contains <> "www.gnu.org") value))
(_ #f)))
@@ -749,6 +770,7 @@ Return #t if the signature was good, #f otherwise."
("libosip2" "ftp.gnu.org" "/gnu/osip" #f)
("libgcrypt" "ftp.gnupg.org" "/gcrypt" #t)
("libgpg-error" "ftp.gnupg.org" "/gcrypt" #t)
("libassuan" "ftp.gnupg.org" "/gcrypt" #t)
("freefont-ttf" "ftp.gnu.org" "/gnu/freefont" #f)
("gnupg" "ftp.gnupg.org" "/gcrypt" #t)
("gnu-ghostscript" "ftp.gnu.org" "/gnu/ghostscript" #f)
@@ -921,6 +943,7 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
gnu-packages))
(define (fetch-gnu project directory version archive-type)
"Download PROJECT's tarball over FTP."
(let* ((server (ftp-server/directory project))
(base (string-append project "-" version ".tar." archive-type))
(url (string-append "ftp://" server "/" directory "/" base))
@@ -963,12 +986,18 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
(format #t "~%")
(format #t " -x, --xml=FILE Read XML output of `nix-instantiate'~%")
(format #t " from FILE.~%")
(format #t " -A, --attribute=ATTR~%")
(format #t " Update only the package pointed to by attribute~%")
(format #t " ATTR.~%")
(format #t " -s, --select=SET Update only packages from SET, which may~%")
(format #t " be either `all', `stdenv', or `non-stdenv'.~%")
(format #t " -d, --dry-run Don't actually update Nix expressions~%")
(format #t " -h, --help Give this help list.~%~%")
(format #t "Report bugs to <ludo@gnu.org>~%")
(exit 0)))
(option '(#\A "attribute") #t #f
(lambda (opt name arg result)
(alist-cons 'attribute arg result)))
(option '(#\s "select") #t #f
(lambda (opt name arg result)
(cond ((string-ci=? arg "stdenv")
@@ -994,13 +1023,14 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
(define (gnupdate . args)
;; Assume Nixpkgs is under $NIXPKGS or ~/src/nixpkgs.
(define (nixpkgs->snix xml-file)
(define (nixpkgs->snix xml-file attribute)
(format (current-error-port) "evaluating Nixpkgs...~%")
(let* ((home (getenv "HOME"))
(xml (if xml-file
(open-input-file xml-file)
(open-nixpkgs (or (getenv "NIXPKGS")
(string-append home "/src/nixpkgs")))))
(string-append home "/src/nixpkgs"))
attribute)))
(snix (xml->snix xml)))
(if (not xml-file)
(let ((status (pipe-failed? xml)))
@@ -1009,7 +1039,34 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
(format (current-error-port) "`nix-instantiate' failed: ~A~%"
status)
(exit 1)))))
snix))
;; If we asked for a specific attribute, rewrap the thing in an
;; attribute set to match the expectations of `packages-to-update' & co.
(if attribute
(match snix
(('snix loc ('derivation args ...))
`(snix ,loc
(attribute-set
((attribute #f ,attribute
(derivation ,@args)))))))
snix)))
(define (selected-gnu-packages packages stdenv selection)
;; Return the subset of PACKAGES that are/aren't in STDENV, according to
;; SELECTION. To do that reliably, we check whether their "src"
;; derivation is a requisite of STDENV.
(define gnu
(gnu-packages packages))
(case selection
((stdenv)
gnu)
((non-stdenv)
(filter (lambda (p)
(not (member (package-source-output-path p)
(force stdenv))))
gnu))
(else gnu)))
(let* ((opts (args-fold (cdr args) %options
(lambda (opt name arg result)
@@ -1017,7 +1074,8 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
(lambda (operand result)
(error "extraneous argument `~A'" operand))
'()))
(snix (nixpkgs->snix (assoc-ref opts 'xml-file)))
(snix (nixpkgs->snix (assq-ref opts 'xml-file)
(assq-ref opts 'attribute)))
(packages (match snix
(('snix _ ('attribute-set attributes))
attributes)
@@ -1026,23 +1084,12 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
;; The source tarballs that make up stdenv.
(filter-map derivation-source-output-path
(package-requisites (stdenv-package packages)))))
(gnu (gnu-packages packages))
(gnu* (case (assoc-ref opts 'filter)
;; Filter out packages that are/aren't in `stdenv'. To
;; do that reliably, we check whether their "src"
;; derivation is a requisite of stdenv.
((stdenv)
(filter (lambda (p)
(member (package-source-output-path p)
(force stdenv)))
gnu))
((non-stdenv)
(filter (lambda (p)
(not (member (package-source-output-path p)
(force stdenv))))
gnu))
(else gnu)))
(updates (packages-to-update gnu*)))
(attribute (assq-ref opts 'attribute))
(selection (assq-ref opts 'filter))
(to-update (if attribute
packages ; already a subset
(selected-gnu-packages packages stdenv selection)))
(updates (packages-to-update to-update)))
(format #t "~%~A packages to update...~%" (length updates))
(for-each (lambda (update)