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

		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
    Ping (
	ADDRESSING_MODE(EXTERNAL=LONG_RELATIVE,
			NONEXTERNAL=LONG_RELATIVE),
	IDENT='1.1',
	LIST (ASSEMBLY, BINARY, NOEXPAND),
	LANGUAGE(BLISS32)) =
BEGIN
!++
! PING.BLI	Copyright (c) 1989	Carnegie Mellon University
!
! Description:
!
!	Code to send and receive ICMP echo requests.
!
! Author:	Bruce R. Miller		CMU Network Development
! Date:		December 5, 1989  (My birthday, of all days...)
!
! Modifications:
!
! 1.1	09-Jan-1991	Bruce R. Miller		CMU Network Development
!	Fixed Ping-yourself failure.  Added some nice new display
!	features, like missed packets.  Neatened things up.
!
!--

LIBRARY 'SYS$LIBRARY:STARLET';
LIBRARY 'CMUIP_SRC:[central]netXPORT';
LIBRARY 'CMUIP_SRC:[central]neterror';
LIBRARY 'CMUIP_SRC:[central]netcommon';
LIBRARY 'CMUIP_SRC:[central]network';
LIBRARY 'CMUIP_SRC:[central]netaux';
LIBRARY 'CMUIP_SRC:[central]netTCPIP';
LIBRARY 'IPNCP';



LITERAL
    Ping_Data_Size = 32;

$FIELD PING$XMSG_FIELDS =
    SET
    PING$IOSB	= [$BYTES(8)],		! A conviently located IO status block
    PING$HEADER = [$BYTES(IPADR$ADDRESS_BLEN)],	! the protocol header
    PING$LENGTH	= [$BYTES(2)],			! Length of buffer
    PING$DATA	= [$BYTES(Ping_Data_Size)]	! Start of buffer
    TES;
LITERAL
    PING$XMSG_SIZE = $FIELD_SET_SIZE,
    PING$XMSG_BLEN = 8+IPADR$ADDRESS_BLEN+2+Ping_Data_Size;
MACRO
    PING$XMSG = BLOCK[PING$XMSG_SIZE] FIELD(PING$XMSG_FIELDS) %;

LITERAL
    MAXWAIT = 10,	! Max time to wait for response
    MAXPACKET = 4096;	! Max packet size.

OWN
    npackets,
    ntransmitted : INITIAL (0),
    nreceived : INITIAL (0),
    Last_Seq : INITIAL (-1),
    ident,
    tmin : INITIAL (99999999),
    tmax : INITIAL (0),
    tsum : INITIAL (0),
    verbose,
    bar,
    packet : VECTOR[MAXPACKET,BYTE],
    datalen,
    options,
    Done;

OWN
    ICMP_Channel,
    Main_buff : PING$XMSG,
    IPAddr;



ROUTINE ICMP_SetUp ( HostName_A , IPAddr) =
    BEGIN
    EXTERNAL ROUTINE
	STR$CONCAT	: BLISS ADDRESSING_MODE (GENERAL),
	STR$FREE1_DX	: BLISS ADDRESSING_MODE (GENERAL);
    BIND
	HostName	= .HostName_A;
    LOCAL
	Chan,
	Host_ASCIZ	: $BBLOCK [DSC$K_S_BLN],
        Info_Block      : Connection_Info_Return_Block,
	ICMP_IOSB	: NetIO_Status_Block,
	Status;

    Status = $ASSIGN (DEVNAM = %ASCID'INET$DEVICE', CHAN = Chan);
!!!Hack!!! we need a better error message here.
    IF NOT .Status THEN Signal (.Status);

    $Init_DynDesc (Host_ASCIZ);

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

    Status = NET$OPEN (
		FHNAM		= .Host_ASCIZ [DSC$A_POINTER],
		Protocol	= U$ICMP_Protocol,
!		AddrFlag	= 1,
		OpenMode	= ACTIVE,
		TimOut		= 0,
		IOCHAN		= .Chan,
		IO$SB		= ICMP_IOSB);
    IF NOT .Status THEN Signal (.Status);
    Status = .ICMP_IOSB [NSB$Status];
    IF .Status EQL SS$_ABORT THEN
	BEGIN
	Signal( .ICMP_IOSB [NSB$XStatus] );
	RETURN(0)
	END;
    IF NOT .Status THEN Signal (.Status);

    ! Give it back.
    Status = STR$FREE1_DX (Host_ASCIZ);
    IF NOT .Status THEN Signal (.Status);

    ! What was the IP address of the destination?
    Status = NET$INFO (
		BUFAdrs	= Info_Block,
		IOCHAN	= .Chan,
		IO$SB	= ICMP_IOSB);
    IF NOT .Status THEN Signal (.Status);
    Status = .ICMP_IOSB [NSB$Status];
    IF NOT .Status THEN Signal (.Status);

    ! Return the results.
    .IPAddr = .Info_Block[CI$Remote_Internet_Adrs];
    .Chan
    END;



ROUTINE Finish : NOVALUE =
    BEGIN

    PrintTT('!UL packets transmitted!/',.ntransmitted);
    PrintTT('!UL packets received!/',.nreceived);
    IF .ntransmitted GTR 0 THEN
	PrintTT('!UB% packet loss!/',
		((.ntransmitted-.nreceived)*100)/.ntransmitted);

    IF (.nreceived GTR 0) THEN
	BEGIN
	PrintTT('Round Trip Time (ms)  min/avg/max = !UL/!UL/!UL!/',
		.tmin, .tsum / .nreceived, .tmax);
	END;

    $WAKE();

    END;



OWN
    scale : INITIAL(0);

ROUTINE pr_pack ( Buff , ProtoHdr ) : NOVALUE =
    BEGIN
    EXTERNAL ROUTINE
	LIB$SUB_TIMES : BLISS ADDRESSING_MODE (GENERAL);
!	LIB$CVT_FROM_INTERNAL_TIME : BLISS ADDRESSING_MODE (GENERAL);
    MAP
	Buff : REF $BBLOCK[0],
	ProtoHdr : REF IPADR$ADDRESS_BLOCK;
    LOCAL
	newid,
	Stars : REF VECTOR[80,BYTE] INITIAL(UPLIT('***********************************************************!')),
	nStars,
	type : BYTE,
	Seq : WORD,
	trip_time,
	time_diff : VECTOR [2],
	time_now : VECTOR [2],
	time_then : REF VECTOR [2];

    $GETTIM ( timadr = time_now );
    time_then = .Buff;

    NewId = .(ProtoHdr[IPADR$SPECIAL])<0,16,0>;
    type = .ProtoHdr[IPADR$CODE];	!!! HACK !!!
    Seq = .(ProtoHdr[IPADR$SPECIAL])<16,16,0>;

    IF .Verbose THEN
	PrintTT('Received ICMP : type=!XB ID=!XW code=!XB!/',
	.type,.NewID);

    ! Is it the right type of packet?
    IF .type NEQ ICM_EREPLY THEN
	BEGIN
	IF .Verbose THEN
	    PrintTT('Not a reply packet... (typ=!XW) (hmph)!/',.type);
	RETURN 0
	END;

    ! Is it my packet?
    IF .newid NEQ .Ident THEN
	BEGIN
	IF .Verbose THEN
	    PrintTT('not my packet... (id=!XW) (hmph)!/',.NewId);
	RETURN 0
	END;

    ! It's a good packet
    nreceived = .nreceived + 1;

    LIB$SUB_TIMES ( time_now , .time_then , time_diff );
    trip_time = (-.time_diff[0]) / 10000;
    IF (.trip_time LSS 0) THEN trip_time = 0;
    IF (.scale EQL 0) THEN scale = 2*.trip_time/60;
    IF (.scale EQL 0) THEN scale = 1;
    IF ((nStars = .trip_time/.scale) GTR 60) THEN nStars = 60;

    IF .Verbose THEN
	PrintTT('RTT = !UL ms. |!AD!/',.trip_time,
		.nStars,Stars);
    tsum = .tsum + .trip_time;
    if .trip_time LSS .tmin THEN tmin = .trip_time;
    if .trip_time GTR .tmax THEN tmax = .trip_time;

    IF .Seq LSS .Last_Seq + 1 THEN
	PrintTT('!3UW RTT=!4ULms.  Non-Seq!/',.Seq,.trip_time)
    ELSE
	BEGIN
	IF .Seq GTR .Last_Seq + 1 THEN
	    PrintTT('<missed !UB>!/', .Seq - (.Last_Seq + 1));
	PrintTT('!3UW RTT=!4UL ms. ',.Seq,.trip_time);
	IF (.Bar) THEN
	    PrintTT('|!AD!/',.nStars,.Stars)
	ELSE
	    PrintTT('!/')
	END;

    Last_Seq = .Seq
    END;



FORWARD ROUTINE
    recv : NOVALUE;

ROUTINE recv_ast ( xmsg : REF PING$XMSG ) =
    BEGIN
    LOCAL
	Status;
    BIND
	Buff = xmsg [ PING$DATA ] : $BBLOCK[0],
	ProtoHdr = xmsg [ PING$HEADER ] : IPADR$ADDRESS_BLOCK,
	ICMP_IOSB = xmsg [ PING$IOSB ] : NetIO_Status_Block;

    Status = .ICMP_IOSB [NSB$Status];
    IF .Status EQL SS$_ABORT THEN
	BEGIN
	IF .ICMP_IOSB[NSB$XStatus] NEQU NET$_CC THEN
	    Signal( .ICMP_IOSB [NSB$XStatus] );
	RETURN 0
	END
    ELSE IF NOT .Status THEN Signal (.Status);

    IF .Verbose THEN
	PrintTT('got packet from !XL!/',.ProtoHdr[IPADR$SRC_HOST]);

    pr_pack ( Buff , ProtoHdr );

    IF (.nreceived EQL .npackets) AND
	(.npackets NEQ 0) AND (.ntransmitted GEQ .npackets) THEN
	BEGIN
	PrintTT('done!!!/');
	$CANTIM();
	Finish();
	END;

    recv ( .ICMP_Channel , .xmsg );

   .Status
    END;

ROUTINE recv ( Chan , xmsg : REF PING$XMSG ) : NOVALUE =
    BEGIN
    LOCAL
	Status;

    IF .Done THEN RETURN;

    Status = NET$RECEIVE (
	BufAdrs	= xmsg[PING$DATA],
	BufSize	= Ping_Data_Size,
	IOMode	= ASynch,
	ADDR_SPEC = xmsg[PING$HEADER],
	IOCHAN	= .Chan,
	IO$SB	= xmsg[PING$IOSB],
	AST$ADR = recv_ast,
	AST$PRM = .xmsg);

    IF NOT .Status THEN Signal (.Status);

    .Status
    END;



ROUTINE Pinger =
    BEGIN
    LOCAL
	outpack	: VECTOR [MaxPacket,BYTE],
	Status,
	ProtoHdr	: IPADR$ADDRESS_BLOCK,
	ICMP_IOSB	: NetIO_Status_Block;
    BIND
        time = outpack	: VECTOR[2];

    ProtoHdr[IPADR$SRC_HOST] = 0;
    ProtoHdr[IPADR$DST_HOST] = .IPAddr;

    ProtoHdr[IPADR$TYPE] = ICM_ECHO;
    ProtoHdr[IPADR$CODE] = 0;
    (ProtoHdr[IPADR$SPECIAL])<0,16,0> = .ident;
    (ProtoHdr[IPADR$SPECIAL])<16,16,0> = .ntransmitted;
    ntransmitted = .ntransmitted+1;

    INCR I FROM 8 to .datalen DO
	outpack[.I] = .I;

    IF .Verbose THEN
	PrintTT('Sending ICMP type=!XB  ID=!XW  Seq=!SW!/',
	.ProtoHdr[IPADR$TYPE],.ident,.ntransmitted-1);

    $GETTIM ( timadr = time );

    Status = NET$SEND (
	BufAdrs	= outpack,
	BufSize	= 32,
	IOMode	= Synch,
	EOL	= 1,
	ADDR_SPEC = ProtoHdr,
	IOCHAN	= .ICMP_Channel,
	IO$SB	= ICMP_IOSB);

    IF NOT .Status THEN Signal (.Status);
    Status = .ICMP_IOSB [NSB$Status];
    IF .Status EQL SS$_ABORT THEN
	Signal( .ICMP_IOSB [NSB$XStatus] )
    ELSE IF NOT .Status THEN Signal (.Status);

    .Status
    END;



ROUTINE CATCHER : NOVALUE =
    BEGIN
    EXTERNAL ROUTINE
	LIB$CVT_TO_INTERNAL_TIME : BLISS ADDRESSING_MODE (GENERAL);
    LOCAL
	SLEEP_TIME : VECTOR[2],
	timeout_rtn,
	waittime;

    Pinger();
    waittime = 1;
    timeout_rtn = CATCHER;

    IF (.npackets NEQ 0) AND (.ntransmitted GEQ .npackets) THEN
	BEGIN
	timeout_rtn = Finish;
	IF .nreceived EQL 0 THEN
	    waittime = MAXWAIT
	ELSE
	    IF (waittime = 2 * .tmax / 1000) EQL 0 THEN waittime = 1;
	END;

    LIB$CVT_TO_INTERNAL_TIME ( %ref(LIB$K_DELTA_SECONDS) , waittime ,
				SLEEP_TIME );
    IF .Verbose THEN
	PrintTT('Sleeping !UW seconds.!/',.waittime);
    $SETIMR(DAYTIM = SLEEP_TIME,
	    ASTADR = .timeout_rtn);
    END;

GLOBAL ROUTINE Ping ( HostName_A , DataSize, Attempts,
		      Verbose_Flag, Bar_Flag) : NOVALUE =

!++
! Functional Description:
!
!--

    BEGIN
    LOCAL
	tmp,
	Item_List;

    npackets = 0;
    ntransmitted = 0;
    nreceived = 0;
    ident = 0;
    tmin = 99999999;
    tmax  = 0;
    tsum = 0;
    verbose = 0;
    datalen = 0;

    PrintTT('PING !AS!/', .HostName_A );

    ICMP_Channel = ICMP_SetUp ( .HostName_A , IPaddr );
    IF .ICMP_Channel EQL 0 THEN Return;

    datalen = 32;
    npackets = .Attempts;
    Verbose = .Verbose_flag;
    Bar = .Bar_flag;

    Ident = 0;
    Item_List = 0;
    $GETJPI ( PIDADR = ident , ITMLST = Item_List );
    ident<16,31> = 0; !Mask off high word (in case this is a cluster.)

    Done = 0;
    catcher();
    recv( .ICMP_Channel , Main_buff );

    $HIBER;

    Done = 1;
    NET$CLOSE ( IOChan = .ICMP_Channel );
    $DASSGN ( CHAN = .ICMP_Channel );

    PrintTT('Bye bye!/')
    END;

END ELUDOM