summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGiacomo Leidi <goodoldpaul@autistici.org>2020-05-12 23:31:31 +0200
committerGuix Patches Tester <>2020-05-12 22:34:10 +0100
commit57623d1b876f2411abe3d1bc641a77d1b1864d5a (patch)
tree787cf70b892d37e39c4ce6c46b9be34fa9809b85
parentb4d68d22aad1ed255a113a7294b278c9d3f63d34 (diff)
downloadguix-patches-57623d1b876f2411abe3d1bc641a77d1b1864d5a.tar
guix-patches-57623d1b876f2411abe3d1bc641a77d1b1864d5a.tar.gz
guix: Enforce package.json "files" directive.
This fixes https://issues.guix.gnu.org/40710 by implementing support for the "files" directive from https://docs.npmjs.com/files/package.json#files . * guix/build/node-build-system.scm (install): Enforce package.json "files" directive. * guix/build-system/node.scm (%node-build-system-modules) (node-build)[modules]: Add (guix glob).
-rw-r--r--guix/build-system/node.scm4
-rw-r--r--guix/build/node-build-system.scm68
2 files changed, 58 insertions, 14 deletions
diff --git a/guix/build-system/node.scm b/guix/build-system/node.scm
index 05c24c47d5..05bc9f2087 100644
--- a/guix/build-system/node.scm
+++ b/guix/build-system/node.scm
@@ -42,6 +42,7 @@ registry."
`((guix build node-build-system)
(guix build json)
(guix build union)
+ (guix glob)
,@%gnu-build-system-modules)) ;; TODO: Might be not needed
(define (default-node)
@@ -90,7 +91,8 @@ registry."
(modules '((guix build node-build-system)
(guix build json)
(guix build union)
- (guix build utils))))
+ (guix build utils)
+ (guix glob))))
"Build SOURCE using NODE and INPUTS."
(define builder
`(begin
diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
index 7799f03595..befcbbeb75 100644
--- a/guix/build/node-build-system.scm
+++ b/guix/build/node-build-system.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
+;;; Copyright © 2020 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -22,6 +23,7 @@
#:use-module (guix build json)
#:use-module (guix build union)
#:use-module (guix build utils)
+ #:use-module (guix glob)
#:use-module (ice-9 match)
#:use-module (ice-9 popen)
#:use-module (ice-9 regex)
@@ -110,18 +112,60 @@ the @file{bin} directory."
(#f #f)))
(dependencies (match (assoc-ref data "dependencies")
(('@ deps ...) deps)
- (#f #f))))
+ (#f #f)))
+ (patterns (match (assoc-ref data "files")
+ (() #f)
+ ((? list? patrn-list) patrn-list)
+ (#f #f)))
+ (main (match (assoc-ref data "main")
+ ("" #f)
+ ((? string? main-module) main-module)
+ (#f #f)))
+ (install-dir (string-append target "/node_modules/" modulename))
+ (install-files (lambda (files directory)
+ (for-each (lambda (file)
+ (install-file
+ file
+ (string-append directory "/"
+ (dirname file))))
+ files))))
(mkdir-p target)
- (copy-recursively "." (string-append target "/node_modules/" modulename))
- ;; Remove references to dependencies
- (delete-file-recursively
- (string-append target "/node_modules/" modulename "/node_modules"))
+ (if patterns
+ (install-files
+ (filter (lambda (file)
+ (any (lambda (pattern)
+ (glob-match?
+ (string->compiled-sglob pattern)
+ file))
+ (append
+ patterns
+ '("package.json"
+ ;; These files get installed no
+ ;; matter the case or extension.
+ "[rR][eE][aA][dD][mM][eE]*"
+ "[cC][hH][aA][nN][gG][eE][sS]*"
+ "[cC][hH][aA][nN][gG][eE][lL][oO][gG]*"
+ "[hH][iI][sS][tT][oO][rR][yY]*"
+ "[nN][oO][tT][iI][cC][eE]*"))))
+ (map (lambda (path)
+ (string-drop path 2))
+ (find-files ".")))
+ install-dir)
+ (begin
+ (copy-recursively "." install-dir)
+ ;; Remove references to dependencies
+ (delete-file-recursively
+ (string-append install-dir "/node_modules"))))
+ (if (and main
+ (not (file-exists?
+ (string-append
+ install-dir "/" (dirname main)))))
+ (install-files (list main) install-dir))
(cond
((string? binary-configuration)
(begin
(mkdir-p binaries)
- (symlink (string-append target "/node_modules/" modulename "/"
- binary-configuration)
+ (symlink (string-append install-dir "/" binary-configuration)
(string-append binaries "/" modulename))))
((list? binary-configuration)
(for-each
@@ -130,21 +174,19 @@ the @file{bin} directory."
((key . value)
(begin
(mkdir-p (dirname (string-append binaries "/" key)))
- (symlink (string-append target "/node_modules/" modulename "/"
- value)
+ (symlink (string-append install-dir "/" value)
(string-append binaries "/" key))))))
- binary-configuration)))
+ binary-configuration)))
(when dependencies
(mkdir-p
- (string-append target "/node_modules/" modulename "/node_modules"))
+ (string-append install-dir "/node_modules"))
(for-each
(lambda (dependency)
(let ((dependency (car dependency)))
(symlink
(string-append (assoc-ref inputs (string-append "node-" dependency))
"/lib/node_modules/" dependency)
- (string-append target "/node_modules/" modulename
- "/node_modules/" dependency))))
+ (string-append install-dir "/node_modules/" dependency))))
dependencies))
#t))