1 /* -*- tab-width:4; -*- */
2 /*
3 * Process interface
4 */
5 #include "s.h"
6 #include <sys/types.h>
7 #include <sys/wait.h>
8 #include <sys/stat.h>
9 #include <unistd.h>
10 #include <fcntl.h>
11
12 /* define this to use execv. If USE_EXECV is not defined, we will use execvp */
13
14 static int use_execv = FALSE; /* TRUE=>execv, FALSE=>execvp */
15
16 int SOBJ_T_PROCESS; /* process type */
17
18 static SOBJ atom_pipe, atom_null;
19
20 /*E* process-list => LIST */
21 /*D* The list of processe created with make-process */
22 SOBJ scm_process_list; /* list of active processes */
23
24 /*NOTE: we need the process list so that we can note status of
25 processes that get waited */
26
27 typedef struct
28 {
29 int pid;
30 SOBJ port[3]; /* stdin stdout and stderr */
31 int status; /* status of process after exit */
32 int exited; /* TRUE when process has exited This
33 * flag is set only when process has
34 * been waited for */
35 } SCM_ProcessAux;
36
37 /* NOTE: if exited is not set when collecting, it's time to wait for next */
38
39 #define SCM_PROCESS(x) ((SCM_ProcessAux*)SCM_AUX(x))
40 #define SCM_PROCESSP(x) (SCM_OBJTYPE(x) == SOBJ_T_PROCESS)
41 #define SCM_PROCESS_SET SCM_AUX_SET
42
43 #define SCM_PROCESS_PID(x) (SCM_PROCESS(x)->pid)
44 #define SCM_PROCESS_PORT(x,i) (SCM_PROCESS(x)->port[i])
45
46
47 /* forward declaration for type descriptor functions */
48 static void scm_process_mark(SOBJ obj);
49 static void scm_process_sweep(SOBJ obj);
50 static void scm_process_print(SOBJ obj, PORT *p);
51 static void scm_process_write(SOBJ obj, PORT *p);
52
53
54 /****************************************************************
55 * Type descrptor entry
56 ****************************************************************/
57 SOBJ_TYPE_DESCR scm_process_type = {
58 0,
59 "process",
60 scm_process_mark, /* mark */
61 scm_process_sweep, /* sweep */
62 scm_process_print, /* print */
63 scm_process_write, /* write */
64 NULL, /* creconize */
65 NULL, /* cparse */
66 NULL, /* wreconize */
67 NULL, /* wparse */
68 NULL /* compare */
69 };
70
71 /****************************************************************
72 * Type functions
73 ****************************************************************/
proc_remove_by_pid(int pid)74 static SOBJ proc_remove_by_pid(int pid)
75 {
76 SOBJ l, last, proc;
77
78 last = NULL;
79 for (l = scm_process_list; l; l = SCM_CDR(l)) {
80 if (!SCM_PAIRP(l)) {
81 scm_process_list = NULL;
82 SCM_ERR("bad process-list: reseted", NULL);
83 }
84 proc = SCM_CAR(l);
85 if (SCM_PROCESS_PID(proc) == pid) {
86 if (last) { /* have a node to link */
87 SCM_CDR(last) = SCM_CDR(l);
88 } else { /* was first in the process_list */
89 scm_process_list = SCM_CDR(l);
90 }
91 return(proc);
92 }
93 last = l;
94 }
95 return(NULL);
96 }
97
scm_process_mark(SOBJ obj)98 static void scm_process_mark(SOBJ obj)
99 {
100 int i;
101
102 if (SCM_PROCESS(obj)->exited) {
103 fprintf(stderr, "process_mark: proc %d @%p terminated with status %d\n",
104 SCM_PROCESS_PID(obj), obj, SCM_PROCESS(obj)->status);
105 fprintf(stderr, "process_mark: closing ports\n");
106 for (i = 0; i < 3; i++) {
107 if (SCM_PROCESS_PORT(obj, i) != NULL) {
108 scm_close_port(SCM_PROCESS_PORT(obj, i));
109 SCM_PROCESS_PORT(obj, i) = NULL;
110 }
111 }
112 return;
113 }
114 for (i = 0; i < 3; i++) {
115 if (SCM_PROCESS_PORT(obj, i))
116 scm_gc_mark(SCM_PROCESS_PORT(obj, i));
117 }
118 }
119
scm_process_sweep(SOBJ obj)120 static void scm_process_sweep(SOBJ obj)
121 {
122 if (SCM_PROCESS(obj))
123 scm_free(SCM_PROCESS(obj));
124 }
125
scm_process_print(SOBJ obj,PORT * p)126 static void scm_process_print(SOBJ obj, PORT *p)
127 {
128 port_puts(p, "#<process>");
129 }
130
scm_process_write(SOBJ obj,PORT * p)131 static void scm_process_write(SOBJ obj, PORT *p)
132 {
133 port_puts(p, "#<process pid=");
134 port_putn(p, SCM_PROCESS_PID(obj));
135 port_puts(p, " in=");
136 scm_write_obj(SCM_PROCESS_PORT(obj, 0), p, 1);
137 port_puts(p, " out=");
138 scm_write_obj(SCM_PROCESS_PORT(obj, 1), p, 1);
139 port_puts(p, " err=");
140 scm_write_obj(SCM_PROCESS_PORT(obj, 2), p, 1);
141 port_puts(p, " status=");
142 scm_putn(SCM_PROCESS(obj)->status);
143 port_puts(p, " exited=");
144 scm_putn(SCM_PROCESS(obj)->exited);
145 port_putc(p, '>');
146 }
147
148 /****************************************************************
149 * Helper functions
150 ****************************************************************/
151
scm_process_alloc()152 static SOBJ scm_process_alloc()
153 {
154 int i;
155 SOBJ new = scm_newcell(SOBJ_T_PROCESS);
156
157 /*SCM_PROCESS_SET(new) = scm_must_alloc(sizeof(SCM_ProcessAux));*/
158 SCM_PROCESS_SET(new, scm_must_alloc(sizeof(SCM_ProcessAux)));
159 SCM_PROCESS_PID(new) = 0;
160 for (i = 0; i < 3; i++)
161 SCM_PROCESS_PORT(new, i) = NULL;
162 SCM_PROCESS(new)->status = -1;
163 SCM_PROCESS(new)->exited = 0;
164 return (new);
165 }
166
scm_process_add()167 static SOBJ scm_process_add()
168 {
169 SOBJ new = scm_process_alloc();
170
171 scm_process_list = scm_cons(new, scm_process_list);
172 return (new);
173 }
174
175 #ifdef OLD
scm_process_remove(SOBJ obj)176 static SOBJ scm_process_remove(SOBJ obj)
177 {
178 SOBJ before, l;
179
180 before = NULL;
181 for (l = scm_process_list; l; l = SCM_CDR(l)) {
182 if (SCM_CAR(l) == obj)
183 break;
184 before = l;
185 }
186 if (l == NULL)
187 SCM_ERR("process-remove: process not found", obj);
188
189 if (before) { /* middle of list */
190 SCM_CDR(before) = SCM_CDR(l); /* jump over current */
191 } else { /* first of list */
192 scm_process_list = SCM_CDR(l);
193 }
194 return (obj);
195 }
196 #endif
197
198 /****************************************************************
199 * public functions
200 ****************************************************************/
201
202 /*E* (process? OBJ) => BOOLEAN */
203 /*D* Returns #t if OBJ is a process, #f otherwise. */
scm_processp(SOBJ obj)204 SOBJ scm_processp(SOBJ obj)
205 {
206 return (SCM_TYPEP(obj, SOBJ_T_PROCESS) ? scm_true : scm_false);
207 }
208
209 /*E* (process-pid PROCESS) => PID */
210 /*D* Returns the PID of the process PROCESS */
scm_process_pid(SOBJ obj)211 SOBJ scm_process_pid(SOBJ obj)
212 {
213 if (!SCM_PROCESSP(obj))
214 SCM_ERR("process-id: bad process", obj);
215 return (SCM_MKINUM(SCM_PROCESS_PID(obj)));
216 }
217
218 /*E* (process-input PROCESS) => PORT */
219 /*D* Returns the process input port */
scm_process_input(SOBJ obj)220 SOBJ scm_process_input(SOBJ obj)
221 {
222 if (!SCM_PROCESSP(obj))
223 SCM_ERR("process-input: bad process", obj);
224 return (SCM_PROCESS_PORT(obj, 0));
225 }
226
227 /*E* (process-output PROCESS) => PORT */
228 /*D* Returns the process output port */
scm_process_output(SOBJ obj)229 SOBJ scm_process_output(SOBJ obj)
230 {
231 if (!SCM_PROCESSP(obj))
232 SCM_ERR("process-output: bad process", obj);
233 return (SCM_PROCESS_PORT(obj, 1));
234 }
235
236 /*E* (process-error PROCESS) => PORT */
237 /*D* return the process error port */
scm_process_error(SOBJ obj)238 SOBJ scm_process_error(SOBJ obj)
239 {
240 if (!SCM_PROCESSP(obj))
241 SCM_ERR("process-error: bad process", obj);
242 return (SCM_PROCESS_PORT(obj, 2));
243 }
244
245 /*E* (process-status PROCESS) => STATUS */
246 /*D* Returns the process status of the process PROCESS. */
scm_process_status(SOBJ obj)247 SOBJ scm_process_status(SOBJ obj)
248 {
249 if (!SCM_PROCESSP(obj))
250 SCM_ERR("process-error: bad process", obj);
251 return (SCM_MKINUM(SCM_PROCESS(obj)->status));
252 }
253
254 /* IN OUT ERR possible values:
255 * :null | '() : not opened
256 * :pipe | "-" : open to pipe
257 * STR : open to file
258 * NUM : redirect to same descriptor
259 *
260 * (make-process :null :pipe 1 "ls" "-al")
261 * (make-process :null "/tmp/ake" 1 "ls -al")
262 *
263 */
264 enum IO_TYPE
265 {
266 IO_T_NULL = 0,
267 IO_T_PIPE, /* pipe */
268 IO_T_FILE, /* redir to file */
269 IO_T_PORT, /* redir to open port */
270 IO_T_REDIR, /* redir to another descriptor */
271 IO_T_MAX
272 };
273
get_io_type(SOBJ obj,int enable_redir)274 static int get_io_type(SOBJ obj, int enable_redir)
275 {
276 switch (SCM_OBJTYPE(obj)) {
277 case SOBJ_T_KEYWORD:
278 if (SCM_KEYW_NAME(obj) == atom_pipe)
279 return (IO_T_PIPE);
280 if (SCM_KEYW_NAME(obj) == atom_null)
281 return (IO_T_NULL);
282 break;
283
284 case SOBJ_T_STRING:
285 return (IO_T_FILE);
286 case SOBJ_T_PORT:
287 return (IO_T_PORT);
288 case SOBJ_T_INUM:
289 if (enable_redir)
290 return (IO_T_REDIR);
291 break;
292 }
293 SCM_ERR("make-process: bad io type", obj);
294 return (-1);
295 }
296
297 /*-- output an error message after the fork and exit with status 111 */
child_err(char * msg)298 static void child_err(char *msg)
299 {
300 static char head[] = "make-process child: ";
301 static char tail[] = ", dying\n";
302
303 write(2, head, strlen(head));
304 write(2, msg, strlen(msg));
305 write(2, tail, strlen(tail));
306 exit(111);
307 }
308
309 /*E* (make-process IN OUT ERR [ARG...|LIST|ARRAY]) => PROCESS */
310 /*D* Create a new process. IN, OUT or ERR indicates the type of port
311 to open for the new process. :null or '() means that no file is
312 opened, :pipe or "-" means open to a pipe, a string means open to a
313 file, NUMBER means redirect to descriptor. */
314 /*X* (make-process :null :pipe 1 "ls" "-al") */
315
scm_make_process(int argc,SOBJ * arg)316 SOBJ scm_make_process(int argc, SOBJ *arg)
317 {
318 SOBJ proc, arg_array;
319 static int io_rd[3] = { TRUE, FALSE, FALSE };
320 int io_type[3], pfd[3][2];
321 int i, pid;
322
323 if (argc < 4)
324 SCM_ERR("make-process: not enough arguments", SCM_MKINUM(argc));
325
326 io_type[0] = get_io_type(arg[0], FALSE);
327 io_type[1] = get_io_type(arg[1], TRUE);
328 io_type[2] = get_io_type(arg[2], TRUE);
329
330 if (SCM_STRINGP(arg[3])) {
331 for (i = 3; i < argc; i++) {
332 if (!SCM_STRINGP(arg[i]))
333 SCM_ERR("make-process: bad arg type", arg[i]);
334 }
335 } else if (!SCM_ARRAYP(arg[3]) && !SCM_PAIRP(arg[3])) {
336 SCM_ERR("make-process: bad arg type", arg[3]);
337 }
338
339 for (i = 0; i < 3; i++) {
340 switch (io_type[i]) {
341 case IO_T_NULL:
342 pfd[i][0] = -1;
343 pfd[i][1] = -1;
344 break;
345
346 case IO_T_PIPE:
347 if (pipe(pfd[i]) != 0)
348 SCM_ERR("make-process: cannot create pipe for io ", SCM_MKINUM(i));
349 break;
350
351 case IO_T_FILE:
352 {
353 int flags;
354
355 if (io_rd[i]) { /* read */
356 flags = O_RDONLY;
357 } else { /* write */
358 flags = O_WRONLY | O_CREAT | O_TRUNC;
359 }
360 pfd[i][0] = open(SCM_STR_VALUE(arg[i]), flags, 0666);
361 if (pfd[i][0] < 0)
362 SCM_ERR("make-process: cannot redirect from file", arg[i]);
363 }
364 break;
365
366 case IO_T_PORT:
367 case IO_T_REDIR:
368 default:
369 SCM_ERR("make-process: illegal io_type", NULL);
370 }
371 }
372
373 if ((pid = fork()) == -1)
374 SCM_ERR("make-process: fork failed", NULL);
375 if (pid == 0) { /* child process */
376 for (i = 0; i < 3; i++) {
377 switch (io_type[i]) {
378 case IO_T_NULL:
379 break;
380 case IO_T_PIPE:
381 if (close(i) != 0)
382 child_err("close failed");
383 if (dup(pfd[i][io_rd[i] ? 0 : 1]) != i)
384 child_err("dup failed");
385 if (close(pfd[i][0]) != 0 || close(pfd[i][1]) != 0)
386 child_err("pipe close failed");
387 break;
388 case IO_T_FILE:
389 if (close(i) != 0)
390 child_err("close failed");
391 if (dup(pfd[i][0]) != i)
392 child_err("dup failed");
393 if (close(pfd[i][0]) != 0)
394 child_err("file close failed");
395 break;
396
397 case IO_T_PORT:
398 case IO_T_REDIR:
399 default:
400 SCM_ERR("make-process: io type not supported", SCM_MKINUM(io_type[i]));
401 }
402 }
403
404 if (SCM_STRINGP(arg[3])) { /* inlined list of string */
405 /* reuse the arg[] to put string for the exec */
406 for (i = 3; i < argc; i++)
407 arg[i - 3] = (void *) SCM_STR_VALUE(arg[i]);
408 arg[i - 3] = NULL;
409 if (use_execv) {
410 execv((void *) arg[0], (char **) arg);
411 } else {
412 execvp((void *) arg[0], (char **) arg);
413 }
414 child_err("exec failed");
415 }
416
417 if (SCM_PAIRP(arg[3])) {
418 arg_array = scm_list_to_vector(arg[3]);
419 } else { /* !list ==> array, we checked this before! */
420 arg_array = arg[3];
421 }
422 scm_vector_append(arg_array, NULL);
423 for (i = 0; i < (SCM_ASIZE(arg_array) - 1); i++) {
424 if (!SCM_STRINGP(SCM_AREF(arg_array, i)))
425 child_err("not a string arg");
426 SCM_AREF(arg_array, i) = (void *) SCM_STR_VALUE(SCM_AREF(arg_array, i));
427 }
428 if (use_execv) {
429 execv((void *) SCM_AREF(arg_array, 0), (char **) SCM_ARRAY(arg_array));
430 } else {
431 execvp((void *) SCM_AREF(arg_array, 0), (char **) SCM_ARRAY(arg_array));
432 }
433 child_err("exec failed");
434 }
435
436 /* parent process */
437 proc = scm_process_add();
438 SCM_PROCESS_PID(proc) = pid;
439
440 for (i = 0; i < 3; i++) {
441 switch (io_type[i]) {
442 case IO_T_NULL:
443 break;
444 case IO_T_PIPE:
445 if (close(pfd[i][io_rd[i] ? 0 : 1]) != 0)
446 SCM_ERR("make-process: close pipe", NULL);
447
448 SCM_PROCESS_PORT(proc, i) =
449 scm_mk_fn_port(pfd[i][io_rd[i] ? 1 : 0], !io_rd[i]);
450 break;
451
452 case IO_T_FILE:
453 if (close(pfd[i][0]) != 0)
454 SCM_ERR("make-process: close file failed", NULL);
455
456 break;
457
458 case IO_T_PORT:
459 case IO_T_REDIR:
460 default:
461 SCM_ERR("make-process: bad io type", SCM_MKINUM(io_type[i]));
462 }
463 }
464 return (proc);
465 }
466
467 /*E* (process-wait PROC) => STATUS */
468 /*D* Wait for process to terminate and return the exit code of the
469 process. */
470
scm_process_wait(SOBJ proc)471 SOBJ scm_process_wait(SOBJ proc)
472 {
473 int status, result, pid;
474
475 if (!SCM_PROCESSP(proc) && proc != scm_true)
476 SCM_ERR("process-wait: bad process", proc);
477
478 if (scm_process_list == NULL)
479 SCM_ERR("process-wait: process list is empty", scm_process_list);
480
481 if (SCM_PROCESSP(proc)) { /* process is specified */
482 pid = SCM_PROCESS_PID(proc);
483 if (SCM_PROCESS(proc)->exited) return (scm_false);
484 } else { /* wait for any process */
485 pid = -1;
486 }
487 result = waitpid(pid, &status, 0);
488 if (result == -1) return(scm_false);
489 proc = proc_remove_by_pid(result);
490 if (proc) {
491 SCM_PROCESS(proc)->status = status;
492 SCM_PROCESS(proc)->exited = TRUE;
493 }
494 return (SCM_MKINUM(status));
495 }
496
497 /*E* (process-use-execv FLAG) => OLD */
498 /*D* Determine if next make-process will use execv() or execvp(). If
499 FLAG is #t, execv() will be used. Returns the previous mode */
scm_process_use_execv(SOBJ flag)500 SOBJ scm_process_use_execv(SOBJ flag)
501 {
502 SOBJ ret = SCM_MKBOOL(use_execv);
503
504 use_execv = (flag != scm_false) ? TRUE : FALSE;
505 return (ret);
506 }
507
scm_init_process()508 void scm_init_process()
509 {
510 SOBJ_T_PROCESS = scm_add_type(&scm_process_type);
511
512 atom_pipe = scm_mkatom("pipe");
513 atom_null = scm_mkatom("null");
514
515 scm_add_cvar("process-list", &scm_process_list);
516
517 scm_add_cprim("process?", scm_processp, 1);
518 scm_add_cprim("process-pid", scm_process_pid, 1);
519 scm_add_cprim("process-input", scm_process_input, 1);
520 scm_add_cprim("process-output", scm_process_output, 1);
521 scm_add_cprim("process-error", scm_process_error, 1);
522 scm_add_cprim("process-status", scm_process_status, 1);
523
524 scm_add_cprim("make-process", scm_make_process, -1);
525 scm_add_cprim("process-wait", scm_process_wait, 1);
526 scm_add_cprim("process-use-execv",scm_process_use_execv, 1);
527 }
528