diff options
Diffstat (limited to 'modules/language')
| -rw-r--r-- | modules/language/python/module/_posixsubprocess.scm | 140 | ||||
| -rw-r--r-- | modules/language/python/module/errno.scm | 8 |
2 files changed, 147 insertions, 1 deletions
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) |