From: paul <goodoldpaul@autistici.org>
To: Jelle Licht <jlicht@fsfe.org>, 41219@debbugs.gnu.org
Subject: [bug#41219] [PATCH 2/2] guix: Enforce package.json "files" directive.
Date: Mon, 19 Oct 2020 01:32:50 +0200 [thread overview]
Message-ID: <bbe9bc1d-120c-5ee8-aed6-db4dde677766@autistici.org> (raw)
In-Reply-To: <87a6xhel9s.fsf@jlicht.xyz>
[-- Attachment #1: Type: text/plain, Size: 971 bytes --]
Dear Jelle,
On 9/22/20 8:09 PM, Jelle Licht wrote:
> Hey Giacomo,
>
> paul <goodoldpaul@autistici.org> writes:
>>>> + 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)))))
> ^
>
> {New,Forgotten} nitpick; this only checks for the `dirname': why not
> just `(string-append install-dir "/" main)'? Because if
> e.g. "lib/utils.js" is in "files", and main is "lib/main.js", it seems
> that main would not be installed with this snippet. Does that make
> sense?
Yes it definitely does. I believe I fixed this in the attached patch.
Thank you for your review,
Giacomo
[-- Attachment #2: 0002-guix-Enforce-package.json-files-directive.patch --]
[-- Type: text/x-patch, Size: 6436 bytes --]
From 3cc2a309f611ea1cd7cf1e0274ef81668819e058 Mon Sep 17 00:00:00 2001
From: Giacomo Leidi <goodoldpaul@autistici.org>
Date: Mon, 21 Sep 2020 22:18:19 +0200
Subject: [PATCH 2/2] 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).
---
guix/build-system/node.scm | 4 +-
guix/build/node-build-system.scm | 68 ++++++++++++++++++++++++++------
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..3c15e7931b 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)))
+ (file-list (match (assoc-ref data "files")
+ (() #f)
+ ((? list? pattern-list) pattern-list)
+ (#f #f)))
+ (patterns
+ (when file-list
+ (map (lambda (pattern)
+ (string->compiled-sglob pattern))
+ (append file-list
+ '("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]*")))))
+ (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)
+ (for-each (lambda (file)
+ (install-file
+ file
+ (string-append install-dir "/"
+ (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 file-list
+ (install-files
+ (find-files "." (lambda (file stat)
+ (any (lambda (pattern)
+ (glob-match? pattern
+ (string-drop file 2)))
+ patterns))))
+ (begin
+ (copy-recursively "." install-dir)
+ ;; Remove references to dependencies
+ (delete-file-recursively
+ (string-append install-dir "/node_modules"))))
+ (when main
+ (let ((main.js (if (string-contains (basename main) ".js")
+ main
+ (string-append main ".js"))))
+ (unless (file-exists? main.js)
+ (install-files (list main.js)))))
(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))
--
2.28.0
next prev parent reply other threads:[~2020-10-18 23:33 UTC|newest]
Thread overview: 16+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-05-12 21:26 [bug#41219] Enforce "files" directive in node build system goodoldpaul
2020-05-12 21:30 ` goodoldpaul
2020-05-12 21:31 ` [bug#41219] [PATCH 1/2] guix: Add globstar support Giacomo Leidi
2020-05-12 21:31 ` [bug#41219] [PATCH 2/2] guix: Enforce package.json "files" directive Giacomo Leidi
2020-06-05 23:09 ` goodoldpaul
2020-09-19 15:15 ` paul
2020-09-20 19:51 ` Jelle Licht
2020-09-21 20:33 ` paul
2020-09-22 15:47 ` paul
2020-09-22 18:09 ` Jelle Licht
2020-10-18 23:32 ` paul [this message]
2020-10-19 13:44 ` paul
2020-10-24 13:23 ` Jelle Licht
2020-10-24 17:07 ` paul
2020-11-30 23:30 ` paul
2020-12-09 21:45 ` bug#41219: " Jelle Licht
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=bbe9bc1d-120c-5ee8-aed6-db4dde677766@autistici.org \
--to=goodoldpaul@autistici.org \
--cc=41219@debbugs.gnu.org \
--cc=jlicht@fsfe.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).