vmsjobs.c

   1 /* --------------- Moved here from job.c ---------------
   2    This file must be #included in job.c, as it accesses static functions.
   3
   4 Copyright (C) 1996-2013 Free Software Foundation, Inc.
   5 This file is part of GNU Make.
   6
   7 GNU Make is free software; you can redistribute it and/or modify it under the
   8 terms of the GNU General Public License as published by the Free Software
   9 Foundation; either version 3 of the License, or (at your option) any later
  10 version.
  11
  12 GNU Make is distributed in the hope that it will be useful, but WITHOUT ANY
  13 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License along with
  17 this program.  If not, see <http://www.gnu.org/licenses/>.  */
  18
  19 #include <string.h>
  20 #include <descrip.h>
  21 #include <clidef.h>
  22
  23 char *vmsify (char *name, int type);
  24
  25 static int vms_jobsefnmask = 0;
  26
  27 /* Wait for nchildren children to terminate */
  28 static void
  29 vmsWaitForChildren(int *status)
  30 {
  31   while (1)
  32     {
  33       if (!vms_jobsefnmask)
  34         {
  35           *status = 0;
  36           return;
  37         }
  38
  39       *status = sys$wflor (32, vms_jobsefnmask);
  40     }
  41   return;
  42 }
  43
  44 /* Set up IO redirection.  */
  45
  46 char *
  47 vms_redirect (struct dsc$descriptor_s *desc, char *fname, char *ibuf)
  48 {
  49   char *fptr;
  50
  51   ibuf++;
  52   while (isspace ((unsigned char)*ibuf))
  53     ibuf++;
  54   fptr = ibuf;
  55   while (*ibuf && !isspace ((unsigned char)*ibuf))
  56     ibuf++;
  57   *ibuf = 0;
  58   if (strcmp (fptr, "/dev/null") != 0)
  59     {
  60       strcpy (fname, vmsify (fptr, 0));
  61       if (strchr (fname, '.') == 0)
  62         strcat (fname, ".");
  63     }
  64   desc->dsc$w_length = strlen (fname);
  65   desc->dsc$a_pointer = fname;
  66   desc->dsc$b_dtype = DSC$K_DTYPE_T;
  67   desc->dsc$b_class = DSC$K_CLASS_S;
  68
  69   if (*fname == 0)
  70     printf (_("Warning: Empty redirection\n"));
  71   return ibuf;
  72 }
  73
  74
  75 /* found apostrophe at (p-1)
  76    inc p until after closing apostrophe.
  77 */
  78
  79 char *
  80 vms_handle_apos (char *p)
  81 {
  82   int alast;
  83
  84 #define SEPCHARS ",/()= "
  85
  86   alast = 0;
  87
  88   while (*p != 0)
  89     if (*p == '"')
  90       if (alast)
  91         {
  92           alast = 0;
  93           p++;
  94         }
  95       else
  96         {
  97           p++;
  98           if (strchr (SEPCHARS, *p))
  99             break;
 100           alast = 1;
 101         }
 102     else
 103       p++;
 104
 105   return p;
 106 }
 107
 108 static int ctrlYPressed= 0;
 109 /* This is called at main or AST level. It is at AST level for DONTWAITFORCHILD
 110    and at main level otherwise. In any case it is called when a child process
 111    terminated. At AST level it won't get interrupted by anything except a
 112    inner mode level AST.
 113 */
 114 int
 115 vmsHandleChildTerm(struct child *child)
 116 {
 117   int status;
 118   register struct child *lastc, *c;
 119   int child_failed;
 120
 121   vms_jobsefnmask &= ~(1 << (child->efn - 32));
 122
 123   lib$free_ef (&child->efn);
 124   if (child->comname)
 125     {
 126       if (!ISDB (DB_JOBS) && !ctrlYPressed)
 127         unlink (child->comname);
 128       free (child->comname);
 129     }
 130
 131   (void) sigblock (fatal_signal_mask);
 132
 133   child_failed = !(child->cstatus & 1 || ((child->cstatus & 7) == 0));
 134
 135   /* Search for a child matching the deceased one.  */
 136   lastc = 0;
 137 #if defined(RECURSIVEJOBS) /* I've had problems with recursive stuff and process handling */
 138   for (c = children; c != 0 && c != child; lastc = c, c = c->next)
 139     ;
 140 #else
 141   c = child;
 142 #endif
 143
 144   if (child_failed && !c->noerror && !ignore_errors_flag)
 145     {
 146       /* The commands failed.  Write an error message,
 147          delete non-precious targets, and abort.  */
 148       child_error (c, c->cstatus, 0, 0, 0);
 149       c->file->update_status = us_failed;
 150       delete_child_targets (c);
 151     }
 152   else
 153     {
 154       if (child_failed)
 155         {
 156           /* The commands failed, but we don't care.  */
 157           child_error (c, c->cstatus, 0, 0, 1);
 158           child_failed = 0;
 159         }
 160
 161 #if defined(RECURSIVEJOBS) /* I've had problems with recursive stuff and process handling */
 162       /* If there are more commands to run, try to start them.  */
 163       start_job (c);
 164
 165       switch (c->file->command_state)
 166         {
 167         case cs_running:
 168           /* Successfully started.  */
 169           break;
 170
 171         case cs_finished:
 172           if (c->file->update_status != us_success)
 173             /* We failed to start the commands.  */
 174             delete_child_targets (c);
 175           break;
 176
 177         default:
 178           error (NILF, _("internal error: '%s' command_state"),
 179                  c->file->name);
 180           abort ();
 181           break;
 182         }
 183 #endif /* RECURSIVEJOBS */
 184     }
 185
 186   /* Set the state flag to say the commands have finished.  */
 187   c->file->command_state = cs_finished;
 188   notice_finished_file (c->file);
 189
 190 #if defined(RECURSIVEJOBS) /* I've had problems with recursive stuff and process handling */
 191   /* Remove the child from the chain and free it.  */
 192   if (lastc == 0)
 193     children = c->next;
 194   else
 195     lastc->next = c->next;
 196   free_child (c);
 197 #endif /* RECURSIVEJOBS */
 198
 199   /* There is now another slot open.  */
 200   if (job_slots_used > 0)
 201     --job_slots_used;
 202
 203   /* If the job failed, and the -k flag was not given, die.  */
 204   if (child_failed && !keep_going_flag)
 205     die (EXIT_FAILURE);
 206
 207   (void) sigsetmask (sigblock (0) & ~(fatal_signal_mask));
 208
 209   return 1;
 210 }
 211
 212 /* VMS:
 213    Spawn a process executing the command in ARGV and return its pid. */
 214
 215 #define MAXCMDLEN 200
 216
 217 /* local helpers to make ctrl+c and ctrl+y working, see below */
 218 #include <iodef.h>
 219 #include <libclidef.h>
 220 #include <ssdef.h>
 221
 222 static int ctrlMask= LIB$M_CLI_CTRLY;
 223 static int oldCtrlMask;
 224 static int setupYAstTried= 0;
 225 static unsigned short int chan= 0;
 226
 227 static void
 228 reEnableAst(void)
 229 {
 230   lib$enable_ctrl (&oldCtrlMask,0);
 231 }
 232
 233 static int
 234 astYHandler (void)
 235 {
 236   struct child *c;
 237   for (c = children; c != 0; c = c->next)
 238     sys$delprc (&c->pid, 0, 0);
 239   ctrlYPressed= 1;
 240   kill (getpid(),SIGQUIT);
 241   return SS$_NORMAL;
 242 }
 243
 244 static void
 245 tryToSetupYAst(void)
 246 {
 247   $DESCRIPTOR(inputDsc,"SYS$COMMAND");
 248   int     status;
 249   struct {
 250     short int       status, count;
 251     int     dvi;
 252   } iosb;
 253   unsigned short int loc_chan;
 254
 255   setupYAstTried++;
 256
 257   if (chan)
 258     loc_chan= chan;
 259   else
 260     {
 261       status= sys$assign(&inputDsc,&loc_chan,0,0);
 262       if (!(status&SS$_NORMAL))
 263         {
 264           lib$signal(status);
 265           return;
 266         }
 267     }
 268   status= sys$qiow (0, loc_chan, IO$_SETMODE|IO$M_CTRLYAST,&iosb,0,0,
 269                     astYHandler,0,0,0,0,0);
 270   if (status==SS$_NORMAL)
 271     status= iosb.status;
 272   if (status!=SS$_NORMAL)
 273     {
 274       if (!chan)
 275         sys$dassgn(loc_chan);
 276       if (status!=SS$_ILLIOFUNC && status!=SS$_NOPRIV)
 277         lib$signal(status);
 278       return;
 279     }
 280
 281   /* called from AST handler ? */
 282   if (setupYAstTried>1)
 283     return;
 284   if (atexit(reEnableAst))
 285     fprintf (stderr,
 286              _("-warning, you may have to re-enable CTRL-Y handling from DCL.\n"));
 287   status= lib$disable_ctrl (&ctrlMask, &oldCtrlMask);
 288   if (!(status&SS$_NORMAL))
 289     {
 290       lib$signal(status);
 291       return;
 292     }
 293   if (!chan)
 294     chan = loc_chan;
 295 }
 296
 297 int
 298 child_execute_job (char *argv, struct child *child)
 299 {
 300   int i;
 301   static struct dsc$descriptor_s cmddsc;
 302   static struct dsc$descriptor_s pnamedsc;
 303   static struct dsc$descriptor_s ifiledsc;
 304   static struct dsc$descriptor_s ofiledsc;
 305   static struct dsc$descriptor_s efiledsc;
 306   int have_redirection = 0;
 307   int have_append = 0;
 308   int have_newline = 0;
 309
 310   int spflags = CLI$M_NOWAIT;
 311   int status;
 312   char *cmd = alloca (strlen (argv) + 512), *p, *q;
 313   char ifile[256], ofile[256], efile[256];
 314   int comnamelen;
 315   char procname[100];
 316   int in_string;
 317
 318   /* Parse IO redirection.  */
 319
 320   ifile[0] = 0;
 321   ofile[0] = 0;
 322   efile[0] = 0;
 323   child->comname = NULL;
 324
 325   DB (DB_JOBS, ("child_execute_job (%s)\n", argv));
 326
 327   while (isspace ((unsigned char)*argv))
 328     argv++;
 329
 330   if (*argv == 0)
 331     return 0;
 332
 333   sprintf (procname, "GMAKE_%05x", getpid () & 0xfffff);
 334   pnamedsc.dsc$w_length = strlen(procname);
 335   pnamedsc.dsc$a_pointer = procname;
 336   pnamedsc.dsc$b_dtype = DSC$K_DTYPE_T;
 337   pnamedsc.dsc$b_class = DSC$K_CLASS_S;
 338
 339   in_string = 0;
 340   /* Handle comments and redirection. */
 341   for (p = argv, q = cmd; *p; p++, q++)
 342     {
 343       if (*p == '"')
 344         in_string = !in_string;
 345       if (in_string)
 346         {
 347           *q = *p;
 348           continue;
 349         }
 350       switch (*p)
 351         {
 352         case '#':
 353           *p-- = 0;
 354           *q-- = 0;
 355           break;
 356         case '\\':
 357           p++;
 358           if (*p == '\n')
 359             p++;
 360           if (isspace ((unsigned char)*p))
 361             {
 362               do { p++; } while (isspace ((unsigned char)*p));
 363               p--;
 364             }
 365           *q = *p;
 366           break;
 367         case '<':
 368           p = vms_redirect (&ifiledsc, ifile, p);
 369           *q = ' ';
 370           have_redirection = 1;
 371           break;
 372         case '>':
 373           have_redirection = 1;
 374           if (*(p-1) == '2')
 375             {
 376               q--;
 377               if (strncmp (p, ">&1", 3) == 0)
 378                 {
 379                   p += 3;
 380                   strcpy (efile, "sys$output");
 381                   efiledsc.dsc$w_length = strlen(efile);
 382                   efiledsc.dsc$a_pointer = efile;
 383                   efiledsc.dsc$b_dtype = DSC$K_DTYPE_T;
 384                   efiledsc.dsc$b_class = DSC$K_CLASS_S;
 385                 }
 386               else
 387                   p = vms_redirect (&efiledsc, efile, p);
 388             }
 389           else
 390             {
 391               if (*(p+1) == '>')
 392                 {
 393                   have_append = 1;
 394                   p += 1;
 395                 }
 396               p = vms_redirect (&ofiledsc, ofile, p);
 397             }
 398           *q = ' ';
 399           break;
 400         case '\n':
 401           have_newline = 1;
 402         default:
 403           *q = *p;
 404           break;
 405         }
 406     }
 407   *q = *p;
 408   while (isspace ((unsigned char)*--q))
 409     *q = '\0';
 410
 411   if (strncmp (cmd, "builtin_", 8) == 0)
 412     {
 413       child->pid = 270163;
 414       child->efn = 0;
 415       child->cstatus = 1;
 416
 417       DB (DB_JOBS, (_("BUILTIN [%s][%s]\n"), cmd, cmd+8));
 418
 419       p = cmd + 8;
 420
 421       if ((*(p) == 'c')
 422           && (*(p+1) == 'd')
 423           && ((*(p+2) == ' ') || (*(p+2) == '\t')))
 424         {
 425           p += 3;
 426           while ((*p == ' ') || (*p == '\t'))
 427             p++;
 428           DB (DB_JOBS, (_("BUILTIN CD %s\n"), p));
 429           if (chdir (p))
 430             return 0;
 431           else
 432             return 1;
 433         }
 434       else if ((*(p) == 'r')
 435                && (*(p+1) == 'm')
 436                && ((*(p+2) == ' ') || (*(p+2) == '\t')))
 437         {
 438           int in_arg;
 439
 440           /* rm  */
 441           p += 3;
 442           while ((*p == ' ') || (*p == '\t'))
 443             p++;
 444           in_arg = 1;
 445
 446           DB (DB_JOBS, (_("BUILTIN RM %s\n"), p));
 447           while (*p)
 448             {
 449               switch (*p)
 450                 {
 451                 case ' ':
 452                 case '\t':
 453                   if (in_arg)
 454                     {
 455                       *p++ = ';';
 456                       in_arg = 0;
 457                     }
 458                   break;
 459                 default:
 460                   break;
 461                 }
 462               p++;
 463             }
 464         }
 465       else
 466         {
 467           printf (_("Unknown builtin command '%s'\n"), cmd);
 468           fflush (stdout);
 469           return 0;
 470         }
 471     }
 472
 473   /* Create a *.com file if either the command is too long for
 474      lib$spawn, or the command contains a newline, or if redirection
 475      is desired. Forcing commands with newlines into DCLs allows to
 476      store search lists on user mode logicals.  */
 477
 478   if (strlen (cmd) > MAXCMDLEN
 479       || (have_redirection != 0)
 480       || (have_newline != 0))
 481     {
 482       FILE *outfile;
 483       char c;
 484       char *sep;
 485       int alevel = 0;   /* apostrophe level */
 486
 487       if (strlen (cmd) == 0)
 488         {
 489           printf (_("Error, empty command\n"));
 490           fflush (stdout);
 491           return 0;
 492         }
 493
 494       outfile = output_tmpfile (&child->comname, "sys$scratch:CMDXXXXXX.COM");
 495       if (outfile == 0)
 496         pfatal_with_name (_("fopen (temporary file)"));
 497       comnamelen = strlen (child->comname);
 498
 499       if (ifile[0])
 500         {
 501           fprintf (outfile, "$ assign/user %s sys$input\n", ifile);
 502           DB (DB_JOBS, (_("Redirected input from %s\n"), ifile));
 503           ifiledsc.dsc$w_length = 0;
 504         }
 505
 506       if (efile[0])
 507         {
 508           fprintf (outfile, "$ define sys$error %s\n", efile);
 509           DB (DB_JOBS, (_("Redirected error to %s\n"), efile));
 510           efiledsc.dsc$w_length = 0;
 511         }
 512
 513       if (ofile[0])
 514         if (have_append)
 515           {
 516             fprintf (outfile, "$ set noon\n");
 517             fprintf (outfile, "$ define sys$output %.*s\n", comnamelen-3, child->comname);
 518             DB (DB_JOBS, (_("Append output to %s\n"), ofile));
 519             ofiledsc.dsc$w_length = 0;
 520           }
 521         else
 522           {
 523             fprintf (outfile, "$ define sys$output %s\n", ofile);
 524             DB (DB_JOBS, (_("Redirected output to %s\n"), ofile));
 525             ofiledsc.dsc$w_length = 0;
 526           }
 527
 528       p = sep = q = cmd;
 529       for (c = '\n'; c; c = *q++)
 530         {
 531           switch (c)
 532             {
 533             case '\n':
 534               /* At a newline, skip any whitespace around a leading $
 535                  from the command and issue exactly one $ into the DCL. */
 536               while (isspace ((unsigned char)*p))
 537                 p++;
 538               if (*p == '$')
 539                 p++;
 540               while (isspace ((unsigned char)*p))
 541                 p++;
 542               fwrite (p, 1, q - p, outfile);
 543               fputc ('$', outfile);
 544               fputc (' ', outfile);
 545               /* Reset variables. */
 546               p = sep = q;
 547               break;
 548
 549               /* Nice places for line breaks are after strings, after
 550                  comma or space and before slash. */
 551             case '"':
 552               q = vms_handle_apos (q);
 553               sep = q;
 554               break;
 555             case ',':
 556             case ' ':
 557               sep = q;
 558               break;
 559             case '/':
 560             case '\0':
 561               sep = q - 1;
 562               break;
 563             default:
 564               break;
 565             }
 566           if (sep - p > 78)
 567             {
 568               /* Enough stuff for a line. */
 569               fwrite (p, 1, sep - p, outfile);
 570               p = sep;
 571               if (*sep)
 572                 {
 573                   /* The command continues.  */
 574                   fputc ('-', outfile);
 575                 }
 576               fputc ('\n', outfile);
 577             }
 578         }
 579
 580       if (*p)
 581         {
 582           fwrite (p, 1, --q - p, outfile);
 583           fputc ('\n', outfile);
 584         }
 585
 586       if (have_append)
 587         {
 588           fprintf (outfile, "$ deassign sys$output ! 'f$verify(0)\n");
 589           fprintf (outfile, "$ append:=append\n");
 590           fprintf (outfile, "$ delete:=delete\n");
 591           fprintf (outfile, "$ append/new %.*s %s\n", comnamelen-3, child->comname, ofile);
 592           fprintf (outfile, "$ delete %.*s;*\n", comnamelen-3, child->comname);
 593           DB (DB_JOBS, (_("Append %.*s and cleanup\n"), comnamelen-3, child->comname));
 594         }
 595
 596       fclose (outfile);
 597
 598       sprintf (cmd, "$ @%s", child->comname);
 599
 600       DB (DB_JOBS, (_("Executing %s instead\n"), cmd));
 601     }
 602
 603   cmddsc.dsc$w_length = strlen(cmd);
 604   cmddsc.dsc$a_pointer = cmd;
 605   cmddsc.dsc$b_dtype = DSC$K_DTYPE_T;
 606   cmddsc.dsc$b_class = DSC$K_CLASS_S;
 607
 608   child->efn = 0;
 609   while (child->efn < 32 || child->efn > 63)
 610     {
 611       status = lib$get_ef ((unsigned long *)&child->efn);
 612       if (!(status & 1))
 613         {
 614           if (child->comname)
 615             {
 616               if (!ISDB (DB_JOBS))
 617                 unlink (child->comname);
 618               free (child->comname);
 619             }
 620           return 0;
 621         }
 622     }
 623
 624   sys$clref (child->efn);
 625
 626   vms_jobsefnmask |= (1 << (child->efn - 32));
 627
 628   /*
 629     LIB$SPAWN  [command-string]
 630     [,input-file]
 631     [,output-file]
 632     [,flags]
 633     [,process-name]
 634     [,process-id] [,completion-status-address] [,byte-integer-event-flag-num]
 635     [,AST-address] [,varying-AST-argument]
 636     [,prompt-string] [,cli] [,table]
 637   */
 638
 639 #ifndef DONTWAITFORCHILD
 640   /*
 641    * Code to make ctrl+c and ctrl+y working.
 642    * The problem starts with the synchronous case where after lib$spawn is
 643    * called any input will go to the child. But with input re-directed,
 644    * both control characters won't make it to any of the programs, neither
 645    * the spawning nor to the spawned one. Hence the caller needs to spawn
 646    * with CLI$M_NOWAIT to NOT give up the input focus. A sys$waitfr
 647    * has to follow to simulate the wanted synchronous behaviour.
 648    * The next problem is ctrl+y which isn't caught by the crtl and
 649    * therefore isn't converted to SIGQUIT (for a signal handler which is
 650    * already established). The only way to catch ctrl+y, is an AST
 651    * assigned to the input channel. But ctrl+y handling of DCL needs to be
 652    * disabled, otherwise it will handle it. Not to mention the previous
 653    * ctrl+y handling of DCL needs to be re-established before make exits.
 654    * One more: At the time of LIB$SPAWN signals are blocked. SIGQUIT will
 655    * make it to the signal handler after the child "normally" terminates.
 656    * This isn't enough. It seems reasonable for simple command lines like
 657    * a 'cc foobar.c' spawned in a subprocess but it is unacceptable for
 658    * spawning make. Therefore we need to abort the process in the AST.
 659    *
 660    * Prior to the spawn it is checked if an AST is already set up for
 661    * ctrl+y, if not one is set up for a channel to SYS$COMMAND. In general
 662    * this will work except if make is run in a batch environment, but there
 663    * nobody can press ctrl+y. During the setup the DCL handling of ctrl+y
 664    * is disabled and an exit handler is established to re-enable it.
 665    * If the user interrupts with ctrl+y, the assigned AST will fire, force
 666    * an abort to the subprocess and signal SIGQUIT, which will be caught by
 667    * the already established handler and will bring us back to common code.
 668    * After the spawn (now /nowait) a sys$waitfr simulates the /wait and
 669    * enables the ctrl+y be delivered to this code. And the ctrl+c too,
 670    * which the crtl converts to SIGINT and which is caught by the common
 671    * signal handler. Because signals were blocked before entering this code
 672    * sys$waitfr will always complete and the SIGQUIT will be processed after
 673    * it (after termination of the current block, somewhere in common code).
 674    * And SIGINT too will be delayed. That is ctrl+c can only abort when the
 675    * current command completes. Anyway it's better than nothing :-)
 676    */
 677
 678   if (!setupYAstTried)
 679     tryToSetupYAst();
 680   status = lib$spawn (&cmddsc,                                  /* cmd-string */
 681                       (ifiledsc.dsc$w_length == 0)?0:&ifiledsc, /* input-file */
 682                       (ofiledsc.dsc$w_length == 0)?0:&ofiledsc, /* output-file */
 683                       &spflags,                                 /* flags */
 684                       &pnamedsc,                                /* proc name */
 685                       &child->pid, &child->cstatus, &child->efn,
 686                       0, 0,
 687                       0, 0, 0);
 688   if (status & 1)
 689     {
 690       status= sys$waitfr (child->efn);
 691       vmsHandleChildTerm(child);
 692     }
 693 #else
 694   status = lib$spawn (&cmddsc,
 695                       (ifiledsc.dsc$w_length == 0)?0:&ifiledsc,
 696                       (ofiledsc.dsc$w_length == 0)?0:&ofiledsc,
 697                       &spflags,
 698                       &pnamedsc,
 699                       &child->pid, &child->cstatus, &child->efn,
 700                       vmsHandleChildTerm, child,
 701                       0, 0, 0);
 702 #endif
 703
 704   if (!(status & 1))
 705     {
 706       printf (_("Error spawning, %d\n") ,status);
 707       fflush (stdout);
 708       switch (status)
 709         {
 710         case 0x1c:
 711           errno = EPROCLIM;
 712           break;
 713         default:
 714           errno = EFAIL;
 715         }
 716     }
 717
 718   return (status & 1);
 719 }