From:	CSBVAX::MRGATE!@KL.SRI.Com:DSTEVENS@VAXC.STEVENS-TECH.EDU@SMTP 11-SEP-1987 17:10
To:	EVERHART
Subj:	RE: how to get $STATUS from a subprocess at DCL level

Received: from VAXC.STEVENS-TECH.EDU by KL.SRI.COM with TCP; Fri 11 Sep 87 11:10:31-PDT
Date: Wed, 11 Sep 87 14:10:59 EDT
From: DSTEVENS@VAXC.STEVENS-TECH.EDU (David L. Stevens)
To: info-vax@kl.sri.com
Subject: RE: how to get $STATUS from a subprocess at DCL level
X-VMS-To: Q%"info-vax@kl.sri.com"
Message-Id: <87811141059.20a0045c.DSTEVENS>


 To whom it may concern,
	I sent a message out a couple of days ago about getting the status
 of a command from a subprocess that is still active.  The subprocess would
 have the following charicteristics:

	1: Would have CLI loaded into it
	2: Would be running at DCL level
	3: SYS$INPUT , SYS$OUTPUT, & SYS$ERROR would be defined as mailboxes
	4: Parent process would continue executing while the subprocess existed
	5: Subprocess will not exit after executing a command

 I now have a program that does all of the above.  The program will create the
 subprocess, allow a calling program to issue commands to it and, will return
 the integer value of the $STATUS symbol to the calling routine.  The
 subprocess will stay there until you call the shutdown routine.  The modules
 are both written in VAX-C, they work at our site here, but then again since
 this is a college, reallity may be warped beyond all recognition.  So I can't
 guarentee that it will run anywhere else.  But for what its worth, here it is:

 -------------------------Cut here -------------------------------------------


/*
**
**  INCLUDE FILES
**
**/

#include    stdio
#include    descrip
#include    "acct"


main()
{
#define	COMMAND	    "What ever command you want"
#define	NXT_COMMAND "Any other command you want"
    unsigned	int	    status;
    unsigned	int	    final_status;
    static	readonly
	$DESCRIPTOR(show_command, "FINGER");
    static	readonly
	$DESCRIPTOR(command_1, COMMAND);
    static	readonly
	$DESCRIPTOR(command_2, NXT_COMMAND);

    status = dcl_initialize();
    if (TEST_STATUS)
    {
	status = dcl_execute_command(&show_command, &final_status);
	if (! TEST_STATUS)
	    printf("\n DCL command failed with status = %x", status);
	else
	    printf("\n The status of the show command was: %x",
		     final_status);

	status = dcl_execute_command(&command_1, &final_status);
	if (! TEST_STATUS)
	    printf("\n DCL command failed with status = %x", status);
	else
	    printf("\n The status of the command was: %x",
		     final_status);

	status = dcl_execute_command(&command_2, &final_status);
	if (! TEST_STATUS)
	    printf("\n DCL command failed with status = %x", status);
	else
	    printf("\n The status of the command was: %x",
		     final_status);
    }
    dcl_shutdown();
    exit (status);
}

--------------------------------End of first module----------------------------

--------------------------------DCL command module-----------------------------
#module acct_dcl_command "1.0.001"

/*
**++
**  FACILITY:
**
**      Stevens accounting system
**
**  ABSTRACT:
**
**      This module implements an interface to the Digital Command Language
**	(DCL).  This is used to implement an interface to those items that are
**	not callable.
**
**  AUTHORS:
**
**      Robert McQueen
**	David L. Stevens
**
**  CREATION DATE:     19-August-1987
**
**  MODIFICATION HISTORY:
**--
**/



/*
**
**  INCLUDE FILES
**
**/

#include    stdio		    /* Standard I/O definitions */
#include    dvidef		    /* GETDVI symbol definitions */
#include    iodef		    /* IO symbol definitions */
#include    prvdef		    /* Process privilege definitions */
#include    ssdef		    /* System Service status definitions */
#include    descrip		    /* Descriptor definitions */
#include    "acct"		    /* Accounting definitions */


#define	    SUBPROCESS_LOG_FILE	    "Acct$subprocess_log_file.log"


/*
** The following are prototype function definitions
*/

unsigned    int	dcl_initialize(void);

unsigned    int	dcl_shutdown(void);

unsigned    int	dcl_execute_command(
		    struct	dsc$descriptor	*command,
		    unsigned	int		*final_status);

unsigned    int	dcl_final_status(
		    struct	dcl_structure	*process_info,
		    unsigned	int		*final_status);

unsigned    int	dcl_assign_mbx(
		    unsigned int    *channel,
		    unsigned int    *unit,
		    struct dsc$descriptor *name);

unsigned    int	dcl_write_command(
		    struct  dcl_structure   *process_info,
		    struct  dsc$descriptor  *command_line);

unsigned    int	dcl_wait_until_done(
		    struct  dcl_structure   *process_info);

unsigned    int	dcl_post_read_io(
		    char	*buffer_address,
		    int		buffer_length);

unsigned    int	post_termination_read(
		    struct	dcl_structure	*process_info);

unsigned    int	dcl_create_the_process(
		    unsigned	int		*privileges);

wake_ast();

term_ast();

read_ast();

/*
** Local structure definitions
*/

struct	dcl_structure
{
    unsigned	long		    pid;		/* PID */

    unsigned	short		    input_channel;	/* Input channel */
    unsigned	short		    input_unit;		/* Input unit number */
    struct	dsc$descriptor	    input_name;		/* Input mailbox name */
    struct	io_status_block	    input_iosb;		/* Input IOSB */

    unsigned	short		    output_channel;	/* Output channel */
    unsigned	short		    output_unit;	/* Output unit number */
    struct	dsc$descriptor	    output_name;	/* Output mailbox name */
    struct	io_status_block	    output_iosb;	/* Output IOSB */

    unsigned	short		    term_channel;	/* Termination channel */
    unsigned	short		    term_unit;		/* Termination unit number */
    struct	dsc$descriptor	    term_name;		/* Termination mailbox name */
    struct	io_status_block	    term_iosb;		/* Termination IOSB */
};

struct	    dcl_structure   dcl;
unsigned    int		    process_privileges[2] = {0, 0};
char			    term_buffer[255];
FILE			    *subproc_log_file;


/*		    DCL INITIALIZE
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This function will initialize the DCL command processing.  This routine
**	should be called as part of the initialization of the accounting system.
**
**  FORMAL PARAMETERS:
**
**      none
**
**  IMPLICIT INPUTS:
**
**      none
**
**  IMPLICIT OUTPUTS:
**
**      Module initialized
**
**  COMPLETION CODES:
**
**      System service condition codes
**
**  SIDE EFFECTS:
**
**      none
**
**--
**/
unsigned int	dcl_initialize(void)
{
/*
** Permanent strings
*/
    static struct dsc$descriptor dyn_string =	    /* Prototype dynamic string */
			$INIT_DESCRIPTOR;	    /* Initialize it */
/*
** Local variables
*/
    unsigned	int	status;			/* Condition code to return */
/*
** Main logic:
** - Initialize all dynamic strings
** - Create the input, output and termination mailboxes
*/
    dcl.input_name  = dyn_string;	/* Initialize the dynamic strings */
    dcl.output_name = dyn_string;	/* Initialize the output string */
    dcl.term_name   = dyn_string;	/* Initialize the termination string */
/*
** Assign an input mailbox for interprocess communications
*/
    status = dcl_assign_mbx(		/* Assign the mailbox */
		&dcl.input_channel,	/* Place to store the channel */
		&dcl.input_unit,	/* and the unit number */
		&dcl.input_name);	/* and the mailbox name */

    if (! TEST_STATUS)			/* Did this win? */
	return status;			/* No, return the failure status */
/*
** Assign an output mailbox for interprocess communications
*/
    status = dcl_assign_mbx(		/* Assign the mailbox */
		&dcl.output_channel,	/* Place to store the channel */
		&dcl.output_unit,	/* and the unit number */
		&dcl.output_name);	/* and the mailbox name */
    if (! TEST_STATUS)			/* Did this win? */
	return status;			/* No, return the failure status */
/*
** Assign a termination mailbox for interprocess communications
*/
    status = dcl_assign_mbx(		/* Assign the mailbox */
		&dcl.term_channel,	/* Place to store the channel */
		&dcl.term_unit,		/* and the unit number */
		&dcl.term_name);	/* and the mailbox name */
    if (! TEST_STATUS)			/* Did this win? */
	return status;			/* No, return the failure status */
/*
** Post ar read for when the process terminates
*/
    post_termination_read(&dcl);
/*
** Set up the privileges that the subprocess will have
*/
    process_privileges[0] = PRV$M_NETMBX | PRV$M_TMPMBX;
/*
** Now create the process and return to the caller
*/
    return  dcl_create_the_process(&process_privileges);
}

/*		    DCL SHUTDOWN
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This function will shutdown the DCL command interface.
**
**  FORMAL PARAMETERS:
**
**      none
**
**  IMPLICIT INPUTS:
**
**      Local data structures
**
**  IMPLICIT OUTPUTS:
**
**      none
**
**  COMPLETION CODES:
**
**      System service condition code
**
**  SIDE EFFECTS:
**
**      none
**
**--
**/
unsigned int	dcl_shutdown(void)
{
/*
** Local variables
*/
    unsigned int    status;		/* Condition code to return */
/*
** Main logic:
** - Cancel all I/O
** - Deassign the channels
** - Kill the process
*/

/*
** Cancel IO on the Input channel,
**  and then deassign the IO channel
*/
    status = sys$cancel(dcl.input_channel);	/* Cancel input I/O */
    if (TEST_STATUS)
	status = sys$dassgn(dcl.input_channel);	/* Deassign the input channel */
    if (! TEST_STATUS)
	return status;				/* Pass back failing status */
/*
** Cancel IO on the Output channel,
**  and then deassign the IO channel
*/
    status = sys$cancel(dcl.output_channel);	/* Cancel the output I/O requests */
    if (TEST_STATUS)
	status = sys$dassgn(dcl.output_channel);/* Deassign the output channel */
    if (! TEST_STATUS)
	return status;				/* Return the failing status */
/*
** Cancel IO on the Termination channel,
**  and then deassign the IO channel
*/
    status = sys$cancel(dcl.term_channel);	/* Cancel the termination mailbox read */
    if (TEST_STATUS)
	status = sys$dassgn(dcl.term_channel);	/* Deassign the channel */
    if (! TEST_STATUS)
	return status;			/* Pass back any errors */
/*
** Now kill off the process, if it is still around
*/
    status = sys$delprc(
		 &dcl.pid,		/* Delete the process with this PID */
		 0);			/* Don't use the process name */
    if (status == SS$_NONEXPR)		/* Already gone? */
	status = SS$_NORMAL;		/* Yes, convert this to a normal */
    if (! TEST_STATUS)
	return status;			/* Return the failing status */
/*
** Return any dynamic strings that are in the block now.
*/
    STR$FREE1_DX(&dcl.input_name);	/* Return the input name */
    STR$FREE1_DX(&dcl.output_name);	/* Return the output name */
    STR$FREE1_DX(&dcl.term_name);	/* Free up the termination MBX name */
/*
** Close the Subprocess Log File
*/
    fprintf(subproc_log_file, "\n\n   End of Subprocess log file\n");
    fclose(subproc_log_file);
/*
** At this point we are basically finished, so return the final status for the
** caller.
*/
    return status;			/* Return the final status */
}

/*		    DCL EXECUTE COMMAND
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This function will execute a DCL command.  It will wait until the
**	command is complete and return the status of the executed command.
**
**  FORMAL PARAMETERS:
**
**      command - Pointer to a string descriptor which is the command to
**	    execute.
**
**  IMPLICIT INPUTS:
**
**      Local data structures
**
**  IMPLICIT OUTPUTS:
**
**	none
**
**  COMPLETION CODES:
**
**      System service condition code, program condition code
**
**  SIDE EFFECTS:
**
**      DCL command executed
**
**--
**/
unsigned int	dcl_execute_command(
    struct	dsc$descriptor	*command,
    unsigned	int		*final_status)
{
/*
** Local variables
*/
    unsigned	int	status;
/*
** Main logic:
**  - Write the command to the subprocesses input device
**  - Wait for the command to complete
**  - Go get the final status of the command
*/

/*
** Now if the process got created correctly, we can go execute the command
*/
    status = dcl_write_command(		/* Go write the command to the */
			&dcl,		/*   mailbox that */
			command);	/*     we have opened */
/*
** If the previous call succeeded, wait until subprocess
**	finishes the command
*/
    if (TEST_STATUS)
	status = dcl_wait_until_done(   /* Now wait until the subprocess */
			    &dcl);	/*   has executed the command */
/*
** If everything is still fine then go and get the final status
*/
    if (TEST_STATUS)
	status = dcl_final_status(	/* Go get the subprocess status */
			&dcl,		/*   for the command that we */
			final_status);	/*     just executed */
/*
** Return to the caller
*/
    return status;			    /* Return the call status */
}

/*		    DCL FINAL STATUS
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This function will determine the final status of the executed command.
**	It will do this by translating the symbol $STATUS in the sub-process.
**
**  FORMAL PARAMETERS:
**
**      none
**
**  IMPLICIT INPUTS:
**
**      Local data structures
**
**  IMPLICIT OUTPUTS:
**
**      none
**
**  COMPLETION CODES:
**
**      Status of the command that was executed.
**
**  SIDE EFFECTS:
**
**      none
**
**--
**/
unsigned int	dcl_final_status(
    struct	dcl_structure	*process_info,
    unsigned	int		*final_status)
{
/*
** Local permanent strings
*/
    static  readonly	$DESCRIPTOR(command, "SHOW SYMBOL $STATUS");
    static  readonly	$DESCRIPTOR(search_string, "  $STATUS == \"%X");
/*
** Local variables
*/
    unsigned int    status;		/* Condition code to return */
    char	    read_buffer[255];
/*
** Main logic:
**  - Issue a command to get the value of the symbol status
**  - Read the responce off the subprocesses output channel
*/
    status = dcl_write_command(process_info, &command);
    if (TEST_STATUS)
    {
    /*
    ** Block variables
    */
	struct	    dsc$descriptor  final_status_string = $INIT_DESCRIPTOR;
	unsigned    short	    loop = TRUE;
	unsigned    int		    cmp_state;
	unsigned    int		    string_length;
    /*
    ** Make sure that the buffer is cleared out, then
    **	Wait until the subprocess completes the SHOW SYMBOL $STATUS command
    */
	while ( (TEST_STATUS) && (loop) )
	{
	/*
	** Issue a QIO to read the result of the subprocesses DCL command
	*/
	    memset(&read_buffer, '\0', 255);
	    status = dcl_post_read_io(&read_buffer, 255);
	    if (TEST_STATUS)
	    {
	    /*
	    ** See if the Search_String is contained in the output buffer
	    */
		fprintf(subproc_log_file,"\n%s", read_buffer);
		cmp_state = memcmp(				/* See if the strings match */
				&read_buffer,			/* First string */
				search_string.dsc$a_pointer,	/* Second string */
				search_string.dsc$w_length);	/* Number of bytes to compare */
		if (cmp_state == 0)
		    loop = FALSE;
	    }				/* End IF ... */
	}				/* End While ... */
    /*
    ** Now set up so we can move the string value to a descriptor, and
    **	then move it into the descriptor
    */
	if (TEST_STATUS)
	{
	    string_length = (process_info->output_iosb.count - 1) -
			     search_string.dsc$w_length;
	    STR$COPY_R(
		&final_status_string,
		&string_length,
		&read_buffer[search_string.dsc$w_length]);
	/*
	** Convert the Hexidecimal Text into an Integer
	*/
	    status = OTS$CVT_TZ_L(&final_status_string, final_status);
	}
    }
/*
** Return the final status
*/
    return status;
}

/*		    DCL ASSIGN MAILBOX
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This function will create a mailbox and return the unit number and the
**	name of the mailbox.
**
**  FORMAL PARAMETERS:
**
**      channel - Place to store the channel number assigned to the mailbox.
**	unit - Place to store the unit number of the mailbox that is assigned.
**	name - Name of the mailbox that is assigned.
**
**  IMPLICIT INPUTS:
**
**      none
**
**  IMPLICIT OUTPUTS:
**
**      none
**
**  COMPLETION CODES:
**
**      System service condition code
**
**  SIDE EFFECTS:
**
**      Assigns a mailbox
**
**--
**/
unsigned int	dcl_assign_mbx(
    unsigned	int		*channel,
    unsigned	int		*unit,
    struct	dsc$descriptor	*name)
{
/*
** Local variables
*/
    unsigned	char	    name_string[128];	    /* Name string */
    short	int	    name_length;	    /* Returned length of the name */
    unsigned	int	    status;		    /* Condition code to return */
    unsigned	int	    dummy;		    /* dummy variable */
    struct	item_list_3 getdvi_itemlist[] =	    /* Itemlist for GETDVIW call */
	{sizeof name_string,	DVI$_DEVNAM,	&name_string, &name_length,
	 4,			DVI$_UNIT,	unit,	      &dummy,
	 0,			0,		0,	      0};
/*
** Main logic:
**  - Create the mailbox
**  - Get the device name and the unit number via GETDVIW
*/
    status = sys$crembx (
		 0,			    /* Perm flag */
		 channel,		    /* Where to store the channel */
		 1024,			    /* Maximum message size */
		 1024,			    /* Buffer quota */
		 0,			    /* Protection mask */
		 0,			    /* Access mode */
		 0);			    /* Logical name */
    if (! TEST_STATUS)			    /* If that failed */
	lib$signal(status);		    /* Note the fact */
/*
** Now get the mailbox device information
*/
    status = sys$getdviw (
		 0,			    /* EFN */
		 *channel,		    /* Channel */
		 0,			    /* Device name */
		 &getdvi_itemlist,	    /* Item list */
		 0,			    /* I/O status block */
		 0,			    /* AST address */
		 0,			    /* AST parameters */
		 0);			    /* Null argument */
/*
** If the GETDVI worked then copy the answere into a Descriptor
*/
    if (TEST_STATUS)
	status = STR$COPY_R(
		     name,		    /* Place to store the name */
		     &name_length,	    /* Length of the name */
		     &name_string);	    /* Place were the name is */
/*
** If failure is indicated then Signal the error
*/
    if (! TEST_STATUS)
	lib$signal(status);
/*
** Return the final status to the caller
*/
    return status;
}

/*		    DCL CREATE the PROCESS
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This routine is called to create the subprocess.  It will run the
**	    program LOGINOUT.EXE in order to create a CLI for the subprocess
**	    to use.  Input and output devices will be based on Mailbox names
**	    defined in the DCL structure.
**
**  FORMAL PARAMETERS:
**
**	privileges	->  Pointer to Quadword containing the privileges the
**				subprocess is to be created with
**
**  IMPLICIT INPUTS:
**
**	none
**
**  IMPLICIT OUTPUTS:
**
**	none
**
**  FUNCTION VALUE:
**
**      System Service value
**
**  SIDE EFFECTS:
**
**      none
**
**--
**/
unsigned    int	dcl_create_the_process(
		    unsigned	int		*privileges)
{
/*
** Readonly strings
*/
    static  readonly
	$DESCRIPTOR(process_name, "Lcl$sub_proc_");
    static  readonly
	$DESCRIPTOR(image_name, "SYS$SYSTEM:LOGINOUT.EXE");
    static  readonly
	$DESCRIPTOR(set_noon_command, "SET NOON");
/*
** Local variables
*/
    struct	dsc$descriptor	final_process_name = $INIT_DESCRIPTOR;
    struct	dsc$descriptor	char_descriptor    = $STATIC_DESCRIPTOR;
    char			character;
    char			base_character;
    unsigned    int		loop;
    unsigned	int		status;
    short	int		sequence_number;
/*
** Set up a static descriptor to point at a sequence character
*/
    char_descriptor.dsc$a_pointer = &character;
    char_descriptor.dsc$w_length  = 1;
    loop = TRUE;
    sequence_number = 0;
    base_character = '0';
/*
** Now Loop until either the process name is unique,
**	or an error other than SS$_DUPLNAM occurs
*/
    while (loop)
    {
    /*
    ** If the sequence number is = 10 and the base character is still an
    **	ASCII Zero, then reset the sequence number and change the base
    **	character to an ASCII Lower-case A
    */
	if ( (base_character == '0') && (sequence_number == 10) )
	{
	    base_character = 'a';	    /* Now use Characters for uniqueness */
	    sequence_number = 0;	    /* Reset the sequence number */
	}
    /*
    ** Create a character form of the Sequence number
    **  and use it with the base name to get an Final Process Name
    */
	character = base_character + sequence_number++;
	STR$CONCAT(			    /* Concatenate the strings */
		&final_process_name,	    /* Resultant string */
		&process_name,		    /* First source string */
		&char_descriptor);	    /* Last source string */
    /*
    ** Now try to create the process with the specified privileges
    */
	status = SYS$CREPRC(		    /* Call the Create Process function */
		     &dcl.pid,		    /* Process ID */
		     &image_name,	    /* Image to run */
		     &dcl.input_name,	    /* Definition for SYS$INPUT */
		     &dcl.output_name,	    /* Definition for SYS$OUTPUT */
		     &dcl.output_name,	    /* Definition for SYS$ERROR */
		     privileges,	    /* Privileges */
		     0,			    /* Quotas */
		     &final_process_name,   /* Name of the process */
		     4,			    /* Base priority */
		     0,			    /* Use my UIC */
		     dcl.term_unit,	    /* Termination mailbox unit number */
		     0);		    /* Status flags */
    /*
    ** Free up the dynamic string and see if we have to loop again
    */
	STR$FREE1_DX(&final_process_name);
	if (status == SS$_DUPLNAM)
	    loop = TRUE;		/* Duplicate process name, try again */
	else
	    loop = FALSE;		/* Jump out of the loop */
    }				/* End WHILE ... */
/*
** If the process was created OK then issue a command to execute
**  the required initial commands
*/
    if (TEST_STATUS)
    {
    /*
    ** Open up a log file for a record of all the command outputs
    */
	subproc_log_file = fopen(SUBPROCESS_LOG_FILE, "w");
	if (subproc_log_file == NULL)
	    printf("\n WARNING, unable to open Subprocess Log File   %s",SUBPROCESS_LOG_FILE);
	else
	    fprintf(subproc_log_file,"\n   Beginning of Log file for subprocess PID = %x (hex)\n", dcl.pid);
    /*
    ** Issue a command to NOT logout the process on an error
    */
	status = dcl_write_command(&dcl, &set_noon_command);
    }
/*
** Return the final status to the caller
*/
    return status;
}

/*		    DCL WRITE COMMAND
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This procedure is used to write a DCL command to the Subprocesses
**	    input device.  Thus forcing the subprocess to actually issue
**	    the DCL command.
**
**  FORMAL PARAMETERS:
**
**      process_info	->  Internal data structure specifying characteristics
**				of the subprocess
**	command_line	->  Pointer to a descriptor containing the DCL command
**
**  IMPLICIT INPUTS:
**
**      none
**
**  IMPLICIT OUTPUTS:
**
**      none
**
**  FUNCTION VALUE:
**
**      System service return
**
**  SIDE EFFECTS:
**
**      The DCL command is executed by the subprocess
**
**--
**/
unsigned    int	dcl_write_command(
		    struct  dcl_structure   *process_info,
		    struct  dsc$descriptor  *command_line)
{
/*
** Local variables
*/
    unsigned	int		status;
/*
** Write the command out to the Subprocesses input channel
*/
    status = SYS$QIOW(				/* Issue a syncronous QIO */
		 0,				/* No event flag */
		 process_info->input_channel,	/* IO Channel */
		 IO$_WRITEVBLK | IO$M_NOW,	/* IO operation - WRITE */
		 &process_info->input_iosb,	/* IO status block */
		 0,				/* No AST routine */
		 0,				/* No AST arguement */
		 command_line->dsc$a_pointer,	/* Address of output buffer */
		 command_line->dsc$w_length,	/* Length of output buffer */
		 0, 0, 0, 0);			/* No P3, P4, P5, P6 arguements */
/*
** If the QIO worked then get the status out of the IOSB
*/
    if (TEST_STATUS)
	status = process_info->input_iosb.status;
/*
** Return the final status
*/
    return status;
}

/*		    DCL WAIT UNTIL DONE
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This routine is called to suspend the current process until the
**	    subprocess has completed the command that it was issued.  This
**	    is done by using a set mode I/O to call an AST routine when the
**	    subprocess writes something into the mailbox.  After issueing the
**	    set mode I/O, the process then hibernates.
**
**  FORMAL PARAMETERS:
**
**      process_info	->  Pointer to information block for the subprocess
**
**  IMPLICIT INPUTS:
**
**      none
**
**  IMPLICIT OUTPUTS:
**
**      none
**
**  FUNCTION VALUE:
**
**      System Service value
**
**  SIDE EFFECTS:
**
**      The process hibernates until the subprocess writes something
**	    to the output channel
**
**--
**/
unsigned    int	dcl_wait_until_done(
		    struct  dcl_structure   *process_info)
{
    unsigned	int		status;
/*
** Issue the Set WRITE ATTENTION call for the Output mailbod
*/
    status = SYS$QIOW(				/* Issue the QIO */
		 0,				/* No Event flag */
		 process_info->output_channel,	/* IO Channel */
		 IO$_SETMODE | IO$M_WRTATTN,	/* SETMODE IO */
		 &process_info->output_iosb,	/* IO status block */
		 0,				/* No AST address */
		 0,				/* No AST arguement */
		 &wake_ast,			/* Address of AST routine */
		 0, 0, 0, 0, 0);		/* No other P? arguements */
/*
** Determine the result of the Set Mode QIO
*/
    if (TEST_STATUS)
	status = process_info->output_iosb.status;
/*
** If alls well, then goto sleep until the subprocess writes something to the
**  mailbox
*/
    if (TEST_STATUS)
	SYS$HIBER();
/*
** Return the final status to the caller
*/
    return status;
}

/*		    DCL POST READ I/O
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This routine is called to read in the output that the subprocess
**	    got back from the command that it issued.  The routine will
**	    keep reading until there is no more output to be read.
**
**  FORMAL PARAMETERS:
**
**      process_info	->  Pointer to structure containing information on
**				the subprocess
**
**  IMPLICIT INPUTS:
**
**      none
**
**  IMPLICIT OUTPUTS:
**
**      none
**
**  FUNCTION VALUE:
**
**      System service return
**
**  SIDE EFFECTS:
**
**      none
**
**--
**/
unsigned    int	dcl_post_read_io(
		    char	*buffer_address,
		    int		buffer_length)
{
    unsigned	int		status = SS$_NORMAL;
/*
** Read in the output that the suprocess has written to the mailbox
*/
    status = SYS$QIO(				/* Issue the IO request */
		 0,				/* No event flag */
		 dcl.output_channel,		/* IO channel */
		 IO$_READVBLK,			/* IO function - READ */
		 &dcl.output_iosb,		/* IO status block */
		 &read_ast,			/* AST address */
		 0,				/* No AST arguement */
		 buffer_address,		/* Buffer address */
		 buffer_length,			/* Buffer length */
		 0, 0, 0, 0);			/* No more arguements */
    SYS$HIBER();
    if (TEST_STATUS)
	status = dcl.output_iosb.status;
    return status;
}

/*		    POST TERMINATION READ
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This routine is used to post an Asyncronous I/O to read information
**	    off the termination channel.  When the subprocess is terminated
**	    a final message will be written to that channel.
**
**  FORMAL PARAMETERS:
**
**      process_info	->  Pointer to block containing information about
**				the subprocess
**
**  IMPLICIT INPUTS:
**
**      none
**
**  IMPLICIT OUTPUTS:
**
**      none
**
**  FUNCTION VALUE:
**
**      System Service routine
**
**  SIDE EFFECTS:
**
**      An Asyncronous I/O will be outstanding until subprocess terminates
**
**--
**/
unsigned    int	post_termination_read(
		    struct	dcl_structure	*process_info)
{
/*
** Post an async IO on the termination channel
*/
    return  SYS$QIO(				/* Issue the IO request */
		 0,				/* No event flag */
		 process_info->term_channel,	/* IO channel */
		 IO$_READVBLK,			/* IO function - READ */
		 &process_info->term_iosb,	/* IO status block */
		 &term_ast,			/* Address of AST routine */
		 0,				/* No Ast arguements */
		 &term_buffer,			/* Buffer address */
		 255,				/* Buffer length */
		 0, 0, 0, 0);			/* No more arguements */
}

/*		    WAKE-UP AST
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This is the AST routine called when the subprocess writes something
**	    to the mailbox.  The routine will wake up the current process
**	    and then exit.
**
**  FORMAL PARAMETERS:
**
**      none
**
**  IMPLICIT INPUTS:
**
**      none
**
**  IMPLICIT OUTPUTS:
**
**      none
**
**  COMPLETION CODES:
**
**      none
**
**  SIDE EFFECTS:
**
**      The process is woken back up
**
**--
**/
wake_ast()
{
/*
** Wake up the process
*/
    SYS$WAKE(		/* Wake up the process */
	0,		/* No PID, use our own */
	0);		/* No Process Name, use our own */
}

/*		    Subprocess TERMINATION AST
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This is the AST routine called when the subprocess terminates.
**
**  FORMAL PARAMETERS:
**
**      none
**
**  IMPLICIT INPUTS:
**
**      none
**
**  IMPLICIT OUTPUTS:
**
**      none
**
**  COMPLETION CODES:
**
**      none
**
**  SIDE EFFECTS:
**
**      The process is woken back up
**
**--
**/
term_ast()
{
    printf("\n  *** ATTN*** The accounting subprocess has terminated\n");
}

/*		    READ I/O AST
**++
**  FUNCTIONAL DESCRIPTION:
**
**      This AST routine is called when the Asyncronous read of the mailbox
**	    completes.  At that point we will wake up the current process.
**
**  FORMAL PARAMETERS:
**
**      none
**
**  IMPLICIT INPUTS:
**
**      none
**
**  IMPLICIT OUTPUTS:
**
**      none
**
**  COMPLETION CODES:
**
**      none
**
**  SIDE EFFECTS:
**
**      The current process is started up again
**
**--
**/
read_ast()
{
    SYS$WAKE(		/* Wake up the process */
	0,		/* No PID, use our own */
	0);		/* No Process Name, use our own */
}
----------------------------End of DCL command program-------------------------

----------------------------Required include file------------------------------
/*
**++
**  FACILITY:
**
**      Stevens Accounting System
**
**  ABSTRACT:
**
**      [@tbs@]
**
**  AUTHORS:
**
**      [@tbs@]
**
**
**  CREATION DATE:     14-July-1987
**
**  MODIFICATION HISTORY:
**--
**/

/*
** Define TEST_STATUS, to see if an error was returned or not
*/
#define	TEST_STATUS	(status & 1)
/*
** Parameters -- Standard VMS Specific parameters
*/

#define	MAX_USERNAME	39		/* Maximum number of characters in a user name */

/*
 * A macro, $DESCRIPTOR, is defined in the file included above, and can be
 * used to declare descriptors for the usual C strings (NUL-terminated arrays
 * of char).  This macro is not adequate for all the cases requiring descriptors
 * in this program, however, so we must define a few more macros:
 *
 * $DESCRIPTOR1 can be used for 1-character items, or for whole structures
 * $DESCRIPTORM can be used for strings that are structure members, or for
 *		any other string not terminated by a NUL character
 * $DESCRIPTORA generates an array descriptor, and is used to describe
 *		the workspaces and terminal control area
 *
 * LENGTH and POINTER are useful shorthands for accessing descriptor fields
 */

#define $DESCRIPTOR1(name,string)	struct dsc$descriptor_s \
name = { sizeof(string), DSC$K_DTYPE_T, DSC$K_CLASS_S, &string }

#define $DESCRIPTORM(name,string)	struct dsc$descriptor_s \
name = { sizeof(string), DSC$K_DTYPE_T, DSC$K_CLASS_S, string }

#define $DESCRIPTORA(name,array,type)	struct dsc$descriptor_a \
name = { sizeof (type), DSC$K_DTYPE_L, DSC$K_CLASS_A, array, 0, 0, { 0, 0, 0, 0, 0 }, 1, sizeof array }

#define LENGTH(descriptor)	descriptor.dsc$w_length
#define POINTER(descriptor)	descriptor.dsc$a_pointer
#define $INIT_DESCRIPTOR	{0, DSC$K_DTYPE_T, DSC$K_CLASS_D, 0}
#define	$STATIC_DESCRIPTOR	{0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}

/*
** Structure definitions
**
** key_word_list - Structure to define what a keywork list is.
**
*/
struct	key_word_list
{
    struct dsc$descriptor *keyword;	    /* Pointer to keyword */
    unsigned int keyword_information;	    /* keyword specific information */
};

/*
** Standard VAX/VMS item list definitions.  This item lists are used for various
** system service calls.  There are two flavors basic flavors, the three item
** item list and the two item item lits.
*/

struct	item_list_2
{
    unsigned short  buffer_length;		/* Length of the buffer */
    unsigned short  item_code;			/* Item code */
    unsigned int    *buffer_address;		/* Address of the buffer */
};

struct	item_list_3
{
    unsigned short  buffer_length;		/* Length of the buffer */
    unsigned short  item_code;			/* Item code */
    unsigned int    *buffer_address;		/* Address of the buffer */
    unsigned int    *return_length_address;	/* Returned information */
};

struct	item_list_acct
{
    unsigned short  buffer_length;		/* Length of the buffer */
    unsigned short  item_code;			/* Item code */
    unsigned char   buffer[];			/* Buffer */
};

/*
** Definitions for the item list descriptor
*/
#define	DSC$ITEMLIST {0, DSC$K_DTYPE_T, DSC$K_CLASS_D, 0}

/*
** Accounting information is passed in the program as an item list.  That is it
** will conform to Digital's standard idea of what an item list is, except that
** the information that is contained in the item list will no be a pointer to
** any information, but the information itself.
**
** Information types:
**  - String:  - Stored as ASCIZ with a byte count.
**  - Numbers: - Stored as a long word.
**
*/

/*
** All item codes are stored in ranges.
**
**     1 -  99	    UAF associated data
**   100 - 199	    Diskquota associated data
**   200 - 299	    Project associated data
**   300 - 399	    Quantum RS user associated data
**   400 - 499	    Quantum RS group associated data
**
** New items are added on the end.
**
*/

#define	ITM_END_OF_LIST	   0	    /* End of the item list */

/*
** General item codes
*/
#define	ITM_UIC		1	    /* General UIC */

/*
** UAF Item codes
*/

#define	ITM_UAF_OWNER	10	    /* Owner name */
#define	ITM_UAF_ACCOUNT	11	    /* Account */
#define	ITM_UAF_DEVICE	12	    /* Default device name */
#define	ITM_UAF_DIRECTORY 13	    /* Default directory name */
#define	ITM_UAF_EXPIRATION 14	    /* Expiration date/time */
#define	ITM_UAF_UIC	15	    /* UAF UIC */

/*
** Diskquota item codes
*/

#define	ITM_DISK_PERM	30	    /* Diskquota - Perm */

/*
**  Quantum RS user item codes
*/
#define ITM_USN_INACTIVE		310	/* Inactive flag */
#define ITM_USN_BILLABLE		311	/* Billable flag */
#define ITM_USN_POST_DISK_USAGE		312	/* Post disk usage flag */
#define ITM_USN_POST_SESSION_USAGE	313	/* Post session resource usage */

/*
**  Rate schedule associated with each user for each node.
*/
#define ITM_USN_VXA_RATES		320	/* Rate schedule used (SITVXA) */
#define ITM_USN_VXB_RATES		321	/* Rate schedule used (SITVXB) */
#define ITM_USN_VXC_RATES		322	/* Rate schedule used (SITVXC) */
/*
**  Text descriptions of the users for each node.
*/
#define ITM_USN_VXA_DESCRIPTION		330	/* SITVXA user description (text) */

#define ITM_USN_VXB_DESCRIPTION		331	/* SITVXB user description (text) */

#define ITM_USN_VXC_DESCRIPTION		332	/* SITVXC user description (text) */

/*
**  Quantum RS group item codes
*/
#define ITM_GRP_ACTIVE		410	/* Inactive flag */
#define ITM_GRP_BILLABLE	411	/* Billable flag */
#define ITM_GRP_AGGREGATE	412	/* Aggregate usage across group members*/
#define ITM_GRP_RATES		413	/* Group rate schedule */
#define ITM_GRP_CHG_COUNT	414	/* Group charge count */
#define ITM_GRP_INIT_DATE	415	/* Group initialization date */
#define ITM_GRP_MOD_COUNT	416	/* Modification count */
#define ITM_GRP_LAST_MOD_DATE	417	/* Last modification date */
#define ITM_GRP_DESCRIPTION	420	/* Group description (text) */

/*
** The following structure is used to map an item list item to a field in the
** current form that is being processed.  This structure is used by all the
** modules to store the item list items into the form.
*/

struct	item_field_mapping
{
    unsigned short  item_type;		/* Item type to make from */
    struct dsc$descriptor *field_name;	/* Field name */
};

/*
** VAX/VMS I/O status block (IOSB) structure definition
*/

struct	io_status_block
    {
	unsigned short	int status;		/* Final status */
	unsigned short	int count;		/* Byte count for many devices */
	unsigned long	devdepend;		/* Device dependent part */
    };

/*
** The following definitions are required by the routines that handle the
**	processing of the local databases.  These databases include:
**		Available UIC Database
**		Group Definition Database
**		Account Definition Database
*/

/* Define flags to specify which type of UIC Number to process */

#define	    FIND_UIC_MEMBER_NUMBER  1	/* Find a free UIC Member Number */
#define	    FIND_UIC_GROUP_NUMBER   2	/* Find a free UIC Group Number */

/* 
** Define the UIC Number Catagories, which are actually indexes into
**  an initial value array
*/

#define	    CGY$C_SYSTEM	    0   /* Use valid System UIC's */
#define	    CGY$C_COMP_CENTER	    1   /* Use valid Computer Center UIC's */
#define	    CGY$C_DEPARTMENT	    2   /* Use valid Departmental UIC's */
#define	    CGY$C_RESEARCH	    3   /* Use valid Research UIC's */
#define	    CGY$C_SPECIAL	    4   /* Use valid Special project UIC's */
#define	    CGY$C_GRADUATE	    5   /* Use valid Graduate UIC's */
#define	    CGY$C_UNDERGRADUATE	    6   /* Use valid Undergraduate UIC's */

--------------------------End of include file----------------------------------

 Good luck, and thanks for those who sent me help

 David L. Stevens
 Stevens Tech

 CCnet:		SITVXC::DSTEVENS
 BITnet:	DSTEVENS@SITVXA
 INTERnet:	DSTEVENS@VAXC.STEVENS-TECH.EDU

 Disclaimer:	It's not my fault

------------

