From 71eb5c1067dcd1d32f881b01cecf36a4121aef9d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 5 Mar 2013 10:16:17 +0100 Subject: gnu: Add intltool. * guix/download.scm (%mirrors): Add `gnome' mirrors. * gnu/packages/glib.scm (intltool): New variable. --- guix/download.scm | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'guix') diff --git a/guix/download.scm b/guix/download.scm index b6bf6a0822..8dcfc7cb9a 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -67,6 +67,11 @@ (define %mirrors "ftp://trumpetti.atm.tut.fi/gcrypt/" "ftp://mirror.cict.fr/gnupg/" "ftp://ftp.strasbourg.linuxfr.org/pub/gnupg/") + (gnome + "http://ftp.belnet.be/ftp.gnome.org/" + "http://ftp.linux.org.uk/mirrors/ftp.gnome.org/" + "http://ftp.gnome.org/pub/GNOME/" + "http://mirror.yandex.ru/mirrors/ftp.gnome.org/") (savannah "http://download.savannah.gnu.org/releases/" "ftp://ftp.twaren.net/Unix/NonGNU/" -- cgit v1.2.3 From ef010c0f3d414f7107de80e0835d1e347b04315b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 5 Mar 2013 20:30:27 +0100 Subject: guix package: Inform about new upstream versions of GNU packages. * guix/gnu-maintenance.scm (gnu-package?): New procedure. * guix/scripts/package.scm (waiting): New macro. (check-package-freshness): New procedure. (guix-package)[process-actions]: Use it. * doc/guix.texi (Invoking guix package): Mention the feature. --- doc/guix.texi | 6 ++++++ guix/gnu-maintenance.scm | 14 ++++++++++++++ guix/scripts/package.scm | 34 ++++++++++++++++++++++++++++++++++ 3 files changed, 54 insertions(+) (limited to 'guix') diff --git a/doc/guix.texi b/doc/guix.texi index a07c277e70..1be172c3f6 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -514,6 +514,12 @@ Thus, when installing MPC, the MPFR and GMP libraries also get installed in the profile; removing MPC also removes MPFR and GMP---unless they had also been explicitly installed independently. +@c XXX: keep me up-to-date +Besides, when installing a GNU package, the tool reports the +availability of a newer upstream version. In the future, it may provide +the option of installing directly from the upstream version, even if +that version is not yet in the distribution. + @item --install-from-expression=@var{exp} @itemx -e @var{exp} Install the package @var{exp} evaluates to. diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 6475c386d3..981bb81919 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -29,7 +29,9 @@ (define-module (guix gnu-maintenance) #:use-module (system foreign) #:use-module (guix ftp-client) #:use-module (guix utils) + #:use-module (guix packages) #:export (official-gnu-packages + gnu-package? releases latest-release gnu-package-name->name+version)) @@ -74,6 +76,18 @@ (define %package-line-rx (and=> (regexp-exec %package-line-rx line) (cut match:substring <> 1))) lst))) + +(define gnu-package? + (memoize + (lambda (package) + "Return true if PACKAGE is a GNU package. This procedure may access the +network to check in GNU's database." + ;; TODO: Find a way to determine that a package is non-GNU without going + ;; through the network. + (let ((url (origin-uri (package-source package)))) + (or (string-prefix? "mirror://gnu" url) + (member (package-name package) (official-gnu-packages))))))) + ;;; ;;; Latest release. diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index ccca614d88..61b2f0570d 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -39,6 +39,7 @@ (define-module (guix scripts package) #:use-module (gnu packages) #:use-module ((gnu packages base) #:select (guile-final)) #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile)) + #:use-module (guix gnu-maintenance) #:export (guix-package)) (define %store @@ -266,6 +267,38 @@ (define (input->name+path input) (assoc-ref (derivation-outputs drv) sub-drv)))) `(,name ,out)))))) +(define-syntax-rule (waiting exp fmt rest ...) + "Display the given message while EXP is being evaluated." + (let* ((message (format #f fmt rest ...)) + (blank (make-string (string-length message) #\space))) + (display message (current-error-port)) + (force-output (current-error-port)) + (let ((result exp)) + ;; Clear the line. + (display #\cr (current-error-port)) + (display blank (current-error-port)) + (display #\cr (current-error-port)) + (force-output (current-error-port)) + exp))) + +(define (check-package-freshness package) + "Check whether PACKAGE has a newer version available upstream, and report +it." + ;; TODO: Automatically inject the upstream version when desired. + (when (gnu-package? package) + (let ((name (package-name package)) + (full-name (package-full-name package))) + (match (waiting (latest-release name) + (_ "looking for the latest release of GNU ~a...") name) + ((latest-version . _) + (when (version>? latest-version full-name) + (format (current-error-port) + (_ "~a: note: using ~a \ +but ~a is available upstream~%") + (location->string (package-location package)) + full-name latest-version))) + (_ #t))))) + ;;; ;;; Command-line options. @@ -547,6 +580,7 @@ (define (package->tuple p) ((name version sub-drv (? package? package) (deps ...)) + (check-package-freshness package) (package-derivation (%store) package)) (_ #f)) install)) -- cgit v1.2.3 From 19777ae6ea35cfe4d23ae7096751971c3bf86722 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 5 Mar 2013 22:24:19 +0100 Subject: guix package: Recover from freshness check transient errors. * guix/scripts/package.scm (check-package-freshness): Ignore `getaddrinfo-error' and `ftp-error' exceptions. --- guix/scripts/package.scm | 33 +++++++++++++++++++++------------ 1 file changed, 21 insertions(+), 12 deletions(-) (limited to 'guix') diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 61b2f0570d..dd7d6ca112 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -285,19 +285,28 @@ (define (check-package-freshness package) "Check whether PACKAGE has a newer version available upstream, and report it." ;; TODO: Automatically inject the upstream version when desired. - (when (gnu-package? package) - (let ((name (package-name package)) - (full-name (package-full-name package))) - (match (waiting (latest-release name) - (_ "looking for the latest release of GNU ~a...") name) - ((latest-version . _) - (when (version>? latest-version full-name) - (format (current-error-port) - (_ "~a: note: using ~a \ + + (catch #t + (lambda () + (when (gnu-package? package) + (let ((name (package-name package)) + (full-name (package-full-name package))) + (match (waiting (latest-release name) + (_ "looking for the latest release of GNU ~a...") name) + ((latest-version . _) + (when (version>? latest-version full-name) + (format (current-error-port) + (_ "~a: note: using ~a \ but ~a is available upstream~%") - (location->string (package-location package)) - full-name latest-version))) - (_ #t))))) + (location->string (package-location package)) + full-name latest-version))) + (_ #t))))) + (lambda (key . args) + ;; Silently ignore networking errors rather than preventing + ;; installation. + (case key + ((getaddrinfo-error ftp-error) #f) + (else (apply throw key args)))))) ;;; -- cgit v1.2.3 From 296540a6dbd594a34e6ea3c223081f123ce30c7a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 5 Mar 2013 22:25:40 +0100 Subject: gnu-maintenance: Fix `gnu-package?' for packages lacking a `source'. * guix/gnu-maintenance.scm (gnu-package?): Support PACKAGE when its source is #f. --- guix/gnu-maintenance.scm | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 981bb81919..184875300a 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -84,9 +84,10 @@ (define gnu-package? network to check in GNU's database." ;; TODO: Find a way to determine that a package is non-GNU without going ;; through the network. - (let ((url (origin-uri (package-source package)))) - (or (string-prefix? "mirror://gnu" url) - (member (package-name package) (official-gnu-packages))))))) + (let ((url (and=> (package-source package) origin-uri))) + (or (and (string? url) (string-prefix? "mirror://gnu" url)) + (and (member (package-name package) (official-gnu-packages)) + #t)))))) ;;; -- cgit v1.2.3 From 6a917ef7e6a7958a86a280215e1c262bf5b9b259 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 5 Mar 2013 22:31:19 +0100 Subject: gnu-maintenance: Clarify `releases'. * guix/gnu-maintenance.scm (releases): Change to use `match' and `match-lambda'. Add `release-file' auxiliary function. --- guix/gnu-maintenance.scm | 66 +++++++++++++++++++++++++----------------------- 1 file changed, 34 insertions(+), 32 deletions(-) (limited to 'guix') diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 184875300a..cde31aaa7b 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -134,43 +134,45 @@ (define (sans-extension tarball) (let ((end (string-contains tarball ".tar"))) (substring tarball 0 end))) + (define (release-file file) + ;; Return #f if FILE is not a release tarball, otherwise return + ;; PACKAGE-VERSION. + (and (not (string-suffix? ".sig" file)) + (regexp-exec release-rx file) + (not (regexp-exec alpha-rx file)) + (let ((s (sans-extension file))) + (and (regexp-exec %package-name-rx s) s)))) + (let-values (((server directory) (ftp-server/directory project))) (define conn (ftp-open server)) (let loop ((directories (list directory)) (result '())) - (if (null? directories) - (begin - (ftp-close conn) - result) - (let* ((directory (car directories)) - (files (ftp-list conn directory)) - (subdirs (filter-map (lambda (file) - (match file - ((name 'directory . _) name) - (_ #f))) - files))) - (loop (append (map (cut string-append directory "/" <>) - subdirs) - (cdr directories)) - (append - ;; Filter out signatures, deltas, and files which - ;; are potentially not releases of PROJECT--e.g., - ;; in /gnu/guile, filter out guile-oops and - ;; guile-www; in mit-scheme, filter out binaries. - (filter-map (lambda (file) - (match file - ((file 'file . _) - (and (not (string-suffix? ".sig" file)) - (regexp-exec release-rx file) - (not (regexp-exec alpha-rx file)) - (let ((s (sans-extension file))) - (and (regexp-exec - %package-name-rx s) - (cons s directory))))) - (_ #f))) - files) - result))))))) + (match directories + (() + (ftp-close conn) + result) + ((directory rest ...) + (let* ((files (ftp-list conn directory)) + (subdirs (filter-map (match-lambda + ((name 'directory . _) name) + (_ #f)) + files))) + (loop (append (map (cut string-append directory "/" <>) + subdirs) + rest) + (append + ;; Filter out signatures, deltas, and files which + ;; are potentially not releases of PROJECT--e.g., + ;; in /gnu/guile, filter out guile-oops and + ;; guile-www; in mit-scheme, filter out binaries. + (filter-map (match-lambda + ((file 'file . _) + (and=> (release-file file) + (cut cons <> directory))) + (_ #f)) + files) + result)))))))) (define (latest-release project) "Return (\"FOO-X.Y\" . \"/bar/foo\") or #f." -- cgit v1.2.3 From bbd60260dd3f40398a1da7d3beabc29ac02976fb Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Mon, 4 Mar 2013 01:08:24 +0000 Subject: licenses: Add 'x11-style'. * guix/licenses.scm (x11-style): New variable. --- guix/licenses.scm | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/licenses.scm b/guix/licenses.scm index 4e4aee2036..9c4e17737a 100644 --- a/guix/licenses.scm +++ b/guix/licenses.scm @@ -39,7 +39,7 @@ (define-module (guix licenses) psfl public-domain qpl vim - x11 + x11 x11-style zlib fsf-free)) @@ -236,6 +236,16 @@ (define x11 "http://directory.fsf.org/wiki/License:X11" "https://www.gnu.org/licenses/license-list#X11License")) +(define* (x11-style uri #:optional (comment "")) + "Return an X11-style license, whose full text can be found at URI, +which may be a file:// URI pointing the package's tree." + (license "X11-style" + uri + (string-append + "This is an X11-style, non-copyleft free software license. " + "Check the URI for details. " + comment))) + (define zlib (license "Zlib" "http://www.gzip.org/zlib/zlib_license.html" -- cgit v1.2.3 From 02065130de33e990969fe9b7cc19b9b1c24f3ff7 Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Sun, 3 Mar 2013 23:20:28 +0000 Subject: utils: Add 'wrap-program'. * guix/build/utils.scm (wrap-program): New procedure. --- guix/build/utils.scm | 68 +++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 67 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 6921e31bdd..7391f54e77 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2013 Nikita Karetnikov ;;; ;;; This file is part of GNU Guix. ;;; @@ -49,7 +50,8 @@ (define-module (guix build utils) patch-shebang patch-makefile-SHELL fold-port-matches - remove-store-references)) + remove-store-references + wrap-program)) ;;; @@ -605,6 +607,70 @@ (define pattern (put-u8 out (char->integer char)) result)))))) +(define* (wrap-program prog #:rest vars) + "Rename PROG to .PROG-real and make PROG a wrapper. VARS should look like +this: + + '(VARIABLE DELIMITER POSITION LIST-OF-DIRECTORIES) + +where DELIMITER is optional. ':' will be used if DELIMITER is not given. + +For example, this command: + + (wrap-program \"foo\" + '(\"PATH\" \":\" = (\"/nix/.../bar/bin\")) + '(\"CERT_PATH\" suffix (\"/nix/.../baz/certs\" + \"/qux/certs\"))) + +will copy 'foo' to '.foo-real' and create the file 'foo' with the following +contents: + + #!location/of/bin/bash + export PATH=\"/nix/.../bar/bin\" + export CERT_PATH=\"$CERT_PATH${CERT_PATH:+:}/nix/.../baz/certs:/qux/certs\" + exec location/of/.foo-real + +This is useful for scripts that expect particular programs to be in $PATH, for +programs that expect particular shared libraries to be in $LD_LIBRARY_PATH, or +modules in $GUILE_LOAD_PATH, etc." + (let ((prog-real (string-append "." prog "-real")) + (prog-tmp (string-append "." prog "-tmp"))) + (define (export-variable lst) + ;; Return a string that exports an environment variable. + (match lst + ((var sep '= rest) + (format #f "export ~a=\"~a\"" + var (string-join rest sep))) + ((var sep 'prefix rest) + (format #f "export ~a=\"~a${~a~a+~a}$~a\"" + var (string-join rest sep) var sep sep var)) + ((var sep 'suffix rest) + (format #f "export ~a=\"$~a${~a~a+~a}~a\"" + var var var sep sep (string-join rest sep))) + ((var '= rest) + (format #f "export ~a=\"~a\"" + var (string-join rest ":"))) + ((var 'prefix rest) + (format #f "export ~a=\"~a${~a:+:}$~a\"" + var (string-join rest ":") var var)) + ((var 'suffix rest) + (format #f "export ~a=\"$~a${~a:+:}~a\"" + var var var (string-join rest ":"))))) + + (copy-file prog prog-real) + + (with-output-to-file prog-tmp + (lambda () + (format #t + "#!~a~%~a~%exec ~a~%" + (which "bash") + (string-join (map export-variable vars) + "\n") + (canonicalize-path prog-real)))) + + (chmod prog-tmp #o755) + (rename-file prog-tmp prog))) + ;;; Local Variables: ;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1) ;;; eval: (put 'with-throw-handler 'scheme-indent-function 1) -- cgit v1.2.3 From 6ba9dd813db7c528cb99e442a066bcf832f27330 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 7 Mar 2013 00:36:14 +0100 Subject: Revert "utils: Add 'wrap-program'." This reverts commit 02065130de33e990969fe9b7cc19b9b1c24f3ff7. --- guix/build/utils.scm | 68 +--------------------------------------------------- 1 file changed, 1 insertion(+), 67 deletions(-) (limited to 'guix') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 7391f54e77..6921e31bdd 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -1,6 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Ludovic Courtès -;;; Copyright © 2013 Nikita Karetnikov ;;; ;;; This file is part of GNU Guix. ;;; @@ -50,8 +49,7 @@ (define-module (guix build utils) patch-shebang patch-makefile-SHELL fold-port-matches - remove-store-references - wrap-program)) + remove-store-references)) ;;; @@ -607,70 +605,6 @@ (define pattern (put-u8 out (char->integer char)) result)))))) -(define* (wrap-program prog #:rest vars) - "Rename PROG to .PROG-real and make PROG a wrapper. VARS should look like -this: - - '(VARIABLE DELIMITER POSITION LIST-OF-DIRECTORIES) - -where DELIMITER is optional. ':' will be used if DELIMITER is not given. - -For example, this command: - - (wrap-program \"foo\" - '(\"PATH\" \":\" = (\"/nix/.../bar/bin\")) - '(\"CERT_PATH\" suffix (\"/nix/.../baz/certs\" - \"/qux/certs\"))) - -will copy 'foo' to '.foo-real' and create the file 'foo' with the following -contents: - - #!location/of/bin/bash - export PATH=\"/nix/.../bar/bin\" - export CERT_PATH=\"$CERT_PATH${CERT_PATH:+:}/nix/.../baz/certs:/qux/certs\" - exec location/of/.foo-real - -This is useful for scripts that expect particular programs to be in $PATH, for -programs that expect particular shared libraries to be in $LD_LIBRARY_PATH, or -modules in $GUILE_LOAD_PATH, etc." - (let ((prog-real (string-append "." prog "-real")) - (prog-tmp (string-append "." prog "-tmp"))) - (define (export-variable lst) - ;; Return a string that exports an environment variable. - (match lst - ((var sep '= rest) - (format #f "export ~a=\"~a\"" - var (string-join rest sep))) - ((var sep 'prefix rest) - (format #f "export ~a=\"~a${~a~a+~a}$~a\"" - var (string-join rest sep) var sep sep var)) - ((var sep 'suffix rest) - (format #f "export ~a=\"$~a${~a~a+~a}~a\"" - var var var sep sep (string-join rest sep))) - ((var '= rest) - (format #f "export ~a=\"~a\"" - var (string-join rest ":"))) - ((var 'prefix rest) - (format #f "export ~a=\"~a${~a:+:}$~a\"" - var (string-join rest ":") var var)) - ((var 'suffix rest) - (format #f "export ~a=\"$~a${~a:+:}~a\"" - var var var (string-join rest ":"))))) - - (copy-file prog prog-real) - - (with-output-to-file prog-tmp - (lambda () - (format #t - "#!~a~%~a~%exec ~a~%" - (which "bash") - (string-join (map export-variable vars) - "\n") - (canonicalize-path prog-real)))) - - (chmod prog-tmp #o755) - (rename-file prog-tmp prog))) - ;;; Local Variables: ;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1) ;;; eval: (put 'with-throw-handler 'scheme-indent-function 1) -- cgit v1.2.3 From 1fb78cb2c36a6b0d7a3ecf1f7150c4d99b01c1a9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 7 Mar 2013 00:42:18 +0100 Subject: packages: Remove the default value for `license'. * guix/packages.scm (): Remove the default value for `license'. * gnu/packages/bootstrap.scm (package-from-tarball, %bootstrap-glibc, %bootstrap-gcc): Initialize `license'. * tests/packages.scm (dummy-package): Likewise. --- gnu/packages/bootstrap.scm | 9 ++++++--- guix/packages.scm | 2 +- tests/packages.scm | 2 +- 3 files changed, 8 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm index 22ee98879a..ffe1ec6528 100644 --- a/gnu/packages/bootstrap.scm +++ b/gnu/packages/bootstrap.scm @@ -104,7 +104,8 @@ (define (package-from-tarball name* source* program-to-test description*) ("tarball" ,(bootstrap-origin (source* (%current-system)))))) (synopsis description*) (description #f) - (home-page #f))) + (home-page #f) + (license #f))) (define package-with-bootstrap-guile (memoize @@ -284,7 +285,8 @@ (define %bootstrap-glibc "08hv8i0axwnihrcgbz19x0a7s6zyv3yx38x8r29liwl8h82x9g88"))))))))) (synopsis "Bootstrap binaries and headers of the GNU C Library") (description #f) - (home-page #f))) + (home-page #f) + (license lgpl2.1+))) (define %bootstrap-gcc ;; The initial GCC. Uses binaries from a tarball typically built by @@ -351,7 +353,8 @@ (define %bootstrap-gcc "06wqs0xxnpw3hn0xjb4c9cs0899p1xwkcysa2rvzhvpra0c5vsg2"))))))))) (synopsis "Bootstrap binaries of the GNU Compiler Collection") (description #f) - (home-page #f))) + (home-page #f) + (license gpl3+))) (define %bootstrap-inputs ;; The initial, pre-built inputs. From now on, we can start building our diff --git a/guix/packages.scm b/guix/packages.scm index 51984baa3b..81f09d638e 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -135,7 +135,7 @@ (define-record-type* (synopsis package-synopsis) ; one-line description (description package-description) ; one or two paragraphs - (license package-license (default '())) + (license package-license) (home-page package-home-page) (platforms package-platforms (default '())) (maintainers package-maintainers (default '())) diff --git a/tests/packages.scm b/tests/packages.scm index f441532d22..c5d9d280ed 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -49,7 +49,7 @@ (define-syntax-rule (dummy-package name* extra-fields ...) (package (name name*) (version "0") (source #f) (build-system gnu-build-system) (synopsis #f) (description #f) - (home-page #f) + (home-page #f) (license #f) extra-fields ...)) (test-assert "package-transitive-inputs" -- cgit v1.2.3 From ef86c39f27b0d1c21435ea54cba5fb247e341537 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 7 Mar 2013 19:29:12 +0100 Subject: ui: Gracefully report failures to connect to the daemon. * guix/store.scm (&nix-connection-error): New condition type. (open-connection): Translate `system-error' during the `connect' call into `&nix-connection-error'. * guix/ui.scm (call-with-error-handling): Add case for `nix-connection-error?'. * guix/scripts/package.scm (guix-package): Move `open-connection' call within `with-error-handling'. * guix/scripts/pull.scm (guix-pull): Likewise. * guix/scripts/download.scm (guix-download): Move body within `with-error-handling'. --- guix/scripts/download.scm | 47 ++++++++++++++++++++++++----------------------- guix/scripts/package.scm | 4 ++-- guix/scripts/pull.scm | 6 +++--- guix/store.scm | 18 +++++++++++++++++- guix/ui.scm | 4 ++++ 5 files changed, 50 insertions(+), 29 deletions(-) (limited to 'guix') diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm index 3dc227fdcd..3f989a3494 100644 --- a/guix/scripts/download.scm +++ b/guix/scripts/download.scm @@ -110,26 +110,27 @@ (define (parse-options) (alist-cons 'argument arg result)) %default-options)) - (let* ((opts (parse-options)) - (store (open-connection)) - (arg (assq-ref opts 'argument)) - (uri (or (string->uri arg) - (leave (_ "guix-download: ~a: failed to parse URI~%") - arg))) - (path (case (uri-scheme uri) - ((file) - (add-to-store store (basename (uri-path uri)) - #f "sha256" (uri-path uri))) - (else - (fetch-and-store store - (cut url-fetch arg <> - #:mirrors %mirrors) - (basename (uri-path uri)))))) - (hash (call-with-input-file - (or path - (leave (_ "guix-download: ~a: download failed~%") - arg)) - (compose sha256 get-bytevector-all))) - (fmt (assq-ref opts 'format))) - (format #t "~a~%~a~%" path (fmt hash)) - #t)) + (with-error-handling + (let* ((opts (parse-options)) + (store (open-connection)) + (arg (assq-ref opts 'argument)) + (uri (or (string->uri arg) + (leave (_ "guix-download: ~a: failed to parse URI~%") + arg))) + (path (case (uri-scheme uri) + ((file) + (add-to-store store (basename (uri-path uri)) + #f "sha256" (uri-path uri))) + (else + (fetch-and-store store + (cut url-fetch arg <> + #:mirrors %mirrors) + (basename (uri-path uri)))))) + (hash (call-with-input-file + (or path + (leave (_ "guix-download: ~a: download failed~%") + arg)) + (compose sha256 get-bytevector-all))) + (fmt (assq-ref opts 'format))) + (format #t "~a~%~a~%" path (fmt hash)) + #t))) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index dd7d6ca112..a9ed79184e 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -712,8 +712,8 @@ (define (process-query opts) (let ((opts (parse-options))) (or (process-query opts) - (parameterize ((%store (open-connection))) - (with-error-handling + (with-error-handling + (parameterize ((%store (open-connection))) (parameterize ((%guile-for-build (package-derivation (%store) (if (assoc-ref opts 'bootstrap?) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 942bf501c5..bc72dc4088 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -194,9 +194,9 @@ (define (parse-options) (leave (_ "~A: unexpected argument~%") arg)) %default-options)) - (let ((opts (parse-options)) - (store (open-connection))) - (with-error-handling + (with-error-handling + (let ((opts (parse-options)) + (store (open-connection))) (let ((tarball (download-and-store store))) (unless tarball (leave (_ "failed to download up-to-date source, exiting\n"))) diff --git a/guix/store.scm b/guix/store.scm index 80b36daf93..eaf1cd544f 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -39,6 +39,9 @@ (define-module (guix store) nix-server-socket &nix-error nix-error? + &nix-connection-error nix-connection-error? + nix-connection-error-file + nix-connection-error-code &nix-protocol-error nix-protocol-error? nix-protocol-error-message nix-protocol-error-status @@ -373,6 +376,11 @@ (define-record-type (define-condition-type &nix-error &error nix-error?) +(define-condition-type &nix-connection-error &nix-error + nix-connection-error? + (file nix-connection-error-file) + (errno nix-connection-error-code)) + (define-condition-type &nix-protocol-error &nix-error nix-protocol-error? (message nix-protocol-error-message) @@ -392,7 +400,15 @@ (define* (open-connection #:optional (file (%daemon-socket-file)) ;; Enlarge the receive buffer. (setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024)) - (connect s a) + (catch 'system-error + (cut connect s a) + (lambda args + ;; Translate the error to something user-friendly. + (let ((errno (system-error-errno args))) + (raise (condition (&nix-connection-error + (file file) + (errno errno))))))) + (write-int %worker-magic-1 s) (let ((r (read-int s))) (and (eqv? r %worker-magic-2) diff --git a/guix/ui.scm b/guix/ui.scm index 03d881a428..94f0825a0a 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -111,6 +111,10 @@ (define (call-with-error-handling thunk) (leave (_ "~a:~a:~a: error: package `~a' has an invalid input: ~s~%") file line column (package-full-name package) input))) + ((nix-connection-error? c) + (leave (_ "error: failed to connect to `~a': ~a~%") + (nix-connection-error-file c) + (strerror (nix-connection-error-code c)))) ((nix-protocol-error? c) ;; FIXME: Server-provided error messages aren't i18n'd. (leave (_ "error: build failed: ~a~%") -- cgit v1.2.3 From 993fb66dd2f3087fef12c3f3f31e42485dfeb1bf Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 16 Mar 2013 00:59:19 +0100 Subject: guix package: Gracefully handle `official-gnu-packages' failure. * guix/gnu-maintenance.scm (http-fetch): Error out when DATA is #f. * guix/scripts/package.scm (check-package-freshness): Wrap `gnu-package?' call in `false-if-exception'. Reported by Cyril Roelandt . --- guix/gnu-maintenance.scm | 15 ++++++++++++++- guix/scripts/package.scm | 2 +- 2 files changed, 15 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index cde31aaa7b..89a01741ec 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -56,7 +56,20 @@ (define (http-fetch uri) (response-code resp))) (case code ((200) - data) + (if data + data + (begin + ;; XXX: Guile 2.0.5 and earlier did not support chunked transfer + ;; encoding, which is required when fetching %PACKAGE-LIST-URL + ;; (see ). + ;; Since users may still be using these versions, warn them and + ;; bail out. + (format (current-error-port) + "warning: using Guile ~a, which does not support HTTP ~s encoding~%" + (version) + (response-transfer-encoding resp)) + (error "download failed; use a newer Guile" + uri resp)))) (else (error "download failed:" uri code (response-reason-phrase resp)))))) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index a9ed79184e..f14677c519 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -288,7 +288,7 @@ (define (check-package-freshness package) (catch #t (lambda () - (when (gnu-package? package) + (when (false-if-exception (gnu-package? package)) (let ((name (package-name package)) (full-name (package-full-name package))) (match (waiting (latest-release name) -- cgit v1.2.3 From d80855999a81f344ca0c994f0532f5bd45162089 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 16 Mar 2013 16:46:46 +0100 Subject: derivations: Optimize `write-derivation'. This reduces the execution time of "guix build -e '(@ (gnu packages emacs) emacs)' -d" by 25%, from 1.54 s. to 1.15s. * guix/derivations.scm (write-sequence, write-list, write-tuple): New procedures. (write-derivation)[list->string, write-list]: Remove. [write-string-list, write-output, write-input, write-env-var]: New helpers. Rewrite in terms of these new helpers. --- guix/derivations.scm | 106 +++++++++++++++++++++++++++++++++++---------------- 1 file changed, 74 insertions(+), 32 deletions(-) (limited to 'guix') diff --git a/guix/derivations.scm b/guix/derivations.scm index 18a637ae5a..d70bd9dd85 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -235,6 +235,32 @@ (define read-derivation (hash-set! cache file drv) drv)))))) +(define-inlinable (write-sequence lst write-item port) + ;; Write each element of LST with WRITE-ITEM to PORT, separating them with a + ;; comma. + (match lst + (() + #t) + ((prefix (... ...) last) + (for-each (lambda (item) + (write-item item port) + (display "," port)) + prefix) + (write-item last port)))) + +(define-inlinable (write-list lst write-item port) + ;; Write LST as a derivation list to PORT, using WRITE-ITEM to write each + ;; element. + (display "[" port) + (write-sequence lst write-item port) + (display "]" port)) + +(define-inlinable (write-tuple lst write-item port) + ;; Same, but write LST as a tuple. + (display "(" port) + (write-sequence lst write-item port) + (display ")" port)) + (define (write-derivation drv port) "Write the ATerm-like serialization of DRV to PORT. See Section 2.4 of Eelco Dolstra's PhD dissertation for an overview of a previous version of @@ -243,11 +269,8 @@ (define (write-derivation drv port) ;; Make sure we're using the faster implementation. (define format simple-format) - (define (list->string lst) - (string-append "[" (string-join lst ",") "]")) - - (define (write-list lst) - (display (list->string lst) port)) + (define (write-string-list lst) + (write-list lst write port)) (define (coalesce-duplicate-inputs inputs) ;; Return a list of inputs, such that when INPUTS contains the same DRV @@ -272,6 +295,34 @@ (define (coalesce-duplicate-inputs inputs) '() inputs)) + (define (write-output output port) + (match output + ((name . ($ path hash-algo hash)) + (write-tuple (list name path + (or (and=> hash-algo symbol->string) "") + (or (and=> hash bytevector->base16-string) + "")) + write + port)))) + + (define (write-input input port) + (match input + (($ path sub-drvs) + (display "(" port) + (write path port) + (display "," port) + (write-string-list (sort sub-drvs string outputs inputs sources system builder args env-vars) (display "Derive(" port) - (write-list (map (match-lambda - ((name . ($ path hash-algo hash)) - (format #f "(~s,~s,~s,~s)" - name path - (or (and=> hash-algo symbol->string) "") - (or (and=> hash bytevector->base16-string) - "")))) - (sort outputs - (lambda (o1 o2) - (string path sub-drvs) - (format #f "(~s,~a)" path - (list->string (map object->string - (sort sub-drvs stringstring (sort sources stringstring args)) + (write-string-list args) (display "," port) - (write-list (map (match-lambda - ((name . value) - (format #f "(~s,~s)" name value))) - (sort env-vars - (lambda (e1 e2) - (stringoutput-path -- cgit v1.2.3 From 0bb1aa9e05bd103a71378307b7e26e22fea5ebab Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 16 Mar 2013 17:22:20 +0100 Subject: derivations: Optimize `build-expression->derivation'. This reduces the execution time of "guix build -e '(@ (gnu packages emacs) emacs)' -d" by 6%, from 1.15s to 1.08s. * guix/derivations.scm (build-expression->derivation): Write the builder as UTF-8. --- guix/derivations.scm | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) (limited to 'guix') diff --git a/guix/derivations.scm b/guix/derivations.scm index d70bd9dd85..2243d2ba46 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -741,14 +741,21 @@ (define %build-inputs (unsetenv "LD_LIBRARY_PATH"))) (builder (add-text-to-store store (string-append name "-guile-builder") - (string-append - (object->string prologue) - (object->string - `(exit - ,(match exp - ((_ ...) - (remove module-form? exp)) - (_ `(,exp)))))) + + ;; Explicitly use UTF-8 for determinism, + ;; and also because UTF-8 output is faster. + (with-fluids ((%default-port-encoding + "UTF-8")) + (call-with-output-string + (lambda (port) + (write prologue port) + (write + `(exit + ,(match exp + ((_ ...) + (remove module-form? exp)) + (_ `(,exp)))) + port)))) ;; The references don't really matter ;; since the builder is always used in -- cgit v1.2.3 From a4f08f9258805bf3d783db9a20d66d60209d8853 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 18 Mar 2013 23:04:07 +0100 Subject: guix package: Report packages to be removed/installed. * guix/scripts/package.scm (guix-package)[process-actions](show-what-to-remove/install): New procedure. Call it before `show-what-to-build'. --- guix/scripts/package.scm | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) (limited to 'guix') diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index f14677c519..6de2f1beb6 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -552,6 +552,44 @@ (define (package->tuple p) ,path ,(canonicalize-deps deps)))) + (define (show-what-to-remove/install remove install dry-run?) + ;; Tell the user what's going to happen in high-level terms. + ;; TODO: Report upgrades more clearly. + (match remove + (((name version _ path _) ..1) + (let ((len (length name)) + (remove (map (cut format #f " ~a-~a\t~a" <> <> <>) + name version path))) + (if dry-run? + (format (current-error-port) + (N_ "The following package would be removed:~% ~{~a~%~}~%" + "The following packages would be removed:~% ~{~a~%~}~%" + len) + remove) + (format (current-error-port) + (N_ "The following package will be removed:~% ~{~a~%~}~%" + "The following packages will be removed:~% ~{~a~%~}~%" + len) + remove)))) + (_ #f)) + (match install + (((name version _ path _) ..1) + (let ((len (length name)) + (install (map (cut format #f " ~a-~a\t~a" <> <> <>) + name version path))) + (if dry-run? + (format (current-error-port) + (N_ "The following package would be installed:~% ~{~a~%~}~%" + "The following packages would be installed:~% ~{~a~%~}~%" + len) + install) + (format (current-error-port) + (N_ "The following package will be installed:~% ~{~a~%~}~%" + "The following packages will be installed:~% ~{~a~%~}~%" + len) + install)))) + (_ #f))) + ;; First roll back if asked to. (if (and (assoc-ref opts 'roll-back?) (not dry-run?)) (begin @@ -619,6 +657,7 @@ (define (package->tuple p) package) (_ #f)) opts)) + (remove* (filter-map (cut assoc <> installed) remove)) (packages (append install* (fold (lambda (package result) (match package @@ -630,6 +669,7 @@ (define (package->tuple p) (when (equal? profile %current-profile) (ensure-default-profile)) + (show-what-to-remove/install remove* install* dry-run?) (show-what-to-build (%store) drv dry-run?) (or dry-run? -- cgit v1.2.3 From 238f739777f3634c3a987d834519d692216027d0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 22 Mar 2013 22:51:41 +0100 Subject: store: Use `sendfile' when available. * guix/store.scm (write-contents)[call-with-binary-input-file]: New procedure. Use `sendfile' instead of `dump' when available. Add `size' parameter. (write-file): Update caller. --- guix/store.scm | 30 ++++++++++++++++++++---------- 1 file changed, 20 insertions(+), 10 deletions(-) (limited to 'guix') diff --git a/guix/store.scm b/guix/store.scm index eaf1cd544f..688ddbe714 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -234,8 +234,17 @@ (define (read-store-path p) (define write-store-path-list write-string-list) (define read-store-path-list read-string-list) -(define (write-contents file p) - "Write the contents of FILE to output port P." +(define (write-contents file p size) + "Write SIZE bytes from FILE to output port P." + (define (call-with-binary-input-file file proc) + ;; Open FILE as a binary file. This avoids scan-for-encoding, and thus + ;; avoids any initial buffering. + (let ((port (open-file file "rb"))) + (catch #t (cut proc port) + (lambda args + (close-port port) + (apply throw args))))) + (define (dump in size) (define buf-size 65536) (define buf (make-bytevector buf-size)) @@ -250,13 +259,14 @@ (define buf (make-bytevector buf-size)) (put-bytevector p buf 0 read) (loop (- left read)))))))) - (let ((size (stat:size (lstat file)))) - (write-string "contents" p) - (write-long-long size p) - (call-with-input-file file - (lambda (p) - (dump p size))) - (write-padding size p))) + (write-string "contents" p) + (write-long-long size p) + (call-with-binary-input-file file + ;; Use `sendfile' when available (Guile 2.0.8+). + (if (compile-time-value (defined? 'sendfile)) + (cut sendfile p <> size 0) + (cut dump <> size))) + (write-padding size p)) (define (write-file f p) (define %archive-version-1 "nix-archive-1") @@ -274,7 +284,7 @@ (define %archive-version-1 "nix-archive-1") (begin (write-string "executable" p) (write-string "" p))) - (write-contents f p)) + (write-contents f p (stat:size s))) ((directory) (write-string "type" p) (write-string "directory" p) -- cgit v1.2.3 From 128663e4c8e8e3c2a56686c6018641ce7bcf92da Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 22 Mar 2013 22:58:19 +0100 Subject: store: Really disable file name canonicalization for derivation inputs. * guix/store.scm (write-contents)[call-with-binary-input-file]: Set %FILE-PORT-NAME-CANONICALIZATION to #f. * gnu/packages.scm (search-patch, search-bootstrap-binary): Leave %FILE-PORT-NAME-CANONICALIZATION unchanged. This reverts 9776ebb. --- gnu/packages.scm | 8 +++----- guix/store.scm | 14 ++++++++------ 2 files changed, 11 insertions(+), 11 deletions(-) (limited to 'guix') diff --git a/gnu/packages.scm b/gnu/packages.scm index 821246bc38..b639541788 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -61,14 +61,12 @@ (define %bootstrap-binaries-path (define (search-patch file-name) "Search the patch FILE-NAME." - (with-fluids ((%file-port-name-canonicalization #f)) - (search-path (%patch-path) file-name))) + (search-path (%patch-path) file-name)) (define (search-bootstrap-binary file-name system) "Search the bootstrap binary FILE-NAME for SYSTEM." - (with-fluids ((%file-port-name-canonicalization #f)) - (search-path (%bootstrap-binaries-path) - (string-append system "/" file-name)))) + (search-path (%bootstrap-binaries-path) + (string-append system "/" file-name))) (define %distro-module-directory ;; Absolute path of the (gnu packages ...) module root. diff --git a/guix/store.scm b/guix/store.scm index 688ddbe714..4d078c5899 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -238,12 +238,14 @@ (define (write-contents file p size) "Write SIZE bytes from FILE to output port P." (define (call-with-binary-input-file file proc) ;; Open FILE as a binary file. This avoids scan-for-encoding, and thus - ;; avoids any initial buffering. - (let ((port (open-file file "rb"))) - (catch #t (cut proc port) - (lambda args - (close-port port) - (apply throw args))))) + ;; avoids any initial buffering. Disable file name canonicalization to + ;; avoid stat'ing like crazy. + (with-fluids ((%file-port-name-canonicalization #f)) + (let ((port (open-file file "rb"))) + (catch #t (cut proc port) + (lambda args + (close-port port) + (apply throw args)))))) (define (dump in size) (define buf-size 65536) -- cgit v1.2.3 From c9f94132ca854bf49fe9b6d3dd1c16cf80fe2709 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 27 Mar 2013 15:50:18 +0100 Subject: download: Remove unreliable GNU mirror. * guix/download.scm (%mirrors)[gnu]: Remove ftp.chg.ru. --- guix/download.scm | 1 - 1 file changed, 1 deletion(-) (limited to 'guix') diff --git a/guix/download.scm b/guix/download.scm index 8dcfc7cb9a..ea00798b4b 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -43,7 +43,6 @@ (define %mirrors "http://ftpmirror.gnu.org/" "ftp://ftp.cs.tu-berlin.de/pub/gnu/" - "ftp://ftp.chg.ru/pub/gnu/" "ftp://ftp.funet.fi/pub/mirrors/ftp.gnu.org/gnu/" ;; This one is the master repository, and thus it's always -- cgit v1.2.3 From c6bded8a296d5593e31f6f860948ca2c2cdd43d4 Mon Sep 17 00:00:00 2001 From: Cyril Roelandt Date: Tue, 26 Mar 2013 22:14:24 +0100 Subject: Add (guix build-system cmake). * guix/build/cmake-build-system.scm, guix/build-system/cmake.scm: New files. * Makefile.am (MODULES): Add them. --- Makefile.am | 2 + guix/build-system/cmake.scm | 123 ++++++++++++++++++++++++++++++++++++++ guix/build/cmake-build-system.scm | 63 +++++++++++++++++++ 3 files changed, 188 insertions(+) create mode 100644 guix/build-system/cmake.scm create mode 100644 guix/build/cmake-build-system.scm (limited to 'guix') diff --git a/Makefile.am b/Makefile.am index 022c9a9afe..41ef50318c 100644 --- a/Makefile.am +++ b/Makefile.am @@ -38,6 +38,7 @@ MODULES = \ guix/gnu-maintenance.scm \ guix/licenses.scm \ guix/build-system.scm \ + guix/build-system/cmake.scm \ guix/build-system/gnu.scm \ guix/build-system/perl.scm \ guix/build-system/trivial.scm \ @@ -45,6 +46,7 @@ MODULES = \ guix/store.scm \ guix/ui.scm \ guix/build/download.scm \ + guix/build/cmake-build-system.scm \ guix/build/gnu-build-system.scm \ guix/build/perl-build-system.scm \ guix/build/utils.scm \ diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm new file mode 100644 index 0000000000..2a9db80cf8 --- /dev/null +++ b/guix/build-system/cmake.scm @@ -0,0 +1,123 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013 Cyril Roelandt +;;; +;;; 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 (guix build-system cmake) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix derivations) + #:use-module (guix build-system) + #:use-module (guix build-system gnu) + #:use-module (guix packages) + #:use-module (ice-9 match) + #:export (cmake-build + cmake-build-system)) + +;; Commentary: +;; +;; Standard build procedure for packages using CMake. This is implemented as an +;; extension of `gnu-build-system'. +;; +;; Code: + +(define* (cmake-build store name source inputs + #:key (guile #f) + (outputs '("out")) (configure-flags ''()) + (make-flags ''()) + (patches ''()) (patch-flags ''("--batch" "-p1")) + (cmake (@ (gnu packages cmake) cmake)) + (out-of-source? #f) + (path-exclusions ''()) + (tests? #t) + (test-target "test") + (parallel-build? #t) (parallel-tests? #f) + (patch-shebangs? #t) + (strip-binaries? #t) + (strip-flags ''("--strip-debug")) + (strip-directories ''("lib" "lib64" "libexec" + "bin" "sbin")) + (phases '(@ (guix build cmake-build-system) + %standard-phases)) + (system (%current-system)) + (imported-modules '((guix build cmake-build-system) + (guix build gnu-build-system) + (guix build utils))) + (modules '((guix build cmake-build-system) + (guix build gnu-build-system) + (guix build utils)))) + "Build SOURCE using CMAKE, and with INPUTS. This assumes that SOURCE +provides a 'CMakeLists.txt' file as its build system." + (define builder + `(begin + (use-modules ,@modules) + (cmake-build #:source ,(if (and source (derivation-path? source)) + (derivation-path->output-path source) + source) + #:system ,system + #:outputs %outputs + #:inputs %build-inputs + #:patches ,patches + #:patch-flags ,patch-flags + #:phases ,phases + #:configure-flags ,configure-flags + #:make-flags ,make-flags + #:out-of-source? ,out-of-source? + #:path-exclusions ,path-exclusions + #:tests? ,tests? + #:test-target ,test-target + #:parallel-build? ,parallel-build? + #:parallel-tests? ,parallel-tests? + #:patch-shebangs? ,patch-shebangs? + #:strip-binaries? ,strip-binaries? + #:strip-flags ,strip-flags + #:strip-directories ,strip-directories))) + + (define guile-for-build + (match guile + ((? package?) + (package-derivation store guile system)) + ((and (? string?) (? derivation-path?)) + guile) + (#f ; the default + (let* ((distro (resolve-interface '(gnu packages base))) + (guile (module-ref distro 'guile-final))) + (package-derivation store guile system))))) + + (let ((cmake (package-derivation store cmake system))) + (build-expression->derivation store name system + builder + `(,@(if source + `(("source" ,source)) + '()) + ("cmake" ,cmake) + ,@inputs + + ;; Keep the standard inputs of + ;; `gnu-build-system'. + ,@(standard-inputs system)) + + #:modules imported-modules + #:outputs outputs + #:guile-for-build guile-for-build))) + +(define cmake-build-system + (build-system (name 'cmake) + (description "The standard CMake build system") + (build cmake-build))) + +;;; cmake.scm ends here diff --git a/guix/build/cmake-build-system.scm b/guix/build/cmake-build-system.scm new file mode 100644 index 0000000000..877d8110d7 --- /dev/null +++ b/guix/build/cmake-build-system.scm @@ -0,0 +1,63 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013 Cyril Roelandt +;;; +;;; 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 (guix build cmake-build-system) + #:use-module ((guix build gnu-build-system) + #:renamer (symbol-prefix-proc 'gnu:)) + #:use-module (guix build utils) + #:use-module (ice-9 match) + #:export (%standard-phases + cmake-build)) + +;; Commentary: +;; +;; Builder-side code of the standard cmake build procedure. +;; +;; Code: + +(define* (configure #:key outputs (configure-flags '()) + #:allow-other-keys) + "Configure the given package." + (let ((out (assoc-ref outputs "out"))) + (if (file-exists? "CMakeLists.txt") + (let ((args `(,(string-append "-DCMAKE_INSTALL_PREFIX=" out) + ,@configure-flags))) + (format #t "running 'cmake' with arguments ~s~%" args) + (zero? (apply system* "cmake" args))) + (error "no CMakeLists.txt found")))) + +(define* (check #:key (tests? #t) (parallel-tests? #t) (test-target "test") + #:allow-other-keys) + (let ((gnu-check (assoc-ref gnu:%standard-phases 'check))) + (gnu-check #:tests? tests? #:test-target test-target + #:parallel-tests? parallel-tests?))) + +(define %standard-phases + ;; Everything is as with the GNU Build System except for the `configure' + ;; and 'check' phases. + (alist-replace 'configure configure + (alist-replace 'check check + gnu:%standard-phases))) + +(define* (cmake-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given package, applying all of PHASES in order." + (apply gnu:gnu-build #:inputs inputs #:phases phases args)) + +;;; cmake-build-system.scm ends here -- cgit v1.2.3 From f9bbf2a819d2b6fb3d56e289f8d8debc19e87a1a Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Thu, 28 Mar 2013 21:40:41 +0000 Subject: gnu-maintenance: Improve 'official-gnu-packages'; add related procedures. * guix/gnu-maintenance.scm (http-fetch): Return an input port. (): Add it. (official-gnu-packages): Use . (find-packages): Add it. (gnu-package?): Adjust accordingly. --- guix/gnu-maintenance.scm | 159 ++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 131 insertions(+), 28 deletions(-) (limited to 'guix') diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 89a01741ec..979678d076 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012 Nikita Karetnikov ;;; Copyright © 2010, 2011, 2012, 2013 Ludovic Courtès +;;; Copyright © 2012, 2013 Nikita Karetnikov ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,6 +22,7 @@ (define-module (guix gnu-maintenance) #:use-module (web client) #:use-module (web response) #:use-module (ice-9 regex) + #:use-module (ice-9 rdelim) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) @@ -30,8 +31,22 @@ (define-module (guix gnu-maintenance) #:use-module (guix ftp-client) #:use-module (guix utils) #:use-module (guix packages) - #:export (official-gnu-packages + #:export (gnu-package-name + gnu-package-mundane-name + gnu-package-copyright-holder + gnu-package-savannah + gnu-package-fsd + gnu-package-language + gnu-package-logo + gnu-package-doc-category + gnu-package-doc-summary + gnu-package-doc-urls + gnu-package-download-url + + official-gnu-packages + find-packages gnu-package? + releases latest-release gnu-package-name->name+version)) @@ -49,29 +64,32 @@ (define-module (guix gnu-maintenance) ;;; (define (http-fetch uri) - "Return a string containing the textual data at URI, a string." + "Return an input port containing the textual data at URI, a string." (let*-values (((resp data) (http-get (string->uri uri))) ((code) (response-code resp))) (case code ((200) - (if data - data - (begin - ;; XXX: Guile 2.0.5 and earlier did not support chunked transfer - ;; encoding, which is required when fetching %PACKAGE-LIST-URL - ;; (see ). - ;; Since users may still be using these versions, warn them and - ;; bail out. - (format (current-error-port) - "warning: using Guile ~a, which does not support HTTP ~s encoding~%" - (version) - (response-transfer-encoding resp)) - (error "download failed; use a newer Guile" - uri resp)))) + (cond ((string<=? (version) "2.0.5") + (begin + ;; XXX: Guile 2.0.5 and earlier did not support chunked transfer + ;; encoding, which is required when fetching %PACKAGE-LIST-URL + ;; (see ). + ;; Since users may still be using these versions, warn them and + ;; bail out. + (format (current-error-port) + "warning: using Guile ~a, ~a ~s encoding~%" + (version) + "which does not support HTTP" + (response-transfer-encoding resp)) + (error "download failed; use a newer Guile" + uri resp))) + ((string<=? (version) "2.0.7") + (open-input-string data)) + (else data))) (else - (error "download failed:" uri code + (error "download failed" uri code (response-reason-phrase resp)))))) (define %package-list-url @@ -79,16 +97,100 @@ (define %package-list-url "viewvc/*checkout*/gnumaint/" "gnupackages.txt?root=womb")) +(define-record-type* + gnu-package-descriptor + make-gnu-package-descriptor + + gnu-package-descriptor? + + (name gnu-package-name) + (mundane-name gnu-package-mundane-name) + (copyright-holder gnu-package-copyright-holder) + (savannah gnu-package-savannah) + (fsd gnu-package-fsd) + (language gnu-package-language) + (logo gnu-package-logo) + (doc-category gnu-package-doc-category) + (doc-summary gnu-package-doc-summary) + (doc-urls gnu-package-doc-urls) + (download-url gnu-package-download-url)) + (define (official-gnu-packages) - "Return a list of GNU packages." - (define %package-line-rx - (make-regexp "^package: (.+)$")) + "Return a list of records, which are GNU packages." + (define (group-package-fields port state) + ;; Return a list of alists. Each alist contains fields of a GNU + ;; package. + (let ((line (read-line port)) + (field-rx (make-regexp "^([[:graph:]]+): (.*)$")) + (doc-urls-rx (make-regexp "^doc-url: (.*)$")) + (end-rx (make-regexp "^# End. .+Do not remove this line.+"))) + + (define (match-field str) + ;; Packages are separated by empty strings. If STR is an + ;; empty string, create a new list to store fields of a + ;; different package. Otherwise, match and create a key-value + ;; pair. + (match str + ("" + (group-package-fields port (cons '() state))) + (str + (cond ((regexp-exec doc-urls-rx str) + => + (lambda (match) + (if (equal? (assoc-ref (first state) "doc-urls") #f) + (group-package-fields + port (cons (cons (cons "doc-urls" + (list + (match:substring match 1))) + (first state)) + (drop state 1))) + (group-package-fields + port (cons (cons (cons "doc-urls" + (cons (match:substring match 1) + (assoc-ref (first state) + "doc-urls"))) + (assoc-remove! (first state) + "doc-urls")) + (drop state 1)))))) + ((regexp-exec field-rx str) + => + (lambda (match) + (group-package-fields + port (cons (cons (cons (match:substring match 1) + (match:substring match 2)) + (first state)) + (drop state 1))))) + (else (group-package-fields port state)))))) + + (if (or (eof-object? line) + (regexp-exec end-rx line)) ; don't include dummy fields + (remove null-list? state) + (match-field line)))) + + (define (alist->record alist make keys) + ;; Apply MAKE, which should be a syntactic constructor, to the + ;; values associated with KEYS in ALIST. + (let ((args (map (cut assoc-ref alist <>) keys))) + (apply make args))) + + (reverse + (map (lambda (alist) + (alist->record alist + make-gnu-package-descriptor + (list "package" "mundane-name" "copyright-holder" + "savannah" "fsd" "language" "logo" + "doc-category" "doc-summary" "doc-urls" + "download-url"))) + (group-package-fields (http-fetch %package-list-url) + '(()))))) - (let ((lst (string-split (http-fetch %package-list-url) #\nl))) - (filter-map (lambda (line) - (and=> (regexp-exec %package-line-rx line) - (cut match:substring <> 1))) - lst))) +(define (find-packages regexp) + "Find GNU packages which satisfy REGEXP." + (let ((name-rx (make-regexp regexp))) + (filter (lambda (package) + (false-if-exception + (regexp-exec name-rx (gnu-package-name package)))) + (official-gnu-packages)))) (define gnu-package? (memoize @@ -97,9 +199,10 @@ (define gnu-package? network to check in GNU's database." ;; TODO: Find a way to determine that a package is non-GNU without going ;; through the network. - (let ((url (and=> (package-source package) origin-uri))) + (let ((url (and=> (package-source package) origin-uri)) + (name (package-name package))) (or (and (string? url) (string-prefix? "mirror://gnu" url)) - (and (member (package-name package) (official-gnu-packages)) + (and (member name (map gnu-package-name (official-gnu-packages))) #t)))))) -- cgit v1.2.3 From 3f5a932eeaa8111b841de64b742b1cc408f2419a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 28 Mar 2013 15:30:27 +0100 Subject: snix: Adjust import to current Nixpkgs input attribute names. * guix/snix.scm (snix-derivation->guix-package): Use the new names `nativeBuildInputs' and `propagatedNativeBuildInputs'. --- guix/snix.scm | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/snix.scm b/guix/snix.scm index 3a470b9b8b..0c19fecb28 100644 --- a/guix/snix.scm +++ b/guix/snix.scm @@ -277,7 +277,7 @@ (define* (open-nixpkgs nixpkgs #:optional attribute) %nix-instantiate "--strict" "--eval-only" "--xml" ;; Pass a dummy `crossSystem' argument so that `buildInputs' and - ;; `buildNativeInputs' are not coalesced. + ;; `nativeBuildInputs' are not coalesced. ;; XXX: This is hacky and has other problems. ;"--arg" "crossSystem" cross-system @@ -423,12 +423,15 @@ (define (license-variable license) (build-system gnu-build-system) ;; When doing a native Nixpkgs build, `buildInputs' is empty and - ;; everything is in `buildNativeInputs'. So we can't distinguish + ;; everything is in `nativeBuildInputs'. So we can't distinguish ;; between both, here. + ;; + ;; Note that `nativeBuildInputs' was renamed from + ;; `buildNativeInputs' in Nixpkgs sometime around March 2013. ,@(maybe-inputs 'inputs - (convert-inputs "buildNativeInputs")) + (convert-inputs "nativeBuildInputs")) ,@(maybe-inputs 'propagated-inputs - (convert-inputs "propagatedBuildNativeInputs")) + (convert-inputs "propagatedNativeBuildInputs")) (home-page ,(and=> (find-attribute-by-name "homepage" meta) attribute-value)) -- cgit v1.2.3