summaryrefslogtreecommitdiff
path: root/modules/language/python/module/_posixsubprocess.scm
blob: ce2bdc935ff22e4f195fb868c536fdd0726806f4 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
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)))))