Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Posting-Version: version B 2.10 5/3/83; site k.cs.cmu.edu
Path: utzoo!watmath!clyde!burl!ulysses!mhuxr!mhuxn!ihnp4!qantel!lll-crg!seismo!rochester!pt.cs.cmu.edu!k.cs.cmu.edu!tim
From: tim@k.cs.cmu.edu (Tim Maroney)
Newsgroups: net.sources.mac
Subject: Macintosh Internet Protocols (3 of 12)
Message-ID: <662@k.cs.cmu.edu>
Date: Tue, 26-Nov-85 04:54:02 EST
Article-I.D.: k.662
Posted: Tue Nov 26 04:54:02 1985
Date-Received: Fri, 29-Nov-85 21:24:21 EST
Organization: Carnegie-Mellon University, Networking
Lines: 1705

echo extracting net/arp_lib.text...
cat >net/arp_lib.text <<'!E!O!F!'
{$X-}
{$M+}
{$R-}
{$0V-}
{$D-}
{$DECL DEBUG}
{$SETC DEBUG := false}
Unit ARP_Lib;

{ Please note the copyright notice in the file "copyright/notice" }

{
Note: This code was inspired by the Ethernet device handler in the
PCIP system distributed by MIT.
}

INTERFACE

{$L-}

   USES {$U-}
      {$U Obj-Memtypes	  } Memtypes,
      {$U Obj-QuickDraw	  } QuickDraw,
      {$U Obj-OSIntf	  } OSIntf,
      {$U Obj-ToolIntf	  } ToolIntf,
      {$U Obj-ABPasIntf	  } ABPasIntf,
      {$U net-Task_Lib	  } Task_Lib,
      {$U net-Timer_Lib	  } Timer_Lib,
      {$U net-IP_Lib	  } IP_Lib;

{$L+}

CONST
	MaxIPAddr = 10;

	ARP_Request     =       1;
	ARP_Reply       =       2;
	ARP_Hrd_AB      =       3; { This magic number created by Mark Sherman
				     and is not official }

	AB_ARP	        =       23;{ Address resolution protocol, as per
				     Ethernet and RFC 826. However, ethernet uses
				     protocol number 2054 to represent an ARP
				     Protocol - I can not since DDP only has 8
				     bits of protocol number. }

	AR_DOD_IP       =       2048; { Magic number requesting translation to
					/from DOD internet protocol }

TYPE
	ARP_Buf = PACKED RECORD
			AR_Hrd: Integer;        { Hardward address space }
			AR_Pro: Integer;        { Protocol address space }
			AR_Hln: Byte;	        { Byte len of hardware add = 4 }
			AR_Pln: Byte;	        { Byte len of protocol add = 4 }
			AR_Op:  Integer;        { Opcode (request or reply) }
			AR_Snd_AB: AddrBlock;   { Hardware address of sender }
			AR_Snd_IP: in_name;     { Protocol address of sender }
			AR_Tar_AB: AddrBlock;   { Hardware address of target }
			AR_Tar_IP: in_name;     { Protocol address of target }
			END;

	ARP_Packet = ^ ARP_Buf;

	IP2AB_Entry = RECORD
			AB: AddrBlock;
			IP: in_name;
			Count: Integer; { try to keep some statistics }
			END;

FUNCTION arp_init: Ref_Task;
PROCEDURE Add_AB_Address(IP_Address:in_name;AB_Addr:AddrBlock);
PROCEDURE AB_ARP_Snd(WhichWay:Integer; Recipient: AddrBlock;
		    Other_IP_Addr: in_name);
PROCEDURE AB_ARP_Rcv(Dummy:PTR);
FUNCTION Get_AB_Address(IP_Address:in_name;VAR AB_Addr:AddrBlock): Boolean;
PROCEDURE IP2AB(IP: in_name; VAR AB:AddrBlock);

CONST	  ARPTKSZ = 2048;

IMPLEMENTATION

VAR
	ARPtask: Ref_Task;	       { main ARP receiving task }
	Cur_ARP_Pkt:ARP_Packet;	       { ARP receive packet }
	arp_rcv: Ref_Task;	       { Task that waits for incoming ARPs }

	my_AB_Addr: AddrBlock;	       { My Apple bus address }
	Everyone_on_AB: AddrBlock;     { A reusable broadcast address }

	my_ARP_Pkt: ARP_Packet;	       { Reusable send packet for ARP }

	{ Table of IP <-> AB Pairs }
	IP2AB_Table: ARRAY [0..MaxIPAddr] OF IP2AB_Entry;
	Last_IP2AB_Entry: -1..MaxIPAddr; { Last Entry Filled In }
	Next_IP2AB_Entry: 0..MaxIPAddr; { Next Entry to Use when inserting entry }

	{ Statistics on ARP Usage }

	ABARPSnd: Integer;	        { ARPs sent }
	ABARPReq: Integer;	        { ARP requests received }
	ABARPRep: Integer;	        { ARP replies received }
	ABARPNotMe: Integer;	        { Misaddress ARPs - should be 0 w/ DDP }
	ABARPBad: Integer;	        { ARP Packet ill formed }
	ABARPUnexpected: Integer;       { Got ARP when Request not outstanding }
	ABARPProtocolErr: Integer;      { ARP wanted non IP address translation }

{$S InitSeg }

PROCEDURE ARPEnable; external;
FUNCTION GetARPBuf:ARP_Packet; external;

FUNCTION arp_init: Ref_Task;
VAR     myNode,myNet:INTEGER;
BEGIN
	ABARPSnd := 0;
	ABARPReq := 0;
	ABARPRep := 0;
	ABARPNotMe := 0;
	ABARPBad := 0;
	ABARPUnexpected := 0;
	ABARPProtocolErr := 0;

	if GetNodeAddress(myNode,myNet) <> noErr then exit(arp_init);
	my_AB_Addr.ANode := myNode;
	my_AB_Addr.ANet := myNet;
	my_AB_Addr.ASocket := AB_IP_Socket;

	Everyone_on_AB.ANet := 0;
	Everyone_on_AB.ANode := $FF;
	Everyone_on_AB.ASocket := AB_IP_Socket;

	Last_IP2AB_Entry := -1;
	Next_IP2AB_Entry := 0;

	{ ARP initialization }
	arp_rcv := NIL;
	my_ARP_Pkt := POINTER(ORD4(NewPtr(sizeof(ARP_Buf))));
	cur_ARP_Pkt := getarpbuf;

	ARPtask := tk_fork(tk_cur,@AB_ARP_Rcv,ARPTKSZ,'ARP Recv',NIL);
	arp_init := ARPTask;
END;

{$S	    }

{$IFC DEBUG}
PROCEDURE out_inaddr(fhost: in_name);
VAR host:_ipname;
BEGIN
	host.in_lname := fhost;
	Write(BitAND(host.in_lst.in_net,255):1,'.',
	      BitAND(host.in_lst.in_nets,255):1,'.',
	      BitAND(host.in_lst.in_netss,255):1,'.',
	      BitAND(host.in_lst.in_host,255):1);
END; { End of out_inaddr }
{$ENDC}

PROCEDURE Add_AB_Address(IP_Address:in_name;AB_Addr:AddrBlock);
{ Look in the table for the appropriate ip address. If there, reset AB_Addr
  to it, otherwise make a new entry }
VAR i: Integer;
BEGIN
{$IFC DEBUG}
    Write('Add_AB_Address: Associating IP address ');
    out_inaddr(IP_Address);WriteLn(' with AB address ',AB_Addr.ANode:1);
{$ENDC}

    FOR i := 0 TO Last_IP2AB_Entry DO
	IF IP2AB_Table[i].IP = IP_Address THEN BEGIN
	    IP2AB_Table[i].AB := AB_Addr;
	    EXIT(Add_AB_Address);
	    END;

    { Hmm, not in table already, must make a new entry }
    IP2AB_Table[Next_IP2AB_Entry].IP := IP_Address;
    IP2AB_Table[Next_IP2AB_Entry].AB := AB_Addr;
    Next_IP2AB_Entry := Next_IP2AB_Entry + 1;
    IF Next_IP2AB_Entry > MaxIPAddr THEN Next_IP2AB_Entry := 0;
    IF Last_IP2AB_Entry <> MaxIPAddr THEN Last_IP2AB_Entry := Last_IP2AB_Entry + 1;

END;

PROCEDURE AB_ARP_Snd(WhichWay:Integer; Recipient: AddrBlock;
		    Other_IP_Addr: in_name);
	{Always use the same packet to send }
VAR
	Success: Integer; { Status DDP write - ignored for ARP }
	myNode,myNet:INTEGER;
BEGIN
{$IFC DEBUG}
	WriteLn('AB_ARP_Snd: About to send an ARP packet');
{$ENDC}
	WITH my_ARP_Pkt^ DO BEGIN
	    AR_Hrd:= ARP_Hrd_AB;
	    AR_Pro:= AR_DOD_IP;
	    AR_Hln:= sizeof(AddrBlock);
	    AR_Pln:= sizeof(in_name);
	    AR_Op:= WhichWay;
	    { Should not be necessary but we are paranoid }
	    if GetNodeAddress(myNode,myNet) <> noErr then exit(AB_ARP_Snd);
	    my_AB_Addr.ANode := myNode;
	    my_AB_Addr.ANet := myNet;
	    my_AB_Addr.ASocket := AB_IP_Socket;
	    AR_Snd_AB:= my_AB_Addr;
	    AR_Snd_IP:= LocalIPaddr;
	    AR_Tar_AB:= Recipient;
	    AR_Tar_IP:= Other_IP_Addr;
	    END;

{$IFC DEBUG}
	WriteLn('The Write call is using socket ',my_AB_Addr.ASocket);
	WriteLn('With buffer length ',sizeof(ARP_Buf));
	WriteLn('Going to node ',Recipient.ANode);
{$ENDC}

	{ Wait until previous write finished }
	WHILE CurW_Hdl^^.abResult = 1 DO tk_yield;
	{ Fill in the disk block }
	WITH CurW_Hdl^^ DO BEGIN
	    ddpType := AB_ARP;
	    ddpSocket := my_AB_Addr.ASocket;
	    ddpAddress := Recipient;
	    ddpReqCount := sizeof(ARP_BUF);
	    ddpDataPtr := POINTER(ORD4(my_ARP_Pkt));
	    END;
	{ And do the write }
	Success := DDPWrite(CurW_Hdl,false,true);

{$IFC DEBUG}
	WriteLn('AB_ARP_Snd: Wrote packet on applebus, status = ',Success);
{$ENDC}
END;

PROCEDURE AB_ARP_Rcv(Dummy:PTR);
LABEL 777;
BEGIN
    WHILE TRUE DO BEGIN
777:
	ARPEnable;
	tk_block;

{$IFC DEBUG}
	WriteLn('AB_ARP_Rcv: Received an ARP packet');
{$ENDC}

	WITH Cur_ARP_Pkt^ DO BEGIN
{$IFC DEBUG}
	WriteLn('AR_Hrd = ',AR_Hrd);
	WriteLn('AR_Pro = ',AR_Pro);
	WriteLn('AR_Hln = ',AR_Hln);
	WriteLn('AR_Pln = ',AR_Pln);
	WriteLn('AR_Op  = ',AR_Op);
	WriteLn('AR_Snd_AB = ',AR_Snd_AB.ANode);
	Write('AR_Snd_IP = ');out_inaddr(AR_Snd_IP);WriteLn('');
	WriteLn('AR_Tar_AB = ',AR_Tar_AB.ANode);
	Write('AR_Tar_IP = ');out_inaddr(AR_Tar_IP);WriteLn('');
{$ENDC}

       { Wants hardware translation for Apple Bus? }
       IF AR_Hrd <> ARP_Hrd_AB THEN BEGIN
{$IFC DEBUG}
	   WriteLn('AB_ARP_Rcv: Doesn''t want AB hardware: ',AR_Hrd);
{$ENDC}

	   ABARPProtocolErr := ABARPProtocolErr + 1;
	   goto 777;
	   END;

       { Wants protocol translation of DOD's IP? }
       IF AR_Pro <> AR_DOD_IP THEN BEGIN
{$IFC DEBUG}
	   WriteLn('AB_ARP_Rcv: Doesn''t want IP translation: ',AR_Pro);
{$ENDC}
	   ABARPProtocolErr := ABARPProtocolErr + 1;
	   goto 777;
	   END;

       { Wants *my* IP address to be translated into an AB address? }
       IF AR_Tar_IP <> LocalIPaddr THEN BEGIN
{$IFC DEBUG}
	   Write('AB_ARP_Rcv: Not my IP address ');out_inaddr(AR_Tar_IP);WriteLn;
{$ENDC}
	   ABARPNotMe := ABARPNotMe + 1;
	   goto 777;
	   END;

       { Everything OK, so first update my tables with his information }
       Add_AB_Address(AR_Snd_IP,AR_Snd_AB);

       CASE AR_OP OF

	    ARP_Request: BEGIN

{$IFC DEBUG}
		Write('AB_ARP_Request: Got an ARP Request for me from ');
		out_inaddr(AR_Snd_IP); WriteLn('');
{$ENDC}
		ABARPReq := ABARPReq + 1;

		{ And answer the request }
		AB_ARP_Snd(ARP_Reply, AR_Snd_AB, AR_Snd_IP);
		END; { End of ARP_Request }

	    ARP_Reply: BEGIN
{$IFC DEBUG}
		Write('AB_ARP_Request: Got an ARP Reply for me from ');
		out_inaddr(AR_Snd_IP); WriteLn('');
{$ENDC}
		{ Someone waiting for the reply ? }
		IF arp_rcv <> NIL
		    THEN tk_wake(arp_rcv)
		    ELSE ABARPUnexpected := ABARPUnexpected + 1; { Why arrived? }

		arp_rcv := NIL; { Make sure he is not awakened more than once }
		END; { End of ARP_Reply }

	    OTHERWISE BEGIN
		ABARPBad := ABARPBad + 1;
{$IFC DEBUG}
		WriteLn('Bad opcode in ARP packet: ',AR_Op);
{$ENDC}
		END;

	END; { of CASE }
	END; { of WITH }
    END; { infinite loop }
END;

FUNCTION Get_AB_Address(IP_Address:in_name;VAR AB_Addr:AddrBlock): Boolean;
{ Look in the table for the appropriate ip address. If there, set AB_Addr
  to it and return true, otherwise return false }
VAR i: Integer;
BEGIN
    FOR i := 0 TO Last_IP2AB_Entry DO
	IF IP2AB_Table[i].IP = IP_Address THEN BEGIN
	    AB_Addr := IP2AB_Table[i].AB;
	    Get_AB_Address := true;
	    EXIT(Get_AB_Address);
	    END;
    Get_AB_Address := False;
END;

PROCEDURE ARP_dotimer(tk:Ref_Task);
BEGIN
     if (tk <> NIL) & (tk <> tk_cur) then tk_wake(tk);
END;

PROCEDURE IP2AB(IP: in_name; VAR AB:AddrBlock);
CONST
    ARP_TIME_OUT = 900;	 { 15 seconds = 900 ticks }
VAR
    ARPtimer: Ref_Timer;
    Dummy:BOOLEAN;
BEGIN

{$IFC DEBUG}
    Write('IP2AB: Looking up AB address for ');out_inaddr(IP);WriteLn('');
{$ENDC}

    { Look it up in the current table }
    IF Get_AB_Address(IP,AB) THEN EXIT(IP2AB);

{$IFC DEBUG}
    WriteLn('IP2AB: AB address not found so performing ARP');
{$ENDC}

    { Not there, so let's ARP for it }
    arp_rcv := tk_cur;
    AB_ARP_Snd(ARP_Request, Everyone_on_AB, IP);
    ARPtimer := tm_alloc;
    if ARPtimer = NIL then begin
{$IFC DEBUG}
	  WriteLn('IP2AB: Can''t allocate timer');
{$ENDC}
	  AB.ANet := 0;
	  AB.ASocket := 0;
	  AB.ANode := 0;
	  arp_rcv := NIL;
	  exit(IP2AB);
	  end;

    tm_tset(ARP_TIME_OUT,@arp_dotimer,POINTER(ORD4(arp_rcv)),ARPtimer);

    while true do begin
{$IFC DEBUG}
	  WriteLn('IP2AB: Blocking');
{$ENDC}
	  tk_block;
{$IFC DEBUG}
	  WriteLn('IP2AB: Awakened');
{$ENDC}
	  { Have we been awakened by a reception, or timed out? }
	  IF arp_rcv = NIL { got an ARP packet }
	    THEN BEGIN
		 Dummy := tm_clear(ARPtimer);
{$IFC DEBUG}
		 WriteLn('IP2AB: Got an ARP response');
{$ENDC}
		 IF Get_AB_Address(IP,AB) THEN BEGIN
			 Dummy := tm_free(ARPtimer);
			 EXIT(IP2AB)
			 END
		 ELSE BEGIN
		     { Nuts, got a different ARP answer, maybe ours is en route }
{$IFC DEBUG}
		     WriteLn('IP2AB: Received wrong ARP response');
{$ENDC}
		     tm_tset(ARP_TIME_OUT,@arp_dotimer,POINTER(ORD4(arp_rcv)),
			      ARPtimer);
		     arp_rcv := tk_cur;
		     END;
		 END { end of = NIL block }
	  ELSE BEGIN { Timed out. Oh well, we tried }
{$IFC DEBUG}
	       WriteLn('IP2AB: ARP timeout. Cannot translate address');
{$ENDC}
	       Dummy := tm_free(ARPtimer);
	       AB.ANet := 0;
	       AB.ASocket := 0;
	       AB.ANode := 0;
	       arp_rcv := NIL;
	       exit(IP2AB);
	       END;
	END; { end of WHILE loop }
END;

END.
!E!O!F!
#
#
echo extracting net/call_asm.text...
cat >net/call_asm.text <<'!E!O!F!'
;
;{ Please note the copyright notice in the file "copyright/notice" }
;
; The following little hack allows procedures to be called with any number
; of arguments so long as the procedure ptr is the last argument and so long
; as no static links are required to be maintained (Also works for functions!)
;


     .PROC CALL,4	      ; General interface for calling procedures
     .DEF  Call1
     .DEF  CallB
     .DEF  Call1B
     .DEF  Call1C
     .DEF  Call2
     .DEF  Call3
     .DEF  Call3A
     .DEF  Call3B
     .DEF  Call4
     .DEF  Call4A
CALLB
CALL1
CALL1A
CALL1B
CALL1C
CALL2
CALL3
CALL3A
CALL3B
CALL4
CALL4A
     MOVE.L    4(SP),A0	      ; Copy the procedure pointer
     MOVE.L    (SP)+,(SP)     ; Move the return address down
     JMP       (A0)	      ; Jump to the real routine

;
;    The following routine has the following signature:
;    FUNCTION StrCvt(S:STR255):StringPtr;
;
;    It is intended to take a string a return a pointer to that string.
;    Because Lisa Pascal will pass all strings over four characters in
;    length by passing a pointer to the string, and because the Lisa
;    Pascal conventions require the *caller* to make a copy of value
;    structures, one can pass the address of a string by just passing the
;    string.  This is a long way of saying that this routine just moves its
;    arguemnt down the stack
;
     .FUNC StrCvt,1	      ; Slimy way to pass String Constants by VAR
			      ; (Just leave the address on the stack!)
     MOVE.L    (SP)+,A0	      ; Get the return address
     MOVE.L    (SP)+,(SP)     ; Move the argument into the return value
     JMP       (A0)	      ; And return !
;
; The Lisa Pascal version of checksumming was wrong.  Here is an assembler
; version from Bill Croft at Stanford.
;
     .func     cksum	      ; (integer) sum = cksum(buf:Ptr, wdcnt:integer)
     move.l    (sp)+,a1
     clr.l     d1
     move.w    (sp)+,d1
     move.l    (sp)+,a0
     subq.l    #1,d1
     clr.l     d0
@1
     add.w     (a0)+,d0
     bcc.s     @2
     addq.l    #1,d0
@2
     dbra      d1,@1
     move.w    d0,(sp)
     jmp       (a1)
;
; Reboot routine scarfed from net.micro.mac
;
     .func     reboot
ROMStart .equ  $2AE
     move.l    ROMStart,A0
     add.w     #10,A0
     jmp       (A0)
;
     .END


!E!O!F!
#
#
echo extracting net/calls.text...
cat >net/calls.text <<'!E!O!F!'
{$X-}
{$M+}
{$R-}
{$0V-}
{$D-}
UNIT Call_Lib;

{ Please note the copyright notice in the file "copyright/notice" }

INTERFACE

{$L-}

USES {$U-}
      {$U Obj-Memtypes	  } Memtypes,
      {$U Obj-QuickDraw	  } QuickDraw,
      {$U Obj-OSIntf	  } OSIntf,
      {$U Obj-ToolIntf	  } ToolIntf;

{$L+}

PROCEDURE Call(Proc: ProcPtr);
FUNCTION  CallB(Proc:ProcPtr):Boolean;
PROCEDURE Call1(ArgPtr:PTR; Proc: ProcPtr);
PROCEDURE Call1B(Flag: Integer; Proc: ProcPtr);
PROCEDURE Call1C(c:char; Proc: ProcPtr);
PROCEDURE Call3(PacketPtr:PTR; PacketLength: Integer; SourceAdd: LongInt;
		Handler: ProcPtr);
FUNCTION  Call3A(host: LongInt; file_name: StringPtr;
		 TransferDirection: Integer; tfs_alert: ProcPtr): Integer;
PROCEDURE Call3B(what:PTR; arg2,arg3:Integer; Proc: ProcPtr);

FUNCTION  Call4(PacketPtr:PTR; Protocol:Integer; PacketLength:Integer;
		FirstHop: LongInt; SendProc: ProcPtr):Integer;
PROCEDURE Call4A(PacketPtr: PTR; PacketLength: Integer; HostAddr: LongInt;
	       FooData: PTR; Handler: ProcPtr);

IMPLEMENTATION

FUNCTION  CallB(Proc:ProcPtr):Boolean; EXTERNAL;
PROCEDURE Call1(ArgPtr:PTR; Proc: ProcPtr); EXTERNAL;
PROCEDURE Call1B(Flag: Integer; Proc: ProcPtr); EXTERNAL;
PROCEDURE Call1C(c:char; Proc: ProcPtr); EXTERNAL;
PROCEDURE Call(Proc: ProcPtr); EXTERNAL;
PROCEDURE Call3(PacketPtr:PTR; PacketLength: Integer; SourceAdd: LongInt;
		Handler: ProcPtr); EXTERNAL;
FUNCTION  Call3A(host: LongInt; file_name: StringPtr;
		 TransferDirection: Integer; tfs_alert: ProcPtr): Integer;
		 EXTERNAL;
PROCEDURE Call3B;EXTERNAL;
FUNCTION  Call4(PacketPtr:PTR; Protocol:Integer; PacketLength:Integer;
		FirstHop: LongInt; SendProc: ProcPtr):Integer; EXTERNAL;
PROCEDURE Call4A(PacketPtr: PTR; PacketLength: Integer; HostAddr: LongInt;
	       FooData: PTR; Handler: ProcPtr); EXTERNAL;
END.
!E!O!F!
#
#
echo extracting net/cust_lib.text...
cat >net/cust_lib.text <<'!E!O!F!'
{$X-}
{$M+}
{$R-}
{$0V-}
{$D-}
{$DECL DEBUG}
{$SETC DEBUG := false}
Unit Cust_Lib;

{ Please note the copyright notice in the file "copyright/notice" }

{$L-}

INTERFACE

   USES {$U-}
      {$U Obj-Memtypes	  } Memtypes,
      {$U Obj-QuickDraw	  } QuickDraw,
      {$U Obj-OSIntf	  } OSIntf,
      {$U Obj-ToolIntf	  } ToolIntf,
      {$U Obj-ABPasIntf	  } ABPasIntf;

TYPE
      CustRecord = RECORD
	    LocalIPAddr: LongInt;
	    GateWIPAddr: LongInt;
	    NameServer: LongInt;
	    TimeServer: LongInt;
	    UserName: STR255;
	    UseAB: Boolean;
	    DefHost:STR255
	    END;

       Ref_CustRecord = ^ CustRecord;

CONST
	CFileName = 'Customization Values';

PROCEDURE ReadCustom(CP: Ref_CustRecord);

IMPLEMENTATION

{$S InitSeg}

PROCEDURE ReadCustom(CP: Ref_CustRecord);
VAR OSStatus: OSErr;
    FRN: Integer;
    RLength: LongInt;
    NodeNumber,NetNumber:INTEGER;
BEGIN
  if GetNodeAddress(NodeNumber,NetNumber) <> noErr
	then NodeNumber := 0;
  CP^.LocalIPAddr:= $80020000 + NodeNumber;
  CP^.GateWIPAddr:= $80020040;
  CP^.NameServer := $80020040;
  CP^.TimeServer := $80020040;
  CP^.UserName := 'AppleMAC';
  CP^.DefHost := 'Unknown';
  CP^.UseAB := TRUE;

  { Try to read in old values }
  OSStatus := FSOpen(CFileName, {Current Vol} 0, FRN);
  IF OSStatus = noErr THEN BEGIN
     { File is there, read in the values }
     RLength := sizeof(CustRecord);
     { Get to the start of the file }
     OSStatus := SetFPos(FRN,fsFromStart,0);
     IF OSStatus = noErr
	 THEN OSStatus := FSRead(FRN,RLength,POINTER(ORD4(CP)));
     OSStatus := FSClose(FRN);
     IF CP^.UseAB then
	 begin
	 CP^.LocalIPAddr := BitAnd(CP^.LocalIPAddr,$FFFFFF00) + NodeNumber;
	 end;
     END;
END;

END.

!E!O!F!
#
#
echo extracting net/err_lib.text...
cat >net/err_lib.text <<'!E!O!F!'
{$X-}
{$M+}
{$R-}
{$0V-}
{$D-}
{$DECL DEBUG}
{$SETC DEBUG := false}
Unit Err_Lib;

{ Please note the copyright notice in the file "copyright/notice" }

INTERFACE

{$L-}

   USES {$U-}
      {$U Obj-Memtypes	  } Memtypes,
      {$U Obj-QuickDraw	  } QuickDraw,
      {$U Obj-OSIntf	  } OSIntf,
      {$U Obj-ToolIntf	  } ToolIntf;

CONST errId = 49;

VAR errWindow:WindowPtr;
    Msg:STR255;

PROCEDURE ErrInit;
PROCEDURE CantAlloc(where:StringPtr; what:StringPtr);
PROCEDURE CantConnect(where:StringPtr; what:StringPtr);
PROCEDURE NotResponding(where:StringPtr);
PROCEDURE FOpenErr(fileName:StringPtr; status:OSErr);
PROCEDURE FWriteErr(fileName:StringPtr; status:OSErr);
PROCEDURE FReadErr(fileName:StringPtr; status:OSErr);
PROCEDURE Error(what:StringPtr);
PROCEDURE Error2(what:StringPtr; arg:StringPtr);
PROCEDURE Error3(what:StringPtr; arg:StringPtr; final:StringPtr);
PROCEDURE ErrorOS(what:StringPtr;status:OSErr);
PROCEDURE Fatal(what:StringPtr; re_boot:Boolean);

PROCEDURE Message(from:StringPtr;what:StringPtr);
PROCEDURE MsgRegister(wp:DialogPtr);
FUNCTION ClickResolve(ev:EventRecord):Boolean;
FUNCTION ActResolve(ev:EventRecord):Boolean;

FUNCTION StrCvt(S:Str255): StringPtr;
PROCEDURE reboot;

IMPLEMENTATION

FUNCTION StrCvt(S:Str255): StringPtr; EXTERNAL;
PROCEDURE reboot; external;

TYPE MsgRecPtr = ^MsgRec;

     MsgRec = RECORD
     next:MsgRecPtr;
     qType:QTypes;
     win:WindowPtr;
     END;

     MsgQ = RECORD
     qFlags:INTEGER;
     qHead:MsgRecPtr;
     qTail:MsgRecPtr
     end;

VAR theMsgQ:MsgQ;

{$S InitSeg}

PROCEDURE ErrInit;
BEGIN
     errWindow := POINTER(ORD4(GetNewDialog(errId,NIL,NIL)));
     theMsgQ.qFlags := 0;
     theMsgQ.qHead := NIL;
     theMsgQ.qTail := NIL;
END;

{$S	    }

FUNCTION ZapIt(wp:WindowPtr):Boolean;
VAR Dummy:OSErr;
    qp:MsgRecPtr;
BEGIN
     qp := theMsgQ.qHead;
     while (qp <> NIL) & (qp^.win <> wp) do
	  begin
	  qp := qp^.next;
	  end;
     if qp <> NIL { found it } then
	  begin
	  Dummy := dequeue(POINTER(ORD4(qp)),@theMsgQ);
	  DisposDialog(wp);
	  DisposPtr(POINTER(ORD4(qp)));
	  ZapIt := true;
	  end
     else
	  begin
	  ZapIt := false;
	  end;
END;

FUNCTION ClickResolve(ev:EventRecord):Boolean;
VAR wp:WindowPtr;
    code:INTEGER;
BEGIN
     code := FindWindow(ev.where,wp);
     if wp = errWindow then
	  begin
	  HideWindow(errWindow);
	  ClickResolve := true;
	  end
     else
	  ClickResolve := ZapIt(wp);
end;

FUNCTION ActResolve(ev:EventRecord):Boolean;
VAR wp:WindowPtr;
    code:INTEGER;
    fake:INTEGER;
    iHndl:Handle;
    iRect:Rect;
begin
     wp := POINTER(ORD4(ev.message));
     if wp = errWindow then
	    ActResolve := true
     else if BitAND(ev.modifiers,1) = 1 then
	  ActResolve := true
     else
	  ActResolve := ZapIt(wp);
end;

PROCEDURE MsgRegister(wp:WindowPtr);
VAR qp:MsgRecPtr;
BEGIN
     qp := POINTER(ORD4(NewPtr(sizeof(MsgRec))));
     qp^.next := NIL;
     qp^.qType := dummyType;
     qp^.win := wp;
     enqueue(POINTER(ORD4(qp)),@theMsgQ);
END;

PROCEDURE DoErr;
BEGIN
     ShowWindow(errWindow);
     SelectWindow(errWindow);
END;

PROCEDURE Message(from:StringPtr;what:StringPtr);
VAR  iType:INTEGER;
     iHndl:Handle;
     iRect:Rect;
BEGIN
     GetDItem(errWindow,1,iType,iHndl,iRect);
     SetIText(iHndl,from^);
     GetDItem(errWindow,2,iType,iHndl,iRect);
     SetIText(iHndl,what^);
     DoErr;
END;

PROCEDURE Error(what:StringPtr);
VAR  iType:INTEGER;
     iHndl:Handle;
     iRect:Rect;
BEGIN
     GetDItem(errWindow,1,iType,iHndl,iRect);
     SetIText(iHndl,'A network error happened.');
     GetDItem(errWindow,2,iType,iHndl,iRect);
     SetIText(iHndl,what^);
     SysBeep(2);
     DoErr;
END;

PROCEDURE Error2(what:StringPtr; arg:StringPtr);
VAR  iType:INTEGER;
     iHndl:Handle;
     iRect:Rect;
BEGIN
     GetDItem(errWindow,1,iType,iHndl,iRect);
     SetIText(iHndl,'A network error happened.');
     GetDItem(errWindow,2,iType,iHndl,iRect);
     SetIText(iHndl,concat(what^,arg^));
     SysBeep(2);
     DoErr;
END;

PROCEDURE Error3(what:StringPtr; arg:StringPtr; final:StringPtr);
VAR  iType:INTEGER;
     iHndl:Handle;
     iRect:Rect;
BEGIN
     GetDItem(errWindow,1,iType,iHndl,iRect);
     SetIText(iHndl,'A network error happened.');
     GetDItem(errWindow,2,iType,iHndl,iRect);
     SetIText(iHndl,concat(what^,arg^,final^));
     SysBeep(2);
     DoErr;
END;

PROCEDURE ErrorOS(what:StringPtr;status:OSErr);
VAR errstr:STR255;
BEGIN
     case status of
     bdNamErr:	    errstr := 'The file name is invalid.';
     dupFNErr:	    errstr := 'The file already exists.';
     dirFulErr:	    errstr := 'The directory is full.';
     dskFulErr:	    errstr := 'The disk is full.';
     eofErr:	    errstr := 'End of file.';
     extFSErr:	    errstr := 'External file system error.';
     fBsyErr:	    errstr := 'The file is busy.';
     fLckdErr:	    errstr := 'The file is locked.';
     fnfErr:	    errstr := 'The file does not exist.';
     fsRnErr:	    errstr := 'Difficulty with renaming.';
     ioErr:	    errstr := 'Disk I/O error.';
     mFulErr:	    errstr := 'Memory is full.';
     nsvErr:	    errstr := 'There is no such volume.';
     opWrErr:	    errstr := 'The file is already open for writing.';
     posErr:	    errstr := 'The given file position is invalid.';
     tmfoErr:	    errstr := 'Too many files are open now.';
     vLckdErr:	    errstr := 'Software volume lock.';
     wrPermErr:	    errstr := 'Permission does not allow writing.';
     wPrErr:	    errstr := 'Hardware volume lock.';
{$IFC DEBUG}
     fnOpnErr:	    errstr := 'File not open!';
     paramErr:	    errstr := 'Parameter error!';
     rfNumErr:	    errstr := 'Bad reference number!';
{$ENDC}
     end;	    { of case }
     Error2(what,@errstr);
END;

PROCEDURE CantAlloc(where:StringPtr; what:StringPtr);
BEGIN
     Error3(where,StrCvt(': I can''t get a new '),what);
END;

PROCEDURE CantConnect(where:StringPtr; what:StringPtr);
BEGIN
     Error3(where,StrCvt(': I can''t open a connection, protocol '),what);
END;

PROCEDURE NotResponding(where:StringPtr);
BEGIN
     Error3(where,
	    StrCvt(': The foreign host is not responding.  '),
	    StrCvt('The operation will be aborted.'));
END;

PROCEDURE FOpenErr(fileName:StringPtr; status:OSErr);
BEGIN
     Msg := concat('I can''t open "',fileName^,'";  ');
     ErrorOS(@Msg,status);
END;

PROCEDURE FWriteErr(fileName:StringPtr; status:OSErr);
BEGIN
     Msg := concat('I can''t write to "',fileName^,'";  ');
     ErrorOS(@Msg,status);
END;

PROCEDURE FReadErr(fileName:StringPtr; status:OSErr);
BEGIN
     Msg := concat('I can''t read from "',fileName^,'";	 ');
     ErrorOS(@Msg,status);
END;

PROCEDURE Fatal(what:StringPtr; re_boot:Boolean);
CONST FatalAlert = 333;
VAR dummy:INTEGER;
BEGIN
     ParamText(what^,'','','');
     dummy := StopAlert(FatalAlert,NIL);
     if re_boot then reboot else halt;
END;

END.

!E!O!F!
#
#
echo extracting net/icmp_lib.text...
cat >net/icmp_lib.text <<'!E!O!F!'
{$X-}
{$M+}
{$R-}
{$0V-}
{$D-}
{$DECL DEBUG}
{$SETC DEBUG := false}
UNIT ICMP_Lib;

{ Please note the copyright notice in the file "copyright/notice" }

INTERFACE

{$L-}

   USES {$U-}
      {$U Obj-Memtypes	  } Memtypes,
      {$U Obj-QuickDraw	  } QuickDraw,
      {$U Obj-OSIntf	  } OSIntf,
      {$U Obj-ToolIntf	  } ToolIntf,
      {$U Obj-PackIntf	  } PackIntf,
      {$U Obj-ABPasIntf	  } ABPasIntf,
      {$U net-err_lib	  } Err_Lib,
      {$U net-Task_Lib	  } Task_Lib,
      {$U net-Timer_Lib	  } Timer_Lib,
      {$U net-calls	  } Call_Lib,
      {$U net-ip_lib	  } IP_Lib;

{$L+}

CONST

{ Define some ICMP messages }
	PGNOSND	        = 0     { Couldn't send pkt };
	PGTMO	        = 1     { timedout };
	PGBADDATA       = 2     { rcved bad data back };
	PGWAITING       = 3     { waiting for rcpt of packet };
	PGSUCCESS       = 4     { success };

PROCEDURE icmprcv(p: PACKET; len:Integer; host:IN_Name);
FUNCTION icmp_destun(host: in_name; ip: Ref_IP; Packet_type: Integer):Integer;
PROCEDURE IcmpInit;
PROCEDURE inroute(host: in_name; hop1: Ref_in_name);

PROCEDURE ggprcv(p:PACKET; len:Integer; host:in_name);
PROCEDURE GgpInit;

IMPLEMENTATION

TYPE
    Ref_Ping = ^ ping;

    ping = PACKED RECORD    { ICMP Echo request/reply header }
		ptype: byte;
		pcode: byte;
		pchksum: Integer;
		pid: Integer;
		pseq: Integer;
		END;

CONST
	ICMPPROT= 1	        { ICMP Protocol number };
	ECHOREP = 0	        { ICMP Echo reply };
	DESTIN  = 3	        { Destination Unreachable };
	SOURCEQ = 4	        { Source quench };
	REDIR   = 5	        { Redirect };
	ECHOREQ = 8	        { ICMP Echo request };
	TIMEX   = 11	        { Time exceeded };
	PARAM   = 12	        { Parameter problem };
	TIMEREQ = 13	        { Timestamp request };
	TIMEREP = 14;
	INFO    = 15	        { Information request };
	ICMPSIZE = sizeof(ping);
	ECHOTMO	 = 6	        { Echo reply timeout period. };

	REDIRTABLEN =   16;     { Size + 1 of redirection table }

TYPE
	Raw_Bytes = PACKED ARRAY[0..32767] OF BYTE;

	Raw_Ptr_Type = ^Raw_Bytes;

	{ redirect table definitions }

	redent = RECORD
	       rd_dest: in_name;
	       rd_to: in_name;
	       END;

{ structure of an icmp destination unreachable packet }

	 destun = PACKED RECORD
		dtype: byte;			        { + 0 }
		dcode: byte;			        { + 1 }
		dchksum: Integer;		        { + 2 }
		dno1: Integer;			        { + 4 }
		dno2: Integer;			        { + 6 }
		dip: ip; { The header for the packet }  { + 8 }
		ddata: packed array [0..7] of byte;
	END;

{ structure of a timestamp reply }

	 tstamp = PACKED RECORD
		ttype: byte;
		tcode: byte;
		txsum: Integer;
		tid: Integer;
		tseq: Integer;
		tstampvals: packed array [0..2] of LongInt;
	END;

{ structure of an icmp redirect }

	 redirect = PACKED RECORD
		rdtype: byte;
		rdcode: byte;
		rdchksum: Integer;
		rdgw: in_name;
		rdip: ip;
		rddata: packed array [0..7] of byte;
	END;

VAR
	redtab: array [0..REDIRTABLEN-1] of redent;
	rednext : integer; { See initialization in IcmpInit = 0 }

	icmp: IPCONN;
	pingstate: Integer;
	requested: Ref_Task;
	sent: PACKET;
	snt_len: Integer;
	pingseq: Integer;

{$S InitSeg }

PROCEDURE IcmpInit;
VAR
	i: Integer;
BEGIN
	{ Once only initialization that used to be part of var decl's }
	FOR i := 0 TO REDIRTABLEN-1 DO BEGIN
	    redtab[i].rd_dest := 0;
	    redtab[i].rd_to := 0;
	    END;
	rednext := 0;
	pingstate := PGWAITING;
	requested := NIL;
	pingseq := 1;

	sent := NIL;
	snt_len := 0;

	icmp := in_open(ICMPPROT, @icmprcv);

	if (icmp = NIL) then
		CantConnect(StrCvt('ICMP'),StrCvt('IP'))
{$IFC DEBUG}
	WriteLn('ICMP: Opened ip conn.');
{$ENDC}
END; { End of IcmpInit }

{$S	    }

PROCEDURE wake_req;
BEGIN
	if (requested<>NIL) THEN tk_wake(requested);
END;

{ ICMP packet handler }

{$SETC DODESTIN := true}
{$SETC DOTIMEREQ := true}

{$SETC DOECHO := false}
{$SETC DOSOURCEQ := false}
{$SETC DOPARAM := false}
{$SETC DOTIMEX := false}
{$SETC DOINFO := false}

PROCEDURE icmprcv(p: PACKET; len:Integer; host:IN_Name);
VAR
	pip: Ref_IP;
	e: Ref_Ping;
	rd: ^redirect;
	pdp: ^destun;
	osum, xsum: Integer;
	data1, data2: PTR;
	i: integer;
	Raw_Ptr: Raw_Ptr_Type;
	DataMisMatch: Boolean;

BEGIN

{$IFC DEBUG}
	WriteLn('ICMP: p[',len,'] from ');
	out_inaddr(host);
	WriteLn('');
{$ENDC}

	pip := in_head(p);
	e := Ref_Ping(ORD4(in_data(pip)));

	osum := e^.pchksum;
	e^.pchksum := 0;

	if Odd(len) THEN BEGIN
		Raw_Ptr := POINTER(ORD4(e));
		Raw_Ptr^[len] := 0;
		END;

	xsum := BitNOT(cksum(POINTER(ORD4(e)),BitSR(len+1,1)));
	if (xsum <> osum) THEN BEGIN
		e^.pchksum := osum;
{$IFC DEBUG}
		WriteLn('ICMP: Bad xsum ',osum,' should have been ',xsum);
		in_dump(p);
{$ENDC}
		in_free(p);
		exit(icmprcv);
		END;

	e^.pchksum := osum;

	CASE (e^.ptype) OF
{$IFC DOECHO}
	    ECHOREQ: BEGIN
{$IFC DEBUG}
		Write('ICMP: Sending Echo Reply to ');
		out_inaddr(host);
		WriteLn('.');
{$ENDC}
		e^.ptype := ECHOREP;
		e^.pchksum := 0;
		if Odd(len) THEN BEGIN
			Raw_Ptr := POINTER(ORD4(e));
			Raw_Ptr^[len] := 0;
			END;

		e^.pchksum := BitNOT(cksum(POINTER(ORD4(e)),
						BitSR(len+1,1)));
		pip^.ip_src := pip^.ip_dest;
		pip^.ip_dest := host;
		if (in_write(icmp, p, len, host) <= 0) THEN BEGIN
{$IFC DEBUG}
			WriteLn('ICMP: Echo reply failed.\n');
{$ENDC}
		END;
		in_free(p);
		END; { end of ECHOREQ }

	ECHOREP: BEGIN
{$IFC DEBUG}
		WriteLn('ICMP: rcvd echo reply.');
{$ENDC}
		if(e^.pseq <> (pingseq-1)) THEN BEGIN
{$IFC DEBUG}
		    WriteLn('ICMP_RCV: Bad echo reply seq #');
{$ENDC}
		    in_free(p);
		    exit(icmprcv);
		    END;

		data1 := POINTER(ORD4(in_data(in_head(p)))+ICMPSIZE);
		data2 := POINTER(ORD4(in_data(in_head(sent)))+ICMPSIZE);

		FOR i := 0 to snt_len - 1 DO BEGIN
			DataMisMatch := (Data1^ <> Data2^);
			Data1 := POINTER(ORD4(Data1)+1);
			Data2 := POINTER(ORD4(Data2)+1);
			{ if(*data1++ != *data2++) }
			IF DataMisMatch THEN BEGIN
{$IFC DEBUG}
				WriteLn('bad icmp data at byte ',i);
				WriteLn('ICMP: Bad data in echo rep sent:');
				in_dump(sent);
				WriteLn('rcvd:');
				in_dump(p);
{$ENDC}
				pingstate := PGBADDATA;
				wake_req;
				in_free(p);
				exit(icmprcv);
				END; { End of outer IF test }
			END; { End of FOR loop }

		pingstate := PGSUCCESS;
		wake_req;
		in_free(p);
{$IFC DEBUG}
		WriteLn('ICMP: rcvd ICMP Echo Reply.');
{$ENDC}
		END; { End of ECHOREP }

{$ENDC}

{$IFC DODESTIN}
	DESTIN: BEGIN
		pdp := {(struct destun *)} POINTER(ORD4(in_data(in_head(p))));
{$IFC DEBUG}
		Write('ICMP: rcvd destination unreachable of type ',
		      pdp^.dcode,' on host ');
		out_inaddr(pdp^.dip.ip_dest);
		WriteLn('.');
{$ENDC}
		{ New from Tim -- cause the next attempt to route to this site to
		  fail.	 This is done by putting in a null redirect table entry. }
		FOR i := 0 TO REDIRTABLEN - 1 DO
			if (redtab[i].rd_dest = pdp^.dip.ip_dest) THEN BEGIN
				redtab[i].rd_to := 0;
				in_free(p);
				exit(icmprcv);
				END;

		redtab[rednext].rd_dest := pdp^.dip.ip_dest;
		redtab[rednext].rd_to := 0;
		IF rednext = REDIRTABLEN - 1
			THEN rednext := 0
			ELSE rednext := rednext + 1;
		in_free(p);
		END; {End of DESTIN }
{$ENDC}

	 REDIR: BEGIN
{$IFC DEBUG}
		WriteLn('ICMP: rcvd redirect.');
{$ENDC}
		rd := { (struct redirect *)} POINTER(ORD4(e));
{$IFC DEBUG}
		Write('redirect for ');
		out_inaddr(rd^.rdip.ip_dest);
		Write(' to ');
		out_inaddr(rd^.rdgw);
		WriteLn('.');
{$ENDC}
		FOR i := 0 TO REDIRTABLEN - 1 DO
			if (redtab[i].rd_dest = rd^.rdip.ip_dest) THEN BEGIN
				redtab[i].rd_to := rd^.rdgw;
				in_free(p);
				exit(icmprcv);
				END;

		redtab[rednext].rd_dest := rd^.rdip.ip_dest;
		redtab[rednext].rd_to := rd^.rdgw;
		IF rednext = REDIRTABLEN - 1
			THEN rednext := 0
			ELSE rednext := rednext + 1;
		in_free(p);

		END; { End of REDIR }

{$IFC DOSOURCEQ}
	SOURCEQ: BEGIN
{$IFC DEBUG}
		WriteLn('ICMP: rcvd source quench; ignoring.');
{$ENDC}
		in_free(p);
		END; {End of SOURCEQ }
{$ENDC}

{$IFC DOTIMEX}
	 TIMEX: BEGIN
{$IFC DEBUG}
		Write('ICMP: rcvd time exceeded message.');
{$ENDC}
		in_free(p);
		END; { End of TIMEX }
{$ENDC}

{$IFC DOPARAM}
	 PARAM: BEGIN
{$IFC DEBUG}
		WriteLn('ICMP: rcvd parameter problem message.');
{$ENDC}
		in_free(p);
		END; {End of PARAM }
{$ENDC}

{$IFC DOTIMEREQ}
	 TIMEREQ: BEGIN
{$IFC DEBUG}
		WriteLn('ICMP: rcvd Timestamp Request; ignoring.');
{$ENDC}
		e^.ptype := TIMEREP;
		e^.pchksum := 0;
		e^.pchksum := BitNOT(cksum(POINTER(ORD4(e)),
					BitSR(sizeof(tstamp),1)));
		pip^.ip_src := pip^.ip_dest;
		pip^.ip_dest := host;
		if (in_write(icmp, p, sizeof(tstamp), host) <= 0) THEN
		    BEGIN
{$IFC DEBUG}
		    WriteLn('ICMP: Couldn''t send timestamp reply.');
{$ENDC}
		    END;
		in_free(p);
		END; {End of TIMEREQ }
{$ENDC}

{$IFC DOINFO}
	 INFO:  BEGIN
{$IFC DEBUG}
		WriteLn('ICMP: rcvd information request.');
{$ENDC}
		in_free(p);
		END; {End of INFO }
{$ENDC}

	OTHERWISE BEGIN
{$IFC DEBUG}
		WriteLn('ICMP: rcvd unhandled packet of type ',e^.ptype;
		in_dump(p);
{$ENDC}
		in_free(p);
		END; {of otherwise }

		END; { OF CASE }
END; { End of Icmprcv }

{ ICMP Echo Request - returns 1 if host replies, 0 if timeout or error }

PROCEDURE pingtmo(Dummy:Ptr);
BEGIN
	pingstate := PGTMO;
	if (requested<>NIL) THEN tk_wake(requested);
END;

FUNCTION IcEchoRequest(host: in_name; length: Integer): Integer;
VAR
	p: PACKET;
	e: Ref_Ping;
	data: PTR;
	tm: Ref_Timer;
	i: integer;
	DummyBoolean: Boolean;

BEGIN
	IcEchoRequest := 0;
	p := in_alloc(40, 0);
	if (p = NIL) THEN BEGIN
		CantAlloc(StrCvt('ICMP'),StrCvt('packet'));
		IcEchoRequest :=  PGNOSND;
		exit(IcEchoRequest);
		END;

	e := Ref_Ping(ORD4(in_data(in_head(p)) ));
	e^.ptype := ECHOREQ;
	e^.pcode := 0;
	e^.pid :=   0;
	e^.pseq := pingseq;
	pingseq := pingseq + 1;

	{ Put 256 random numbers in the packet. }
	data := POINTER(ORD4(in_data(in_head(p))) + ICMPSIZE);
	FOR i := 0 TO Length - 1 DO BEGIN
	    Data^ := Random;
	    Data := POINTER(ORD4(Data) + 1);
	    END;

	{ Calculate the checksum }
	e^.pchksum:= 0;
	if Odd(ICMPSIZE+length) THEN Data^ := 0;

	e^.pchksum := BitNOT(cksum(POINTER(ORD4(e)),
					BitSR(ICMPSIZE+length+1,1) ));

	pingstate := PGWAITING;
	requested := tk_cur;
	sent := p;
	snt_len := length;
	tm := tm_alloc;
	if (tm = NIL) THEN BEGIN
		CantAlloc(StrCvt('ICMP'),StrCvt('timer'));
		IcEchoRequest :=  PGNOSND;
		exit(IcEchoRequest);
		END;

	tm_set(ECHOTMO, @pingtmo, NIL, tm);

	if (in_write(icmp, p, ICMPSIZE+length, host) <= 0) THEN BEGIN
{$IFC DEBUG}
		WriteLn('ICMP: Couldn''t send echo request.');
{$ENDC}
		DummyBoolean := tm_clear(tm);
		DummyBoolean := tm_free(tm);
		in_free(p);
		IcEchoRequest := PGNOSND;
		exit(IcEchoRequest);
		END;
{$IFC DEBUG}

	in_dump(p);
{$ENDC}

	while (pingstate = PGWAITING) DO tk_block;
	DummyBoolean := tm_clear(tm);
	DummyBoolean := tm_free(tm);
	in_free(p);
	sent := NIL;
	requested := NIL { Where did this variable come from ? };
	IcEchoRequest := pingstate;
END; { End of IcEchoRequest }

FUNCTION icmp_destun(host: in_name; ip: Ref_IP; Packet_type: Integer):Integer;
VAR
	p: PACKET;
	d: ^destun;
	i:integer;
	Raw_Ptr1, Raw_Ptr2: Raw_Ptr_Type;

BEGIN
	icmp_destun := 0;
{$IFC DEBUG}
		Write('ICMP: sending ');
		CASE Packet_Type OF
			0: Write('net');
			1: Write('host');
			2: Write('protocol');
			3: Write('port');
			4: Write('fragmentation needed');
			5: Write('source route failed');
			OTHERWISE Write('unknown packet type');
		END; { of case }
		Write(' dest unreachable to ');
		out_inaddr(host);
		WriteLn('');
{$ENDC}

	p := in_alloc(512, 0);
	if (p = NIL) THEN BEGIN
		CantAlloc(StrCvt('ICMP_DESTUN'),StrCvt('packet'));
		icmp_destun := 0;
		exit(icmp_destun);
		END;

	d := { (struct destun *)} POINTER(ORD4(in_data(in_head(p))));

	d^.dtype := DESTIN;
	d^.dcode := Packet_type;
	FOR i := 0 TO (sizeof(ip)+8)-1 DO BEGIN
		Raw_Ptr1 := POINTER(ORD4(ip));
		Raw_Ptr2 := POINTER(ORD4(@D^) + 8); { Note: Magic 8 in DIP dcl}
		Raw_Ptr2^[i] := Raw_Ptr1^[i];
		END;

	d^.dchksum := 0;
	d^.dchksum := BitNOT(cksum(POINTER(ORD4(d)),
					BitSR(sizeof(destun),1)));

	i := in_write(icmp, p, sizeof(destun), host);
	if (i <= 0) THEN BEGIN
{$IFC DEBUG}
		WriteLn('ICMP: Couldn''t send dest unreachable');
		WriteLn('ICMP: in_write returns ',i);
{$ENDC}
		END;

	in_free(p);
END; { End of icmp_destun }

{ Route a packet.
	Takes an internet address as its argument and a pointer to an
	internet address. Fills in this address with the internet address
	of the machine on our net which this packet should be sent to.

	Two routing algorithms are implemented: the MIT subnet routing
	algorithm, and a net-routing algorithm. The former places
	this interpretation on internet addresses: net,subnet,rsvd,host.
	It says: if the net and subnet of the destination of this packet
	and of my address are the same, the destination is on my network
	and I can send it directly to him. Otherwise, use the default
	gateway. The latter only checks on the net number.

	ICMP manages a routing table based on redirects which this
	code uses.
}

{$SETC CMU := false}

FUNCTION samenet(hi1: in_name; hi2:in_name): Boolean;
{ define some masks for testing addresses }
CONST
	 AMASK	 = $80;
	 AADDR	 = $00;
	 BMASK	 = $C0;
	 BADDR	 = $80;
	 CMASK	 = $E0;
	 CADDR	 = $C0;
VAR
	h1,h2: _ipname;
BEGIN

	h1.in_lname := hi1;
	h2.in_lname := hi2;

{$IFC CMU}
	samenet := ((h1.in_lst.in_net = h2.in_lst.in_net) AND
				  (h1.in_lst.in_nets = h2.in_lst.in_nets));
	exit(samenet);
{$ELSEC}
	if (BitAND(h1.in_lst.in_net,AMASK) = AADDR) THEN BEGIN
		{ We have a class A network }
		{ IF custom.c_route <> 0 THEN
		    samenet := (h1.in_lst.in_net = h2.in_lst.in_net)
		ELSE } samenet := ((h1.in_lst.in_net = h2.in_lst.in_net) AND
				  (h1.in_lst.in_nets = h2.in_lst.in_nets));
		exit(samenet);
		END;

	if (BitAND(h1.in_lst.in_net,BMASK) = BADDR) THEN BEGIN
		{ We have a class B network }
		{ IF custom.c_route <> 0 THEN
			samenet := (h1.in_lst.in_net=h2.in_lst.in_net) AND
				  (h1.in_lst.in_nets = h2.in_lst.in_nets)
		ELSE } samenet := (
				  (h1.in_lst.in_net = h2.in_lst.in_net) AND
				  (h1.in_lst.in_nets = h2.in_lst.in_nets) AND
				  (h1.in_lst.in_netss = h2.in_lst.in_netss));
		exit(samenet);
		END;

	if(BitAND(h1.in_lst.in_net,CMASK) = CADDR) THEN BEGIN
		{ Got a class C network }
		samenet := ( (h1.in_lst.in_net = h2.in_lst.in_net) AND
		       (h1.in_lst.in_nets = h2.in_lst.in_nets) AND
		       (h1.in_lst.in_netss = h2.in_lst.in_netss));
		exit(samenet);
		END;
{$ENDC}

{$IFC DEBUG}
	Write('bad address - ');
	out_inaddr(hi1);
	WriteLn('');
{$ENDC}
	samenet := false;
END; { End of samenet }

PROCEDURE inroute(host: in_name; hop1: Ref_in_name);
VAR i: integer;
BEGIN
{$IFC DEBUG}
	Write('Making a routing through the network for host ');
	out_inaddr(host); WriteLn('');
{$ENDC}

	{ first check through the redirect table for this host }
	FOR i := 0 TO REDIRTABLEN - 1 DO
	    IF redtab[i].rd_dest = 0 THEN cycle
	    ELSE if (redtab[i].rd_dest = host) THEN BEGIN
			hop1^ := redtab[i].rd_to;
			{ destination unreachable messages cause a null entry
			  to be inserted.  This makes IP think it can't write
			  to that host.	 However, these null entries are only
			  good until the next attempt to connect.  Eventually,
			  they should have a time value and a limited lifespan.
			  -- Tim }
			if redtab[i].rd_to = 0 then redtab[i].rd_dest := 0;
			exit(inroute);
			END;

	{ Check if it is on my net }
	if (samenet(LocalIPAddr, host)) THEN BEGIN
		hop1^ := host;
		exit(inroute);
		END;

	{ The host isn't on a net I'm on, so send it to the default gateway
		on IP }

	hop1^ := GWIPAddress;
END; { end of inroute}

{ A tiny GGP which will respond to ggp echo requests.

  (c) 1983 Massachussetts Institute of Technology
}

CONST
	GGP_Prot      = 3;

VAR
	ggp: IPCONN;

{$S InitSeg }

PROCEDURE GgpInit;
BEGIN

	ggp := in_open(GGP_Prot, @ggprcv);
	if ggp = NIL
	    THEN CantConnect(StrCvt('GGP'),StrCvt('InterNet'))
{$IFC DEBUG}
	else if	 BCBitAnd(NDEBUG,INFOMSG) THEN
		WriteLn('GGP: Opened InterNet connection.');
{$ENDC}
END;

{$S	    }

TYPE  ggping = PACKED RECORD
	 gtype: byte;
	 gcode: byte;
	 gseq: integer;
	END;

{ GGP packet handler }

PROCEDURE ggprcv(p:PACKET; len:Integer; host:in_name);
VAR
	pip: Ref_IP;
	e: ^ggping;

BEGIN

{$IFC DEBUG}
	if  BCBitAnd(NDEBUG,INFOMSG) THEN BEGIN
		Write('GGP: Received packet from host ');
		out_inaddr(host);
		WriteLn('.');
		END;
{$ENDC}

	pip := in_head(p);
	e := { (struct ggping *)} POINTER(ORD4(in_data(pip)));

	if (e^.gtype = ECHOREQ) THEN BEGIN
		e^.gtype := ECHOREP;
		if (in_write(ggp, p, len, host) <= 0) THEN BEGIN
{$IFC DEBUG}
			if BCBitAnd(NDEBUG,BitOR(INFOMSG,PROTERR)) THEN
				WriteLn('GGP: Echo reply failed.');
{$ENDC}
			END
{$IFC DEBUG}
		else if BCBitAnd(NDEBUG,INFOMSG) THEN
			WriteLn('GGP: Sent echo reply.');
{$ENDC}
		END

{$IFC DEBUG}
	else if BCBitAnd(NDEBUG,BitOR(PROTERR,INFOMSG)) THEN BEGIN
	  WriteLn('GGP: Received unhandled packet type',e^.gtype);
	  END
{$ENDC}
	;
	in_free(p);
END; { End of ggprcv }

END.
!E!O!F!
exit
-=-
Tim Maroney, Professional Heretic, CMU Center for Art and Technology
tim@k.cs.cmu.edu       | uucp: {seismo,decwrl,ucbvax,etc.}!k.cs.cmu.edu!tim
CompuServe: 74176,1360 | God is not dead; he just smells funny.