From c60e72504a8ba4bb6a90c07bef7844d461a12467 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Fri, 2 Sep 2016 16:16:35 +0200 Subject: [PATCH] npm importer: support --binary and fixes for e.g.: cjson, http, xmldom. * gnu/nmp.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. * guix/scripts/import/npm.scm: Add --binary option. * guix/import/npm.scm (gh-fuzzy-tag-match): Add two fallbacks: missing /TAGS and VERSION mismatch. (strip-.git-if-needed project): New function. (github-user-slash-repository, github-repository): Use it. (source-uri): Fallback to use `binary' (dist . tarball). Add optional binary? parameter to prefer binary fallback. (spdx-string->license): Add LGPL, fix LGPL-3.0. (make-npm-sexp): Add optional binary? parameter to set #:binary? argument. (npm->guix-package): Add optional binary? parameter to set #:binary? argument to ignore devDependencies. (recursive-import): Add optional binary? parameter. * guix/build-system/node.scm (node-build): Add binary? and make-flags keys. * guix/build/node-build-system (build): Also check for `Gulpfile.js', fallback to generic `npm build'. Skip build if #:binary?. (binary-install): Rename from install. (npm-install): New function. (install): Have #:binary? switch between binary-install, and npm-install. (package-origin): Handle registry.npmjs.org url. (npm->guix-package)[npm-binary?]: Discard devDependencies. --- gnu/local.mk | 1 + gnu/packages/npm.scm | 34 +++++++++ guix/build-system/node.scm | 4 + guix/build/node-build-system.scm | 30 ++++++-- guix/import/npm.scm | 161 +++++++++++++++++++++++++++------------ guix/scripts/import/npm.scm | 13 +++- 6 files changed, 186 insertions(+), 57 deletions(-) create mode 100644 gnu/packages/npm.scm diff --git a/gnu/local.mk b/gnu/local.mk index b9d2a11..4fa94c7 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -255,6 +255,7 @@ GNU_SYSTEM_MODULES = \ %D%/packages/nettle.scm \ %D%/packages/networking.scm \ %D%/packages/ninja.scm \ + %D%/packages/npm.scm \ %D%/packages/node.scm \ %D%/packages/noweb.scm \ %D%/packages/ntp.scm \ diff --git a/gnu/packages/npm.scm b/gnu/packages/npm.scm new file mode 100644 index 0000000..43b7774 --- /dev/null +++ b/gnu/packages/npm.scm @@ -0,0 +1,34 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Jan Nieuwenhuizen +;;; +;;; 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 npm) + #:use-module (guix licenses) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system node) + #:use-module (gnu packages base) + #:use-module (gnu packages commencement) + #:use-module (gnu packages gcc) + #:use-module (gnu packages perl) + #:use-module (gnu packages python)) + +(define npm-license-unknown public-domain) + +#! +for i in array-equal async-q q cjson http fs-extra xmldom; do ./pre-inst-env guix import import --recursive --binary $i >> gnu/packages/npm.scm; make; done +!# diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm index a7b71e6..99e0ef0 100644 --- a/guix/build-system/node.scm +++ b/guix/build-system/node.scm @@ -75,10 +75,12 @@ registry." (define* (node-build store name inputs #:key + (binary? #f) (npm-flags ''()) (global? #f) (test-target "test") (tests? #f) + (make-flags ''()) (phases '(@ (guix build node-build-system) %standard-phases)) (outputs '("out")) @@ -103,6 +105,8 @@ registry." source)) #:system ,system #:npm-flags ,npm-flags + #:make-flags ,make-flags + #:binary? ,binary? #:global? ,global? #:test-target ,test-target #:tests? ,tests? diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm index 35767d6..1077201 100644 --- a/guix/build/node-build-system.scm +++ b/guix/build/node-build-system.scm @@ -50,17 +50,23 @@ (find-files "." "(min\\.js|min\\.js\\.map|min\\.map)$")) #t) -(define* (build #:key outputs inputs #:allow-other-keys) +(define* (build #:key outputs binary? (make-flags '()) (npm-flags '()) + #:allow-other-keys) "Build a new node module using the appropriate build system." ;; XXX: Develop a more robust heuristic, allow override - (cond ((file-exists? "gulpfile.js") + (cond (binary? #t) + ((or (file-exists? "gulpfile.js") + (file-exists? "Gulpfile.js")) (zero? (system* "gulp"))) ((file-exists? "gruntfile.js") (zero? (system* "grunt"))) + ((file-exists? "binding.gyp") + (and (zero? (system* "node-gyp.js" "configure")) + (zero? (system* "node-gyp.js" "build")))) ((file-exists? "Makefile") - (zero? (system* "make"))) + (zero? (apply system* "make" `(,@make-flags)))) (else - #t))) + (zero? (apply system* "npm" "build" `(,@npm-flags)))))) (define* (check #:key tests? #:allow-other-keys) "Run 'npm test' if TESTS?" @@ -69,7 +75,7 @@ (zero? (system* "npm" "test")) #t)) -(define* (install #:key outputs inputs global? #:allow-other-keys) +(define* (binary-install #:key outputs inputs global? #:allow-other-keys) "Install the node module to the output store item. MODULENAME defines how under which name the module will be installed, GLOBAL? determines whether this is an npm global install." @@ -86,6 +92,20 @@ is an npm global install." (symlink (string-append tgt-dir "/node_modules/" modulename "/bin") bin-dir)) #t)) +(define* (npm-install #:key outputs inputs (npm-flags '()) #:allow-other-keys) + "Install the node module to the output store item. MODULENAME defines how +under which name the module will be installed, GLOBAL? determines whether this +is an npm global install." + (let* ((out (assoc-ref outputs "out")) + (home (string-append "/tmp/home"))) + (setenv "HOME" home) + (zero? (apply system* "npm" "install" "-g" "--prefix" out `(,@npm-flags))))) + +(define* (install #:key outputs inputs binary? global? (npm-flags '()) + #:allow-other-keys) + (if binary? + (binary-install #:outputs outputs #:inputs inputs #:global? global?) + (npm-install #:outputs outputs #:global? global? #:npm-flags #:npm-flags))) (define %standard-phases (modify-phases gnu:%standard-phases diff --git a/guix/import/npm.scm b/guix/import/npm.scm index b6c9120..5d6bd9e 100644 --- a/guix/import/npm.scm +++ b/guix/import/npm.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson ;;; Copyright © 2016 Jelle Licht +;;; Copyright © 2016 Jan Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -47,6 +48,7 @@ #:use-module (guix packages) #:use-module (gnu packages) #:use-module (guix build-system node) + #:use-module (guix build node-build-system) #:export (npm->guix-package recursive-import)) @@ -187,10 +189,10 @@ GITHUB-REPO" "https://api.github.com/repos/" (github-user-slash-repository github-repo) "/tags")) - (json (json-fetch* - (if token - (string-append api-url "?access_token=" token) - api-url)))) + (api-url (if token + (string-append api-url "?access_token=" token) + api-url)) + (json (json-fetch* api-url))) (if (eq? json #f) (if token (error "Error downloading release information through the GitHub @@ -208,28 +210,50 @@ api-url)) (member name fuzzy-tags))) json))) (match proper-release - (() ;empty release list - #f) + (() ;fuzzy version mismatch + (if (pair? json) + (begin + ;;XXX: Just pick first release + ;; e.g.: xmldom 0.1.16 vs 0.1.22 + (hash-ref (car json) "name")) + ;;XXX: No tags: Just pick latest commit from master + ;; e.g.: cjson + ;; TODO: iso master, snarf default_branch from / + (let* ((branches-url (string-replace-substring api-url "/tags" "/branches")) + (branches (json-fetch* branches-url)) + (first-or-master + (or + (find (lambda (x) (equal? (hash-ref x "name") "master")) + branches) + (car branches))) + (commit (hash-ref first-or-master "commit")) + (sha (hash-ref commit "sha"))) + sha))) ((release . rest) ;one or more releases ;;XXX: Just pick the first release (let ((tag (hash-ref release "name"))) tag))))))) +(define (strip-.git-if-needed project) + ;; for babel, e.g. project does not end in `.git' + (if (string-suffix? ".git" project) + (string-drop-right project 4) + project)) (define (github-user-slash-repository github-url) "Return a string e.g. arq5x/bedtools2 of the owner and the name of the repository separated by a forward slash, from a string URL of the form 'https://github.com/arq5x/bedtools2.git'" (match (string-split (uri-path (string->uri github-url)) #\/) ((_ owner project . rest) - (string-append owner "/" (string-drop-right project 4))))) + (string-append owner "/" (strip-.git-if-needed project))))) (define (github-repository github-url) "Return a string e.g. bedtools2 of the name of the repository, from a string URL of the form 'https://github.com/arq5x/bedtools2.git'" (match (string-split (uri-path (string->uri github-url)) #\/) ((_ owner project . rest) - (string-drop-right project 4)))) + (strip-.git-if-needed project)))) (define (github-release-url github-url version) "Return the url for the tagged release VERSION on the github repo found at @@ -263,10 +288,19 @@ GITHUB-URL." "Return true if PACKAGE is a node package." (string-prefix? "node-" (package-name package))) -(define (source-uri npm-meta version) +(define* (source-uri npm-meta version #:optional binary?) "Return the repository url for version VERSION of NPM-META" - (let* ((v (assoc-ref* npm-meta "versions" version))) - (normalise-url (assoc-ref* v "repository" "url")))) + (let* ((v (assoc-ref* npm-meta "versions" version)) + (repo (assoc-ref v "repository")) + (dist (assoc-ref v "dist"))) + (or + (and binary? dist + (assoc-ref dist "tarball")) + (and repo + (and=> (assoc-ref repo "url") normalise-url)) + ;; fallback for `binary'-only packages, e.g.: http + (and dist + (assoc-ref dist "tarball"))))) (define (guix-hash-url path) "Return the hash of PATH in nix-base32 format. PATH can be either a file or @@ -319,11 +353,12 @@ package." ("IJG" 'ijg) ("Imlib2" 'imlib2) ("IPA" 'ipa) + ("LGPL" 'lgpl2.0) ("LGPL-2.0" 'lgpl2.0) ("LGPL-2.0+" 'lgpl2.0+) ("LGPL-2.1" 'lgpl2.1) ("LGPL-2.1+" 'lgpl2.1+) - ("LGPL-3.0" 'lgpl3.0) + ("LGPL-3.0" 'lgpl3) ("MPL-1.0" 'mpl1.0) ("MPL-1.1" 'mpl1.1) ("MPL-2.0" 'mpl2.0) @@ -359,35 +394,50 @@ command." located at REPO-URL. Tries to locate a released tarball before falling back to a git checkout." (let ((uri (string->uri repo-url))) - (if (equal? (uri-host uri) "github.com") - (call-with-temporary-output-file - (lambda (temp port) - (let* ((gh-version (gh-fuzzy-tag-match repo-url version)) - (tb (github-release-url repo-url gh-version)) - (result (url-fetch tb temp)) - (hash (bytevector->nix-base32-string (port-sha256 port)))) - (close-port port) - `(origin - (method url-fetch) - (uri ,tb) - (sha256 - (base32 - ,hash)))))) - (call-with-temporary-directory - (lambda (temp-dir) - (let ((fuzzy-version (generic-fuzzy-tag-match repo-url version))) - (and (node-git-fetch repo-url fuzzy-version temp-dir) - `(origin - (method git-fetch) - (uri (git-reference - (url ,repo-url) - (commit ,fuzzy-version))) - (sha256 - (base32 - ,(guix-hash-url temp-dir))))))))))) + (cond + ((equal? (uri-host uri) "registry.npmjs.org") + (call-with-temporary-output-file + (lambda (temp port) + (let* ((result (url-fetch repo-url temp)) + (hash (bytevector->nix-base32-string (port-sha256 port)))) + (close-port port) + `(origin + (method url-fetch) + (uri ,repo-url) + (sha256 + (base32 + ,hash))))))) + ((equal? (uri-host uri) "github.com") + (call-with-temporary-output-file + (lambda (temp port) + (let* ((gh-version (gh-fuzzy-tag-match repo-url version)) + (tb (github-release-url repo-url gh-version)) + (result (url-fetch tb temp)) + (hash (bytevector->nix-base32-string (port-sha256 port)))) + (close-port port) + `(origin + (method url-fetch) + (uri ,tb) + (sha256 + (base32 + ,hash))))))) + (else + (call-with-temporary-directory + (lambda (temp-dir) + (let ((fuzzy-version (generic-fuzzy-tag-match repo-url version))) + (and (node-git-fetch repo-url fuzzy-version temp-dir) + `(origin + (method git-fetch) + (uri (git-reference + (url ,repo-url) + (commit ,fuzzy-version))) + (sha256 + (base32 + ,(guix-hash-url temp-dir)))))))))))) (define (make-npm-sexp name version home-page description - dependencies dev-dependencies license source-url) + dependencies dev-dependencies license source-url + binary?) "Return the `package' s-expression for a Node package with the given NAME, VERSION, HOME-PAGE, DESCRIPTION, DEPENDENCIES, DEV-DEPENDENCIES, LICENSES and SOURCE-URL." @@ -415,6 +465,9 @@ SOURCE-URL." (,'unquote ,(string->symbol name)))) dev-dependencies))))) + ,@(if (not binary?) + '() + '((arguments `(#:binary? #t)))) (synopsis ,description) ; no synopsis field in package.json files (description ,description) (home-page ,home-page) @@ -444,23 +497,32 @@ npm list of dependencies DEPENDENCIES." (spdx-string->license (assoc-ref license-entry "type"))) ((string? license-legacy) (spdx-string->license license-legacy)) + ((and (pair? license-legacy) (string? (car license-legacy))) + (if (= (length license-legacy) 1) + (spdx-string->license (car license-legacy)) + (map spdx-string->license license-legacy))) ((and license-legacy (positive? (length license-legacy))) `(list ,@(map (lambda (l) (spdx-string->license (assoc-ref l "type"))) license-legacy))) (else + (format (current-error-port) "extract-license: no license found: ~a\n" package-json) #f)))) -(define (npm->guix-package package-name) +(define* (npm->guix-package package-name #:optional binary?) "Fetch the metadata for PACKAGE-NAME from registry.npmjs.com and return the - `package' s-expression corresponding to that package, or on failure." +`package' s-expression corresponding to that package, or on failure. If +BINARY?, use the `binary' dist tarball as source url and ignore any +devDependencies." (let ((package (npm-fetch package-name))) (if package (let* ((name (assoc-ref package "name")) (version (latest-source-release package)) (curr (assoc-ref* package "versions" version)) (raw-dependencies (assoc-ref curr "dependencies")) - (raw-dev-dependencies (assoc-ref curr "devDependencies")) + (raw-dev-dependencies (if binary? + #f + (assoc-ref curr "devDependencies"))) (dependencies (extract-guix-dependencies raw-dependencies)) (dev-dependencies (extract-guix-dependencies raw-dev-dependencies)) @@ -469,19 +531,20 @@ npm list of dependencies DEPENDENCIES." (extract-npm-dependencies raw-dependencies) (extract-npm-dependencies raw-dev-dependencies))) (description (assoc-ref package "description")) - (home-page (assoc-ref package "homepage")) - (license (extract-license curr)) - (source-url (source-uri package version))) + (home-page (or (assoc-ref package "homepage") "http://npmjs.com")) + (license (or (extract-license curr) 'npm-license-unknown)) + (source-url (source-uri package version binary?))) (values (make-npm-sexp name version home-page description - dependencies dev-dependencies license source-url) + dependencies dev-dependencies license source-url + binary?) npm-dependencies)) (error "Could not download metadata:" package-name)))) -(define* (recursive-import package-name) +(define* (recursive-import package-name #:optional binary?) "Recursively fetch the metadata for PACKAGE-NAME and its dependencies from registry.npmjs.com and return a list of 'package-name, package s-expression' -tuples." +tuples. If BINARY?, use the `binary' tarball from the dist field." (define (seen? item seen) (or (vhash-assoc item seen) (not (null? (find-packages-by-name (node-package-name item)))))) @@ -501,7 +564,7 @@ tuples." (receive (package dependencies) (catch #t (lambda () - (npm->guix-package package-name)) + (npm->guix-package package-name binary?)) (lambda (key . parameters) (format (current-error-port) "Uncaught throw to '~a: ~a\n" key parameters) diff --git a/guix/scripts/import/npm.scm b/guix/scripts/import/npm.scm index 79abcf0..8e39381 100644 --- a/guix/scripts/import/npm.scm +++ b/guix/scripts/import/npm.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson +;;; Copyright © 2016 Jan Nieuwenhuizen ;;; ;;; This file is part of GNU Guix. ;;; @@ -40,6 +41,8 @@ (display (_ "Usage: guix import npm PACKAGE-NAME Import and convert the npm package for PACKAGE-NAME.\n")) (display (_ " + -b, --binary use binary dist tarball for source url")) + (display (_ " -h, --help display this help and exit")) (display (_ " -V, --version display version information and exit")) @@ -48,7 +51,10 @@ (define %options ;; Specification of the command-line options. - (cons* (option '(#\h "help") #f #f + (cons* (option '(#\b "binary") #f #f + (lambda (opt name arg result) + (alist-cons 'binary? #t result))) + (option '(#\h "help") #f #f (lambda args (show-help) (exit 0))) @@ -73,6 +79,7 @@ (alist-cons 'argument arg result)) %default-options)) (let* ((opts (parse-options)) + (binary? (assoc-ref opts 'binary?)) (args (filter-map (match-lambda (('argument . value) value) @@ -88,9 +95,9 @@ `(define-public ,(string->symbol name) ,pkg)) (_ #f)) - (recursive-import package-name)) + (recursive-import package-name binary?)) ;; Single import - (let ((sexp (npm->guix-package package-name))) + (let ((sexp (npm->guix-package package-name binary?))) (unless sexp (leave (_ "failed to download meta-data for package '~a'~%") package-name)) -- 2.9.3