Fix Savannah bug # 13478. If -L is given, take the latest mtime for a
[make/kirr.git] / vmsjobs.c
blob0f658fe9ed3f442f77e540967182be8be243c2fb
1 \f
3 /* --------------- Moved here from job.c ---------------
4 This file must be #included in job.c, as it accesses static functions.
5 */
7 #include <string.h>
8 #include <descrip.h>
9 #include <clidef.h>
11 extern char *vmsify PARAMS ((char *name, int type));
13 static int vms_jobsefnmask = 0;
15 /* Wait for nchildren children to terminate */
16 static void
17 vmsWaitForChildren(int *status)
19 while (1)
21 if (!vms_jobsefnmask)
23 *status = 0;
24 return;
27 *status = sys$wflor (32, vms_jobsefnmask);
29 return;
32 /* Set up IO redirection. */
34 char *
35 vms_redirect (struct dsc$descriptor_s *desc, char *fname, char *ibuf)
37 char *fptr;
39 ibuf++;
40 while (isspace ((unsigned char)*ibuf))
41 ibuf++;
42 fptr = ibuf;
43 while (*ibuf && !isspace ((unsigned char)*ibuf))
44 ibuf++;
45 *ibuf = 0;
46 if (strcmp (fptr, "/dev/null") != 0)
48 strcpy (fname, vmsify (fptr, 0));
49 if (strchr (fname, '.') == 0)
50 strcat (fname, ".");
52 desc->dsc$w_length = strlen(fname);
53 desc->dsc$a_pointer = fname;
54 desc->dsc$b_dtype = DSC$K_DTYPE_T;
55 desc->dsc$b_class = DSC$K_CLASS_S;
57 if (*fname == 0)
58 printf (_("Warning: Empty redirection\n"));
59 return ibuf;
63 /* found apostrophe at (p-1)
64 inc p until after closing apostrophe.
67 char *
68 vms_handle_apos (char *p)
70 int alast;
72 #define SEPCHARS ",/()= "
74 alast = 0;
76 while (*p != 0)
78 if (*p == '"')
80 if (alast)
82 alast = 0;
83 p++;
85 else
87 p++;
88 if (strchr (SEPCHARS, *p))
89 break;
90 alast = 1;
93 else
94 p++;
97 return p;
100 /* This is called as an AST when a child process dies (it won't get
101 interrupted by anything except a higher level AST).
104 vmsHandleChildTerm(struct child *child)
106 int status;
107 register struct child *lastc, *c;
108 int child_failed;
110 vms_jobsefnmask &= ~(1 << (child->efn - 32));
112 lib$free_ef(&child->efn);
114 (void) sigblock (fatal_signal_mask);
116 child_failed = !(child->cstatus & 1 || ((child->cstatus & 7) == 0));
118 /* Search for a child matching the deceased one. */
119 lastc = 0;
120 #if defined(RECURSIVEJOBS) /* I've had problems with recursive stuff and process handling */
121 for (c = children; c != 0 && c != child; lastc = c, c = c->next)
123 #else
124 c = child;
125 #endif
127 if (child_failed && !c->noerror && !ignore_errors_flag)
129 /* The commands failed. Write an error message,
130 delete non-precious targets, and abort. */
131 child_error (c->file->name, c->cstatus, 0, 0, 0);
132 c->file->update_status = 1;
133 delete_child_targets (c);
135 else
137 if (child_failed)
139 /* The commands failed, but we don't care. */
140 child_error (c->file->name, c->cstatus, 0, 0, 1);
141 child_failed = 0;
144 #if defined(RECURSIVEJOBS) /* I've had problems with recursive stuff and process handling */
145 /* If there are more commands to run, try to start them. */
146 start_job (c);
148 switch (c->file->command_state)
150 case cs_running:
151 /* Successfully started. */
152 break;
154 case cs_finished:
155 if (c->file->update_status != 0) {
156 /* We failed to start the commands. */
157 delete_child_targets (c);
159 break;
161 default:
162 error (NILF, _("internal error: `%s' command_state"),
163 c->file->name);
164 abort ();
165 break;
167 #endif /* RECURSIVEJOBS */
170 /* Set the state flag to say the commands have finished. */
171 c->file->command_state = cs_finished;
172 notice_finished_file (c->file);
174 #if defined(RECURSIVEJOBS) /* I've had problems with recursive stuff and process handling */
175 /* Remove the child from the chain and free it. */
176 if (lastc == 0)
177 children = c->next;
178 else
179 lastc->next = c->next;
180 free_child (c);
181 #endif /* RECURSIVEJOBS */
183 /* There is now another slot open. */
184 if (job_slots_used > 0)
185 --job_slots_used;
187 /* If the job failed, and the -k flag was not given, die. */
188 if (child_failed && !keep_going_flag)
189 die (EXIT_FAILURE);
191 (void) sigsetmask (sigblock (0) & ~(fatal_signal_mask));
193 return 1;
196 /* VMS:
197 Spawn a process executing the command in ARGV and return its pid. */
199 #define MAXCMDLEN 200
201 /* local helpers to make ctrl+c and ctrl+y working, see below */
202 #include <iodef.h>
203 #include <libclidef.h>
204 #include <ssdef.h>
206 static int ctrlMask= LIB$M_CLI_CTRLY;
207 static int oldCtrlMask;
208 static int setupYAstTried= 0;
209 static int pidToAbort= 0;
210 static int chan= 0;
212 static void
213 reEnableAst(void)
215 lib$enable_ctrl (&oldCtrlMask,0);
218 static void
219 astHandler (void)
221 if (pidToAbort) {
222 sys$forcex (&pidToAbort, 0, SS$_ABORT);
223 pidToAbort= 0;
225 kill (getpid(),SIGQUIT);
228 static void
229 tryToSetupYAst(void)
231 $DESCRIPTOR(inputDsc,"SYS$COMMAND");
232 int status;
233 struct {
234 short int status, count;
235 int dvi;
236 } iosb;
238 setupYAstTried++;
240 if (!chan) {
241 status= sys$assign(&inputDsc,&chan,0,0);
242 if (!(status&SS$_NORMAL)) {
243 lib$signal(status);
244 return;
247 status= sys$qiow (0, chan, IO$_SETMODE|IO$M_CTRLYAST,&iosb,0,0,
248 astHandler,0,0,0,0,0);
249 if (status==SS$_NORMAL)
250 status= iosb.status;
251 if (status==SS$_ILLIOFUNC || status==SS$_NOPRIV) {
252 sys$dassgn(chan);
253 #ifdef CTRLY_ENABLED_ANYWAY
254 fprintf (stderr,
255 _("-warning, CTRL-Y will leave sub-process(es) around.\n"));
256 #else
257 return;
258 #endif
260 else if (!(status&SS$_NORMAL)) {
261 sys$dassgn(chan);
262 lib$signal(status);
263 return;
266 /* called from AST handler ? */
267 if (setupYAstTried>1)
268 return;
269 if (atexit(reEnableAst))
270 fprintf (stderr,
271 _("-warning, you may have to re-enable CTRL-Y handling from DCL.\n"));
272 status= lib$disable_ctrl (&ctrlMask, &oldCtrlMask);
273 if (!(status&SS$_NORMAL)) {
274 lib$signal(status);
275 return;
280 child_execute_job (char *argv, struct child *child)
282 int i;
283 static struct dsc$descriptor_s cmddsc;
284 static struct dsc$descriptor_s pnamedsc;
285 static struct dsc$descriptor_s ifiledsc;
286 static struct dsc$descriptor_s ofiledsc;
287 static struct dsc$descriptor_s efiledsc;
288 int have_redirection = 0;
289 int have_newline = 0;
291 int spflags = CLI$M_NOWAIT;
292 int status;
293 char *cmd = alloca (strlen (argv) + 512), *p, *q;
294 char ifile[256], ofile[256], efile[256];
295 char *comname = 0;
296 char procname[100];
297 int in_string;
299 /* Parse IO redirection. */
301 ifile[0] = 0;
302 ofile[0] = 0;
303 efile[0] = 0;
305 DB (DB_JOBS, ("child_execute_job (%s)\n", argv));
307 while (isspace ((unsigned char)*argv))
308 argv++;
310 if (*argv == 0)
311 return 0;
313 sprintf (procname, "GMAKE_%05x", getpid () & 0xfffff);
314 pnamedsc.dsc$w_length = strlen(procname);
315 pnamedsc.dsc$a_pointer = procname;
316 pnamedsc.dsc$b_dtype = DSC$K_DTYPE_T;
317 pnamedsc.dsc$b_class = DSC$K_CLASS_S;
319 in_string = 0;
320 /* Handle comments and redirection. */
321 for (p = argv, q = cmd; *p; p++, q++)
323 if (*p == '"')
324 in_string = !in_string;
325 if (in_string)
327 *q = *p;
328 continue;
330 switch (*p)
332 case '#':
333 *p-- = 0;
334 *q-- = 0;
335 break;
336 case '\\':
337 p++;
338 if (*p == '\n')
339 p++;
340 if (isspace ((unsigned char)*p))
342 do { p++; } while (isspace ((unsigned char)*p));
343 p--;
345 *q = *p;
346 break;
347 case '<':
348 p = vms_redirect (&ifiledsc, ifile, p);
349 *q = ' ';
350 have_redirection = 1;
351 break;
352 case '>':
353 have_redirection = 1;
354 if (*(p-1) == '2')
356 q--;
357 if (strncmp (p, ">&1", 3) == 0)
359 p += 3;
360 strcpy (efile, "sys$output");
361 efiledsc.dsc$w_length = strlen(efile);
362 efiledsc.dsc$a_pointer = efile;
363 efiledsc.dsc$b_dtype = DSC$K_DTYPE_T;
364 efiledsc.dsc$b_class = DSC$K_CLASS_S;
366 else
368 p = vms_redirect (&efiledsc, efile, p);
371 else
373 p = vms_redirect (&ofiledsc, ofile, p);
375 *q = ' ';
376 break;
377 case '\n':
378 have_newline = 1;
379 default:
380 *q = *p;
381 break;
384 *q = *p;
385 while (isspace ((unsigned char)*--q))
386 *q = '\0';
388 if (strncmp (cmd, "builtin_", 8) == 0)
390 child->pid = 270163;
391 child->efn = 0;
392 child->cstatus = 1;
394 DB (DB_JOBS, (_("BUILTIN [%s][%s]\n"), cmd, cmd+8));
396 p = cmd + 8;
398 if ((*(p) == 'c')
399 && (*(p+1) == 'd')
400 && ((*(p+2) == ' ') || (*(p+2) == '\t')))
402 p += 3;
403 while ((*p == ' ') || (*p == '\t'))
404 p++;
405 DB (DB_JOBS, (_("BUILTIN CD %s\n"), p));
406 if (chdir (p))
407 return 0;
408 else
409 return 1;
411 else if ((*(p) == 'r')
412 && (*(p+1) == 'm')
413 && ((*(p+2) == ' ') || (*(p+2) == '\t')))
415 int in_arg;
417 /* rm */
418 p += 3;
419 while ((*p == ' ') || (*p == '\t'))
420 p++;
421 in_arg = 1;
423 DB (DB_JOBS, (_("BUILTIN RM %s\n"), p));
424 while (*p)
426 switch (*p)
428 case ' ':
429 case '\t':
430 if (in_arg)
432 *p++ = ';';
433 in_arg = 0;
435 break;
436 default:
437 break;
439 p++;
442 else
444 printf(_("Unknown builtin command '%s'\n"), cmd);
445 fflush(stdout);
446 return 0;
450 /* Create a *.com file if either the command is too long for
451 lib$spawn, or the command contains a newline, or if redirection
452 is desired. Forcing commands with newlines into DCLs allows to
453 store search lists on user mode logicals. */
455 if (strlen (cmd) > MAXCMDLEN
456 || (have_redirection != 0)
457 || (have_newline != 0))
459 FILE *outfile;
460 char c;
461 char *sep;
462 int alevel = 0; /* apostrophe level */
464 if (strlen (cmd) == 0)
466 printf (_("Error, empty command\n"));
467 fflush (stdout);
468 return 0;
471 outfile = open_tmpfile (&comname, "sys$scratch:CMDXXXXXX.COM");
472 if (outfile == 0)
473 pfatal_with_name (_("fopen (temporary file)"));
475 if (ifile[0])
477 fprintf (outfile, "$ assign/user %s sys$input\n", ifile);
478 DB (DB_JOBS, (_("Redirected input from %s\n"), ifile));
479 ifiledsc.dsc$w_length = 0;
482 if (efile[0])
484 fprintf (outfile, "$ define sys$error %s\n", efile);
485 DB (DB_JOBS, (_("Redirected error to %s\n"), efile));
486 efiledsc.dsc$w_length = 0;
489 if (ofile[0])
491 fprintf (outfile, "$ define sys$output %s\n", ofile);
492 DB (DB_JOBS, (_("Redirected output to %s\n"), ofile));
493 ofiledsc.dsc$w_length = 0;
496 p = sep = q = cmd;
497 for (c = '\n'; c; c = *q++)
499 switch (c)
501 case '\n':
502 /* At a newline, skip any whitespace around a leading $
503 from the command and issue exactly one $ into the DCL. */
504 while (isspace ((unsigned char)*p))
505 p++;
506 if (*p == '$')
507 p++;
508 while (isspace ((unsigned char)*p))
509 p++;
510 fwrite (p, 1, q - p, outfile);
511 fputc ('$', outfile);
512 fputc (' ', outfile);
513 /* Reset variables. */
514 p = sep = q;
515 break;
517 /* Nice places for line breaks are after strings, after
518 comma or space and before slash. */
519 case '"':
520 q = vms_handle_apos (q);
521 sep = q;
522 break;
523 case ',':
524 case ' ':
525 sep = q;
526 break;
527 case '/':
528 case '\0':
529 sep = q - 1;
530 break;
531 default:
532 break;
534 if (sep - p > 78)
536 /* Enough stuff for a line. */
537 fwrite (p, 1, sep - p, outfile);
538 p = sep;
539 if (*sep)
541 /* The command continues. */
542 fputc ('-', outfile);
544 fputc ('\n', outfile);
548 fwrite (p, 1, q - p, outfile);
549 fputc ('\n', outfile);
551 fclose (outfile);
553 sprintf (cmd, "$ @%s", comname);
555 DB (DB_JOBS, (_("Executing %s instead\n"), cmd));
558 cmddsc.dsc$w_length = strlen(cmd);
559 cmddsc.dsc$a_pointer = cmd;
560 cmddsc.dsc$b_dtype = DSC$K_DTYPE_T;
561 cmddsc.dsc$b_class = DSC$K_CLASS_S;
563 child->efn = 0;
564 while (child->efn < 32 || child->efn > 63)
566 status = lib$get_ef ((unsigned long *)&child->efn);
567 if (!(status & 1))
568 return 0;
571 sys$clref (child->efn);
573 vms_jobsefnmask |= (1 << (child->efn - 32));
576 LIB$SPAWN [command-string]
577 [,input-file]
578 [,output-file]
579 [,flags]
580 [,process-name]
581 [,process-id] [,completion-status-address] [,byte-integer-event-flag-num]
582 [,AST-address] [,varying-AST-argument]
583 [,prompt-string] [,cli] [,table]
586 #ifndef DONTWAITFORCHILD
588 * Code to make ctrl+c and ctrl+y working.
589 * The problem starts with the synchronous case where after lib$spawn is
590 * called any input will go to the child. But with input re-directed,
591 * both control characters won't make it to any of the programs, neither
592 * the spawning nor to the spawned one. Hence the caller needs to spawn
593 * with CLI$M_NOWAIT to NOT give up the input focus. A sys$waitfr
594 * has to follow to simulate the wanted synchronous behaviour.
595 * The next problem is ctrl+y which isn't caught by the crtl and
596 * therefore isn't converted to SIGQUIT (for a signal handler which is
597 * already established). The only way to catch ctrl+y, is an AST
598 * assigned to the input channel. But ctrl+y handling of DCL needs to be
599 * disabled, otherwise it will handle it. Not to mention the previous
600 * ctrl+y handling of DCL needs to be re-established before make exits.
601 * One more: At the time of LIB$SPAWN signals are blocked. SIGQUIT will
602 * make it to the signal handler after the child "normally" terminates.
603 * This isn't enough. It seems reasonable for simple command lines like
604 * a 'cc foobar.c' spawned in a subprocess but it is unacceptable for
605 * spawning make. Therefore we need to abort the process in the AST.
607 * Prior to the spawn it is checked if an AST is already set up for
608 * ctrl+y, if not one is set up for a channel to SYS$COMMAND. In general
609 * this will work except if make is run in a batch environment, but there
610 * nobody can press ctrl+y. During the setup the DCL handling of ctrl+y
611 * is disabled and an exit handler is established to re-enable it.
612 * If the user interrupts with ctrl+y, the assigned AST will fire, force
613 * an abort to the subprocess and signal SIGQUIT, which will be caught by
614 * the already established handler and will bring us back to common code.
615 * After the spawn (now /nowait) a sys$waitfr simulates the /wait and
616 * enables the ctrl+y be delivered to this code. And the ctrl+c too,
617 * which the crtl converts to SIGINT and which is caught by the common
618 * signal handler. Because signals were blocked before entering this code
619 * sys$waitfr will always complete and the SIGQUIT will be processed after
620 * it (after termination of the current block, somewhere in common code).
621 * And SIGINT too will be delayed. That is ctrl+c can only abort when the
622 * current command completes. Anyway it's better than nothing :-)
625 if (!setupYAstTried)
626 tryToSetupYAst();
627 status = lib$spawn (&cmddsc, /* cmd-string */
628 (ifiledsc.dsc$w_length == 0)?0:&ifiledsc, /* input-file */
629 (ofiledsc.dsc$w_length == 0)?0:&ofiledsc, /* output-file */
630 &spflags, /* flags */
631 &pnamedsc, /* proc name */
632 &child->pid, &child->cstatus, &child->efn,
633 0, 0,
634 0, 0, 0);
635 if (status & 1)
637 pidToAbort= child->pid;
638 status= sys$waitfr (child->efn);
639 pidToAbort= 0;
640 vmsHandleChildTerm(child);
642 #else
643 status = lib$spawn (&cmddsc,
644 (ifiledsc.dsc$w_length == 0)?0:&ifiledsc,
645 (ofiledsc.dsc$w_length == 0)?0:&ofiledsc,
646 &spflags,
647 &pnamedsc,
648 &child->pid, &child->cstatus, &child->efn,
649 vmsHandleChildTerm, child,
650 0, 0, 0);
651 #endif
653 if (!(status & 1))
655 printf (_("Error spawning, %d\n") ,status);
656 fflush (stdout);
657 switch (status)
659 case 0x1c:
660 errno = EPROCLIM;
661 break;
662 default:
663 errno = EFAIL;
667 if (comname && !ISDB (DB_JOBS))
668 unlink (comname);
670 return (status & 1);