From ed022bec126c9832a47f1fbd75822ffcf3734486 Mon Sep 17 00:00:00 2001
From: Stefan Israelsson Tampe <stefan.itampe@gmail.com>
Date: Tue, 24 Jul 2018 21:47:26 +0200
Subject: subprocess

---
 .../language/python/module/_posixsubprocess.scm    | 140 +++++++++++++++++++++
 modules/language/python/module/errno.scm           |   8 +-
 2 files changed, 147 insertions(+), 1 deletion(-)
 create mode 100644 modules/language/python/module/_posixsubprocess.scm

(limited to 'modules/language/python')

diff --git a/modules/language/python/module/_posixsubprocess.scm b/modules/language/python/module/_posixsubprocess.scm
new file mode 100644
index 0000000..ce2bdc9
--- /dev/null
+++ b/modules/language/python/module/_posixsubprocess.scm
@@ -0,0 +1,140 @@
+(define-module (language python module _posixsubprocess)
+  #:use-module (language python for)
+  #:use-module (language python try)
+  #:use-module (language python module python)
+  #:use-module (language python module bool)
+  #:use-module (language python module os)
+  #:use-module (language python module errno)
+  #:use-module (language python module list)
+  #:use-module (language python exceptions)
+  #:export (fork_exec))
+
+(define (child_exec exec_array argv envp cwd
+                    p2cread p2cwrite
+                    c2pread c2pwrite
+                    errread errwrite
+                    errpipe_read errpipe_write
+                    closed_fds restore_signals
+                    call_setsid
+                    fds_to_keep preexec_fn)
+
+  (define errwrite #f)
+  (define execmsg  #f)
+  (close p2cwrite)
+  (close c2pread)
+  (close errread)
+  (close errpipe_read)
+
+  (if (= c2pwrite 0)
+      (set! c2pwrite (dup c2pwrite)))
+
+  (let lp ()
+    (when (or (= errwrite 0) (= errwrite 1))
+      (set! errwrite (dup errwrite))
+      (lp)))
+  
+  (if (> p2cread 0)
+      (dup2 p2cread 0))
+
+  (if (> c2pwrite 1)
+      (dup2 c2pwrite 1))
+
+  (if (> errwrite 2)
+      (dup2 errwrite 2))
+
+  (if (> p2cread 2)
+      (close p2cread))
+
+  (if (and (> c2pwrite 2) (not (= c2pwrite p2cread)))
+      (close c2pwrite))
+  (if (and (> errwrite 2) (not (= errwrite p2cread))
+           (not (= errwrite c2pwrite)))
+      (close errwrite))
+
+  (if (bool cwd)
+      (chdir cwd))
+
+  (if (bool call_setsid)
+      (setsid))
+  
+  (if (bool preexec_fn)
+      (try
+       preexec_fn
+       (#:except #t (set! msg "Exception occured in preexec_fn"))))
+
+  (if (bool closed_fd)
+      (for ((fd : fds_to_close)) ()
+           (close fd)))
+
+  (let ((argv (to-list argv))
+        (envp (if (bool envp) (to-list envp) envp)))
+    (for ((e : exec_array)) ((e #f))
+         (try
+          (lambda ()
+            (if (bool envp)
+                (execve e argv envp)
+                (execv  e argv)))
+          (#:except #t =>
+             (lambda x
+               (if (not execmsg)
+                   (set! execmsg ""))
+               (set! execmsg
+                 (+ execmsg + (format #f " exec error: ~a~%" x))))))
+         (let ((er (errno)))
+           (if (and (not (= er ENOENT)) (not (=  er ENOTDIR)) (not e))
+               er
+               e))
+         #:final
+         (if e (set_errno e) (set_errno 0))))
+
+  (if errwrite
+      (write errpipe_write errwrite))
+
+  (if execmsg
+      (write errpipe_write execmsg))
+  
+  (if (errno)
+      (write errpipe_write (format #f "exec failed with errno ~a" (errno)))))
+  
+  
+
+(define (fork_exec process_args executable_list
+                   close_fds fds_to_keep
+                   cwd env_list
+                   p2cread p2cwrite c2pread c2pwrite
+                   errread errwrite
+                   errpipe_read errpipe_write
+                   restore_signals start_new_session preexec_fn)
+
+  (if (and (bool close_fds) (< errpipe_read 3))
+      (raise (ValueError "errpipe_write must be >= 3")))
+
+  (for ((fd : fds_to_keep)) ()
+       (if (not (isinstance fd int))
+           (raise (ValueError "bad values(s) in fds_to_keep"))))
+
+  (let ((pid (fork)))
+    (if (= pid 0)
+        (begin
+          ;; Child process
+          (child_exec executable_list
+                      process_args
+                      env_list
+                      cwd
+                      p2cread
+                      p2cwrite
+                      c2pread
+                      c2pwrite
+                      errread
+                      errwrite
+                      errpipe_read
+                      errpipe_write
+                      close_fds
+                      restore_signals
+                      call_setsid
+                      fds_to_keep
+                      preexec_fn)))))
+
+
+                      
+
diff --git a/modules/language/python/module/errno.scm b/modules/language/python/module/errno.scm
index 1626175..f57bf15 100644
--- a/modules/language/python/module/errno.scm
+++ b/modules/language/python/module/errno.scm
@@ -1,7 +1,7 @@
 (define-module (language python module errno)
   #:use-module (system foreign)
   #:use-module (oop pf-objects)
-  #:export (errno errorcode))
+  #:export (errno set_errno errorcode))
 
 
 (define errno
@@ -9,6 +9,12 @@
     (lambda ()
       (pointer-address (dereference-pointer f)))))
 
+(define set_errno
+  (let* ((f (dynamic-pointer "errno" (dynamic-link)))
+         (v (pointer->bytevector f 1)))
+    (lambda (x)
+      (bytevector-set! v 0 x))))
+
 (define errorcode (make-hash-table))
 
 (define-syntax-rule (mk x n)
-- 
cgit v1.2.3