Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume7/vms_tools/part02

Internet Message Format | 1986-12-02 | 45.9 KB

Subject:  v07i070:  Unix-like tools for VMS systems, Part02/02
Newsgroups: mod.sources
Approved: mirror!rs

Submitted by: David Albrecht <calmasd![e-mail]>
Mod.sources: Volume 7, Issue 70
Archive-name: vms_tools/Part02

#!/bin/sh
#
# The following files are VMS C programs which will
# interface with VMS to provide some unix-like capabilities.
# One file, (unixlike) gives a simplistic introduction to the
# tools in 'roff format.
#
# Most of the files are well documented in comments at the
# beginning as to their function and are totally stand alone.
#
# The file cd.com is a DCL script for the CD command under
# VMS for those people who don't possess the C compiler.
#
# The file reset is a one line symbol definition which should
# be added to a symbol definition file (ala. login.com) to add
# a command (RESET) which will reset the JOB tracking system when
# it goes astray.
#
# David Albrecht
#
#
echo 'Start of vms, part 01 of 02:'
echo 'x - jobs.c'
sed 's/^X//' > jobs.c << '/'
X/*
X    jobs - David C. Albrecht 4/4/86
X
X    jobs provides a facility for printing the status of jobs issued
X    into the background by the E(x)tend utility.  It will also
X    update the status of finished jobs and print completion for
X    when the mode is not set to immediate notify.
X*/
X
X#define MAXSTRING 256
X#define NULL 0
X
X/*
X    vms interface files
X*/
X#include <rms.h>
X#include <stdio.h>
X#include <stsdef.h>
X#include <ssdef.h>
X#include <descrip.h>
X
X/* descriptors for passing to vms commands */
Xstruct dsc$descriptor_s desc,desc1;
X
Xmain (argc,argv)
X    int argc;
X    char **argv;
X
X{   int i;
X    int next_job;    /* subprocess number of job */
X    int job_status;    /* flag for existence of job_status symbol */
X    char str[MAXSTRING];/* multi-purpose:
X                get job_status symbol value
X                get job logical value
X            */
X    char jobstr[15];    /* current bg jobs indicator string */
X    char joblogical[15];/* name of individual job logical */
X
X    /*
X    get background job process string
X    */
X    if (job_status = getsymbol("JOB_STATUS",str)) {
X    /*
X        update any completed background jobs
X    */
X    strcpy(jobstr,str);
X    update_job_status(jobstr,&next_job);
X    }
X    else {
X    *jobstr = '\0';
X    next_job = 1;
X    }
X    /*
X    there is an 'X' in the job status string for all background
X    jobs currently still outstanding
X    */
X    for (i = 0; i < strlen(jobstr); i++) {
X    if (jobstr[i] != ' ') {
X        /*
X        each job maintains a JOB_'number' logical which
X        indicates current execute status of the job
X        */
X        sprintf(joblogical,"JOB_%d",i+1);
X        getlogical(joblogical,str);
X        /*
X        print the job execute status
X        */
X        printf("[%d] %s\n",i+1,str);
X    }
X    }
X    /*
X    set or delete updated job process string
X    */
X    if (*jobstr) {
X    setsymbol("JOB_STATUS",jobstr);
X    }
X    else if (job_status) {
X    delsymbol("JOB_STATUS");
X    }
X}
X/*
X    dellogical
X    delete a logical from the job space
X*/
Xdellogical(logical_name)
Xchar *logical_name;
X{
X
X    setdesc(&desc,logical_name,strlen(logical_name));
X    lib$delete_logical(&desc,0);
X}
X/*
X    delsymbol
X    delete a symbol from the global table
X*/
Xdelsymbol(symbol_name)
Xchar *symbol_name;
X{   int tbl;
X
X    setdesc(&desc,symbol_name,strlen(symbol_name));
X    tbl = 2;
X    lib$delete_symbol(&desc,&tbl);
X}
X/*
X    getlogical
X    get a logical's translation
X*/
Xgetlogical(logical_name,value)
Xchar *logical_name,*value;
X{   int valuelen;
X
X    setdesc(&desc,logical_name,strlen(logical_name));
X    setdesc(&desc1,value,MAXSTRING-1);
X    valuelen = 0;
X    lib$sys_trnlog(&desc,&valuelen,&desc1,0,0,0);
X    value[valuelen] = '\0';
X    if (!strcmp(logical_name,value)) {
X    return(0);
X    }
X    return(1);
X
X}
X
X/*
X    getsymbol
X    get a symbol's value
X*/
Xgetsymbol(symbol_name,value)
Xchar *symbol_name,*value;
X{   int valuelen,status;
X
X    setdesc(&desc,symbol_name,strlen(symbol_name));
X    setdesc(&desc1,value,MAXSTRING-1);
X    valuelen = 0;
X    status = lib$get_symbol(&desc,&desc1,&valuelen,0);
X    if (status & STS$M_SUCCESS) {
X    value[valuelen] = '\0';
X    return(1);
X    }
X    else {
X    return(0);
X    }
X}
X
X/*
X    setdesc
X    set a descriptor entry for a standard ascii string
X*/
Xsetdesc(descr,str,strlen)
Xstruct dsc$descriptor_s *descr;
Xchar *str;
Xint strlen;
X{
X    descr->dsc$w_length = strlen;
X    descr->dsc$a_pointer = str;
X    descr->dsc$b_class = DSC$K_CLASS_S;    /* String desc class */
X    descr->dsc$b_dtype = DSC$K_DTYPE_T;    /* Ascii string type */
X}
X
X/*
X    setsymbol
X    set a symbol in the global space
X*/
Xsetsymbol(symbol_name,value)
Xchar *symbol_name,*value;
X{   int tbl;
X
X    setdesc(&desc,symbol_name,strlen(symbol_name));
X    setdesc(&desc1,value,strlen(value));
X    tbl = 2;
X    lib$set_symbol(&desc,&desc1,&tbl);
X}
X/*
X    update_job_status
X    update the status of any completed background jobs.
X    print completion code to the screen for any non-immediate
X    notification style jobs.
X*/
Xupdate_job_status(active_jobs,next_job)
Xchar *active_jobs;
Xint *next_job;
X{   int i;
X    char joblogical[MAXSTRING],status_info[MAXSTRING],*active;
X
X    /*
X    there is an 'X' in the active_jobs string for all background
X    jobs currently outstanding.
X    */
X    for (i = 0; i < strlen(active_jobs); i++) {
X    if (active_jobs[i] != ' ') {
X        /*
X        each job maintains a JOB_'number' logical which
X        indicates current execute status of the job
X        */
X        sprintf(joblogical,"JOB_%d",i+1);
X        getlogical(joblogical,status_info);
X        /*
X        a symbol prefaced with DONE means the job is complete
X        */
X        if (!strncmp(status_info,"DONE",4)) {
X        if (strcmp(status_info,"DONE")) {
X            /*
X            if DONE is followed by additional info then
X            the job was not immediately notified so its
X            completion is signaled now
X            */
X            printf("[%d] %s\n",i+1,status_info);
X        }
X        /*
X            remove the completed job's logical
X        */
X        dellogical(joblogical);
X        /*
X            remove the active indicator from the active_jobs
X        */
X        active_jobs[i] = ' ';
X        }
X    }
X    }
X    /*
X    update active_jobs string to remove trailing blanks
X    */
X    active = active_jobs + strlen(active_jobs) - 1;
X    while (active >= active_jobs && *active == ' ') *(active--) = '\0';
X    /*
X    set number of next_job sub process
X    */
X    *next_job = strlen(active_jobs)+1;
X}
X/*
X    upshift
X    uppercase a character string
X*/
Xupshift(upname,lwname)
Xchar *upname,*lwname;
X{
X    while (*(upname++) = toupper(*(lwname++)));
X}
X
/
echo 'x - kill.c'
sed 's/^X//' > kill.c << '/'
X/*
X    kill - David C. Albrecht 8/20/86
X
X    kill provides a facility for aborting jobs issued
X    into the background by the E(x)tend utility.  It will also
X    update the status of finished jobs and print completion for
X    when the mode is not set to immediate notify.
X*/
X
X#define MAXSTRING 256
X#define NULL 0
X
X/*
X    vms interface files
X*/
X#include <rms.h>
X#include <stdio.h>
X#include <stsdef.h>
X#include <ssdef.h>
X#include <descrip.h>
X
X/* descriptors for passing to vms commands */
Xstruct dsc$descriptor_s desc,desc1;
X
Xmain (argc,argv)
X    int argc;
X    char **argv;
X
X{   int i;
X    int next_job;    /* subprocess number of job */
X    int job_status;    /* flag for existence of job_status symbol */
X    char str[MAXSTRING];/* multi-purpose:
X                get job_status symbol value
X                get job logical value
X            */
X    char jobstr[15];    /* current bg jobs indicator string */
X    char joblogical[15];/* name of individual job logical */
X    long pid1, pid2;    /* process id variables */
X
X    /*
X    get background job process string
X    */
X    if (job_status = getsymbol("JOB_STATUS",str)) {
X    /*
X        update any completed background jobs
X    */
X    strcpy(jobstr,str);
X    update_job_status(jobstr,&next_job);
X    }
X    else {
X    *jobstr = '\0';
X    next_job = 1;
X    }
X    /*
X    there is an 'X' in the job status string for all background
X    jobs currently still outstanding
X    */
X    if (!argv[1]) {
X    fprintf(stderr, "kill {pid | %jobno}\n");
X    exit(1);
X    }
X    if (*argv[1] == '%') {
X    if (sscanf(argv[1] + 1, "%d", &i) < 1) {
X        fprintf(stderr, "kill {pid | %jobno}\n");
X        exit(1);
X    }
X    if (i <= strlen(jobstr) && jobstr[i - 1] != ' ') {
X        /*
X        each job maintains a JOB_'number' logical which
X        indicates current execute status of the job
X        */
X        sprintf(joblogical,"JOB_%d",i);
X        getlogical(joblogical,str);
X        /*
X        kill the job and update the job status string
X        */
X        kill_pid(str);
X        jobstr[i - 1] = ' ';
X        printf("[%d] %s killed\n", i, str);
X    }
X    else {
X        printf("%s not found\n", argv[1]);
X    }
X    }
X    else {
X    if (sscanf(argv[1], "%lx", &pid1) < 1) {
X        fprintf(stderr, "invalid pid %s\n", argv[1]);
X        exit(1);
X    }
X    for (i = 0; i < strlen(jobstr); i++) {
X        if (jobstr[i] != ' ') {
X        /*
X            each job maintains a JOB_'number' logical which
X            indicates current execute status of the job
X        */
X        sprintf(joblogical,"JOB_%d",i+1);
X        getlogical(joblogical,str);
X        if (sscanf(str, "%lx", &pid2) >= 1) {
X            if (pid1 == pid2) {
X            jobstr[i] = ' ';
X            break;
X            }
X        }
X        }
X    }
X    kill_pid(argv[1]);
X    if (i < strlen(jobstr)) {
X        printf("[%d] %s killed\n", i + 1, str);
X    }
X    else {
X        printf("%s killed\n", argv[1]);
X    }
X    }
X    /*
X    set or delete updated job process string
X    */
X    if (*jobstr) {
X    setsymbol("JOB_STATUS",jobstr);
X    }
X    else if (job_status) {
X    delsymbol("JOB_STATUS");
X    }
X}
X/*
X    dellogical
X    delete a logical from the job space
X*/
Xdellogical(logical_name)
Xchar *logical_name;
X{
X
X    setdesc(&desc,logical_name,strlen(logical_name));
X    lib$delete_logical(&desc,0);
X}
X/*
X    delsymbol
X    delete a symbol from the global table
X*/
Xdelsymbol(symbol_name)
Xchar *symbol_name;
X{   int tbl;
X
X    setdesc(&desc,symbol_name,strlen(symbol_name));
X    tbl = 2;
X    lib$delete_symbol(&desc,&tbl);
X}
X/*
X    getlogical
X    get a logical's translation
X*/
Xgetlogical(logical_name,value)
Xchar *logical_name,*value;
X{   int valuelen;
X
X    setdesc(&desc,logical_name,strlen(logical_name));
X    setdesc(&desc1,value,MAXSTRING-1);
X    valuelen = 0;
X    lib$sys_trnlog(&desc,&valuelen,&desc1,0,0,0);
X    value[valuelen] = '\0';
X    if (!strcmp(logical_name,value)) {
X    return(0);
X    }
X    return(1);
X
X}
X
X/*
X    getsymbol
X    get a symbol's value
X*/
Xgetsymbol(symbol_name,value)
Xchar *symbol_name,*value;
X{   int valuelen,status;
X
X    setdesc(&desc,symbol_name,strlen(symbol_name));
X    setdesc(&desc1,value,MAXSTRING-1);
X    valuelen = 0;
X    status = lib$get_symbol(&desc,&desc1,&valuelen,0);
X    if (status & STS$M_SUCCESS) {
X    value[valuelen] = '\0';
X    return(1);
X    }
X    else {
X    return(0);
X    }
X}
X
X/*
X    killpid
X    kill a process id specified by a hex number string
X*/
Xkill_pid(str)
Xchar *str;
X{   long pid;
X    int i;
X
X    if (sscanf(str, "%lx", &pid) < 1) {
X    fprintf(stderr, "invalid process id %s\n", str);
X    exit(1);
X    }
X    i = SYS$DELPRC(&pid,0);
X    switch (i) {
X
X    case SS$_NORMAL:
X        break;
X
X    case SS$_ACCVIO:
X        fprintf(stderr, "access violation, process not killed\n");
X        exit(1);
X
X    case SS$_NONEXPR:
X        fprintf(stderr, "invalid process specification, process not killed\n");
X        exit(1);
X
X    case SS$_NOPRIV:
X        fprintf(stderr, "no privledge for attempted operation, process not killed\n");
X        exit(1);
X
X    default:
X        fprintf(stderr, "error killing process, return = %d, process not killed",i);
X        exit(1);
X
X    }
X}
X/*
X    setdesc
X    set a descriptor entry for a standard ascii string
X*/
Xsetdesc(descr,str,strlen)
Xstruct dsc$descriptor_s *descr;
Xchar *str;
Xint strlen;
X{
X    descr->dsc$w_length = strlen;
X    descr->dsc$a_pointer = str;
X    descr->dsc$b_class = DSC$K_CLASS_S;    /* String desc class */
X    descr->dsc$b_dtype = DSC$K_DTYPE_T;    /* Ascii string type */
X}
X
X/*
X    setsymbol
X    set a symbol in the global space
X*/
Xsetsymbol(symbol_name,value)
Xchar *symbol_name,*value;
X{   int tbl;
X
X    setdesc(&desc,symbol_name,strlen(symbol_name));
X    setdesc(&desc1,value,strlen(value));
X    tbl = 2;
X    lib$set_symbol(&desc,&desc1,&tbl);
X}
X/*
X    update_job_status
X    update the status of any completed background jobs.
X    print completion code to the screen for any non-immediate
X    notification style jobs.
X*/
Xupdate_job_status(active_jobs,next_job)
Xchar *active_jobs;
Xint *next_job;
X{   int i;
X    char joblogical[MAXSTRING],status_info[MAXSTRING],*active;
X
X    /*
X    there is an 'X' in the active_jobs string for all background
X    jobs currently outstanding.
X    */
X    for (i = 0; i < strlen(active_jobs); i++) {
X    if (active_jobs[i] != ' ') {
X        /*
X        each job maintains a JOB_'number' logical which
X        indicates current execute status of the job
X        */
X        sprintf(joblogical,"JOB_%d",i+1);
X        getlogical(joblogical,status_info);
X        /*
X        a symbol prefaced with DONE means the job is complete
X        */
X        if (!strncmp(status_info,"DONE",4)) {
X        if (strcmp(status_info,"DONE")) {
X            /*
X            if DONE is followed by additional info then
X            the job was not immediately notified so its
X            completion is signaled now
X            */
X            printf("[%d] %s\n",i+1,status_info);
X        }
X        /*
X            remove the completed job's logical
X        */
X        dellogical(joblogical);
X        /*
X            remove the active indicator from the active_jobs
X        */
X        active_jobs[i] = ' ';
X        }
X    }
X    }
X    /*
X    update active_jobs string to remove trailing blanks
X    */
X    active = active_jobs + strlen(active_jobs) - 1;
X    while (active >= active_jobs && *active == ' ') *(active--) = '\0';
X    /*
X    set number of next_job sub process
X    */
X    *next_job = strlen(active_jobs)+1;
X}
X/*
X    upshift
X    uppercase a character string
X*/
Xupshift(upname,lwname)
Xchar *upname,*lwname;
X{
X    while (*(upname++) = toupper(*(lwname++)));
X}
X
/
echo 'x - pushd.c'
sed 's/^X//' > pushd.c << '/'
X#define NULL 0
X#define MAXSTRING 132
X
X#include <rms.h>
X#include <stdio.h>
X#include <stsdef.h>
X#include <ssdef.h>
X#include <descrip.h>
X
Xstruct dsc$descriptor_s desc,desc1;
X
Xmain (argc,argv)
X    int argc;
X    char **argv;
X
X{   char curdir[MAXSTRING],testdir[MAXSTRING],todir[MAXSTRING];
X    char *p1,*dirspec,*strpos();
X    int i;
X
X    if (argc <= 1) {
X    getlogical("SYS$LOGIN",todir);
X    if (save_and_chdir(todir,1)) {
X        invalid_dirspec(todir);
X        return(1);
X    }
X    }
X    else {
X    p1 = argv[1];
X    if (strchr(p1,'[')
X     || strpos(p1,"..")
X     || strchr(p1,'/')) {
X        if (save_and_chdir(p1,1)) {
X        invalid_dirspec(p1);
X        return(1);
X        }
X    }
X    else if (getlogical(p1,todir)) {
X        if (save_and_chdir(p1,1)) {
X        invalid_dirspec(p1);
X        return(1);
X        }
X    }
X    else {
X        dirspec = strrchr(p1,':');
X        if (!dirspec) {
X        *todir = '\0';
X        dirspec = p1;
X        }
X        else {
X        i = dirspec-p1+1;
X        strncpy(todir,p1,i);
X        todir[i]='\0';
X        dirspec++;
X        }
X        strcat(todir,"[");
X        if (*dirspec != '.'
X         && *dirspec != '-'
X         && dirspec == p1) strcat(todir,".");
X        strcat(todir,dirspec);
X        strcat(todir,"]");
X        if (save_and_chdir(todir,1)) {
X        invalid_dirspec(todir);
X        return(1);
X        }
X    }
X    }
X}
Xgetlogical(logical_name,value)
Xchar *logical_name,*value;
X{   int valuelen;
X    char cap_name[MAXSTRING];
X
X    upshift(cap_name,logical_name);
X    setdesc(&desc,cap_name,strlen(cap_name));
X    setdesc(&desc1,value,MAXSTRING-1);
X    valuelen = 0;
X    lib$sys_trnlog(&desc,&valuelen,&desc1,0,0,0);
X    value[valuelen] = '\0';
X    if (!strcmp(cap_name,value)) {
X    return(0);
X    }
X    return(1);
X
X}
Xgetsymbol(symbol_name,value)
Xchar *symbol_name,*value;
X{   int valuelen,status;
X
X    setdesc(&desc,symbol_name,strlen(symbol_name));
X    setdesc(&desc1,value,MAXSTRING-1);
X    valuelen = 0;
X    status = lib$get_symbol(&desc,&desc1,&valuelen,0);
X    if (status & STS$M_SUCCESS) {
X    value[valuelen] = '\0';
X    return(1);
X    }
X    else {
X    return(0);
X    }
X}
Xgetwd(pwd)
Xchar *pwd;
X{   int pwdlen;
X
X    setdesc(&desc,pwd,MAXSTRING-1);
X    pwdlen = 0;
X    sys$setddir(0,&pwdlen,&desc);
X    pwd[pwdlen] = '\0';
X}
Xinvalid_dirspec(dirspec)
Xchar *dirspec;
X{
X    fprintf(stderr,"invalid directory %s\n",dirspec);
X}
Xsetdesc(descr,str,strlen)
Xstruct dsc$descriptor_s *descr;
Xchar *str;
Xint strlen;
X{
X    descr->dsc$w_length = strlen;
X    descr->dsc$a_pointer = str;
X    descr->dsc$b_class = DSC$K_CLASS_S;    /* String desc class */
X    descr->dsc$b_dtype = DSC$K_DTYPE_T;    /* Ascii string type */
X}
Xsetlogical(logical_name,value)
Xchar *logical_name,*value;
X{   char cap_name[MAXSTRING];
X
X    upshift(cap_name,logical_name);
X    setdesc(&desc,cap_name,strlen(cap_name));
X    setdesc(&desc1,value,strlen(value));
X    lib$set_logical(&desc,&desc1,0);
X}
Xsetsymbol(symbol_name,value)
Xchar *symbol_name,*value;
X{   int tbl;
X
X    setdesc(&desc,symbol_name,strlen(symbol_name));
X    setdesc(&desc1,value,strlen(value));
X    tbl = 2;
X    lib$set_symbol(&desc,&desc1,&tbl);
X}
Xupshift(upname,lwname)
Xchar *upname,*lwname;
X{
X    while (*(upname++) = toupper(*(lwname++)));
X}
Xsave_and_chdir(todir,permanent_flag)
Xchar *todir;
Xint permanent_flag;
X{   char pushstack[MAXSTRING],oldstack[MAXSTRING];
X    int i;
X
X    getlogical("SYS$DISK",pushstack);
X    getwd(pushstack+strlen(pushstack));
X    if (i = chdir(todir,permanent_flag)) {
X    return(i);
X    }
X    printf("%s\n",pushstack);
X    if (getlogical("dir_stack",oldstack)) {
X    strcat(pushstack,",");
X    strcat(pushstack,oldstack);
X    }
X    setlogical("dir_stack",pushstack);
X    return(i);
X}
Xchar *strpos(str,searchstr)
Xchar *str,*searchstr;
X{   char *matchc,c,*matchstr;
X
X    matchc = searchstr;
X    c = *matchc++;
X    while (c) {
X    if (!*str) {
X        return(NULL);
X    }
X    else {
X        matchstr = str++;
X        while (c == *matchstr && *matchstr++) {
X        c = *matchc++;
X        }
X        if (!c) {
X         return(str - 1);
X        }
X        matchc = searchstr;
X        c = *matchc++;
X    }
X    }
X    return(NULL);
X}
/
echo 'x - reset'
sed 's/^X//' > reset << '/'
XRESET :== "DELETE/SYM/GLOB JOB_STATUS"
/
echo 'x - unixlike'
sed 's/^X//' > unixlike << '/'
X.so macs.txt
X
X.sp 10
X.(l C
XUNIX-LIKE TOOLS
XAVAILABLE FROM VMS
X.sp 2
X\*(td
X.)l
X.fi
X.bp
X.sh  1 "CD"
X.pp
XThe Unix change directory command's most attractive feature is that
Xit checks target directorys.  This CD command will not only check
Xtarget directories but also allow some limited specification of
Xpaths in Unix format as well as VMS format.  In vms format the
Xbrackets around the directory specification can by omitted.  It
Xwill even change to a VMS logical.
X.sh 2 "PUSHD/POPD"
X.pp
XPUSHD just as in Unix is an extension to CD which saves the current
Xdirectory on a directory stack.  POPD is the symmetrical tool
Xwhich provides the facility to return to the \&'pushed' directory.
X.sh 3 "CDPATH's"
X.pp
XA CDPATH is a path of directories under UNIX which the user can
Xspecify.  The CD command will search these directories for your
Xtarget directory.  A facility which approximates these capabilities
Xhas been provided under VMS which actually gives some additional
Xcapabilities.  Define a symbol called \&'CDPATH' in the DCL
Xshell which is a list of blank separated VMS directories.
XInvoking the CDHASH program will search these directories and
Xdefine a logical for each subdirectory the value of which is
Xthe full path location.  CD'ing to a directory from anywhere
Xin the system thus becomes a matter of typing the subdirectory name.
XThe additional capabilities this provides are that this symbol is
Xa true logical and thus can also be supplied to a directory command
Xor used as a preface to a file name.
X.sh 4 "E(X)TEND"
X.pp
XExtend provides a capability for a user to run from the standard DCL
Xshell and yet extend to some Unix-like advanced capabilities when
Xnecessary.  Extend provides the capability for easy i/o redirection,
Xpipes, backgrounding, and multiple command entry from one command line.
XExtend is invoked by simply typing \&'x' followed by a list of dcl
Xcommands mixed with extended command characters.
X.ip "input redirection"
XInput can be obtained from files on the system through the use of
Xthe \&'< file' command.  This command works by both assigning sys$input and
Xpas$input and specifing the file name as the last parameter to the command.
XA unix mode \&'-u' for extend will eliminate the file specification.  This works
Xin most cases but not always.
X.ip "output redirection"
XOutput can be diverted to a file on the system through the use of the
X\&'> file' command.  This command will divert sys$output and pas$output
Xto the file.
X.ip "pipes"
XTwo commands can have their outputs and inputs connected through the
Xpipe construct \&'|'.  The effect is to do an output redirection on
Xthe source process and a input redirection on the target process
Xso again, the input redirection is not guaranteed to work.  Pipes differ
Xin that they use mailboxes for the connection, not files.
X.ip "standard error"
XMany times you want to divert both sys$output and sys$error.  In Unix,
Xstderr holds only error messages and stdout has the rest.  In VMS,
Xsys$output is basically a superset of sys$error.  Therefore, while
X\&'>&' and \&'|&' to divert both sys$output and sys$error are supported,
Xthe effect is to divert sys$output and send sys$error to the null
Xdevice.
X.ip "multiple commands"
XMultiple commands on a line may be simply specified by separating them
Xby semicolons ';'.
X.ip "backgrounding"
XYou can background a command by simply following the command specification
Xby a \&'&'.  To check the status of the command there is a separate command
X\&'jobs' which will show the status of background processes.
XAborting the execution of the command is possible using the
X\&'kill' command.  \&'kill' takes one argument, either the
Xprocess id to kill or the job number preceeded by a \&'%'.
XYou can select whether you want immediate notification of process
Xcompletion or only when executing the \&'jobs', \&'kill'
Xor \&'x' commands,
Xset a logical called 'notify' in the DCL shell to any value if
Xyou want immediate notification.
X.ip "grouping"
XYou can group commands so that an i/o redirection will apply
Xto the entire sequence of commands by surrounding the commands with
Xparentheses and following the parentheses with the redirection
Xcommands.
X.ip "quoting"
XIf you want to pass one of these special characters to the DCL shell,
Xsuch as \&';' for a version number, you must 'quote' it by preceeding
Xit with the \&'\' character.
/
echo 'x - x.c'
sed 's/^X//' > x.c << '/'
X/*
X
X    e(x)tend - David C. Albrecht 4/4/86
X
X    Extend is called from the VMS shell and provides some of the
X    functionality Unix (TM), namely i/o redirection, pipes and back-
X    grounding of processes.  Normally the user won't need these facilities
X    and can thus run in the more efficient vanilla VMS environment.  It is
X    quite simple, however, when the need for the extensions arises to
X    invoke extend for one extended command.
X
X    Extend supports:
X
X    i/o redirection:
X        >    redirect sys$output to a file.
X        <    get sys$input from a file AND put the file name as
X        the last parameter of the next invoked routine.
X        >&  redirect sys$output to a file and send sys$error to
X        the null device.
X
X    pipes:
X        |   spawn two processes and attach a mailbox between them.
X        works like > for the source process and like < for the
X        receiving process.
X        |&    spawn two processes and attach a mailbox between them.
X        works like >& for the source process and like < for the
X        receiving process.
X
X    multiple commands per line:
X        ;   a semicolon will separate multiple commands which are
X        to be processed serially.
X
X    backgrounding of processes:
X        &   will indicate that the preceeding command sequence is
X        to be placed to run in the background.  & also acts
X        as a command separator.
X
X    process grouping
X        ()    will group jobs so that the previous commands will
X        apply to them as a group.
X
X    all these characters are treated as above unless escaped by a preceeding
X    backslash character (\).
X
X    A companion program (jobs) is available which will display current
X    status of a background process.
X
X    Note that two modes for background jobs is available:
X
X    If a logical named 'notify' is defined in the DCL shell.
X        The subprocess will signal completion immediately by
X        writing a completion message to the terminal.
X
X    If the logical is not set then.
X        The subprocess will complete silently and completion
X        will be signalled to the user when he runs either
X        jobs or extend.
X
X*/
X
X#define NULL        0
X#define SHORT_STR    40
X#define MAXSTRING    150    /* max single comand size */
X#define MAXCMDS        20    /* max vms commands in one extend command */
X/*
X    flag bits for a command
X    and character process modes
X*/
X#define ARGUMENT    0
X#define IN_FILE        1
X#define OUT_FILE    2
X#define PIPE_IN        4
X#define PIPE_OUT    8
X#define BG        16
X#define ERROR_OUT    32
X#define CLEAR_IN    64
X#define CLEAR_OUT    128
X#define CLEAR_ERROR    256
X/*
X    spawn command flag bits
X*/
X#define NO_WAIT 0x1
X#define NOTIFY 0x10
X/*
X    vms interface files
X*/
X#include <rms.h>
X#include <stdio.h>
X#include <stsdef.h>
X#include <ssdef.h>
X#include <descrip.h>
X
XFILE *comfile;    /* file variable for VMS com file */
X
X/* descriptors for passing to vms commands */
Xstruct dsc$descriptor_s desc,desc1;
X
X/*
X    command description record
X*/
Xstruct cmd_desc_type {
X    int state;        /* flag word indicating various info, see above */
X    char *arg_str;    /* text of vms command */
X    char *input;    /* input file */
X    char *output;    /* output file */
X    } cmd_desc[MAXCMDS];
X
Xint cmd_cnt;        /* number of vms commands */
X
Xint paren_in_process = -1;    /* cmd_cnt number for beginning of
X                    paren block in process */
X
Xmain (argc,argv)
X    int argc;
X    char **argv;
X
X{   int i,j;
X    int unix = FALSE;    /* unix style */
X    int keep_comfile = FALSE;    /* delete comfile after execution */
X    int flags;        /* flags to lib$spawn */
X    int pid;        /* current process id */
X    int job_sequence = FALSE;    /* flag indicating a serial job sequence */
X    int next_job;    /* subprocess number of job */
X    char str[MAXSTRING];    /* multi-purpose:
X                    extend arguments
X                    vms com file names
X                */
X    char exec_str[SHORT_STR];    /* com file execution text */
X    char jobstr[SHORT_STR];    /* current bg jobs indicator string */
X    char title[MAXSTRING];    /* text of title for current stage of
X                   background process
X                */
X    char job_title[MAXSTRING];    /* text of title for completed background
X                   process
X                */
X    int backgrounded_process = FALSE;    /* backgrounded process flag */
X
X    /*
X    get process id
X    */
X    pid = getpid();
X
X    /*
X    get background job process string
X    */
X    if (getsymbol("JOB_STATUS",str)) {
X    strcpy(jobstr,str);
X    /*
X        update any completed background jobs
X    */
X    update_job_status(jobstr,&next_job);
X    }
X    else {
X    *jobstr = '\0';
X    next_job = 1;
X    }
X    /*
X    set updated job process string
X    */
X    if (*jobstr) {
X    setsymbol("JOB_STATUS",jobstr);
X    }
X    else {
X    delsymbol("JOB_STATUS");
X    }
X
X    if (argc <= 1) exit(SS$_NORMAL);
X    /*
X    concatenate arguments into one string
X    */
X    *str = '\0';
X    i = 1;
X    if (!strcmp(argv[i],"-u")) {
X    i++;
X    unix = TRUE;
X    }
X    if (!strcmp(argv[i],"-k")) {
X    i++;
X    keep_comfile = TRUE;
X    }
X    for (; i < argc; i++) {
X    if (*str) {
X       strcat(str," ");
X    }
X    strcat(str,argv[i]);
X    }
X    /*
X    process string into commands
X    */
X    if (process_arg(str)) {
X    return(1);
X    }
X    /*
X    init flag for sequential sequence of commands
X    */
X    for (i = 0; i < cmd_cnt; i++) {
X    if (!job_sequence) {
X        /*
X        open a new VMS com file
X        */
X        sprintf(str,"SYS$LOGIN:EXE%0d%0d.COM",pid,i);
X        comfile = fopen(str, "w");
X        if (comfile == NULL) {
X        sprintf(str,"EXE%0d%0d.COM",pid,i);
X        comfile = fopen(str, "w");
X        if (comfile == NULL) {
X            fprintf(stderr,"unable to open process file %s\n",str);
X            return(1);
X        }
X        }
X        /*
X        error exit line
X        */
X        fprintf(comfile,"$ on error then goto exit\n");
X        /*
X        null the job completion title
X        */
X        *job_title = '\0';
X    }
X    else {
X        job_sequence = FALSE;
X    }
X    /*
X        set title to name of current vms command
X    */
X        strcpy(title,cmd_desc[i].arg_str);
X    /*
X       append names of following sequential vms commands
X    */
X    j = i + 1;
X    while (j < cmd_cnt && !(cmd_desc[j-1].state & BG)) {
X        strcat(title," ; ");
X        strcat(title,cmd_desc[j].arg_str);
X        j++;
X    }
X    /*
X       first time, save title as the job completion title
X    */
X    if (!*job_title) {
X        strcpy(job_title,title);
X    }
X    /*
X       if an asynchronous completing job then generate line to
X       update job status in the vms com file
X    */
X    if (cmd_desc[cmd_cnt - 1].state & BG) {
X        fprintf(comfile,
X            "$ define/job/nol JOB_%d \"''f$getjpi(0,\"PID\")' %s\"\n",
X            next_job,title);
X    }
X    /*
X       unredirect sys$input
X    */
X    if (cmd_desc[i].state & CLEAR_IN) {
X        fprintf(comfile,"$ deassign sys$input\n");
X        fprintf(comfile,"$ deassign pas$input\n");
X    }
X    /*
X       unredirect sys$output and sys$error
X    */
X    if (cmd_desc[i].state & CLEAR_OUT) {
X        fprintf(comfile,"$ deassign sys$output\n");
X        fprintf(comfile,"$ deassign pas$output\n");
X    }
X    if (cmd_desc[i].state & CLEAR_ERROR) {
X        fprintf(comfile,"$ deassign sys$error\n");
X    }
X    /*
X        redirect output streams for output pipes or files
X    */
X    if (cmd_desc[i].state & (OUT_FILE | PIPE_OUT)) {
X        fprintf(comfile,"$ define sys$output %s\n",cmd_desc[i].output);
X        fprintf(comfile,"$ define pas$output %s\n",cmd_desc[i].output);
X        /*
X        when sys$error is redirected throw it away by
X        sending it to the null device since sys$output
X        is a superset of sys$error
X        */
X        if (cmd_desc[i].state & ERROR_OUT) {
X        if (unix) {
X            fprintf(comfile,"$ define sys$error %s\n",
X                    cmd_desc[i].output);
X        }
X        else {
X            fprintf(comfile,"$ define sys$error nl:\n");
X        }
X        }
X    }
X    /*
X        redirect input streams for input pipes or file
X        in addition, put input file as last parameter
X        to associated vms command.
X    */
X    if (cmd_desc[i].state & (IN_FILE | PIPE_IN)) {
X        fprintf(comfile,"$ define/nolog sys$input %s\n",cmd_desc[i].input);
X        fprintf(comfile,"$ define pas$input %s\n",cmd_desc[i].input);
X        if (unix) {
X        fprintf(comfile,"$ %s\n",cmd_desc[i].arg_str);
X        }
X        else {
X        fprintf(comfile,"$ %s %s\n",cmd_desc[i].arg_str,cmd_desc[i].input);
X        }
X    }
X    else {
X        fprintf(comfile,"$ %s\n",cmd_desc[i].arg_str);
X    }
X    /*
X        if job is not being backgrounded,
X        and there is a following job then,
X        set the job sequence flag
X    */
X    if (!(cmd_desc[i].state & BG)) {
X        if (i+1 < cmd_cnt) {
X        job_sequence = TRUE;
X        }
X    }
X    if (!job_sequence) {
X        /*
X        finish off vms com file
X        */
X        fprintf(comfile,"$ exit:\n");
X        strcpy(exec_str,"@");
X        strcat(exec_str,str);
X        setdesc(&desc,exec_str,strlen(exec_str));
X        if (!(cmd_desc[i].state & BG)) {
X        flags = NULL;
X        }
X        else {
X        flags = NO_WAIT;
X        if (!(cmd_desc[i].state & PIPE_OUT)) {
X            backgrounded_process = TRUE;
X            /*
X            when asynchronous execution add file completion
X            and status update lines to vms com file
X            */
X            fprintf(comfile,
X    "$ if \"''f$logical(\"NOTIFY\")'\" .nes. \"\" then goto speak\n");
X            fprintf(comfile,"$ define/job/nol JOB_%D \"DONE %s\"\n",
X                    next_job,job_title);
X            if (!keep_comfile) {
X            fprintf(comfile,"$ delete %s;*\n",str);
X            }
X            fprintf(comfile,"$ exit\n");
X            fprintf(comfile,"$ speak:\n");
X            fprintf(comfile,"$ define/job/nol JOB_%D \"DONE\"\n",
X                    next_job);
X            printf("[%d] %s\n",next_job ,job_title);
X            fprintf(comfile,"$ deassign sys$output\n");
X            fprintf(comfile,"$ write sys$output \"[%d] DONE %s\"\n",
X                    next_job,job_title);
X            /*
X            update background job status string
X            */
X            strcat(jobstr,"X");
X            next_job++;
X        }
X        }
X        if (!keep_comfile) {
X         fprintf(comfile,"$ delete %s;*\n",str);
X        }
X        fclose(comfile);
X        /*
X        spawn the process for execution
X        */
X        lib$spawn(&desc,0,0,&flags,0,0,0,0,0,0,0,0);
X    }
X    }
X    if (backgrounded_process) {
X    /*
X        if asynchronous job execution then set the background
X        job status symbol on exit
X    */
X    setsymbol("JOB_STATUS",jobstr);
X    }
X}
X/*
X    add_command
X    add a command to the command description structure
X*/
Xadd_command(cmd_desc_pt,cmd_cnt_pt,state,arg_str,input,output)
Xstruct cmd_desc_type (*cmd_desc_pt)[];
Xint *cmd_cnt_pt,*state;
Xchar *arg_str,*input,*output;
X{   struct cmd_desc_type *cmd_desc_entry;
X
X    if ((*state & (IN_FILE | OUT_FILE | PIPE_IN | PIPE_OUT)) && !arg_str) {
X    fprintf(stderr,"invalid i/o redirection\n");
X    return(1);
X    }
X    if (!*arg_str) {
X    return(0);
X    }
X    /*
X    get a pointer to the current command descripion record
X    */
X    cmd_desc_entry = &((*cmd_desc_pt)[(*cmd_cnt_pt)++]);
X    /*
X    set the state, argument, input, and output fields and re-init
X    */
X    cmd_desc_entry->state = *state;
X    *state = NULL;
X    if (*arg_str) {
X    cmd_desc_entry->arg_str = malloc(strlen(arg_str)+1);
X    strcpy(cmd_desc_entry->arg_str,arg_str);
X    *arg_str = '\0';
X    }
X    if (*input) {
X    cmd_desc_entry->input = malloc(strlen(input)+1);
X    strcpy(cmd_desc_entry->input,input);
X    *input = '\0';
X    }
X    if (*output) {
X    cmd_desc_entry->output = malloc(strlen(output)+1);
X    strcpy(cmd_desc_entry->output,output);
X    *output = '\0';
X    }
X    /*
X    initialize the next description record
X    */
X    init_cmd_desc(&((*cmd_desc_pt)[*cmd_cnt_pt]));
X    return(0);
X
X}
X
X/*
X    check_mode
X    check mode checks the current and next mode,
X    command state, input and output, and validates and sets
X    the new mode.
X*/
Xcheck_mode(curr_mode,new_mode,state,input,output)
Xint curr_mode,new_mode,*state;
Xchar *input,*output;
X{
X    if (curr_mode == IN_FILE) {
X    if (!*input) {
X        fprintf(stderr,"null redirection attempted\n");
X        return(-1);
X    }
X    else if (paren_in_process >= 0) {
X        cmd_desc[paren_in_process].input = malloc(strlen(input)+1);
X        strcpy(cmd_desc[paren_in_process].input, input);
X        *input = '\0';
X    }
X    }
X    if (curr_mode == OUT_FILE) {
X    if (!*output) {
X        fprintf(stderr,"null redirection attempted\n");
X        return(-1);
X    }
X    else if (paren_in_process >= 0) {
X        cmd_desc[paren_in_process].output = malloc(strlen(output)+1);
X        strcpy(cmd_desc[paren_in_process].output, output);
X        *output = '\0';
X    }
X    }
X    if (new_mode & (IN_FILE | PIPE_IN)) {
X    if (*state & (IN_FILE | PIPE_IN)) {
X        fprintf(stderr,"multiple redirection attempted\n");
X        return(-1);
X    }
X    else {
X        *state |= new_mode;
X    }
X    }
X    else if (new_mode & (OUT_FILE | PIPE_OUT)) {
X    if (*state & (OUT_FILE | PIPE_OUT)) {
X        fprintf(stderr,"multiple redirection attempted\n");
X        return(-1);
X    }
X    else {
X        *state |= new_mode;
X    }
X    }
X    return(new_mode);
X}
X
X/*
X    dellogical
X    delete a logical from the job table
X*/
Xdellogical(logical_name)
Xchar *logical_name;
X{   char job_table[20];
X
X    setdesc(&desc,logical_name,strlen(logical_name));
X    sprintf(job_table,"LNM$JOB_%d",getuid());
X    setdesc(&desc1,job_table,strlen(job_table));
X    lib$delete_logical(&desc,desc1);
X}
X
X/*
X    delsymbol
X    delete a symbol from the global level
X*/
Xdelsymbol(symbol_name)
Xchar *symbol_name;
X{   int tbl;
X
X    setdesc(&desc,symbol_name,strlen(symbol_name));
X    tbl = 2;
X    lib$delete_symbol(&desc,&tbl);
X}
X
X/*
X    getlogical
X    get a logical translation
X*/
Xgetlogical(logical_name,value)
Xchar *logical_name,*value;
X{   int valuelen;
X
X    setdesc(&desc,logical_name,strlen(logical_name));
X    setdesc(&desc1,value,MAXSTRING-1);
X    valuelen = 0;
X    lib$sys_trnlog(&desc,&valuelen,&desc1,0,0,0);
X    value[valuelen] = '\0';
X    if (!strcmp(logical_name,value)) {
X    return(0);
X    }
X    return(1);
X
X}
X
X/*
X    getsymbol
X    get a symbol value
X*/
Xgetsymbol(symbol_name,value)
Xchar *symbol_name,*value;
X{   int valuelen,status;
X
X    setdesc(&desc,symbol_name,strlen(symbol_name));
X    setdesc(&desc1,value,MAXSTRING-1);
X    valuelen = 0;
X    status = lib$get_symbol(&desc,&desc1,&valuelen,0);
X    if (status & STS$M_SUCCESS) {
X    value[valuelen] = '\0';
X    return(1);
X    }
X    else {
X    return(0);
X    }
X}
X
X/*
X   get_pipe
X   create a pipe_name and open a mailbox under that name
X*/
Xget_pipe(pipe_name,pipeno)
Xchar *pipe_name;
Xint pipeno;
X{   int i,chan;
X
X    i = getpid();
X    sprintf(pipe_name,"COM%0d%0d",i,pipeno);
X    setdesc(&desc,pipe_name,strlen(pipe_name));
X    sys$crembx(0,&chan,1024,2048,0xff0f,0,&desc);
X}
X
X/*
X    init_cmd_desc
X    initialize a command description entry
X*/
Xinit_cmd_desc(cmd_desc_entry)
Xstruct cmd_desc_type *cmd_desc_entry;
X{
X    cmd_desc_entry->state = NULL;
X    cmd_desc_entry->arg_str = NULL;
X    cmd_desc_entry->input = NULL;
X    cmd_desc_entry->output = NULL;
X}
X
X/*
X    process_arg
X    split the extend argument string and process into separate commands.
X*/
Xprocess_arg(str)
Xchar *str;
X{   /*
X    state,arg_str,input,output
X    are local temporaries for the corresponding fields in a
X    command description record.
X    */
X    int state = NULL;
X    char arg_str[MAXSTRING];
X    char input[MAXSTRING];
X    char output[MAXSTRING];
X    int old_state = NULL;    /* old state values */
X    char cstr[2],c;    /* temporary character manipulation storage */
X    int char_mode = ARGUMENT;    /* next character addition mode */
X
X    int parens = 0;        /* paren levels saved */
X    int paren_levels[4];    /* paren level storage */
X
X    int i;
X
X    /*
X    init the command description temporaries
X    */
X    *arg_str = '\0';
X    *input = '\0';
X    *output = '\0';
X    /*
X    zero the number of commands and init the first command
X    description record
X    */
X    cmd_cnt = 0;
X    init_cmd_desc(&cmd_desc[cmd_cnt]);
X
X    while (c = *str++) {
X    /* command separator */
X    if (c == ';') {
X        if ((char_mode =
X            check_mode(char_mode,ARGUMENT,&state,input,output)) < 0) {
X        return(1);
X        }
X        old_state = state;
X        if (add_command(cmd_desc,&cmd_cnt,&state,arg_str,input,output)) {
X        return(1);
X        }
X        if (old_state & OUT_FILE) state |= CLEAR_OUT;
X        if (old_state & IN_FILE) state |= CLEAR_IN;
X        if (old_state & ERROR_OUT) state |= CLEAR_ERROR;
X        paren_in_process = -1;
X    }
X    /* pipe */
X    else if (c == '|') {
X        if (paren_in_process < 0) {
X        if ((char_mode =
X            check_mode(char_mode,PIPE_OUT,&state,input,output)) < 0) {
X            return(1);
X        }
X        get_pipe(output);
X        if (*str == '&') {
X            str++;
X            state |= ERROR_OUT;
X        }
X        if (add_command(cmd_desc,&cmd_cnt,&state,arg_str,input,output)) {
X            return(1);
X        }
X        cmd_desc[cmd_cnt - 1].state |= BG;
X        /*
X            set up pipe input to next command
X        */
X        if ((char_mode =
X            check_mode(char_mode,PIPE_IN,&state,input,output)) < 0 ) {
X            return(1);
X        }
X        cmd_desc[cmd_cnt].input = cmd_desc[cmd_cnt - 1].output;
X        char_mode = check_mode(char_mode,ARGUMENT,&state,input,output);
X        }
X        else {
X        if ((char_mode =
X            check_mode(char_mode,PIPE_OUT,
X                    &cmd_desc[paren_in_process].state,
X                    cmd_desc[paren_in_process].input,
X                    cmd_desc[paren_in_process].output)) < 0) {
X            return(1);
X        }
X        for (i = paren_in_process + 1; i < cmd_cnt; i++) {
X            if (cmd_desc[i].state & (OUT_FILE | PIPE_OUT)) {
X            fprintf(stderr, "multiple redirection attempted\n");
X            return(1);
X            }
X        }
X        if (state & OUT_FILE) {
X            fprintf(stderr, "multiple redirection attempted\n");
X            return(1);
X        }
X        get_pipe(output);
X        cmd_desc[paren_in_process].output = malloc(strlen(output)+1);
X        strcpy(cmd_desc[paren_in_process].output, output);
X        *output = '\0';
X        if (*str == '&') {
X            str++;
X            cmd_desc[paren_in_process].state |= ERROR_OUT;
X        }
X        if (add_command(cmd_desc,&cmd_cnt,&state,arg_str,input,output)) {
X            return(1);
X        }
X        cmd_desc[cmd_cnt - 1].state |= BG;
X        /*
X            set up pipe input to next command
X        */
X        if ((char_mode =
X            check_mode(char_mode,PIPE_IN,&state,input,output)) < 0) {
X            return(1);
X        }
X        cmd_desc[cmd_cnt].input = cmd_desc[paren_in_process].output;
X        char_mode = check_mode(char_mode,ARGUMENT,&state,input,output);
X        paren_in_process = -1;
X        }
X    }
X    /* background */
X    else if (c == '&') {
X        if ((char_mode =
X            check_mode(char_mode,ARGUMENT,&state,input,output)) < 0) {
X        return(1);
X        }
X        if (add_command(cmd_desc,&cmd_cnt,&state,arg_str,input,output)) {
X        return(1);
X        }
X        cmd_desc[cmd_cnt - 1].state |= BG;
X        paren_in_process = -1;
X    }
X    /* redirect output */
X    else if (c == '>') {
X        if (paren_in_process < 0) {
X        if ((char_mode =
X            check_mode(char_mode,OUT_FILE,&state,input,output)) < 0) {
X            return(1);
X        }
X        if (*str == '&') {
X            str++;
X            state |= ERROR_OUT;
X        }
X        }
X        else {
X        if ((char_mode =
X            check_mode(char_mode,OUT_FILE,
X                    &cmd_desc[paren_in_process].state,
X                    cmd_desc[paren_in_process].input,
X                    cmd_desc[paren_in_process].output)) < 0) {
X            return(1);
X        }
X        for (i = paren_in_process + 1; i < cmd_cnt; i++) {
X            if (cmd_desc[i].state & (OUT_FILE | PIPE_OUT)) {
X            fprintf(stderr, "multiple redirection attempted\n");
X            return(1);
X            }
X        }
X        if (state & OUT_FILE) {
X            fprintf(stderr, "multiple redirection attempted\n");
X            return(1);
X        }
X        if (*str == '&') {
X            str++;
X            cmd_desc[paren_in_process].state |= ERROR_OUT;
X        }
X        }
X    }
X    /* redirect input */
X    else if (c == '<') {
X        if (paren_in_process < 0) {
X        if ((char_mode =
X            check_mode(char_mode,IN_FILE,&state,input,output)) < 0) {
X            return(1);
X        }
X        }
X        else {
X        if ((char_mode =
X            check_mode(char_mode,IN_FILE,
X                    &cmd_desc[paren_in_process].state,
X                    cmd_desc[paren_in_process].input,
X                    cmd_desc[paren_in_process].output)) < 0) {
X            return(1);
X        }
X        for (i = paren_in_process + 1; i < cmd_cnt; i++) {
X            if (cmd_desc[i].state & (IN_FILE | PIPE_IN)) {
X            fprintf(stderr, "multiple redirection attempted\n");
X            return(1);
X            }
X        }
X        if (state & (IN_FILE | PIPE_IN)) {
X            fprintf(stderr, "multiple redirection attempted\n");
X            return(1);
X        }
X        }
X    }
X    /* job group start */
X    else if (c == '(') {
X        if (paren_in_process >= 0 || char_mode != ARGUMENT || *arg_str) {
X        fprintf(stderr,"invalid job grouping\n");
X        return(1);
X        }
X        paren_levels[parens++] = cmd_cnt;
X    }
X    /* job group end */
X    else if (c == ')') {
X        if (!parens) {
X        fprintf(stderr,"mis-matched parenthisis\n");
X        return(1);
X        }
X        if (char_mode != ARGUMENT || !(*arg_str)) {
X        fprintf(stderr,"invalid job grouping\n");
X        return(1);
X        }
X        paren_in_process = paren_levels[--parens];
X    }
X    else {
X        /* escaping of next character */
X        if (c == '\\') {
X        if (!(*cstr = *str++)) {
X            return(1);
X        }
X        }
X        /* any other character */
X        else {
X        /*
X            space or tab delimits a file name in file redirection
X            modes, reset the character mode to ARGUMENT input.
X        */
X        if (c == ' ' || c == '\t') {
X            if ((char_mode == IN_FILE && *input)
X             || (char_mode == OUT_FILE && *output)) {
X            if ((char_mode =
X                check_mode(char_mode,ARGUMENT,
X                       &state,input,output)) < 0) {
X                return(1);
X            }
X                continue;
X            }
X        }
X        *cstr = c;
X        }
X        *(cstr+1) = '\0';
X
X        /*
X        three character modes are available for normal character
X        ARGUMENT - part of a vms command
X        IN_FILE  - part of a input redirection file name
X        OUT_FILE - part of an output redirection file name
X        */
X        switch(char_mode) {
X
X        case ARGUMENT:
X            strcat(arg_str,cstr);
X            break;
X
X        case IN_FILE:
X            strcat(input,cstr);
X            break;
X
X        case OUT_FILE:
X            strcat(output,cstr);
X            break;
X
X        }
X    }
X    }
X    /*
X    exit cleanup
X    */
X    if (check_mode(char_mode,ARGUMENT,&state,input,output) < 0) {
X    return(1);
X    }
X    if (add_command(cmd_desc,&cmd_cnt,&state,arg_str,input,output)) {
X    return(1);
X    }
X    return(0);
X}
X/*
X    setdesc
X    set descriptor to a standard ascii string
X*/
Xsetdesc(descr,str,strlen)
Xstruct dsc$descriptor_s *descr;
Xchar *str;
Xint strlen;
X{
X    descr->dsc$w_length = strlen;
X    descr->dsc$a_pointer = str;
X    descr->dsc$b_class = DSC$K_CLASS_S;    /* String desc class */
X    descr->dsc$b_dtype = DSC$K_DTYPE_T;    /* Ascii string type */
X}
X/*
X    setsymbol
X    set a symbol in the global table
X*/
Xsetsymbol(symbol_name,value)
Xchar *symbol_name,*value;
X{   int tbl;
X
X    setdesc(&desc,symbol_name,strlen(symbol_name));
X    setdesc(&desc1,value,strlen(value));
X    tbl = 2;
X    lib$set_symbol(&desc,&desc1,&tbl);
X}
X/*
X    update_job_status
X    update the status of any completed background jobs.
X    print completion code to the screen for any non-immediate
X    notification style jobs.
X*/
Xupdate_job_status(active_jobs,next_job)
Xchar *active_jobs;
Xint *next_job;
X{   int i;
X    char joblogical[MAXSTRING],status_info[MAXSTRING],*active;
X
X    /*
X    there is an 'X' in the active_jobs string for all background
X    jobs currently still outstanding.
X    */
X    for (i = 0; i < strlen(active_jobs); i++) {
X    if (active_jobs[i] != ' ') {
X        /*
X        each job maintains a JOB_'number' logical which
X        indicates current execute status of the job
X        */
X        sprintf(joblogical,"JOB_%d",i+1);
X        getlogical(joblogical,status_info);
X        /*
X        a symbol prefaced with DONE means the job is complete
X        */
X        if (!strncmp(status_info,"DONE",4)) {
X        if (strcmp(status_info,"DONE")) {
X            /*
X            if DONE is followed by additional info then
X            the job was not immediately notified so its
X            completion is signaled now
X            */
X            printf("[%d] %s\n",i+1,status_info);
X        }
X        /*
X            remove the completed job's logical
X        */
X        dellogical(joblogical);
X        /*
X            remove the active indicator from the active_jobs
X        */
X        active_jobs[i] = ' ';
X        }
X    }
X    }
X    /*
X    update active_jobs string to remove trailing blanks
X    */
X    active = active_jobs + strlen(active_jobs) - 1;
X    while (active >= active_jobs && *active == ' ') *(active--) = '\0';
X    /*
X    set number of next_job sub process
X    */
X    *next_job = strlen(active_jobs)+1;
X}
X/*
X    upshift
X    uppercase a character string
X*/
Xupshift(upname,lwname)
Xchar *upname,*lwname;
X{
X    while (*(upname++) = toupper(*(lwname++)));
X}
X
/
echo 'Part 01 of vms complete.'
exit