diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | guix/gnu-maintenance.scm | 8 | ||||
| -rw-r--r-- | guix/import/gnu.scm | 116 | ||||
| -rw-r--r-- | guix/scripts/import.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/import/gnu.scm | 104 |
5 files changed, 232 insertions, 2 deletions
diff --git a/Makefile.am b/Makefile.am index 3350fd6994..5c4ce90f89 100644 --- a/Makefile.am +++ b/Makefile.am @@ -79,6 +79,7 @@ MODULES = \ guix/build/graft.scm \ guix/packages.scm \ guix/import/utils.scm \ + guix/import/gnu.scm \ guix/import/snix.scm \ guix/scripts/download.scm \ guix/scripts/build.scm \ @@ -93,6 +94,7 @@ MODULES = \ guix/scripts/refresh.scm \ guix/scripts/system.scm \ guix/scripts/lint.scm \ + guix/scripts/import/gnu.scm \ guix/scripts/import/nix.scm \ guix/scripts/environment.scm \ guix.scm \ diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index bfc03359ac..ee84446549 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -64,7 +64,10 @@ releases latest-release + gnu-release-archive-types gnu-package-name->name+version + + download-tarball package-update-path package-update update-package-source)) @@ -382,6 +385,11 @@ open (resp. close) FTP connections; this can be useful to reuse connections." (ftp-close conn) #f))))))))) +(define (gnu-release-archive-types release) + "Return the available types of archives for RELEASE---a list of strings such +as \"gz\" or \"xz\"." + (map file-extension (gnu-release-files release))) + (define %package-name-rx ;; Regexp for a package name, e.g., "foo-X.Y". Since TeXmacs uses ;; "TeXmacs-X.Y-src", the `-src' suffix is allowed. diff --git a/guix/import/gnu.scm b/guix/import/gnu.scm new file mode 100644 index 0000000000..763b8d2a12 --- /dev/null +++ b/guix/import/gnu.scm @@ -0,0 +1,116 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix import gnu) + #:use-module (guix gnu-maintenance) + #:use-module (guix utils) + #:use-module (guix store) + #:use-module (guix hash) + #:use-module (guix base32) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:export (gnu->guix-package)) + +;;; Commentary: +;;; +;;; Generate a package declaration template for the latest version of a GNU +;;; package, using meta-data available upstream for the package. +;;; +;;; Code: + +(define (file-sha256 file) + "Return the SHA256 hash of FILE as a bytevector." + (call-with-input-file file port-sha256)) + +(define (qualified-url url) + "Return a fully-qualified URL based on URL." + (if (string-prefix? "/" url) + (string-append "http://www.gnu.org" url) + url)) + +(define (preferred-archive-type release) + "Return the preferred type of archive for downloading RELEASE." + (find (cute member <> (gnu-release-archive-types release)) + '("xz" "lz" "bz2" "tbz2" "gz" "tgz" "Z"))) + +(define* (gnu-package->sexp package release + #:key (key-download 'interactive)) + "Return the 'package' sexp for the RELEASE (a <gnu-release>) of PACKAGE (a +<gnu-package>). Use KEY-DOWNLOAD as the OpenPGP key download policy (see +'download-tarball' for details.)" + (define name + (gnu-package-name package)) + + (define url-base + ;; XXX: We assume that RELEASE's directory starts with "/gnu". + (string-append "mirror:/" (gnu-release-directory release) + "/" name "-")) + + (define archive-type + (preferred-archive-type release)) + + (let ((tarball (with-store store + (download-tarball store name + (gnu-release-directory release) + (gnu-release-version release) + #:archive-type archive-type + #:key-download key-download)))) + `(package + (name ,name) + (version ,(gnu-release-version release)) + (source (origin + (method url-fetch) + (uri (string-append ,url-base version + ,(string-append ".tar." archive-type))) + (sha256 + (base32 + ,(bytevector->base32-string (file-sha256 tarball)))))) + (build-system gnu-build-system) + (synopsis ,(gnu-package-doc-summary package)) + (description ,(gnu-package-doc-description package)) + (home-page ,(match (gnu-package-doc-urls package) + ((head . tail) (qualified-url head)))) + (license find-by-yourself!)))) + +(define* (gnu->guix-package name + #:key (key-download 'interactive)) + "Return the package declaration for NAME as an s-expression. Use +KEY-DOWNLOAD as the OpenPGP key download policy (see 'download-tarball' for +details.)" + (match (latest-release name) + ((? gnu-release? release) + (let ((version (gnu-release-version release))) + (match (find-packages (regexp-quote name)) + ((info . _) + (gnu-package->sexp info release)) + (() + (raise (condition + (&message + (message "couldn't find meta-data for GNU package")))))))) + (_ + (raise (condition + (&message + (message + "failed to determine latest release of GNU package"))))))) + +;;; gnu.scm ends here diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index e9576bad8c..86ef05bc2c 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; ;;; This file is part of GNU Guix. @@ -73,7 +73,7 @@ rather than \\n." ;;; Entry point. ;;; -(define importers '("nix" "pypi")) +(define importers '("gnu" "nix" "pypi")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/gnu.scm b/guix/scripts/import/gnu.scm new file mode 100644 index 0000000000..5fac6db516 --- /dev/null +++ b/guix/scripts/import/gnu.scm @@ -0,0 +1,104 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix scripts import gnu) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix import gnu) + #:use-module (guix scripts import) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:export (guix-import-gnu)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '((key-download . interactive))) + +(define (show-help) + (display (_ "Usage: guix import gnu [OPTION...] PACKAGE +Return a package declaration template for PACKAGE, a GNU package.\n")) + ;; '--key-download' taken from (guix scripts refresh). + (display (_ " + --key-download=POLICY + handle missing OpenPGP keys according to POLICY: + 'always', 'never', and 'interactive', which is also + used when 'key-download' is not specified")) + (newline) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %options + ;; Specification of the command-line options. + (cons* (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix import gnu"))) + (option '("key-download") #t #f ;from (guix scripts refresh) + (lambda (opt name arg result) + (match arg + ((or "interactive" "always" "never") + (alist-cons 'key-download (string->symbol arg) + result)) + (_ + (leave (_ "unsupported policy: ~a~%") + arg))))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-gnu . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((name) + (with-error-handling + (gnu->guix-package name + #:key-download (assoc-ref opts 'key-download)))) + (_ + (leave (_ "wrong number of arguments~%")))))) + +;;; gnu.scm ends here |