synchronize with trunk
svn path=/nixpkgs/branches/stdenv-updates/; revision=30186
This commit is contained in:
@@ -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)
|
||||
|
||||
Reference in New Issue
Block a user