ce2bdc935ff22e4f195fb868c536fdd0726806f4
[software/python-on-guile.git] / modules / language / python / module / _posixsubprocess.scm
1 (define-module (language python module _posixsubprocess)
2 #:use-module (language python for)
3 #:use-module (language python try)
4 #:use-module (language python module python)
5 #:use-module (language python module bool)
6 #:use-module (language python module os)
7 #:use-module (language python module errno)
8 #:use-module (language python module list)
9 #:use-module (language python exceptions)
10 #:export (fork_exec))
11
12 (define (child_exec exec_array argv envp cwd
13 p2cread p2cwrite
14 c2pread c2pwrite
15 errread errwrite
16 errpipe_read errpipe_write
17 closed_fds restore_signals
18 call_setsid
19 fds_to_keep preexec_fn)
20
21 (define errwrite #f)
22 (define execmsg #f)
23 (close p2cwrite)
24 (close c2pread)
25 (close errread)
26 (close errpipe_read)
27
28 (if (= c2pwrite 0)
29 (set! c2pwrite (dup c2pwrite)))
30
31 (let lp ()
32 (when (or (= errwrite 0) (= errwrite 1))
33 (set! errwrite (dup errwrite))
34 (lp)))
35
36 (if (> p2cread 0)
37 (dup2 p2cread 0))
38
39 (if (> c2pwrite 1)
40 (dup2 c2pwrite 1))
41
42 (if (> errwrite 2)
43 (dup2 errwrite 2))
44
45 (if (> p2cread 2)
46 (close p2cread))
47
48 (if (and (> c2pwrite 2) (not (= c2pwrite p2cread)))
49 (close c2pwrite))
50 (if (and (> errwrite 2) (not (= errwrite p2cread))
51 (not (= errwrite c2pwrite)))
52 (close errwrite))
53
54 (if (bool cwd)
55 (chdir cwd))
56
57 (if (bool call_setsid)
58 (setsid))
59
60 (if (bool preexec_fn)
61 (try
62 preexec_fn
63 (#:except #t (set! msg "Exception occured in preexec_fn"))))
64
65 (if (bool closed_fd)
66 (for ((fd : fds_to_close)) ()
67 (close fd)))
68
69 (let ((argv (to-list argv))
70 (envp (if (bool envp) (to-list envp) envp)))
71 (for ((e : exec_array)) ((e #f))
72 (try
73 (lambda ()
74 (if (bool envp)
75 (execve e argv envp)
76 (execv e argv)))
77 (#:except #t =>
78 (lambda x
79 (if (not execmsg)
80 (set! execmsg ""))
81 (set! execmsg
82 (+ execmsg + (format #f " exec error: ~a~%" x))))))
83 (let ((er (errno)))
84 (if (and (not (= er ENOENT)) (not (= er ENOTDIR)) (not e))
85 er
86 e))
87 #:final
88 (if e (set_errno e) (set_errno 0))))
89
90 (if errwrite
91 (write errpipe_write errwrite))
92
93 (if execmsg
94 (write errpipe_write execmsg))
95
96 (if (errno)
97 (write errpipe_write (format #f "exec failed with errno ~a" (errno)))))
98
99
100
101 (define (fork_exec process_args executable_list
102 close_fds fds_to_keep
103 cwd env_list
104 p2cread p2cwrite c2pread c2pwrite
105 errread errwrite
106 errpipe_read errpipe_write
107 restore_signals start_new_session preexec_fn)
108
109 (if (and (bool close_fds) (< errpipe_read 3))
110 (raise (ValueError "errpipe_write must be >= 3")))
111
112 (for ((fd : fds_to_keep)) ()
113 (if (not (isinstance fd int))
114 (raise (ValueError "bad values(s) in fds_to_keep"))))
115
116 (let ((pid (fork)))
117 (if (= pid 0)
118 (begin
119 ;; Child process
120 (child_exec executable_list
121 process_args
122 env_list
123 cwd
124 p2cread
125 p2cwrite
126 c2pread
127 c2pwrite
128 errread
129 errwrite
130 errpipe_read
131 errpipe_write
132 close_fds
133 restore_signals
134 call_setsid
135 fds_to_keep
136 preexec_fn)))))
137
138
139
140