/* @(#)ospsystem.c	19.1 (ES0-DMD) 02/25/03 13:56:13 */
/*===========================================================================
  Copyright (C) 1995 European Southern Observatory (ESO)
 
  This program is free software; you can redistribute it and/or 
  modify it under the terms of the GNU General Public License as 
  published by the Free Software Foundation; either version 2 of 
  the License, or (at your option) any later version.
 
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
 
  You should have received a copy of the GNU General Public 
  License along with this program; if not, write to the Free 
  Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
  MA 02139, USA.
 
  Corresponding concerning ESO-MIDAS should be addressed as follows:
	Internet e-mail: midas@eso.org
	Postal address: European Southern Observatory
			Data Management Division 
			Karl-Schwarzschild-Strasse 2
			D 85748 Garching bei Muenchen 
			GERMANY
===========================================================================*/

/*--------------------------ospsystem--------------------------------------
.TYPE        routine
.NAME        ospsystem
.MODULE      osp (operating system independant interface, processes)
.ENVIROMENT  vms
.LANGUAGE    C
.AUTHOR      Trond Melen (IPG-ESO Garching)
.PURPOSE
  Execute a command in a shell (The Borne shell under UNIX) or to a 
  command line interpreter (DCL under VMS).
.IMPLEMENTATION
  VMS: The "system()" C runtime library call could have been used but is 
  not for two reasons. First, it is slow because spawning a process for 
  each command is very expensive under VMS. Second, a command cannot be 
  run in the background (using SPAWN/NOWAIT) since a VMS subprocess dies 
  with its parent.

  Instead a subprocess is created when "ospsystem()" is called for the first
  time, and it is kept alive for the rest of the execution period. To 
  run a process in the background, a SPAWN/NOWAIT command is executed in 
  this subprocess. Therfore, a background command will be aborted if the 
  program that issued the command terminates or the subprocess is 
  otherwise killed. The same holds if the user is logged out.

  To simulate the behaviour of a UNIX shell, the command string is 
  parsed and the symbols ';', '&', '(' and ')' are given special meanings. 
  Commands separated by semicolons are run in sequence. If a command is 
  followed by an ampersant, its run in the background. Several commands 
  enclosed in paranthesis are treated as one. This is implemented by 
  creating a command file in the SYS$SCRATCH directory holding the simple
  commands. The command file is executed using the '@file.com' construct.

  Nesting is not admissable.  It is only really usefull for running a
  sequence of commands in the background, and spawning a process from a
  spawned process is unsafe since the parent process might die before
  the child and thereby kill it.

  The parser is documented in connection with the relevant routines.

.RETURNS
  Error status of the command (UNIX only).
----------------------------------------------------------------------*/

#include <stdio.h>

int ospdebug = 0;         /* flag controlling debug printings */


/* The fairly complicated VMS solution */

#include <descrip.h>       /* character descriptor definitions */
#include <dvidef.h>        /* SYS$GETDVI definitions */
#include <iodef.h>         /* SYS$QIO definitions */


#define COMMAND_LEN  256
#define WORD_LEN      80

#define BIT_0(x) ((x) & 1)   /* mask returning bit zero (used for 
                                checking return status of system calls */


/* Type definitions. */

typedef struct dsc$descriptor_s descriptor;

typedef struct   /* structure used by SYS$GETDVI */
  {
    unsigned short buf_len;
    unsigned short item_code;
    char *buffer;
    short *return_len;
  } item_dsc;

typedef struct
  {
    long channel;   /* channel assigned to mailbox 
                       assosiated with the subprocess */
    long pid;       /* process identifier for the subprocess */
  } proc_record;

typedef enum   /* tokens for the parser */
  {T_WORD, T_SEMI, T_LEFT, T_RIGHT, T_AMP, T_EOS, T_ERROR, T_TOOLONG}
TOKEN;


/* Variables global to ospsystem related code. */

static proc_record sub_proc = {0, 0};    /* info about the subprocess */
static int sub_proc_created = 0;         /* flag, initially false */
static int exit_handler_installed = 0;   /* flag, initially false */
static char ospword[WORD_LEN + 1];       /* value only valid when 
                                            get_token returnes T_WORD */


/* A string handling routine. */

static char *strprecat(s1, s2)
/* Workes as strcat, but s2 is inserted at the beginning of s1. */
char s1[], s2[];
{
  int l1, l2, i;
  char *from, *to;

  l1 = strlen(s1);
  l2 = strlen(s2);

  from = &s1[l1 - 1];
  to   = &s1[l1 + l2 - 1];
  for (i = 0; i < l1; i++)
    *to-- = *from--;
  strncpy(s1, s2, l2);
  s1[l1 + l2] = '\0';

  return(s1);
}


/* routines to simplify access to VMS services */

static descriptor dsc(str)
/* Create a descriptor from a string.                                  */
/* Returning structures is not portable, but neigther are descriptors. */
/* May cause program abortion if str is not a null terminated string.  */
char str[];
{
  descriptor dsc;

  dsc.dsc$w_length  = (strlen(str) <= 256) ? strlen(str) : 256 ;
  dsc.dsc$a_pointer = str;
  dsc.dsc$b_class   = DSC$K_CLASS_S;
  dsc.dsc$b_dtype   = DSC$K_DTYPE_T;

  return(dsc);
}


static void error_msg(str, msg_id)
/* Print string and error message identified by msg_id. */
char str[];
long msg_id;
{
  long flags, status;
  short msg_len;
  descriptor msg_dsc;
  char buffer[257];

  msg_dsc = dsc(buffer);
  msg_dsc.dsc$w_length = 256;
  flags =  0;        /* use process default */
  /* flags = 15;        /* get all information available */

  if (BIT_0(status = SYS$GETMSG(msg_id, &msg_len, &msg_dsc, flags, NULL)))
    {
      buffer[msg_len] = '\0';
      fprintf(stderr, "%s: %s\n", str, buffer);
    }
  else
    {
      fprintf(stderr, 
        "%s: error_msg: SYS$GETMSG failed for msg_id %d\n", str, msg_id);

      msg_dsc.dsc$w_length = 256;
      if (BIT_0(status = SYS$GETMSG(status, &msg_len, &msg_dsc, flags, NULL)))
        {
          buffer[msg_len] = '\0';
          fprintf(stderr, "error_msg: %s\n", buffer);
        }
      else
        fprintf(stderr, 
          "error_msg: unable to find out why (status = %d)\n", status);
    }
}


static int write_channel(channel, buffer)
/* Write null-terminated string to VMS-type channel. */
/* Returns 0 on success, 1 on falure.                */
long channel;
char buffer[];
{
  long event_flag, function, buf_size;
  short int iosb[4];                    /* not used */
  long status;
    
  event_flag = 0;                       /* not used */
  function = IO$_WRITEVBLK | IO$M_NOW;  /* write virtual block */
  buf_size = strlen(buffer);

  status = SYS$QIOW(event_flag, channel, function, iosb, NULL, 0, 
                    buffer, buf_size, 0, 0, 0, 0);
  if (!BIT_0(status))
    {
      error_msg("SYS$QIOW", status);
      return(1);
    }
  return(0);
}


static char *get_dev_name(channel, str, max_len)
/* Get name of the device which the channel is assigned to. */
/* Returnes str on success, NULL on falure. */
long channel;
char str[];
int max_len;
{
  /* parameters for SYS$GETDVI */
  item_dsc item_list[2];
  long event_flag;
  short str_len;
  long status;

  event_flag = 0;
  item_list[0].buf_len    = max_len - 1;
  item_list[0].item_code  = DVI$_DEVNAM;
  item_list[0].buffer     = str;
  item_list[0].return_len = &str_len;
  item_list[1].buf_len    = 0;
  item_list[1].item_code  = 0;

  status = SYS$GETDVIW(event_flag, channel, NULL, item_list, 
                      NULL, NULL, 0, NULL);
  if (!BIT_0(status))
    {
      error_msg("SYS$GETDVI", status);
      return(NULL);
    }

  str[str_len] = '\0';
  return(str);
}


/* Asyncronous system traps (ASTs) end exit handler (EXH) */

static int ready_ast()
/* Executes in parent process when subprosses is ready for input, */
/* i.e. when previous command has compleated.                     */
{
  long status;

  status = SYS$WAKE(NULL, NULL);
  if (!BIT_0(status))
    {
      error_msg("SYS$WAKE", status);
      fprintf(stderr, "osp/ready_ast: cannot recover\n");
    }

  return(0);
}


static long termination_ast()
/* Executes in parent process when a subprocess terminates */
{
  long status;

  fprintf(stderr, "[subprocess terminated]\n");

  sub_proc_created = 0;

  status = SYS$WAKE(NULL, NULL);
  if (!BIT_0(status)) error_msg("SYS$WAKE", status); 

  return(0);
}


static int cleanup_exh()
/* Kill the subprocess if one has been created.     */
/* Executes in parent process when this is exiting. */
{
  long status;

  if (sub_proc_created)
    {
      status = SYS$DELPRC(&sub_proc.pid, NULL);
      if (!BIT_0(status)) error_msg("SYS$DELPRC", status);
    }

  return(0);
}


static int install_exit_handler()
/* Install the exithandler and set the assosiated flag */
{
  static long control_block[4];
  static long condition_value;
  long status;

  control_block[1] = (long) cleanup_exh;
  control_block[2] = 1;
  control_block[3] = (long) &condition_value;

  status = SYS$DCLEXH(control_block);
  if (!BIT_0(status))
    {
      error_msg("SYS$DCLEXH", status);
      return(1);
    }

  exit_handler_installed = 1;

  return(0);
};


/* Routines to create and initialize the subprocess. */

static int create_sub_proc()
/* Create a subprocess and let it take its input from a mailbox. */
/* Returns 0 on success, 1 on falure.                            */
{
  char mbx_dev_name[10];
  long status;

  /* Parameters for SYS$CREMBX. */
  long mbx_chan;

  /* Parameters for LIB$SPAWN. */
  descriptor in_file;
  long flags, spawned_pid, (* c_ast)(), c_ast_param;

  /* Create a mailbox.
  status = SYS$CREMBX(permanent_flag, &mbx_channel, max_msg_size,
		      buffer_size, protection_mask, access_mode, &mbx_name); */
  if (ospdebug)
    fprintf(stderr, "osp/create_sub_proc: creating mailbox\n");
  status = SYS$CREMBX(0, &mbx_chan, 0, 0, 0, 0, 0);
  if (!BIT_0(status))
    {
      error_msg("SYS$CREMBX", status);
      return(1);
    }

  /* Get devive name of mailbox. */
  if (ospdebug) fprintf(stderr, 
    "osp/create_sub_proc: asking system for mailbox' device name\n");
  (void) get_dev_name(mbx_chan, mbx_dev_name, sizeof(mbx_dev_name));

  /* Spawn a process, not waiting for it to complete.
  status = LIB$SPAWN(&command_str, &in_file, &out_file, &flags, &proc_name, 
                     &spawned_pid, &c_status, &c_efn, c_ast, c_ast_param); */
  if (ospdebug) 
    fprintf(stderr, "osp/create_sub_proc: spawning a subprocess\n");
  in_file = dsc(mbx_dev_name);  /* take input from the mailbox */
  flags = 1;                    /* NOWAIT */
  c_ast = termination_ast;      /* rutine to be run upon completion */
  status = LIB$SPAWN(0, &in_file, 0, &flags, 0, &spawned_pid, 0, 0, c_ast, 0);
  if (!BIT_0(status))
    {
      error_msg("LIB$SPAWN", status);
      return(1);
    }

  /* Initialize process record. */
  sub_proc.channel = mbx_chan;
  sub_proc.pid     = spawned_pid;

  /* Print information about the subprocess. */
  if (ospdebug)
    {
      fprintf(stderr,
              "osp/create_sub_proc: Process identifier %d\n", sub_proc.pid);
      fprintf(stderr,
              "osp/create_sub_proc: Channel number     %d\n", sub_proc.channel);
    }
  return(0);
}


static int init_sub_proc()
/* Initialize subprocess using DCL commands */
/* Returns 0 on success, 1 on falure.       */
{
  long channel;
  char user_terminal[10], command[80];
  int length;
  short str_len;

  /* Get channel assigned to mailbox associated with subprocess. */
  channel = sub_proc.channel;

  /* Assign terminal device name to I/O logical names. */
  return(
    write_channel(channel, "SET NOVERIFY") ||
    write_channel(channel, "SET NOON") ||
    write_channel(channel,
                  "DEFINE/NOLOG TT          'F$TRNLNM(\"SYS$OUTPUT\")") ||
    write_channel(channel,
                  "DEFINE/NOLOG SYS$COMMAND 'F$TRNLNM(\"SYS$OUTPUT\")") ||
    write_channel(channel,
                  "DEFINE/NOLOG SYS$INPUT   'F$TRNLNM(\"SYS$OUTPUT\")") ||
    write_channel(channel,
                  "DEFINE/NOLOG FOR$INPUT   'F$TRNLNM(\"SYS$OUTPUT\")"));
}


/* The parser */

static TOKEN get_token(string, pos_ptr, look_for_T_RIGHT)
/* Return the token at current position and              */
/* increment position to the beginning of next token.    */
/* If token is T_WORD, ospword will hold the characters. */
/* '(' is only interpreted as a token at the beginning   */
/* of a line or after a ';' or a '&'. ')' is only        */
/* interpreted if the flag look_for_T_RIGHT is set.      */

char *string;          /* string to be parsed */
int  *pos_ptr;         /* pointer to variable holding position within string */
int look_for_T_RIGHT;  /* 1 if ')' should be interpreted as a token, else 0 */
{
  enum {NEUTRAL, INWORD} state = NEUTRAL;
  int ch, prev_ch, i;

  i = 0;
  while (i < sizeof(ospword))
    {
      ch = string[(*pos_ptr)++];
      switch(state)
        {
          case NEUTRAL:
            switch(ch)
              {
                case ';':
                  return(T_SEMI);
                case '(':
		  if (*pos_ptr == 1)
		    return(T_LEFT);
		  prev_ch = string[(*pos_ptr) - 1];
		  if (prev_ch == ';' || prev_ch == '&')
		    return(T_LEFT);
		  else
		    {
		      state = INWORD;
		      ospword[i++] = ch;
		      continue;
		    }
                case ')':
		  if (look_for_T_RIGHT)
		    return(T_RIGHT);
		  else
		    {
		      state = INWORD;
		      ospword[i++] = ch;
		      continue;
		    }
                case '&':
                  return(T_AMP);
                case '\0':
                  return(T_EOS);
                case ' ':
                case '\t':
                  continue;
                default:
                  state = INWORD;
                  ospword[i++] = ch;
                  continue;
            }
        case INWORD:
          switch(ch)
            {
              case ';':
              case '&':
              case ' ':
              case '\t':
              case '\0':
                (*pos_ptr)--;
                ospword[i] = '\0';
                return(T_WORD);
              case ')':
		if (look_for_T_RIGHT)
		  {
		    (*pos_ptr)--;
		    ospword[i] = '\0';
		    return(T_WORD);
		  }
		else
		  {
		    ospword[i++] = ch;
		    continue;
		  }
              default:
                ospword[i++] = ch;
                continue;
            }
        }
    }
  return(T_TOOLONG);
}


static TOKEN make_simple_command(look_ahead, string,
				 pos_ptr, dcl_command, look_for_T_RIGHT)
/*------------------------------------------------------------------
Make_simple_command builds a command using tokens from string
and places it in dcl_command.
The routine is called with look_ahead holding the first
token of the simple command, which must be T_WORD. This
word and the following are collected and copied into dcl_command.
If look_ahead is not T_WORD, dcl_command becomes the null string.
Make_simple_command returnes the first token not used in building
dcl_command.
---------------------------------------------------------------------*/
TOKEN look_ahead;      /* first token to be used  */
char string[];         /* the string being parsed */
int *pos_ptr;          /* ponter to integer holding 
                         current position whithin string */
char dcl_command[];    /* string to hold the command being build */
int look_for_T_RIGHT;  /* 1 if ')' should be interpreted as a token, else 0 */
{
  dcl_command[0] = '\0';

  /* Check for empty command. */
  if (look_ahead != T_WORD) return(look_ahead);

  /* loop over the next tokens */
  while (1)
    {
      switch (look_ahead)
        {
          case T_WORD:
            if ((strlen(dcl_command) + strlen(ospword) + 1) > COMMAND_LEN) 
              return(T_TOOLONG);
            strcat(dcl_command, ospword);
            strcat(dcl_command, " ");
            look_ahead = get_token(string, pos_ptr, look_for_T_RIGHT);
            continue;
          default:   /* token was a command terminator */
            return(look_ahead);
        }
    }
}


static TOKEN make_command(look_ahead, string, pos_ptr, 
                          dcl_command, action)
/*-------------------------------------------------------------------
Make_command builds a command using tokens from string
and places it in dcl_command.
The routine is called with look_ahead holding the first
token of the command.
* If look_ahead is T_WORD, the simple exercice of building
  the command is left to make_simple command. 
* If look_ahead is T_LEFT, a command file is created and the
  commands enclosed in paranthesis are included in the file.
* If look_ahead is a command separator or terminator, an
  empty command is build.
* For other values of look_ahead som error handling is performed.
Some effords are made to avoid creating files for a single or empty 
command.
Make_command returnes the first token not used building dcl_command.
dcl_command will hold a simple command, or the command to run the
comand file.
---------------------------------------------------------------------*/
TOKEN look_ahead;     /* first token to be used  */
char string[];        /* the string being parsed */
int *pos_ptr;         /* ponter to integer holding 
                         current position whithin string */
char dcl_command[];   /* string to hold the command being build */
int action;           /* flag, if 0 only check syntax, 
                         else create the necessary files */
{
  FILE *fd;                        /* file descriptor of file created */
  char file_name[64];              /* name of file created */
  int com_file_created = 0;        /* flag, initially false */
  int look_for_T_RIGHT = 0;        /* flag, initially false */
  char last_dcl[COMMAND_LEN + 1];  /* temporary storage for dcl_command */

  file_name[0] = '\0';
  last_dcl[0] = '\0';

  /* switch on first token of the command */
  switch (look_ahead)
    {
      case T_SEMI:
      case T_AMP:
      case T_EOS:
        dcl_command[0] = '\0';
        return(look_ahead);
      case T_WORD:
        look_ahead = make_simple_command(look_ahead, string, pos_ptr,
					 dcl_command, look_for_T_RIGHT);
        return(look_ahead);
      case T_RIGHT:
        fprintf(stderr, "Unexpected ')'\n");
        return(T_ERROR);
      case T_ERROR:
      case T_TOOLONG:
        return(look_ahead);
      case T_LEFT:
        /* create a com-file to execute commands in paranthesis in sequence */
	look_for_T_RIGHT = 1;

        /* not all tokens are admissable after T_LEFT */
        look_ahead = get_token(string, pos_ptr, look_for_T_RIGHT);
        switch (look_ahead)
          {
	  case T_RIGHT:
	    dcl_command[0] = '\0';
	    look_for_T_RIGHT = 0;
	    look_ahead = get_token(string, pos_ptr, look_for_T_RIGHT);
	    return(look_ahead);
	  case T_LEFT:
	    fprintf(stderr, "Nested paranthesis not allowed\n");
	    return(T_ERROR);
	  case T_AMP:
	    fprintf(stderr, "Unexpexted '&'\n");
	    return(T_ERROR);
	  case T_EOS:
	    fprintf(stderr, "Unbalanced parenthesis\n");
	    return(T_ERROR);
	  case T_ERROR:
	  case T_TOOLONG:
	    return(look_ahead);
	  default:  /* T_WORD or T_SEMI */
	    break;  /* ok */
          }

        /* loop over commands to be included in command file */
        while (1)
          {
            look_ahead = make_simple_command(look_ahead, string, pos_ptr,
					     dcl_command, look_for_T_RIGHT);

            /* switch on token following the command */
            switch(look_ahead) 
              {
                case T_WORD:
                  fprintf(stderr, "osp/parser: BUG! Error in parser\n");
                  return(T_ERROR);
                case T_LEFT:
		  fprintf(stderr, "Nested paranthesis not allowed\n");
                  return(T_ERROR);
                case T_AMP:
                  fprintf(stderr, "'&' not allowed in paranthesis\n");
                  return(T_ERROR);
                case T_EOS:
                  fprintf(stderr, "Unbalanced parenthesis\n");
                  return(T_ERROR);
                case T_ERROR:
                case T_TOOLONG:
                  return(look_ahead);
                case T_SEMI:
                case T_RIGHT:
                  if (strlen(dcl_command) > 0)
                    {
                      /* if this is not the first nonempty command */
                      if (strlen(last_dcl) > 0)
                        {
                          /* if command file not yet created, do it */
                          if (!com_file_created)
                            {
                              sprintf(file_name, "sys$scratch:midas_%s.com", 
                                                 tmpnam(NULL));
                              if (action)
				{
				  fd = fopen(file_name, "w");
				  fprintf(fd, "$ SET NOON\n");
				}
                              com_file_created = 1; /* true */
                            }

                          /* Write last command to file */
                          if (action) 
                            fprintf(fd, "$ %s\n", last_dcl);
                        }

                      /* copy dcl_commnad to last_dcl */
                      strcpy(last_dcl, dcl_command);
                    }

                  /* if command was terminated with ';', build next command */
                  if (look_ahead == T_SEMI)
                    {
                      /* get the next token and loop to next command */
                      look_ahead = get_token(string, pos_ptr,look_for_T_RIGHT);
                      continue;
                    }

                  /* command was terminated with ')', close the com-file */
		  if (com_file_created)
		    {
		      if (action)
			{
			  fprintf(fd, "$ %s\n", last_dcl);
/*			  fprintf(fd,
"$ IF f$process() .nes. f$getjpi(\"%x\", \"prcnam\") THEN \
WRITE sys$error \"Process \" + f$process() + \" terminated\"\n", sub_proc.pid);
			  fprintf(fd, "$ DELETE/NOLOG %s;\n", file_name); */
			  fclose(fd);
			}
		      sprintf(dcl_command, "@%s", file_name);
		    }
		  else
		    strcpy(dcl_command, last_dcl);
                  /* get the next token */
		  look_for_T_RIGHT = 0;
                  look_ahead = get_token(string, pos_ptr, look_for_T_RIGHT);
                  return(look_ahead);
              }
          }
    }
}


static int run_command(command, action)
/*----------------------------------------------------------------------
run_command execute the command(s) in the command string if the flag
action is set.  It the flag is not set, only syntax checking will be
performed. Commands are separated with ';' or '&'. If a command
is terminated with an '&', dcl_command is concatenated with the string 
"SPAWN/NOWAIT " so that it will be run in the background.
run_command retuns 1 on error, 0 if command was ok.
----------------------------------------------------------------------*/
char command[];     /* the command to be parsed and executed */
int action;         /* flag, if 0 only check syntax, 
                       else create the necessary files */
{
  TOKEN look_ahead;                   /* first token not yet used  */
  char dcl_command[COMMAND_LEN + 1];  /* string to hold the 
                                         command being build */
  int pos = 0;                        /* current position whithin string */

  /* Get first token in command. */
  look_ahead = get_token(command, &pos, 0);

  /* loop over commands separated by semicolons or ampersent */
  while (1)
    {
      look_ahead = make_command(look_ahead, command, &pos, dcl_command,action);
      switch(look_ahead)
        {
          case T_SEMI:
            if (action && strlen(dcl_command) > 0)
	      {
		write_channel(sub_proc.channel, dcl_command);
		write_channel(sub_proc.channel,
			      "DEFINE/NOLOG SYS$INPUT 'F$TRNLNM(\"TT\")");
	      }
            look_ahead = get_token(command, &pos, 0);
            continue;
          case T_AMP:
            if (strlen(dcl_command) > 0)
	      if (strlen("SPAWN/NOWAIT/NOLOG ") +
		  strlen(dcl_command) > COMMAND_LEN)
		{
		  fprintf(stderr, "Token or command too long\n");
		  return(1);
		}
	      else
		{
		  strprecat(dcl_command, "SPAWN/NOWAIT/NOLOG ");
		  if (action)
		    write_channel(sub_proc.channel, dcl_command);
		}
            look_ahead = get_token(command, &pos, 0);
            continue;
          case T_EOS:
            if (action && strlen(dcl_command) > 0)
	      {
		write_channel(sub_proc.channel, dcl_command);
		write_channel(sub_proc.channel,
			      "DEFINE/NOLOG SYS$INPUT 'F$TRNLNM(\"TT\")");
	      }
            return(0);
          case T_LEFT:
            fprintf(stderr, "Unexpected left parenthesis\n");
            return(1);
          case T_RIGHT:
            fprintf(stderr, "Unexpected right parenthesis\n");
            return(1);
          case T_WORD:
            fprintf(stderr, "';' expected\n");
            return(1);
          case T_ERROR:
            return(1);
          case T_TOOLONG:
            fprintf(stderr, "Token or command too long\n");
            return(1);
        }
    }
}


/* The entrypoint for the VMS implementation */

long ospsystem(command)
/* Routine simulating the UNIX "system()" library call under VMS. */
char *command;   /* command to be executed */
{
  /* parameters for SYS$QIOW */
  long event_flag, channel, function, acc_mode, status;

  /* check the command syntax */
  if (run_command(command, 0))      /* if syntax error */
    return(1);

  /* If subprocess not yet created, do it. */
  /* Should ask system for the existance of the process, but ... */
  if (!sub_proc_created)
    {
      if (ospdebug)
        fprintf(stderr, "ospsystem: Creating a subprocess\n");
      if (create_sub_proc() != 0)
        {
          fprintf(stderr, "Unable to create subprocess\n");
          return(1);
        }

      /* Initialize subprocess. */
      if (ospdebug)
        fprintf(stderr, "osp/create_sub_proc: initializing subprocess\n");
      if (init_sub_proc())
        printf(stderr, "Subprocess may not be properly initialized\n");

      /* Intstall exit handler. */
      if (ospdebug)
        fprintf(stderr, "osp/create_sub_proc: installing exit handler\n");
      if (!exit_handler_installed && install_exit_handler())
          printf(stderr, "Subprocess may not be deleted on exit\n");

      if (ospdebug)
        fprintf(stderr, "ospsystem: Subprocess created\n");
      sub_proc_created = 1;  /* true */
    }

  /* Run the command in the subprocess. */
  (void) run_command(command, 1);

  /* enable mailbox to run ready_ast when dcl command has compleated */
  event_flag = 0;                          /* not used */
  channel = sub_proc.channel;              /* channel assigned to mailbox */
  function = IO$_SETMODE | IO$M_READATTN;  /* read attention ast */

  status = SYS$QIOW(event_flag, channel, function, NULL, 
                    NULL, 0, ready_ast, NULL, 0, 0, 0, 0);
  if (!BIT_0(status))
    {
      error_msg("SYS$QIOW", status);
      fprintf(stderr, 
        "Unable to enable ready_ast, skipping the hibernation\n");
    }
  else
    {
      /* wait for dcl command to complete, ready_ast will wake us up */
      if (ospdebug)
        fprintf(stderr, "ospsystem: caller is hibernated\n");

      status = SYS$HIBER();
      if (!BIT_0(status))
        {
          error_msg("SYS$HIBER", status);
          fprintf(stderr, "Hibernation failed\n");
        }
      else
        if (ospdebug) 
          fprintf(stderr, "ospsystem: Hibernated caller waked up\n");
    }
}
