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

		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.

	****************************************************************
)%
%TITLE 'Internet Control Message Protocol User Interface'
%SBTTL 'Internet Control Message Protocol User Interface Overview'
%(

Module:

	ICMP_User

Facility:

	Internet Control Message Protocol (ICMP) User Interface

Abstract:

	ICMP provides the user with a access to ICMP service
	via the Internet Protocol (IP). This module handles the
	ICMP interface between the user and the IP layer.

Author:

	Bruce R. Miller, CMU Network Development, Nov. 1989
	Copyright (c) 1989, Carnegie-Mellon University

Modification History:

1.0c	18-Jul-1991	Henry W. Miller		USBR
	Use LIB$GET_VM_PAGE and LIB$FREE_VM_PAGE rather then LIB$GET_VM
	and LIB$FREE_VM, and check return status.

1.0b	09-Jul-1991	Henry W. Miller		USBR
	Added STARLET for VMS 5.4.

1.0a	13-Jan-1991	Henry W. Miller		USBR
	Make ICMPTTL a configurable variable.

)%

%SBTTL 'Module definition'	

MODULE ICMP_User (IDENT='1.0c',LANGUAGE(BLISS32),
	    ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE,
			    NONEXTERNAL=LONG_RELATIVE),
	    LIST(NOREQUIRE,ASSEMBLY,OBJECT,BINARY),
	    OPTIMIZE,OPTLEVEL=3,ZIP)=

BEGIN

! Include standard definition files

!LIBRARY 'SYS$LIBRARY:STARLET';
LIBRARY 'SYS$LIBRARY:LIB';
LIBRARY 'CMUIP_SRC:[CENTRAL]NETERROR';
LIBRARY 'CMUIP_SRC:[CENTRAL]NETXPORT';
LIBRARY 'CMUIP_SRC:[CENTRAL]NETVMS';
LIBRARY 'CMUIP_SRC:[CENTRAL]NETCOMMON';
LIBRARY 'CMUIP_SRC:[CENTRAL]NetTCPIP';	! IP & ICMP definitions
LIBRARY 'STRUCTURE';
LIBRARY 'TCPMACROS';
LIBRARY 'SNMP';

!*** Special literals from USER.BLI ***

EXTERNAL LITERAL
    UCB$Q_DDP,
    UCB$L_CBID,
    UCB$L_EXTRA;

! External data items

EXTERNAL
    INTDF,
    AST_In_Progress,
    LOG_STATE,
    MIN_PHYSICAL_BUFSIZE,
    MAX_PHYSICAL_BUFSIZE,

    ICMP_MIB : ICMP_MIB_struct;	! ICMP Management Information Block


! External routines

EXTERNAL ROUTINE

! MACLIB.MAR

    Swapbytes : NOVALUE,
    Movbyt : NOVALUE,
    Calc_Checksum,

! MEMGR.BLI

    MM$UArg_Free : NOVALUE,
    MM$QBLK_Get,
    MM$QBLK_Free : NOVALUE,
    MM$Seg_Get,
    MM$Seg_Free : NOVALUE,

! USER.BLI

    USER$CHECK_ACCESS,
    USER$Err,
    IO$POST : NOVALUE,
    User$Post_IO_Status : NOVALUE,

! IP.BLI

    IP$SET_HOSTS : NOVALUE,
    IP$SEND,

! NMLOOK.BLI

    NML$CANCEL : NOVALUE,
    NML$GETALST : NOVALUE,
    NML$GETNAME : NOVALUE,

! IOUTIL.BLI

    GET_IP_ADDR,
    ASCII_DEC_BYTES : NOVALUE,
    ASCII_HEX_BYTES : NOVALUE,
    LOG_FAO : NOVALUE,
    QL_FAO : NOVALUE;


%SBTTL 'ICMP data structures'

! Define the 'ICMPCB' - ICMP analogue of TCB.

$FIELD  ICMPCB_Fields =
    SET
    ICMPCB$Foreign_Host	= [$Ulong],	! ICMP foreign host number
    ICMPCB$Local_Host	= [$Ulong],	!     local host
    ICMPCB$Foreign_Hname	= [$Bytes(MAX_HNAME)],
    ICMPCB$Foreign_Hnlen	= [$Short_Integer],
    ICMPCB$USR_Qhead	= [$Address],	! User receive request queue
    ICMPCB$USR_Qtail	= [$Address],
    ICMPCB$NR_Qhead	= [$Address],	! Net receive queue
    ICMPCB$NR_Qtail	= [$Address],
    ICMPCB$NR_Qcount	= [$Short_Integer],
    ICMPCB$Flags		= [$Bytes(2)],
    $OVERLAY(ICMPCB$Flags)
	ICMPCB$Wildcard	= [$Bit],	! ICMPCB opened with wild FH/FP/LH
!	ICMPCB$Addr_Mode	= [$Bit],	! User wants IP addresses
	ICMPCB$Aborting	= [$Bit],	! ICMPCB is closing
	ICMPCB$NMLook	= [$Bit],	! ICMPCB has an outstanding name lookup
	ICMPCB$Internal	= [$Bit],	! ICMPCB is open by ACP not user
    $CONTINUE
    ICMPCB$ICMPCBID		= [$Address],	! ICMPCB_Table index for this connection
    ICMPCB$UCB_Adrs	= [$Address],	! Connection UCB address
    ICMPCB$UARGS	= [$Address],	! Uarg block in pending open
    ICMPCB$User_ID	= [$Bytes(4)],	! Process ID of owner
    ICMPCB$PIOchan	= [$Bytes(2)]	! Process IO channel
    TES;

LITERAL
    ICMPCB_Size = $Field_Set_Size;
MACRO
    ICMPCB_Structure = BLOCK[ICMPCB_Size] FIELD(ICMPCB_Fields) %;
%MESSAGE(%NUMBER(ICMPCB_Size),' longwords per ICMPCB')



%SBTTL 'ICMP data storage'

GLOBAL
    ICMPTTL	:	INITIAL(32);	! TTL for ICMP

OWN
    ICMPIPID : INITIAL(1),	! Current IP packet ID
    ICMPCB_Count : INITIAL(0),	! Count of active ICMPCBs
    ICMPCB_TABLE : VECTOR[MAX_ICMPCB+1];! Table of ICMPCBs



%SBTTL 'ICMP packet logger'
%(
    Queue up a log entry to dump out a ICMP packet.
 )%

ROUTINE Log_ICMP_Packet(Seg,SwapFlag,SendFlag) : NOVALUE =
    BEGIN
    MAP
	Seg : REF ICMP_Structure;
    LOCAL
	sptr,
	segdata,
	segcopy : ICMP_Structure,
	seghdr : REF ICMP_Structure;

    seghdr = .seg;		! Point at segment header
    segdata = .seg + ICMP_Header_Size;
    IF .SwapFlag THEN		! Need to byteswap header?
	BEGIN
	CH$MOVE(ICMP_Header_Size,CH$PTR(.seg),CH$PTR(segcopy)); ! Make a copy
	seghdr = segcopy;	! Point at this version...
	SwapBytes(ICMP_Header_Size/2,.seghdr); ! Swap header bytes
	END;

! Print first part of info

    IF .SendFlag THEN
	sptr = %ASCID'Sent'
    ELSE
	sptr = %ASCID'Received';

! Log the contents of the ICMP header

    QL$FAO(%STRING('!%T !AS ICMP packet, SEG=!XL, DATA=!XL!/',
		   '!_CKsum:!_!SL!/'),
	    0,.sptr,.seg,.segdata,
	   .seghdr[ICM$CkSum]);

    END;

%SBTTL 'ICMPCB_Find - look up ICMP control block'

ROUTINE ICMPCB_Find(Src$Adrs) =
    BEGIN
    LOCAL
	Ucount,
	ICMPCBIX,
	ICMPCB : REF ICMPCB_Structure;
    Ucount = .ICMPCB_Count;
    ICMPCBIX = 1;
    WHILE (.Ucount GTR 0) AND (.ICMPCBIX LEQ Max_ICMPCB) DO
	BEGIN
	IF (ICMPCB = .ICMPCB_Table[.ICMPCBIX]) NEQ 0 THEN
	    BEGIN
	    IF ((.ICMPCB[ICMPCB$Foreign_Host] EQL WILD) OR
		(.ICMPCB[ICMPCB$Foreign_Host] EQL .Src$Adrs)) THEN
		RETURN .ICMPCB;
	    Ucount = .Ucount-1;
	    END;
	ICMPCBIX = .ICMPCBIX + 1;
	END;
    RETURN 0;
    END;

%SBTTL 'ICMP input handler'
%(
    Come here at AST level when input packet is determined to be ICMP packet.
    At present, all ICMP input handling is done at AST level, so we search
    the ICMPCB list and queue the ICMP packet for deliver here.
)%

FORWARD ROUTINE
    Queue_User_ICMP;

GLOBAL ROUTINE ICMP$User_Input(Src$Adrs,Dest$Adrs,BufSize,Buf,SegSize,Seg): NOvalue=
    BEGIN
    MAP
	Seg : REF ICMP_Structure;
    LOCAL
	Buf2,
	Uptr,
	Ucount,
	ICMPCBIX,
	sum,
	delete,
	ICMPCB : REF ICMPCB_Structure;
    LABEL
	X;

! Assume this packet (Buf2) should not be deleted

    delete = FALSE;

! Log the ICMP packet if desired

    IF $$LOGF(LOG$ICMP) THEN
	Log_ICMP_Packet(.Seg,TRUE,FALSE);

!!!HACK!!! I deleted this.  It should be done 

! Try to match the input packet up with a ICMPCB
!!!HACK!!! What if there's more than one ICMPCB for this address?
    ICMPCB = ICMPCB_Find(.Src$Adrs);
    IF .ICMPCB EQL 0 THEN
	BEGIN
!!!HACK!!! Don't worry if there'e no ICMPCB.
	IF $$LOGF(LOG$ICMP) THEN
	    QL$FAO('!%T No ICMPCB found for segment !XL!/',0,.Seg);
	END
    ELSE
X:	BEGIN

! Log that it was found

	IF $$LOGF(LOG$ICMP) THEN
	    QL$FAO('!%T ICMPCB !XL found for ICMP Seg !XL!/',
		   0,.ICMPCB,.Seg);

! Make sure the ICMPCB isn't aborted...

	IF .ICMPCB[ICMPCB$Aborting] THEN
	    BEGIN
	    XQL$FAO(LOG$ICMP,'!%T ICMP input !XL for aborted ICMPCB !XL dropped!/',
		    0,.Seg,.ICMPCB);
	    LEAVE X;
	    END;

	Buf2 = MM$Seg_Get(.Bufsize);	! Get a buffer
	Seg = .Buf2 + (.Seg - .Buf);
!!!HACK!!! There's no need to copy the whole buffer, only .Usize worth...
	MOVBYT(.Bufsize,.Buf,.Buf2);

! Setup pointer to ICMP data and ICMP data size

	Uptr = .Seg + ICMP_Header_Size;
	Ucount = .SegSize - ICMP_Header_Size;

	    BEGIN
	    MAP
		Uptr : REF IPADR$ADDRESS_BLOCK;

! Kluge. Overwrite the ICMP/IP header in the buffer, since we don't need it.

	    Uptr = .Uptr - IPADR$ADDRESS_BLEN;
	    Ucount = .Ucount + IPADR$ADDRESS_BLEN;
	    UPTR[IPADR$EXT1] = .Seg[ICM$EXT1];
	    UPTR[IPADR$EXT2] = .Seg[ICM$VAR];
	    UPTR[IPADR$SRC_HOST] = .Src$Adrs;
	    UPTR[IPADR$DST_HOST] = .Dest$Adrs;
	    END;

! Give the segment to the user now.

	delete = Queue_User_ICMP (.ICMPCB,.Uptr,.Ucount,.Buf2,.Bufsize,0);
	END;

! If the packet hasn't been given to the user, delete it now

    IF .delete THEN
	MM$Seg_Free(.Bufsize,.Buf2);
    END;


%SBTTL 'Queue_User_ICMP - Queue up ICMP packet for delivery to user'
%(
    Called by ICMP_Input at AST level when an input packet matches a
    user ICMP "connection". Function of this routine is to either deliver
    the ICMP packet to the user (if a user read request is available) or
    queue it for later deliver.
    Returns TRUE if the ICMP packet has been fully disposed of (i.e. the
    caller may deallocate the packet), FALSE otherwise (i.e. the packet
    has been placed on a queue and may not be deallocated yet).
 )%

FORWARD ROUTINE
    DELIVER_ICMP_DATA : NOVALUE;

ROUTINE Queue_User_ICMP(ICMPCB,Uptr,Usize,Buf,Bufsize,QB) =
    BEGIN
    MAP
	ICMPCB : REF ICMPCB_Structure,
	QB : REF Queue_BLK_Structure(QB_NR_Fields);
    LOCAL
	QBR;
    EXTERNAL ROUTINE
	MM$QBlk_Get;
    LITERAL
	ICMPCB$NR_Qmax = 5;	! Max input packets permitted on input queue

! See if the input queue is full for this ICMPCB

    IF .ICMPCB[ICMPCB$NR_Qcount] GTR ICMPCB$NR_Qmax THEN
	BEGIN
	IF $$LOGF(LOG$ICMP) THEN
	    QL$FAO('!%T ICMP at !XL dropped - ICMPCB NR queue full!/',0,.Uptr);
	RETURN TRUE;		! Drop the packet - no room
	END;

! Allocate a queue block and insert onto user receive queue

    IF .QB EQL 0 THEN
	QB = MM$QBLK_Get();
    QB[NR$Buf_Size] = .Bufsize;	! Total size of network buffer
    QB[NR$Buf] = .Buf;		! Pointer to network buffer
    QB[NR$Ucount] = .Usize;	! Length of the data
    QB[NR$Uptr] = .Uptr;	! Pointer to the data

! If there is a user read outstanding, deliver data, else queue for later

    IF REMQUE(.ICMPCB[ICMPCB$USR_Qhead],QBR) NEQ Empty_Queue THEN
	Deliver_ICMP_Data(.ICMPCB,.QB,.QBR)
    ELSE
	INSQUE(.QB,.ICMPCB[ICMPCB$NR_Qtail]);
    RETURN FALSE;		! Don't deallocate this segment...
    END;

%SBTTL 'Deliver_ICMP_Data - Deliver ICMP data to user'
%(
    Perform actual delivery of ICMP packet to a user request.
    ICMP packet is copied into the user buffer and the user I/O request
    is posted.
 )%

ROUTINE Deliver_ICMP_Data(ICMPCB,QB,URQ) : NOVALUE =
    BEGIN
    MAP
	ICMPCB : REF ICMPCB_Structure,
	QB : REF Queue_Blk_Structure(QB_NR_Fields),
	URQ : REF Queue_Blk_Structure(QB_UR_Fields);
    LOCAL
	FLAGS,
	ICMTYPE,
	IRP : REF $BBLOCK[],
	UArgs : REF User_RECV_Args,
	Sargs : REF User_RECV_Args,
	Aptr,
	Uptr,
	Ucount;

! Determine data start and data count

    Ucount = .QB[NR$Ucount] - IPADR$ADDRESS_BLEN;
    Uptr = .QB[NR$Uptr] + IPADR$ADDRESS_BLEN;
    Aptr = .QB[NR$Uptr];

! Truncate to user receive request size

    IF .Ucount GTR .URQ[UR$Size] THEN
	Ucount = .URQ[UR$Size];

    IF $$LOGF(LOG$ICMP) THEN
	QL$FAO('!%T Posting ICMP receive,Size=!SL,ICMPCB=!XL,IRP=!XL,UCB_A=!XL!/',
	       0,.Ucount,.ICMPCB,.URQ[UR$IRP_Adrs],.URQ[UR$UCB_Adrs]);

! Copy from our buffer to the user system buffer

    $$KCALL(MOVBYT,.Ucount,.Uptr,.URQ[UR$Data]);

! Copy ICMP Source and destination addresses to system space Diag Buff
! First, get the SysBlk address out of the IRP, then copy the Header
! block from our local copy of UArgs.

    UArgs = .URQ[UR$UArgs];
    IRP = .URQ[UR$IRP_Adrs];
    IF .Uargs[RE$PH_Buff] NEQ 0 THEN
	$$KCALL(MOVBYT,IPADR$ADDRESS_BLEN,
		.Aptr,.Uargs[RE$PH_Buff]);

! Post the I/O and free up memory

    User$Post_IO_Status(.URQ[UR$Uargs],SS$_NORMAL,
			.Ucount,0,0);
    MM$UArg_Free(.URQ[UR$Uargs]);

    MM$QBLK_Free(.URQ);
    MM$Seg_Free(.QB[NR$Buf_Size],.QB[NR$Buf]);
    MM$QBLK_Free(.QB);
    END;

%SBTTL 'ICMPCB_OK - Match connection ID to ICMPCB address'

ROUTINE ICMPCB_OK(Conn_ID,RCaddr,Uargs : REF User_Default_Args) =
    BEGIN
    LOCAL
	ICMPCB : REF ICMPCB_Structure;
    MACRO
	ICMPCBERR(EC) = (.RCaddr = EC; RETURN 0) %;

! Range check the connection id. This should never fail, since the user should
! not be fondling connection IDs.

    IF (.Conn_ID LEQ 0) OR (.Conn_ID GTR MAX_ICMPCB) THEN
	ICMPCBERR(NET$_CDE);	! Nonexistant connection ID
    ICMPCB = .ICMPCB_Table[.Conn_ID];

! Make sure the table had something reasonable for this connection ID

    IF .ICMPCB LEQ 0 THEN
	ICMPCBERR(NET$_CDE);	! ICMPCB has been deleted (possible)

! Check consistancy of ICMPCB back-pointer into table

    IF (.ICMPCB[ICMPCB$ICMPCBID] NEQ .Conn_ID) OR
       (.ICMPCB[ICMPCB$UCB_ADRS] NEQ .Uargs[UD$UCB_Adrs]) THEN
	ICMPCBERR(NET$_CDE);	! Confusion (can this happen?)

! Everything is good - return the ICMPCB address

    RETURN .ICMPCB;
    END;

%SBTTL 'ICMPCB_Get - Allocate and initialize one ICMPCB'

ROUTINE ICMPCB_Get(IDX) =
    BEGIN
    EXTERNAL ROUTINE
	LIB$GET_VM	: ADDRESSING_MODE(GENERAL),
	LIB$GET_VM_PAGE	: ADDRESSING_MODE(GENERAL);
    LOCAL
	ICMPCB : REF ICMPCB_Structure,
	ICMPCBIDX,
	RC,
	Pages ;
    LABEL
	X;

! Find a free slot in the ICMPCB table

X:  BEGIN			! ** Block X **
    ICMPCBIDX = 0;
    INCR I FROM 1 TO MAX_ICMPCB DO
	IF .ICMPCB_Table[.I] EQL 0 THEN
	    LEAVE X WITH (ICMPCBIDX = .I);
    RETURN 0;			! Failed to allocate a ICMPCB
    END;			! ** Block X **

! Allocate some space for the ICMPCB

!    LIB$GET_VM(%REF(ICMPCB_Size*4),ICMPCB);
    Pages = ((ICMPCB_Size * 4) / 512) + 1 ;
    RC = LIB$GET_VM_PAGE(Pages, ICMPCB);
    IF NOT .RC THEN
	FATAL$FAO('ICMPCB_GET - LIB$GET_VM failure, RC=!XL',.RC);

! Clear it out and set it in the table

    ICMPCB_Table[.ICMPCBIDX] = .ICMPCB;
    CH$FILL(%CHAR(0),ICMPCB_Size*4,.ICMPCB);
    ICMPCB_Count = .ICMPCB_Count+1;

! Initialize queue headers for the ICMPCB

    ICMPCB[ICMPCB$NR_Qhead] = ICMPCB[ICMPCB$NR_Qtail] = ICMPCB[ICMPCB$NR_Qhead];
    ICMPCB[ICMPCB$USR_Qhead] = ICMPCB[ICMPCB$USR_Qtail] = ICMPCB[ICMPCB$USR_Qhead];

! Set the connection ID

    ICMPCB[ICMPCB$ICMPCBID] = .ICMPCBIDX;

! Return the pointer

    .IDX = .ICMPCBIDX;
    RETURN .ICMPCB;
    END;

%SBTTL 'ICMPCB_Free - Deallocate a ICMPCB'

ROUTINE ICMPCB_Free(ICMPCBIX,ICMPCB : REF ICMPCB_Structure) : NOVALUE =
    BEGIN
    EXTERNAL ROUTINE
	LIB$FREE_VM 		: ADDRESSING_MODE(GENERAL),
	LIB$FREE_VM_PAGE	: ADDRESSING_MODE(GENERAL);

    LOCAL
	RC,
	Pages ;

! Clear the table entry

    ICMPCB_Table[.ICMPCBIX] = 0;

! Free the memory and decrement our counter.

!    LIB$FREE_VM(%REF(ICMPCB_Size*4),ICMPCB);
    Pages = ((ICMPCB_Size * 4) / 512) + 1 ;
    RC = LIB$FREE_VM_PAGE(Pages, ICMPCB);
    IF NOT .RC THEN
	FATAL$FAO('ICMPCB_FREE - LIB$FREE_VM failure, RC=!XL',.RC);
    ICMPCB_Count = .ICMPCB_Count-1;
    END;

%SBTTL 'Kill_ICMP_Requests - purge all I/O requests for a connection'

ROUTINE Kill_ICMP_Requests(ICMPCB : REF ICMPCB_Structure,RC) : NOVALUE =
    BEGIN
    LOCAL
	URQ : REF Queue_Blk_Structure(QB_UR_Fields),
	QB : REF Queue_Blk_Structure(QB_NR_Fields);

! Make sure we aren't doing this more than once
!
!   IF .ICMPCB[ICMPCB$Aborting] THEN
!	RETURN;

! Say that this connection is aborting (prevent future requests)

    ICMPCB[ICMPCB$Aborting] = TRUE;

! Cancel any name lookup in progess

    IF .ICMPCB[ICMPCB$NMLOOK] THEN
	BEGIN
	NML$CANCEL(.ICMPCB, 0, 0);
	ICMPCB[ICMPCB$NMLOOK] = FALSE;
	END;

! Kill any pending open

    NOINT;
    IF .ICMPCB[ICMPCB$UARGS] NEQ 0 THEN
	BEGIN
	USER$Err(.ICMPCB[ICMPCB$UARGS],.RC);
	ICMPCB[ICMPCB$UARGS] = 0;
	END;
    OKINT;

! Purge the user request queue, posting all requests

    WHILE REMQUE(.ICMPCB[ICMPCB$USR_Qhead],URQ) NEQ Empty_Queue DO
	BEGIN
	IF .ICMPCB[ICMPCB$Internal] THEN
	    (.URQ[UR$ASTADR])(.URQ[UR$ASTPRM],.RC,0)
	ELSE
	    BEGIN
	    User$Post_IO_Status(.URQ[UR$Uargs],.RC,0,0,0);
	    MM$UArg_Free(.URQ[UR$Uargs]);
	    END;
	MM$QBlk_Free(.URQ);	
	END;

! Purge any received qblocks as well

    WHILE REMQUE(.ICMPCB[ICMPCB$NR_Qhead],QB) NEQ Empty_Queue DO
	BEGIN
	MM$Seg_Free(.QB[NR$Buf_Size],.QB[NR$Buf]);
	MM$QBlk_Free(.QB);
	END;
    END;

%SBTTL 'ICMPCB_Close - Close/deallocate a ICMPCB'

ROUTINE ICMPCB_Close(UIDX,ICMPCB : REF ICMPCB_Structure,RC) : NOVALUE =
    BEGIN
    Kill_ICMP_Requests(.ICMPCB,.RC);
    ICMPCB_FREE(.UIDX,.ICMPCB);
    END;

ROUTINE ICMPCB_Abort(ICMPCB : REF ICMPCB_Structure,RC) : NOVALUE =
!
! Abort a ICMPCB - called by ICMP code.
!
    BEGIN
    IF .ICMPCB[ICMPCB$Internal] THEN
	Kill_ICMP_Requests(.ICMPCB,.RC)
    ELSE
	ICMPCB_CLOSE(.ICMPCB[ICMPCB$ICMPCBID],.ICMPCB,.RC);
    END;


%SBTTL 'ICMP$Purge_All_IO - delete ICMP database before network exits'

GLOBAL ROUTINE ICMP$Purge_All_IO : NOVALUE =
    BEGIN
    LOCAL
	ICMPCBIDX,
	ICMPCB : REF ICMPCB_Structure;

! Loop for all connections, purge them, and delete them.

    INCR ICMPCBIDX FROM 1 TO MAX_ICMPCB DO
	IF (ICMPCB = .ICMPCB_Table[.ICMPCBIDX]) NEQ 0 THEN
	    ICMPCB_Close(.ICMPCBIDX,.ICMPCB,NET$_TE);
    END;


%SBTTL 'ICMP$OPEN - open a ICMP "connection"'
%(
    Open a ICMP "connection". Create a ICMP Control Block, which serves as a
    place to hang incoming packets and user receive requests.
 )%

FORWARD ROUTINE
    ICMP_COPEN_DONE,
    ICMP_NMLOOK_DONE : NOVALUE,
    ICMP_ADLOOK_DONE : NOVALUE;

GLOBAL ROUTINE ICMP$OPEN(Uargs : REF User_Open_Args) : NOVALUE =
    BEGIN
    LOCAL
	IPADDR,
	NAMLEN,
	NAMPTR,
	UIDX,
	ICMPCB : REF ICMPCB_Structure,
	ICMPCBPTR,
	Args : VECTOR[4];
    LABEL
	X;

    XLOG$FAO(LOG$USER,'!%T ICMP$OPEN: PID=!XL,CHAN=!XW,FLAGS=!XL X1=!XL!/',
	     0,.Uargs[OP$PID],.Uargs[OP$PIOchan],.Uargs[OP$FLAGS],
	     .UArgs[OP$Ext1]);

! First create a ICMPCB for this connection.

    IF (ICMPCB = ICMPCB_Get(UIDX)) LEQ 0 THEN
	BEGIN
	USER$Err(.Uargs,NET$_UCT);
	RETURN;
	END;

! Initialize user mode values

    ICMPCB[ICMPCB$UCB_ADRS] = .Uargs[OP$UCB_Adrs];
    ICMPCB[ICMPCB$User_ID] = .Uargs[OP$PID];
    ICMPCB[ICMPCB$PIOchan] = .Uargs[OP$PIOchan];

! At this point, the connection exists. Write the connection ID
! back into the Unit Control Block for this connection.

    ICMPCBptr = .Uargs[OP$UCB_Adrs] + UCB$L_CBID;
    $$KCALL(MOVBYT,4,UIDX,.ICMPCBptr);

! Initialize queue headers for the ICMPCB

    ICMPCB[ICMPCB$NR_Qhead] = ICMPCB[ICMPCB$NR_Qtail] = ICMPCB[ICMPCB$NR_Qhead];
    ICMPCB[ICMPCB$USR_Qhead] = ICMPCB[ICMPCB$USR_Qtail] = ICMPCB[ICMPCB$USR_Qhead];

! Copy user arguments to ICMPCB

! Handle wildcard host

    NAMPTR = CH$PTR(Uargs[OP$Foreign_Host]);
    NAMLEN = .Uargs[OP$Foreign_Hlen];
    IF (NOT .Uargs[OP$ADDR_FLAG]) AND (.NAMLEN EQL 0) THEN
	BEGIN
	ICMPCB[ICMPCB$Wildcard] = TRUE;
	ICMPCB[ICMPCB$Foreign_Host] = WILD;
	ICMPCB[ICMPCB$Foreign_Hnlen] = 0;
	ICMPCB[ICMPCB$Local_Host] = WILD;
	ICMPCB[ICMPCB$Uargs] = .Uargs;
	ICMP_NMLOOK_DONE(.ICMPCB,SS$_NORMAL,0,0,0,0);
	RETURN;
	END;

! Check for supplied IP address instead of name

X:  BEGIN			! *** Block X ***
    IF .Uargs[OP$ADDR_FLAG] THEN
	IPADDR = .Uargs[OP$Foreign_Address]
    ELSE
	IF GET_IP_ADDR(NAMPTR,IPADDR) LSS 0 THEN
	    LEAVE X;
    ICMPCB[ICMPCB$Foreign_Hnlen] = 0;
    ICMPCB[ICMPCB$Uargs] = .Uargs;
    ICMP_NMLOOK_DONE(.ICMPCB,SS$_NORMAL,1,IPADDR,0,0);
    ICMPCB[ICMPCB$NMLook] = TRUE;
    NML$GETNAME(.IPADDR,ICMP_ADLOOK_DONE,.ICMPCB);
    RETURN;
    END;			! *** Block X ***

! "standard" case, host name is supplied - start name lookup for it

    ICMPCB[ICMPCB$Uargs] = .Uargs;
    ICMPCB[ICMPCB$NMLook] = TRUE;
    NML$GETALST(.NAMPTR,.NAMLEN,ICMP_NMLOOK_DONE,.ICMPCB);
    END;



%SBTTL 'ICMP_NMLOOK_DONE - Second phase of ICMP$OPEN when namelookup done'
%(
    Come here when the foreign host name has been resolved.
    At this point, we set the local & foreign hosts in the ICMPCB
    and post the users open request.
)%

ROUTINE ICMP_NMLOOK_DONE(ICMPCB,STATUS,ADRCNT,ADRLST,NAMLEN,NAMPTR) : NOVALUE =
    BEGIN
    MAP
	ICMPCB : REF ICMPCB_Structure;
    LOCAL
	RC,
	Uargs : REF User_Open_Args,
	IOSB : NetIO_Status_Block;
    MACRO
	UOP_ERROR(EC) = 
	    BEGIN
	    USER$Err(.Uargs,EC);
	    ICMPCB_FREE(.ICMPCB[ICMPCB$ICMPCBID],.ICMPCB);
	    RETURN;
	    END %;

! Clear name lookup flag and get uargs

    NOINT;
    ICMPCB[ICMPCB$NMLook] = FALSE;
    Uargs = .ICMPCB[ICMPCB$Uargs];
    ICMPCB[ICMPCB$Uargs] = 0;
    OKINT;

! Check status of the name lookup

    IF NOT .STATUS THEN
	UOP_ERROR(.STATUS);

! Finish up the common part of the open

    RC = ICMP_COPEN_DONE(.ICMPCB,.ADRCNT,.ADRLST);
    IF NOT .RC THEN
	UOP_ERROR(.RC);

! Verify that we have access to the host set

!!!HACK!!! Should we do this or not??
!    RC = USER$CHECK_ACCESS(.ICMPCB[ICMPCB$USER_ID],.ICMPCB[ICMPCB$Local_Host],
!		      0,.ICMPCB[ICMPCB$Foreign_Host],0);
!    IF NOT .RC THEN
!	UOP_ERROR(.RC);

! Set the foreign host name in the ICMPCB

    ICMPCB[ICMPCB$Foreign_Hnlen] = .NAMLEN;
    IF .NAMLEN NEQ 0 THEN
	CH$MOVE(.NAMLEN,.NAMPTR,CH$PTR(ICMPCB[ICMPCB$Foreign_Hname]));

! Finally, post the status

    IOSB[NSB$STATUS] = SS$_NORMAL; ! Success return
    IOSB[NSB$Byte_Count] = 0;
    IOSB[NSB$XSTATUS] = 0;
    IO$POST(IOSB,.Uargs);
    MM$UArg_Free(.Uargs);
    END;

%SBTTL 'ICMP_COPEN_DONE - Common user/internal ICMP open done routine'

ROUTINE ICMP_COPEN_DONE(ICMPCB,ADRCNT,ADRLST) =
    BEGIN
    MAP
	ICMPCB : REF ICMPCB_Structure;

! Set local and foreign host numbers according to our info

    IF .ADRCNT GTR 0 THEN
	IP$SET_HOSTS(.ADRCNT,.ADRLST,ICMPCB[ICMPCB$Local_Host],
		     ICMPCB[ICMPCB$Foreign_Host]);

! Done at last - log success

    XLOG$FAO(LOG$USER,'!%T UDB_COPEN: Conn idx = !XL, ICMPCB = !XL!/',
	     0,.ICMPCB[ICMPCB$ICMPCBID],.ICMPCB);
    RETURN SS$_NORMAL;
    END;

%SBTTL 'ICMP_ADLOOK_DONE - Finish ICMP address to name lookup'

ROUTINE ICMP_ADLOOK_DONE(ICMPCB,STATUS,NAMLEN,NAMPTR) : NOVALUE =
    BEGIN
    MAP
	ICMPCB : REF ICMPCB_Structure;

! Clear pending name lookup flag

    ICMPCB[ICMPCB$NMLook] = FALSE;

! Check status

    IF NOT .STATUS THEN
	RETURN;

! Copy the hostname into the ICMPCB

    ICMPCB[ICMPCB$Foreign_Hnlen] = .NAMLEN;
    CH$MOVE(.NAMLEN,.NAMPTR,CH$PTR(ICMPCB[ICMPCB$Foreign_Hname]));
    END;

%SBTTL 'ICMP$CLOSE - close ICMP "connection"'
%(
    Close a ICMP "connection". Kills any receive requests that haven't
    finished yet and deallocates the ICMPCB and any other data structures
    associated with a connection.
)%

GLOBAL ROUTINE ICMP$CLOSE(Uargs : REF User_Close_Args) : NOVALUE =
    BEGIN
    LOCAL
	ICMPCB : REF ICMPCB_Structure,
	RC;

! Check for valid ICMPCB

    IF (ICMPCB = ICMPCB_OK(.Uargs[CL$Local_Conn_ID],RC,.Uargs)) EQL 0 THEN
	BEGIN
	USER$Err(.Uargs,.RC);
	RETURN;
	END;

! Use common routine for closing

    ICMPCB_Close(.Uargs[CL$Local_Conn_ID],.ICMPCB,NET$_CC);

! Close done - post user request and free argblk

    User$Post_IO_Status(.Uargs,SS$_NORMAL,0,0,0);
    MM$UArg_Free(.Uargs);
    END;

%SBTTL 'ICMP$ABORT - abort ICMP "connection"'
%(
    Abort a ICMP "connection". Identical in functionality to ICMP$CLOSE.
 )%

GLOBAL ROUTINE ICMP$ABORT(Uargs : REF User_Abort_Args) : NOVALUE =
    BEGIN
    LOCAL
	ICMPCB : REF ICMPCB_Structure,
	RC;

! Check for valid ICMPCB

    IF (ICMPCB = ICMPCB_OK(.Uargs[AB$Local_Conn_ID],RC,.Uargs)) EQL 0 THEN
	BEGIN
	USER$Err(.Uargs,.RC);
	RETURN;
	END;

! Use common routine for closing

    ICMPCB_Close(.Uargs[AB$Local_Conn_ID],.ICMPCB,NET$_CC);

! Done. Clean up.

    User$Post_IO_Status(.Uargs,SS$_NORMAL,0,0,0);
    MM$UArg_Free(.Uargs);
    END;

%SBTTL 'ICMP$SEND - send ICMP packet'
%(
    Handle user send request for ICMP connection. Form a ICMP packet from the
    user's data buffer and hand it to IP layer for transmission.
 )%

GLOBAL ROUTINE ICMP$SEND(Uargs : REF User_Send_Args) : NOVALUE =
    BEGIN
    LOCAL
	RC,
	Bufsize,
	Buf,
	LocalAddr, ForeignAddr,
	Seg : REF ICMP_Structure,
	Segsize,
	Uhead : REF IPADR$ADDRESS_BLOCK,
	USize,
	ICMPCB : REF ICMPCB_Structure;

! Validate connection ID and get ICMPCB pointer

    IF (ICMPCB = ICMPCB_OK(.Uargs[SE$Local_Conn_ID],RC,.Uargs)) EQL 0 THEN
	BEGIN
	USER$Err(.Uargs,.RC);	! No such connection
	ICMP_MIB[MIB$icmpOutErrors] =
		.ICMP_MIB[mib$icmpOutErrors] + 1;
	RETURN;
	END;
    XLOG$FAO(LOG$USER,'!%T ICMP$SEND: Conn=!XL, ICMPCB=!XL, Size=!SL!/',
	     0,.Uargs[SE$Local_Conn_ID],.ICMPCB,.Uargs[SE$Buf_size]);

! Check for aborted connection

    IF .ICMPCB[ICMPCB$Aborting] THEN
	BEGIN
	XLOG$FAO(LOG$USER,'!%T ICMP$SEND for aborted ICMPCB !XL!/',0,.ICMPCB);
	USER$Err(.Uargs,NET$_CC);
	ICMP_MIB[MIB$icmpOutErrors] =
		.ICMP_MIB[mib$icmpOutErrors] + 1;
	RETURN;
	END;

! Check for invalid buffer size

    IF .Uargs[SE$Buf_Size] LSS 0 THEN
	BEGIN
	USER$Err(.Uargs,NET$_BTS);
	ICMP_MIB[MIB$icmpOutErrors] =
		.ICMP_MIB[mib$icmpOutErrors] + 1;
	RETURN;
	END;

! Check for "address mode" connection and set host addresses from user buffer
! in that case.

    ForeignAddr = .ICMPCB[ICMPCB$Foreign_Host];
    IF .ForeignAddr EQL WILD THEN
	ForeignAddr = .ICMPCB[ICMPCB$Foreign_Host];

    LocalAddr = .ICMPCB[ICMPCB$Local_Host];
    IF .LocalAddr EQL WILD THEN
    IP$SET_HOSTS(1,ForeignAddr,LocalAddr,ForeignAddr);

   IF (.ForeignAddr EQL WILD) THEN
	BEGIN
	USER$Err(.Uargs,NET$_NOPN);
	ICMP_MIB[MIB$icmpOutErrors] =
		.ICMP_MIB[mib$icmpOutErrors] + 1;
	RETURN;
	END;

! Allocate an output buffer and build an IP packet

    USize = .Uargs[SE$Buf_size];
    IF .Usize GTR Max_ICMP_Data_Size THEN
	Usize = Max_ICMP_Data_Size;

! Use preallocated buffer sizes to reduce dynamic memory load

    bufsize = .Usize + IP_hdr_byte_size + Device_header;
    IF .bufsize LEQ .MIN_PHYSICAL_BUFSIZE THEN
	bufsize = .MIN_PHYSICAL_BUFSIZE
    ELSE
	IF .bufsize LEQ .MAX_PHYSICAL_BUFSIZE THEN
	    bufsize = .MAX_PHYSICAL_BUFSIZE;
    Buf = MM$Seg_Get(.Bufsize);	! Get a buffer
    Seg = .Buf + device_header + IP_hdr_byte_size; ! Point at ICMP segment
    Segsize = .Usize+ICMP_Header_Size; ! Length of segment + ICMP header

! Set up the ICMP header
    UHead = Uargs[SE$ProtoHdrBlk];
    Seg[ICM$Type] = .UHead[IPADR$TYPE];
    Seg[ICM$Code] = .UHead[IPADR$CODE];
    Seg[ICM$CkSum] = 0;
    Seg[ICM$VAR] = .UHead[IPADR$SPECIAL];

! Copy the user data into the data area

    $$KCALL(MOVBYT,.Usize,.Uargs[SE$Data_Start],Seg[ICM$Data]);

! Swap the header bytes and compute the checksum

    SwapBytes(ICMP_Header_Size/2,.Seg);
!!!HACK!!! Hardwired in ICMP Header size of 8.
    Seg[ICM$CkSum]=Calc_Checksum(.USize+ICMP_Header_Size,.Seg);

! Log the ICMP packet if desired

    IF $$LOGF(LOG$ICMP) THEN
	Log_ICMP_Packet(.Seg,FALSE,TRUE);

! Send the segment to IP (it will deallocate it)

    ICMPIPID = .ICMPIPID+1;	! Increment packet ID
    RC = SS$_NORMAL;
    IF (IP$SEND(.LocalAddr,.ForeignAddr,ICMPTOS,.ICMPTTL,
		   .Seg,.Segsize,.ICMPIPID,ICMPDF,TRUE,ICMP_Protocol,
		   .Buf,.Bufsize) EQL 0) THEN RC = NET$_NRT;

    ! Keep count of outgoing packets and errors
    ICMP_MIB[MIB$icmpOutMsgs] = .ICMP_MIB[mib$icmpOutMsgs] + 1;
    IF .RC NEQ SS$_NORMAL THEN ICMP_MIB[MIB$icmpOutErrors] =
				    .ICMP_MIB[mib$icmpOutErrors] + 1;

    ! Do SNMP accounting
    SELECTONE .Seg[ICM$Type] OF
	SET
	[ICM_ECHO]:	ICMP_MIB[MIB$icmpOutEchos] =
				.ICMP_MIB[mib$icmpOutEchos] + 1;
	[ICM_TSTAMP]:	ICMP_MIB[MIB$icmpOutTimeStamps] =
				.ICMP_MIB[mib$icmpOutTimeStamps] + 1;
	[ICM_AMREQUEST]:ICMP_MIB[MIB$icmpOutAddrMasks] =
				.ICMP_MIB[mib$icmpOutAddrMasks] + 1;
	[ICM_DUNREACH]:	ICMP_MIB[MIB$icmpOutDestUnreachs] =
				.ICMP_MIB[mib$icmpOutDestUnreachs] + 1;
	[ICM_SQUENCH]:	ICMP_MIB[MIB$icmpOutSrcQuenchs] =
				.ICMP_MIB[mib$icmpOutSrcQuenchs] + 1;
	[ICM_REDIRECT]:	ICMP_MIB[MIB$icmpOutRedirects] =
				.ICMP_MIB[mib$icmpOutRedirects] + 1;
	[ICM_TEXCEED]:	ICMP_MIB[MIB$icmpOutTimeExcds] =
				.ICMP_MIB[mib$icmpOutTimeExcds] + 1;
	[ICM_PPROBLEM]:	ICMP_MIB[MIB$icmpOutParamProbs] =
				.ICMP_MIB[mib$icmpOutParamProbs] + 1;
	[ICM_TSREPLY]:	ICMP_MIB[MIB$icmpOutTimestampReps] =
				.ICMP_MIB[mib$icmpOutTimestampReps] + 1;
	[ICM_AMREPLY]:	ICMP_MIB[MIB$icmpOutAddrMaskReps] =
				.ICMP_MIB[mib$icmpOutAddrMaskReps] + 1;
	[ICM_EREPLY]:	ICMP_MIB[MIB$icmpOutEchoReps] =
				.ICMP_MIB[mib$icmpOutEchoReps] + 1;
	TES;

! Post the I/O request back to the user

    User$Post_IO_Status(.Uargs,.RC,0,0,0);
    MM$UArg_Free(.Uargs);

    END;



%SBTTL 'ICMP$RECEIVE - receive a ICMP packet'
%(
    Handle user receive request for ICMP connection. If there is a packet
    available on the ICMP receive queue, then deliver it to the user
    immediately. Otherwise, queue up the user receive for later.
 )%

GLOBAL ROUTINE ICMP$RECEIVE(Uargs : REF User_Recv_Args) : NOVALUE =
    BEGIN
    LOCAL
	ICMPCB : REF ICMPCB_Structure,
	QB : REF Queue_Blk_Structure(QB_NR_Fields),
	URQ : REF Queue_Blk_Structure(QB_UR_Fields),
	RC;

! Validate connection ID and get ICMPCB pointer

    IF (ICMPCB = ICMPCB_OK(.Uargs[RE$Local_Conn_ID],RC,.Uargs)) EQL 0 THEN
	BEGIN
	USER$Err(.Uargs,.RC);	! No such connection
	RETURN;
	END;
    XLOG$FAO(LOG$USER,'!%T ICMP$RECEIVE: Conn=!XL, ICMPCB=!XL, Size=!SL!/',
	     0,.Uargs[RE$Local_Conn_ID],.ICMPCB,.Uargs[RE$Buf_size]);

! Check for aborted connection

    IF .ICMPCB[ICMPCB$Aborting] THEN
	BEGIN
	XLOG$FAO(LOG$USER,'!%T ICMP$RECEIVE for aborted ICMPCB !XL!/',0,.ICMPCB);
	USER$Err(.Uargs,NET$_CC);
	RETURN;
	END;

! Check for invalid buffer size

    IF .Uargs[RE$Buf_Size] LEQ 0 THEN
	BEGIN
	USER$Err(.Uargs,NET$_BTS);
	RETURN;
	END;

! Make a request block for the receive

    URQ = MM$QBLK_Get();		! Get a queue block
    URQ[UR$Size] = .Uargs[RE$Buf_size]; ! # of bytes this rq can take
    URQ[UR$Data] = .Uargs[RE$Data_Start]; ! Address of system buffer
    URQ[UR$IRP_Adrs] = .Uargs[RE$IRP_Adrs]; ! IO request packet address
    URQ[UR$UCB_Adrs] = .Uargs[RE$UCB_Adrs]; ! Unit Control Block address
    URQ[UR$Uargs] = .Uargs;	! User argument block address

! If anything is available on the queue, deliver it now, else queue for later

    NOINT;
    IF REMQUE(.ICMPCB[ICMPCB$NR_Qhead],QB) NEQ Empty_Queue THEN
	Deliver_ICMP_Data(.ICMPCB,.QB,.URQ)
    ELSE
	INSQUE(.URQ,.ICMPCB[ICMPCB$USR_Qtail]);
    OKINT;
    END;



%SBTTL 'ICMP$INFO - get info about ICMP "connection"'
%(
    Read the host names/numbers for a ICMP connection.
 )%

GLOBAL ROUTINE ICMP$INFO(Uargs : REF User_Info_Args) : NOVALUE =
    BEGIN
    EXTERNAL ROUTINE
	USER$Net_Connection_Info : NOVALUE;
    LOCAL
	ICMPCB : REF ICMPCB_Structure,
	RC;

! Validate the connection ID

    IF (ICMPCB = ICMPCB_OK(.Uargs[IF$Local_Conn_ID],RC,.Uargs)) EQL 0 THEN
	BEGIN
	USER$Err(.Uargs,.RC);	! Bad connection ID
	RETURN;
	END;

! Give the information back (common TCP/ICMP routine in USER.BLI)

    USER$Net_Connection_Info(.Uargs,.ICMPCB[ICMPCB$Local_Host],
			.ICMPCB[ICMPCB$Foreign_Host],
			0,0,
			ICMPCB[ICMPCB$Foreign_Hname],
			.ICMPCB[ICMPCB$Foreign_Hnlen]);
    END;


%SBTTL 'ICMP$STATUS - get status of ICMP "connection"'
%(
    This routine is a placeholder for the network STATUS command, which is
    currently implemented for the TCP protocol.
 )%

GLOBAL ROUTINE ICMP$STATUS(Uargs : REF User_Status_Args) : NOVALUE =
    BEGIN
    USER$Err(.Uargs,NET$_NYI);
    END;

%SBTTL 'ICMP$CANCEL - Handle VMS cancel for ICMP connection'
%(
    Handle process abort/$CANCEL request for a ICMP connection. Identical
    in functionality to ICMP$CLOSE/ICMP$ABORT except for calling procedure.
 )%

GLOBAL ROUTINE ICMP$CANCEL(Uargs : REF VMS$Cancel_Args) =
    BEGIN
    LOCAL
	ICMPCB : REF ICMPCB_Structure,
	Fcount;

    Fcount = 0;

! Check all valid ICMPCB's looking for a match on pid and channel #.

    INCR I FROM 1 TO MAX_ICMPCB DO
	IF (ICMPCB = .ICMPCB_Table[.I]) NEQ 0 THEN
	    BEGIN

! If the process doing the cancel owns this connection, then delete it.

	    IF (.ICMPCB[ICMPCB$User_ID] EQLU .Uargs[VC$PID]) AND
	       (.ICMPCB[ICMPCB$PIOchan] EQL .Uargs[VC$PIOchan]) THEN
		BEGIN
		XLOG$FAO(LOG$USER,'!%T ICMP$Cancel: ICMPCB=!XL!/',0,.ICMPCB);
		ICMPCB_Close(.I,.ICMPCB,NET$_ccan);
		Fcount = .Fcount + 1;
		END;
	    END;
    RETURN .Fcount;
    END;

%SBTTL 'ICMP dump routines'

GLOBAL ROUTINE ICMP$Connection_List(RB) : NOVALUE =
!
! Dump out the list of ICMP connections.
!
    BEGIN
    MAP
	RB : REF D$ICMP_List_Return_Blk;
    LOCAL
	RBIX;
    RBIX = 1;
    INCR I FROM 1 TO MAX_ICMPCB-1 DO
	IF .ICMPCB_TABLE[.I] NEQ 0 THEN
	    BEGIN
	    RB[.RBIX] = .I;
	    RBIX = .RBIX + 1;
	    END;
    RB[0] = .RBIX - 1;
    END;

GLOBAL ROUTINE ICMP$ICMPCB_Dump(ICMPCBIX,RB) =
!
! Dump out a single ICMP connection
!
    BEGIN
    MAP
	RB : REF D$ICMPCB_Dump_Return_BLK;
    LOCAL
	ICMPCB : REF ICMPCB_Structure,
	QB,
	Qcount;

! Validate that there is a real ICMPCB there

    IF (.ICMPCBIX LSS 1) OR (.ICMPCBIX GTR MAX_ICMPCB) OR
       ((ICMPCB = .ICMPCB_TABLE[.ICMPCBIX]) EQL 0) THEN
	RETURN FALSE;

! Copy the ICMPCB contents

    RB[DU$ICMPCB_Address] = .ICMPCB;
    RB[DU$ICMPCB_Foreign_Host] = .ICMPCB[ICMPCB$Foreign_Host];
    RB[DU$ICMPCB_Local_Host] = .ICMPCB[ICMPCB$Local_Host];
    RB[DU$ICMPCB_Flags] = .ICMPCB[ICMPCB$Flags];
    RB[DU$ICMPCB_User_ID] = .ICMPCB[ICMPCB$User_ID];

! Get length of network receive queue

    QB = .ICMPCB[ICMPCB$NR_Qhead];
    Qcount = 0;
    WHILE (.QB NEQA ICMPCB[ICMPCB$NR_Qhead]) DO
	BEGIN
	MAP
	    QB : REF Queue_Blk_Structure(QB_NR_Fields);
	Qcount = .Qcount + 1;
	QB = .QB[NR$NEXT];
	END;
    RB[DU$ICMPCB_NR_Qcount] = .Qcount;

! Get length of user receive queue

    QB = .ICMPCB[ICMPCB$USR_Qhead];
    Qcount = 0;
    WHILE (.QB NEQA ICMPCB[ICMPCB$USR_Qhead]) DO
	BEGIN
	MAP
	    QB : REF Queue_Blk_Structure(QB_UR_Fields);
	Qcount = .Qcount + 1;
	QB = .QB[UR$NEXT];
	END;
    RB[DU$ICMPCB_UR_Qcount] = .Qcount;

! Done.

    RETURN TRUE;
    END;
END
ELUDOM