[comp.os.vms] BOSS 2.4 4/4

KARNEY%PPC.MFENET@NMFECC.ARPA (07/19/88)

+-+-+-+ Beginning of part 4 +-+-+-+
X`009if (tiosb.stats != SS$_DATAOVERUN) check(tiosb.stats);
X`009input_state = NORMAL;
X      }
X      break;
X    }
X    switch (input_char) {
X    case '\016':
X      input_state = CREATE;
X      break;
X    case '\024':
X      input_state = TOP;
X      break;
X    case '\032':
X      if (count_processes()) {
X`009diag();
X        sprintf(buf,"[Do you really want to quit (y or n)?]%s\007",ceol);
X        term_msg(buf);
X`009input_state = END;
X      }
X      else exit(SS$_NORMAL);
X      break;
X    case '\010':
X      print_help();
X      input_state = NORMAL;
X      break;
X    case '?':
X      diag();
X      input_state = NORMAL;
X      break;
X    case '\002':
X    case '\017':
X    case '\020':
X    case '\027':
X      if (input_char == '\002') desc = "Buffer";
X      else if (input_char == '\017') desc = "Discard";
X      else if (input_char == '\020') desc = "Print";
X      else if (input_char == '\027') desc = "Stop";
X      nmode = input_char + 0140;
X      if (cur < 0) {
X`009defmode = nmode;
X`009sprintf(buf,"%s[%s output by default]%s",bos,desc,ceoln);
X      }
X      else {
X`009mode[cur] = nmode;
X`009pmode[cur] = nmode;
X`009sprintf(buf,"%s[%s output from process %c]%s",bos,desc,
X`009`009name[cur],ceoln);
X      }
X      term_msg(buf);
X      input_state = NORMAL;
X      break;
X    case '\177':
X      input_state = NORMAL;
X      break;
X    default:
X      nname = toupper(input_char);
X      if (nname >= 'A' && nname <= 'Z') {
X`009mov_to(nname,input_char < 'a',"",switch_create ? CREATE : SWITCH);
X      } else term_msg("\007");
X      input_state = NORMAL;
X      break;
X    }
X    break;
X  case CREATE:
X  case TOP:
X    switch (input_char) {
X    case '\016':
X      input_state = CREATE;
X      break;
X    case '\024':
X      input_state = TOP;
X      break;
X    case '\010':
X      print_help();
X      input_state = NORMAL;
X      break;
X    case '?':
X      diag();
X      input_state = NORMAL;
X      break;
X    case '\177':
X      input_state = NORMAL;
X      break;
X    default:
X      nname = toupper(input_char);
X      if (nname >= 'A' && nname <= 'Z') {
X`009mov_to(nname,input_char < 'a',"",input_state);
X      } else term_msg("\007");
X      input_state = NORMAL;
X      break;
X    }
X    break;
X  case END:
X    if (toupper(input_char) == 'Y') {
X      term_msg(" Yes\r");
X      exit(SS$_NORMAL);
X    } else {
X      term_msg(" No\r\n");
X    }
X    input_state = NORMAL;
X    break;
X  }
X                               /* re-post read AST on real term */
X  check(SYS$QIO(0,tt_chn,IO$_READVBLK,&tiosb,&tt_srv,0,
X                &input_char,1,0,0,0,0));
X}
X
Xget_tt_info()
X{
X  $DESCRIPTOR(d_tt, "SYS$COMMAND");
X                                /* Get a channel & mailbox of terminal */
X  check(LIB$ASN_WTH_MBX(&d_tt,&ttmbsiz,&ttmaxsiz,&tt_chn,&tt_mb_chn));
X                                /* Get the terminal characteristics. */
X  check(SYS$QIOW(0,tt_chn,IO$_SENSEMODE,0,0,0,&tt_chr,ttchrlen,0,0,0,0));
X  tt_sav_chr = tt_chr;
X  tt_chr.ttchr |= TT$M_NOECHO;  /* term will be Noecho */
X  tt_chr.ttchr &= `126TT$M_HOSTSYNC; /* no host sync */
X  if (flow_control) tt_chr.ttchr |= TT$M_TTSYNC; /* do sync at BOSS level */
X  else tt_chr.ttchr &= `126TT$M_TTSYNC; /* do sync at subprocess level */
X  tt_chr.xchar |= TT2$M_PASTHRU; /* it will be PASTRHU */
X  if (brkthru) {
X    tt_chr.ttchr |= TT$M_MBXDSABL; /* no hangup messages */
X    tt_chr.ttchr |= TT$M_NOBRDCST; /* disable direct broadcast */
X    tt_chr.xchar |= TT2$M_BRDCSTMBX; /* send them to mailbox instead */
X  }
X  check(SYS$QIOW(0,tt_chn,IO$_SETMODE,0,0,0,&tt_chr,ttchrlen,0,0,0,0));
X}
X
Xfix_a_tp(n)                             /* Set up a Pseudo term */
Xint n;
X{
X  int dev_depend, tp_chn;
X  struct CHARBLK tw_chr;
X  struct IOSBBLK iosb;
X  struct DVIBLK  dvi_stuff = {4, DVI$_DEVDEPEND, &dev_depend, 0, 0};
X
X  $DESCRIPTOR(d_pynam,"PYA0:"); /* Template. */
X  $DESCRIPTOR(d_finaltp, &finaltp[n]);
X                                /* Assign a mailbox to PYA */
X  check(LIB$ASN_WTH_MBX(&d_pynam,&mbsiz,&maxsiz,&py_chn[n],&py_mb_chn[n]));
X/*
X * Use $GETDVI to get the device dependent characteristics, which
X * contains the associated terminal device's unit number.
X */
X  check(SYS$GETDVI(0,py_chn[n],0,&dvi_stuff,&iosb,0,0,0));
X  check(iosb.stats);
X  tw_chr= tt_sav_chr;
X  tw_chr.xchar|= TT2$M_HANGUP;
X  sprintf(&finaltp[n],"TWA%d:",dev_depend);
X  d_finaltp.dsc$w_length = strlen(&finaltp[n]);
X`009`009`009`009/* Get a channel on this TWA */
X  if (bad(SYS$ASSIGN(&d_finaltp,&tp_chn,0,0))) {
X    sprintf(&finaltp[n],"TPA%d:",dev_depend); /* TWA doesn't work; try TPA */
X    d_finaltp.dsc$w_length = strlen(&finaltp[n]);
X    check(SYS$ASSIGN(&d_finaltp,&tp_chn,0,0));
X  }
X  if (no_phy_io) check(SYS$SETPRV(1,&priv,0,0));
X`009`009`009`009/* Make it look like a terminal */
X  if (bad(SYS$QIOW(0,tp_chn,IO$_SETCHAR,0,0,0, /* This needs PHY_IO priv */
X                   &tw_chr,ttchrlen,0,0,0,0)))
X    check(SYS$QIOW(0,tp_chn,IO$_SETMODE,0,0,0,
X                   &tw_chr,ttchrlen,0,0,0,0));
X  if (no_phy_io) check(SYS$SETPRV(0,&priv,0,0));
X  check(SYS$DASSGN(tp_chn));    /* We don't need it. only the mailbox */
X                                /* in fact keeping it kills us. */
X}
X
Xbroadcast_handler()`009`009/* handle broadcasts to BOSS */
X{
X  int j, len;
X
X  $DESCRIPTOR(d_tt_mb,tt_mb);
X  $DESCRIPTOR(d_finaltp,finaltp[cur]);
X
X  check(tiosbmb.stats);`009`009/* Check status */
X  len = ((0377 & tt_mb[21]) << 8) + (0377 & tt_mb[20]); /* message length */
X  if (cur < 0) {
X    term_msg("\r\n");
X    check(SYS$QIOW(0,tt_chn,IO$_WRITEVBLK,0,0,0,&(tt_mb[22]),len,0,0,0,0));
X    term_msg("\r");
X  }
X  else {
X    d_tt_mb.dsc$w_length = len;
X    d_tt_mb.dsc$a_pointer = &(tt_mb[22]);
X    if (no_oper) check(SYS$SETPRV(1,&privs,0,0));
X    check(SYS$BRKTHRU(0,&d_tt_mb,&d_finaltp,
X`009`009      BRK$C_DEVICE,0,32,0,BRK$C_USER16,0,0,0));
X    if (no_oper) check(SYS$SETPRV(0,&privs,0,0));
X  }
X  check(SYS$QIO(0,tt_mb_chn,IO$_READVBLK,&tiosbmb,&broadcast_handler,0,
X                &tt_mb,ttmbsiz,0,0,0,0));
X}
X
Xpost_term_reads()                           /* Read AST on real term */
X{
X  if (brkthru)
X    check(SYS$QIO(0,tt_mb_chn,IO$_READVBLK,&tiosbmb,&broadcast_handler,0,
X`009`009  &tt_mb,ttmbsiz,0,0,0,0));
X  else
X    check(SYS$QIO(0,tt_mb_chn,IO$_READVBLK,&tiosbmb,0,0,
X`009`009  &tt_mb,ttmbsiz,0,0,0,0));
X  check(SYS$QIO(0,tt_chn,IO$_READVBLK,&tiosb,&tt_srv,0,
X                &input_char,1,0,0,0,0));
X}
X
Xpost_pty_reads(n)                          /* Read AST on Pseudo-term */
Xint n;
X{
X  char cr = '\r';
X
X  if (init) return(0);
X  py_post[n] = 1;
X  check(SYS$QIO(0,py_mb_chn[n],IO$_READVBLK,&miosb[n],&mb_srv,n,
X                &py_mb[n],mbsiz,0,0,0,0));
X  check(SYS$QIO(0,py_chn[n],IO$_READVBLK,&piosb[n],&py_srv,n,
X                &tpline[n],linesz,0,0,0,0));
X  if (proc_type[n] == TOP) {
X    check(SYS$QIOW(0,py_chn[n],IO$_WRITEVBLK,&tiosb,0,0,
X                   &cr,1,0,0,0,0));
X    if (tiosb.stats != SS$_DATAOVERUN) check(tiosb.stats);
X  }
X}
X
Xint
Xfire_up(n,nname,proc_mode)                /* Fire up subprocess n */
Xint n,proc_mode;
Xchar nname;
X{
X  int val;
X  name[n] = nname;
X  procno[nname - 'A'] = n;
X  count[n] = 0;                 /* Initialize buffer count */
X  blocked[n] = 0;               /* It starts unblocked */
X  py_post[n] = 0;
X  mode[n] = defmode;
X  pmode[n] = defmode;
X  buflen[n] = 0;
X  proc_type[n] = proc_mode;
X  enable_hangup[n] = 0;
X  pid[n] = 0;
X  fix_a_tp(n);                  /* Set a pseudo terminal by TT info */
X  check(SYS$CANCEL(py_chn[n])); /* Don't need this Half of pseudo-ter */
X  val = (proc_type[n] == TOP) ? 1 :
X    low_lib_spawn(n,&finaltp[n],&pid[n],name[n]); /* Spawn a subprocess. */
X  if (!bad(val)) post_pty_reads(n); /* Set up AST */
X  else comp_srv(n);             /* Mark the process as non-existent */
X  return(val);
X}
X
Xinitialize()                    /* Initialize everything */
X{
X  int j,item;
X  $DESCRIPTOR(d_boss_id,"BOSS$ID");
X  $DESCRIPTOR(d_lnm_process,"LNM$PROCESS");
X
X  for (j = 0; j < nproc; j++) name[j] = '\0'; /* Initialize variables */
X  for (j = 0; j < nalph; j++) procno[j] = -1;
X`009`009`009`009/* Save old value of BOSS$ID */
X  j = SYS$TRNLNM(0,&d_lnm_process,&d_boss_id,&super_ac_mode,&trnlnm_item);
X  if (!bad(j) && trnlnm_string_len == 1) {
X    oboss_id = trnlnm_string[0];
X    j = LIB$DELETE_LOGICAL(&d_boss_id,0);
X  }
X
X  item = JPI$_PROCPRIV;`009`009/* Check whether have PHY_IO & OPER */
X  check(LIB$GETJPI(&item,0,0,&priv,0,0));
X  no_phy_io = !(priv[0] & PRV$M_PHY_IO);
X  no_oper = !(priv[0] & PRV$M_OPER);
X  item = JPI$_IMAGPRIV;`009`009/* Check whether we can do BRKTHRU */
X  check(LIB$GETJPI(&item,0,0,&priv,0,0));
X  brkthru = ((priv[0] & PRV$M_OPER) || !no_oper);
X  priv[0] = PRV$M_PHY_IO; priv[1] = 0;
X  privs[0] = PRV$M_OPER; privs[1] = 0;
X  if (no_phy_io) check(SYS$SETPRV(0,&priv,0,0));
X  if (no_oper) check(SYS$SETPRV(0,&privs,0,0));
X  get_tt_info();                /* Initialize terminal */
X  start_up();`009`009`009/* Start up processes */
X  post_term_reads();
X}
X
X/* Next two routines taken from FILE program by Joe Meadows Jr. */
X
Xlong int cli_present(s)
X  char *s;
X{
X  static struct dsc$descriptor s_desc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
X
X  s_desc.dsc$w_length = strlen(s);
X  s_desc.dsc$a_pointer = s;
X  return(cli$present(&s_desc));
X}
X
Xlong int cli_get_value(s1,s2)
X  char *s1,**s2;
X{
X  static struct dsc$descriptor s1_desc={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
X  static struct dsc$descriptor s2_desc={0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
X  static char null = '\0';
X  static struct dsc$descriptor null_desc={1,DSC$K_DTYPE_T,DSC$K_CLASS_S,&null};
X  long int status;
X
X  s1_desc.dsc$w_length = strlen(s1);
X  s1_desc.dsc$a_pointer = s1;
X
X  status = cli$get_value(&s1_desc,&s2_desc);
X
X  if (status & 1)
X    {
X    str$append(&s2_desc,&null_desc);
X    *s2 = s2_desc.dsc$a_pointer;
X    }
X  else
X    *s2 = 0;
X  return(status);
X}
X
Xprocess_command_line()
X{
X  long int status,boss_len;
X  short int length;
X  $DESCRIPTOR(d_line,buf);
X  $DESCRIPTOR(d_cldline,buf);
X  $DESCRIPTOR(d_boss_term,"BOSS$TERM");
X  $DESCRIPTOR(d_lnm_file_dev,"LNM$FILE_DEV");
X
X  strcpy(buf,"BOSS ");
X  boss_len = strlen(buf);
X  d_line.dsc$w_length =  d_line.dsc$w_length - boss_len;
X  d_line.dsc$a_pointer = d_line.dsc$a_pointer + boss_len;
X  check(lib$get_foreign(&d_line,0,&length,0));
X  buf[length + boss_len] = '\0';
X  d_cldline.dsc$w_length = length + boss_len;
X  status = cli$dcl_parse(&d_cldline,BOSS_CLD,0,0,0);
X  if (bad(status)) exit(STS$K_ERROR+STS$M_INHIB_MSG);
X
X  status = cli_get_value("COMMAND_CHARACTER",&retval);
X  if (bad(status)) ctlchar = 034;
X  else sscanf(retval,"%d",&ctlchar);
X  if (ctlchar < 0 || ctlchar > 0177 || ctlchar == 032) {
X    printf("[Illegal command character (%d); using C-\\ instead]\n",ctlchar);
X    ctlchar = 034;
X`009`009`009`009/* disallow C-z as a command character */
X  }
X  if (ctlchar < 040) sprintf(ctlchar_str,"C-%c",tolower(ctlchar+0100));
X  else if (ctlchar == 040) strcpy(ctlchar_str,"SPC");
X  else if (ctlchar == 0177) strcpy(ctlchar_str,"DEL");
X  else sprintf(ctlchar_str,"%c",ctlchar);
X
X  status = cli_get_value("BEGIN_PROMPT",&retval);
X  if (bad(status)) strcpy(prompt_begin,"");
X  else strcpy(prompt_begin,retval);
X
X  status = cli_get_value("END_PROMPT",&retval);
X  if (bad(status)) strcpy(prompt_end,"");
X  else strcpy(prompt_end,retval);
X
X  status = cli_get_value("DEFAULT_OUTPUT_FLAG",&retval);
X  if (bad(status)) defmode = 'b';
X  else defmode = tolower(retval[0]);
X
X  status = cli_present("SWITCH_CREATE");
X  switch_create = !bad(status);
X
X  status = cli_present("FLOW_CONTROL");
X  flow_control = !bad(status);
X
X  status = cli_get_value("DELETE_CHARACTER",&retval);
X  if (bad(status)) delete_char = 0177;
X  else sscanf(retval,"%d",&delete_char);
X  if (delete_char < 0 || delete_char > 0177) {
X    printf("[Illegal delete character (%d); using DEL instead]\n",delete_char);
X    ctlchar = 0177;
X  }
X
X  status = SYS$TRNLNM(0,&d_lnm_file_dev,&d_boss_term,0,&trnlnm_item);
X  if (bad(status)) strcpy(trnlnm_string,"VT100");
X  else trnlnm_string[trnlnm_string_len] = '\0';
X  if (trnlnm_string[0] == 'V') { /* VT100 */
X    clr = "\033[r\033[4l\033[H\033[2J"; /* Clear screen reset scroll */
X    bos = "\033[r\033[4l\033[99;1H\n"; /* Go to bottom of screen */
X    ceol = "\033[K";`009`009/* Clear to end-of-line */
X    ceoln = "\033[K\r\n";`009/* Clear to end-of-line and newline */
X  } else if (trnlnm_string[0] == 'A') { /* ADM3A */
X    clr = "\032";
X    bos = "\033=7 \n";
X    ceol = "   \010\010\010";
X    ceoln = "   \r\n";
X  } else {`009`009`009/* UNKNOWN */
X    clr = "\r\n";
X    bos = "\r\n";
X    ceol = "";
X    ceoln = "\r\n";
X  }
X}
X
Xint start_up()
X{
X  long int status,j,n;
X  char nname[30], output_flags[30], stuff_flag, odefmode;
X
X  cur = -1;
X  input_state = PENDING;
X  init = 1;
X
X  status = cli_present("START_PROCESS");
X  if (!bad(status)) {
X    stuff_flag = 1;
X    j = 0;
X    while (j < 30 && !bad(cli_get_value("START_PROCESS",&retval))) {
X      if (strlen(retval) != 1) break;
X      nname[j] = toupper(retval[0]);
X      if (nname[j] < 'A' && nname[j] > 'Z') break;
X      j++;
X    }
X    n = j;
X    j = 0;
X    while (j < n && !bad(cli_get_value("OUTPUT_FLAGS",&retval))) {
X      output_flags[j] = tolower(retval[0]);
X      j++;
X    }
X    while (j < n) {
X      output_flags[j] = defmode;
X      j++;
X    }
X    for (j = 0; j < n; j++) {
X      if (stuff_flag) {
X`009status = cli_get_value("STUFF_STRING",&retval);
X`009if (bad(status)) {
X`009  stuff_flag = 0;
X`009  strcpy(stuff_buf,"");
X`009} else {
X`009  strcpy(stuff_buf,retval);
X`009  if (strlen(retval) > 0) strcat(stuff_buf,"\015");
X`009}
X      }
X      odefmode = defmode;
X      defmode = output_flags[j];
X      status = mov_to(nname[j],0,stuff_buf,CREATE);
X      defmode = odefmode;
X      if (bad(status)) break;
X      input_state = NORMAL;
X    }
X  }
X  init = 0;
X  for (j = 0; j < nproc; j++) if (name[j] > 0) post_pty_reads(j);
X}
X
Xmain( )
X{
X  int  exit_handler[4] = {0,quit,0,&st};
X
X  process_command_line();
X  check(SYS$DCLEXH(&exit_handler)); /* Define Exit handler (quit) */
X  if (ctlchar < 040)
X    printf("Begin BOSS %s\nType control-%c control-h for information\n",
X`009   VERSION,tolower(ctlchar+0100));
X  else
X        printf("Begin BOSS %s\nType %s control-h for information\n",
X`009   VERSION,ctlchar_str);
X  initialize();
X  sys$hiber();
X}
$ GOSUB UNPACK_FILE
$ FILE_IS = "BOSS_CLD.CLD"
$ CHECKSUM_IS = 1913354040
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
Xmodule boss_cld
Xdefine verb boss
X`009qualifier command_character, nonnegatable, default,
X`009`009value(default="28",type=$number)
X`009qualifier delete_character, nonnegatable, default,
X`009`009value(default="127",type=$number)
X`009qualifier start_process, nonnegatable,
X`009`009value(required,list)
X`009qualifier stuff_string, nonnegatable,
X`009`009value(required,list)
X`009qualifier output_flags, nonnegatable,
X`009`009value(required,list,type=output_flag)
X`009qualifier begin_prompt, negatable,
X`009`009value
X`009qualifier end_prompt, negatable, default,
X`009`009value(default="> ")
X`009qualifier default_output_flag, nonnegatable, default,
X`009`009value(type=output_flag)
X`009qualifier switch_create, negatable
X`009qualifier flow_control, negatable
X
Xdefine type output_flag
X`009keyword b, default
X`009keyword o
X`009keyword p
X`009keyword w
$ GOSUB UNPACK_FILE
$ FILE_IS = "BOSS_BUILD.COM"
$ CHECKSUM_IS = 855795594
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$! Procedure for compiling and linking BOSS.
X$!
X$ cc boss
X$ set command/object boss_cld
X$ link/notraceback boss,boss_cld,sys$input/opt
Xsys$library:vaxcrtl/share
$ GOSUB UNPACK_FILE
$ FILE_IS = "BOSS_INSTALL.COM"
$ CHECKSUM_IS = 1029728184
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$! Procedure for installing BOSS.  This goes into the system startup file.
X$!
X$ boss_dir = "usr:[utility]"`009! Edit to point to where BOSS.EXE resides
X$ install = "$install/command_mode"
X$ if  f$file("''boss_dir'boss.exe","known") then install delete 'boss_dir'boss
X$ install create 'boss_dir'boss/priv=(phy_io,oper)/header/open/shared
$ GOSUB UNPACK_FILE
$ EXIT
-+-+-+-+-+ End of part 4 +-+-+-+-+-