%(
	****************************************************************

		Copyright (c) 1992, Carnegie Mellon University

		All Rights Reserved

	Permission  is  hereby  granted   to  use,  copy,  modify,  and
	distribute  this software  provided  that the  above  copyright
	notice appears in  all copies and that  any distribution be for
	noncommercial purposes.

	Carnegie Mellon University disclaims all warranties with regard
	to this software.  In no event shall Carnegie Mellon University
	be liable for  any special, indirect,  or consequential damages
	or any damages whatsoever  resulting from loss of use, data, or
	profits  arising  out of  or in  connection  with  the  use  or
	performance of this software.

	****************************************************************
)%
MODULE
    Routines (
	ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE,
			NONEXTERNAL=LONG_RELATIVE),
	IDENT='1.0',
	LIST (ASSEMBLY, BINARY, NOEXPAND),
	LANGUAGE(BLISS32)) =
BEGIN
!++
! ROUTINES.BLI	Copyright (c) 1989	Carnegie Mellon University
!
! Description:
!
!	Routines called by IPNCP.  See IPNCP_PARSE.CLD for details
!
! Author:	Bruce R. Miller		CMU Network Development
! Date:		September 6, 1989
!
! Modifications:
!
! 04-Oct-1990	Bruce R. Miller		CMU Network Development
!		Removed extraneous code from SPAWN.
!		

! 12-Sep-1990	Bruce R. Miller		CMU Network Development
!		Moved help lib from SYS$HELP to CMUTEK_ROOT:[SYSHLP]
!--

!!!HACK!!! don't just Signal .status; DO A RETURN AFTERWARDS!!!

LIBRARY 'SYS$LIBRARY:STARLET';
LIBRARY 'CLI';
LIBRARY 'IPNCP';
LIBRARY 'CMUIP_SRC:[central]netconfig';
LIBRARY 'CMUIP_SRC:[central]netcntrl';
LIBRARY 'CMUIP_SRC:[central]netcommon';

REQUIRE 'RRFETCH';

EXTERNAL ROUTINE
	CLI$PRESENT : BLISS ADDRESSING_MODE(GENERAL),
	CLI$GET_VALUE : BLISS ADDRESSING_MODE(GENERAL);

EXTERNAL
    config : REF IPNCP_Config_Struct;	! One page.

BIND
    NETNAME = %ASCID'INET$DEVICE';


GLOBAL ROUTINE Get_Switch_Value (
	Switch_A,
	Value_A,
	Logical_Name_A,
	Default_Value_A) =
!++
! Functional Description:
!
!	Routine to return a switch value.  Is (in this module) passed
!	a descriptor switch and a descriptor return value (into which the 
!	switch value is returned.
!	If string contains a double quote, it is filtered out.
!--
    BEGIN
    BIND
	Switch		= .Switch_A		: $BBLOCK,
	Value		= .Value_A		: $BBLOCK,
	Logical_Name	= .Logical_Name_A	: $BBLOCK,
	Default_Value	= .Default_Value_A	: $BBLOCK;
    EXTERNAL ROUTINE
	CLI$GET_VALUE	: BLISS ADDRESSING_MODE (GENERAL),
	STR$COPY_DX	: BLISS ADDRESSING_MODE (GENERAL);
    BUILTIN
	NULLPARAMETER;
    LOCAL
	Temp_Buffer	: VECTOR [128, BYTE],
	Temp_String	: $BBLOCK [DSC$K_S_BLN] PRESET(
			[DSC$W_LENGTH]	= %ALLOCATION (Temp_Buffer),
			[DSC$B_DTYPE]	= DSC$K_DTYPE_Z,
			[DSC$B_Class]	= DSC$K_CLASS_Z,
			[DSC$A_POINTER]	= Temp_Buffer),
	Status;

    Status = CLI$GET_VALUE (Switch, Value);
    IF (.Status EQLU CLI$_ABSENT) AND NOT NULLPARAMETER (Logical_Name_A)
	THEN BEGIN
	LOCAL
	    Length	: WORD INITIAL (0);
	IF (
		$TRNLOG (
		    LOGNAM = Logical_Name,
		    RSLLEN = Length,
		    RSLBUF = Temp_String)
		EQLU
		SS$_NORMAL
	    ) THEN
	    BEGIN
	    Status = CLI$_PRESENT;
	    Temp_String [DSC$W_LENGTH] = .Length;
	    STR$COPY_DX (Value, Temp_String);
	    END;
	END;

    IF	(.Status EQLU CLI$_ABSENT) AND NOT NULLPARAMETER (Default_Value_A)
	THEN BEGIN
	Status = CLI$_DEFAULTED;
	STR$COPY_DX (Value, Default_Value);
	END;

    .Status
    END;

GLOBAL ROUTINE IPNCP_ForceX =
!++
!  COMMAND:	ForceX
!
!	Forces exit of a given process.
!
!--
    BEGIN
    EXTERNAL ROUTINE
	OTS$CVT_TZ_L	: BLISS ADDRESSING_MODE (GENERAL),
	STR$FREE1_DX	: BLISS ADDRESSING_MODE(GENERAL);
    EXTERNAL LITERAL
	IPNCP$_Arg;
    LOCAL
	pid : INITIAL(0),
	rcode : INITIAL(SS$_NORMAL),
	Number		:  VOLATILE $BBLOCK [DSC$K_S_BLN] PRESET (
					[DSC$W_LENGTH]	= 0,
					[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
					[DSC$B_CLASS]	= DSC$K_CLASS_D,
					[DSC$A_POINTER]	= 0),
	Status;

    ! Get the PID and return code.

    ! get dcl argument - hex value for Return code
    Status = CLI$PRESENT (%ASCID'PID');
    IF .Status THEN Status = CLI$GET_VALUE (%ASCID 'PID', Number);
    IF .Status
	THEN BEGIN
	Status = OTS$CVT_TZ_L (Number, pid);
	IF NOT .Status THEN Signal (IPNCP$_Arg, 1, Number, .Status);
	END;

    ! get dcl argument - hex value for Return code
    Status = CLI$PRESENT (%ASCID'RCode');
    IF .Status THEN Status = CLI$GET_VALUE (%ASCID 'RCODE', Number);
    IF .Status
	THEN BEGIN
	Status = OTS$CVT_TZ_L (Number, rcode);
	IF NOT .Status THEN Signal (IPNCP$_Arg, 1, Number, .Status);
	END;

    ! Do the actual pinging.
    PrintTT('  Attempting to force exit of process !XL with RC=!XL.!/',
	.pid,.RCode);
    Status = $FORCEX ( PIDADR = pid , CODE = .RCode );
    IF NOT .Status THEN Signal (.Status);

    Status = STR$FREE1_DX (Number);
    IF NOT .Status THEN Signal (.Status);

    SS$_NORMAL
    END;



GLOBAL ROUTINE Exit_IPNCP =
!++
! Description:
!
!	A CLI Dispatch routine to exit the IPNCP Utility.
!
! Note:
!
!	As the End Of File condition must not be stopped.
!--
    BEGIN

    RMS$_EOF
    END;



GLOBAL ROUTINE IPNCP_Help =
!++
!  COMMAND:	HELP
!
!  Will give user a little help.
!
!--
    BEGIN
    EXTERNAL ROUTINE
	LBR$OUTPUT_HELP : BLISS ADDRESSING_MODE(GENERAL),
	IPNCP_Get_Input	: BLISS ADDRESSING_MODE(GENERAL),
	LIB$PUT_OUTPUT	: BLISS ADDRESSING_MODE(GENERAL),
	STR$FREE1_DX	: BLISS ADDRESSING_MODE(GENERAL);
    LOCAL
	Flag,
	Line		:  VOLATILE $BBLOCK [DSC$K_S_BLN] PRESET (
					[DSC$W_LENGTH]	= 0,
					[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
					[DSC$B_CLASS]	= DSC$K_CLASS_D,
					[DSC$A_POINTER]	= 0),
	Status;

    ! Set the help options

    Status = Get_Switch_Value(%ASCID'Help_line',Line);
    IF NOT .Status THEN
	IF .Status NEQU CLI$_ABSENT THEN
	    Signal (.Status);
!	    Signal (IPNCP$_NO_SWITCH, 1, %ASCID'HELP', .Status);

    Flag = HLP$M_PROMPT OR HLP$M_HELP;
    Status = LBR$OUTPUT_HELP (
			LIB$PUT_OUTPUT,
			0,
			Line,
			%ASCID 'CMUIP_ROOT:[SYSHLP]IPNCP.HLB',
			Flag,
			IPNCP_Get_Input);
!    IF NOT .Status THEN	Signal (IPNCP$_ERROR, 0, .Status);
    IF NOT .Status THEN	Signal (.Status);

    Status = STR$FREE1_DX (Line);
    IF NOT .Status THEN Signal (.Status);

    SS$_NORMAL
    END;



GLOBAL ROUTINE IPNCP_HostNm =
    BEGIN
    EXTERNAL ROUTINE
	Do_Hostnm,
	CLI$GET_VALUE	: BLISS ADDRESSING_MODE (GENERAL);
    LOCAL
	Host_Name	: $BBLOCK [DSC$K_S_BLN],
	Status;

    $Init_DynDesc (Host_Name);

    WHILE 1 DO
	BEGIN
	Status = CLI$GET_VALUE (%ASCID 'HOST_NAME', Host_Name);
	IF NOT .Status THEN EXITLOOP;

	Status = Do_HostNm (Host_Name);
	IF NOT .Status THEN Signal (.Status);
	END;

    SS$_NORMAL
    END;



GLOBAL ROUTINE IPNCP_Kill : NOVALUE =
!++
! Description:
!
!	A CLI Dispatch routine to dispatch the KILL command
!
!--
    BEGIN
    LOCAL
	DONE,
	STATUS,
	CONN_DESC : $BBLOCK[DSC$K_S_BLN] PRESET(
		[DSC$W_LENGTH] = 0,
		[DSC$B_DTYPE] = DSC$K_DTYPE_T,
		[DSC$B_CLASS] = DSC$K_CLASS_D,
		[DSC$A_POINTER] = 0),
	CONN_IDX;
    EXTERNAL ROUTINE
	LIB$CVT_DTB : BLISS ADDRESSING_MODE(GENERAL),
	! The next few routines are in NetStat.bli
	DO_KILL_TCP,
	DO_KILL_UDP,
	DO_KILL_ICMP;
    LOCAL
	NETCHAN;	! Holds the channel ID.

! Assign the network device

    IF NOT (STATUS = $ASSIGN(DEVNAM=NETNAME,CHAN=NETCHAN)) THEN
	BEGIN
	Signal(.status);
	RETURN .Status
	END;

    DONE = 0;

    ! Connection-ID specified - Kill a TCP connection
    IF CLI$PRESENT(%ASCID'CONN_ID') THEN
	BEGIN
	CLI$GET_VALUE(%ASCID'CONN_ID',CONN_DESC);
	LIB$CVT_DTB(.CONN_DESC[DSC$W_LENGTH],.CONN_DESC[DSC$A_POINTER],
		    CONN_IDX);
	DO_KILL_TCP(.NETCHAN,.CONN_IDX);
	DONE = 1;
	END;

    ! /UDP:<id> - Kill one UDP connection

    IF CLI$PRESENT(%ASCID'UDP_ID') THEN
	BEGIN
	CLI$GET_VALUE(%ASCID'UDP_ID',CONN_DESC);
	LIB$CVT_DTB(.CONN_DESC[DSC$W_LENGTH],.CONN_DESC[DSC$A_POINTER],
		    CONN_IDX);
	DO_KILL_UDP(.NETCHAN,.CONN_IDX);
	DONE = 1;
	END;

    ! /ICMP:<id> - Kill one ICMP connection

    IF CLI$PRESENT(%ASCID'ICMP_ID') THEN
	BEGIN
	CLI$GET_VALUE(%ASCID'ICMP_ID',CONN_DESC);
	LIB$CVT_DTB(.CONN_DESC[DSC$W_LENGTH],.CONN_DESC[DSC$A_POINTER],
		    CONN_IDX);
	DO_KILL_ICMP(.NETCHAN,.CONN_IDX);
	DONE = 1;
	END;

    ! Default

    IF NOT .DONE THEN
	PRINTTT('No connection selected...!/');

! Deassign the network device

    $DASSGN(CHAN = .NETCHAN)
    END;



GLOBAL ROUTINE IPNCP_NETEXIT : NOVALUE =
!++
! Description:
!
!	A CLI Dispatch routine to execute the NETEXIT command.
!
! Note:
!
!	This used to be the NETEXIT.EXE utility.
!--
    BEGIN
    EXTERNAL ROUTINE
	NetExit;

    NETEXIT()
    END;



GLOBAL ROUTINE IPNCP_NETLOG : NOVALUE =
!++
! Description:
!
!	A CLI Dispatch routine to execute the NETLOG sub-system.
!
! Note:
!
!	This used to be the NETLOG.EXE utility.
!--
    BEGIN
    EXTERNAL ROUTINE
	Do_NetLog,
	OTS$CVT_TI_L	: BLISS ADDRESSING_MODE (GENERAL);
    EXTERNAL LITERAL
	IPNCP$_Arg;
    LOCAL
	arg0	: $BBLOCK [DSC$K_S_BLN] PRESET (
			[DSC$W_LENGTH]	= 0,
			[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
			[DSC$B_CLASS]	= DSC$K_CLASS_D,
			[DSC$A_POINTER]	= 0),
	log_state	: INITIAL (0),
	RC;

    ! get dcl argument - hex value for setting of log state
    rc = CLI$PRESENT (%ASCID'DEBUG');
    IF .rc THEN rc = CLI$GET_VALUE (%ASCID 'DEBUG', arg0);
    IF .rc
	THEN BEGIN
	rc = OTS$CVT_TI_L (arg0, Log_State);
	IF NOT .rc THEN Signal (IPNCP$_Arg, 1, arg0, .rc);
	END;

    IF CLI$PRESENT (%ASCID 'PHYSICAL')	THEN Log_State < 0, 1> = 1;
    IF CLI$PRESENT (%ASCID 'ARP')	THEN Log_State < 1, 1> = 1;
    IF CLI$PRESENT (%ASCID 'IP')	THEN Log_State < 2, 1> = 1;
    IF CLI$PRESENT (%ASCID 'TCP')	THEN Log_State < 3, 1> = 1;
    IF CLI$PRESENT (%ASCID 'TCB_DUMP')	THEN Log_State < 4, 1> = 1;
    IF CLI$PRESENT (%ASCID 'USER')	THEN Log_State < 5, 1> = 1;
    IF CLI$PRESENT (%ASCID 'TCB_STATE')	THEN Log_State < 6, 1> = 1;
    IF CLI$PRESENT (%ASCID 'TCB_CHECK')	THEN Log_State < 7, 1> = 1;
    IF CLI$PRESENT (%ASCID 'ERROR')	THEN Log_State < 8, 1> = 1;
    IF CLI$PRESENT (%ASCID 'ICMP')	THEN Log_State < 9, 1> = 1;
    IF CLI$PRESENT (%ASCID 'UDP')	THEN Log_State <10, 1> = 1;

    ! What the heck, turn them all on
    IF CLI$PRESENT (%ASCID 'ALL')	THEN Log_State = %x'FFFF';

    Do_NetLog ( .Log_State , DBG$DEBUG)
    END;



GLOBAL ROUTINE IPNCP_NETLOG_ACTIVITY : NOVALUE =
!++
! Description:
!
!	A CLI Dispatch routine to execute the NETLOG sub-system.
!
!--
    BEGIN
    EXTERNAL ROUTINE
	Do_NetLog,
	OTS$CVT_TI_L	: BLISS ADDRESSING_MODE (GENERAL);
    EXTERNAL LITERAL
	IPNCP$_Arg;
    LOCAL
	arg0	: $BBLOCK [DSC$K_S_BLN] PRESET (
			[DSC$W_LENGTH]	= 0,
			[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
			[DSC$B_CLASS]	= DSC$K_CLASS_D,
			[DSC$A_POINTER]	= 0),
	log_state	: INITIAL (0),
	RC;

    ! get dcl argument - hex value for setting of log state
    rc = CLI$PRESENT (%ASCID'DEBUG');
    IF .rc THEN rc = CLI$GET_VALUE (%ASCID 'DEBUG', arg0);
    IF .rc
	THEN BEGIN
	rc = OTS$CVT_TI_L (arg0, Log_State);
	IF NOT .rc THEN Signal (IPNCP$_Arg, 1, arg0, .rc);
	END;

    IF CLI$PRESENT (%ASCID 'DEMONS')	THEN Log_State < 0, 1> = 1;
    IF CLI$PRESENT (%ASCID 'EVENTS')	THEN Log_State < 1, 1> = 1;
    IF CLI$PRESENT (%ASCID 'SECURITY')	THEN Log_State < 2, 1> = 1;

    ! What the heck, turn them all on
    IF CLI$PRESENT (%ASCID 'ALL')	THEN Log_State = %x'FFFF';

    Do_NetLog ( .Log_State , DBG$ACTIVITY)
    END;



GLOBAL ROUTINE IPNCP_NETSTAT : NOVALUE =
!++
! Description:
!
!	A CLI Dispatch routine to execute the NETSTAT sub-system.
!
! Note:
!
!	This used to be the NETSTAT.EXE utility.
!--
    BEGIN
    LOCAL
	DONE,
	STATUS,
	CONN_DESC : $BBLOCK[DSC$K_S_BLN] PRESET(
		[DSC$W_LENGTH] = 0,
		[DSC$B_DTYPE] = DSC$K_DTYPE_T,
		[DSC$B_CLASS] = DSC$K_CLASS_D,
		[DSC$A_POINTER] = 0),
	CONN_IDX;
    EXTERNAL ROUTINE
	LIB$CVT_DTB : BLISS ADDRESSING_MODE(GENERAL),
	! The next few routines are in NetStat.bli
	NETSTAT_DO_TCB,
	NETSTAT_DO_UDPCB,
	NETSTAT_DO_ICMPCB,
	NETSTAT_DO_STATS,
	NETSTAT_DO_MEMORY,
	NETSTAT_DO_ARP,
	NETSTAT_DO_DEVICE_LIST,
	NETSTAT_DO_LIST;
    EXTERNAL
	NETCHAN;	! Holds the channel ID.  Lives in NetStat.bli

! Assign the network device

    IF NOT (STATUS = $ASSIGN(DEVNAM=NETNAME,CHAN=NETCHAN)) THEN
	$EXIT(CODE=.STATUS);

    DONE = 0;

    ! Connection-ID specified - do one connection in detail
    IF CLI$PRESENT(%ASCID'CONN_ID') THEN
	BEGIN
	CLI$GET_VALUE(%ASCID'CONN_ID',CONN_DESC);
	LIB$CVT_DTB(.CONN_DESC[DSC$W_LENGTH],.CONN_DESC[DSC$A_POINTER],
		    CONN_IDX);
	NETSTAT_DO_TCB(.CONN_IDX);
	DONE = 1;
	END;

    ! /UDP:<id> - Print one UDP connection in detail

    IF CLI$PRESENT(%ASCID'UDP_ID') THEN
	BEGIN
	CLI$GET_VALUE(%ASCID'UDP_ID',CONN_DESC);
	LIB$CVT_DTB(.CONN_DESC[DSC$W_LENGTH],.CONN_DESC[DSC$A_POINTER],
		    CONN_IDX);
	NETSTAT_DO_UDPCB(.CONN_IDX);
	DONE = 1;
	END;

    ! /ICMP:<id> - Print one ICMP connection in detail

    IF CLI$PRESENT(%ASCID'ICMP_ID') THEN
	BEGIN
	CLI$GET_VALUE(%ASCID'ICMP_ID',CONN_DESC);
	LIB$CVT_DTB(.CONN_DESC[DSC$W_LENGTH],.CONN_DESC[DSC$A_POINTER],
		    CONN_IDX);
	NETSTAT_DO_ICMPCB(.CONN_IDX);
	DONE = 1;
	END;

    ! /STATISTICS - print statistics counters

    IF CLI$PRESENT(%ASCID'STATISTICS') THEN
	BEGIN
	NETSTAT_DO_STATS();
	DONE = 1;
	END;

    ! /MEMORY - print memory manager statistics

    IF CLI$PRESENT(%ASCID'MEMORY') THEN
	BEGIN
	NETSTAT_DO_MEMORY();
	DONE = 1;
	END;

    ! /ARP - Print ARP cache

    IF CLI$PRESENT(%ASCID'ARP') THEN
	BEGIN
	NETSTAT_DO_ARP();
	DONE = 1;
	END;

    ! /DEVICE - Print device list

    IF CLI$PRESENT(%ASCID'DEVICE') THEN
	BEGIN
	NETSTAT_DO_DEVICE_LIST();
	DONE = 1;
	END;

    ! Default - list all active connections

    IF NOT .DONE THEN
	NETSTAT_DO_LIST();

! Deassign the network device

    $DASSGN(CHAN = .NETCHAN);
!    $EXIT(CODE=SS$_NORMAL);
    END;



GLOBAL ROUTINE IPNCP_Ping =
!++
!  COMMAND:	PING
!
!	Test connectivity to an internet host by sending ICMP echo requests.
!
!--
    BEGIN
    EXTERNAL ROUTINE
	OTS$CVT_TI_L	: BLISS ADDRESSING_MODE (GENERAL),
	STR$FREE1_DX	: BLISS ADDRESSING_MODE(GENERAL),
	Ping;	! From PING.BLI
    EXTERNAL LITERAL
	IPNCP$_Arg;
    LOCAL
	datalength	: INITIAL (64-8),
	npings		: INITIAL (5),
	HostName	:  VOLATILE $BBLOCK [DSC$K_S_BLN] PRESET (
					[DSC$W_LENGTH]	= 0,
					[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
					[DSC$B_CLASS]	= DSC$K_CLASS_D,
					[DSC$A_POINTER]	= 0),
	Number		:  VOLATILE $BBLOCK [DSC$K_S_BLN] PRESET (
					[DSC$W_LENGTH]	= 0,
					[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
					[DSC$B_CLASS]	= DSC$K_CLASS_D,
					[DSC$A_POINTER]	= 0),
	Verbose : INITIAL (0),
	Bar : INITIAL (0),
	Status;

    ! Get the ping options
    ! Connection-ID specified - do one connection in detail
    IF CLI$PRESENT(%ASCID'HostName') THEN
	CLI$GET_VALUE(%ASCID'HostName',HostName)
    ELSE Signal (IPNCP$_NO_SWITCH, 1, %ASCID'PING', .Status);

    ! get dcl argument - hex value for packet length
    Status = CLI$PRESENT (%ASCID'DataLength');
    IF .Status THEN Status = CLI$GET_VALUE (%ASCID 'DataLength', Number);
    IF .Status
	THEN BEGIN
	Status = OTS$CVT_TI_L (Number, datalength);
	IF NOT .Status THEN Signal (IPNCP$_Arg, 1, Number, .Status);
	END;

    ! get dcl argument - hex value for number of pings.
    Status = CLI$PRESENT (%ASCID'N');
    IF .Status THEN Status = CLI$GET_VALUE (%ASCID 'N', Number);
    IF .Status
	THEN BEGIN
	Status = OTS$CVT_TI_L (Number, npings);
	IF NOT .Status THEN Signal (IPNCP$_Arg, 1, Number, .Status);
	END;

    ! get dcl argument - VERBOSE flag
    Status = CLI$PRESENT (%ASCID'VERBOSE');
    IF .Status THEN Verbose = 1;

    ! get dcl argument - BAR flag (Display RTT Bar graph)
    Status = CLI$PRESENT (%ASCID'BAR');
    IF .Status THEN Bar = 1;

    ! Do the actual pinging.
    PrintTT('  Pinging host !AS !UB times.!/',HostName,.npings);
    Ping(HostName,.datalength,.npings,.Verbose,.Bar);

    Status = STR$FREE1_DX (HostName);
    IF NOT .Status THEN Signal (.Status);

    SS$_NORMAL
    END;



GLOBAL ROUTINE IPNCP_RDate =
!++
!  COMMAND:	PING
!
!	Retrieve the time from a remote system and use it to set sys clock.
!
!--
    BEGIN
    EXTERNAL ROUTINE
	STR$APPEND	: BLISS ADDRESSING_MODE(GENERAL),
	STR$FREE1_DX	: BLISS ADDRESSING_MODE(GENERAL),
	Do_RDate;	! From RDate.c
    LOCAL
	HostName	:  VOLATILE $BBLOCK [DSC$K_S_BLN] PRESET (
					[DSC$W_LENGTH]	= 0,
					[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
					[DSC$B_CLASS]	= DSC$K_CLASS_D,
					[DSC$A_POINTER]	= 0),
	Status;

    ! Get the hostname
    IF CLI$PRESENT(%ASCID'HostName') THEN
	CLI$GET_VALUE(%ASCID'HostName',HostName)
    ELSE Signal (IPNCP$_NO_SWITCH, 1, %ASCID'RDate', .Status);

    Status = STR$APPEND ( HostName , $DESCRIPTOR (%CHAR (0)));
    IF NOT .Status THEN Signal (.Status);

    ! Just Do It.
    PrintTT('  Asking host !AS for the time.!/',HostName);
    Do_RDate ( .HostName[dsc$a_pointer] );

    Status = STR$FREE1_DX (HostName);
    IF NOT .Status THEN Signal (.Status);

    SS$_NORMAL
    END;



%SBTTL 'Do_DomName_RRLook - main routine to handle host name/address string'

ROUTINE Do_DomName_RRLook (Host_Desc_A) =
    BEGIN
    BIND
	Host_Desc	= .Host_Desc_A : $BBLOCK;
    EXTERNAL ROUTINE
	STR$FREE1_DX	: BLISS ADDRESSING_MODE (GENERAL),
	Parse_IP_Address,
!	ADDR_2_Name,
	RR$Name_2_RR;
    LOCAL
	InAddr,
	Full_Name	: $BBLOCK [DSC$K_S_BLN] PRESET (
			[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
			[DSC$B_CLASS]	= DSC$K_CLASS_D),
	Type : Initial(RRTY$ADDR),
	STATUS;

    Status = Parse_IP_Address (Host_Desc, InAddr);
!    IF .Status
!	THEN Status = Addr_2_Name (.InAddr, Full_Name)
!	ELSE Status = Host_Full_Name (Host_Desc, Full_Name);
!    IF NOT .Status THEN Signal (.Status);

    Full_Name[DSC$A_POINTER] = .Host_Desc[DSC$A_POINTER];
    Full_Name[DSC$W_LENGTH] = .Host_Desc[DSC$W_LENGTH];

!    PrintTT('Host !/''!AS'' Full Name = ''!AS''', Host_Desc, Full_Name);

    IF CLI$PRESENT (%ASCID'ADDR') EQL CLI$_PRESENT THEN
	Type = RRTY$ADDR;

    IF CLI$PRESENT (%ASCID'NS') EQL CLI$_PRESENT THEN
	Type = RRTY$NS;

    IF CLI$PRESENT (%ASCID'MD') EQL CLI$_PRESENT THEN
	Type = RRTY$MD;

    IF CLI$PRESENT (%ASCID'MF') EQL CLI$_PRESENT THEN
	Type = RRTY$MF;

    IF CLI$PRESENT (%ASCID'CNAME') EQL CLI$_PRESENT THEN
	Type = RRTY$CNAME;

    IF CLI$PRESENT (%ASCID'SOA') EQL CLI$_PRESENT THEN
	Type = RRTY$SOA;

    IF CLI$PRESENT (%ASCID'MB') EQL CLI$_PRESENT THEN
	Type = RRTY$MB;

    IF CLI$PRESENT (%ASCID'MG') EQL CLI$_PRESENT THEN
	Type = RRTY$MG;

    IF CLI$PRESENT (%ASCID'MR') EQL CLI$_PRESENT THEN
	Type = RRTY$MG;

    IF CLI$PRESENT (%ASCID'NULL') EQL CLI$_PRESENT THEN
	Type = RRTY$NULL;

    IF CLI$PRESENT (%ASCID'WKS') EQL CLI$_PRESENT THEN
	Type = RRTY$WKS;

    IF CLI$PRESENT (%ASCID'PTR') EQL CLI$_PRESENT THEN
	Type = RRTY$PTR;

    IF CLI$PRESENT (%ASCID'HINFO') EQL CLI$_PRESENT THEN
	Type = RRTY$HINFO;

    IF CLI$PRESENT (%ASCID'MINFO') EQL CLI$_PRESENT THEN
	Type = RRTY$MINFO;

    IF CLI$PRESENT (%ASCID'MX') EQL CLI$_PRESENT THEN
	Type = RRTY$MX;

    Status = RR$Name_2_RR (Full_Name, .Type);
    IF NOT .Status THEN Signal (.Status);

    Status = STR$FREE1_DX (Full_Name);
    IF NOT .Status THEN Signal (.Status);

    PrintTT('!/');

    SS$_NORMAL
    END;

GLOBAL ROUTINE IPNCP_RRFetch =
    BEGIN
    EXTERNAL ROUTINE
	CLI$GET_VALUE	: BLISS ADDRESSING_MODE (GENERAL);
    LOCAL
	Domain_Name	: $BBLOCK [DSC$K_S_BLN],
	Status;

    $Init_DynDesc (Domain_Name);

    WHILE 1 DO
	BEGIN
	Status = CLI$GET_VALUE (%ASCID 'DOM_NAME', Domain_Name);
	IF NOT .Status THEN EXITLOOP;

	Status = Do_DomName_RRLook (Domain_Name);
	IF NOT .Status THEN Signal (.Status);

	END;

    SS$_NORMAL
    END;



GLOBAL ROUTINE IPNCP_StartUp : NOVALUE =
!++
! Description:
!
!	StartUp the IPNCP or the NamRes procs.
!
!--
    BEGIN
    EXTERNAL ROUTINE
	Do_Startup;
    LOCAL
	IPACP_flag,NamRes_flag,
	RC;

    ! get dcl qualifiers
    IPACP_flag = CLI$PRESENT (%ASCID'IPACP');
    NAMRES_flag = CLI$PRESENT (%ASCID'NAMRES');

    DO_StartUp (.IPACP_flag,.NamRes_flag)
    END;



GLOBAL ROUTINE IPNCP_ShutDown : NOVALUE =
!++
! Description:
!
!	Kill (nicely) the IPNCP or the NamRes procs.
!
!--
    BEGIN
    EXTERNAL ROUTINE
	Do_ShutDown;
    LOCAL
	IPACP_flag,NamRes_flag,
	RC;

    ! get dcl qualifiers
    IPACP_flag = CLI$PRESENT (%ASCID'IPACP');
    NAMRES_flag = CLI$PRESENT (%ASCID'NAMRES');

    DO_ShutDown (.IPACP_flag,.NamRes_flag)
    END;



    EXTERNAL ROUTINE
	NAMCNTRL_LOG,
	NAMCNTRL_EXIT,
	NAMCNTRL_INIT,
	NAMCNTRL_START,
	NAMCNTRL_STOP,
	NAMCNTRL_DUMP,
	NAMCNTRL_PRUNE;


GLOBAL ROUTINE Do_NamRes_Log = 
!++
!	Set NamRes logging level
!--
BEGIN
    EXTERNAL ROUTINE
        LIB$CVT_DTB : BLISS ADDRESSING_MODE(GENERAL);
    LOCAL
	Space : VECTOR [20,BYTE],
	Line		:  VOLATILE $BBLOCK [DSC$K_S_BLN] PRESET (
					[DSC$W_LENGTH]	= 20,
					[DSC$B_DTYPE]	= DSC$K_DTYPE_Z,
					[DSC$B_CLASS]	= DSC$K_CLASS_Z,
					[DSC$A_POINTER]	= Space),
	Length : UNSIGNED WORD,
	Status,
	Level;

    Status = CLI$PRESENT (%ASCID'Level');
    IF (.Status EQLU CLI$_PRESENT) THEN
	BEGIN
	CLI$GET_VALUE (%ASCID'Level', Line, Length);
	Status = LIB$CVT_DTB (.Length, Space, Level);
	END
    ELSE Signal (IPNCP$_NO_SWITCH, 1, %ASCID'CONTROL LOG', .Status);

    NamCntrl_Log(.Level)
END;



GLOBAL ROUTINE Do_NamRes_Exit = 
!++
!	Delete currently running NamRes process.
!--
BEGIN
    EXTERNAL ROUTINE
        LIB$CVT_DTB : BLISS ADDRESSING_MODE(GENERAL);
    LOCAL
	Space : $BBLOCK [20],
	Line		:  VOLATILE $BBLOCK [DSC$K_S_BLN] PRESET (
					[DSC$W_LENGTH]	= 20,
					[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
					[DSC$B_CLASS]	= DSC$K_CLASS_S,
					[DSC$A_POINTER]	= Space),
	Length : UNSIGNED WORD,
	Status,
	RC;

    Status = CLI$PRESENT (%ASCID'Code');
    IF (.Status EQLU CLI$_PRESENT) THEN
	BEGIN
	CLI$GET_VALUE (%ASCID'Code', Line, Length);
	LIB$CVT_DTB (.Length, Space, RC)
	END
    ELSE RC = SS$_NORMAL;

    NamCntrl_Exit(.RC)
    END;



GLOBAL ROUTINE Do_NamRes_Init = 
!++
!	Reinitialize currently running NamRes process.
!--
    BEGIN
    NamCntrl_Init(0)
    END;



GLOBAL ROUTINE Do_NamRes_Start = 
!++
!	Tell NamRes that IPACP has started up.
!--
BEGIN
    NamCntrl_Start(0)
END;



GLOBAL ROUTINE Do_NamRes_Stop = 
!++
!	Tell NamRes that IPACP has shutdown.
!--
BEGIN
    NamCntrl_Stop(0)
END;

GLOBAL ROUTINE Do_NamRes_Dump = 
!++
!	Tell NamRes to dump the Domain DataBase to the log file.
!--
BEGIN
    EXTERNAL ROUTINE
        LIB$CVT_DTB : BLISS ADDRESSING_MODE(GENERAL);
    LOCAL
	Space : $BBLOCK [20],
	Line		:  VOLATILE $BBLOCK [DSC$K_S_BLN] PRESET (
					[DSC$W_LENGTH]	= 20,
					[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
					[DSC$B_CLASS]	= DSC$K_CLASS_S,
					[DSC$A_POINTER]	= Space),
	Length : UNSIGNED WORD,
	Status,
	Type;

    Status = CLI$PRESENT (%ASCID'Type');
    IF (.Status EQLU CLI$_PRESENT) THEN
	BEGIN
	CLI$GET_VALUE (%ASCID'Type', Line, Length);
	Status = LIB$CVT_DTB (.Length, Space, Type);
	IF (NOT .Status) THEN
	    BEGIN
	    Signal(.Status);
	    RETURN .Status
	    END;
	END
    ELSE Type = 0;

    NamCntrl_Dump(.Type)
END;



GLOBAL ROUTINE Do_NamRes_Prune =
!++
!	Tell NamRes to purge part of the cache
!--
BEGIN
    LOCAL
	Space : $BBLOCK [256],
	Domain		:  VOLATILE $BBLOCK [DSC$K_S_BLN] PRESET (
					[DSC$W_LENGTH]	= 256,
					[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
					[DSC$B_CLASS]	= DSC$K_CLASS_S,
					[DSC$A_POINTER]	= Space),
	Length : UNSIGNED WORD,
	Status,
	Type;

    Status = CLI$PRESENT (%ASCID'Domain');
    IF (.Status EQLU CLI$_PRESENT) THEN
	BEGIN
	Status = CLI$GET_VALUE (%ASCID'Domain', Domain, Length);
	IF (NOT .Status) THEN
	    BEGIN
	    Signal(.Status);
	    RETURN .Status
	    END;
	END
    ELSE Signal(IPNCP$_Error);

    Domain[DSC$W_LENGTH] = .Length;
    NamCntrl_Prune(Domain)
END;



    EXTERNAL ROUTINE
	Do_SNMP_Get,
	Do_SNMP_GetNext,
	Do_SNMP_Store;

GLOBAL ROUTINE IPNCP_SNMP_Store = 
!++
!	Store a value in an SNMP variable in the IPACP.
!--
BEGIN
    EXTERNAL ROUTINE
        LIB$CVT_DTB : BLISS ADDRESSING_MODE(GENERAL);
    LOCAL
	Space : VECTOR [20,BYTE],
	VarDesc		:  VOLATILE $BBLOCK [DSC$K_S_BLN] PRESET (
					[DSC$W_LENGTH]	= 0,
					[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
					[DSC$B_CLASS]	= DSC$K_CLASS_D,
					[DSC$A_POINTER]	= 0),
	ValDesc		:  VOLATILE $BBLOCK [DSC$K_S_BLN] PRESET (
					[DSC$W_LENGTH]	= 20,
					[DSC$B_DTYPE]	= DSC$K_DTYPE_Z,
					[DSC$B_CLASS]	= DSC$K_CLASS_Z,
					[DSC$A_POINTER]	= Space),
	Length : UNSIGNED WORD,
	Status,
	Value;

    Status = CLI$GET_VALUE (%ASCID'Variable', VarDesc, Length);

    Status = CLI$PRESENT (%ASCID'value');
    IF (.Status EQLU CLI$_PRESENT) THEN
	BEGIN
	CLI$GET_VALUE (%ASCID'Value', ValDesc, Length);
	Status = LIB$CVT_DTB (.Length, .ValDesc[DSC$A_POINTER], Value);
	END
    ELSE Signal (IPNCP$_NO_SWITCH, 1, %ASCID'SNMP STORE', .Status);

    Do_SNMP_Store(VarDesc,.Value)
END;

GLOBAL ROUTINE IPNCP_SNMP_Get = 
!++
!	Retrieve a variable from the IPACP via SNMP
!--
BEGIN
    LOCAL
	VarDesc		:  VOLATILE $BBLOCK [DSC$K_S_BLN] PRESET (
					[DSC$W_LENGTH]	= 0,
					[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
					[DSC$B_CLASS]	= DSC$K_CLASS_D,
					[DSC$A_POINTER]	= 0),
	Length : UNSIGNED WORD,
	Status;

    Status = CLI$GET_VALUE (%ASCID'Variable', VarDesc, Length);

    Do_SNMP_Get(VarDesc)
END;

GLOBAL ROUTINE IPNCP_SNMP_GetNext = 
!++
!	Retrieve next variable from the IPACP via SNMP
!--
BEGIN
    LOCAL
	VarDesc		:  VOLATILE $BBLOCK [DSC$K_S_BLN] PRESET (
					[DSC$W_LENGTH]	= 0,
					[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
					[DSC$B_CLASS]	= DSC$K_CLASS_D,
					[DSC$A_POINTER]	= 0),
	Length : UNSIGNED WORD,
	Status;

    Status = CLI$GET_VALUE (%ASCID'Variable', VarDesc, Length);

    Do_SNMP_GetNext(VarDesc)
END;



GLOBAL ROUTINE Spawn (Command) =
!++
! Functional Description:
!
!	Call LIB$SPAWN.
!--
    BEGIN
    EXTERNAL ROUTINE
	LIB$SPAWN	: BLISS ADDRESSING_MODE(GENERAL);
    LOCAL
	Status;

    Status = LIB$SPAWN (.Command);
    IF NOT .Status THEN Signal (.Status);

    SS$_NORMAL
    END;



GLOBAL ROUTINE IPNCP_Spawn =
!++
! Functional Description:
!
!	Deassign any devices that have anything to do with
!	the terminal and spawn a new CLI.
!--
    BEGIN
    LOCAL
	Line		:  VOLATILE $BBLOCK [DSC$K_S_BLN] PRESET (
					[DSC$W_LENGTH]	= 0,
					[DSC$B_DTYPE]	= DSC$K_DTYPE_T,
					[DSC$B_CLASS]	= DSC$K_CLASS_D,
					[DSC$A_POINTER]	= 0),
	Length,
	Status;

    PrintTT('!/');
    Status = CLI$PRESENT (%ASCID'Command_line');
    IF NOT .Status THEN
	IF .Status NEQU CLI$_ABSENT THEN
	    Signal (IPNCP$_NO_SWITCH, 1, %ASCID'SPAWN', .Status);


    Spawn(Line);

    SS$_NORMAL
    END;



GLOBAL ROUTINE IPNCP_UnixStat =
!++
!  COMMAND:	
!
!	Work (maybe) just like the Unix NETSTAT program.
!
!--
    BEGIN
    EXTERNAL ROUTINE
	UnixStat;	! From UnixStat.c

    ! Just Do It.
    UnixStat ()
    END;



GLOBAL ROUTINE IPNCP_TraceRoute =
!++
!  COMMAND:	PING
!
!	Test connectivity to an internet host by sending IP Packets.
!
!--
    BEGIN
    EXTERNAL ROUTINE
	OTS$CVT_TI_L	: BLISS ADDRESSING_MODE (GENERAL),
	STR$FREE1_DX	: BLISS ADDRESSING_MODE(GENERAL),
	TraceRoute;	! From TRACEROUTE.BLI
    EXTERNAL LITERAL
	IPNCP$_Arg;
    LOCAL
	Src_Host	:  VOLATILE $BBLOCK [DSC$K_S_BLN],
	HostName	:  VOLATILE $BBLOCK [DSC$K_S_BLN],
	PDesc		:  VOLATILE $BBLOCK [DSC$K_S_BLN],
	deb_flag	: INITIAL(0),
	maxttl		: INITIAL(30),
	num_flag	: INITIAL(0),
	port		: INITIAL(32768+666),
	nProbe		: INITIAL(3),
	DntRt_flag	: INITIAL(0),
	Src		: INITIAL(0),
	TOS		: INITIAL(0),
	Verbose_flag	: INITIAL(0),
	wait		: INITIAL(5),
	Status;

    ! Get the TraceRoute options
    ! Connection-ID specified - do one connection in detail
    $Init_DynDesc(HostName);
    IF CLI$PRESENT(%ASCID'HostName') THEN
	CLI$GET_VALUE(%ASCID'HostName',HostName)
    ELSE Signal (IPNCP$_NO_SWITCH, 1, %ASCID'TraceRoute', .Status);

    ! Debug flag
    IF CLI$PRESENT(%ASCID'Debug') THEN Deb_flag=1;

    ! Get maximum ttl qual, in hex
    $Init_DynDesc(PDesc);
    IF Status = CLI$PRESENT (%ASCID'MaxTTL') THEN
	Status = CLI$GET_VALUE (%ASCID 'MaxTTL', PDesc);
    IF .Status THEN
	BEGIN
	Status = OTS$CVT_TI_L (PDesc, maxttl);
	IF NOT .Status THEN Signal (IPNCP$_Arg, 1, PDesc, .Status);
	STR$FREE1_DX (PDesc);
	END;
    IF .MaxTTL LEQ 1 THEN
	BEGIN
	PrintTT('MaxTTL must be >1!/');	RETURN 0;
	END;

    ! Number output flag
    IF CLI$PRESENT(%ASCID'Numeric') THEN Num_flag=1;

    ! Get port number
    $Init_DynDesc(PDesc);
    IF Status = CLI$PRESENT (%ASCID'Port') THEN
	Status = CLI$GET_VALUE (%ASCID 'Port', PDesc);
    IF .Status THEN
	BEGIN
	Status = OTS$CVT_TI_L (PDesc, port);
	IF NOT .Status THEN Signal (IPNCP$_Arg, 1, PDesc, .Status);
	STR$FREE1_DX (PDesc);
	END;
    IF .port LSS 1 THEN
	BEGIN
	PrintTT('Port must be >0!/');
	RETURN 0;
	END;

    ! Get probe quantity
    $Init_DynDesc(PDesc);
    IF Status = CLI$PRESENT (%ASCID'nProbe') THEN
	Status = CLI$GET_VALUE (%ASCID 'nProbe', PDesc);
    IF .Status THEN
	BEGIN
	Status = OTS$CVT_TI_L (PDesc, nProbe);
	IF NOT .Status THEN Signal (IPNCP$_Arg, 1, PDesc, .Status);
	STR$FREE1_DX (PDesc);
	END;
    IF .nProbe LSS 1 THEN
	BEGIN
	PrintTT('Number of probes must be >0!/');
	RETURN 0;
	END;

    ! Don't-route flag
    IF CLI$PRESENT(%ASCID'DntRt') THEN DntRt_flag=1;

!    $Init_DynDesc(Src_Host);
!    IF CLI$PRESENT(%ASCID'Src') THEN
!	CLI$GET_VALUE(%ASCID'Src',Src_Host)
!    ELSE Signal (IPNCP$_NO_SWITCH, 1, %ASCID'TraceRoute', .Status);

    ! Get type-of-service
    $Init_DynDesc(PDesc);
    IF Status = CLI$PRESENT (%ASCID'TOS') THEN
	Status = CLI$GET_VALUE (%ASCID 'TOS', PDesc);
    IF .Status THEN
	BEGIN
	Status = OTS$CVT_TI_L (PDesc, TOS);
	IF NOT .Status THEN Signal (IPNCP$_Arg, 1, PDesc, .Status);
	STR$FREE1_DX (PDesc);
	END;
    IF (.TOS LSS 0) OR (.TOS GTR 255) THEN
	BEGIN
	PrintTT('Type of Service must be between 0 and 255!/');
	RETURN 0;
	END;

    ! Verbose flag
    IF CLI$PRESENT(%ASCID'Verbose') THEN Verbose_flag=1;

    ! Get wait period
    $Init_DynDesc(PDesc);
    IF Status = CLI$PRESENT (%ASCID'Wait') THEN
	Status = CLI$GET_VALUE (%ASCID 'Wait', PDesc);
    IF .Status THEN
	BEGIN
	Status = OTS$CVT_TI_L (PDesc, Wait);
	IF NOT .Status THEN Signal (IPNCP$_Arg, 1, PDesc, .Status);
	STR$FREE1_DX (PDesc);
	END;
    IF (.Wait LSS 1) THEN
	BEGIN
	PrintTT('Wait period must be at least 1 second.!/');
	RETURN 0;
	END;

    ! Do the actual tracing.
    PrintTT('  TraceRoute to host !AS (MaxTTL=!UB).!/',HostName,.MaxTTL);
    PrintTT('!AD d=!UB m=!UB n=!UB p=!UB q=!UB r=!UB s=!ub T=!UB w=!UB!/',HostName,
		.deb_flag, .maxttl, .num_flag, .port, .nProbe,
		.DntRt_flag, .Src, .TOS, .Verbose_flag, .wait);

    TraceRoute ( HostName , .maxttl );

!    TraceRoute(HostName,
!		.deb_flag, .maxttl, .num_flag, .port, .nProbe,
!		.DntRt_flag, .Src, .TOS, .Verbose_flag, .wait);


    SS$_NORMAL
    END;



GLOBAL ROUTINE Do_Version = 
!++
!	Print information about current version of IPNCP.
!--
BEGIN
    PrintTT('!/');
    PrintTT('Current IPNCP version is !AS.!/',version_string);
    IF .config NEQ 0 THEN
	PrintTT('  !UL invocations.!/',.config[CNF$Invocation_Count]);

    PrintTT('!/')
END;

GLOBAL ROUTINE Do_NOOP = 
!++
!	Do nothing
!--
BEGIN
	1
END;

GLOBAL ROUTINE Do_Hello = 
!++
!	
!--
    BEGIN
    EXTERNAL ROUTINE
	STR$CASE_BLIND_COMPARE	: BLISS ADDRESSING_MODE (GENERAL),
	CLI$GET_VALUE	: BLISS ADDRESSING_MODE (GENERAL);
    LOCAL
	Who		: $BBLOCK [DSC$K_S_BLN],
	Status;

    $Init_DynDesc (Who);

    Status = CLI$PRESENT (%ASCID'Who');
    IF .Status THEN Status = CLI$GET_VALUE (%ASCID 'WHO', WHO)
    ELSE
	BEGIN
	PrintTT('Hi!!/');
	RETURN SS$_NORMAL
	END;
	
    IF STR$CASE_BLIND_COMPARE(Who,%ASCID'BRUCE') EQL 0 THEN
	BEGIN
	PrintTT('Howdy,!/');
	PrintTT('Call bruce at (412) 268-7560!/');
	PrintTT('or send e-mail to bm17+@andrew.cmu.edu!/');
	PrintTT('Have a day.!/');
	PrintTT('!/');
	RETURN SS$_NORMAL
	END;

    IF STR$CASE_BLIND_COMPARE(Who,%ASCID'KAREN') EQL 0 THEN
	BEGIN
	PrintTT('Call Karen at (412) 268-5896!/');
	PrintTT('or send e-mail to Karen.Heilman@andrew.cmu.edu!/');
	PrintTT('!/');
	RETURN SS$_NORMAL
	END;

    IF STR$CASE_BLIND_COMPARE(Who,%ASCID'SAILOR') EQL 0 THEN
	BEGIN
	PrintTT('Nothing happens here.!/');
	PrintTT('!/');
	RETURN SS$_NORMAL
	END;
    PrintTT('Nobody home...!/');

    SS$_NORMAL
    END;

GLOBAL ROUTINE Do_XYZZY = 
!++
!	
!--
BEGIN
    PrintTT('You find yourself in a maze of twisty dollar signs, all alike.!/');
    RMS$_EOF
END;

END ELUDOM