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

		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
    NETSTAT(
	VERSION = '6.5',
	ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE,
			NONEXTERNAL=LONG_RELATIVE),
	OPTIMIZE,
	OPTLEVEL = 3,
	ZIP) =
BEGIN

!++
! NETSTAT.BLI	Copyright (c) 1986	Carnegie Mellon University
!
! Description:
!
!	A utility to obtain information about the state of the
!	IP network.
!
! Written By:	Vince Fuller		CMU-CS/RI
!
! Modifications:
!	06-Dec-1989	Bruce R. Miller		CMU NetDev
!	Moved all code into the IPNCP utility.
!
!	06-Dec-1989	Bruce R. Miller		CMU NetDev
!	Added ICMP support, same as UDP support.
!
!--

LIBRARY 'SYS$LIBRARY:STARLET';
LIBRARY 'CMUIP_SRC:[central]NETWORK';
LIBRARY 'CMUIP_SRC:[central]NETCOMMON';
LIBRARY 'CMUIP_SRC:[central]NETCONFIG';
LIBRARY 'CMUIP_SRC:[central]NETCNTRL';
LIBRARY 'CMUIP_SRC:[central]NETERROR';
LIBRARY 'IPNCP';

OWN
    NETIOSB : NetIO_Status_Block;

GLOBAL
    NETCHAN;

EXTERNAL ROUTINE
    STR$APPEND : BLISS ADDRESSING_MODE(GENERAL),
    STR$FREE1_DX : BLISS ADDRESSING_MODE(GENERAL);

MACRO
    TRUE = (1 EQL 1) %,
    FALSE = (NOT TRUE) %;

OWN
    PADD : VECTOR[80,BYTE] INITIAL(BYTE(REP 80 of (%c' '))) ADDRESSING_MODE(LONG_RELATIVE);


%SBTTL 'Utility routines'

ROUTINE NETERROR(IOSB : REF NetIO_Status_Block) : NOVALUE =
    BEGIN
    IF .IOSB[NSB$Status] NEQ SS$_ABORT THEN
	SIGNAL(.IOSB[NSB$Status])
    ELSE
	SIGNAL(.IOSB[NSB$XStatus]);
    END;

ROUTINE GET_DEVICE (IDX,buffer) =
!
! Dump out a UDPCB by UDPCB index.
!
    BEGIN
    LOCAL
	STATUS;
    STATUS = NET$DUMP(
		IOchan	= .NETCHAN,
		IO$SB	= NETIOSB,
		DFUNC	= DU$Device_Stat,
		ARG0	= .IDX,
		BUFADRS	= .buffer,
		BUFSIZE	= DC_Entry_Size*4);
    IF .STATUS THEN
	IF (STATUS = .NETIOSB[NSB$Status]) EQL SS$_ABORT THEN
	    STATUS = .NETIOSB[NSB$XStatus];
    RETURN .STATUS;
    END;

ROUTINE GET_UDPCB(IDX,UDPCB : REF D$UDPCB_Dump_Return_BLK) =
!
! Dump out a UDPCB by UDPCB index.
!
    BEGIN
    LOCAL
	STATUS;
    STATUS = NET$DUMP(
		IOchan	= .NETCHAN,
		IO$SB	= NETIOSB,
		DFUNC	= DU$UDPCB_Dump,
		ARG0	= .IDX,
		BUFADRS	= .UDPCB,
		BUFSIZE	= D$UDPCB_Dump_Blksize);
    IF .STATUS THEN
	IF (STATUS = .NETIOSB[NSB$Status]) EQL SS$_ABORT THEN
	    STATUS = .NETIOSB[NSB$XStatus];
    RETURN .STATUS;
    END;

ROUTINE GET_ICMPCB(IDX,ICMPCB : REF D$ICMPCB_Dump_Return_BLK) =
!
! Dump out ICMPCB by ICMPCB index.
!
    BEGIN
    LOCAL
	STATUS;
    STATUS = NET$DUMP(
		IOchan	= .NETCHAN,
		IO$SB	= NETIOSB,
		DFUNC	= DU$ICMPCB_Dump,
		ARG0	= .IDX,
		BUFADRS	= .ICMPCB,
		BUFSIZE	= D$ICMPCB_Dump_Blksize);
    IF .STATUS THEN
	IF (STATUS = .NETIOSB[NSB$Status]) EQL SS$_ABORT THEN
	    STATUS = .NETIOSB[NSB$XStatus];
    RETURN .STATUS;
    END;

ROUTINE GET_TCB(IDX,TCB : REF D$TCB_Dump_Return_BLK) =
!
! Dump out a TCB by TCB index.
!
    BEGIN
    LOCAL
	STATUS;
    STATUS = NET$DUMP(
		IOchan	= .NETCHAN,
		IO$SB	= NETIOSB,
		DFUNC	= DU$TCB_Dump,
		ARG0	= .IDX,
		BUFADRS	= .TCB,
		BUFSIZE	= D$TCB_Dump_Blksize);
    IF .STATUS THEN
	IF (STATUS = .NETIOSB[NSB$Status]) EQL SS$_ABORT THEN
	    STATUS = .NETIOSB[NSB$XStatus];
    RETURN .STATUS;
    END;

ROUTINE TCB_STATE(VAL) =
!
! Translate TCB state value into a string descriptor.
!
    BEGIN
    LOCAL
	RVAL;
    SELECTONE .VAL OF
    SET
    [CS$CLOSED]:	RVAL = %ASCID'CLOSED     ';
    [CS$LISTEN]:	RVAL = %ASCID'LISTEN     ';
    [CS$SYN_SENT]:	RVAL = %ASCID'SYN-SENT   ';
    [CS$SYN_RECV]:	RVAL = %ASCID'SYN-RECV   ';
    [CS$ESTABLISHED]:	RVAL = %ASCID'ESTABLISHED';
    [CS$FIN_WAIT_1]:	RVAL = %ASCID'FIN-WAIT-1 ';
    [CS$FIN_WAIT_2]:	RVAL = %ASCID'FIN-WAIT-2 ';
    [CS$TIME_WAIT]:	RVAL = %ASCID'TIME-WAIT  ';
    [CS$CLOSE_WAIT]:	RVAL = %ASCID'CLOSE-WAIT ';
    [CS$CLOSING]:	RVAL = %ASCID'CLOSING    ';
    [CS$LAST_ACK]:	RVAL = %ASCID'LAST-ACK   ';
    [CS$NAMELOOK]:	RVAL = %ASCID'NAME-LOOKUP';
    [OTHERWISE]:	RVAL = 0;
    TES;
    RETURN .RVAL;
    END;


ROUTINE OUT_TIME(TIMVAL,TIMDSC : REF $DESC_BLK) : NOVALUE =

! Convert time value into string.

    BEGIN
    LOCAL
	HR,MIN,SEC,FRAC;
    REGISTER
	TMP;
    TMP = .TIMVAL;
    FRAC = .TMP MOD 100;
    TMP = .TMP/100;
    SEC = .TMP MOD 60;
    TMP = .TMP/60;
    MIN = .TMP MOD 60;
    TMP = .TMP/60;
    HR = .TMP MOD 24;
    $FAO(%ASCID' !UB:!2ZB:!2ZB.!2ZB',TIMDSC[DSC$W_LENGTH],.TIMDSC,
	 .HR,.MIN,.SEC,.FRAC);
    END;

! Title string for the device list
MACRO DEV_TITLE =
    'IDX          Address         Network   Xmit  Recv Device    Device-specific!/'%;


%SBTTL 'TCB_STATUS - give brief connection status'

MACRO TITLE =
    'IDX  Address       Local Host    Port    Foreign Host    Port  State!/'%;

LITERAL
	IPADRLEN = 15,
	IPPRTLEN = 7;

ROUTINE TCB_STATUS(TCBIDX,TCB : REF D$TCB_Dump_Return_BLK) : NOVALUE =
!
! Print one-line information about a connection
!
    BEGIN
    LOCAL
	DESC$STR_ALLOC(XSTR,10),
	DESC$STR_ALLOC(FHSTR,50),
	DESC$STR_ALLOC(LHSTR,50),
	DESC$STR_ALLOC(FPSTR,10),
	DESC$STR_ALLOC(LPSTR,10),
	stastr,
	fhplen,
	lhplen,
	fpplen,
	lpplen;

    BIND
	FRNHST = TCB[DM$Foreign_Host] : VECTOR[4,BYTE],
	FRNPRT = TCB[DM$Foreign_Port] : VECTOR[4,BYTE],
	LCLHST = TCB[DM$Local_Host] : VECTOR[4,BYTE],
	LCLPRT = TCB[DM$Local_Port] : VECTOR[4,BYTE];

! Format string for foreign host & port, calculate leading padding

    $FAO(%ASCID'!UB.!UB.!UB.!UB',FHSTR[DSC$W_LENGTH],FHSTR,
	 .FRNHST[0],.FRNHST[1],.FRNHST[2],.FRNHST[3]);
    fhplen = IPADRLEN - .FHSTR[DSC$W_LENGTH];
    $FAO(%ASCID'!UW',FPSTR[DSC$W_LENGTH],FPSTR,
	 .TCB[DM$Foreign_Port]);
    fpplen = IPPRTLEN - .FPSTR[DSC$W_LENGTH];

! Likewise, for local host & port

    $FAO(%ASCID'!UB.!UB.!UB.!UB',LHSTR[DSC$W_LENGTH],LHSTR,
	 .LCLHST[0],.LCLHST[1],.LCLHST[2],.LCLHST[3]);
    lhplen = IPADRLEN - .LHSTR[DSC$W_LENGTH];
    $FAO(%ASCID'!UW',LPSTR[DSC$W_LENGTH],LPSTR,
	 .TCB[DM$Local_Port]);
    lpplen = IPPRTLEN - .LPSTR[DSC$W_LENGTH];

! Get connection state string

    stastr = TCB_State(.TCB[DM$State]);
    IF .stastr EQL 0 THEN
	BEGIN
	$FAO(%ASCID'?!SL?',xstr[DSC$W_LENGTH],xstr,
	     .TCB[DM$STATE]);
	stastr = xstr;
	END;

! Print the line

    PrintTT('!3UL  !8XL !AD!AS !AD!AS !AD!AS !AD!AS  !AS!/',
	  .TCBIDX,.TCB[DM$TCB_Addr],.lhplen,padd,lhstr,.lpplen,padd,lpstr,
	  .fhplen,padd,fhstr,.fpplen,padd,fpstr,.stastr);
    END;

ROUTINE DEVICE_STATUS ( IDX, Dev_Conf : REF D$Dev_Dump_Return_Blk) : NOVALUE =
!
! Print one-line information about an IPACP interface.
!
    BEGIN
    LOCAL
	DESC$STR_ALLOC(DEVSTR,80),
	DESC$STR_ALLOC(IPSTR,24),
	DESC$STR_ALLOC(NETSTR,24),
	IPpadlen, NETpadlen;
    BIND
	HOST = Dev_Conf[DU$Dev_Address] : VECTOR[4,BYTE],
	NET = Dev_Conf[DU$Dev_network] : VECTOR[4,BYTE];

! Format string for IP address, calculate leading padding
    $FAO(%ASCID'!UB.!UB.!UB.!UB', IPSTR[DSC$W_LENGTH], IPSTR,
	.HOST[0],.HOST[1],.HOST[2],.HOST[3]);
    IPpadlen = IPADRLEN - .IPSTR[DSC$W_LENGTH];

! Format string for IP address & Network, calculate leading padding
    $FAO(%ASCID'!UB.!UB.!UB.!UB', NETSTR[DSC$W_LENGTH],NETSTR,
	.NET[0],.NET[1],.NET[2],.NET[3]);
    NETpadlen = IPADRLEN - .NETSTR[DSC$W_LENGTH];

! Print the line
    PrintTT('!3UL  !AD!AS !AD!AS  !5UL !5UL !10AD!18AD!/',
	.IDX,
	.IPpadlen,padd,IPSTR,
	.NETpadlen,padd,NETSTR,
	.Dev_Conf[DU$Dev_Pck_Xmit], .Dev_Conf[DU$Dev_Pck_Recv],
	.Dev_Conf[DU$DevNam_Len], Dev_Conf[DU$DevNam_Str],
	.Dev_Conf[DU$DevSpec_Len], Dev_Conf[DU$DevSpec_Str]);
    END;



ROUTINE UDPCB_STATUS (UDPCBIDX,UDPCB : REF D$UDPCB_Dump_Return_BLK) : NOVALUE =
!
! Print one-line information about a UDP connection
!
    BEGIN
    LOCAL
	DESC$STR_ALLOC(XSTR,10),
	DESC$STR_ALLOC(FHSTR,50),
	DESC$STR_ALLOC(LHSTR,50),
	DESC$STR_ALLOC(FPSTR,10),
	DESC$STR_ALLOC(LPSTR,10),
	stastr,
	fhplen,
	lhplen,
	fpplen,
	lpplen;
    BIND
	FRNHST = UDPCB[DU$UDPCB_Foreign_Host] : VECTOR[4,BYTE],
	FRNPRT = UDPCB[DU$UDPCB_Foreign_Port] : VECTOR[4,BYTE],
	LCLHST = UDPCB[DU$UDPCB_Local_Host] : VECTOR[4,BYTE],
	LCLPRT = UDPCB[DU$UDPCB_Local_Port] : VECTOR[4,BYTE];

! Format string for foreign host & port, calculate leading padding

    $FAO(%ASCID'!UB.!UB.!UB.!UB',FHSTR[DSC$W_LENGTH],FHSTR,
	 .FRNHST[0],.FRNHST[1],.FRNHST[2],.FRNHST[3]);
    fhplen = IPADRLEN - .FHSTR[DSC$W_LENGTH];
    $FAO(%ASCID'!UW',FPSTR[DSC$W_LENGTH],FPSTR,
	 .UDPCB[DU$UDPCB_Foreign_Port]);
    fpplen = IPPRTLEN - .FPSTR[DSC$W_LENGTH];

! Likewise, for local host & port

    $FAO(%ASCID'!UB.!UB.!UB.!UB',LHSTR[DSC$W_LENGTH],LHSTR,
	 .LCLHST[0],.LCLHST[1],.LCLHST[2],.LCLHST[3]);
    lhplen = IPADRLEN - .LHSTR[DSC$W_LENGTH];
    $FAO(%ASCID'!UW',LPSTR[DSC$W_LENGTH],LPSTR,
	 .UDPCB[DU$UDPCB_Local_Port]);
    lpplen = IPPRTLEN - .LPSTR[DSC$W_LENGTH];

! Print the line

    PrintTT('!3UL  !8XL !AD!AS !AD!AS !AD!AS !AD!AS  !XL!/',
	  .UDPCBIDX,.UDPCB[DU$UDPCB_Address],.lhplen,padd,lhstr,.lpplen,padd,lpstr,
	  .fhplen,padd,fhstr,.fpplen,padd,fpstr,.UDPCB[DU$UDPCB_Flags]);
    END;

ROUTINE ICMPCB_STATUS(ICMPCBIDX,ICMPCB : REF D$ICMPCB_Dump_Return_BLK) : NOVALUE =
!
! Print one-line information about a UDP connection
!
    BEGIN
    LOCAL
	DESC$STR_ALLOC(XSTR,10),
	DESC$STR_ALLOC(FHSTR,50),
	DESC$STR_ALLOC(LHSTR,50),
	stastr,
	fhplen,
	lhplen;
    BIND
	FRNHST = ICMPCB[DU$ICMPCB_Foreign_Host] : VECTOR[4,BYTE],
	LCLHST = ICMPCB[DU$ICMPCB_Local_Host] : VECTOR[4,BYTE];

! Format string for foreign host, calculate leading padding

    $FAO(%ASCID'!UB.!UB.!UB.!UB',FHSTR[DSC$W_LENGTH],FHSTR,
	 .FRNHST[0],.FRNHST[1],.FRNHST[2],.FRNHST[3]);
    fhplen = IPADRLEN - .FHSTR[DSC$W_LENGTH];

! Likewise, for local host.

    $FAO(%ASCID'!UB.!UB.!UB.!UB',LHSTR[DSC$W_LENGTH],LHSTR,
	 .LCLHST[0],.LCLHST[1],.LCLHST[2],.LCLHST[3]);
    lhplen = IPADRLEN - .LHSTR[DSC$W_LENGTH];

! Print the line

    PrintTT('!3UL  !8XL !AD!AS !AD!AS  !XL!/',
	  .ICMPCBIDX,.ICMPCB[DU$ICMPCB_Address],.lhplen,padd,lhstr,
	  .fhplen,padd,fhstr,.ICMPCB[DU$ICMPCB_Flags]);
    END;



%SBTTL 'NETSTAT_DO_LIST - List all active connections'

GLOBAL ROUTINE NETSTAT_DO_DEVICE_LIST : NOVALUE =
!
! List all of the valid interfaces on the system, printing a brief summary
! of each one.
!
    BEGIN
    LOCAL
	STATUS,
	DEVLIST : D$Device_List_Return_Blk,
	dev_conf : Device_Configuration_Entry;

! Get the list of valid device indecies

    STATUS = NET$DUMP(
		IOchan	= .NETCHAN,
		IO$SB	= NETIOSB,
		DFUNC	= DU$device_list,
		BUFADRS	= DEVLIST,
		BUFSIZE	= DC_Entry_Size*4);
    IF NOT .STATUS THEN
	BEGIN
	SIGNAL(.STATUS);
	RETURN;
	END;
    STATUS = .NETIOSB[NSB$Status];
    IF NOT .STATUS THEN
	BEGIN
	NETERROR(NETIOSB);
	RETURN;
	END;

! Print count of TCP connections

    PrintTT('!SL device interface!%S found!/',.DEVLIST[0]);

! If some connections, do them

    IF .DEVLIST[0] GTR 0 THEN
	BEGIN

! Print header

	PrintTT(DEV_TITLE);
	INCR I FROM 1 TO .DEVLIST[0] DO
	    BEGIN
	    IF NOT GET_DEVICE(.DEVLIST[.I],dev_conf) THEN
		PrintTT('!3UL  %% device invalid!/',.DEVLIST[.I])
	    ELSE
		DEVICE_STATUS(.DEVLIST[.I],dev_conf);
	    END;
	END;

    END;


%SBTTL 'NETSTAT_DO_LIST - List all active connections'

GLOBAL ROUTINE NETSTAT_DO_LIST : NOVALUE =
!
! List all of the active connections on the system, printing a brief summary
! of hosts and ports.
!
    BEGIN
    LOCAL
	STATUS,
	TCLIST : D$LC_ID_RETURN_BLK,
	UCLIST : D$UDP_List_Return_BLK,
	ICLIST : D$ICMP_List_Return_BLK,
	TCB : D$TCB_Dump_Return_BLK,
	UDPCB : D$UDPCB_Dump_Return_BLK,
	ICMPCB : D$ICMPCB_Dump_Return_BLK;

! Get the list of valid TCB indecies

    STATUS = NET$DUMP(
		IOchan	= .NETCHAN,
		IO$SB	= NETIOSB,
		DFUNC	= DU$Local_Connection_ID,
		BUFADRS	= TCLIST,
		BUFSIZE	= D$LC_ID_BLKSIZE);
    IF NOT .STATUS THEN
	BEGIN
	SIGNAL(.STATUS);
	RETURN;
	END;
    STATUS = .NETIOSB[NSB$Status];
    IF NOT .STATUS THEN
	BEGIN
	NETERROR(NETIOSB);
	RETURN;
	END;

! Print count of TCP connections

    PrintTT('!SL TCP connection!%S found!/',.TCLIST[0]);

! If some connections, do them

    IF .TCLIST[0] GTR 0 THEN
	BEGIN

! Print header

	PrintTT(TITLE);
	INCR I FROM 1 TO .TCLIST[0] DO
	    BEGIN
	    IF NOT GET_TCB(.TCLIST[.I],TCB) THEN
		PrintTT('!3UL  %% Connection closed!/',.TCLIST[.I])
	    ELSE
		TCB_STATUS(.TCLIST[.I],TCB);
	    END;
	END;

! Get the list of valid UDPCB indecies

    STATUS = NET$DUMP(
		IOchan	= .NETCHAN,
		IO$SB	= NETIOSB,
		DFUNC	= DU$UDP_Connections,
		BUFADRS	= UCLIST,
		BUFSIZE	= D$UDP_List_Blksize);
    IF NOT .STATUS THEN
	BEGIN
	SIGNAL(.STATUS);
	RETURN;
	END;
    STATUS = .NETIOSB[NSB$Status];
    IF NOT .STATUS THEN
	BEGIN
	NETERROR(NETIOSB);
	RETURN;
	END;

! Print count of UDP connections

    PrintTT('!SL UDP connection!%S found!/',.UCLIST[0]);

! If some connections, do them

    IF .UCLIST[0] GTR 0 THEN
	BEGIN

! Print header

	PrintTT(TITLE);
	INCR I FROM 1 TO .UCLIST[0] DO
	    BEGIN
	    IF NOT GET_UDPCB(.UCLIST[.I],UDPCB) THEN
		PrintTT('!3UL  %% Connection closed!/',.UCLIST[.I])
	    ELSE
		UDPCB_STATUS(.UCLIST[.I],UDPCB);
	    END;
	END;

! Get the list of valid ICMPCB indecies

    STATUS = NET$DUMP(
		IOchan	= .NETCHAN,
		IO$SB	= NETIOSB,
		DFUNC	= DU$ICMP_Connections,
		BUFADRS	= ICLIST,
		BUFSIZE	= D$ICMP_List_Blksize);
    IF NOT .STATUS THEN
	BEGIN
	SIGNAL(.STATUS);
	RETURN;
	END;
    STATUS = .NETIOSB[NSB$Status];
    IF NOT .STATUS THEN
	BEGIN
	NETERROR(NETIOSB);
	RETURN;
	END;

! Print count of ICMP connections

    PrintTT('!SL ICMP connection!%S found!/',.ICLIST[0]);

! If some connections, do them

    IF .ICLIST[0] GTR 0 THEN
	BEGIN

! Print header

	PrintTT(TITLE);
	INCR I FROM 1 TO .ICLIST[0] DO
	    BEGIN
	    IF NOT GET_ICMPCB(.ICLIST[.I],ICMPCB) THEN
		PrintTT('!3UL  %% Connection closed!/',.ICLIST[.I])
	    ELSE
		ICMPCB_STATUS(.ICLIST[.I],ICMPCB);
	    END;
	END;
    END;

%SBTTL 'NETSTAT_DO_TCB - print a single connection in detail'

GLOBAL ROUTINE NETSTAT_DO_TCB(CONIDX) : NOVALUE =
    BEGIN
    LOCAL
	STATUS,
	TCB : D$TCB_Dump_Return_BLK,
	SNDUNA,
	OSTSTR,
	DESC$STR_ALLOC(CTOSTR,30),
	DESC$STR_ALLOC(RTOSTR,30);

    STATUS = GET_TCB(.CONIDX,TCB);
    IF NOT .STATUS THEN
	BEGIN
	SIGNAL(.STATUS);
	RETURN;
	END;

    OSTSTR = TCB_STATE(.TCB[DM$Last_State]);

! Print main information

    PrintTT(TITLE);
    TCB_STATUS(.CONIDX,TCB);

! Print address, owner and previous state

    PrintTT('     Owner: !XL!_Last State: !AS!/',.TCB[DM$User_id],.OSTSTR);

! Print receive side information

    PrintTT('     IRS: !XL!_RCV.NXT: !XL!_RCV.WND: !SL!/',
	  .TCB[DM$IRS],.TCB[DM$RCV_NXT],.TCB[DM$RCV_WND]);

! Print send side information

    SNDUNA = .TCB[DM$SND_NXT] - .TCB[DM$SND_UNA];
    PrintTT('     ISS: !XL!_SND.NXT: !XL!_SND.WND: !SL!_SND.UNA: !SL!/',
	  .TCB[DM$ISS],.TCB[DM$SND_NXT],.TCB[DM$SND_WND],.SNDUNA);

! Print queue lengths

    PrintTT('     NRQ: !SL!_NFQ: !SL!_RXQ: !SL!_URQ: !SL!_USQ: !SL!/',
	   .TCB[DM$Net_Recv_QE],.TCB[DM$Future_QE],.TCB[DM$Rexmit_QE],
	   .TCB[DM$User_Recv_QE],.TCB[DM$User_Send_QE]);

! Get string time value for retransmission timeout & connection timeout

    OUT_TIME(.TCB[DM$RT_Timeout],RTOSTR);
    OUT_TIME(.TCB[DM$Conn_Timeout],CTOSTR);

! Print RTT and timeouts

    PrintTT('     RTT: !SL!_RTO: !AS!_CTO: !AS!/',
	  .TCB[DM$Round_Trip_Time],RTOSTR,CTOSTR);
    END;

%SBTTL 'NETSTAT_DO_UDPCB - print a single UDP connection in detail'

GLOBAL ROUTINE NETSTAT_DO_UDPCB(CONIDX) : NOVALUE =
    BEGIN
    LOCAL
	STATUS,
	UDPCB : D$UDPCB_Dump_Return_BLK,
	Flagstr : $DESC_BLK;

    STATUS = GET_UDPCB(.CONIDX,UDPCB);
    IF NOT .STATUS THEN
	BEGIN
	SIGNAL(.STATUS);
	RETURN;
	END;

! Print main information

    PrintTT(TITLE);
    UDPCB_STATUS(.CONIDX,UDPCB);

! Figure out what flags we have on

    $INIT_DYNDESC(Flagstr);
    SELECT TRUE OF
    SET
    [.UDPCB[DU$UDPCB_Wildcard]]:
	STR$APPEND(Flagstr,%ASCID'WLD ');

    [.UDPCB[DU$UDPCB_Raw_Mode]]:
	STR$APPEND(Flagstr,%ASCID'RAW ');

    [.UDPCB[DU$UDPCB_Aborting]]:
	STR$APPEND(Flagstr,%ASCID'ABT ');

    [.UDPCB[DU$UDPCB_NMLook]]:
	STR$APPEND(Flagstr,%ASCID'NML ');

    [.UDPCB[DU$UDPCB_Internal]]:
	STR$APPEND(Flagstr,%ASCID'INT ');
    TES;

! Print additional info

    PrintTT('	Owner: !XL!_NRQ: !SL!_URQ: !SL!_Flags: !AS!/',
	  .UDPCB[DU$UDPCB_User_ID],.UDPCB[DU$UDPCB_NR_Qcount],.UDPCB[DU$UDPCB_UR_Qcount],
	  Flagstr);

    STR$FREE1_DX(Flagstr);
    END;

%SBTTL 'NETSTAT_DO_ICMPCB - print a single ICMP connection in detail'

GLOBAL ROUTINE NETSTAT_DO_ICMPCB(CONIDX) : NOVALUE =
    BEGIN
    LOCAL
	STATUS,
	ICMPCB : D$ICMPCB_Dump_Return_BLK,
	Flagstr : $DESC_BLK;

    STATUS = GET_ICMPCB(.CONIDX,ICMPCB);
    IF NOT .STATUS THEN
	BEGIN
	SIGNAL(.STATUS);
	RETURN;
	END;

! Print main information

    PrintTT(TITLE);
    ICMPCB_STATUS(.CONIDX,ICMPCB);

! Figure out what flags we have on

    $INIT_DYNDESC(Flagstr);
    SELECT TRUE OF
    SET
    [.ICMPCB[DU$ICMPCB_Wildcard]]:
	STR$APPEND(Flagstr,%ASCID'WLD ');

    [.ICMPCB[DU$ICMPCB_Raw_Mode]]:
	STR$APPEND(Flagstr,%ASCID'RAW ');

    [.ICMPCB[DU$ICMPCB_Aborting]]:
	STR$APPEND(Flagstr,%ASCID'ABT ');

    [.ICMPCB[DU$ICMPCB_NMLook]]:
	STR$APPEND(Flagstr,%ASCID'NML ');

    [.ICMPCB[DU$ICMPCB_Internal]]:
	STR$APPEND(Flagstr,%ASCID'INT ');
    TES;

! Print additional info

    PrintTT('	Owner: !XL!_NRQ: !SL!_URQ: !SL!_Flags: !AS!/',
	  .ICMPCB[DU$ICMPCB_User_ID],.ICMPCB[DU$ICMPCB_NR_Qcount],.ICMPCB[DU$ICMPCB_UR_Qcount],
	  Flagstr);

    STR$FREE1_DX(Flagstr);
    END;

%SBTTL 'NETSTAT_DO_STATS - Print network ACP statistics'

GLOBAL ROUTINE NETSTAT_DO_STATS : NOVALUE =
    BEGIN
    LOCAL
	STATUS,
	STABLK : D$TCP_Stats_Return_BLK;

! Get the statistics block

    STATUS = NET$DUMP(
		IOchan	= .NETCHAN,
		IO$SB	= NETIOSB,
		DFUNC	= DU$TCP_Stats,
		BUFADRS	= STABLK,
		BUFSIZE	= D$TS_BLKsize);
    IF NOT .STATUS THEN
	BEGIN
	SIGNAL(.STATUS);
	RETURN;
	END;
    STATUS = .NETIOSB[NSB$Status];
    IF NOT .STATUS THEN
	BEGIN
	NETERROR(NETIOSB);
	RETURN;
	END;

! Miscellaneous statistics

       PrintTT(%STRING(
   	  'IPACP PID: !XL!_Uptime: !%D!_User IORQs: !SL!/',
   	  'Opens:  Active: !SL!_Passive: !SL!_Servers forked: !SL!/',
   	  'IP forwards: !SL!/'),
   	  .STABLK[DM$tcpacp_pid],STABLK [DM$uptime],.STABLK[DM$user_io_requests],
   	  .STABLK[DM$Active_conects_opened],.STABLK[DM$passive_conects_opened],
   	  .STABLK[DM$servers_forked],
   	  .STABLK[DM$storeforward]);

! TCP Receive statistics

     PrintTT(%STRING(
	  'RCV Total segs: !SL!_Total data bytes: !SL!/',
	  '     Bad cksum: !SL!_Out of window: !SL!_Dups: !SL!_BadSeq: !SL!/',
	  '   Future segs: !SL!_Used: !SL!_Dropped: !SL!_Dups: !SL!/'),
	  .STABLK[DM$segs_recved],.STABLK[DM$data_bytes_recved],
	  .STABLK[DM$seg_bad_chksum],.STABLK[DM$oorw_segs],
	  .STABLK[DM$Duplicate_segs],.STABLK[DM$Badseq],
	  .STABLK[DM$future_rcvd],.STABLK[DM$future_used],
	  .STABLK[DM$future_dropped],.STABLK[DM$future_dups]);


! TCP send statistics

    PrintTT(%STRING(
	  'SND Total segs: !SL!_Total data bytes: !SL!/',
	  '   Retransmits: !SL!_Repacketizer: !SL!/'),
	  .STABLK[DM$segs_xmitted],.STABLK[DM$data_bytes_xmitted],
	  .STABLK[DM$retrans_segs],.STABLK[DM$rpz_rxq]);

!! Arp Statistics
!    PrintTT('ARPs!/');
!    PrintTT('  Received:   !8SL!/',
!	    .Stablk[DM$Arps_Received])
    END;


%SBTTL 'NETSTAT_DO_MEMORY - Print ACP memory manager statistics'

GLOBAL ROUTINE NETSTAT_DO_MEMORY : NOVALUE =
    BEGIN
    LOCAL
	STATUS,
	MB : D$Mem_Alloc_Return_BLK;

! Get info about memory allocator

    STATUS = NET$DUMP(
		IOchan	= .NETCHAN,
		IO$SB	= NETIOSB,
		DFUNC	= DU$Dynamic_Mem_Alloc,
		BUFADRS	= MB,
		BUFSIZE	= D$MA_Blksize);
    IF NOT .STATUS THEN
	BEGIN
	SIGNAL(.STATUS);
	RETURN;
	END;
    STATUS = .NETIOSB[NSB$Status];
    IF NOT .STATUS THEN
	BEGIN
	NETERROR(NETIOSB);
	RETURN;
	END;    

! Print the info...

    PrintTT(%STRING(
	  'Item!_!_Alloc!_Free!_Overrun!_Max overrun!/',
	  'QBlks!_!_!SL!_!SL!_!SL!_!SL!/',
	  'Uarg blks!_!SL!_!SL!_!SL!_!SL!/'),
	  .MB[DM$QBAL],.MB[DM$QBFR],.MB[DM$QB],.MB[DM$QBMX],
	  .MB[DM$UAAL],.MB[DM$UAFR],.MB[DM$UA],.MB[DM$UAMX]);

    PrintTT(%STRING(
	  'Control segs!_!SL!_!SL!_!SL!_!SL!/',
	  'Max size segs!_!SL!_!SL!_!SL!_!SL!/',
	  'Net recv bufs!_!SL!_!SL!_!SL!_!SL!/'),
	  .MB[DM$CSAL],.MB[DM$CSFR],.MB[DM$CS],.MB[DM$CSMX],
	  .MB[DM$DMSAL],.MB[DM$DMSFR],.MB[DM$DMS],.MB[DM$DMSMX],
	  .MB[DM$NMAL],.MB[DM$NMFR],.MB[DM$NM],.MB[DM$NMMX]);
    END;

%SBTTL 'NETSTAT_DO_ARP - Dump ARP cache'

GLOBAL ROUTINE NETSTAT_DO_ARP : NOVALUE =
    BEGIN
    LOCAL
	STATUS,
	ACACHE : D$ARP_Dump_Return_Blk(D$ARP_Dump_MaxBlk),
	AIDX,
	ACNT,
	ASIZE;

! Print header

    PrintTT('CIDX  DEV      IP Address        Physical Address  Time out!/');
    AIDX = 0;
    DO
	BEGIN
	STATUS = NET$DUMP(
			IOchan	= .NETCHAN,
			IO$SB	= NETIOSB,
			DFUNC	= DU$DEVICE_DUMP,
			ARG0	= 0,
			ARG1	= 1,
			ARG2	= .AIDX,
			BUFADRS	= ACACHE,
			BUFSIZE	= D$ARP_Dump_MaxBlkSize);
	IF NOT .STATUS THEN
	    BEGIN
	    SIGNAL(.STATUS);
	    RETURN;
	    END;
	STATUS = .NETIOSB[NSB$Status];
	IF NOT .STATUS THEN
	    BEGIN
	    NETERROR(NETIOSB);
	    RETURN;
	    END;

! Get the size, calculate number of entries

	ASIZE = .NETIOSB[NSB$BYTE_COUNT];
	ACNT = .ASIZE/D$ARP_Dump_Blksize;

! Do each of the entries

	INCR I FROM 0 TO .ACNT-1 DO
	    BEGIN
	    LOCAL
		PHASTR : $DESC_BLK,
		IPPLEN,
		PHPLEN,
		DESC$STR_ALLOC(IPASTR,50),
		DESC$STR_ALLOC(TIMSTR,50);
	    BIND
		IPA = ACACHE[.I,DU$ARP_IPADDR] : VECTOR[4,BYTE],
		PHA = ACACHE[.I,DU$ARP_HWADDR] : VECTOR[ARP_HDW_LEN,BYTE];

! Format the IP address string

	    $FAO(%ASCID'!UB.!UB.!UB.!UB',IPASTR[DSC$W_LENGTH],IPASTR,
		 .IPA[0],.IPA[1],.IPA[2],.IPA[3]);
	    IPPLEN = IPADRLEN - .IPASTR[DSC$W_LENGTH];

! Format the hardware address string

	    PHPLEN = (ARP_HDW_LEN-.ACACHE[.I,DU$ARP_HWSIZE])*3;
	    $INIT_DYNDESC(PHASTR);
	    INCR J FROM 0 TO .ACACHE[.I,DU$ARP_HWSIZE]-1 DO
		BEGIN
		LOCAL
		    DESC$STR_ALLOC(DIGSTR,10);
		IF .J EQL 0 THEN
		    $FAO(%ASCID'!XB',DIGSTR[DSC$W_LENGTH],DIGSTR,.PHA[.J])
		ELSE
		    $FAO(%ASCID'-!XB',DIGSTR[DSC$W_LENGTH],DIGSTR,.PHA[.J]);
		STR$APPEND(PHASTR,DIGSTR);
		END;

! Format the time-out string

	    OUT_TIME(.ACACHE[.I,DU$ARP_EXPIRE],TIMSTR);

! Print the information

	    PrintTT('!4UW !4UW !AD!AS !AD!AS !AS!/',
		  .ACACHE[.I,DU$ARP_INDEX],.ACACHE[.I,DU$ARP_DEVICE],

		  .IPPLEN,padd,IPASTR,.PHPLEN,padd,PHASTR,
		  TIMSTR);
	    STR$FREE1_DX(PHASTR);

! Account for this index...

	    AIDX = .AIDX + 1;
	    END;
	END
    WHILE .ASIZE EQL D$ARP_Dump_MaxBlkSize;
    END;

END
ELUDOM