From a74da6b015f0c10534dd90186d841a720d5db7cd Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 28 Feb 2014 00:01:53 +0100 Subject: gnu-maintenance: Adjust 'latest-release' to filter Bash's patch directories. * guix/gnu-maintenance.scm (latest-release)[patch-directory-name?]: New procedure. : Use it to filter out Bash-like patch directories. --- guix/gnu-maintenance.scm | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 98432a69ce..14195da7ba 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2010, 2011, 2012, 2013 Ludovic Courtès +;;; Copyright © 2010, 2011, 2012, 2013, 2014 Ludovic Courtès ;;; Copyright © 2012, 2013 Nikita Karetnikov ;;; ;;; This file is part of GNU Guix. @@ -275,6 +275,10 @@ (define (latest a b) (define contains-digit? (cut string-any char-set:digit <>)) + (define patch-directory-name? + ;; Return #t for patch directory names such as 'bash-4.2-patches'. + (cut string-suffix? "patches" <>)) + (let-values (((server directory) (ftp-server/directory project))) (define conn (ftp-open server)) @@ -284,6 +288,9 @@ (define conn (ftp-open server)) ;; Filter out sub-directories that do not contain digits---e.g., ;; /gnuzilla/lang and /gnupg/patches. (subdirs (filter-map (match-lambda + (((? patch-directory-name? dir) + 'directory . _) + #f) (((? contains-digit? dir) 'directory . _) dir) (_ #f)) -- cgit v1.2.3 From 62b76320b40641fef3a23eca1e0916098ce09bde Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 28 Feb 2014 18:14:49 +0100 Subject: gnu: libgc: Change URLs to point to hboehm.info. * gnu/packages/bdw-gc.scm (libgc)[source, home-page, license]: Update URL. (libatomic-ops)[source, home-page]: Likewise. (libgc-7.4)[source]: Likewise. --- gnu/packages/bdw-gc.scm | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/gnu/packages/bdw-gc.scm b/gnu/packages/bdw-gc.scm index b223721520..1955cd3ee1 100644 --- a/gnu/packages/bdw-gc.scm +++ b/gnu/packages/bdw-gc.scm @@ -29,9 +29,8 @@ (define-public libgc (version "7.2d") (source (origin (method url-fetch) - (uri (string-append - "http://www.hpl.hp.com/personal/Hans_Boehm/gc/gc_source/gc-" - version ".tar.gz")) + (uri (string-append "http://www.hboehm.info/gc/gc_source/gc-" + version ".tar.gz")) (sha256 (base32 "0phwa5driahnpn79zqff14w9yc8sn3599cxz91m78hqdcpl0mznr")))) @@ -58,10 +57,9 @@ (define-public libgc Alternatively, the garbage collector may be used as a leak detector for C or C++ programs, though that is not its primary goal.") - (home-page "http://www.hpl.hp.com/personal/Hans_Boehm/gc/") + (home-page "http://www.hboehm.info/gc/") - (license - (x11-style "http://www.hpl.hp.com/personal/Hans_Boehm/gc/license.txt")))) + (license (x11-style (string-append home-page "license.txt"))))) (define-public libatomic-ops (package @@ -70,7 +68,7 @@ (define-public libatomic-ops (source (origin (method url-fetch) (uri (string-append - "http://www.hpl.hp.com/personal/Hans_Boehm/gc/gc_source/libatomic_ops-" + "http://www.hboehm.info/gc/gc_source/libatomic_ops-" version ".tar.gz")) (sha256 (base32 @@ -83,7 +81,7 @@ (define-public libatomic-ops memory update operations on a number architectures. These might allow you to write code that does more interesting things in signal handlers, write lock-free code, experiment with thread programming paradigms, etc.") - (home-page "http://www.hpl.hp.com/research/linux/atomic_ops/") + (home-page "https://github.com/ivmai/libatomic_ops/") ;; Some source files are X11-style, others are GPLv2+. (license gpl2+))) @@ -93,9 +91,8 @@ (define-public libgc-7.4 (version "7.4.0") (source (origin (method url-fetch) - (uri (string-append - "http://www.hpl.hp.com/personal/Hans_Boehm/gc/gc_source/gc-" - version ".tar.gz")) + (uri (string-append "http://www.hboehm.info/gc/gc_source/gc-" + version ".tar.gz")) (sha256 (base32 "10z2nph62ilab063wygg2lv0jxlsbcf2az9w1lx01jzqj5lzry31")))) -- cgit v1.2.3 From 36b56f081b5c84c48d2d5e47cab16ef2fefcc11a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 28 Feb 2014 22:31:16 +0100 Subject: guix archive: Change '--help' to show '--authorize'. * guix/scripts/archive.scm (show-help): Add '--authorize'. --- guix/scripts/archive.scm | 3 +++ 1 file changed, 3 insertions(+) diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 4788468584..8280a821c5 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -63,6 +63,9 @@ (define (show-help) (display (_ " --generate-key[=PARAMETERS] generate a key pair with the given parameters")) + (display (_ " + --authorize authorize imports signed by the public key on stdin")) + (newline) (display (_ " -e, --expression=EXPR build the package or derivation EXPR evaluates to")) (display (_ " -- cgit v1.2.3 From 165f4b2add7f292877d67d58c9f6cf9d1c137e70 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 1 Mar 2014 01:31:18 +0100 Subject: offload: Take the target machine load into account. * guix/scripts/offload.scm (machine-load, machine-less-loaded?, machine-less-loaded-or-faster?): New procedures. (choose-build-machine): Use 'machine-less-loaded-or-faster?' when sorting. Return the head of MACHINES unless it's loaded is >= 2. --- guix/scripts/offload.scm | 36 +++++++++++++++++++++++++++++++++--- 1 file changed, 33 insertions(+), 3 deletions(-) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 00a145e5e9..e48e31547a 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -268,15 +268,45 @@ (define (machine-faster? m1 m2) "Return #t if M1 is faster than M2." (> (build-machine-speed m1) (build-machine-speed m2))) +(define (machine-load machine) + "Return the load of MACHINE, divided by the number of parallel builds +allowed on MACHINE." + (let* ((pipe (remote-pipe machine OPEN_READ `("cat" "/proc/loadavg"))) + (line (read-line pipe))) + (close-pipe pipe) + (if (eof-object? line) + 1. + (match (string-tokenize line) + ((one five fifteen . _) + (let* ((raw (string->number five)) + (jobs (build-machine-parallel-builds machine)) + (normalized (/ raw jobs))) + (format (current-error-port) "load on machine '~a' is ~s\ + (normalized: ~s)~%" + (build-machine-name machine) raw normalized) + normalized)) + (_ + 1.))))) + +(define (machine-less-loaded? m1 m2) + "Return #t if the load on M1 is lower than that on M2." + (< (machine-load m1) (machine-load m2))) + +(define (machine-less-loaded-or-faster? m1 m2) + "Return #t if M1 is either less loaded or faster than M2." + (or (machine-less-loaded? m1 m2) + (machine-faster? m1 m2))) + (define (choose-build-machine requirements machines) "Return the best machine among MACHINES fulfilling REQUIREMENTS, or #f." - ;; FIXME: Take machine load into account, and/or shuffle MACHINES. (let ((machines (sort (filter (cut machine-matches? <> requirements) machines) - machine-faster?))) + machine-less-loaded-or-faster?))) (match machines ((head . _) - head) + ;; Return the best machine unless it's already overloaded. + (and (< (machine-load head) 2.) + head)) (_ #f)))) (define* (process-request wants-local? system drv features -- cgit v1.2.3 From aedbf9b8730b99790a49e3a01fbd59388fcc0c93 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 1 Mar 2014 12:15:47 +0100 Subject: offload: 'remote-pipe' uses the right SSH key. * guix/scripts/offload.scm (remote-pipe): Pass -i when invoking %LSHG-COMMAND. --- guix/scripts/offload.scm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index e48e31547a..5b971302f3 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -161,6 +161,10 @@ (define (remote-pipe machine mode command) (lambda () (apply open-pipe* mode %lshg-command "-l" (build-machine-user machine) "-z" + + ;; XXX: Remove '-i' when %LSHG-COMMAND really is lshg. + "-i" (build-machine-private-key machine) + (build-machine-name machine) command)) (lambda args -- cgit v1.2.3 From 1f7fd80032ef74015bb9a731e7c9a0a6d5d41f42 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 1 Mar 2014 12:24:39 +0100 Subject: offload: Comment out attempt to set up an lsh gateway. * guix/scripts/offload.scm (open-ssh-gateway): Comment out. (process-request): Remove call to 'open-ssh-gateway' and to 'kill'. --- guix/scripts/offload.scm | 116 +++++++++++++++++++++++------------------------ 1 file changed, 57 insertions(+), 59 deletions(-) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 5b971302f3..d5ee907c36 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -122,38 +122,40 @@ (define* (build-machines #:optional (file %machine-file)) (leave (_ "failed to load machine file '~a': ~s~%") file args)))))) -(define (open-ssh-gateway machine) - "Initiate an SSH connection gateway to MACHINE, and return the PID of the -running lsh gateway upon success, or #f on failure." - (catch 'system-error - (lambda () - (let* ((port (open-pipe* OPEN_READ %lsh-command - "-l" (build-machine-user machine) - "-i" (build-machine-private-key machine) - ;; XXX: With lsh 2.1, passing '--write-pid' - ;; last causes the PID not to be printed. - "--write-pid" "--gateway" "--background" "-z" - (build-machine-name machine))) - (line (read-line port)) - (status (close-pipe port))) - (if (zero? status) - (let ((pid (string->number line))) - (if (integer? pid) - pid - (begin - (warning (_ "'~a' did not write its PID on stdout: ~s~%") - %lsh-command line) - #f))) - (begin - (warning (_ "failed to initiate SSH connection to '~a':\ - '~a' exited with ~a~%") - (build-machine-name machine) - %lsh-command - (status:exit-val status)) - #f)))) - (lambda args - (leave (_ "failed to execute '~a': ~a~%") - %lsh-command (strerror (system-error-errno args)))))) +;;; FIXME: The idea was to open the connection to MACHINE once for all, but +;;; lshg is currently non-functional. +;; (define (open-ssh-gateway machine) +;; "Initiate an SSH connection gateway to MACHINE, and return the PID of the +;; running lsh gateway upon success, or #f on failure." +;; (catch 'system-error +;; (lambda () +;; (let* ((port (open-pipe* OPEN_READ %lsh-command +;; "-l" (build-machine-user machine) +;; "-i" (build-machine-private-key machine) +;; ;; XXX: With lsh 2.1, passing '--write-pid' +;; ;; last causes the PID not to be printed. +;; "--write-pid" "--gateway" "--background" "-z" +;; (build-machine-name machine))) +;; (line (read-line port)) +;; (status (close-pipe port))) +;; (if (zero? status) +;; (let ((pid (string->number line))) +;; (if (integer? pid) +;; pid +;; (begin +;; (warning (_ "'~a' did not write its PID on stdout: ~s~%") +;; %lsh-command line) +;; #f))) +;; (begin +;; (warning (_ "failed to initiate SSH connection to '~a':\ +;; '~a' exited with ~a~%") +;; (build-machine-name machine) +;; %lsh-command +;; (status:exit-val status)) +;; #f)))) +;; (lambda args +;; (leave (_ "failed to execute '~a': ~a~%") +;; %lsh-command (strerror (system-error-errno args)))))) (define (remote-pipe machine mode command) "Run COMMAND on MACHINE, assuming an lsh gateway has been set up." @@ -324,34 +326,30 @@ (define* (process-request wants-local? system drv features (features features))) (machine (choose-build-machine reqs (build-machines)))) (if machine - (match (open-ssh-gateway machine) - ((? integer? pid) - (display "# accept\n") - (let ((inputs (string-tokenize (read-line))) - (outputs (string-tokenize (read-line)))) - (when (send-files (cons (derivation-file-name drv) inputs) - machine) - (let ((status (offload drv machine - #:print-build-trace? print-build-trace? - #:max-silent-time max-silent-time - #:build-timeout build-timeout))) - (kill pid SIGTERM) - (if (zero? status) - (begin - (retrieve-files outputs machine) - (format (current-error-port) - "done with offloaded '~a'~%" - (derivation-file-name drv))) - (begin - (format (current-error-port) - "derivation '~a' offloaded to '~a' failed \ + (begin + (display "# accept\n") + (let ((inputs (string-tokenize (read-line))) + (outputs (string-tokenize (read-line)))) + (when (send-files (cons (derivation-file-name drv) inputs) + machine) + (let ((status (offload drv machine + #:print-build-trace? print-build-trace? + #:max-silent-time max-silent-time + #:build-timeout build-timeout))) + (if (zero? status) + (begin + (retrieve-files outputs machine) + (format (current-error-port) + "done with offloaded '~a'~%" + (derivation-file-name drv))) + (begin + (format (current-error-port) + "derivation '~a' offloaded to '~a' failed \ with exit code ~a~%" - (derivation-file-name drv) - (build-machine-name machine) - (status:exit-val status)) - (primitive-exit (status:exit-val status)))))))) - (#f - (display "# decline\n"))) + (derivation-file-name drv) + (build-machine-name machine) + (status:exit-val status)) + (primitive-exit (status:exit-val status)))))))) (display "# decline\n")))) (define-syntax-rule (with-nar-error-handling body ...) -- cgit v1.2.3 From 706e9e575d136299ef7d2623842c7a47dfbc6e27 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 1 Mar 2014 15:38:11 +0100 Subject: substitute-binary: Gracefully handle HTTP GET errors. * guix/http-client.scm (&http-get-error): New condition type. (http-fetch): Raise it instead of using 'error'. * guix/scripts/substitute-binary.scm (fetch) : Wrap body into 'guard' form; gracefully handle 'http-get-error?' conditions. --- guix/http-client.scm | 35 ++++++++++++++++++---- guix/scripts/substitute-binary.scm | 60 +++++++++++++++++++++----------------- 2 files changed, 62 insertions(+), 33 deletions(-) diff --git a/guix/http-client.scm b/guix/http-client.scm index 11231cbc1e..1f05df4b05 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; Copyright © 2012 Free Software Foundation, Inc. ;;; ;;; This file is part of GNU Guix. @@ -23,19 +23,36 @@ (define-module (guix http-client) #:use-module (web client) #:use-module (web response) #:use-module (srfi srfi-11) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (rnrs io ports) #:use-module (rnrs bytevectors) #:use-module (guix ui) #:use-module (guix utils) - #:export (open-socket-for-uri + #:export (&http-get-error + http-get-error? + http-get-error-uri + http-get-error-code + http-get-error-reason + + open-socket-for-uri http-fetch)) ;;; Commentary: ;;; -;;; HTTP client portable among Guile versions. +;;; HTTP client portable among Guile versions, and with proper error condition +;;; reporting. ;;; ;;; Code: +;; HTTP GET error. +(define-condition-type &http-get-error &error + http-get-error? + (uri http-get-error-uri) ; URI + (code http-get-error-code) ; integer + (reason http-get-error-reason)) ; string + + (define-syntax when-guile<=2.0.5 (lambda (s) (syntax-case s () @@ -154,7 +171,9 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)) "Return an input port containing the data at URI, and the expected number of bytes available or #f. If TEXT? is true, the data at URI is considered to be textual. Follow any HTTP redirection. When BUFFERED? is #f, return an -unbuffered port, suitable for use in `filtered-port'." +unbuffered port, suitable for use in `filtered-port'. + +Raise an '&http-get-error' condition if downloading fails." (let loop ((uri uri)) (let ((port (or port (open-socket-for-uri uri @@ -202,7 +221,11 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)) (uri->string uri)) (loop uri))) (else - (error "download failed" uri code - (response-reason-phrase resp)))))))) + (raise (condition (&http-get-error + (uri uri) + (code code) + (reason (response-reason-phrase resp))) + (&message + (message "download failed")))))))))) ;;; http-client.scm ends here diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm index 3aaa1c4284..54f4aaa6c0 100755 --- a/guix/scripts/substitute-binary.scm +++ b/guix/scripts/substitute-binary.scm @@ -38,6 +38,7 @@ (define-module (guix scripts substitute-binary) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) #:use-module (web uri) #:use-module (guix http-client) #:export (guix-substitute-binary)) @@ -133,33 +134,38 @@ (define* (fetch uri #:key (buffered? #t) (timeout? #t)) (if buffered? "rb" "r0b")))) (values port (stat:size (stat port))))) ((http) - ;; On Guile 2.0.5, `http-fetch' fetches the whole thing at once. So - ;; honor TIMEOUT? to disable the timeout when fetching a nar. - ;; - ;; Test this with: - ;; sudo tc qdisc add dev eth0 root netem delay 1500ms - ;; and then cancel with: - ;; sudo tc qdisc del dev eth0 root - (let ((port #f)) - (with-timeout (if (or timeout? (guile-version>? "2.0.5")) - %fetch-timeout - 0) - (begin - (warning (_ "while fetching ~a: server is unresponsive~%") - (uri->string uri)) - (warning (_ "try `--no-substitutes' if the problem persists~%")) - - ;; Before Guile v2.0.9-39-gfe51c7b, EINTR was reported to the user, - ;; and thus PORT had to be closed and re-opened. This is not the - ;; case afterward. - (unless (or (guile-version>? "2.0.9") - (version>? (version) "2.0.9.39")) - (when port - (close-port port)))) - (begin - (when (or (not port) (port-closed? port)) - (set! port (open-socket-for-uri uri #:buffered? buffered?))) - (http-fetch uri #:text? #f #:port port))))))) + (guard (c ((http-get-error? c) + (leave (_ "download from '~a' failed: ~a, ~s~%") + (uri->string (http-get-error-uri c)) + (http-get-error-code c) + (http-get-error-reason c)))) + ;; On Guile 2.0.5, `http-fetch' fetches the whole thing at once. So + ;; honor TIMEOUT? to disable the timeout when fetching a nar. + ;; + ;; Test this with: + ;; sudo tc qdisc add dev eth0 root netem delay 1500ms + ;; and then cancel with: + ;; sudo tc qdisc del dev eth0 root + (let ((port #f)) + (with-timeout (if (or timeout? (guile-version>? "2.0.5")) + %fetch-timeout + 0) + (begin + (warning (_ "while fetching ~a: server is unresponsive~%") + (uri->string uri)) + (warning (_ "try `--no-substitutes' if the problem persists~%")) + + ;; Before Guile v2.0.9-39-gfe51c7b, EINTR was reported to the user, + ;; and thus PORT had to be closed and re-opened. This is not the + ;; case afterward. + (unless (or (guile-version>? "2.0.9") + (version>? (version) "2.0.9.39")) + (when port + (close-port port)))) + (begin + (when (or (not port) (port-closed? port)) + (set! port (open-socket-for-uri uri #:buffered? buffered?))) + (http-fetch uri #:text? #f #:port port)))))))) (define-record-type (%make-cache url store-directory wants-mass-query?) -- cgit v1.2.3 From 00ee3a712f693a5c31af55d10e95db12b1199c3b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 1 Mar 2014 15:41:18 +0100 Subject: gnu: guile-ssh: Upgrade to 0.5.0. * gnu/packages/ssh.scm (guile-ssh): Upgrade to 0.5.0. [arguments]: Adjust 'autoreconf' phase. Add #:parallel-tests? #f and #:tests? #f. [native-inputs]: Add TEXINFO. --- gnu/packages/ssh.scm | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/gnu/packages/ssh.scm b/gnu/packages/ssh.scm index 41ceeb6cef..6bf68a916e 100644 --- a/gnu/packages/ssh.scm +++ b/gnu/packages/ssh.scm @@ -27,6 +27,7 @@ (define-module (gnu packages ssh) #:use-module (gnu packages guile) #:use-module (gnu packages pkg-config) #:use-module (gnu packages autotools) + #:use-module (gnu packages texinfo) #:use-module (gnu packages which) #:use-module (guix packages) #:use-module (guix download) @@ -185,7 +186,7 @@ (define-public openssh (define-public guile-ssh (package (name "guile-ssh") - (version "0.4.0") + (version "0.5.0") (source (origin (method url-fetch) (uri (string-append @@ -193,13 +194,13 @@ (define-public guile-ssh version ".tar.gz")) (sha256 (base32 - "0vw02r261amkp6238cflww2y9y1v6vfx9ias6hvn8dlx0ghrd5dw")))) + "13wk2fj08b8zjylvf78l3d9pf8y3zqcd7h75jf15a46iprk00n7q")))) (build-system gnu-build-system) (arguments '(#:phases (alist-cons-before 'configure 'autoreconf (lambda* (#:key inputs #:allow-other-keys) - (substitute* "src/Makefile.am" + (substitute* "ssh/Makefile.am" (("-lssh_threads" match) (string-append "-L" (assoc-ref inputs "libssh") "/lib " match))) @@ -223,10 +224,17 @@ (define-public guile-ssh %standard-phases)) #:configure-flags (list (string-append "--with-guilesitedir=" (assoc-ref %outputs "out") - "/share/guile/site/2.0")))) + "/share/guile/site/2.0")) + + ;; Two client/server tests use the same port. + #:parallel-tests? #f + + ;; XXX: There are test failures reported and being fixed. + #:tests? #f)) (native-inputs `(("autoconf" ,autoconf) ("automake" ,automake) ("libtool" ,libtool "bin") + ("texinfo" ,texinfo) ("pkg-config" ,pkg-config) ("which" ,which))) (inputs `(("guile" ,guile-2.0) -- cgit v1.2.3 From dd67b429e1644407a928a8c12ab7649bf9c50145 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 1 Mar 2014 18:29:29 +0100 Subject: guix package: Use the common build options from (guix scripts build). * guix/scripts/build.scm (%standard-build-options): Change option handlers to support multiple seeds. * guix/scripts/package.scm (show-help): Remove --dry-run, --fallback, --no-substitutes, and --max-silent-time. (%options): Likewise, and add %STANDARD-BUILD-OPTIONS. (%default-options): Add 'verbosity'. (guix-package): Call 'set-build-options-from-command-line' instead of 'set-build-options'. --- guix/scripts/build.scm | 50 ++++++----- guix/scripts/package.scm | 212 +++++++++++++++++++++-------------------------- 2 files changed, 125 insertions(+), 137 deletions(-) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 4a00505022..14b8f2d6bd 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -147,34 +147,46 @@ (define (set-build-options-from-command-line store opts) (define %standard-build-options ;; List of standard command-line options for tools that build something. (list (option '(#\K "keep-failed") #f #f - (lambda (opt name arg result) - (alist-cons 'keep-failed? #t result))) + (lambda (opt name arg result . rest) + (apply values + (alist-cons 'keep-failed? #t result) + rest))) (option '("fallback") #f #f - (lambda (opt name arg result) - (alist-cons 'fallback? #t - (alist-delete 'fallback? result)))) + (lambda (opt name arg result . rest) + (apply values + (alist-cons 'fallback? #t + (alist-delete 'fallback? result)) + rest))) (option '("no-substitutes") #f #f - (lambda (opt name arg result) - (alist-cons 'substitutes? #f - (alist-delete 'substitutes? result)))) + (lambda (opt name arg result . rest) + (apply values + (alist-cons 'substitutes? #f + (alist-delete 'substitutes? result)) + rest))) (option '("no-build-hook") #f #f - (lambda (opt name arg result) - (alist-cons 'build-hook? #f - (alist-delete 'build-hook? result)))) + (lambda (opt name arg result . rest) + (apply values + (alist-cons 'build-hook? #f + (alist-delete 'build-hook? result)) + rest))) (option '("max-silent-time") #t #f - (lambda (opt name arg result) - (alist-cons 'max-silent-time (string->number* arg) - result))) + (lambda (opt name arg result . rest) + (apply values + (alist-cons 'max-silent-time (string->number* arg) + result) + rest))) (option '("verbosity") #t #f - (lambda (opt name arg result) + (lambda (opt name arg result . rest) (let ((level (string->number arg))) - (alist-cons 'verbosity level - (alist-delete 'verbosity result))))) + (apply values + (alist-cons 'verbosity level + (alist-delete 'verbosity result)) + rest)))) (option '(#\c "cores") #t #f - (lambda (opt name arg result) + (lambda (opt name arg result . rest) (let ((c (false-if-exception (string->number arg)))) (if c - (alist-cons 'cores c result) + (apply values (alist-cons 'cores c result) rest) (leave (_ "~a: not a number~%") arg))))))) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index d41a83de8a..6069b203de 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -26,6 +26,7 @@ (define-module (guix scripts package) #:use-module (guix profiles) #:use-module (guix utils) #:use-module (guix config) + #:use-module (guix scripts build) #:use-module ((guix build utils) #:select (directory-exists? mkdir-p)) #:use-module ((guix ftp-client) #:select (ftp-open)) #:use-module (ice-9 format) @@ -460,6 +461,7 @@ (define %default-options ;; Alist of default option values. `((profile . ,%current-profile) (max-silent-time . 3600) + (verbosity . 0) (substitutes? . #t))) (define (show-help) @@ -484,18 +486,9 @@ (define (show-help) (display (_ " -d, --delete-generations[=PATTERN] delete generations matching PATTERN")) - (newline) (display (_ " -p, --profile=PROFILE use PROFILE instead of the user's default profile")) - (display (_ " - -n, --dry-run show what would be done without actually doing it")) - (display (_ " - --fallback fall back to building when the substituter fails")) - (display (_ " - --no-substitutes build instead of resorting to pre-built substitutes")) - (display (_ " - --max-silent-time=SECONDS - mark the build as failed after SECONDS of silence")) + (newline) (display (_ " --bootstrap use the bootstrap Guile to build the profile")) (display (_ " @@ -510,6 +503,8 @@ (define (show-help) -A, --list-available[=REGEXP] list available packages matching REGEXP")) (newline) + (show-build-options-help) + (newline) (display (_ " -h, --help display this help and exit")) (display (_ " @@ -519,107 +514,94 @@ (define (show-help) (define %options ;; Specification of the command-line options. - (list (option '(#\h "help") #f #f - (lambda args - (show-help) - (exit 0))) - (option '(#\V "version") #f #f - (lambda args - (show-version-and-exit "guix package"))) - - (option '(#\i "install") #f #t - (lambda (opt name arg result arg-handler) - (let arg-handler ((arg arg) (result result)) - (values (if arg - (alist-cons 'install arg result) - result) - arg-handler)))) - (option '(#\e "install-from-expression") #t #f - (lambda (opt name arg result arg-handler) - (values (alist-cons 'install (read/eval-package-expression arg) - result) - #f))) - (option '(#\r "remove") #f #t - (lambda (opt name arg result arg-handler) - (let arg-handler ((arg arg) (result result)) - (values (if arg - (alist-cons 'remove arg result) - result) - arg-handler)))) - (option '(#\u "upgrade") #f #t - (lambda (opt name arg result arg-handler) - (let arg-handler ((arg arg) (result result)) - (values (alist-cons 'upgrade arg - ;; Delete any prior "upgrade all" - ;; command, or else "--upgrade gcc" - ;; would upgrade everything. - (delete '(upgrade . #f) result)) - arg-handler)))) - (option '("roll-back") #f #f - (lambda (opt name arg result arg-handler) - (values (alist-cons 'roll-back? #t result) - #f))) - (option '(#\l "list-generations") #f #t - (lambda (opt name arg result arg-handler) - (values (cons `(query list-generations ,(or arg "")) - result) - #f))) - (option '(#\d "delete-generations") #f #t - (lambda (opt name arg result arg-handler) - (values (alist-cons 'delete-generations (or arg "") - result) - #f))) - (option '("search-paths") #f #f - (lambda (opt name arg result arg-handler) - (values (cons `(query search-paths) result) - #f))) - (option '(#\p "profile") #t #f - (lambda (opt name arg result arg-handler) - (values (alist-cons 'profile arg - (alist-delete 'profile result)) - #f))) - (option '(#\n "dry-run") #f #f - (lambda (opt name arg result arg-handler) - (values (alist-cons 'dry-run? #t result) - #f))) - (option '("fallback") #f #f - (lambda (opt name arg result arg-handler) - (values (alist-cons 'fallback? #t - (alist-delete 'fallback? result)) - #f))) - (option '("no-substitutes") #f #f - (lambda (opt name arg result arg-handler) - (values (alist-cons 'substitutes? #f - (alist-delete 'substitutes? result)) - #f))) - (option '("max-silent-time") #t #f - (lambda (opt name arg result arg-handler) - (values (alist-cons 'max-silent-time (string->number* arg) - result) - #f))) - (option '("bootstrap") #f #f - (lambda (opt name arg result arg-handler) - (values (alist-cons 'bootstrap? #t result) - #f))) - (option '("verbose") #f #f - (lambda (opt name arg result arg-handler) - (values (alist-cons 'verbose? #t result) - #f))) - (option '(#\s "search") #t #f - (lambda (opt name arg result arg-handler) - (values (cons `(query search ,(or arg "")) - result) - #f))) - (option '(#\I "list-installed") #f #t - (lambda (opt name arg result arg-handler) - (values (cons `(query list-installed ,(or arg "")) - result) - #f))) - (option '(#\A "list-available") #f #t - (lambda (opt name arg result arg-handler) - (values (cons `(query list-available ,(or arg "")) - result) - #f))))) + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix package"))) + + (option '(#\i "install") #f #t + (lambda (opt name arg result arg-handler) + (let arg-handler ((arg arg) (result result)) + (values (if arg + (alist-cons 'install arg result) + result) + arg-handler)))) + (option '(#\e "install-from-expression") #t #f + (lambda (opt name arg result arg-handler) + (values (alist-cons 'install (read/eval-package-expression arg) + result) + #f))) + (option '(#\r "remove") #f #t + (lambda (opt name arg result arg-handler) + (let arg-handler ((arg arg) (result result)) + (values (if arg + (alist-cons 'remove arg result) + result) + arg-handler)))) + (option '(#\u "upgrade") #f #t + (lambda (opt name arg result arg-handler) + (let arg-handler ((arg arg) (result result)) + (values (alist-cons 'upgrade arg + ;; Delete any prior "upgrade all" + ;; command, or else "--upgrade gcc" + ;; would upgrade everything. + (delete '(upgrade . #f) result)) + arg-handler)))) + (option '("roll-back") #f #f + (lambda (opt name arg result arg-handler) + (values (alist-cons 'roll-back? #t result) + #f))) + (option '(#\l "list-generations") #f #t + (lambda (opt name arg result arg-handler) + (values (cons `(query list-generations ,(or arg "")) + result) + #f))) + (option '(#\d "delete-generations") #f #t + (lambda (opt name arg result arg-handler) + (values (alist-cons 'delete-generations (or arg "") + result) + #f))) + (option '("search-paths") #f #f + (lambda (opt name arg result arg-handler) + (values (cons `(query search-paths) result) + #f))) + (option '(#\p "profile") #t #f + (lambda (opt name arg result arg-handler) + (values (alist-cons 'profile arg + (alist-delete 'profile result)) + #f))) + (option '(#\n "dry-run") #f #f + (lambda (opt name arg result arg-handler) + (values (alist-cons 'dry-run? #t result) + #f))) + (option '("bootstrap") #f #f + (lambda (opt name arg result arg-handler) + (values (alist-cons 'bootstrap? #t result) + #f))) + (option '("verbose") #f #f + (lambda (opt name arg result arg-handler) + (values (alist-cons 'verbose? #t result) + #f))) + (option '(#\s "search") #t #f + (lambda (opt name arg result arg-handler) + (values (cons `(query search ,(or arg "")) + result) + #f))) + (option '(#\I "list-installed") #f #t + (lambda (opt name arg result arg-handler) + (values (cons `(query list-installed ,(or arg "")) + result) + #f))) + (option '(#\A "list-available") #f #t + (lambda (opt name arg result arg-handler) + (values (cons `(query list-available ,(or arg "")) + result) + #f))) + + %standard-build-options)) (define (options->installable opts manifest) "Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold', @@ -1052,13 +1034,7 @@ (define (list-generation number) (or (process-query opts) (with-error-handling (parameterize ((%store (open-connection))) - (set-build-options (%store) - #:print-build-trace #f - #:fallback? (assoc-ref opts 'fallback?) - #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:max-silent-time - (assoc-ref opts 'max-silent-time)) + (set-build-options-from-command-line (%store) opts) (parameterize ((%guile-for-build (package-derivation (%store) -- cgit v1.2.3 From dc91c10f2bc21982f26a9f90721f23b79b5668b7 Mon Sep 17 00:00:00 2001 From: Manolis Ragkousis Date: Sat, 1 Mar 2014 14:48:09 +0000 Subject: gnu: hurd: Add Hurd headers. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/hurd.scm (hurd-headers): New variable. Co-authored-by: Ludovic Courtès Signed-off-by: Ludovic Courtès --- gnu/packages/hurd.scm | 44 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 43 insertions(+), 1 deletion(-) diff --git a/gnu/packages/hurd.scm b/gnu/packages/hurd.scm index 3edccbdd1c..f1e7dbc9dc 100644 --- a/gnu/packages/hurd.scm +++ b/gnu/packages/hurd.scm @@ -22,7 +22,9 @@ (define-module (gnu packages hurd) #:use-module (guix packages) #:use-module (guix build-system gnu) #:use-module (gnu packages flex) - #:use-module (gnu packages bison)) + #:use-module (gnu packages bison) + #:use-module (gnu packages perl) + #:use-module (gnu packages autotools)) (define-public gnumach-headers (package @@ -86,3 +88,43 @@ (define-public mig for other software in the GNU system that uses Mach-based inter-process communication.") (license gpl2+))) + +(define-public hurd-headers + (package + (name "hurd-headers") + (version "0.5") + (source (origin + (method url-fetch) + (uri (string-append "mirror://gnu/hurd/hurd-" + version ".tar.gz")) + (sha256 + (base32 + "0lvkz3r0ngb4bsn2hzdc9vjpyrfa3ls36jivrvy1n7f7f55zan7q")))) + (build-system gnu-build-system) + (native-inputs + `(;; Autoconf shouldn't be necessary but there seems to be a bug in the + ;; build system triggering its use. + ("autoconf" ,autoconf) + + ("mig" ,mig))) + (arguments + `(#:phases (alist-replace + 'install + (lambda _ + (zero? (system* "make" "install-headers" "no_deps=t"))) + (alist-delete 'build %standard-phases)) + + #:configure-flags '(;; Pretend we're on GNU/Hurd; 'configure' wants + ;; that. + "--host=i686-pc-gnu" + + ;; Reduce set of dependencies. + "--without-parted") + + #:tests? #f)) + (home-page "http://www.gnu.org/software/hurd/hurd.html") + (synopsis "GNU Hurd headers") + (description + "This package provides C headers of the GNU Hurd, used to build the GNU C +Library and other user programs.") + (license gpl2+))) -- cgit v1.2.3 From fc1e45160e40c846f2f332d3552b314b912d3055 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 2 Mar 2014 13:48:28 +0100 Subject: gnu: Add neon. * gnu/packages/version-control.scm (neon): New variable. --- gnu/packages/version-control.scm | 54 ++++++++++++++++++++++++++++++++++++++-- 1 file changed, 52 insertions(+), 2 deletions(-) diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 3d69eee5cd..39d37a7645 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2013 Cyril Roelandt ;;; Copyright © 2013, 2014 Ludovic Courtès -;;; Copyright © 2013 Andreas Enge +;;; Copyright © 2013, 2014 Andreas Enge ;;; ;;; This file is part of GNU Guix. ;;; @@ -26,13 +26,15 @@ (define-module (gnu packages version-control) #:use-module (guix build-system gnu) #:use-module (guix build-system python) #:use-module (guix build utils) - #:use-module (gnu packages gettext) #:use-module (gnu packages apr) #:use-module (gnu packages curl) #:use-module (gnu packages ed) + #:use-module (gnu packages gettext) +;; #:use-module (gnu packages gnutls) #:use-module (gnu packages nano) #:use-module (gnu packages openssl) #:use-module (gnu packages perl) + #:use-module (gnu packages pkg-config) #:use-module (gnu packages python) #:use-module (gnu packages sqlite) #:use-module (gnu packages admin) @@ -216,6 +218,54 @@ (define-public mercurial and offers an easy and intuitive interface.") (license gpl2+))) +(define-public neon + (package + (name "neon") + (version "0.30.0") + (source (origin + (method url-fetch) + (uri (string-append "http://www.webdav.org/neon/neon-" + version ".tar.gz")) + (sha256 + (base32 + "1hlhg5w505jxdvaf7bq17057f6a48dry981g7lp2gwrhbp5wyqi9")))) + (build-system gnu-build-system) + (native-inputs + `(("perl" ,perl) + ("pkg-config" ,pkg-config))) + (inputs + `(("libxml2" ,libxml2) + ("openssl" ,openssl) + ("zlib" ,zlib))) + (arguments + `(;; FIXME: Add tests once reverse address lookup is fixed in glibc, see + ;; https://sourceware.org/bugzilla/show_bug.cgi?id=16475 + #:tests? #f + #:configure-flags '("--enable-shared" + ;; requires libgnutils-config, deprecated + ;; in gnutls 2.8. + ; "--with-ssl=gnutls"))) + "--with-ssl=openssl"))) + (home-page "http://www.webdav.org/neon/") + (synopsis "HTTP and WebDAV client library") + (description "Neon is an HTTP and WebDAV client library, with a +C interface. Features: +High-level wrappers for common HTTP and WebDAV operations (GET, MOVE, +DELETE, etc.); +low-level interface to the HTTP request/response engine, allowing the use +of arbitrary HTTP methods, headers, etc.; +authentication support including Basic and Digest support, along with +GSSAPI-based Negotiate on Unix, and SSPI-based Negotiate/NTLM on Win32; +SSL/TLS support using OpenSSL or GnuTLS, exposing an abstraction layer for +verifying server certificates, handling client certificates, and examining +certificate properties, smartcard-based client certificates are also +supported via a PKCS#11 wrapper interface; +abstract interface to parsing XML using libxml2 or expat, and wrappers for +simplifying handling XML HTTP response bodies; +WebDAV metadata support, wrappers for PROPFIND and PROPPATCH to simplify +property manipulation.") + (license gpl2+))) ; for documentation and tests; source under lgpl2.0+ + (define-public subversion (package (name "subversion") -- cgit v1.2.3 From d56052bd8050778464e0f61a1ccfdb7a621c210c Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 2 Mar 2014 14:03:00 +0100 Subject: gnu: Add neon-0.29.6. * gnu/packages/version-control.scm (neon-0.29.6): New variable. --- gnu/packages/version-control.scm | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 39d37a7645..f4f2afd5d5 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -266,6 +266,18 @@ (define-public neon property manipulation.") (license gpl2+))) ; for documentation and tests; source under lgpl2.0+ +(define-public neon-0.29.6 + (package (inherit neon) + (name "neon") + (version "0.29.6") + (source (origin + (method url-fetch) + (uri (string-append "http://www.webdav.org/neon/neon-" + version ".tar.gz")) + (sha256 + (base32 + "0hzbjqdx1z8zw0vmbknf159wjsxbcq8ii0wgwkqhxj3dimr0nr4w")))))) + (define-public subversion (package (name "subversion") -- cgit v1.2.3 From 98b79d361c66425b7a71fc66c043e44910efc9a1 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 2 Mar 2014 14:12:40 +0100 Subject: gnu: subversion: Enable http checkouts. * gnu/packages/version-control.scm (subversion): Add input neon-0.29.6 to enable http and https checkouts. --- gnu/packages/version-control.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index f4f2afd5d5..708856ab93 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -312,11 +312,13 @@ (define-public subversion (system* "make" "install"))))))) %standard-phases))) (native-inputs - ;; For the Perl bindings. - `(("swig" ,swig))) + `(("pkg-config" ,pkg-config) + ;; For the Perl bindings. + ("swig" ,swig))) (inputs `(("apr" ,apr) ("apr-util" ,apr-util) + ("neon" ,neon-0.29.6) ("perl" ,perl) ("python" ,python-2) ; incompatible with Python 3 (print syntax) ("sqlite" ,sqlite) -- cgit v1.2.3 From ebb7aeff800c805134869abebb3300e341a6415f Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 2 Mar 2014 15:09:59 +0100 Subject: gnu: subversion: Update to 1.7.14. * gnu/packages/version-control.scm (subversion): Update to 1.7.14. --- gnu/packages/version-control.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index 708856ab93..41df90b8a7 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -281,14 +281,14 @@ (define-public neon-0.29.6 (define-public subversion (package (name "subversion") - (version "1.7.8") + (version "1.7.14") (source (origin (method url-fetch) (uri (string-append "http://archive.apache.org/dist/subversion/subversion-" version ".tar.bz2")) (sha256 (base32 - "11inl9n1riahfnbk1fax0dysm2swakzhzhpmm2zvga6fikcx90zw")))) + "038jbcpwm083abp0rvk0fhnx65kp9mz1qvzs3f83ig8fxcvqzb64")))) (build-system gnu-build-system) (arguments '(#:phases (alist-cons-after -- cgit v1.2.3 From 70ee564299c257501405b920580dea676275dd78 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 2 Mar 2014 23:15:31 +0100 Subject: doc: Factorize documentation of common build options. * doc/guix.texi (Invoking guix package): Remove documentation for --dry-run, --fallback, --no-substitutes, and --max-silent-time. Add a cross-ref to "Invoking guix build". (Invoking guix archive): Add "common build options" as the cross-ref topic for "Invoking guix build". (Invoking guix build): Move common build options separately. Add a paragraph to explain. --- doc/guix.texi | 81 +++++++++++++++++++++++++++++------------------------------ 1 file changed, 40 insertions(+), 41 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 78736fadf2..baa1990484 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -789,21 +789,6 @@ suggest setting these variables to @code{@var{profile}/include} and @itemx -p @var{profile} Use @var{profile} instead of the user's default profile. -@item --dry-run -@itemx -n -Show what would be done without actually doing it. - -@item --fallback -When substituting a pre-built binary fails, fall back to building -packages locally. - -@item --no-substitutes -Do not use substitutes for build products. That is, always build things -locally instead of allowing downloads of pre-built binaries. - -@item --max-silent-time=@var{seconds} -Same as for @command{guix build} (@pxref{Invoking guix build}). - @item --verbose Produce verbose output. In particular, emit the environment's build log on the standard error port. @@ -918,6 +903,10 @@ Consequently, this command must be used with care. @end table +Finally, since @command{guix package} may actually start build +processes, it supports all the common build options that @command{guix +build} supports (@pxref{Invoking guix build, common build options}). + @node Packages with Multiple Outputs @section Packages with Multiple Outputs @@ -1176,7 +1165,7 @@ guix archive --export git:gui /nix/store/...-emacs-24.3 > great.nar If the specified packages are not built yet, @command{guix archive} automatically builds them. The build process may be controlled with the same options that can be passed to the @command{guix build} command -(@pxref{Invoking guix build}). +(@pxref{Invoking guix build, common build options}). @c ********************************************************************* @@ -1843,6 +1832,37 @@ configuration triplets,, configure, GNU Configure and Build System}). Return the derivation paths, not the output paths, of the given packages. +@item --root=@var{file} +@itemx -r @var{file} +Make @var{file} a symlink to the result, and register it as a garbage +collector root. + +@item --log-file +Return the build log file names for the given +@var{package-or-derivation}s, or raise an error if build logs are +missing. + +This works regardless of how packages or derivations are specified. For +instance, the following invocations are equivalent: + +@example +guix build --log-file `guix build -d guile` +guix build --log-file `guix build guile` +guix build --log-file guile +guix build --log-file -e '(@@ (gnu packages guile) guile-2.0)' +@end example + + +@end table + +@cindex common build options +In addition, a number of options that control the build process are +common to @command{guix build} and other commands that can spawn builds, +such as @command{guix package} or @command{guix archive}. These are the +following: + +@table @code + @item --keep-failed @itemx -K Keep the build tree of failed builds. Thus, if a build fail, its build @@ -1870,36 +1890,15 @@ instead of offloading builds to remote machines. When the build or substitution process remains silent for more than @var{seconds}, terminate it and report a build failure. -@item --cores=@var{n} -@itemx -c @var{n} -Allow the use of up to @var{n} CPU cores for the build. The special -value @code{0} means to use as many CPU cores as available. - -@item --root=@var{file} -@itemx -r @var{file} -Make @var{file} a symlink to the result, and register it as a garbage -collector root. - @item --verbosity=@var{level} Use the given verbosity level. @var{level} must be an integer between 0 and 5; higher means more verbose output. Setting a level of 4 or more may be helpful when debugging setup issues with the build daemon. -@item --log-file -Return the build log file names for the given -@var{package-or-derivation}s, or raise an error if build logs are -missing. - -This works regardless of how packages or derivations are specified. For -instance, the following invocations are equivalent: - -@example -guix build --log-file `guix build -d guile` -guix build --log-file `guix build guile` -guix build --log-file guile -guix build --log-file -e '(@@ (gnu packages guile) guile-2.0)' -@end example - +@item --cores=@var{n} +@itemx -c @var{n} +Allow the use of up to @var{n} CPU cores for the build. The special +value @code{0} means to use as many CPU cores as available. @end table -- cgit v1.2.3 From 8deeda0c35d1ca07d5cbd17dfa5180cb36b7493b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 3 Mar 2014 00:22:33 +0100 Subject: gnu: Add ElementTree and pybugz. * gnu/packages/python.scm (python2-element-tree, python2-pybugz): New variables. --- gnu/packages/python.scm | 52 ++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 51 insertions(+), 1 deletion(-) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 44e3c14aa2..ad1ac5c8f7 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -20,7 +20,8 @@ (define-module (gnu packages python) #:use-module ((guix licenses) - #:select (bsd-3 bsd-style psfl x11 gpl2+ lgpl2.1+)) + #:select (bsd-3 bsd-style psfl x11 x11-style + gpl2 gpl2+ lgpl2.1+)) #:use-module ((guix licenses) #:select (zlib) #:renamer (symbol-prefix-proc 'license:)) #:use-module (gnu packages) @@ -505,6 +506,55 @@ (define-public python2-empy commands.") (license lgpl2.1+))) +(define-public python2-element-tree + (package + (name "python2-element-tree") + (version "1.2.6") + (source (origin + (method url-fetch) + (uri (string-append + "http://effbot.org/media/downloads/elementtree-" + version "-20050316.tar.gz")) + (sha256 + (base32 + "016bphqnlg0l4vslahhw4r0aanw95bpypy65r1i1acyb2wj5z7dj")))) + (build-system python-build-system) + (arguments + `(#:python ,python-2 ; seems to be part of Python 3 + #:tests? #f)) ; no 'test' sub-command + (synopsis "Toolkit for XML processing in Python") + (description + "ElementTree is a Python library supporting lightweight XML processing.") + (home-page "http://effbot.org/zone/element-index.htm") + (license (x11-style "http://docs.python.org/2/license.html" + "Like \"CWI LICENSE AGREEMENT FOR PYTHON \ +0.9.0 THROUGH 1.2\".")))) + +(define-public python2-pybugz + (package + (name "python2-pybugz") + (version "0.6.11") + (source (origin + (method url-fetch) + (uri (string-append + "http://bits.liquidx.net/projects/pybugz/pybugz-" + version ".tar.gz")) + (sha256 + (base32 + "17ni00p08gp5lkxlrrcnvi3x09fmajnlbz4da03qcgl9q21ym4jd")))) + (build-system python-build-system) + (arguments + `(#:python ,python-2 ; SyntaxError with Python 3 + #:tests? #f)) ; no 'test' sub-command + (inputs `(("element-tree" ,python2-element-tree))) + (synopsis "Python and command-line interface to Bugzilla") + (description + "PyBugz is a Python library and command-line tool to query the Bugzilla +bug tracking system. It is meant as an aid to speed up interaction with the +bug tracker.") + (home-page "http://www.liquidx.net/pybugz/") + (license gpl2))) + (define-public scons (package (name "scons") -- cgit v1.2.3 From 9b521a678b6a9bb1e27d7379f70e467ececbe6d1 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Tue, 4 Mar 2014 15:15:23 -0500 Subject: gnu: gnutls: Upgrade to 3.2.12. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/packages/gnutls.scm (gnutls): Upgrade to 3.2.12. Co-authored-by: Ludovic Courtès --- gnu/packages/gnutls.scm | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/gnu/packages/gnutls.scm b/gnu/packages/gnutls.scm index 915f6f8c8f..0391f54126 100644 --- a/gnu/packages/gnutls.scm +++ b/gnu/packages/gnutls.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; Copyright © 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. @@ -63,7 +63,7 @@ (define-public libtasn1 (define-public gnutls (package (name "gnutls") - (version "3.2.11") + (version "3.2.12") (source (origin (method url-fetch) (uri @@ -75,8 +75,12 @@ (define-public gnutls "/gnutls-" version ".tar.xz")) (sha256 (base32 - "1hgk3k8f6wqijca3bsjbfn8pzyfva509y4j2vaxhm4ynfa5cai5q")))) + "0195nliarszq5mginli6d2f5z7ljnd7mwa46iy9z8pkcgy56khbl")))) (build-system gnu-build-system) + (arguments + ;; Work around build issue reported at + ;; . + '(#:make-flags '("CPPFLAGS=-DENABLE_RSA_EXPORT"))) (native-inputs `(("pkg-config" ,pkg-config))) (inputs -- cgit v1.2.3 From ece262461625e80957d904f39a6818286099d367 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 5 Mar 2014 02:16:06 -0500 Subject: gnu: Add lynx. * gnu/packages/lynx.scm: New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add it. --- gnu-system.am | 1 + gnu/packages/lynx.scm | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 87 insertions(+) create mode 100644 gnu/packages/lynx.scm diff --git a/gnu-system.am b/gnu-system.am index ef89b42b23..f034b292dc 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -139,6 +139,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/lsof.scm \ gnu/packages/lua.scm \ gnu/packages/lvm.scm \ + gnu/packages/lynx.scm \ gnu/packages/m4.scm \ gnu/packages/mail.scm \ gnu/packages/make-bootstrap.scm \ diff --git a/gnu/packages/lynx.scm b/gnu/packages/lynx.scm new file mode 100644 index 0000000000..a87316643d --- /dev/null +++ b/gnu/packages/lynx.scm @@ -0,0 +1,86 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Mark H Weaver +;;; +;;; 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 . + +(define-module (gnu packages lynx) + #:use-module ((guix licenses) #:select (gpl2)) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (gnu packages pkg-config) + #:use-module (gnu packages perl) + #:use-module (gnu packages ncurses) + #:use-module (gnu packages libidn) + #:use-module (gnu packages gnutls) + #:use-module (gnu packages gnupg) + #:use-module (gnu packages zip) + #:use-module (gnu packages compression)) + +(define-public lynx + (package + (name "lynx") + (version "2.8.8") + (source (origin + (method url-fetch) + (uri (string-append "http://lynx.isc.org/lynx" version + "/lynx" version ".tar.bz2")) + (sha256 + (base32 "00jcfmx4bxnrzywzzlllz3z45a2mc4fl91ca5lrzz1pyr1s1qnm2")))) + (build-system gnu-build-system) + (native-inputs `(("pkg-config" ,pkg-config) + ("perl" ,perl))) + (inputs `(("ncurses" ,ncurses) + ("libidn" ,libidn) + ("gnutls" ,gnutls) + ("libgcrypt" ,libgcrypt) + ("unzip" ,unzip) + ("zlib" ,zlib) + ("gzip" ,gzip) + ("bzip2" ,bzip2))) + (arguments + `(#:configure-flags '("--with-pkg-config" + "--with-screen=ncurses" + "--with-zlib" + "--with-bzlib" + "--with-gnutls" + ;; "--with-socks5" ; XXX TODO + "--enable-widec" + "--enable-ascii-ctypes" + "--enable-local-docs" + "--enable-htmlized-cfg" + "--enable-gzip-help" + "--enable-nls" + "--enable-ipv6") + #:tests? #f ; no check target + #:phases (alist-replace + 'install + (lambda* (#:key (make-flags '()) #:allow-other-keys) + (zero? (apply system* "make" "install-full" make-flags))) + %standard-phases))) + (synopsis "Text Web Browser") + (description + "Lynx is a fully-featured World Wide Web (WWW) client for users running +cursor-addressable, character-cell display devices. It will display Hypertext +Markup Language (HTML) documents containing links to files on the local +system, as well as files on remote systems running http, gopher, ftp, wais, +nntp, finger, or cso/ph/qi servers. Lynx can be used to access information on +the WWW, or to build information systems intended primarily for local +access.") + (home-page "http://lynx.isc.org/") + (license gpl2))) + +;;; lynx.scm ends here -- cgit v1.2.3 From 5249045cd47c1d7e1d5eec55101f80958eec5880 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 5 Mar 2014 16:21:24 -0500 Subject: gnu: gnupg: Add support for version 1.4.16. * gnu/packages/gnupg.scm (gnupg-1): New variable. --- gnu/packages/gnupg.scm | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/gnu/packages/gnupg.scm b/gnu/packages/gnupg.scm index 85ce0767b7..f9f72903c9 100644 --- a/gnu/packages/gnupg.scm +++ b/gnu/packages/gnupg.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; Copyright © 2013 Andreas Enge ;;; Copyright © 2014 Eric Bavier +;;; Copyright © 2014 Mark H Weaver ;;; ;;; This file is part of GNU Guix. ;;; @@ -213,6 +214,31 @@ (define-public gnupg (working with X.509 certificates and CMS data).") (license gpl3+))) +(define-public gnupg-1 + (package (inherit gnupg) + (version "1.4.16") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnupg/gnupg/gnupg-" version + ".tar.bz2")) + (sha256 + (base32 + "0bsa1yqa3ybhvmc4ys73amdpcmckrlq1fsxjl2980cxada778fvv")))) + (inputs + `(("zlib" ,guix:zlib) + ("bzip2" ,guix:bzip2) + ("curl" ,curl) + ("readline" ,readline) + ("libgpg-error" ,libgpg-error))) + (arguments + `(#:phases (alist-cons-after + 'unpack 'patch-check-sh + (lambda _ + (substitute* "checks/Makefile.in" + (("/bin/sh") (which "bash")))) + %standard-phases))))) + (define-public gpgme (package (name "gpgme") -- cgit v1.2.3 From 7c706558f564e878415a14d32286c31c5ef370fb Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Wed, 5 Mar 2014 19:12:19 -0500 Subject: gnu: Add libotr. * gnu/packages/messaging.scm: New file. * gnu-system.am (GNU_SYSTEM_MODULES): Add it. --- gnu-system.am | 3 +- gnu/packages/messaging.scm | 68 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 70 insertions(+), 1 deletion(-) create mode 100644 gnu/packages/messaging.scm diff --git a/gnu-system.am b/gnu-system.am index f034b292dc..de975e927e 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -1,7 +1,7 @@ # GNU Guix --- Functional package management for GNU # Copyright © 2012, 2013, 2014 Ludovic Courtès # Copyright © 2013 Andreas Enge -# Copyright © 2013 Mark H Weaver +# Copyright © 2013, 2014 Mark H Weaver # # This file is part of GNU Guix. # @@ -144,6 +144,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/mail.scm \ gnu/packages/make-bootstrap.scm \ gnu/packages/maths.scm \ + gnu/packages/messaging.scm \ gnu/packages/mit-krb5.scm \ gnu/packages/moe.scm \ gnu/packages/mpd.scm \ diff --git a/gnu/packages/messaging.scm b/gnu/packages/messaging.scm new file mode 100644 index 0000000000..34efa85970 --- /dev/null +++ b/gnu/packages/messaging.scm @@ -0,0 +1,68 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Mark H Weaver +;;; +;;; 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 . + +(define-module (gnu packages messaging) + #:use-module (guix licenses) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (gnu packages gnupg)) + +(define-public libotr + (package + (name "libotr") + (version "4.0.0") + (source (origin + (method url-fetch) + (uri (string-append "https://otr.cypherpunks.ca/libotr-" + version ".tar.gz")) + (sha256 + (base32 "1d4k0b7v4d3scwm858cmqr9c6xgd6ppla1vk4x2yg64q82a1k49z")))) + (build-system gnu-build-system) + (propagated-inputs + `(("libgcrypt" ,libgcrypt))) ; libotr headers include gcrypt.h + (inputs `(("libgpg-error" ,libgpg-error))) + (arguments + `(#:configure-flags '("--with-pic"))) + (synopsis "Off-the-Record (OTR) Messaging Library and Toolkit") + (description + "OTR allows you to have private conversations over instant messaging by +providing: +* Encryption: No one else can read your instant messages. +* Authentication: You are assured the correspondent is who you think it is. +* Deniability: The messages you send do not have digital signatures that are + checkable by a third party. Anyone can forge messages after a conversation + to make them look like they came from you. However, during a conversation, + your correspondent is assured the messages he sees are authentic and + unmodified. +* Perfect forward secrecy: If you lose control of your private keys, no + previous conversation is compromised.") + (home-page "https://otr.cypherpunks.ca/") + (license (list lgpl2.1 gpl2)))) + +(define-public libotr-3 + (package (inherit libotr) + (version "3.2.1") + (source (origin + (method url-fetch) + (uri (string-append "https://otr.cypherpunks.ca/libotr-" + version ".tar.gz")) + (sha256 + (base32 "1x6dd4rh499hdraiqfhz81igrj0a5rs0gjhc8l4sljwqhjjyla6l")))))) + +;;; messaging.scm ends here -- cgit v1.2.3 From 8b3099cf03b2d1ebcd233b4a35d132cd73b5728d Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Thu, 6 Mar 2014 00:07:07 -0500 Subject: gnu: Add bitlbee. * gnu/packages/messaging.scm (bitlbee): New variable. * gnu/packages/patches/bitlbee-fix-tests.patch: New file. * gnu/packages/patches/bitlbee-memset-fix.patch: New file. * gnu-system.am (dist_patch_DATA): Add patches. --- gnu-system.am | 2 + gnu/packages/messaging.scm | 59 ++++++++++++++++++++++++++- gnu/packages/patches/bitlbee-fix-tests.patch | 33 +++++++++++++++ gnu/packages/patches/bitlbee-memset-fix.patch | 15 +++++++ 4 files changed, 107 insertions(+), 2 deletions(-) create mode 100644 gnu/packages/patches/bitlbee-fix-tests.patch create mode 100644 gnu/packages/patches/bitlbee-memset-fix.patch diff --git a/gnu-system.am b/gnu-system.am index de975e927e..ff45aa7764 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -252,6 +252,8 @@ dist_patch_DATA = \ gnu/packages/patches/binutils-ld-new-dtags.patch \ gnu/packages/patches/binutils-loongson-madd-fix.patch \ gnu/packages/patches/binutils-loongson-workaround.patch \ + gnu/packages/patches/bitlbee-fix-tests.patch \ + gnu/packages/patches/bitlbee-memset-fix.patch \ gnu/packages/patches/cdparanoia-fpic.patch \ gnu/packages/patches/cmake-fix-tests.patch \ gnu/packages/patches/cpio-gets-undeclared.patch \ diff --git a/gnu/packages/messaging.scm b/gnu/packages/messaging.scm index 34efa85970..c1a755ef84 100644 --- a/gnu/packages/messaging.scm +++ b/gnu/packages/messaging.scm @@ -17,11 +17,20 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu packages messaging) - #:use-module (guix licenses) + #:use-module ((guix licenses) + #:select (gpl2+ gpl2 lgpl2.1 bsd-2)) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix build-system gnu) - #:use-module (gnu packages gnupg)) + #:use-module (gnu packages) + #:use-module (gnu packages gnupg) + #:use-module (gnu packages pkg-config) + #:use-module (gnu packages glib) + #:use-module (gnu packages gnutls) + #:use-module (gnu packages python) + #:use-module (gnu packages perl) + #:use-module (gnu packages compression) + #:use-module (gnu packages check)) (define-public libotr (package @@ -65,4 +74,50 @@ (define-public libotr-3 (sha256 (base32 "1x6dd4rh499hdraiqfhz81igrj0a5rs0gjhc8l4sljwqhjjyla6l")))))) +(define-public bitlbee + (package + (name "bitlbee") + (version "3.2.1") + (source (origin + (method url-fetch) + (uri (string-append "http://get.bitlbee.org/src/bitlbee-" + version ".tar.gz")) + (sha256 + (base32 "0n8g5452i5qap43zxb83gxp01d48psf6rr3k1q7z6a3dgpfi3x00")) + (patches (list (search-patch "bitlbee-memset-fix.patch") + (search-patch "bitlbee-fix-tests.patch"))))) + (build-system gnu-build-system) + (native-inputs `(("pkg-config" ,pkg-config) + ("check" ,check))) + (inputs `(("glib" ,glib) + ("libotr" ,libotr-3) + ("gnutls" ,gnutls) + ("zlib" ,zlib) ; Needed to satisfy "pkg-config --exists gnutls" + ("python" ,python-2) + ("perl" ,perl))) + (arguments + `(#:phases (alist-cons-after + 'install 'install-etc + (lambda* (#:key (make-flags '()) #:allow-other-keys) + (zero? (apply system* "make" "install-etc" make-flags))) + (alist-replace + 'configure + ;; bitlbee's configure script does not tolerate many of the + ;; variable settings that Guix would pass to it. + (lambda* (#:key outputs #:allow-other-keys) + (zero? (system* "./configure" + (string-append "--prefix=" + (assoc-ref outputs "out")) + "--otr=1"))) + %standard-phases)))) + (synopsis "IRC to instant messaging gateway") + (description "BitlBee brings IM (instant messaging) to IRC clients, for +people who have an IRC client running all the time and don't want to run an +additional IM client. BitlBee currently supports XMPP/Jabber (including +Google Talk), MSN Messenger, Yahoo! Messenger, AIM and ICQ, and the Twitter +microblogging network (plus all other Twitter API compatible services like +identi.ca and status.net).") + (home-page "http://www.bitlbee.org/") + (license (list gpl2+ bsd-2)))) + ;;; messaging.scm ends here diff --git a/gnu/packages/patches/bitlbee-fix-tests.patch b/gnu/packages/patches/bitlbee-fix-tests.patch new file mode 100644 index 0000000000..52bb6c605d --- /dev/null +++ b/gnu/packages/patches/bitlbee-fix-tests.patch @@ -0,0 +1,33 @@ +Pass the correct number of arguments to 'nick_strip' and 'nick_ok' in tests. + +Patch by Mark H Weaver . + +--- bitlbee/tests/check_nick.c.orig 2013-11-27 17:54:54.000000000 -0500 ++++ bitlbee/tests/check_nick.c 2014-03-05 23:41:45.761230468 -0500 +@@ -30,7 +30,7 @@ START_TEST(test_nick_strip) + for (i = 0; get[i]; i++) { + char copy[60]; + strcpy(copy, get[i]); +- nick_strip(copy); ++ nick_strip(NULL, copy); + fail_unless (strcmp(copy, expected[i]) == 0, + "(%d) nick_strip broken: %s -> %s (expected: %s)", + i, get[i], copy, expected[i]); +@@ -45,7 +45,7 @@ START_TEST(test_nick_ok_ok) + int i; + + for (i = 0; nicks[i]; i++) { +- fail_unless (nick_ok(nicks[i]) == 1, ++ fail_unless (nick_ok(NULL, nicks[i]) == 1, + "nick_ok() failed: %s", nicks[i]); + } + } +@@ -58,7 +58,7 @@ START_TEST(test_nick_ok_notok) + int i; + + for (i = 0; nicks[i]; i++) { +- fail_unless (nick_ok(nicks[i]) == 0, ++ fail_unless (nick_ok(NULL, nicks[i]) == 0, + "nick_ok() succeeded for invalid: %s", nicks[i]); + } + } diff --git a/gnu/packages/patches/bitlbee-memset-fix.patch b/gnu/packages/patches/bitlbee-memset-fix.patch new file mode 100644 index 0000000000..1d801e0070 --- /dev/null +++ b/gnu/packages/patches/bitlbee-memset-fix.patch @@ -0,0 +1,15 @@ +Fix the size argument to 'memset'. + +Patch by Mark H Weaver . + +--- bitlbee/lib/md5.c.orig 2013-11-27 17:54:54.000000000 -0500 ++++ bitlbee/lib/md5.c 2014-03-05 21:39:04.739746093 -0500 +@@ -159,7 +159,7 @@ void md5_finish(struct MD5Context *ctx, + ctx->buf[2] = cvt32(ctx->buf[2]); + ctx->buf[3] = cvt32(ctx->buf[3]); + memcpy(digest, ctx->buf, 16); +- memset(ctx, 0, sizeof(ctx)); /* In case it's sensitive */ ++ memset(ctx, 0, sizeof(*ctx)); /* In case it's sensitive */ + } + + void md5_finish_ascii(struct MD5Context *context, char *ascii) -- cgit v1.2.3 From 56c72822a81cdf5ff4022d64a26887df427d62dd Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 5 Mar 2014 23:25:37 +0100 Subject: download: Perform derivations locally. * guix/download.scm (url-fetch): Pass #:local-build? #t to 'build-expression->derivation'. * guix/git-download.scm (git-fetch): Likewise. --- guix/download.scm | 6 +++++- guix/git-download.scm | 3 ++- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/guix/download.scm b/guix/download.scm index 2cc8a4a5b8..0889928d3a 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -242,7 +242,11 @@ (define need-gnutls? (guix build utils) (guix ftp-client)) #:guile-for-build guile-for-build - #:env-vars env-vars))) + #:env-vars env-vars + + ;; In general, offloading downloads is not a + ;; good idea. + #:local-build? #t))) (define* (download-to-store store url #:optional (name (basename url)) #:key (log (current-error-port))) diff --git a/guix/git-download.scm b/guix/git-download.scm index 472bf756ce..5e0a6a21dc 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -84,6 +84,7 @@ (define git-for-build #:recursive? #t #:modules '((guix build git) (guix build utils)) - #:guile-for-build guile-for-build))) + #:guile-for-build guile-for-build + #:local-build? #t))) ;;; git-download.scm ends here -- cgit v1.2.3 From 827d556311b79d44fd67b4bd24cf17e5f781d502 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 6 Mar 2014 18:38:19 +0100 Subject: tests: Rewrite 'fcntl-lock' test. * tests/utils.scm (temp-file): New variable. ("fcntl-flock"): Rewrite to actually test whether the child process waits for the lock to be released. The previous test was wrong because (1) it expected F_SETLK semantics, not F_SETLKW, and (2) it got EBADF because of a mismatch between the open mode and the lock style. --- tests/utils.scm | 43 +++++++++++++++++++++++++++++-------------- 1 file changed, 29 insertions(+), 14 deletions(-) diff --git a/tests/utils.scm b/tests/utils.scm index b5706aa792..5be7baf016 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -27,6 +27,9 @@ (define-module (test-utils) #:use-module (rnrs io ports) #:use-module (ice-9 match)) +(define temp-file + (string-append "t-utils-" (number->string (getpid)))) + (test-begin "utils") (test-assert "bytevector->base16-string->bytevector" @@ -139,33 +142,43 @@ (define-module (test-utils) (append pids1 pids2))) (equal? (get-bytevector-all decompressed) data))))) +(false-if-exception (delete-file temp-file)) (test-equal "fcntl-flock" - 0 ; the child's exit status - (let ((file (open-input-file (search-path %load-path "guix.scm")))) - (fcntl-flock file 'read-lock) + 42 ; the child's exit status + (let ((file (open-file temp-file "w0"))) + ;; Acquire an exclusive lock. + (fcntl-flock file 'write-lock) (match (primitive-fork) (0 (dynamic-wind (const #t) (lambda () - ;; Taking a read lock should be OK. - (fcntl-flock file 'read-lock) - (fcntl-flock file 'unlock) - - (catch 'flock-error - (lambda () - ;; Taking an exclusive lock should raise an exception. - (fcntl-flock file 'write-lock)) - (lambda args - (primitive-exit 0))) + ;; Reopen FILE read-only so we can have a read lock. + (let ((file (open-file temp-file "r"))) + ;; Wait until we can acquire the lock. + (fcntl-flock file 'read-lock) + (primitive-exit (read file))) (primitive-exit 1)) (lambda () (primitive-exit 2)))) (pid + ;; Write garbage and wait. + (display "hello, world!" file) + (force-output file) + (sleep 1) + + ;; Write the real answer. + (seek file 0 SEEK_SET) + (truncate-file file 0) + (write 42 file) + (force-output file) + + ;; Unlock, which should let the child continue. + (fcntl-flock file 'unlock) + (match (waitpid pid) ((_ . status) (let ((result (status:exit-val status))) - (fcntl-flock file 'unlock) (close-port file) result))))))) @@ -178,5 +191,7 @@ (define-module (test-utils) (test-end) +(false-if-exception (delete-file temp-file)) + (exit (= (test-runner-fail-count (test-runner-current)) 0)) -- cgit v1.2.3 From f326fef8a89d02b481d7e900ef791d0108381f3f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 6 Mar 2014 21:38:45 +0100 Subject: offload: Serialize file transfers to build machines. * guix/scripts/offload.scm (machine-lock-file, lock-machine, unlock-machine): New procedures. (with-machine-lock): New macro. (process-request): Wrap 'send-files' and 'retrieve-files' calls in 'with-machine-lock'. --- guix/scripts/offload.scm | 50 ++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 46 insertions(+), 4 deletions(-) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index d5ee907c36..2c9ecafcb9 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -23,7 +23,7 @@ (define-module (guix scripts offload) #:use-module (guix derivations) #:use-module (guix nar) #:use-module (guix utils) - #:use-module ((guix build utils) #:select (which)) + #:use-module ((guix build utils) #:select (which mkdir-p)) #:use-module (guix ui) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) @@ -303,6 +303,38 @@ (define (machine-less-loaded-or-faster? m1 m2) (or (machine-less-loaded? m1 m2) (machine-faster? m1 m2))) +(define (machine-lock-file machine) + "Return the name of MACHINE's lock file." + (string-append %state-directory "/offload/" + (build-machine-name machine) ".lock")) + +(define (lock-machine machine) + "Wait to acquire MACHINE's lock, and return the lock." + (let ((file (machine-lock-file machine))) + (mkdir-p (dirname file)) + (let ((port (open-file file "w0"))) + (fcntl-flock port 'write-lock) + port))) + +(define (unlock-machine machine lock) + "Unlock LOCK, MACHINE's lock." + (fcntl-flock lock 'unlock) + (close-port lock) + #t) + +(define-syntax-rule (with-machine-lock machine exp ...) + "Wait to acquire MACHINE's exclusive lock, and evaluate EXP in that +context." + (let* ((m machine) + (lock (lock-machine m))) + (dynamic-wind + (lambda () + #t) + (lambda () + exp ...) + (lambda () + (unlock-machine m lock))))) + (define (choose-build-machine requirements machines) "Return the best machine among MACHINES fulfilling REQUIREMENTS, or #f." (let ((machines (sort (filter (cut machine-matches? <> requirements) @@ -330,15 +362,21 @@ (define* (process-request wants-local? system drv features (display "# accept\n") (let ((inputs (string-tokenize (read-line))) (outputs (string-tokenize (read-line)))) - (when (send-files (cons (derivation-file-name drv) inputs) - machine) + ;; Acquire MACHINE's exclusive lock to serialize file transfers + ;; to/from MACHINE in the presence of several 'offload' hook + ;; instance. + (when (with-machine-lock machine + (send-files (cons (derivation-file-name drv) inputs) + machine)) (let ((status (offload drv machine #:print-build-trace? print-build-trace? #:max-silent-time max-silent-time #:build-timeout build-timeout))) (if (zero? status) (begin - (retrieve-files outputs machine) + ;; Likewise (see above.) + (with-machine-lock machine + (retrieve-files outputs machine)) (format (current-error-port) "done with offloaded '~a'~%" (derivation-file-name drv))) @@ -420,4 +458,8 @@ (define not-coma (x (leave (_ "invalid arguments: ~{~s ~}~%") x)))) +;;; Local Variables: +;;; eval: (put 'with-machine-lock 'scheme-indent-function 1) +;;; End: + ;;; offload.scm ends here -- cgit v1.2.3 From 9ea3ef26551a754df502e03002a73052f3c2fbc6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 6 Mar 2014 21:41:51 +0100 Subject: utils: 'fcntl-flock' passes an errno when throwing an exception. * guix/utils.scm (%libc-errno-pointer, errno): New procedures. (fcntl-flock): Use it as the exception's argument. --- guix/utils.scm | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/guix/utils.scm b/guix/utils.scm index 5fda2116de..38f9ad0f61 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -252,6 +252,22 @@ (define F_xxLCK ((string-contains %host-type "linux") #(0 1 2)) ; *-linux-gnu (else #(1 2 3))))) ; *-gnu* +(define %libc-errno-pointer + ;; Glibc's 'errno' pointer. + (let ((errno-loc (dynamic-func "__errno_location" (dynamic-link)))) + (and errno-loc + (let ((proc (pointer->procedure '* errno-loc '()))) + (proc))))) + +(define (errno) + "Return the current errno." + ;; XXX: We assume that nothing changes 'errno' while we're doing all this. + ;; In particular, that means that no async must be running here. + (if %libc-errno-pointer + (let ((bv (pointer->bytevector %libc-errno-pointer (sizeof int)))) + (bytevector-sint-ref bv 0 (native-endianness) (sizeof int))) + 0)) + (define fcntl-flock (let* ((ptr (dynamic-func "fcntl" (dynamic-link))) (proc (pointer->procedure int ptr `(,int ,int *)))) @@ -282,7 +298,7 @@ (define fd (or (zero? err) ;; Presumably we got EAGAIN or so. - (throw 'flock-error fd)))))) + (throw 'flock-error (errno))))))) ;;; -- cgit v1.2.3 From 4d01bd3c1ce8a986ebcf50c65a73cc87657f2360 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Wed, 5 Mar 2014 20:45:55 -0500 Subject: gnu: Add ncmpc. * gnu/packages/mpd.scm (ncmpc): New variable. --- gnu/packages/mpd.scm | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/gnu/packages/mpd.scm b/gnu/packages/mpd.scm index b2c5dec15b..04b34eaf87 100644 --- a/gnu/packages/mpd.scm +++ b/gnu/packages/mpd.scm @@ -29,13 +29,15 @@ (define-module (gnu packages mpd) #:use-module (gnu packages glib) #:use-module (gnu packages linux) #:use-module (gnu packages mp3) + #:use-module (gnu packages ncurses) #:use-module (gnu packages pkg-config) #:use-module (gnu packages pulseaudio) #:use-module (gnu packages sqlite) #:use-module (gnu packages video) #:use-module (gnu packages xiph) #:export (libmpdclient - mpd)) + mpd + ncmpc)) (define libmpdclient (package @@ -121,3 +123,27 @@ (define mpd protocol.") (home-page "http://www.musicpd.org/") (license license:gpl2))) + +(define ncmpc + (package + (name "ncmpc") + (version "0.21") + (source (origin + (method url-fetch) + (uri + (string-append "http://musicpd.org/download/ncmpc/" + (car (string-split version #\.)) + "/ncmpc-" version ".tar.gz")) + (sha256 + (base32 + "1gpy6rr0awl6xgkswmr8rdvqfkrz83rmwk441c00a9d4z3zb1a16")))) + (build-system gnu-build-system) + (inputs `(("glib" ,glib) + ("libmpdclient" ,libmpdclient) + ("ncurses" ,ncurses))) + (native-inputs `(("pkg-config" ,pkg-config))) + (synopsis "A curses Music Player Daemon client") + (description "ncmpc is a fully featured MPD client, which runs in a +terminal using ncurses.") + (home-page "http://www.musicpd.org/clients/ncmpc/") + (license license:gpl2))) -- cgit v1.2.3 From cafb92d853c66b677111594727c586b87bbdd58f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 7 Mar 2014 00:18:28 +0100 Subject: store: 'export-paths' doesn't export references of the given files. This fixes a regression introduced in 99fbddf9a623757e39d88bfb431f8f7d6f24b75b ("store: Change 'export-paths' to always export in topological order.") * guix/store.scm (export-paths): Define 'ordered' variable. Iterate over it. * tests/store.scm ("export/import paths, ensure topological order"): Add 'file0'. Adjust accordingly. --- guix/store.scm | 7 ++++++- tests/store.scm | 7 +++++-- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/guix/store.scm b/guix/store.scm index 54ed31cbbc..e92e159ff4 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -734,8 +734,13 @@ (define* (export-path server path port #:key (sign? #t)) (define* (export-paths server paths port #:key (sign? #t)) "Export the store paths listed in PATHS to PORT, in topological order, signing them if SIGN? is true." + (define ordered + ;; Sort PATHS, but don't include their references. + (filter (cut member <> paths) + (topologically-sorted server paths))) + (let ((s (nix-server-socket server))) - (let loop ((paths (topologically-sorted server paths))) + (let loop ((paths ordered)) (match paths (() (write-int 0 port)) diff --git a/tests/store.scm b/tests/store.scm index 7b0f3249d2..cc76ea5500 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -399,7 +399,9 @@ (define (same? x y) files))))))) (test-assert "export/import paths, ensure topological order" - (let* ((file1 (add-text-to-store %store "foo" (random-text))) + (let* ((file0 (add-text-to-store %store "baz" (random-text))) + (file1 (add-text-to-store %store "foo" (random-text) + (list file0))) (file2 (add-text-to-store %store "bar" (random-text) (list file1))) (files (list file1 file2)) @@ -412,9 +414,10 @@ (define (same? x y) (bytevector=? dump1 dump2) (let* ((source (open-bytevector-input-port dump1)) (imported (import-paths %store source))) + ;; DUMP1 should contain exactly FILE1 and FILE2, not FILE0. (and (equal? imported (list file1 file2)) (every file-exists? files) - (null? (references %store file1)) + (equal? (list file0) (references %store file1)) (equal? (list file1) (references %store file2))))))) (test-assert "import corrupt path" -- cgit v1.2.3 From 583103416dc868826ef573b55c2e6657cd62eb36 Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Thu, 6 Mar 2014 14:16:18 -0600 Subject: gnu: Add a2ps, trueprint, enscript, and source-highlight * gnu/packages/pretty-print.scm: New file * gnu/packages/patches/source-highlight-regexrange-test.patch: New file * gnu-system.am (dist_patch_DATA): Add patch. (GNU_SYSTEM_MODULES): Add pretty-print.scm --- gnu-system.am | 2 + .../patches/source-highlight-regexrange-test.patch | 15 ++ gnu/packages/pretty-print.scm | 224 +++++++++++++++++++++ 3 files changed, 241 insertions(+) create mode 100644 gnu/packages/patches/source-highlight-regexrange-test.patch create mode 100644 gnu/packages/pretty-print.scm diff --git a/gnu-system.am b/gnu-system.am index ff45aa7764..2eae1483cc 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -176,6 +176,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/popt.scm \ gnu/packages/pth.scm \ gnu/packages/pulseaudio.scm \ + gnu/packages/pretty-print.scm \ gnu/packages/python.scm \ gnu/packages/qemu.scm \ gnu/packages/qt.scm \ @@ -322,6 +323,7 @@ dist_patch_DATA = \ gnu/packages/patches/slim-session.patch \ gnu/packages/patches/slim-config.patch \ gnu/packages/patches/slim-sigusr1.patch \ + gnu/packages/patches/source-highlight-regexrange-test.patch \ gnu/packages/patches/tcsh-fix-autotest.patch \ gnu/packages/patches/teckit-cstdio.patch \ gnu/packages/patches/valgrind-glibc.patch \ diff --git a/gnu/packages/patches/source-highlight-regexrange-test.patch b/gnu/packages/patches/source-highlight-regexrange-test.patch new file mode 100644 index 0000000000..298c831b35 --- /dev/null +++ b/gnu/packages/patches/source-highlight-regexrange-test.patch @@ -0,0 +1,15 @@ +Disable a single check. The failure is discussed at: + + https://savannah.gnu.org/bugs/index.php?41786 + +--- a/lib/tests/test_regexranges_main.cpp 2012-04-14 08:58:25.000000000 -0500 ++++ b/lib/tests/test_regexranges_main.cpp 2014-03-05 23:49:23.520402043 -0600 +@@ -52,7 +52,7 @@ + check_range_regex("simple regex"); + check_range_regex("[[:alpha:]]+"); + // test with a wrong regular expression +- check_range_regex("{notclosed", false); ++ // check_range_regex("{notclosed", false); + + // reset regular expressions + ranges.clear(); diff --git a/gnu/packages/pretty-print.scm b/gnu/packages/pretty-print.scm new file mode 100644 index 0000000000..98663cd834 --- /dev/null +++ b/gnu/packages/pretty-print.scm @@ -0,0 +1,224 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Eric Bavier +;;; +;;; 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 . + +(define-module (gnu packages pretty-print) + #:use-module (guix packages) + #:use-module (guix licenses) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (gnu packages) + #:use-module (gnu packages ghostscript) + #:use-module (gnu packages groff) + #:use-module (gnu packages imagemagick) + #:use-module (gnu packages gv) + #:use-module (gnu packages boost) + #:use-module (gnu packages bison) + #:use-module (gnu packages flex) + #:use-module (gnu packages gperf) + #:use-module (gnu packages perl) + #:use-module (gnu packages file)) + +(define-public a2ps + (package + (name "a2ps") + (version "4.14") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnu/a2ps/a2ps-" + version ".tar.gz")) + (sha256 + (base32 + "195k78m1h03m961qn7jr120z815iyb93gwi159p1p9348lyqvbpk")))) + (build-system gnu-build-system) + (inputs + `(("psutils" ,psutils) + ("groff" ,groff) + ("gv" ,gv) + ("imagemagick" ,imagemagick))) + (native-inputs + `(("gperf" ,gperf) + ("perl" ,perl) + ("file" ,file))) + (arguments + '(#:phases (alist-replace + 'configure + (lambda* (#:key #:allow-other-keys #:rest args) + (let ((configure (assoc-ref %standard-phases 'configure))) + (substitute* "configure" + (("/usr/bin/file") (which "file"))) + (apply configure args))) + (alist-cons-before + 'build 'patch-scripts + (lambda _ + (substitute* + '("afm/make_fonts_map.sh" + "tests/defs" + "tests/backup.tst" + "tests/styles.tst") + (("/bin/rm") (which "rm")))) + (alist-cons-before + 'check 'patch-test-files + ;; Alternatively, we could unpatch the shebangs in tstfiles + (lambda* (#:key inputs #:allow-other-keys) + (let ((perl (assoc-ref inputs "perl"))) + (substitute* '("tests/ps-ref/includeres.ps" + "tests/gps-ref/includeres.ps") + (("/usr/local/bin/perl") + (string-append perl "/bin/perl")))) + ;; Some of the reference postscript contain a 'version 3' + ;; string that in inconsistent with the source text in the + ;; tstfiles directory. Erroneous search-and-replace? + (substitute* '("tests/ps-ref/InsertBlock.ps" + "tests/gps-ref/InsertBlock.ps" + "tests/ps-ref/bookie.ps" + "tests/gps-ref/bookie.ps") + (("version 3") "version 2")) + (substitute* '("tests/ps-ref/psmandup.ps" + "tests/gps-ref/psmandup.ps") + (("#! */bin/sh") (string-append + "#!" (which "sh"))))) + %standard-phases))))) + (home-page "http://www.gnu.org/software/a2ps") + (synopsis "Any file to PostScript, including pretty-printing") + (description + "GNU a2ps converts almost anything to a PostScript file, ready for +printing. It accomplishes this by being able to delegate files to external +handlers, such as Groff and Gzip. It handles as many steps as is necessary to +produce a pretty-printed file. It also includes some extra abilities for +special cases, such as pretty-printing \"--help\" output.") + (license gpl3+))) + +(define-public trueprint + (package + (name "trueprint") + (version "5.4") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnu/trueprint/trueprint-" + version ".tar.gz")) + (sha256 + (base32 + "13rkc0fga10xyf56yy9dnq95zndnfadkhxflnp24skszj21y8jqh")))) + (build-system gnu-build-system) + (native-inputs `(("file" ,file))) + (arguments + ;; Must define DIFF_CMD for tests to pass + '(#:configure-flags '("CPPFLAGS=-DDIFF_CMD=\\\"diff\\\"") + #:phases (alist-replace + 'configure + (lambda* (#:key #:allow-other-keys #:rest args) + (let ((configure (assoc-ref %standard-phases 'configure))) + (substitute* "configure" + (("/usr/bin/file") (which "file"))) + (apply configure args))) + %standard-phases))) + (home-page "http://www.gnu.org/software/trueprint") + (synopsis "Pretty-print C sources and other plain text to PostScript") + (description + "GNU Trueprint translates C source code files as PostScript files. +In addition to the basic source code output, it can also perform diff-marking, +indentation counting, function and file indices and more.") + (license gpl2))) + +(define-public enscript + (package + (name "enscript") + (version "1.6.6") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnu/enscript/enscript-" + version ".tar.gz")) + (sha256 + (base32 + "1fy0ymvzrrvs889zanxcaxjfcxarm2d3k43c9frmbl1ld7dblmkd")))) + (build-system gnu-build-system) + (home-page "http://www.gnu.org/software/enscript") + (synopsis "Generating PostScript, including pretty-printing") + (description + "GNU Enscript is a program to convert ASCII text files to PostScript, +HTML or RTF formats, to be stored in files or sent immediately to a printer. +It also includes the capability to perform syntax highlighting for several +different programming languages.") + (license gpl3+))) + +(define-public source-highlight + (package + (name "source-highlight") + (version "3.1.7") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnu/src-highlite/source-highlight-" + version ".tar.gz")) + (sha256 + (base32 + "1s49ld8cnpzhhwq0r7s0sfm3cg3nhhm0wla27lwraifrrl3y1cp1")) + (patches + (list (search-patch + ;; Patch submitted as Savannah item #41786 + "source-highlight-regexrange-test.patch"))))) + (build-system gnu-build-system) + ;; The ctags that comes with emacs does not support the --excmd options, + ;; so can't be used + (inputs + `(("boost" ,boost-1.54))) + (native-inputs + `(("bison" ,bison) + ("flex" ,flex) + ("file" ,file))) + (arguments + `(#:configure-flags + (list (string-append "--with-boost=" + (assoc-ref %build-inputs "boost"))) + #:parallel-tests? #f ;There appear to be race conditions + #:phases (alist-replace + 'configure + (lambda* (#:key #:allow-other-keys #:rest args) + (let ((configure (assoc-ref %standard-phases 'configure))) + (substitute* "configure" + (("/usr/bin/file") (which "file"))) + (apply configure args))) + (alist-cons-before + 'check 'patch-test-files + (lambda* (#:key inputs #:allow-other-keys) + ;; Unpatch shebangs in test input so that source-highlight + ;; is still able to infer input language + (substitute* '("tests/test.sh" + "tests/test2.sh" + "tests/test.tcl") + (((string-append "#! *" (which "sh"))) "#!/bin/sh")) + ;; Initial patching unrecoverably removes whitespace, so + ;; remove it also in the comparison output. + (substitute* '("tests/test.sh.html" + "tests/test2.sh.html" + "tests/test.tcl.html") + (("#! */bin/sh") "#!/bin/sh"))) + %standard-phases)))) + (home-page "http://www.gnu.org/software/src-highlite") + (synopsis "Produce a document with syntax highlighting from a source file") + (description + "GNU source-highlight reads in a source code file and produces an output +file in which the keywords are highlighted in different colors to designate +their syntactic role. It supports over 150 different languages and it can +output to 8 different formats, including HTML, LaTeX and ODF. It can also +output to ANSI color escape sequences, so that highlighted source code can be +seen in a terminal.") + (license gpl3+))) -- cgit v1.2.3 From e7f34eb0dc5a5302726857a77de3cf5f6635c1b7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 7 Mar 2014 10:21:34 +0100 Subject: doc: Explain what's special about the (gnu packages ...) name space. * doc/guix.texi (Invoking guix package): Explain where packages are searched for and link to "Package Modules". (Defining Packages) : Use 'define-module' clause instead of 'use-modules'. Explain why and link to "Package Modules". (Invoking guix build): Explain where packages aer searched for and link to "Package Modules". (Package Modules): Explain that (gnu packages ...) is scanned. --- doc/guix.texi | 50 +++++++++++++++++++++++++++++++++++++------------- 1 file changed, 37 insertions(+), 13 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index baa1990484..97a725a5d4 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -699,7 +699,9 @@ such as @code{guile-1.8.8}. If no version number is specified, the newest available version will be selected. In addition, @var{package} may contain a colon, followed by the name of one of the outputs of the package, as in @code{gcc:doc} or @code{binutils-2.22:lib} -(@pxref{Packages with Multiple Outputs}). +(@pxref{Packages with Multiple Outputs}). Packages with a corresponding +name (and optionally version) are searched for among the GNU +distribution modules (@pxref{Package Modules}). @cindex propagated inputs Sometimes packages have @dfn{propagated inputs}: these are dependencies @@ -1212,10 +1214,11 @@ example, the package definition, or @dfn{recipe}, for the GNU Hello package looks like this: @example -(use-modules (guix packages) - (guix download) - (guix build-system gnu) - (guix licenses)) +(define-module (gnu packages hello) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (guix licenses)) (define hello (package @@ -1237,13 +1240,19 @@ package looks like this: @noindent Without being a Scheme expert, the reader may have guessed the meaning -of the various fields here. This expression binds variable @var{hello} +of the various fields here. This expression binds variable @code{hello} to a @code{} object, which is essentially a record (@pxref{SRFI-9, Scheme records,, guile, GNU Guile Reference Manual}). This package object can be inspected using procedures found in the @code{(guix packages)} module; for instance, @code{(package-name hello)} returns---surprise!---@code{"hello"}. +In the example above, @var{hello} is defined into a module of its own, +@code{(gnu packages hello)}. Technically, this is not strictly +necessary, but it is convenient to do so: all the packages defined in +modules under @code{(gnu packages @dots{})} are automatically known to +the command-line tools (@pxref{Package Modules}). + There are a few points worth noting in the above package definition: @itemize @@ -1778,10 +1787,14 @@ guix build @var{options} @var{package-or-derivation}@dots{} @var{package-or-derivation} may be either the name of a package found in the software distribution such as @code{coreutils} or @code{coreutils-8.20}, or a derivation such as -@file{/nix/store/@dots{}-coreutils-8.19.drv}. Alternatively, the -@code{--expression} option may be used to specify a Scheme expression -that evaluates to a package; this is useful when disambiguation among -several same-named packages or package variants is needed. +@file{/nix/store/@dots{}-coreutils-8.19.drv}. In the former case, a +package with the corresponding name (and optionally version) is searched +for among the GNU distribution modules (@pxref{Package Modules}). + +Alternatively, the @code{--expression} option may be used to specify a +Scheme expression that evaluates to a package; this is useful when +disambiguation among several same-named packages or package variants is +needed. The @var{options} may be zero or more of the following: @@ -2183,7 +2196,7 @@ the load. To check whether a package has a @code{debug} output, use @section Package Modules From a programming viewpoint, the package definitions of the -distribution are provided by Guile modules in the @code{(gnu packages +GNU distribution are provided by Guile modules in the @code{(gnu packages @dots{})} name space@footnote{Note that packages under the @code{(gnu packages @dots{})} module name space are not necessarily ``GNU packages''. This module naming scheme follows the usual Guile module @@ -2192,8 +2205,19 @@ as part of the GNU system, and @code{packages} identifies modules that define packages.} (@pxref{Modules, Guile modules,, guile, GNU Guile Reference Manual}). For instance, the @code{(gnu packages emacs)} module exports a variable named @code{emacs}, which is bound to a -@code{} object (@pxref{Defining Packages}). The @code{(gnu -packages)} module provides facilities for searching for packages. +@code{} object (@pxref{Defining Packages}). + +The @code{(gnu packages @dots{})} module name space is special: it is +automatically scanned for packages by the command-line tools. For +instance, when running @code{guix package -i emacs}, all the @code{(gnu +packages @dots{})} modules are scanned until one that exports a package +object whose name is @code{emacs} is found. This package search +facility is implemented in the @code{(gnu packages)} module. + +Users can store package definitions in modules with different +names---e.g., @code{(my-packages emacs)}. In that case, commands such +as @command{guix package} and @command{guix build} have to be used with +the @code{-e} option so that they know where to find the package. The distribution is fully @dfn{bootstrapped} and @dfn{self-contained}: each package is built based solely on other packages in the -- cgit v1.2.3 From c7445833eb43ec621fb5a56f6bfbbf0a02a675c2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 7 Mar 2014 16:46:09 +0100 Subject: utils: Add a non-blocking option for 'fcntl-flock'. * guix/utils.scm (F_SETLK): New variable. (fcntl-flock): Add 'wait?' keyword parameter; honor it. * tests/utils.scm ("fcntl-flock non-blocking"): New test. --- guix/utils.scm | 17 ++++++++++++++--- tests/utils.scm | 44 +++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 57 insertions(+), 4 deletions(-) diff --git a/guix/utils.scm b/guix/utils.scm index 38f9ad0f61..68329ec915 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -244,6 +244,13 @@ (define F_SETLKW ((string-contains %host-type "linux") 7) ; *-linux-gnu (else 9)))) ; *-gnu* +(define F_SETLK + ;; Likewise: GNU/Hurd and SPARC use 8, while the others typically use 6. + (compile-time-value + (cond ((string-contains %host-type "sparc") 8) ; sparc-*-linux-gnu + ((string-contains %host-type "linux") 6) ; *-linux-gnu + (else 8)))) ; *-gnu* + (define F_xxLCK ;; The F_RDLCK, F_WRLCK, and F_UNLCK constants. (compile-time-value @@ -271,9 +278,11 @@ (define (errno) (define fcntl-flock (let* ((ptr (dynamic-func "fcntl" (dynamic-link))) (proc (pointer->procedure int ptr `(,int ,int *)))) - (lambda (fd-or-port operation) + (lambda* (fd-or-port operation #:key (wait? #t)) "Perform locking OPERATION on the file beneath FD-OR-PORT. OPERATION -must be a symbol, one of 'read-lock, 'write-lock, or 'unlock." +must be a symbol, one of 'read-lock, 'write-lock, or 'unlock. When WAIT? is +true, block until the lock is acquired; otherwise, thrown an 'flock-error' +exception if it's already taken." (define (operation->int op) (case op ((read-lock) (vector-ref F_xxLCK 0)) @@ -289,7 +298,9 @@ (define fd ;; XXX: 'fcntl' is a vararg function, but here we happily use the ;; standard ABI; crossing fingers. (let ((err (proc fd - F_SETLKW ; lock & wait + (if wait? + F_SETLKW ; lock & wait + F_SETLK) ; non-blocking attempt (make-c-struct %struct-flock (list (operation->int operation) SEEK_SET diff --git a/tests/utils.scm b/tests/utils.scm index 5be7baf016..adac5d4381 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -143,7 +143,7 @@ (define temp-file (equal? (get-bytevector-all decompressed) data))))) (false-if-exception (delete-file temp-file)) -(test-equal "fcntl-flock" +(test-equal "fcntl-flock wait" 42 ; the child's exit status (let ((file (open-file temp-file "w0"))) ;; Acquire an exclusive lock. @@ -182,6 +182,48 @@ (define temp-file (close-port file) result))))))) +(test-equal "fcntl-flock non-blocking" + EAGAIN ; the child's exit status + (match (pipe) + ((input . output) + (match (primitive-fork) + (0 + (dynamic-wind + (const #t) + (lambda () + (close-port output) + + ;; Wait for the green light. + (read-char input) + + ;; Open FILE read-only so we can have a read lock. + (let ((file (open-file temp-file "w"))) + (catch 'flock-error + (lambda () + ;; This attempt should throw EAGAIN. + (fcntl-flock file 'write-lock #:wait? #f)) + (lambda (key errno) + (primitive-exit errno)))) + (primitive-exit -1)) + (lambda () + (primitive-exit -2)))) + (pid + (close-port input) + (let ((file (open-file temp-file "w"))) + ;; Acquire an exclusive lock. + (fcntl-flock file 'write-lock) + + ;; Tell the child to continue. + (write 'green-light output) + (force-output output) + + (match (waitpid pid) + ((_ . status) + (let ((result (status:exit-val status))) + (fcntl-flock file 'unlock) + (close-port file) + result))))))))) + ;; This is actually in (guix store). (test-equal "store-path-package-name" "bash-4.2-p24" -- cgit v1.2.3 From 178f5828ebcb5a5c7019b5463e4ecee5df48870b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 8 Mar 2014 11:29:52 +0100 Subject: offload: Generalize the machine lock mechanism. * guix/scripts/offload.scm (lock-machine): Add 'hint' parameter. (unlock-machine): Remove 'machine' parameter. (with-machine-lock): Add 'hint' parameter, and pass it down. (process-request): Adjust uses of 'with-machine-lock' to pass the 'bandwidth hint. --- guix/scripts/offload.scm | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 2c9ecafcb9..9b2ea72dc3 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -303,37 +303,38 @@ (define (machine-less-loaded-or-faster? m1 m2) (or (machine-less-loaded? m1 m2) (machine-faster? m1 m2))) -(define (machine-lock-file machine) - "Return the name of MACHINE's lock file." +(define (machine-lock-file machine hint) + "Return the name of MACHINE's lock file for HINT." (string-append %state-directory "/offload/" - (build-machine-name machine) ".lock")) + (build-machine-name machine) + "." (symbol->string hint) ".lock")) -(define (lock-machine machine) - "Wait to acquire MACHINE's lock, and return the lock." - (let ((file (machine-lock-file machine))) +(define (lock-machine machine hint) + "Wait to acquire MACHINE's lock for HINT, and return the lock." + (let ((file (machine-lock-file machine hint))) (mkdir-p (dirname file)) (let ((port (open-file file "w0"))) (fcntl-flock port 'write-lock) port))) -(define (unlock-machine machine lock) - "Unlock LOCK, MACHINE's lock." +(define (unlock-machine lock) + "Unlock LOCK." (fcntl-flock lock 'unlock) (close-port lock) #t) -(define-syntax-rule (with-machine-lock machine exp ...) - "Wait to acquire MACHINE's exclusive lock, and evaluate EXP in that +(define-syntax-rule (with-machine-lock machine hint exp ...) + "Wait to acquire MACHINE's exclusive lock for HINT, and evaluate EXP in that context." (let* ((m machine) - (lock (lock-machine m))) + (lock (lock-machine m hint))) (dynamic-wind (lambda () #t) (lambda () exp ...) (lambda () - (unlock-machine m lock))))) + (unlock-machine lock))))) (define (choose-build-machine requirements machines) "Return the best machine among MACHINES fulfilling REQUIREMENTS, or #f." @@ -365,7 +366,7 @@ (define* (process-request wants-local? system drv features ;; Acquire MACHINE's exclusive lock to serialize file transfers ;; to/from MACHINE in the presence of several 'offload' hook ;; instance. - (when (with-machine-lock machine + (when (with-machine-lock machine 'bandwidth (send-files (cons (derivation-file-name drv) inputs) machine)) (let ((status (offload drv machine @@ -375,7 +376,7 @@ (define* (process-request wants-local? system drv features (if (zero? status) (begin ;; Likewise (see above.) - (with-machine-lock machine + (with-machine-lock machine 'bandwidth (retrieve-files outputs machine)) (format (current-error-port) "done with offloaded '~a'~%" @@ -459,7 +460,7 @@ (define not-coma (leave (_ "invalid arguments: ~{~s ~}~%") x)))) ;;; Local Variables: -;;; eval: (put 'with-machine-lock 'scheme-indent-function 1) +;;; eval: (put 'with-machine-lock 'scheme-indent-function 2) ;;; End: ;;; offload.scm ends here -- cgit v1.2.3 From 4bf1eb4f88f2d2b0596fe8a4b98490fc277f323b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 8 Mar 2014 12:07:57 +0100 Subject: offload: Further generalize lock files. * guix/scripts/offload.scm (lock-machine, unlock-machine): Remove. (lock-file, unlock-file): New procedures. (with-file-lock): New macro. (with-machine-lock): Rewrite in terms of 'with-file-lock'. --- guix/scripts/offload.scm | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 9b2ea72dc3..fb5d178109 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -309,32 +309,35 @@ (define (machine-lock-file machine hint) (build-machine-name machine) "." (symbol->string hint) ".lock")) -(define (lock-machine machine hint) - "Wait to acquire MACHINE's lock for HINT, and return the lock." - (let ((file (machine-lock-file machine hint))) - (mkdir-p (dirname file)) - (let ((port (open-file file "w0"))) - (fcntl-flock port 'write-lock) - port))) - -(define (unlock-machine lock) +(define (lock-file file) + "Wait and acquire an exclusive lock on FILE. Return an open port." + (mkdir-p (dirname file)) + (let ((port (open-file file "w0"))) + (fcntl-flock port 'write-lock) + port)) + +(define (unlock-file lock) "Unlock LOCK." (fcntl-flock lock 'unlock) (close-port lock) #t) -(define-syntax-rule (with-machine-lock machine hint exp ...) - "Wait to acquire MACHINE's exclusive lock for HINT, and evaluate EXP in that -context." - (let* ((m machine) - (lock (lock-machine m hint))) +(define-syntax-rule (with-file-lock file exp ...) + "Wait to acquire a lock on FILE and evaluate EXP in that context." + (let ((port (lock-file file))) (dynamic-wind (lambda () #t) (lambda () exp ...) (lambda () - (unlock-machine lock))))) + (unlock-file port))))) + +(define-syntax-rule (with-machine-lock machine hint exp ...) + "Wait to acquire MACHINE's exclusive lock for HINT, and evaluate EXP in that +context." + (with-file-lock (machine-lock-file machine hint) + exp ...)) (define (choose-build-machine requirements machines) "Return the best machine among MACHINES fulfilling REQUIREMENTS, or #f." @@ -461,6 +464,7 @@ (define not-coma ;;; Local Variables: ;;; eval: (put 'with-machine-lock 'scheme-indent-function 2) +;;; eval: (put 'with-file-lock 'scheme-indent-function 1) ;;; End: ;;; offload.scm ends here -- cgit v1.2.3 From d652b851373c1bb97da2e446b0d5aa5d0b1ad46d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 8 Mar 2014 12:15:38 +0100 Subject: offload: Make 'parallel-builds' a hard limit. * guix/scripts/offload.scm (machine-choice-lock-file, machine-slot-file, acquire-build-slot, release-build-slot): New procedures. (choose-build-machine): Operate with (machine-choice-lock-file) taken. Acquire a build slot for each of MACHINES. Release those not used. --- guix/scripts/offload.scm | 91 +++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 82 insertions(+), 9 deletions(-) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index fb5d178109..9ebe930a82 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -309,6 +309,10 @@ (define (machine-lock-file machine hint) (build-machine-name machine) "." (symbol->string hint) ".lock")) +(define (machine-choice-lock-file) + "Return the name of the file used as a lock when choosing a build machine." + (string-append %state-directory "/offload/machine-choice.lock")) + (define (lock-file file) "Wait and acquire an exclusive lock on FILE. Return an open port." (mkdir-p (dirname file)) @@ -339,17 +343,86 @@ (define-syntax-rule (with-machine-lock machine hint exp ...) (with-file-lock (machine-lock-file machine hint) exp ...)) + +(define (machine-slot-file machine slot) + "Return the file name of MACHINE's file for SLOT." + ;; For each machine we have a bunch of files representing each build slot. + ;; When choosing a build machine, we attempt to get an exclusive lock on one + ;; of these; if we fail, that means all the build slots are already taken. + ;; Inspired by Nix's build-remote.pl. + (string-append (string-append %state-directory "/offload/" + (build-machine-name machine) + "/" (number->string slot)))) + +(define (acquire-build-slot machine) + "Attempt to acquire a build slot on MACHINE. Return the port representing +the slot, or #f if none is available. + +This mechanism allows us to set a hard limit on the number of simultaneous +connections allowed to MACHINE." + (mkdir-p (dirname (machine-slot-file machine 0))) + (with-machine-lock machine 'slots + (any (lambda (slot) + (let ((port (open-file (machine-slot-file machine slot) + "w0"))) + (catch 'flock-error + (lambda () + (fcntl-flock port 'write-lock #:wait? #f) + ;; Got it! + (format (current-error-port) + "process ~a acquired build slot '~a'~%" + (getpid) (port-filename port)) + port) + (lambda args + ;; PORT is already locked by another process. + (close-port port) + #f)))) + (iota (build-machine-parallel-builds machine))))) + +(define (release-build-slot slot) + "Release SLOT, a build slot as returned as by 'acquire-build-slot'." + (close-port slot)) + (define (choose-build-machine requirements machines) "Return the best machine among MACHINES fulfilling REQUIREMENTS, or #f." - (let ((machines (sort (filter (cut machine-matches? <> requirements) - machines) - machine-less-loaded-or-faster?))) - (match machines - ((head . _) - ;; Return the best machine unless it's already overloaded. - (and (< (machine-load head) 2.) - head)) - (_ #f)))) + + ;; Proceed like this: + ;; 1. Acquire the global machine-choice lock. + ;; 2. For all MACHINES, attempt to acquire a build slot, and filter out + ;; those machines for which we failed. + ;; 3. Choose the best machine among those that are left. + ;; 4. Release the previously-acquired build slots of the other machines. + ;; 5. Release the global machine-choice lock. + + (with-file-lock (machine-choice-lock-file) + (define machines+slots + (map (lambda (machine) + (let ((slot (acquire-build-slot machine))) + (and slot (list machine slot)))) + machines)) + + (define (undecorate pred) + (match-lambda + ((machine slot) + (and (pred machine) + (list machine slot))))) + + (let ((machines+slots (sort (filter (undecorate + (cut machine-matches? <> requirements)) + machines+slots) + (undecorate machine-less-loaded-or-faster?)))) + (match machines+slots + (((best slot) (others slots) ...) + ;; Release slots from the uninteresting machines. + (for-each release-build-slot slots) + + ;; Return the best machine unless it's already overloaded. + (if (< (machine-load best) 2.) + best + (begin + (release-build-slot slot) + #f))) + (() #f))))) (define* (process-request wants-local? system drv features #:key -- cgit v1.2.3 From 7df3ade11286e52829c855b76fc395a4c3831ced Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 8 Mar 2014 12:22:49 +0100 Subject: offload: Fix thinko. * guix/scripts/offload.scm (choose-build-machine)[machine+slots]: Use 'filter-map', not 'filter'. --- guix/scripts/offload.scm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 9ebe930a82..2d2dbe36c5 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -396,10 +396,10 @@ (define (choose-build-machine requirements machines) (with-file-lock (machine-choice-lock-file) (define machines+slots - (map (lambda (machine) - (let ((slot (acquire-build-slot machine))) - (and slot (list machine slot)))) - machines)) + (filter-map (lambda (machine) + (let ((slot (acquire-build-slot machine))) + (and slot (list machine slot)))) + machines)) (define (undecorate pred) (match-lambda -- cgit v1.2.3 From 5cc569dc733c3d606be5180b43c6e8566009b4a3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 8 Mar 2014 21:23:12 +0100 Subject: offload: Prevent locked files from being GC'd. * guix/scripts/offload.scm (%slots): New variable. (choose-build-machine): Add SLOT to '%slots'. --- guix/scripts/offload.scm | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 2d2dbe36c5..e1da31af5d 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -383,6 +383,10 @@ (define (release-build-slot slot) "Release SLOT, a build slot as returned as by 'acquire-build-slot'." (close-port slot)) +(define %slots + ;; List of acquired build slots (open ports). + '()) + (define (choose-build-machine requirements machines) "Return the best machine among MACHINES fulfilling REQUIREMENTS, or #f." @@ -418,7 +422,10 @@ (define (undecorate pred) ;; Return the best machine unless it's already overloaded. (if (< (machine-load best) 2.) - best + (begin + ;; Prevent SLOT from being GC'd. + (set! %slots (cons slot %slots)) + best) (begin (release-build-slot slot) #f))) -- cgit v1.2.3 From 0e6260a49360de0fcb845eb3ca9ccb5a2e56b467 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 9 Mar 2014 11:42:37 +0100 Subject: gnu: raptor2: Disable parallel tests. * gnu/packages/rdf.scm (raptor2): Disable parallel tests since it makes tests fail. --- gnu/packages/rdf.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/gnu/packages/rdf.scm b/gnu/packages/rdf.scm index 1f2bc7932d..e7fe6db985 100644 --- a/gnu/packages/rdf.scm +++ b/gnu/packages/rdf.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Andreas Enge +;;; Copyright © 2013, 2014 Andreas Enge ;;; ;;; This file is part of GNU Guix. ;;; @@ -45,6 +45,8 @@ (define-public raptor2 ("libxml2" ,libxml2) ("libxslt" ,libxslt) ("zlib" ,zlib))) + (arguments + `(#:parallel-tests? #f)) (home-page "http://librdf.org/raptor/") (synopsis "RDF syntax library") (description "Raptor is a C library providing a set of parsers and -- cgit v1.2.3 From 88da0b6888ad37454132b17fb58f0fbd9e0ce6b5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 9 Mar 2014 14:05:30 +0100 Subject: offload: Distinguish between 'decline' and 'postpone'. * guix/scripts/offload.scm (transfer-and-offload): New procedure, with core formerly in 'process-request'. (choose-build-machine): Remove 'requirements' parameter. (process-request): Reply 'decline' when none of MACHINES matches the requirements, and 'postpone' when MACHINES are busy. --- guix/scripts/offload.scm | 109 +++++++++++++++++++++++++++++------------------ 1 file changed, 67 insertions(+), 42 deletions(-) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index e1da31af5d..dffc3e9fd2 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -199,6 +199,43 @@ (define* (offload drv machine (close-pipe pipe))) +(define* (transfer-and-offload drv machine + #:key + (inputs '()) + (outputs '()) + (max-silent-time 3600) + (build-timeout 7200) + print-build-trace?) + "Offload DRV to MACHINE. Prior to the actual offloading, transfer all of +INPUTS to MACHINE; if building DRV succeeds, retrieve all of OUTPUTS from +MACHINE." + ;; Acquire MACHINE's exclusive lock to serialize file transfers + ;; to/from MACHINE in the presence of several 'offload' hook + ;; instance. + (when (with-machine-lock machine 'bandwidth + (send-files (cons (derivation-file-name drv) inputs) + machine)) + (let ((status (offload drv machine + #:print-build-trace? print-build-trace? + #:max-silent-time max-silent-time + #:build-timeout build-timeout))) + (if (zero? status) + (begin + ;; Likewise (see above.) + (with-machine-lock machine 'bandwidth + (retrieve-files outputs machine)) + (format (current-error-port) + "done with offloaded '~a'~%" + (derivation-file-name drv))) + (begin + (format (current-error-port) + "derivation '~a' offloaded to '~a' failed \ +with exit code ~a~%" + (derivation-file-name drv) + (build-machine-name machine) + (status:exit-val status)) + (primitive-exit (status:exit-val status))))))) + (define (send-files files machine) "Send the subset of FILES that's missing to MACHINE's store. Return #t on success, #f otherwise." @@ -387,8 +424,8 @@ (define %slots ;; List of acquired build slots (open ports). '()) -(define (choose-build-machine requirements machines) - "Return the best machine among MACHINES fulfilling REQUIREMENTS, or #f." +(define (choose-build-machine machines) + "Return the best machine among MACHINES, or #f." ;; Proceed like this: ;; 1. Acquire the global machine-choice lock. @@ -411,9 +448,7 @@ (define (undecorate pred) (and (pred machine) (list machine slot))))) - (let ((machines+slots (sort (filter (undecorate - (cut machine-matches? <> requirements)) - machines+slots) + (let ((machines+slots (sort machines+slots (undecorate machine-less-loaded-or-faster?)))) (match machines+slots (((best slot) (others slots) ...) @@ -436,43 +471,33 @@ (define* (process-request wants-local? system drv features print-build-trace? (max-silent-time 3600) (build-timeout 7200)) "Process a request to build DRV." - (let* ((local? (and wants-local? (string=? system (%current-system)))) - (reqs (build-requirements - (system system) - (features features))) - (machine (choose-build-machine reqs (build-machines)))) - (if machine - (begin - (display "# accept\n") - (let ((inputs (string-tokenize (read-line))) - (outputs (string-tokenize (read-line)))) - ;; Acquire MACHINE's exclusive lock to serialize file transfers - ;; to/from MACHINE in the presence of several 'offload' hook - ;; instance. - (when (with-machine-lock machine 'bandwidth - (send-files (cons (derivation-file-name drv) inputs) - machine)) - (let ((status (offload drv machine - #:print-build-trace? print-build-trace? - #:max-silent-time max-silent-time - #:build-timeout build-timeout))) - (if (zero? status) - (begin - ;; Likewise (see above.) - (with-machine-lock machine 'bandwidth - (retrieve-files outputs machine)) - (format (current-error-port) - "done with offloaded '~a'~%" - (derivation-file-name drv))) - (begin - (format (current-error-port) - "derivation '~a' offloaded to '~a' failed \ -with exit code ~a~%" - (derivation-file-name drv) - (build-machine-name machine) - (status:exit-val status)) - (primitive-exit (status:exit-val status)))))))) - (display "# decline\n")))) + (let* ((local? (and wants-local? (string=? system (%current-system)))) + (reqs (build-requirements + (system system) + (features features))) + (candidates (filter (cut machine-matches? <> reqs) + (build-machines)))) + (match candidates + (() + ;; We'll never be able to match REQS. + (display "# decline\n")) + ((_ ...) + (let ((machine (choose-build-machine candidates))) + (if machine + (begin + ;; Offload DRV to MACHINE. + (display "# accept\n") + (let ((inputs (string-tokenize (read-line))) + (outputs (string-tokenize (read-line)))) + (transfer-and-offload drv machine + #:inputs inputs + #:outputs outputs + #:max-silent-time max-silent-time + #:build-timeout build-timeout + #:print-build-trace? print-build-trace?))) + + ;; Not now, all the machines are busy. + (display "# postpone\n"))))))) (define-syntax-rule (with-nar-error-handling body ...) "Execute BODY with any &nar-error suitably reported to the user." -- cgit v1.2.3 From 2a51db7d8d0c23fbe5ac14c0c09eb4051f036221 Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 9 Mar 2014 14:37:14 +0100 Subject: gnu: soprano: Add input raptor2. * gnu/packages/rdf.scm (soprano): Add input raptor2. --- gnu/packages/rdf.scm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/gnu/packages/rdf.scm b/gnu/packages/rdf.scm index e7fe6db985..22cfc2e257 100644 --- a/gnu/packages/rdf.scm +++ b/gnu/packages/rdf.scm @@ -78,11 +78,12 @@ (define-public soprano (base32 "08gb5d8bgy7vc6qd6r1kkmmc5rli67dlglpjqjlahpnvs26r1cwl")))) (build-system cmake-build-system) - ;; FIXME: Add optional dependencies: Raptor, Redland, odbci, clucene; doxygen - (inputs - `(("qt" ,qt-4))) + ;; FIXME: Add optional dependencies: Redland, odbci, clucene; doxygen (native-inputs `(("pkg-config" ,pkg-config))) + (inputs + `(("qt" ,qt-4) + ("raptor2" ,raptor2))) (home-page "http://soprano.sourceforge.net/") (synopsis "RDF data library for Qt") (description "Soprano (formerly known as QRDF) is a library which -- cgit v1.2.3 From 59f704dff69f28149acdfde372ad8faebbdfdfb5 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 9 Mar 2014 18:08:21 +0100 Subject: offload: Move macro definitions before use. * guix/scripts/offload.scm (lock-file, unlock-file, with-file-lock, with-machine-lock, machine-slot-file, acquire-build-slot, release-build-slot): Move definitions above their first use. --- guix/scripts/offload.scm | 154 ++++++++++++++++++++++++++--------------------- 1 file changed, 85 insertions(+), 69 deletions(-) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index dffc3e9fd2..cb979fb929 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -174,6 +174,86 @@ (define (remote-pipe machine mode command) %lshg-command (strerror (system-error-errno args))) #f))) + +;;; +;;; Synchronization. +;;; + +(define (lock-file file) + "Wait and acquire an exclusive lock on FILE. Return an open port." + (mkdir-p (dirname file)) + (let ((port (open-file file "w0"))) + (fcntl-flock port 'write-lock) + port)) + +(define (unlock-file lock) + "Unlock LOCK." + (fcntl-flock lock 'unlock) + (close-port lock) + #t) + +(define-syntax-rule (with-file-lock file exp ...) + "Wait to acquire a lock on FILE and evaluate EXP in that context." + (let ((port (lock-file file))) + (dynamic-wind + (lambda () + #t) + (lambda () + exp ...) + (lambda () + (unlock-file port))))) + +(define-syntax-rule (with-machine-lock machine hint exp ...) + "Wait to acquire MACHINE's exclusive lock for HINT, and evaluate EXP in that +context." + (with-file-lock (machine-lock-file machine hint) + exp ...)) + + +(define (machine-slot-file machine slot) + "Return the file name of MACHINE's file for SLOT." + ;; For each machine we have a bunch of files representing each build slot. + ;; When choosing a build machine, we attempt to get an exclusive lock on one + ;; of these; if we fail, that means all the build slots are already taken. + ;; Inspired by Nix's build-remote.pl. + (string-append (string-append %state-directory "/offload/" + (build-machine-name machine) + "/" (number->string slot)))) + +(define (acquire-build-slot machine) + "Attempt to acquire a build slot on MACHINE. Return the port representing +the slot, or #f if none is available. + +This mechanism allows us to set a hard limit on the number of simultaneous +connections allowed to MACHINE." + (mkdir-p (dirname (machine-slot-file machine 0))) + (with-machine-lock machine 'slots + (any (lambda (slot) + (let ((port (open-file (machine-slot-file machine slot) + "w0"))) + (catch 'flock-error + (lambda () + (fcntl-flock port 'write-lock #:wait? #f) + ;; Got it! + (format (current-error-port) + "process ~a acquired build slot '~a'~%" + (getpid) (port-filename port)) + port) + (lambda args + ;; PORT is already locked by another process. + (close-port port) + #f)))) + (iota (build-machine-parallel-builds machine))))) + +(define (release-build-slot slot) + "Release SLOT, a build slot as returned as by 'acquire-build-slot'." + (close-port slot)) + + +;;; +;;; Offloading. +;;; + (define* (offload drv machine #:key print-build-trace? (max-silent-time 3600) (build-timeout 7200) (log-port (current-output-port))) @@ -299,6 +379,11 @@ (define host (zero? (close-pipe pipe))))))) + +;;; +;;; Scheduling. +;;; + (define (machine-matches? machine requirements) "Return #t if MACHINE matches REQUIREMENTS." (and (string=? (build-requirements-system requirements) @@ -350,75 +435,6 @@ (define (machine-choice-lock-file) "Return the name of the file used as a lock when choosing a build machine." (string-append %state-directory "/offload/machine-choice.lock")) -(define (lock-file file) - "Wait and acquire an exclusive lock on FILE. Return an open port." - (mkdir-p (dirname file)) - (let ((port (open-file file "w0"))) - (fcntl-flock port 'write-lock) - port)) - -(define (unlock-file lock) - "Unlock LOCK." - (fcntl-flock lock 'unlock) - (close-port lock) - #t) - -(define-syntax-rule (with-file-lock file exp ...) - "Wait to acquire a lock on FILE and evaluate EXP in that context." - (let ((port (lock-file file))) - (dynamic-wind - (lambda () - #t) - (lambda () - exp ...) - (lambda () - (unlock-file port))))) - -(define-syntax-rule (with-machine-lock machine hint exp ...) - "Wait to acquire MACHINE's exclusive lock for HINT, and evaluate EXP in that -context." - (with-file-lock (machine-lock-file machine hint) - exp ...)) - - -(define (machine-slot-file machine slot) - "Return the file name of MACHINE's file for SLOT." - ;; For each machine we have a bunch of files representing each build slot. - ;; When choosing a build machine, we attempt to get an exclusive lock on one - ;; of these; if we fail, that means all the build slots are already taken. - ;; Inspired by Nix's build-remote.pl. - (string-append (string-append %state-directory "/offload/" - (build-machine-name machine) - "/" (number->string slot)))) - -(define (acquire-build-slot machine) - "Attempt to acquire a build slot on MACHINE. Return the port representing -the slot, or #f if none is available. - -This mechanism allows us to set a hard limit on the number of simultaneous -connections allowed to MACHINE." - (mkdir-p (dirname (machine-slot-file machine 0))) - (with-machine-lock machine 'slots - (any (lambda (slot) - (let ((port (open-file (machine-slot-file machine slot) - "w0"))) - (catch 'flock-error - (lambda () - (fcntl-flock port 'write-lock #:wait? #f) - ;; Got it! - (format (current-error-port) - "process ~a acquired build slot '~a'~%" - (getpid) (port-filename port)) - port) - (lambda args - ;; PORT is already locked by another process. - (close-port port) - #f)))) - (iota (build-machine-parallel-builds machine))))) - -(define (release-build-slot slot) - "Release SLOT, a build slot as returned as by 'acquire-build-slot'." - (close-port slot)) (define %slots ;; List of acquired build slots (open ports). -- cgit v1.2.3 From 834129e0e2984fa615c8958de3964dabd7f6972c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 9 Mar 2014 22:09:12 +0100 Subject: Change the default store file name to /gnu/store. * configure.ac: Change the default 'storedir' to /gnu/store. Print $storedir. * doc/guix.texi: Replace "/nix/store" by "/gnu/store", except where describing Nix compatibility. * Makefile.am: Likewise. --- Makefile.am | 2 +- configure.ac | 8 ++++++-- doc/guix.texi | 46 +++++++++++++++++++++++----------------------- 3 files changed, 30 insertions(+), 26 deletions(-) diff --git a/Makefile.am b/Makefile.am index 56cb6d2354..764332a001 100644 --- a/Makefile.am +++ b/Makefile.am @@ -263,7 +263,7 @@ gen-ChangeLog: mv $(distdir)/cl-t $(distdir)/ChangeLog; \ fi -# Make sure we're not shipping a file that embeds a local /nix/store file name. +# Make sure we're not shipping a file that embeds a local /gnu/store file name. assert-no-store-file-names: if grep -r --exclude=*.texi --exclude=*.info \ "$(storedir)/[a-z0-9]{32}-" $(distdir) ; \ diff --git a/configure.ac b/configure.ac index 749672f15b..d5a89c915b 100644 --- a/configure.ac +++ b/configure.ac @@ -26,11 +26,15 @@ GUIX_ASSERT_SUPPORTED_SYSTEM AC_ARG_WITH(store-dir, AC_HELP_STRING([--with-store-dir=PATH], - [path of the store (defaults to /nix/store)]), + [file name of the store (defaults to /gnu/store)]), [storedir="$withval"], - [storedir="/nix/store"]) + [storedir="/gnu/store"]) AC_SUBST(storedir) +dnl Better be verbose. +AC_MSG_CHECKING([for the store directory]) +AC_MSG_RESULT([$storedir]) + AC_ARG_ENABLE([daemon], [AS_HELP_STRING([--disable-daemon], [build the Nix daemon (C++)])], [guix_build_daemon="$enableval"], diff --git a/doc/guix.texi b/doc/guix.texi index 97a725a5d4..ddca6e5a1a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -102,7 +102,7 @@ explicit inputs are visible. The result of package build functions is @dfn{cached} in the file system, in a special directory called @dfn{the store} (@pxref{The Store}). Each package is installed in a directory of its own, in the -store---by default under @file{/nix/store}. The directory name contains +store---by default under @file{/gnu/store}. The directory name contains a hash of all the inputs used to build that package; thus, changing an input yields a different directory name. @@ -165,7 +165,7 @@ between both. To do so, you must pass @command{configure} not only the same @code{--with-store-dir} value, but also the same @code{--localstatedir} value. The latter is essential because it specifies where the database that stores metadata about the store is -located, among other things. The default values are +located, among other things. The default values for Nix are @code{--with-store-dir=/nix/store} and @code{--localstatedir=/nix/var}. Note that @code{--disable-daemon} is not required if your goal is to share the store with Nix. @@ -195,7 +195,7 @@ environment. In a standard multi-user setup, Guix and its daemon---the @command{guix-daemon} program---are installed by the system -administrator; @file{/nix/store} is owned by @code{root} and +administrator; @file{/gnu/store} is owned by @code{root} and @command{guix-daemon} runs as @code{root}. Unprivileged users may use Guix tools to build packages or otherwise access the store, and the daemon will do it on their behalf, ensuring that the store is kept in a @@ -577,7 +577,7 @@ management tools it provides. When using Guix, each package ends up in the @dfn{package store}, in its own directory---something that resembles -@file{/nix/store/xxx-package-1.2}, where @code{xxx} is a base32 string. +@file{/gnu/store/xxx-package-1.2}, where @code{xxx} is a base32 string. Instead of referring to these directories, users have their own @dfn{profile}, which points to the packages that they actually want to @@ -586,10 +586,10 @@ use. These profiles are stored within each user's home directory, at For example, @code{alice} installs GCC 4.7.2. As a result, @file{/home/alice/.guix-profile/bin/gcc} points to -@file{/nix/store/@dots{}-gcc-4.7.2/bin/gcc}. Now, on the same machine, +@file{/gnu/store/@dots{}-gcc-4.7.2/bin/gcc}. Now, on the same machine, @code{bob} had already installed GCC 4.8.0. The profile of @code{bob} simply continues to point to -@file{/nix/store/@dots{}-gcc-4.8.0/bin/gcc}---i.e., both versions of GCC +@file{/gnu/store/@dots{}-gcc-4.8.0/bin/gcc}---i.e., both versions of GCC coexist on the same system without any interference. The @command{guix package} command is the central tool to manage @@ -621,7 +621,7 @@ collected. @cindex reproducible builds Finally, Guix takes a @dfn{purely functional} approach to package management, as described in the introduction (@pxref{Introduction}). -Each @file{/nix/store} package directory name contains a hash of all the +Each @file{/gnu/store} package directory name contains a hash of all the inputs that were used to build that package---compiler, libraries, build scripts, etc. This direct correspondence allows users to make sure a given package installation matches the current state of their @@ -632,7 +632,7 @@ machines (@pxref{Invoking guix-daemon, container}). @cindex substitute This foundation allows Guix to support @dfn{transparent binary/source -deployment}. When a pre-built binary for a @file{/nix/store} path is +deployment}. When a pre-built binary for a @file{/gnu/store} path is available from an external source---a @dfn{substitute}, Guix just downloads it@footnote{@c XXX: Remove me when outdated. As of version @value{VERSION}, substitutes are downloaded from @@ -965,10 +965,10 @@ guix package}). @cindex garbage collector Packages that are installed but not used may be @dfn{garbage-collected}. The @command{guix gc} command allows users to explicitly run the garbage -collector to reclaim space from the @file{/nix/store} directory. +collector to reclaim space from the @file{/gnu/store} directory. The garbage collector has a set of known @dfn{roots}: any file under -@file{/nix/store} reachable from a root is considered @dfn{live} and +@file{/gnu/store} reachable from a root is considered @dfn{live} and cannot be deleted; any other file is considered @dfn{dead} and may be deleted. The set of garbage collector roots includes default user profiles, and may be augmented with @command{guix build --root}, for @@ -988,7 +988,7 @@ information. The available options are listed below: @table @code @item --collect-garbage[=@var{min}] @itemx -C [@var{min}] -Collect garbage---i.e., unreachable @file{/nix/store} files and +Collect garbage---i.e., unreachable @file{/gnu/store} files and sub-directories. This is the default operation when no option is specified. @@ -1161,7 +1161,7 @@ containing the @code{gui} output of the @code{git} package and the main output of @code{emacs}: @example -guix archive --export git:gui /nix/store/...-emacs-24.3 > great.nar +guix archive --export git:gui /gnu/store/...-emacs-24.3 > great.nar @end example If the specified packages are not built yet, @command{guix archive} @@ -1183,7 +1183,7 @@ turned into concrete build actions. Build actions are performed by the Guix daemon, on behalf of users. In a standard setup, the daemon has write access to the store---the -@file{/nix/store} directory---whereas users do not. The recommended +@file{/gnu/store} directory---whereas users do not. The recommended setup also has the daemon perform builds in chroots, under a specific build users, to minimize interference with the rest of the system. @@ -1340,7 +1340,7 @@ definition to a new upstream version can be partly automated by the Behind the scenes, a derivation corresponding to the @code{} object is first computed by the @code{package-derivation} procedure. -That derivation is stored in a @code{.drv} file under @file{/nix/store}. +That derivation is stored in a @code{.drv} file under @file{/gnu/store}. The build actions it prescribes may then be realized by using the @code{build-derivations} procedure (@pxref{The Store}). @@ -1379,7 +1379,7 @@ Configure and Build System}). @cindex store paths Conceptually, the @dfn{store} is where derivations that have been -successfully built are stored---by default, under @file{/nix/store}. +successfully built are stored---by default, under @file{/gnu/store}. Sub-directories in the store are referred to as @dfn{store paths}. The store has an associated database that contains information such has the store paths referred to by each store path, and the list of @emph{valid} @@ -1524,7 +1524,7 @@ to a Bash executable in the store: (derivation store "foo" bash `("-e" ,builder) #:env-vars '(("HOME" . "/homeless")))) -@result{} # /nix/store/@dots{}-foo> +@result{} # /gnu/store/@dots{}-foo> @end lisp As can be guessed, this primitive is cumbersome to use directly. An @@ -1568,13 +1568,13 @@ containing one file: @lisp (let ((builder '(let ((out (assoc-ref %outputs "out"))) - (mkdir out) ; create /nix/store/@dots{}-goo + (mkdir out) ; create /gnu/store/@dots{}-goo (call-with-output-file (string-append out "/test") (lambda (p) (display '(hello guix) p)))))) (build-expression->derivation store "goo" builder)) -@result{} # @dots{}> +@result{} # @dots{}> @end lisp @cindex strata of code @@ -1652,7 +1652,7 @@ effect, one must use @code{run-with-store}: @example (run-with-store (open-connection) (profile.sh)) -@result{} /nix/store/...-profile.sh +@result{} /gnu/store/...-profile.sh @end example The main syntactic forms to deal with monads in general are described @@ -1727,7 +1727,7 @@ like this: grep "/bin:" sed "/bin\n")) @end example -In this example, the resulting @file{/nix/store/@dots{}-profile.sh} file +In this example, the resulting @file{/gnu/store/@dots{}-profile.sh} file will references @var{coreutils}, @var{grep}, and @var{sed}, thereby preventing them from being garbage-collected during its lifetime. @end deffn @@ -1787,7 +1787,7 @@ guix build @var{options} @var{package-or-derivation}@dots{} @var{package-or-derivation} may be either the name of a package found in the software distribution such as @code{coreutils} or @code{coreutils-8.20}, or a derivation such as -@file{/nix/store/@dots{}-coreutils-8.19.drv}. In the former case, a +@file{/gnu/store/@dots{}-coreutils-8.19.drv}. In the former case, a package with the corresponding name (and optionally version) is searched for among the GNU distribution modules (@pxref{Package Modules}). @@ -1818,7 +1818,7 @@ Build the packages' source derivations, rather than the packages themselves. For instance, @code{guix build -S gcc} returns something like -@file{/nix/store/@dots{}-gcc-4.7.2.tar.bz2}, which is GCC's source tarball. +@file{/gnu/store/@dots{}-gcc-4.7.2.tar.bz2}, which is GCC's source tarball. The returned source tarball is the result of applying any patches and code snippets specified in the package's @code{origin} (@pxref{Defining @@ -2475,7 +2475,7 @@ etc., at which point we have a working C tool chain. Bootstrapping is complete when we have a full tool chain that does not depend on the pre-built bootstrap tools discussed above. This no-dependency requirement is verified by checking whether the files of -the final tool chain contain references to the @file{/nix/store} +the final tool chain contain references to the @file{/gnu/store} directories of the bootstrap inputs. The process that leads to this ``final'' tool chain is described by the package definitions found in the @code{(gnu packages base)} module. -- cgit v1.2.3 From f5768afa333bbc8167ef2e33db44c9bb64bef0be Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 9 Mar 2014 22:05:29 +0100 Subject: build: Change state and log directories to $localstatedir/.../guix. * daemon.am (libstore_a_CPPFLAGS): Change /nix to /guix. * guix/config.scm.in (%state-directory): Likewise. * guix/store.scm (log-file): Likewise. --- daemon.am | 4 ++-- guix/config.scm.in | 2 +- guix/store.scm | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/daemon.am b/daemon.am index 1059e444ab..abb785592d 100644 --- a/daemon.am +++ b/daemon.am @@ -112,8 +112,8 @@ libstore_a_CPPFLAGS = \ -I$(top_builddir)/nix/libstore \ -DNIX_STORE_DIR=\"$(storedir)\" \ -DNIX_DATA_DIR=\"$(datadir)\" \ - -DNIX_STATE_DIR=\"$(localstatedir)/nix\" \ - -DNIX_LOG_DIR=\"$(localstatedir)/log/nix\" \ + -DNIX_STATE_DIR=\"$(localstatedir)/guix\" \ + -DNIX_LOG_DIR=\"$(localstatedir)/log/guix\" \ -DNIX_CONF_DIR=\"$(sysconfdir)/guix\" \ -DNIX_LIBEXEC_DIR=\"$(libexecdir)\" \ -DNIX_BIN_DIR=\"$(bindir)\" \ diff --git a/guix/config.scm.in b/guix/config.scm.in index 5edb4ced30..eaadae9618 100644 --- a/guix/config.scm.in +++ b/guix/config.scm.in @@ -57,7 +57,7 @@ (define %store-directory (define %state-directory ;; This must match `NIX_STATE_DIR' as defined in `daemon.am'. - (or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/nix")) + (or (getenv "NIX_STATE_DIR") "@guix_localstatedir@/guix")) (define %config-directory ;; This must match `NIX_CONF_DIR' as defined in `daemon.am'. diff --git a/guix/store.scm b/guix/store.scm index e92e159ff4..75edb340ae 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -827,7 +827,7 @@ (define (log-file store file) (cond ((derivation-path? file) (let* ((base (basename file)) (log (string-append (dirname %state-directory) ; XXX - "/log/nix/drvs/" + "/log/guix/drvs/" (string-take base 2) "/" (string-drop base 2))) (log.bz2 (string-append log ".bz2"))) -- cgit v1.2.3 From 02c86a5e365f59fb09c32cfaaef2c02db17e8770 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 9 Mar 2014 22:36:48 +0100 Subject: gnu: Add libpcap and jnettop. * gnu/packages/admin.scm (libpcap, jnettop): New variables. --- gnu/packages/admin.scm | 53 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm index 6998996523..ffedfd3f44 100644 --- a/gnu/packages/admin.scm +++ b/gnu/packages/admin.scm @@ -36,6 +36,9 @@ (define-module (gnu packages admin) #:select (tar)) #:use-module ((gnu packages compression) #:select (gzip)) + #:use-module (gnu packages bison) + #:use-module (gnu packages flex) + #:use-module (gnu packages glib) #:use-module (gnu packages pkg-config)) (define-public dmd @@ -429,3 +432,53 @@ (define-public isc-dhcp reference implementation of all aspects of DHCP, through a suite of DHCP tools: server, client, and relay agent.") (license isc))) + +(define-public libpcap + (package + (name "libpcap") + (version "1.5.3") + (source (origin + (method url-fetch) + (uri (string-append "http://www.tcpdump.org/release/libpcap-" + version ".tar.gz")) + (sha256 + (base32 + "14wyjywrdi1ikaj6yc9c72m6m2r64z94lb0gm7k1a3q6q5cj3scs")))) + (build-system gnu-build-system) + (native-inputs `(("bison" ,bison) ("flex" ,flex))) + (arguments '(#:tests? #f)) ; no 'check' target + (home-page "http://www.tcpdump.org") + (synopsis "Network packet capture library") + (description + "libpcap is an interface for user-level packet capture. It provides a +portable framework for low-level network monitoring. Applications include +network statistics collection, security monitoring, network debugging, etc.") + + ;; fad-*.c and a couple other files are BSD-4, but the rest is BSD-3. + (license bsd-3))) + +(define-public jnettop + (package + (name "jnettop") + (version "0.13.0") + (source (origin + (method url-fetch) + (uri (string-append "http://jnettop.kubs.info/dist/jnettop-" + version ".tar.gz")) + (sha256 + (base32 + "1855np7c4b0bqzhf1l1dyzxb90fpnvrirdisajhci5am6als31z9")))) + (build-system gnu-build-system) + (native-inputs + `(("pkg-config" ,pkg-config))) + (inputs + `(("glib" ,glib) + ("ncurses" ,ncurses) + ("libpcap" ,libpcap))) + (home-page "http://jnettop.kubs.info/") + (synopsis "Visualize network traffic by bandwidth use") + (description + "Jnettop is a traffic visualiser, which captures traffic going +through the host it is running from and displays streams sorted +by bandwidth they use.") + (license gpl2+))) -- cgit v1.2.3 From 6c20d1d0c3822c0332f3cca963121365133e6412 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 9 Mar 2014 23:01:18 +0100 Subject: store: Add #:timeout build option. * guix/serialization.scm (write-string-pairs): New procedure. * guix/store.scm (write-arg): Add 'string-pairs' case. (set-build-options): Add 'timeout' keyword parameter. Honor it. * tests/derivations.scm ("build-expression->derivation and timeout"): New test. --- guix/serialization.scm | 12 +++++++++++- guix/store.scm | 16 +++++++++------- tests/derivations.scm | 14 ++++++++++++++ 3 files changed, 34 insertions(+), 8 deletions(-) diff --git a/guix/serialization.scm b/guix/serialization.scm index 474dc69de5..284b174794 100644 --- a/guix/serialization.scm +++ b/guix/serialization.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,11 +22,13 @@ (define-module (guix serialization) #:use-module (rnrs io ports) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) + #:use-module (ice-9 match) #:export (write-int read-int write-long-long read-long-long write-padding write-string read-string read-latin1-string write-string-list read-string-list + write-string-pairs write-store-path read-store-path write-store-path-list read-store-path-list)) @@ -94,6 +96,14 @@ (define (write-string-list l p) (write-int (length l) p) (for-each (cut write-string <> p) l)) +(define (write-string-pairs l p) + (write-int (length l) p) + (for-each (match-lambda + ((first . second) + (write-string first p) + (write-string second p))) + l)) + (define (read-string-list p) (let ((len (read-int p))) (unfold (cut >= <> len) diff --git a/guix/store.scm b/guix/store.scm index 75edb340ae..909ef195de 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -197,7 +197,7 @@ (define (read-substitutable-path-list p) result)))))) (define-syntax write-arg - (syntax-rules (integer boolean file string string-list + (syntax-rules (integer boolean file string string-list string-pairs store-path store-path-list base16) ((_ integer arg p) (write-int arg p)) @@ -209,6 +209,8 @@ (define-syntax write-arg (write-string arg p)) ((_ string-list arg p) (write-string-list arg p)) + ((_ string-pairs arg p) + (write-string-pairs arg p)) ((_ store-path arg p) (write-store-path arg p)) ((_ store-path-list arg p) @@ -430,6 +432,7 @@ (define* (set-build-options server #:key keep-failed? keep-going? fallback? (verbosity 0) (max-build-jobs (current-processor-count)) + timeout (max-silent-time 3600) (use-build-hook? #t) (build-verbosity 0) @@ -462,12 +465,11 @@ (define socket (when (>= (nix-server-minor-version server) 10) (send (boolean use-substitutes?))) (when (>= (nix-server-minor-version server) 12) - (send (string-list (fold-right (lambda (pair result) - (match pair - ((h . t) - (cons* h t result)))) - '() - binary-caches)))) + (let ((pairs (if timeout + `(("build-timeout" . ,(number->string timeout)) + ,@binary-caches) + binary-caches))) + (send (string-pairs pairs)))) (let loop ((done? (process-stderr server))) (or done? (process-stderr server))))) diff --git a/tests/derivations.scm b/tests/derivations.scm index f31b00b8a2..e87662a198 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -446,6 +446,20 @@ (define %coreutils (build-derivations store (list drv)) #f))) +(test-assert "build-expression->derivation and timeout" + (let* ((store (let ((s (open-connection))) + (set-build-options s #:timeout 1) + s)) + (builder '(begin (sleep 100) (mkdir %output) #t)) + (drv (build-expression->derivation store "slow" builder)) + (out-path (derivation->output-path drv))) + (guard (c ((nix-protocol-error? c) + (and (string-contains (nix-protocol-error-message c) + "failed") + (not (valid-path? store out-path))))) + (build-derivations store (list drv)) + #f))) + (test-assert "build-expression->derivation and derivation-prerequisites-to-build" (let ((drv (build-expression->derivation %store "fail" #f))) ;; The only direct dependency is (%guile-for-build) and it's already -- cgit v1.2.3 From 002622b65b60286209d2c959d590a392afa782b1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 9 Mar 2014 23:09:18 +0100 Subject: guix build: Add '--timeout' to the common build options. * guix/scripts/build.scm (show-build-options-help): Document '--timeout'. (set-build-options-from-command-line): Pass #:timeout to 'set-build-options'. (%standard-build-options): Add '--timeout'. * doc/guix.texi (Invoking guix build): Document it. --- doc/guix.texi | 7 +++++++ guix/scripts/build.scm | 8 ++++++++ 2 files changed, 15 insertions(+) diff --git a/doc/guix.texi b/doc/guix.texi index ddca6e5a1a..150747f445 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1903,6 +1903,13 @@ instead of offloading builds to remote machines. When the build or substitution process remains silent for more than @var{seconds}, terminate it and report a build failure. +@item --timeout=@var{seconds} +Likewise, when the build or substitution process lasts for more than +@var{seconds}, terminate it and report a build failure. + +By default there is no timeout. This behavior can be restored with +@code{--timeout=0}. + @item --verbosity=@var{level} Use the given verbosity level. @var{level} must be an integer between 0 and 5; higher means more verbose output. Setting a level of 4 or more diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 14b8f2d6bd..618015e9ba 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -126,6 +126,8 @@ (define (show-build-options-help) (display (_ " --max-silent-time=SECONDS mark the build as failed after SECONDS of silence")) + (display (_ " + --timeout=SECONDS mark the build as failed after SECONDS of activity")) (display (_ " --verbosity=LEVEL use the given verbosity LEVEL")) (display (_ " @@ -142,6 +144,7 @@ (define (set-build-options-from-command-line store opts) #:use-substitutes? (assoc-ref opts 'substitutes?) #:use-build-hook? (assoc-ref opts 'build-hook?) #:max-silent-time (assoc-ref opts 'max-silent-time) + #:timeout (assoc-ref opts 'timeout) #:verbosity (assoc-ref opts 'verbosity))) (define %standard-build-options @@ -175,6 +178,11 @@ (define %standard-build-options (alist-cons 'max-silent-time (string->number* arg) result) rest))) + (option '("timeout") #t #f + (lambda (opt name arg result . rest) + (apply values + (alist-cons 'timeout (string->number* arg) result) + rest))) (option '("verbosity") #t #f (lambda (opt name arg result . rest) (let ((level (string->number arg))) -- cgit v1.2.3 From 714084e6c08ec6226ad38655153d307a198b7a73 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 9 Mar 2014 23:13:53 +0100 Subject: offload: Honor absolute build timeouts. * guix/scripts/offload.scm (offload): Remove default value for 'build-timeout'. Pass '--timeout' to the remote 'guix build' process. (transfer-and-offload, process-request): Remove default value for 'build-timeout'. --- guix/scripts/offload.scm | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index cb979fb929..4d2f78f711 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -256,7 +256,7 @@ (define (release-build-slot slot) (define* (offload drv machine #:key print-build-trace? (max-silent-time 3600) - (build-timeout 7200) (log-port (current-output-port))) + build-timeout (log-port (current-output-port))) "Perform DRV on MACHINE, assuming DRV and its prerequisites are available there, and write the build log to LOG-PORT. Return the exit status." (format (current-error-port) "offloading '~a' to '~a'...~%" @@ -267,9 +267,12 @@ (define* (offload drv machine ;; FIXME: Protect DRV from garbage collection on MACHINE. (let ((pipe (remote-pipe machine OPEN_READ `("guix" "build" - ;; FIXME: more options ,(format #f "--max-silent-time=~a" max-silent-time) + ,@(if build-timeout + (list (format #f "--timeout=~a" + build-timeout)) + '()) ,(derivation-file-name drv))))) (let loop ((line (read-line pipe))) (unless (eof-object? line) @@ -284,7 +287,7 @@ (define* (transfer-and-offload drv machine (inputs '()) (outputs '()) (max-silent-time 3600) - (build-timeout 7200) + build-timeout print-build-trace?) "Offload DRV to MACHINE. Prior to the actual offloading, transfer all of INPUTS to MACHINE; if building DRV succeeds, retrieve all of OUTPUTS from @@ -485,7 +488,7 @@ (define (undecorate pred) (define* (process-request wants-local? system drv features #:key print-build-trace? (max-silent-time 3600) - (build-timeout 7200)) + build-timeout) "Process a request to build DRV." (let* ((local? (and wants-local? (string=? system (%current-system)))) (reqs (build-requirements -- cgit v1.2.3 From 8a1f6a7e02afbe63dfa1193282c8b6807b845db2 Mon Sep 17 00:00:00 2001 From: Eric Bavier Date: Mon, 10 Mar 2014 11:03:16 -0500 Subject: gnu: pretty-print: Fix boost reference * gnu/packages/pretty-print.scm (source-highlight): Change "boost-1.54" input to "boost" --- gnu/packages/pretty-print.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/packages/pretty-print.scm b/gnu/packages/pretty-print.scm index 98663cd834..0bfbeb7229 100644 --- a/gnu/packages/pretty-print.scm +++ b/gnu/packages/pretty-print.scm @@ -179,7 +179,7 @@ (define-public source-highlight ;; The ctags that comes with emacs does not support the --excmd options, ;; so can't be used (inputs - `(("boost" ,boost-1.54))) + `(("boost" ,boost))) (native-inputs `(("bison" ,bison) ("flex" ,flex) -- cgit v1.2.3 From 5ff3c4b8207eb2fbbc48c9f429ccb65690def5ee Mon Sep 17 00:00:00 2001 From: Pierre-Antoine Rault Date: Sun, 9 Mar 2014 17:10:27 +0100 Subject: doc: Update packaging guidelines. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * HACKING (Submitting Patches): Mention 'git send-mail'. * doc/guix.texi (Packaging Guidelines): More details on how to prepare a package module. (Contributing): Add reference to #guix channel on Freenode. Co-authored-by: Ludovic Courtès --- HACKING | 9 +++++++-- doc/guix.texi | 17 +++++++++++++---- 2 files changed, 20 insertions(+), 6 deletions(-) diff --git a/HACKING b/HACKING index 0dc2908318..6600397554 100644 --- a/HACKING +++ b/HACKING @@ -2,8 +2,9 @@ #+TITLE: Hacking GNU Guix and Its Incredible Distro -Copyright © 2012, 2013 Ludovic Courtès +Copyright © 2012, 2013, 2014 Ludovic Courtès Copyright © 2013 Nikita Karetnikov +Copyright © 2014 Pierre-Antoine Rault Copying and distribution of this file, with or without modification, are permitted in any medium without royalty provided the copyright @@ -85,7 +86,11 @@ wrapping it, swallowing or rejecting the following s-expression, etc. Development is done using the Git distributed version control system. Thus, access to the repository is not strictly necessary. We welcome contributions in the form of patches as produced by ‘git format-patch’ sent to -guix-devel@gnu.org. Please write commit logs in the [[http://www.gnu.org/prep/standards/html_node/Change-Logs.html#Change-Logs][GNU ChangeLog format]]. +guix-devel@gnu.org. Please write commit logs in the [[http://www.gnu.org/prep/standards/html_node/Change-Logs.html#Change-Logs][GNU ChangeLog +format]]; you can check the commit history for examples. + +When posting a patch to the mailing list, use "[PATCH] ..." as a subject. You +may use your email client or the ‘git send-mail’ command. As you become a regular contributor, you may find it convenient to have write access to the repository (see below.) diff --git a/doc/guix.texi b/doc/guix.texi index 150747f445..701b5400f8 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2270,6 +2270,15 @@ called @code{gnew}, you may run this command from the Guix build tree: Using @code{--keep-failed} makes it easier to debug build failures since it provides access to the failed build tree. +If the package is unknown to the @command{guix} command, it may be that +the source file contains a syntax error, or lacks a @code{define-public} +clause to export the package variable. To figure it out, you may load +the module from Guile to get more information about the actual error: + +@example +./pre-inst-env guile -c '(use-modules (gnu packages gnew))' +@end example + Once your package builds correctly, please send us a patch (@pxref{Contributing}). Well, if you need help, we will be happy to help you too. Once the patch is committed in the Guix repository, the @@ -2784,10 +2793,10 @@ deco,,, dmd, GNU dmd Manual}). @chapter Contributing This project is a cooperative effort, and we need your help to make it -grow! Please get in touch with us on @email{guix-devel@@gnu.org}. We -welcome ideas, bug reports, patches, and anything that may be helpful to -the project. We particularly welcome help on packaging -(@pxref{Packaging Guidelines}). +grow! Please get in touch with us on @email{guix-devel@@gnu.org} and +@code{#guix} on the Freenode IRC network. We welcome ideas, bug +reports, patches, and anything that may be helpful to the project. We +particularly welcome help on packaging (@pxref{Packaging Guidelines}). Please see the @url{http://git.savannah.gnu.org/cgit/guix.git/tree/HACKING, -- cgit v1.2.3 From 220193ad038b1aabb776d032526ad4546f76447e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 Mar 2014 22:31:08 +0100 Subject: gnu: Add UnionFS-FUSE. * gnu/packages/linux.scm (unionfs-fuse): New variable. --- gnu/packages/linux.scm | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index 3fca5dfaf9..e1668b1d6b 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -40,6 +40,7 @@ (define-module (gnu packages linux) #:use-module (guix packages) #:use-module (guix download) #:use-module (guix build-system gnu) + #:use-module (guix build-system cmake) #:use-module (guix build-system python)) (define-public (system->linux-architecture arch) @@ -920,3 +921,27 @@ (define-public fuse user-space processes.") (license (list lgpl2.1 ; library gpl2+)))) ; command-line utilities + +(define-public unionfs-fuse + (package + (name "unionfs-fuse") + (version "0.26") + (source (origin + (method url-fetch) + (uri (string-append + "http://podgorny.cz/unionfs-fuse/releases/unionfs-fuse-" + version ".tar.xz")) + (sha256 + (base32 + "0qpnr4czgc62vsfnmv933w62nq3xwcbnvqch72qakfgca75rsp4d")))) + (build-system cmake-build-system) + (inputs `(("fuse" ,fuse))) + (arguments '(#:tests? #f)) ; no tests + (home-page "http://podgorny.cz/moin/UnionFsFuse") + (synopsis "User-space union file system") + (description + "UnionFS-FUSE is a flexible union file system implementation in user +space, using the FUSE library. Mounting a union file system allows you to +\"aggregate\" the contents of several directories into a single mount point. +UnionFS-FUSE additionally supports copy-on-write.") + (license bsd-3))) -- cgit v1.2.3 From 58cbbe4b5562ed8be5c7c6fbdf2b2d8384a5dc8a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 Mar 2014 23:02:43 +0100 Subject: tests: 'topologically-sorted' test handles different references orders. * tests/store.scm ("topologically-sorted, more difficult"): Arrange to handle a different ordering of (references %store y). --- tests/store.scm | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/tests/store.scm b/tests/store.scm index cc76ea5500..8a25c7353b 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -190,9 +190,18 @@ (define (same? x y) (s1 (topologically-sorted %store (list y))) (s2 (topologically-sorted %store (list c y))) (s3 (topologically-sorted %store (cons y (references %store y))))) - (and (equal? s1 (list w x a b c d y)) - (equal? s2 (list a b c w x d y)) - (lset= string=? s1 s3)))) + ;; The order in which 'references' returns the references of Y is + ;; unspecified, so accommodate. + (let* ((x-then-d? (equal? (references %store y) (list x d)))) + (and (equal? s1 + (if x-then-d? + (list w x a b c d y) + (list a b c d w x y))) + (equal? s2 + (if x-then-d? + (list a b c w x d y) + (list a b c d w x y))) + (lset= string=? s1 s3))))) (test-assert "log-file, derivation" (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '())) -- cgit v1.2.3 From c9c88118a12b0e22b7369b1dc6b0e2f9db894986 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 Mar 2014 23:16:02 +0100 Subject: gnu: linux-initrd: Make the pseudo-tty device nodes. * guix/build/linux-initrd.scm (make-essential-device-nodes): Create /dev/ptmx and /dev/pts. * gnu/system/vm.scm (qemu-image): Umount /fs/dev/pts before /fs. --- gnu/system/vm.scm | 8 +++++++- guix/build/linux-initrd.scm | 8 ++++++++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index b8b0274f1f..b6a777353f 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -383,7 +383,13 @@ (define (graph-from-file file) (system* grub "--no-floppy" "--boot-directory" "/fs/boot" "/dev/sda")) - (zero? (system* umount "/fs")) + (begin + (when (file-exists? "/fs/dev/pts") + ;; Unmount devpts so /fs itself can be + ;; unmounted (failing to do that leads to + ;; EBUSY.) + (system* umount "/fs/dev/pts")) + (zero? (system* umount "/fs"))) (reboot)))))))) #:system system #:inputs `(("parted" ,parted) diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm index 80ce679496..9a8ea0ed4f 100644 --- a/guix/build/linux-initrd.scm +++ b/guix/build/linux-initrd.scm @@ -114,6 +114,14 @@ (define (scope dir) (device-number 4 n)) (loop (+ 1 n))))) + ;; Pseudo ttys. + (mknod (scope "dev/ptmx") 'char-special #o666 + (device-number 5 2)) + + (unless (file-exists? (scope "dev/pts")) + (mkdir (scope "dev/pts"))) + (mount "none" (scope "dev/pts") "devpts") + ;; Rendez-vous point for syslogd. (mknod (scope "dev/log") 'socket #o666 0) (mknod (scope "dev/kmsg") 'char-special #o600 (device-number 1 11)) -- cgit v1.2.3