Line data Source code
1 : % Copyright (C) 2012-2021,2022 John E. Davis
2 : %
3 : % This file is part of the S-Lang Library and may be distributed under the
4 : % terms of the GNU General Public License. See the file COPYING for
5 : % more information.
6 : %---------------------------------------------------------------------------
7 5 : require ("fork");
8 5 : require ("fcntl");
9 :
10 5 : private variable OPEN_MAX = 512;
11 : try
12 : {
13 5 : require ("sysconf");
14 5 : OPEN_MAX = (@__get_reference ("sysconf"))("_SC_OPEN_MAX", 512);
15 : }
16 0 : catch ImportError;
17 :
18 : #ifexists signal
19 5 : signal (SIGPIPE, SIG_IGN);
20 : #endif
21 :
22 : private define parse_redir (redir)
23 : {
24 : variable redir_info =
25 2 : [{"^>> ?\(.*\)"R, O_WRONLY|O_CREAT|O_APPEND},
26 : {"^> ?\(.*\)"R, O_WRONLY|O_TRUNC|O_CREAT},
27 : {"^<> ?\(.*\)"R, O_RDWR|O_CREAT},
28 : {"^< ?\(.*\)"R, O_RDONLY}
29 : ];
30 2 : variable other_flags = O_NOCTTY;
31 :
32 2 : foreach (redir_info)
33 : {
34 8 : variable ri = ();
35 8 : variable re = ri[0];
36 8 : ifnot (string_match (redir, re, 1))
37 7 : continue;
38 : variable pos, len;
39 1 : (pos, len) = string_match_nth (1);
40 1 : return ri[1] | other_flags, redir[[pos:pos+len-1]];
41 : }
42 1 : return 0, redir;
43 : }
44 :
45 5 : private variable S_RWUGO = S_IRUSR|S_IWUSR|S_IRGRP|S_IWGRP|S_IROTH|S_IWOTH;
46 :
47 : % Look for structure fields of the form fpN and open the corresponding
48 : % files.
49 : private define open_redirect_files (q)
50 : {
51 8 : variable redir_fds = FD_Type[0], redir_ifds = Int_Type[0];
52 4 : if (q == NULL)
53 0 : return redir_fds, redir_ifds;
54 :
55 4 : foreach (get_struct_field_names (q))
56 : {
57 22 : variable name = ();
58 22 : variable fd, ifd, value, defflags = 0, flags, file;
59 :
60 22 : value = get_struct_field (q, name);
61 :
62 22 : if (1 != sscanf (name, "fd%d", &ifd))
63 : {
64 22 : if (name == "stdin") ifd = 0;
65 22 : else if (name == "stdout") ifd = 1;
66 18 : else if (name == "stderr") ifd = 2;
67 18 : else continue;
68 : }
69 5 : if (ifd == 0) defflags = O_RDONLY|O_NOCTTY;
70 6 : if ((ifd == 1) || (ifd == 2)) defflags = O_WRONLY|O_TRUNC|O_CREAT|O_NOCTTY;
71 :
72 4 : if (typeof(value) == String_Type)
73 : {
74 2 : (flags, file) = parse_redir (value);
75 2 : if (file == "")
76 0 : throw InvalidParmError, "Invalid redirection: $value";
77 :
78 3 : if (flags == 0) flags = defflags;
79 :
80 2 : if (flags & O_CREAT)
81 1 : fd = open (file, flags, S_RWUGO);
82 : else
83 1 : fd = open (file, flags);
84 :
85 2 : if (fd == NULL)
86 1 : throw OpenError, sprintf ("%s: %s", file, errno_string ());
87 : }
88 2 : else if (typeof(value) == FD_Type)
89 : {
90 1 : fd = value;
91 : }
92 1 : else if (typeof(value) == File_Type)
93 : {
94 0 : fd = fileno (value);
95 : }
96 : else
97 : {
98 1 : fd = @FD_Type(value);
99 : }
100 :
101 3 : if (fd == NULL)
102 0 : throw OSError, "fd$ifd: "$ + errno_string();
103 :
104 3 : redir_fds = [redir_fds, fd];
105 3 : redir_ifds = [redir_ifds, ifd];
106 : }
107 :
108 3 : return (redir_fds, redir_ifds);
109 : }
110 :
111 : % parse dupN=M qualifiers
112 : private define parse_dup_qualifiers (q)
113 : {
114 6 : variable open_fds = FD_Type[0], wanted_ifds = Int_Type[0];
115 :
116 3 : if (q == NULL)
117 0 : return open_fds, wanted_ifds;
118 :
119 3 : foreach (get_struct_field_names (q))
120 : {
121 21 : variable name = ();
122 : variable fd, ifd, value;
123 21 : if ((1 != sscanf (name, "dup%d", &ifd))
124 : || (name != sprintf ("dup%d", ifd)))
125 18 : continue;
126 :
127 3 : value = get_struct_field (q, name);
128 3 : if (typeof (value) == File_Type)
129 0 : fd = fileno (value);
130 3 : else if (typeof (value) == FD_Type)
131 0 : fd = value;
132 : else
133 3 : fd = @FD_Type(value);
134 3 : if (fd == NULL)
135 0 : throw OSError, "fd$ifd: "$ + errno_string();
136 :
137 3 : open_fds = [open_fds, fd];
138 3 : wanted_ifds = [wanted_ifds, ifd];
139 : }
140 3 : return open_fds, wanted_ifds;
141 : }
142 :
143 : % Here, open_fds is an array of all (known) open FD_Type objects, and open_ifds
144 : % is the corresponding array of integer descriptors. Starting at the
145 : % index idx_offset, dup2 the FD_Type objects onto the array of
146 : % wanted_ifds. If a wanted_ifd is associated with an open descriptor,
147 : % then that will be duped to a new integer descriptor.
148 : private define dup2_open_fds (wanted_ifds, open_ifds, open_fds, idx_offset)
149 : {
150 : variable i, ifd, fd;
151 :
152 9 : _for i (0, length(wanted_ifds)-1, 1)
153 : {
154 20 : ifd = wanted_ifds[i];
155 :
156 20 : i += idx_offset;
157 20 : variable j = wherefirst (open_ifds == ifd);
158 :
159 21 : if (j == i) continue;
160 19 : if (j == 0)
161 : {
162 : % This is the file descriptior that we want to use for
163 : % messages
164 : % Dup it to something else.
165 5 : fd = dup_fd (open_fds[0]);
166 5 : if (fd == NULL)
167 0 : throw OSError, "dup_fd failed: " + errno_string ();
168 5 : () = fcntl_setfd (fd, fcntl_getfd (fd) | FD_CLOEXEC);
169 :
170 5 : open_fds[0] = fd;
171 5 : open_ifds[0] = _fileno(fd);
172 5 : j = wherefirst (open_ifds == ifd);
173 : }
174 :
175 19 : if (j != NULL)
176 : {
177 : % Here, ifd is already associated with an open
178 : % descriptor. Dup that descriptor to something else so
179 : % that ifd can be used.
180 1 : fd = dup_fd (open_fds[j]);
181 1 : if (fd == NULL)
182 0 : throw OSError, "dup_fd failed: " + errno_string ();
183 1 : open_ifds[j] = _fileno(fd);
184 1 : open_fds[j] = fd;
185 : % drop
186 : }
187 :
188 : % Replace open_ifds[i] with the desired descriptor
189 19 : if (-1 == dup2_fd (open_fds[i], ifd))
190 0 : throw OSError, "dup2_fd failed: " + errno_string ();
191 :
192 19 : open_fds[i] = @FD_Type(ifd);
193 19 : open_ifds[i] = ifd;
194 : }
195 : }
196 :
197 : private define exec_child (argv, child_fds, required_child_ifds)
198 : {
199 : variable i, j, fd, ifd;
200 :
201 : % The child pipe ends will need to be dup2'd to the corresponding
202 : % integers. Care must be exercised to not stomp on pipe descriptors
203 : % that have the same values.
204 : % Note: The first one in the list is the traceback fd
205 4 : variable child_open_ifds = array_map (Int_Type, &_fileno, child_fds);
206 4 : dup2_open_fds (required_child_ifds, child_open_ifds, child_fds, 1);
207 :
208 4 : if (__qualifiers != NULL)
209 : {
210 : % Handle the fdN=foo qualifiers, e.g., fd0="file", fd1=3
211 : variable redir_fds, wanted_redir_ifds;
212 4 : (redir_fds, wanted_redir_ifds) = open_redirect_files (__qualifiers);
213 :
214 3 : variable ofs = length (child_open_ifds);
215 3 : child_fds = [child_fds, redir_fds];
216 3 : child_open_ifds = [child_open_ifds,
217 : array_map (Int_Type, &_fileno, redir_fds)];
218 :
219 3 : redir_fds = NULL; % decrement ref-counts
220 3 : dup2_open_fds (wanted_redir_ifds, child_open_ifds, child_fds, ofs);
221 :
222 : % Now handle the dupN=M qualifiers. Here, M must already be
223 : % open in the child, and N will be duped from it. Note: M
224 : % could be inherited from the parent, and as such may not be
225 : % in the child_open_ifds list.
226 : variable fdMs, ifdMs, ifdNs;
227 3 : (fdMs, ifdNs) = parse_dup_qualifiers (__qualifiers);
228 3 : variable num_aliased = length (ifdNs);
229 3 : if (num_aliased)
230 : {
231 2 : ifdMs = array_map (Int_Type, &_fileno, fdMs);
232 : % Note the padding. This is because there are not yet open
233 : % descriptors that correspond to the ifdNs
234 2 : child_fds = [child_fds, fdMs, fdMs];
235 2 : child_open_ifds = [child_open_ifds, ifdMs, Int_Type[num_aliased]-1];
236 :
237 2 : dup2_open_fds (ifdNs, child_open_ifds, child_fds, length(child_fds)-num_aliased);
238 : }
239 : }
240 :
241 3 : variable hook = qualifier ("pre_exec_hook");
242 3 : if (hook != NULL)
243 : {
244 2 : variable hook_arg = qualifier ("pre_exec_hook_optarg");
245 : % Call the hook. Pass it the list of open descriptors. All others
246 : % will be closed.
247 2 : variable list = {};
248 26 : foreach ifd (child_open_ifds) list_append (list, ifd);
249 2 : if (hook_arg == NULL)
250 1 : (@hook)(list);
251 : else
252 1 : (@hook)(list, hook_arg);
253 :
254 2 : child_open_ifds = list_to_array (list);
255 : }
256 :
257 3 : variable close_mask = Char_Type[OPEN_MAX];
258 3 : close_mask [[3:]] = 1;
259 29 : foreach ifd (child_open_ifds) close_mask[ifd] = 0;
260 3 : _for ifd (0, length(close_mask)-1, 1)
261 : {
262 6117 : if (close_mask[ifd]) () = _close (ifd);
263 : }
264 :
265 3 : variable exec_hook = qualifier("exec_hook");
266 3 : if (exec_hook == NULL)
267 0 : () = execvp (argv[0], argv);
268 : else
269 3 : () = (@exec_hook)(argv, qualifier ("exec_hook_arg"));
270 :
271 0 : throw OSError, "exec failed: " + argv[0] + " : " + errno_string ();
272 : }
273 :
274 : private define wait_method ()
275 : {
276 7 : variable options = 0, s;
277 :
278 7 : if (_NARGS == 2)
279 1 : options = ();
280 7 : s = ();
281 :
282 7 : if (s.pid == -1)
283 0 : return NULL;
284 :
285 7 : return waitpid (s.pid, options);
286 : }
287 :
288 : define new_process ()
289 : {
290 14 : if (_NARGS != 1)
291 : {
292 0 : usage ("obj = new_process([pgm, args...] [;qualifiers])");
293 : }
294 :
295 14 : variable argv = ();
296 14 : if (typeof (argv) == List_Type)
297 0 : argv = list_to_array (argv);
298 14 : if (typeof (argv) != Array_Type)
299 4 : argv = [argv];
300 :
301 14 : variable read_ifds = qualifier("read", Int_Type[0]);
302 14 : variable write_ifds = qualifier("write", Int_Type[0]);
303 :
304 14 : if (typeof (read_ifds) == List_Type)
305 5 : read_ifds = list_to_array (read_ifds);
306 14 : if (typeof (write_ifds) == List_Type)
307 0 : write_ifds = list_to_array (write_ifds);
308 :
309 14 : variable numfds = length(read_ifds) + length(write_ifds);
310 14 : variable parent_fds = FD_Type[numfds+1]; % +1 for traceback fd
311 14 : variable child_fds = FD_Type[numfds+1];
312 14 : variable modes = String_Type[numfds+1];
313 :
314 : variable ifd, r, w;
315 :
316 : % The read and write fds become pipes to the child and are returned
317 : % as structure fields.
318 14 : variable i = 0;
319 :
320 : % The 0th one is used to commmunicate error messages
321 28 : (parent_fds[i], child_fds[i]) = pipe (); i++;
322 14 : variable fd = child_fds[0];
323 14 : () = fcntl_setfd (fd, fcntl_getfd (fd) | FD_CLOEXEC);
324 14 : fd = NULL; % remove reference to it.
325 :
326 14 : variable child_ifds = [read_ifds, write_ifds];
327 14 : variable struct_fields = {};
328 14 : foreach ifd (read_ifds)
329 : {
330 48 : list_append (struct_fields,"fd$ifd"$);
331 48 : list_append (struct_fields,"fp$ifd"$);
332 48 : modes[i] = "w";
333 96 : (child_fds[i], parent_fds[i]) = pipe (); i++;
334 : }
335 :
336 14 : foreach ifd (write_ifds)
337 : {
338 11 : list_append (struct_fields,"fd$ifd"$);
339 11 : list_append (struct_fields,"fp$ifd"$);
340 11 : modes[i] = "r";
341 22 : (parent_fds[i], child_fds[i]) = pipe (); i++;
342 : }
343 :
344 14 : variable pid = fork ();
345 14 : if (pid == 0)
346 : {
347 : variable e;
348 : try (e)
349 : {
350 4 : variable dir = qualifier ("dir");
351 4 : if (dir != NULL)
352 : {
353 1 : if (-1 == chdir (dir))
354 0 : throw OSError, "chdir: " + errno_string ();
355 : }
356 :
357 : % We do not need the parent descriptors, so close them.
358 4 : parent_fds = NULL;
359 4 : exec_child (argv, child_fds, child_ifds;; __qualifiers);
360 : }
361 : catch AnyError:
362 : {
363 1 : fd = child_fds[0];
364 1 : () = write (fd, sprintf ("%S:%S:%S\n", e.file, e.line, e.message));
365 1 : () = write (fd, sprintf ("Traceback:\n%S\n", e.traceback));
366 1 : fd = NULL;
367 : }
368 1 : variable exit_hook = qualifier("exit_hook");
369 1 : variable exit_hook_arg = qualifier ("exit_hook_arg");
370 2 : if (exit_hook != NULL) (@exit_hook)(argv, exit_hook_arg);
371 0 : _exit (1);
372 : }
373 10 : variable other_struct_fields = ["pid", "wait"];
374 10 : child_fds = NULL;
375 :
376 10 : if (length (struct_fields) == 0)
377 2 : struct_fields = String_Type[0];
378 : else
379 8 : struct_fields = list_to_array (struct_fields);
380 10 : variable s = @Struct_Type([struct_fields, other_struct_fields]);
381 :
382 10 : _for i (0, length (child_ifds)-1, 1)
383 : {
384 45 : ifd = child_ifds[i];
385 45 : fd = parent_fds[i+1]; % parent_fds[0] used for errors
386 45 : set_struct_field (s, "fd$ifd"$, fd);
387 45 : variable fp = fdopen (fd, modes[i+1]);
388 45 : if (fp == NULL)
389 0 : throw OpenError, "fdopen failed on child descriptor $ifd"$;
390 45 : set_struct_field (s, "fp$ifd"$, fp);
391 : }
392 10 : s.pid = pid;
393 10 : s.wait = &wait_method;
394 10 : variable errmsg = "";
395 : variable derrmsg;
396 18 : while (read (parent_fds[0], &derrmsg, 512) > 0)
397 : {
398 8 : errmsg += derrmsg;
399 : }
400 10 : if (errmsg != "")
401 2 : throw OSError, errmsg;
402 :
403 8 : return s;
404 : }
405 :
|
