--- Begin Message ---
|
Subject: |
[PATCH] WIP guix: Add wrap-script. |
|
Date: |
Tue, 2 Jan 2018 21:44:34 +0100 |
* guix/build/utils.scm (wrap-script): New procedure.
---
guix/build/utils.scm | 101 +++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 101 insertions(+)
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 7391307c8..a2efcb31c 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2013 Andreas Enge <address@hidden>
;;; Copyright © 2013 Nikita Karetnikov <address@hidden>
;;; Copyright © 2015 Mark H Weaver <address@hidden>
+;;; Copyright © 2018 Ricardo Wurmus <address@hidden>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -84,6 +85,7 @@
fold-port-matches
remove-store-references
wrap-program
+ wrap-script
invoke
locale-category->string))
@@ -1068,6 +1070,105 @@ with definitions for VARS."
(chmod prog-tmp #o755)
(rename-file prog-tmp prog))))
+(define wrap-script
+ (let ((interpreter-regex
+ (make-regexp
+ (string-append "^#! ?(/bin/sh|/gnu/store/[^/]+/bin/("
+ (string-join '("python[^ ]*"
+ "Rscript"
+ "perl"
+ "ruby"
+ "bash"
+ "sh") "|")
+ ") ?.*)")))
+ (coding-line-regex
+ (make-regexp
+ ".*#.*coding[=:][[:space:]]*([-[a-zA-Z_0-9].]+)")))
+ (lambda* (prog #:rest vars)
+ "Wrap the script PROG such that VARS are set first. The format of VARS
+is the same as in the WRAP-PROGRAM procedure. This procedure differs from
+WRAP-PROGRAM in that it does not create a separate shell script. Instead,
+PROG is modified directly by prepending a Guile script, which is interpreted
+as a comment in the script's language.
+
+Special encoding comments as supported by Python are recreated on the second
+line.
+
+Note that this procedure can only be used once per file as Guile scripts are
+not supported."
+ (define update-env
+ (match-lambda
+ ((var sep '= rest)
+ `(setenv ,var ,(string-join rest sep)))
+ ((var sep 'prefix rest)
+ `(let ((current (getenv ,var)))
+ (setenv ,var (if current
+ (string-append ,(string-join rest sep)
+ ,sep current)
+ ,(string-join rest sep)))))
+ ((var sep 'suffix rest)
+ `(let ((current (getenv ,var)))
+ (setenv ,var (if current
+ (string-append current ,sep
+ ,(string-join rest sep))
+ ,(string-join rest sep)))))
+ ((var '= rest)
+ `(setenv ,var ,(string-join rest ":")))
+ ((var 'prefix rest)
+ `(let ((current (getenv ,var)))
+ (setenv ,var (if current
+ (string-append ,(string-join rest ":")
+ ":" current)
+ ,(string-join rest ":")))))
+ ((var 'suffix rest)
+ `(let ((current (getenv ,var)))
+ (setenv ,var (if current
+ (string-append current ":"
+ ,(string-join rest ":"))
+ ,(string-join rest ":")))))))
+ (let-values (((interpreter coding-line)
+ (call-with-ascii-input-file prog
+ (lambda (p)
+ (values (false-if-exception
+ (and=> (regexp-exec interpreter-regex
(read-line p))
+ (lambda (m) (match:substring m 1))))
+ (false-if-exception
+ (and=> (regexp-exec coding-line-regex
(read-line p))
+ (lambda (m) (match:substring m
0)))))))))
+ (when interpreter
+ (let* ((header (format #f "\
+#!~a --no-auto-compile
+#!#; ~a
+#\\-~s
+#\\-~s
+"
+ (which "guile")
+ (or coding-line "Guix wrapper")
+ (cons 'begin (map update-env vars))
+ `(apply execl ,interpreter
+ (car (command-line))
+ (command-line))))
+ (template (string-append prog ".XXXXXX"))
+ (out (mkstemp! template))
+ (st (stat prog))
+ (mode (stat:mode st)))
+ (with-throw-handler #t
+ (lambda ()
+ (call-with-ascii-input-file prog
+ (lambda (p)
+ (format out header)
+ (dump-port p out)
+ (close out)
+ (chmod template mode)
+ (rename-file template prog)
+ (set-file-time prog st))))
+ (lambda (key . args)
+ (format (current-error-port)
+ "wrap-script: ~a: error: ~a ~s~%"
+ prog key args)
+ (false-if-exception (delete-file template))
+ #f))))))))
+
;;;
;;; Locales.
--
2.15.0
--- End Message ---
--- Begin Message ---
|
Subject: |
Re: [bug#29951] [PATCH]: guix: Add wrap-script. |
|
Date: |
Fri, 08 Feb 2019 11:10:40 +0100 |
|
User-agent: |
mu4e 1.0; emacs 26.1 |
Ricardo Wurmus <address@hidden> writes:
> Here’s a new version which raises a condition on errors, handles
> all shebangs (including those with arguments or with custom store
> prefix), and which allows the value for “guile” to be overridden.
>
> It comes with tests.
I have pushed this to core-updates with commit
0fb9a8df429a7b9f40610ff15baaff0d8e31e8cf
> It doesn’t apply automatically when “wrap-program” is used. It might be
> a good idea to call it automatically and fall back to “wrap-program” if
> the target is not a supported script.
It still doesn’t do this. To use it you have to opt in and use
“wrap-script” instead of “wrap-program”.
Comments are still welcome!
--
Ricardo
--- End Message ---