1 files changed, 51 insertions(+), 0 deletions(-)

A modules/ruther/build/wrappers.scm

@@ 0,0 1,51 @@
+(define-module (ruther build wrappers)
+  #:use-module (guix build utils)
+  #:use-module (ice-9 format)
+  #:export (replace-script-wrapper-with-binary
+            replace-wrappers-with-binaries))
+
+(define* (executable-wrapped? executable)
+  (let ((folder (dirname executable))
+        (filename (basename executable)))
+    (file-exists?
+     (string-append folder "/." filename "-real"))))
+
+(define* (make-c-wrapper-program target)
+  (mkdir-p (dirname target))
+  (call-with-output-file target
+    (lambda (port)
+      (display "#include <unistd.h>
+int main (int argc, char* argv[])
+{
+  execv(\"%SCRIPT%\", argv);
+} " port))))
+
+(define* (replace-script-wrapper-with-binary wrapper target)
+  (let ((wrapper-program "wrapper.c")
+        (wrapper-new (or (and
+                          (equal? wrapper target)
+                          (string-append
+                           (dirname wrapper)
+                           "/."
+                           (basename wrapper)
+                           "-wrapper"))
+                         wrapper)))
+    (when (equal? wrapper target)
+      (rename-file wrapper wrapper-new))
+    (format #t "Replacing wrapper ~a with target ~a.~%"
+            wrapper-new target)
+    (make-c-wrapper-program wrapper-program)
+    (substitute* wrapper-program
+      (("%SCRIPT%")
+       wrapper-new))
+    (when (file-exists? target)
+      (delete-file target))
+    (invoke "gcc" wrapper-program "-o" target)))
+
+(define* (replace-wrappers-with-binaries binaries)
+  (for-each
+   (lambda (binary)
+     (format #t "Investigating binary ~a for wrapping.~%" binary)
+     (when (executable-wrapped? binary)
+       (replace-script-wrapper-with-binary binary binary)))
+   binaries))