MODULE LIB$EXECUTE_CLI (
		%TITLE 'Execute CLI Command'
		IDENT = 'V02-002'
		) =
BEGIN

!
!****************************************************************************
!*									    *
!*  COPYRIGHT (c) 1979, 1980                                                *
!*  BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.			    *
!* 									    *
!*  THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED  *
!*  ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE  *
!*  INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER  *
!*  COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY  *
!*  OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY  *
!*  TRANSFERRED.							    *
!* 									    *
!*  THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE  *
!*  AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT  *
!*  CORPORATION.							    *
!* 									    *
!*  DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS  *
!*  SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.		    *
!*									    *
!****************************************************************************
!

!++
! FACILITY: General Purpose Library
!
! ABSTRACT:
!
!	Contains a routine to create a subprocess to execute a Command
!	Language Interpreter (DCL, MCR, etc.) command or commands.
!
! ENVIRONMENT: User mode - non-AST reentrant
!
! AUTHOR: Len Kawell, CREATION DATE: 21-May-1979
!
! MODIFICATION HISTORY:
!
!	V02-002 LMK0001		Len Kawell		14-Mar-1980
!		Correct event flag deallocation.
!--

!
! SWITCHES:
!

SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE);

!
! TABLE OF CONTENTS:
!

FORWARD ROUTINE
    LIB$EXECUTE_CLI,			! Execute CLI command(s)
    EXIT_HANDLER,			! Exit handler
    TRM_HANDLER;			! Subprocess termination handler

!
! INCLUDE FILES:
!
LIBRARY 'SYS$LIBRARY:STARLET.L32';		! VAX/VMS common definitions
!
! MACROS:
!
MACRO
	DESC(STR)=UPLIT(%CHARCOUNT(STR),UPLIT BYTE(STR))%; ! String descriptor


!
! EQUATED SYMBOLS:
!
LITERAL
	ESC		= %X'1B',		! ASCII escape
	LOGNAM_SIZ	= 64;			! Maximum logical name size

!
! PSECT DEFINITIONS:
!
PSECT
	CODE		= _LIB$EXECUTE_CLI (SHARE,NOPIC),
	PLIT		= _LIB$EXECUTE_CLI (SHARE,NOPIC);
!
! OWN STORAGE:
!

!
! EXTERNAL REFERENCES:
!
EXTERNAL ROUTINE
	LIB$GET_EF,				! Allocates event flag number
	LIB$FREE_EF;				! Deallocates event flag numbers


GLOBAL ROUTINE LIB$EXECUTE_CLI (
	COMMAND1,
	COMMAND2
	) =
%SBTTL 'LIB$EXECUTE_CLI - Execute CLI Command'

!++
! FUNCTIONAL DESCRIPTION:
!
!	LIB$EXECUTE_CLI creates a subprocess to execute a CLI command
!	or commands.  To do this it first creates two mailboxes, one
!	to be used as the subprocess's input device, and one to receive
!	the subprocess's termination status.  This routine then creates
!	the subprocess running SYS$SYSTEM:LOGINOUT.EXE.  This will
!	initiate the appropriate command interpreter reading commands
!	from the input mailbox.
!
!	When the subprocess terminates, the termination status will
!	be placed in the termination mailbox and returned to the caller.
!
!
!
! CALLING SEQUENCE:
!
!	status.wlc.v = LIB$GET_FOREIGN (command1.rt.dx [,command2...] [,commandn])
!
!
! FORMAL PARAMETERS:
!
!	command1		- A string passed by descriptor which
!				is the first command to be executed.
!
! 	command2 - commandn	- Optional strings passed by descriptor
!				which are other commands to be executed.
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! COMPLETION CODES:
!
!	SS$_NORMAL     - Successful completion
!
!	SS$_XXXXX	- Any of many system service failures.
!
!
! SIDE EFFECTS:
!
!	NONE
!
!--
BEGIN
!
! BUILTIN DECLARATIONS:
!
BUILTIN
    ACTUALCOUNT,			! Number of actual parameters
    ACTUALPARAMETER;			! Value of parameter
LOCAL
	OUTPUT_DESC	: VECTOR[2],		! Output logical name descriptor
	OUTPUTBUF	: VECTOR[LOGNAM_SIZ,BYTE], ! Output logical name buffer
	OUTPUTBUF_DESC	: VECTOR[2],		! Output logical name buffer desc
	CMDMBXCHAN	: VECTOR[1,WORD],	! Command mailbox channel
	CMDMBXNAMBUF	: VECTOR[LOGNAM_SIZ,BYTE], ! Command mailbox name buffer
	CMDMBXNAM_DESC	: VECTOR[2],		! Command mailbox name desc
	CMDMBXEFN	: VECTOR[1],		! Command mailbox event flag number
	CMDMBXIOSB	: VECTOR[2],		! Termination mailbox IOSB
	TRMMBXCHAN	: VECTOR[1,WORD],	! Termination mailbox channel
	TRMMBXEFN	: VECTOR[1],		! Termination mailbox event flag number
	TRMMBXIOSB	: VECTOR[2],		! Termination mailbox IOSB
	TRMMSGBUF	: BLOCK[ACC$K_TERMLEN,BYTE], ! Termination message buffer
	CHARBUF		: BLOCK[DIB$K_LENGTH+16,BYTE], ! Characteristics buffer
	CHARBUF_DESC	: VECTOR[2],		! Characteristics buffer desc
	EXITSTATUS	: VECTOR[1],		! Image exit status
	EXITBLOCK	: VECTOR[5];		! Exit control block

REGISTER
	STATUS		;			! Routine call status

BIND
	NULL		= DESC('NL:')
			: VECTOR[2],
	SYSOUTPUT	= DESC('SYS$OUTPUT')	! SYS$OUTPUT logical name
			: VECTOR[2],
	DEVNAMFMT	= DESC('_!AC!UW:'),	! Device name format
	SUBPID		= EXITBLOCK[4];		! Subprocess ID

LABEL
	MAIN_BLOCK;				! Name of main block

!
! Zero mailbox channels and event flag numbers, and the subprocess
! ID so we can unconditionally deassign, deallocate, and delete them
! in case of a failure in the middle of execution.
!
TRMMBXCHAN = CMDMBXCHAN = TRMMBXEFN = CMDMBXEFN = SUBPID = 0;
!
! Main block of code in routine
!
STATUS =
MAIN_BLOCK:
	BEGIN
	MACRO
		CKSTATUS[] = 			! Check routine status
			BEGIN
			 LOCAL STATUS;
			 STATUS = (%REMAINING);
			 IF NOT .STATUS THEN LEAVE MAIN_BLOCK WITH .STATUS;
			END%;
	!
	! Get translation of current SYS$OUTPUT logical name
	!
	OUTPUT_DESC[0] = .SYSOUTPUT[0];		! Initialize output logical
	OUTPUT_DESC[1] = .SYSOUTPUT[1];		! name descriptor
	OUTPUTBUF_DESC[0] = LOGNAM_SIZ;		! Initialize output
	OUTPUTBUF_DESC[1] = OUTPUTBUF;		! logical name buffer desc
	DO
		BEGIN
		STATUS = $TRNLOG(LOGNAM=OUTPUT_DESC, ! Translate name
				 RSLLEN=OUTPUT_DESC[0],
				 RSLBUF=OUTPUTBUF_DESC);
		OUTPUT_DESC[1] = OUTPUTBUF;	! Set pointer to translation
		IF (.OUTPUTBUF[0] EQLU ESC) AND	! If name is RMS process
		   (.OUTPUTBUF[1] EQLU 0)	! permanent file name,
		THEN				! strip escape and IFI
			BEGIN
			OUTPUT_DESC[0] = .OUTPUT_DESC[0] - 4;
			OUTPUT_DESC[1] = .OUTPUT_DESC[1] + 4;
			END;
		END
	UNTIL NOT .STATUS OR (.STATUS EQLU SS$_NOTRAN);
	IF .STATUS NEQU SS$_NOTRAN THEN LEAVE MAIN_BLOCK WITH .STATUS;
	!
	! Create the command mailbox and get its name
	!
	CKSTATUS($CREMBX(CHAN=CMDMBXCHAN));	! Create mailbox
	CHARBUF_DESC[0] = DIB$K_LENGTH + 16;	! Initialize characteristics
	CHARBUF_DESC[1] = CHARBUF;		! buffer descriptor
	CKSTATUS($GETCHN(CHAN=.CMDMBXCHAN,	! Get mailbox characteristics
			 PRIBUF=CHARBUF_DESC));
	CMDMBXNAM_DESC[0] = LOGNAM_SIZ;		! Initialize mailbox name
	CMDMBXNAM_DESC[1] = CMDMBXNAMBUF;	! buffer descriptor
	CKSTATUS($FAO(				! Format mailbox name
			DEVNAMFMT,		! control string
			CMDMBXNAM_DESC,		! output length address
			CMDMBXNAM_DESC,		! output buffer desc address
			(.CHARBUF[DIB$W_DEVNAMOFF] + CHARBUF),
			.CHARBUF[DIB$W_UNIT]));
	!
	! Create the termination mailbox and get its number
	!
	CKSTATUS($CREMBX(CHAN=TRMMBXCHAN));	! Create the mailbox
	CKSTATUS($GETCHN(CHAN=.TRMMBXCHAN,	! Get its characteristics
			 PRIBUF=CHARBUF_DESC));
	!
	! Declare an exit handler to delete the subprocess if we (the
	! creator) are rundown.
	!
	EXITBLOCK[1] = EXIT_HANDLER;		! Set exit handler address
	EXITBLOCK[2] = 2;			! Set argument count
	EXITBLOCK[3] = EXITSTATUS;		! Set address to store
						! exit status
	CKSTATUS($DCLEXH(DESBLK=EXITBLOCK));	! Declare exit handler
	!
	! Create the subprocess running the LOGIN image.  LOGIN will
	! initiate a command interpreter to read and execute the commands
	! we'll write in the command mailbox.
	!
	OUTPUT_DESC[0] = .NULL[0];
	OUTPUT_DESC[1] = .NULL[1];
	CKSTATUS($CREPRC(IMAGE=DESC('SYS$SYSTEM:LOGINOUT'),
			 INPUT=CMDMBXNAM_DESC,
			 OUTPUT=OUTPUT_DESC,
			 ERROR=OUTPUT_DESC,
			 MBXUNT=.CHARBUF[DIB$W_UNIT],
			 PRCNAM=CMDMBXNAM_DESC,
			 BASPRI=4,
			 PIDADR=SUBPID));
	!
	! Issue a QIO request to read the termination mailbox specifying
	! an AST routine.  If the AST is delivered, the subprocess died
	! and we have to give up.
	!
	CKSTATUS(LIB$GET_EF(TRMMBXEFN));	! Allocate an event flag
	CKSTATUS(  $QIO(CHAN=.TRMMBXCHAN,	! Issue read QIO request
			EFN=.TRMMBXEFN,
			ASTADR=TRM_HANDLER,
			ASTPRM=.CMDMBXCHAN,
			FUNC=IO$_READLBLK,
			IOSB=TRMMBXIOSB,
			P1=TRMMSGBUF,
			P2=ACC$K_TERMLEN));
	!
	! Write the specified command strings to the command mailbox
	! so the subprocess can execute them.
	!
	CKSTATUS(LIB$GET_EF(CMDMBXEFN));	! Allocate an event flag
	INCR PARAM FROM 1 TO ACTUALCOUNT()
	DO
		BEGIN
		CKSTATUS($QIOW(	CHAN=.CMDMBXCHAN, ! Write command to mailbox
				EFN=.CMDMBXEFN,
				FUNC=IO$_WRITELBLK,
				IOSB=CMDMBXIOSB,
				P1=.(ACTUALPARAMETER(.PARAM) + 4),
				P2=.ACTUALPARAMETER(.PARAM)));
		STATUS = .CMDMBXIOSB<0,16>;	! Get completion status
		IF NOT .STATUS THEN LEAVE MAIN_BLOCK WITH .STATUS;
		END;
	!
	! Write an End-of-File marker to command mailbox.
	!
	CKSTATUS($QIOW( CHAN=.CMDMBXCHAN,	! Write EOF
			EFN=.CMDMBXEFN,
			FUNC=IO$_WRITEOF,
			IOSB=CMDMBXIOSB));
	STATUS = $WAITFR(EFN=.TRMMBXEFN)	! Wait for subprocess
						! to complete
	END;
!
! Cleanup everything that we used...
!
$DELPRC(PIDADR=SUBPID);				! Make sure subprocess
						! is stopped
$DASSGN(CHAN=.CMDMBXCHAN);			! Deassign the mailbox
$DASSGN(CHAN=.TRMMBXCHAN);			! channels
LIB$FREE_EF(CMDMBXEFN);				! Deallocate event flag
LIB$FREE_EF(TRMMBXEFN);				! numbers
$CANEXH(DESBLK=EXITBLOCK);			! Cancel exit handler
IF .STATUS OR					! If success or
   (.STATUS EQLU SS$_CANCEL) OR			! subprocess died or
   (.STATUS EQLU SS$_IVCHAN)			! subprocess died before
						! a command was written,
THEN
	STATUS = .TRMMSGBUF[ACC$L_FINALSTS];	! Get subprocess status
RETURN .STATUS					! Return the status
END;

ROUTINE TRM_HANDLER(CMDMBXCHAN)  =
!++
! FUNCTIONAL DESCRIPTION:
!
!	AST_HANDLER is an AST service routine that gets called when
!	the read QIO request to the subprocess termination mailbox
!	completes.  This indicates that the subprocess has been rundown.
!
!	If the subprocess died prematurely, in other words before it
!	executed all the commands, then any writes to the command
!	mailbox must be cancelled.  It might also happen that the
!	subprocess dies before or between writing to the command mailbox.
!	To avoid this kind of race condition, this routine calls
!	SYS$DASSGN to cancel all I/O and deassign the channel.
!
! INPUTS:
!
!	cmdmbxchan		- Command mailbox channel number
!
! OUTPUTS:
!
!	All I/O requests on the command mailbox channel are canceled
!	and the channel is deassigned.
!
!++
BEGIN
	$DASSGN(CHAN=.CMDMBXCHAN)		! Deassign channel
END;

ROUTINE EXIT_HANDLER(EXITSTATUS,SUBPID) =
!++
! FUNCTIONAL DESCRIPTION:
!
!	EXIT_HANDLER is called as an image exit handler when the
!	current process is rundown.  Its only function is to delete
!	the subprocess.
!
! INPUTS:
!
!	EXITSTATUS		- Address of exit status.
!
!	SUBPID			- Subprocess ID.
!
! OUTPUTS:
!
!	Subprocess deleted.
!
!--
BEGIN
	$DELPRC(PIDADR=SUBPID)			! Delete the subprocess
END;


END				!End of module
ELUDOM