Merge branch 'core-updates'

6 files changed, 361 insertions, 63 deletions

diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index e5f3197b0a..4df0bb4904 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Mark H Weaver <mhw@netris.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -25,6 +25,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 ftw)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-34)
@@ -58,19 +59,14 @@ See https://reproducible-builds.org/specs/source-date-epoch/."
   (setenv "SOURCE_DATE_EPOCH" "1")
   #t)
 
-(define (first-subdirectory dir)
-  "Return the path of the first sub-directory of DIR."
-  (file-system-fold (lambda (path stat result)
-                      (string=? path dir))
-                    (lambda (path stat result) result) ; leaf
-                    (lambda (path stat result) result) ; down
-                    (lambda (path stat result) result) ; up
-                    (lambda (path stat result)         ; skip
-                      (or result path))
-                    (lambda (path stat errno result)   ; error
-                      (error "first-subdirectory" (strerror errno)))
-                    #f
-                    dir))
+(define (first-subdirectory directory)
+  "Return the file name of the first sub-directory of DIRECTORY."
+  (match (scandir directory
+                  (lambda (file)
+                    (and (not (member file '("." "..")))
+                         (file-is-directory? (string-append directory "/"
+                                                            file)))))
+    ((first . _) first)))
 
 (define* (set-paths #:key target inputs native-inputs
                     (search-paths '()) (native-search-paths '())
@@ -735,23 +731,64 @@ which cannot be found~%"
 
 (define* (install-license-files #:key outputs
                                 (license-file-regexp %license-file-regexp)
+                                out-of-source?
                                 #:allow-other-keys)
   "Install license files matching LICENSE-FILE-REGEXP to 'share/doc'."
+  (define (find-source-directory package)
+    ;; For an out-of-source build, guess the source directory location
+    ;; relative to the current directory.  Return #f on failure.
+    (match (scandir ".."
+                    (lambda (file)
+                      (and (not (member file '("." ".." "build")))
+                           (file-is-directory?
+                            (string-append "../" file)))))
+      (()                                         ;hmm, no source
+       #f)
+      ((source)                                   ;only one other file
+       (string-append "../" source))
+      ((directories ...)                          ;pick the most likely one
+       ;; This happens for example with libstdc++, which lives within the GCC
+       ;; source tree.
+       (any (lambda (directory)
+              (and (string-prefix? package directory)
+                   (string-append "../" directory)))
+            directories))))
+
+  (define (copy-to-directories directories sub-directory)
+    (lambda (file)
+      (for-each (if (file-is-directory? file)
+                    (cut copy-recursively file <>)
+                    (cut install-file file <>))
+                (map (cut string-append <> "/" sub-directory)
+                     directories))))
+
   (let* ((regexp    (make-regexp license-file-regexp))
          (out       (or (assoc-ref outputs "out")
                         (match outputs
                           (((_ . output) _ ...)
                            output))))
          (package   (strip-store-file-name out))
-         (directory (string-append out "/share/doc/" package))
-         (files     (scandir "." (lambda (file)
-                                   (regexp-exec regexp file)))))
-    (format #t "installing ~a license files~%" (length files))
-    (for-each (lambda (file)
-                (if (file-is-directory? file)
-                    (copy-recursively file directory)
-                    (install-file file directory)))
-              files)
+         (outputs   (match outputs
+                      (((_ . outputs) ...)
+                       outputs)))
+         (source    (if out-of-source?
+                        (find-source-directory
+                         (package-name->name+version package))
+                        "."))
+         (files     (and source
+                         (scandir source
+                                  (lambda (file)
+                                    (regexp-exec regexp file))))))
+    (if files
+        (begin
+          (format #t "installing ~a license files from '~a'~%"
+                  (length files) source)
+          (for-each (copy-to-directories outputs
+                                         (string-append "share/doc/"
+                                                        package))
+                    (map (cut string-append source "/" <>) files)))
+        (format (current-error-port)
+                "failed to find license files~%"))
     #t))
 
 (define %standard-phases
@@ -784,34 +821,37 @@ in order.  Return #t if all the PHASES succeeded, #f otherwise."
       (+ (time-second diff)
          (/ (time-nanosecond diff) 1e9))))
 
-  (setvbuf (current-output-port) _IOLBF)
-  (setvbuf (current-error-port) _IOLBF)
+  (setvbuf (current-output-port) 'line)
+  (setvbuf (current-error-port) 'line)
 
   ;; Encoding/decoding errors shouldn't be silent.
   (fluid-set! %default-port-conversion-strategy 'error)
 
-  ;; The trick is to #:allow-other-keys everywhere, so that each procedure in
-  ;; PHASES can pick the keyword arguments it's interested in.
-  (every (match-lambda
-           ((name . proc)
-            (let ((start (current-time time-monotonic)))
-              (format #t "starting phase `~a'~%" name)
-              (let ((result (apply proc args))
-                    (end    (current-time time-monotonic)))
-                (format #t "phase `~a' ~:[failed~;succeeded~] after ~,1f seconds~%"
-                        name result
-                        (elapsed-time end start))
-
-                ;; Issue a warning unless the result is #t.
-                (unless (eqv? result #t)
-                  (format (current-error-port) "\
+  (guard (c ((invoke-error? c)
+             (report-invoke-error c)
+             (exit 1)))
+    ;; The trick is to #:allow-other-keys everywhere, so that each procedure in
+    ;; PHASES can pick the keyword arguments it's interested in.
+    (every (match-lambda
+             ((name . proc)
+              (let ((start (current-time time-monotonic)))
+                (format #t "starting phase `~a'~%" name)
+                (let ((result (apply proc args))
+                      (end    (current-time time-monotonic)))
+                  (format #t "phase `~a' ~:[failed~;succeeded~] after ~,1f seconds~%"
+                          name result
+                          (elapsed-time end start))
+
+                  ;; Issue a warning unless the result is #t.
+                  (unless (eqv? result #t)
+                    (format (current-error-port) "\
 ## WARNING: phase `~a' returned `~s'.  Return values other than #t
 ## are deprecated.  Please migrate this package so that its phase
 ## procedures report errors by raising an exception, and otherwise
 ## always return #t.~%"
-                          name result))
+                            name result))
 
-                ;; Dump the environment variables as a shell script, for handy debugging.
-                (system "export > $NIX_BUILD_TOP/environment-variables")
-                result))))
-         phases))
+                  ;; Dump the environment variables as a shell script, for handy debugging.
+                  (system "export > $NIX_BUILD_TOP/environment-variables")
+                  result))))
+           phases)))
diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm
index 3dac43c18a..4bc0156a88 100644
--- a/guix/build/go-build-system.scm
+++ b/guix/build/go-build-system.scm
@@ -237,7 +237,7 @@ unpacking."
   "Install the source code of IMPORT-PATH to the primary output directory.
 Compiled executable files (Go \"commands\") should have already been installed
 to the store based on $GOBIN in the build phase.
-XXX We can't make us of compiled libraries (Go \"packages\")."
+XXX We can't make use of compiled libraries (Go \"packages\")."
   (when install-source?
     (if (string-null? import-path)
         ((display "WARNING: The Go import path is unset.\n")))
diff --git a/guix/build/meson-build-system.scm b/guix/build/meson-build-system.scm
index d0975fcab0..8043a84abb 100644
--- a/guix/build/meson-build-system.scm
+++ b/guix/build/meson-build-system.scm
@@ -108,6 +108,7 @@ for example libraries only needed for the tests."
   ;; from the gnu-build-system.  If the glib-or-gtk? key is #f (the default)
   ;; then the extra phases will be removed again in (guix build-system meson).
   (modify-phases glib-or-gtk:%standard-phases
+    (delete 'bootstrap)
     (replace 'configure configure)
     (replace 'build build)
     (replace 'check check)
diff --git a/guix/build/python-build-system.scm b/guix/build/python-build-system.scm
index 5bb0ba49d5..09bd8465c8 100644
--- a/guix/build/python-build-system.scm
+++ b/guix/build/python-build-system.scm
@@ -1,10 +1,11 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2015, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,6 +32,7 @@
   #:export (%standard-phases
             add-installed-pythonpath
             site-packages
+            python-version
             python-build))
 
 ;; Commentary:
@@ -146,7 +148,7 @@
       (format #t "test suite not run~%"))
   #t)
 
-(define (get-python-version python)
+(define (python-version python)
   (let* ((version     (last (string-split python #\-)))
          (components  (string-split version #\.))
          (major+minor (take components 2)))
@@ -157,7 +159,7 @@
   (let* ((out (assoc-ref outputs "out"))
          (python (assoc-ref inputs "python")))
     (string-append out "/lib/python"
-                   (get-python-version python)
+                   (python-version python)
                    "/site-packages/")))
 
 (define (add-installed-pythonpath inputs outputs)
@@ -186,11 +188,9 @@ when running checks after installing the package."
 
 (define* (wrap #:key inputs outputs #:allow-other-keys)
   (define (list-of-files dir)
-    (map (cut string-append dir "/" <>)
-         (or (scandir dir (lambda (f)
-                            (let ((s (stat (string-append dir "/" f))))
-                              (eq? 'regular (stat:type s)))))
-             '())))
+    (find-files dir (lambda (file stat)
+                      (and (eq? 'regular (stat:type stat))
+                           (not (wrapper? file))))))
 
   (define bindirs
     (append-map (match-lambda
@@ -203,7 +203,7 @@ when running checks after installing the package."
          (python (assoc-ref inputs "python"))
          (var `("PYTHONPATH" prefix
                 ,(cons (string-append out "/lib/python"
-                                      (get-python-version python)
+                                      (python-version python)
                                       "/site-packages")
                        (search-path-as-string->list
                         (or (getenv "PYTHONPATH") ""))))))
@@ -223,7 +223,7 @@ installed with setuptools."
   (let* ((out (assoc-ref outputs "out"))
          (python (assoc-ref inputs "python"))
          (site-packages (string-append out "/lib/python"
-                                       (get-python-version python)
+                                       (python-version python)
                                        "/site-packages"))
          (easy-install-pth (string-append site-packages "/easy-install.pth"))
          (new-pth (string-append site-packages "/" name ".pth")))
@@ -251,16 +251,21 @@ installed with setuptools."
   #t)
 
 (define %standard-phases
-  ;; 'configure' phase is not needed.
+  ;; The build phase only builds C extensions and copies the Python sources,
+  ;; while the install phase byte-compiles and copies them to the prefix
+  ;; directory.  The tests are run after the install phase because otherwise
+  ;; the cached .pyc generated during the tests execution seem to interfere
+  ;; with the byte compilation of the install phase.
   (modify-phases gnu:%standard-phases
     (add-after 'unpack 'ensure-no-mtimes-pre-1980 ensure-no-mtimes-pre-1980)
     (add-after 'ensure-no-mtimes-pre-1980 'enable-bytecode-determinism
       enable-bytecode-determinism)
     (delete 'bootstrap)
-    (delete 'configure)
-    (replace 'install install)
-    (replace 'check check)
+    (delete 'configure)                 ;not needed
     (replace 'build build)
+    (delete 'check)                     ;moved after the install phase
+    (replace 'install install)
+    (add-after 'install 'check check)
     (add-after 'install 'wrap wrap)
     (add-before 'strip 'rename-pth-file rename-pth-file)))
 
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index f2fdb4d9d1..bbf2531c79 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -68,6 +68,7 @@
             statfs
             free-disk-space
             device-in-use?
+            add-to-entropy-count
 
             processes
             mkdtemp!
@@ -708,6 +709,33 @@ backend device."
 
 
 ;;;
+;;; Random.
+;;;
+
+;; From <uapi/linux/random.h>.
+(define RNDADDTOENTCNT #x40045201)
+
+(define (add-to-entropy-count port-or-fd n)
+  "Add N to the kernel's entropy count (the value that can be read from
+/proc/sys/kernel/random/entropy_avail).  PORT-OR-FD must correspond to
+/dev/urandom or /dev/random.  Raise to 'system-error with EPERM when the
+caller lacks root privileges."
+  (let ((fd  (if (port? port-or-fd)
+                 (fileno port-or-fd)
+                 port-or-fd))
+        (box (make-bytevector (sizeof int))))
+    (bytevector-sint-set! box 0 n (native-endianness)
+                          (sizeof int))
+    (let-values (((ret err)
+                  (%ioctl fd RNDADDTOENTCNT
+                          (bytevector->pointer box))))
+      (unless (zero? err)
+        (throw 'system-error "add-to-entropy-count" "~A"
+               (list (strerror err))
+               (list err))))))
+
+
+;;;
 ;;; Containers.
 ;;;
 
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index 5fe3286843..b8be73ead4 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -1,8 +1,10 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2015, 2018 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -87,7 +89,13 @@
             patch-/usr/bin/file
             fold-port-matches
             remove-store-references
+            wrapper?
             wrap-program
+            wrap-script
+
+            wrap-error?
+            wrap-error-program
+            wrap-error-type
 
             invoke
             invoke-error?
@@ -96,10 +104,33 @@
             invoke-error-exit-status
             invoke-error-term-signal
             invoke-error-stop-signal
+            report-invoke-error
+
+            invoke/quiet
 
             locale-category->string))
 
+
+;;;
+;;; Guile 2.0 compatibility later.
+;;;
 
+;; The bootstrap Guile is Guile 2.0, so provide a compatibility layer.
+(cond-expand
+  ((and guile-2 (not guile-2.2))
+   (define (setvbuf port mode . rest)
+     (apply (@ (guile) setvbuf) port
+            (match mode
+              ('line _IOLBF)
+              ('block _IOFBF)
+              ('none _IONBF)
+              (_ mode))                           ;an _IO* integer
+            rest))
+
+   (module-replace! (current-module) '(setvbuf)))
+  (else #f))
+
+
 ;;;
 ;;; Directories.
 ;;;
@@ -600,6 +631,11 @@ Where every <*-phase-name> is an expression evaluating to a symbol, and
     ((_ phases (add-after old-phase-name new-phase-name new-phase))
      (alist-cons-after old-phase-name new-phase-name new-phase phases))))
 
+
+;;;
+;;; Program invocation.
+;;;
+
 (define-condition-type &invoke-error &error
   invoke-error?
   (program      invoke-error-program)
@@ -621,6 +657,68 @@ if the exit code is non-zero; otherwise return #t."
                          (stop-signal (status:stop-sig code))))))
     #t))
 
+(define* (report-invoke-error c #:optional (port (current-error-port)))
+  "Report to PORT about C, an '&invoke-error' condition, in a human-friendly
+way."
+  (format port "command~{ ~s~} failed with ~:[signal~;status~] ~a~%"
+          (cons (invoke-error-program c)
+                (invoke-error-arguments c))
+          (invoke-error-exit-status c)
+          (or (invoke-error-exit-status c)
+              (invoke-error-term-signal c)
+              (invoke-error-stop-signal c))))
+
+(define (open-pipe-with-stderr program . args)
+  "Run PROGRAM with ARGS in an input pipe, but, unlike 'open-pipe*', redirect
+both its standard output and standard error to the pipe.  Return two value:
+the pipe to read PROGRAM's data from, and the PID of the child process running
+PROGRAM."
+  ;; 'open-pipe*' doesn't attempt to capture stderr in any way, which is why
+  ;; we need to roll our own.
+  (match (pipe)
+    ((input .  output)
+     (match (primitive-fork)
+       (0
+        (dynamic-wind
+          (const #t)
+          (lambda ()
+            (close-port input)
+            (dup2 (fileno output) 1)
+            (dup2 (fileno output) 2)
+            (apply execlp program program args))
+          (lambda ()
+            (primitive-exit 127))))
+       (pid
+        (close-port output)
+        (values input pid))))))
+
+(define (invoke/quiet program . args)
+  "Invoke PROGRAM with ARGS and capture PROGRAM's standard output and standard
+error.  If PROGRAM succeeds, print nothing and return the unspecified value;
+otherwise, raise a '&message' error condition that includes the status code
+and the output of PROGRAM."
+  (let-values (((pipe pid)
+                (apply open-pipe-with-stderr program args)))
+    (let loop ((lines '()))
+      (match (read-line pipe)
+        ((? eof-object?)
+         (close-port pipe)
+         (match (waitpid pid)
+           ((_ . status)
+            (unless (zero? status)
+              (let-syntax ((G_ (syntax-rules ()   ;for xgettext
+                                 ((_ str) str))))
+                (raise (condition
+                        (&message
+                         (message (format #f (G_ "'~a~{ ~a~}' exited \
+with status ~a; output follows:~%~%~{  ~a~%~}")
+                                          program args
+                                          (or (status:exit-val status)
+                                              status)
+                                          (reverse lines)))))))))))
+        (line
+         (loop (cons line lines)))))))
+
 
 ;;;
 ;;; Text substitution (aka. sed).
@@ -987,8 +1085,8 @@ known as `nuke-refs' in Nixpkgs."
         ;; We cannot use `regexp-exec' here because it cannot deal with
         ;; strings containing NUL characters.
         (format #t "removing store references from `~a'...~%" file)
-        (setvbuf in _IOFBF 65536)
-        (setvbuf out _IOFBF 65536)
+        (setvbuf in 'block 65536)
+        (setvbuf out 'block 65536)
         (fold-port-matches (lambda (match result)
                              (put-bytevector out (string->utf8 store))
                              (put-u8 out (char->integer #\/))
@@ -1003,6 +1101,18 @@ known as `nuke-refs' in Nixpkgs."
                              (put-u8 out (char->integer char))
                              result))))))
 
+(define-condition-type &wrap-error &error
+  wrap-error?
+  (program    wrap-error-program)
+  (type       wrap-error-type))
+
+(define (wrapper? prog)
+  "Return #t if PROG is a wrapper as produced by 'wrap-program'."
+  (and (file-exists? prog)
+       (let ((base (basename prog)))
+         (and (string-prefix? "." base)
+              (string-suffix? "-real" base)))))
+
 (define* (wrap-program prog #:rest vars)
   "Make a wrapper for PROG.  VARS should look like this:
 
@@ -1100,6 +1210,120 @@ with definitions for VARS."
         (chmod prog-tmp #o755)
         (rename-file prog-tmp prog))))
 
+(define wrap-script
+  (let ((interpreter-regex
+         (make-regexp
+          (string-append "^#! ?(/[^ ]+/bin/("
+                         (string-join '("python[^ ]*"
+                                        "Rscript"
+                                        "perl"
+                                        "ruby"
+                                        "bash"
+                                        "sh") "|")
+                         "))( ?.*)")))
+        (coding-line-regex
+         (make-regexp
+          ".*#.*coding[=:][[:space:]]*([-a-zA-Z_0-9.]+)")))
+    (lambda* (prog #:key (guile (which "guile")) #: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 args coding-line)
+                    (call-with-ascii-input-file prog
+                      (lambda (p)
+                        (let ((first-match
+                               (false-if-exception
+                                (regexp-exec interpreter-regex (read-line p)))))
+                          (values (and first-match (match:substring first-match 1))
+                                  (and first-match (match:substring first-match 3))
+                                  (false-if-exception
+                                   (and=> (regexp-exec coding-line-regex (read-line p))
+                                          (lambda (m) (match:substring m 0))))))))))
+        (if interpreter
+            (let* ((header (format #f "\
+#!~a --no-auto-compile
+#!#; ~a
+#\\-~s
+#\\-~s
+"
+                                   guile
+                                   (or coding-line "Guix wrapper")
+                                   (cons 'begin (map update-env
+                                                     (match vars
+                                                       ((#:guile _ . vars) vars)
+                                                       (_ vars))))
+                                   `(let ((cl (command-line)))
+                                      (apply execl ,interpreter
+                                             (car cl)
+                                             (cons (car cl)
+                                                   (append
+                                                    ',(string-split args #\space)
+                                                    cl))))))
+                   (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))
+                  (raise (condition
+                          (&wrap-error (program prog)
+                                       (type key))))
+                  #f)))
+            (raise (condition
+                    (&wrap-error (program prog)
+                                 (type 'no-interpreter-found)))))))))
+
 
 ;;;
 ;;; Locales.