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 (6 of 12)
Message-ID: <666@k.cs.cmu.edu>
Date: Tue, 26-Nov-85 05:35:15 EST
Article-I.D.: k.666
Posted: Tue Nov 26 05:35:15 1985
Date-Received: Fri, 29-Nov-85 21:20:34 EST
Organization: Carnegie-Mellon University, Networking
Lines: 1848

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

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

{ This file contains the declarations for the timer management package. }

INTERFACE

{$L-}

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

{$L+}

CONST   TPS	 = 60;		        { Clock ticks per second }
	TIMERHIWATER    = 30;	        { number of free timers to keep }

TYPE

	Ref_timer = ^ timer;

	{ This is an extended version of the Mac vertical retrace queue format }
	timer = PACKED RECORD	        { a timer }
		tm_qLink:Ref_timer;     { next element in vertical retrace queue }
		tm_qType:INTEGER;       { will be ORD(vType) }
		tm_vblAddr:ProcPtr;     { points to tm_PSHARG, below }
		tm_vblCount:INTEGER;    { timer frequency }
		tm_vblPhase:INTEGER;    { timer phase }
		tm_tmLink:Ref_timer;    { secondary link, for appl. timers only }
		{ The following is 68000 machine code }
		tm_PSHA5:INTEGER;       { MOVE.L A5,-(SP) }
		tm_LEAA0:INTEGER;       { LEA [word immediate],A0 }
		tm_CURA5:INTEGER;       { system global CurrentA5 (word addr) }
		tm_GETA5:INTEGER;       { MOVE.L (A0),A5 }
		tm_PSHARG:INTEGER;      { MOVE.L [long immediate],-(SP) }
		tm_arg:Ptr;	        { argument to pass to subroutine }
		tm_JSR:INTEGER;	        { JSR [long immediate] }
		tm_subr: ProcPtr;       { timer subroutine to call }
		tm_POPA5:INTEGER;       { MOVE.L (SP)+,A5 }
		tm_RTS:INTEGER	        { RTS }
		END;

	time_q = packed record	        { the queue of free timers }
		qFlags: Integer;
		qHead: Ref_timer;
		qTail: Ref_timer
		end;

{ This file contains the routines which make up the routines for setting
 * and clearing timers.
 * The following routines are included in this package:
 *      tm_set	        set a timer to fire after number of seconds
 *      tm_mset	        set a timer, argument in milliseconds
 *      tm_tset	        set a timer, argument in clock ticks
 *      tm_reset        reset a timer to go off at a different time
 *      tm_clear        clear a previously set timer
 *      tm_main	        the main routine of the timer task
 *      tm_init	        init the timer system
 }
{  Addition of tm_tset and tm_mset, 12/83. <J.H. Saltzer>  }

VAR     TIMERDEBUG: Boolean;

PROCEDURE tm_set(nsecs:LongInt; subr:PROCPTR; arg:PTR; tm: Ref_Timer);
PROCEDURE tm_mset(msecs:LongInt; subr:PROCPTR; arg:PTR; tm:Ref_Timer);
PROCEDURE tm_tset (nticks:LongInt; subr:PROCPTR; arg:PTR; tm:Ref_Timer);
FUNCTION tm_reset (nsecs: LongInt; tm: Ref_Timer): Boolean;
FUNCTION tm_clear(tm: Ref_Timer): Boolean;
PROCEDURE tm_init;
FUNCTION tm_alloc:Ref_Timer;
FUNCTION tm_free(t: Ref_Timer): Boolean;
PROCEDURE tm_allFree;

IMPLEMENTATION

CONST
	RTS = $4E75;		        { instruction format of 68000 RTS }
	PSHARG = $2F3C;		        { MOVE.L [next longword],-(SP) }
	JSR = $4EB9;		        { JSR [next longword] }
	PSHA5 = $2F0D;		        { MOVE.L A%,-(SP) }
	LEAA0 = $41F8;		        { LEA [next word],A0 }
	CURA5 = $0904;		        { location of system global CurrentA5 }
	POPA5 = $2A5F;		        { MOVE.L (SP)+,A5 }
	GETA5 = $2A50;		        { MOVE.L (A0),A5 }

{ Internal variables }

VAR
	freetmq: time_q;	        { queue of free timers }
	allTimers:Ref_timer;	        { list of timers allocated }

{ Initialize the timer package. }

{$S InitSeg }

PROCEDURE tm_init;
BEGIN
	TIMERDEBUG := false;
	freetmq.qFlags := 0;	        { queue of free timers }
	freetmq.qHead := NIL;
	freetmq.qTail := NIL;
	allTimers := NIL;
END; { tm_init }

{$S	   }

{ Set a timer to go off after nticks clock ticks.  When the timer goes
 * off, call the specified subroutine with the specified argument.
 * This routine runs in the context of the caller's task;
 * it just enqueues the timer.
 }

PROCEDURE tm_tset(nticks:LongInt;       { timer expiration time }
		  subr:PROCPTR;	        { subroutine to call on expiration }
		  arg:PTR;	        { arg to pass to subr. }
		  tm:Ref_Timer);        { place to return timer id }
VAR     Dummy: OSErr;
BEGIN

{$IFC DEBUG}
	IF TIMERDEBUG THEN BEGIN
		WriteLn('TM_SET: setting timer ',ORD4(tm),
			' for ',nticks,' ticks.');
		END;
{$ENDC}

	{  make sure not already queued. }

	Dummy := VRemove(POINTER(ORD4(tm)));
	tm^.tm_qLink := NIL;		        { no next element }
	tm^.tm_vblCount := nticks;	        { timer frequency }
	tm^.tm_vblPhase := 0;		        { timer phase }
	tm^.tm_vblAddr := POINTER(ORD4(tm)+18); { addr of procedure }
	tm^.tm_PSHA5 := PSHA5;
	tm^.tm_LEAA0 := LEAA0;
	tm^.tm_CURA5 := CURA5;
	tm^.tm_GETA5 := GETA5;
	tm^.tm_PSHARG := PSHARG;
	tm^.tm_arg := arg;		        { argument to pass }
	tm^.tm_JSR := JSR;
	tm^.tm_subr := subr;		        { subroutine to call }
	tm^.tm_POPA5 := POPA5;
	tm^.tm_RTS := RTS;

	Dummy := VInstall(POINTER(ORD4(tm)));
END;    {  end of tm_tset()  }


{ Reset a (running) timer to go off in nsecs seconds
 * instead of at the time it is currently set for.  If in fact the
 * timer is not already set, return FALSE; otherwise return TRUE.
 * Does not modify the upcall in the timer.
 }

FUNCTION tm_reset(nsecs: LongInt; tm: Ref_Timer): Boolean;
VAR     expired: Boolean;
BEGIN
	expired := (tm^.tm_vblCount = 0);
	{ if NOT expired THEN
		expired := (VRemove(POINTER(ORD4(tm))) <> noErr); }
	if expired THEN BEGIN
{$IFC DEBUG}
		IF TIMERDEBUG THEN
			WriteLn('TIMER_RESET: timer already expired.');
{$ENDC}
		tm_reset := False;
		exit(tm_reset);	   { timer expired, give up }
		END;

{$IFC DEBUG}
	IF TIMERDEBUG THEN BEGIN
		WriteLn('TIMER_RESET: timer reset for ',nsecs,' seconds.');
		END;
{$ENDC}

	tm^.tm_qLink := NIL;		        { no next element }
	tm^.tm_vblCount := nsecs*TPS;	        { timer expiration time }
	tm_reset := (VInstall(POINTER(ORD4(tm))) = noErr);
END;    {  end of tm_reset()  }

{ set timer in seconds  }

PROCEDURE tm_set(nsecs:LongInt; subr:PROCPTR; arg:PTR; tm: Ref_Timer);
BEGIN
	tm_tset(nsecs*TPS, subr, arg, tm);
END; { end of tm_set }

{ set timer in milliseconds  }

PROCEDURE tm_mset(msecs:LongInt; subr:PROCPTR; arg:PTR; tm:Ref_Timer);
BEGIN
	tm_tset (((msecs*TPS) DIV 1000), subr, arg, tm) ;
END; { end of tm_mset }

{ Clear the timer specified by the passed timer identifier.  The timer
 * identifier gives a pointer to the timer to be cleared.
 * Free the timer's storage
 * (into the free list up to TIMERHIWATER elements).
 * Returns FALSE if the specified timer was not found in the queue,
 * TRUE otherwise.
 }

FUNCTION tm_clear(tm: Ref_Timer): Boolean;
BEGIN
	IF (tm^.tm_vblCount = 0) THEN BEGIN
{$IFC DEBUG}
		IF TIMERDEBUG THEN BEGIN
			WriteLn('TIMERCLEAR: timer ',ORD4(tm),' already expired.');
			END;
{$ENDC}
		tm_clear := FALSE;
		exit(tm_clear);
		END;

{$IFC DEBUG}
	IF TIMERDEBUG THEN BEGIN
		WriteLn('TIMERCLEAR: clearing timer ',ORD4(tm));
		END;
{$ENDC}

	{ tm^.tm_vblCount := 0; }
	if VRemove(POINTER(ORD4(tm))) <> noErr THEN tm_clear := FALSE
	else tm_clear := TRUE;
END;    {  end of tm_clear();  }

{ Allocate a timer and return a pointer to it }

FUNCTION tm_alloc:Ref_Timer;
VAR     t: Ref_timer;
	sz:Size;
	Dummy:OSErr;
BEGIN
	t := POINTER(ORD4(freetmq.qHead));
	if t <> NIL then
		Dummy := dequeue(POINTER(ORD4(t)),@freetmq)
	else
		BEGIN
		sz := sizeof(timer);
		t :=  {(timer *)} POINTER(ORD4(NewPtr(sz)));
		if t = NIL THEN BEGIN
			tm_alloc := NIL;
			exit(tm_alloc);
			END;
		END;

	t^.tm_qLink := NIL;
	t^.tm_qType := ORD(vType);
	t^.tm_vblCount := 0;
	t^.tm_tmLink := allTimers;
	allTimers := t;
	tm_alloc := t;
END;

{ Free up a timer. Returns true if successful, false otherwise }

FUNCTION tm_free(t: Ref_Timer): Boolean;
VAR
	tmp:Ref_timer;
	l:Integer;
	Dummy:OSErr;
	flag:Boolean;
BEGIN
	{ Check if the timer is enqueued }

	if VRemove(POINTER(ORD4(t))) = noErr THEN
		begin
{$IFC DEBUG}
		WriteLn('Tried to free active timer.');
{$ENDC}
		Dummy := VInstall(POINTER(ORD4(t)));
		tm_free := false;
		exit(tm_free);
		end;

	{ Have to remove it from allTimers }
	if allTimers = t then
		allTimers := t^.tm_tmLink
	else
		begin
		tmp := allTimers;
		flag := true;
		while flag and (tmp^.tm_tmLink <> NIL) do
			begin
			if tmp^.tm_tmLink = t then
				begin
				tmp^.tm_tmLink := t^.tm_tmLink;
				flag := false;
				end
			else
				tmp := tmp^.tm_tmLink;
			end;
		end;

	l := 0;
	tmp := freetmq.qHead;
	while tmp <> NIL do
		begin
		l := l+1;
		tmp := tmp^.tm_qLink;
		end;

	if l < TIMERHIWATER THEN enqueue(POINTER(ORD4(t)),@freetmq)
	else DisposPtr(POINTER(ORD4(t)));

	tm_free := TRUE;
END; { tm_free }

{ Free all timers from the vertical retrace queue -- done at application death }

PROCEDURE tm_allFree;
VAR
	Dummy:OSErr;
	tm:Ref_timer;
BEGIN
	tm := allTimers;
	while tm <> NIL do
		begin
		Dummy := VRemove(POINTER(ORD4(tm)));{ doesn't matter if it's there or not }
		tm := tm^.tm_tmLink;
		end;
	allTimers := NIL;
END;

END. { End of Timer Library }

!E!O!F!
#
#
echo extracting net/tn_lib.text...
cat >net/tn_lib.text <<'!E!O!F!'
{$X-}
{$M+}
{$R-}
{$0V-}
{$D-}
{$DECL DEBUG}
{$SETC DEBUG := false}
{$DECL LISTEN}
{$SETC LISTEN := true}
UNIT TN_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-ABPasIntf	  } ABPasIntf,
      {$U net-err_lib	  } Err_Lib,
      {$U net-Task_Lib	  } Task_Lib,
      {$U net-Timer_Lib	  } Timer_Lib,
      {$U net-ip_lib	  } IP_Lib,
      {$U net-tcp_lib	  } TCP_Lib,
      {$U net-udp_lib	  } UDP_Lib,
      {$U net-name_user	  } Name_User,
      {$U net-tftp_defs	  } TFTP_Defs,
      {$U net-tftp_lib	  } TFTP_Lib,
      {$U net-calls	  } Call_Lib,
      {$U net-name_host	  } NameHost,
      {$U net-term_lib	  } Term_Lib;
{$L+}

{ Definitions for telnet }

CONST   TNTKSZ = 3072;

TYPE
ucb = record
	u_state:Integer;        { XESTAB or XCLOSING }
	u_tcpfull:Boolean;      { is tcp's output buffer full? }
	u_tftp:Boolean;	        { is tftp running passively? }
	u_rstate:char;	        { Read terminal state }
				{ NORMALMODE }
				{ BLOCK - don't read terminal }
	u_rspecial:char;        { Read terminal character handling }
				{ NORMALMODE }
				{ TCPFULL - tcp output buffer full }
	u_wstate:char;	        { Write terminal state }
				{ NORMALMODE }
				{ URGENTM - urgent mode }
				{ ignore nonspecial chars }
	u_wspecial:char;        { Write terminal character handling }
				{ NORMALMODE }
				{ RETURN (13), IAC, WILL, WONT, DO, DONT -
				   processing special chars }
	u_sendm:char;	        { Send mode }
				{ EVERYC - send to net on every char }
				{ NEWLINE - send to net on newline }
	u_echom:char;	        { Echo mode }
				{ LOCAL - local echo }
				{ REMOTE - remote echo }
	u_echongo:char;	        { Echo negotiation request outstanding }
				{ NORMALMODE }
				{ LECHOREQ - IAC DONT ECHO was sent }
				{ RECHOREQ - IAC DO ECHO was sent }
	u_echoback:Boolean;     { whether to echo all received chars back
				  to the user }
	u_tcconn:Ref_tcconn;    { the TCP connection associated with the TELNET }
	u_tnshost:STR255;       { name of remote host }
end;

ucbptr = ^ucb;

PROCEDURE TelnetMenuCmd(item:Integer; theMenu:MenuHandle);
PROCEDURE TNFixMenu(theMenu:MenuHandle);
PROCEDURE tel_init;
PROCEDURE gt_usr(c:char);
PROCEDURE showstats;
FUNCTION tn_conn(var s:STR255; fsock:Integer):ucbptr;
FUNCTION tntftp(fhost:in_name; var filename:STR255; dir:unsigned):Integer;
PROCEDURE tntfdn(success:Integer);
PROCEDURE SendMenuCmd(item:Integer; theMenu:MenuHandle);
PROCEDURE FixSendMenu(theMenu:menuHandle);

VAR     tn_done:Boolean;
	tn_tftp:Boolean;        { whether or not to do the TFTP server }

IMPLEMENTATION

VAR TheName:STR255;
    TheFSock:Integer;
    ucb_extern:ucb;
    MyDialog:DialogPtr;
    ServerRunning: Boolean;
    nm_task:Ref_task;
    pucb:ucbptr;

CONST
 tntfId = 11;

 NORMALMODE = chr(0);
{
 SPECIAL = chr(1);
 TEST = chr(2);
 CONFIRM = chr(3);
}
 HOLD = chr(4);

 BLOCK = chr(1);
 NOBLOCK = chr(2);
 URGENTM = chr(1);
 EVERYC = chr(1);
 NEWLINE = chr(2);
 LOCAL = chr(1);
 REMOTE = chr(2);
 LECHOREQ = chr(1);
 RECHOREQ = chr(2);

 NOP = chr(241);
 IAC = chr(255);
 WILL = chr(251);
 WONT = chr(252);
 DOIT = chr(253);
 DONT = chr(254);
 DM = chr(242);
 INTP = chr(244);
 AO = chr(245);
 AYT = chr(246);
 GA = chr(249);
 OPTECHO = chr(1);
 OPTSPGA = chr(3);
 OPTTMARK = chr(6);

 RETURN = chr($d);
 LINEFEED = chr($a);

 XESTAB = 1;
 XCLOSING = 2;
 XCLOSED  = 3;

 TELNETSOCK = 23;  { Telnet well known socket no. }
 C_L = chr($c);	   { Control-L }

PROCEDURE echolocal(pucb:ucbptr); forward;
PROCEDURE echoremote(pucb:ucbptr); forward;
PROCEDURE ttechoremote(pucb:ucbptr); forward;
PROCEDURE ttecholocal(pucb:ucbptr); forward;
PROCEDURE tcpfull; forward;

FUNCTION tn_alloc:ucbptr;
BEGIN
	pucb := @ucb_extern;
	pucb^.u_state := XESTAB;
	pucb^.u_tcpfull := false;
	pucb^.u_tftp := false;
	pucb^.u_rstate := NORMALMODE;
	pucb^.u_rspecial := NORMALMODE;
	pucb^.u_wstate := NORMALMODE;
	pucb^.u_wspecial := NORMALMODE;
	pucb^.u_echoback := false;
	pucb^.u_echom := LOCAL;
	pucb^.u_echongo := NORMALMODE;
	pucb^.u_tcconn := NIL;
	pucb^.u_tnshost := 'Unknown';
	pucb^.u_sendm := EVERYC;
	tn_alloc := pucb;
END;

{$S InitSeg}

PROCEDURE tel_init;
begin
	pucb := NIL;
	ServerRunning := false;
	nm_task := NIL;
	em_init;
end;

{$S	    }

PROCEDURE tn_free;
begin
	if tn_tftp AND pucb^.u_tftp then
		begin
		{ File transfer service turned off. }
		tfs_off;
		pucb^.u_tftp := FALSE;
		end;
	{ Don't really throw away connection storage }
	pucb := NIL;
end;

{ Return true if telnet must run; false otherwise. }

FUNCTION mst_run:Boolean;
begin
	mst_run := TRUE;
end;

PROCEDURE bfr;
begin
	ucb_extern.u_tcpfull := false;
end;

{ gt_usr  Process a char from user's terminal }

PROCEDURE gt_usr(c:char);
VAR
	i:Integer;
	ich:Integer;
	dummy:Boolean;
begin
	if pucb = NIL then exit(gt_usr);

	if (pucb^.u_rspecial <> HOLD)
	   AND (pucb^.u_tcconn^.conn_state = ESTAB) then
		begin
		case (pucb^.u_rspecial) of
		NORMALMODE:
			begin
			if(pucb^.u_tcpfull) then
				begin
				tcpfull;
				exit(gt_usr);
				end;

			if(pucb^.u_echom = LOCAL) then
				begin
				em(c);
				if c = RETURN then em(LINEFEED);
				end;

			if c = RETURN then
				c := LINEFEED
			else if c = LINEFEED then
				dummy := tc_put(pucb^.u_tcconn,RETURN)
			else if c = IAC then
				dummy := tc_put(pucb^.u_tcconn,IAC);

			if(pucb^.u_sendm = EVERYC) then
				begin
				if tc_fput(pucb^.u_tcconn,c) then tcpfull;
				end
			else begin
				if tc_put(pucb^.u_tcconn,c) then
					begin
					tcpfull;
					exit(gt_usr);
					end;
				if (c = LINEFEED) then
					tcp_ex(pucb^.u_tcconn);
				end;
			end;

{$IFC DEBUG}
		otherwise
			begin
			WriteLn('Telnet BUG ',ord(pucb^.u_rspecial):1);
			pucb^.u_rspecial := NORMALMODE;
			end;
{$ENDC}
		end;
	end; { of if }
end; { of gt_usr }

{ wr_usr  manage chars coming from net and going to user
 Process received telnet special chars and option negotiation.
 When wstate is URGENTM, only process special chars. }

PROCEDURE wr_usr(c:char);
VAR
	dummy:Boolean;
	theEvent:EventRecord;   { used to get keyboard chars for DO TIMING MARK }
BEGIN
	if pucb = NIL then exit(wr_usr);

	case (pucb^.u_wspecial) of
	NORMALMODE:
		begin
		if (c = IAC) then
			pucb^.u_wspecial := IAC
		else
			{ Don't print ^L because Multics sends them
			  quite often }
			if(pucb^.u_wstate <> URGENTM) AND (c <> C_L) then
				begin
				em(c);
				if pucb^.u_echoback then
					begin
					dummy := tc_put(pucb^.u_tcconn,c);
					if c = RETURN then
						dummy :=
						  tc_put(pucb^.u_tcconn,LINEFEED);
					if pucb^.u_sendm = EVERYC then
						tcp_ex(pucb^.u_tcconn);
					end;
				end;
			end;

	IAC:
		case (c) of
		IAC:
			begin
			if(pucb^.u_wstate <> URGENTM) then
				em(c);
			pucb^.u_wspecial := NORMALMODE
			end;

		AO:
			begin
			dummy := tc_put(pucb^.u_tcconn,IAC);
			dummy := tc_put(pucb^.u_tcconn,DM);
			tcpurgent(pucb^.u_tcconn);
			pucb^.u_wspecial := NORMALMODE
			end;

	       WILL,WONT,DOIT,DONT:
			pucb^.u_wspecial := c;

	       GA:
			begin
			pucb^.u_wspecial := NORMALMODE;
			emstr('*GA*');
			end;

	       NOP:     begin
			pucb^.u_wspecial := NORMALMODE;
			end;

		otherwise
			{ Ignore IAC x }
			pucb^.u_wspecial := NORMALMODE;
		end; { case c }

	WILL:
		begin
		case c of
		OPTECHO:
			begin
			case (pucb^.u_echongo) of
			NORMALMODE:
				begin
				{ This host did not initiate echo negot,
				  so respond }
				if(pucb^.u_echom <> REMOTE) then
					echoremote(pucb);
				end;
			LECHOREQ:
				{ Rejecting my IAC DONT ECHO (illegit) }
				ttechoremote(pucb);
			RECHOREQ: { Everything is OK } ;
			end; { case pucb^.u_echongo }

			pucb^.u_echongo := NORMALMODE;
			end;

		OPTSPGA:
			{ suppress GA's }
			begin
			dummy := tc_put(pucb^.u_tcconn,IAC);
			dummy := tc_put(pucb^.u_tcconn,DOIT);
			dummy := tc_fput(pucb^.u_tcconn,c);
			end;

		otherwise
			begin
			dummy := tc_put(pucb^.u_tcconn,IAC);
			dummy := tc_put(pucb^.u_tcconn,DONT);
			dummy := tc_fput(pucb^.u_tcconn,c);
			end;
		end; { case c }

		pucb^.u_wspecial := NORMALMODE;
		end;

	WONT:
		begin
		if c = OPTECHO then
			begin
			case (pucb^.u_echongo) of
			NORMALMODE:
				{ This host did not initiate echo negot,
				  so respond }
				if pucb^.u_echom <> LOCAL then
					echolocal(pucb);
			RECHOREQ:
				{ Rejecting my IAC DOIT ECHO }
				ttecholocal(pucb);
			LECHOREQ: { Everything is OK } ;
			end; { case pucb^.echongo }

			pucb^.u_echongo := NORMALMODE;
			end;
		pucb^.u_wspecial := NORMALMODE;
		end;

	DOIT:
		begin
		if c = OPTECHO then
			begin
			pucb^.u_echoback := true;
			dummy := tc_put(pucb^.u_tcconn,IAC);
			dummy := tc_put(pucb^.u_tcconn,WILL);
			dummy := tc_fput(pucb^.u_tcconn,OPTECHO);
			end
		else if c = OPTTMARK then begin
			em_flush;
			while GetNextEvent(keyDownMask+autoKeyMask,theEvent) do
				gt_usr(chr(theEvent.message MOD 256));
			dummy := tc_put(pucb^.u_tcconn,IAC);
			dummy := tc_put(pucb^.u_tcconn,WILL);
			dummy := tc_fput(pucb^.u_tcconn,OPTTMARK);
			end
		else
			begin
			dummy := tc_put(pucb^.u_tcconn,IAC);
			dummy := tc_put(pucb^.u_tcconn,WONT);
			dummy := tc_fput(pucb^.u_tcconn,c);
			end;
		pucb^.u_wspecial := NORMALMODE;
		end;

	DONT:
		begin
		if c = OPTECHO then
			begin
			pucb^.u_echoback := false;
			dummy := tc_put(pucb^.u_tcconn,IAC);
			dummy := tc_put(pucb^.u_tcconn,WONT);
			dummy := tc_fput(pucb^.u_tcconn,OPTECHO);
			end;
		pucb^.u_wspecial := NORMALMODE;
		end;

	end; { case pucb^.u_wspecial }
end; { of wr_usr }

PROCEDURE echolocal(pucb:ucbptr);
VAR     dummy:Boolean;
begin
	dummy := tc_put(pucb^.u_tcconn,IAC);
	dummy := tc_put(pucb^.u_tcconn,DONT);
	dummy := tc_fput(pucb^.u_tcconn,OPTECHO);
	pucb^.u_echom := LOCAL;
end;

PROCEDURE ttecholocal(pucb:ucbptr);
begin
	pucb^.u_echom := LOCAL;
end;

PROCEDURE echoremote(pucb:ucbptr);
VAR     dummy:Boolean;
begin
	dummy := tc_put(pucb^.u_tcconn,IAC);
	dummy := tc_put(pucb^.u_tcconn,DOIT);
	dummy := tc_fput(pucb^.u_tcconn,OPTECHO);
	pucb^.u_echom := REMOTE;
end;

PROCEDURE ttechoremote(pucb:ucbptr);
begin
	pucb^.u_echom := REMOTE;
end;

PROCEDURE opn_usr;
VAR pucb:ucbptr;
begin
	EmLn('Open');
	pucb := @ucb_extern;
	echoremote(pucb);
	pucb^.u_echongo := RECHOREQ;
end;

PROCEDURE opn_host;
BEGIN
	EmLn('Open');
END;

PROCEDURE cls_usr;
begin
	EmLn('Closed');
	tn_free;
end;

PROCEDURE tmo_usr;
begin
	NotResponding(StrCvt('TELNET'));
end;

PROCEDURE pr_dot;
begin
	em('.');
end;

{ Functions that interface with the TFTP server }

{ function called when file transfer is requested }

FUNCTION tntftp(fhost:in_name; var filename:STR255; dir:unsigned):Integer;
VAR
	ItemType:Integer;
	ItemHndl:Handle;
	ItemBox:Rect;
	itemHit:Integer;
	dowhat:string[7];
	tntfDialog:DialogPtr;
begin
	cvt_inaddr(fhost,Msg);
	if dir = PUT then dowhat := 'get' else dowhat := 'put';
	ParamText(Msg,dowhat,filename,'');
	tntfDialog := GetNewDialog(tntfId,NIL,POINTER(-1));
	ModalDialog(NIL, itemHit);
	DisposDialog(tntfDialog);
	if itemHit = 1 then tntftp := 1 else tntftp := 0;
end;

{  function called when file transfer is done.  }

PROCEDURE tntfdn(success:Integer);
begin
	Msg := 'TELNET TFTP Server: File transfer ';
	if success = 1 then
		insert('succeeded.',Msg,length(Msg)+1)
	else
		insert('failed.',Msg,length(Msg)+1);
	EmLn(Msg);
end;

{ procedures to handle the two user menus unique to telnet }

PROCEDURE TelnetMenuCmd(item:Integer; theMenu:MenuHandle);
VAR
	dummy:Boolean;
	TempText:STR255;
begin
	case (item) of

	1:      begin
		if pucb = NIL then
			begin
			if not NameRemoteHost(TempText) then
				exit(TelnetMenuCmd);
			em_reset;
			if tn_conn(TempText,TELNETSOCK) = NIL then
				begin
				CantConnect(StrCvt('TELNET'),@TempText);
				end
			else
				begin
				if tn_tftp then
					begin
					if NOT ServerRunning then
						BEGIN
						tfsinit(@tntftp,@tntfdn);
						ServerRunning := true;
						END;
					tfs_on;
					pucb^.u_tftp := TRUE;
					end;
				end;
			end;
		end;

	2:      begin
		if (pucb^.u_tcconn^.conn_state = ESTAB) then
			begin
			tcp_close(pucb^.u_tcconn);
			pucb^.u_state := XCLOSING;
			pucb^.u_rstate := BLOCK;
			end
		else if (pucb^.u_tcconn^.conn_state = LISTEN)
			or (pucb^.u_tcconn^.conn_state = SYNSENT)
			or (pucb^.u_tcconn^.conn_state = SYNRCVD) THEN
			begin
			tcp_close(pucb^.u_tcconn);
			end
		end;

	3:      begin
		if pucb^.u_sendm = EVERYC then
			pucb^.u_sendm := NEWLINE
		else
			pucb^.u_sendm := EVERYC;
		end;

	4:      begin
		if (pucb^.u_tftp) then
			begin
			{ File transfer service turned off. }
			tfs_off;
			pucb^.u_tftp := FALSE;
			end
		else
			begin
			{ File transfer service turned on. }
			tfs_on;
			pucb^.u_tftp := TRUE;
			end;
		end;

{$IFC LISTEN}
	5:      begin
		pucb := tn_alloc;
		em_reset;
		pucb^.u_tcconn :=
			tcp_listen(23, TCPWINDOW, TCPLOWIND,
			@opn_host,@wr_usr,@mst_run,@cls_usr,@tmo_usr,@pr_dot,@bfr);
		pucb^.u_echoback := false;
		pucb^.u_echom := LOCAL;
		if tn_tftp then
			begin
			if Not ServerRunning then
				BEGIN
				tfsinit(@tntftp,@tntfdn);
				ServerRunning := true;
				END;
			tfs_on;
			pucb^.u_tftp := TRUE;
			end;
		end;
{$ENDC}

	6:      begin
		if pucb <> NIL then tn_free;
		tn_done := TRUE;
		end;

	end;    { of item cases }
end; { of TelnetMenuCmd }

PROCEDURE TNFixMenu(theMenu:MenuHandle);
BEGIN
	if (pucb <> NIL) then
		begin
		DisableItem(theMenu,1);
		if (pucb^.u_tcconn^.conn_state = ESTAB)
			or (pucb^.u_tcconn^.conn_state = LISTEN)
			or (pucb^.u_tcconn^.conn_state = SYNSENT)
			or (pucb^.u_tcconn^.conn_state = SYNRCVD) THEN
			EnableItem(theMenu,2)
		else
			DisableItem(theMenu,2);
{$IFC LISTEN}
		CheckItem(theMenu,5,pucb^.u_tcconn^.conn_state=LISTEN);
		DisableItem(theMenu,5);
{$ENDC}
		if (pucb^.u_tcconn^.conn_state = ESTAB) then
			begin
			CheckItem(theMenu,3,pucb^.u_sendm=EVERYC);
			CheckItem(theMenu,4,pucb^.u_tftp);
			EnableItem(theMenu,3);
			if tn_tftp then EnableItem(theMenu,4);
			DisableItem(theMenu,6)
			end
		else    EnableItem(theMenu,6);
		end
	 else
		begin
		CheckItem(theMenu,3,false);
		CheckItem(theMenu,4,false);
		EnableItem(theMenu,1);
		DisableItem(theMenu,2);
		DisableItem(theMenu,3);
		DisableItem(theMenu,4);
{$IFC LISTEN}
		CheckItem(theMenu,5,false);
		EnableItem(theMenu,5);
{$ENDC}
		EnableItem(theMenu,6);
		end;
END;

PROCEDURE SendMenuCmd(item:Integer; theMenu:MenuHandle);
VAR
	dummy:Boolean;
	i:INTEGER;
begin
	if NOT (pucb^.u_tcconn^.conn_state = ESTAB) then exit(SendMenuCmd);
	case item of
	1:      begin
		if(pucb^.u_echom = REMOTE) then
			begin
			echolocal(pucb);
			pucb^.u_echongo := LECHOREQ;
			end
		else
			begin
			{ Remote echo mode. }
			echoremote(pucb);
			pucb^.u_echongo := RECHOREQ;
			end;
		end;

	2:      begin
		{ Sending Are You There. }
		if tc_put(pucb^.u_tcconn,IAC) then
			tcpfull
		else if tc_fput(pucb^.u_tcconn,AYT) then
			tcpfull;
		end;

	3:      begin
		{ Sending abort output. }
		dummy := tc_put(pucb^.u_tcconn,IAC);
		dummy := tc_fput(pucb^.u_tcconn,AO);
		end;

	4:      begin
		{ Sending break. }
		dummy := tc_put(pucb^.u_tcconn,IAC);
		dummy := tc_put(pucb^.u_tcconn,INTP);
		dummy := tc_put(pucb^.u_tcconn,IAC);
		dummy := tc_put(pucb^.u_tcconn,DM);
		tcpurgent(pucb^.u_tcconn);
		end;

	5:      begin
		{ Expediting data. }
		tcp_ex(pucb^.u_tcconn);
		end;
(*
	6:      begin
		{ Send Internet address }
		cvt_inaddr(in_mymach(0),Msg);
		for i := 1 to length(Msg) do gt_usr(Msg[i]);
		end;
*)
	end; { of case }
END;

PROCEDURE FixSendMenu(theMenu:menuHandle);
BEGIN
	if pucb = NIL then
		begin
		DisableItem(theMenu,0);
		CheckItem(theMenu,1,false);
		exit(FixSendMenu);
		end;

	CheckItem(theMenu,1,pucb^.u_echom=LOCAL);
	if pucb^.u_echongo = NORMALMODE then
		EnableItem(theMenu,1)
	else
		DisableItem(theMenu,1);
	if (pucb^.u_tcconn^.conn_state = ESTAB) then
		EnableItem(theMenu,0)
	else
		DisableItem(theMenu,0);
	if (pucb^.u_sendm = EVERYC) then
		DisableItem(theMenu,5)
	else
		EnableItem(theMenu,5);
END;

{ Print the foreign host message }

PROCEDURE pr_tn;
begin
	if (pucb = NIL) or (pucb^.u_tcconn = NIL) then
		Error(StrCvt('TELNET: No open connections'))
	else
		begin
		EmStr('To host ');
		EmStr(pucb^.u_tnshost);
		EmStr(' (');
		cvt_inaddr(pucb^.u_tcconn^.ForeignHost,Msg);
		EmStr(Msg);
		EmLn(')');
		end;
end;

{ Print telnet statistics }

PROCEDURE showstats;
begin
	if pucb = NIL then exit(showstats);
	pr_tn;
	case (pucb^.u_echom) of
		LOCAL:	   msg := 'local';
		REMOTE:	   msg := 'remote';
		otherwise  msg := 'invalid state';
		end;

	WriteLn('');
	WriteLn('Echo Mode: ',msg);

	case (pucb^.u_sendm) of
		EVERYC:	   msg := 'every character';
		NEWLINE:   msg := 'newline';
		otherwise  msg := 'invalid state';
		end;

	WriteLn('Send Mode: ',msg);
	tc_status(pucb^.u_tcconn);
end;

PROCEDURE tcpfull;
begin
	pucb^.u_tcpfull := true;
	Message(StrCvt('TELNET'),StrCvt('Output buffer full'));
end;

{ figure out a neat telnet socket }

FUNCTION tn_sock:unsigned;
VAR     temp:LongInt;
begin
	temp := TickCount;
	temp := BitAnd(temp,$0000ffff);
	if(temp < 1000) then temp := temp + 1000;
	tn_sock := temp;
end;

{ This has to be a separate task because resolve_name blocks }

PROCEDURE ResolveTask(Dummy:PTR);
VAR fhost:in_name;
BEGIN
	fhost := resolve_name(TheName);
	if (fhost = 0) then begin
		Error3(StrCvt('Foreign host '),@TheName,StrCvt(' not known.'));
		tn_free;
		nm_task := NIL;
		tk_exit;
		end;

	if (fhost = 1) then begin
		Error(StrCvt('Name servers not responding.'));
		tn_free;
		nm_task := NIL;
		tk_exit;
		end;

	pucb^.u_tnshost := copy(TheName,1,length(TheName));

	pucb^.u_tcconn :=
		tcp_open(@fhost,TheFSock,tn_sock,TCPWINDOW,TCPLOWIND,
		@opn_usr,@wr_usr,@mst_run,@cls_usr,@tmo_usr,@pr_dot,@bfr);
	pr_tn;
	EmStr('Trying...');
	nm_task := NIL;
	tk_exit;
END;

FUNCTION tn_conn(var s:STR255; fsock:Integer):ucbptr;
BEGIN
	if nm_task <> NIL then
		begin
		Error(StrCvt('Already trying to connect.'));
		tn_conn := NIL;
		exit(tn_conn);
		end;

	TheName := s;
	TheFSock := fsock;
	nm_task := tk_fork(tk_cur,@ResolveTask,TNTKSZ,'ResNam',NIL);
	if nm_task = NIL then
		begin
		CantAlloc(StrCvt('TELNET'),StrCvt('name resolution task'));
		tn_conn := NIL;
		exit(tn_conn);
		end;
	tn_conn := tn_alloc;
end;

{ Here begins commented-out code saved for possible later use }

(*      union { in_name _l; char _c[4]; } him;
	static char nmbuffer[20];

	him._l = custom.c_fhost;
	if(him._l == 0L) then begin
		Error('No telnet state saved, can''t continue.');
		netclose;
		halt;
		end;

	sprintf(nmbuffer, "%o,%o,%o,%o", him._c[0]&0xff,
		him._c[1]&0xff, him._c[2]&0xff, him._c[3]&0xff);
	s := nmbuffer;
	tnhost := custom.c_fhost;
	pr_banner(s);
	EmStr('Trying...');
	tcp_restore;

	2:
		begin
		if(NOT tcp_save) then
			begin
			Error('Suspend failed!');
			exit(TelnetMenuCmd);
			end;
		tn_free;
		end;

	13:
		begin
		me._l := in_mymach(tnhost);
		sprintf(buffer, '%u.%u.%u.%u ',
			me._c[0]&0xff, me._c[1]&0xff,
			me._c[2]&0xff, me._c[3]&0xff);

		ich := 0;
		while buffer[ich] <> chr(0) do
		begin
			if(tc_put(pucb^.u_tcconn,buffer[ich])) then
			begin
			tcpfull;
			goto 418;
			end;
			if(pucb^.u_echom = LOCAL) then
			Write(buffer[ich]);
			ich := ich + 1;
			end;
		418:

		       if(pucb^.u_sendm = EVERYC) then tcp_ex(pucb^.u_tcconn);

		       pr25(0,'Send my internet address in decimal.');
		       end;

	14:
		begin
		me._l := in_mymach(tnhost);
		sprintf(buffer, '%o,%o,%o,%o ',
			me._c[0]&0xff, me._c[1]&0xff,
			me._c[2]&0xff, me._c[3]&0xff);

		ich := 0;
		while buffer[ich]<>chr(0) do
		begin
			if(tc_put(pucb^.u_tcconn,buffer[ich])) then
			begin
			tcpfull;
			goto 93;
			end;
			if(pucb^.u_echom = LOCAL) then
			v(buffer[ich]);
			ich := ich + 1;
		end;
		 93:
		if(pucb^.u_sendm = EVERYC) then tcp_ex(pucb^.u_tcconn);
		pr25(0,'Send Internet address in octal');
		end;
*)

end.

!E!O!F!
#
#
echo extracting net/udp_lib.text...
cat >net/udp_lib.text <<'!E!O!F!'
{$X-}
{$M+}
{$R-}
{$0V-}
{$D-}
{$DECL DEBUG}
{$SETC DEBUG := false}
{$DECL ALLOCT}
{$SETC ALLOCT := false}
UNIT UDP_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-Task_Lib	  } Task_Lib,
      {$U net-Timer_Lib	  } Timer_Lib,
      {$U net-err_lib	  } Err_Lib,
      {$U net-ip_lib	  } IP_Lib,
      {$U net-icmp_lib	  } ICMP_Lib,
      {$U net-calls	  } Call_Lib;

{$L+}

TYPE

{ UDP Header structure }

    udp = PACKED RECORD
	     ud_srcp: integer;	        { source port }
	     ud_dstp: integer;	        { dest port }
	     ud_len: integer;	        { length of UDP packet }
	     ud_cksum: integer;	        { UDP checksum }
	    END;

    Ref_udp = ^ udp;


{ The UDP Connection structure }

    REF_udp_conn = ^ udp_conn;

    udp_conn = PACKED RECORD
		    u_next: REF_udp_conn;
		    u_lport: integer;	    { local port }
		    u_fport: integer;	    { foreign port }
		    u_fhost: in_name;	    { foreign host }
		    {int (*u_rcv)(); }	    { incoming packet handler }
		    u_rcv: ProcPTR;	    { incoming packet handler }
		    u_data: PTR;	    { fooish thing }
	    END;

    UDPCONN = REF_udp_conn;

PROCEDURE UdpInit;

FUNCTION udp_head(pip: Ref_ip):Ref_Udp;
FUNCTION udp_data(pup: Ref_Udp): PTR;

PROCEDURE udp_free(pkt:Packet);
FUNCTION udp_alloc(datalen: Integer; optlen: Integer): PACKET;

FUNCTION udp_socket: Integer;
FUNCTION udp_open(fhost: in_name; fsock: Integer; lsock: Integer;
		  handler: ProcPtr; data: PTR): UDPCONN;
PROCEDURE udp_close(con: UDPCONN);
FUNCTION udp_write(u: UDPCONN; p: PACKET; len: Integer): Integer;

FUNCTION udp_ckcon(fhost: in_name; fsock:integer): UDPCONN;

PROCEDURE udp_table;

IMPLEMENTATION

{ Some UDP internals }

CONST
	NAMESOCK       = 42;	        { A Well Known Socket }

	NI_NAME =       1;
	NI_ADDR =       2;
	NI_ERR  =       3;

	INPKTSIZ        =       INETLEN;

TYPE
    ph = PACKED RECORD
	    ph_src: in_name;	        { source address }
	    ph_dest: in_name;	        { dest address }
	    ph_zero: byte;	        { zero (reserved) }
	    ph_prot: byte;	        { protocol }
	    ph_len: integer;	        { udp length }
	    END;

{ Some goodly constants, macros and an external }
CONST

	UDPPROT =       17		    { UDP Internet protocol number };
	UDPLEN  =       sizeof(udp);

{$S	   }

VAR
	socket : integer;	        { Initialized in UDPInit }
	firstudp: UDPCONN;	        { Initialized in UdpInit := 0; }
	udp_ip_connection: IPCONN;      { IP connection used by UDP }

{$S UDPShare}

PROCEDURE udpdemux(p: PACKET; len: Integer; host: in_name); forward;

FUNCTION udp_head{(pip: Ref_ip):Ref_Udp};
BEGIN
   udp_head := { (struct udp *) } POINTER(ORD4(in_data(pip)));
END;

FUNCTION udp_data{(pup:Ref_Udp): PTR};
BEGIN
   udp_data :=  { (char *) } POINTER(ORD4(pup) + sizeof(udp) );
END;

{$S InitSeg }

{ Initialize the UDP layer; get an internet connection, initialize the
	demux table }

PROCEDURE UdpInit;
BEGIN
	FirstUDP := NIL;
	socket := 0;

	udp_ip_connection := in_open(UDPPROT, @udpdemux);
	if (udp_ip_connection = NIL) THEN BEGIN
		CantConnect(StrCvt('UDP'),StrCvt('InterNet'));
		END
{$IFC DEBUG}
	else if BCBitAnd(NDEBUG,INFOMSG) THEN
		WriteLn('UDP: Opened InterNet connection.');
{$ENDC}
END; { UdpInit }

{$S UDPShare}

FUNCTION udp_alloc(datalen: Integer; optlen: Integer): PACKET;
VAR
	len: Integer;
BEGIN
       {  len := (datalen + sizeof(udp) + 1) & ~1; }
       len := datalen + sizeof(udp) + 1;
       IF Odd(len) THEN len := len - 1;

       udp_alloc := in_alloc(len, optlen);
END; { udp_alloc }

PROCEDURE udp_free(pkt:Packet);
{$IFC ALLOCT}
VAR TmpStr:STR255;
{$ENDC}
BEGIN
{$IFC ALLOCT}
  Write('free: ');
  NumToString(ORD4(pkt),TmpStr);
  WriteLn(TmpStr);
{$ENDC}
  in_free(pkt);
END;

{ Create a UDP connection and enter it in the demux table. }

FUNCTION udp_open(fhost: in_name; fsock: Integer; lsock: Integer;
		  handler: ProcPtr; data: PTR): UDPCONN;
{	  fhost: in_name;    }	        { foreign host }
{	  fsock: integer;    }	        { foreign socket }
{	 lsock: integer;     }	        { local socket }
{       int (*handler)();    }	        { upcalled on receipt of a packet }
{	  data: PTR;	 }	        { random data }
VAR
	i: Integer;
	con: UDPCONN;
	ocon: UDPCONN;
BEGIN
{$IFC DEBUG}
	if BCBitAnd(NDEBUG,INFOMSG) THEN BEGIN
		Write('UDP_OPEN: On host ');
		out_inaddr(fhost);
		Write(', local sock ',lsock,', forn sock ',fsock,', foo ');
		WriteLong(ORD4(data));
		WriteLn('');
		END;
{$ENDC}

	con := firstudp;
	WHILE (con <> NIL ) DO BEGIN
		if (con^.u_lport = lsock) AND (con^.u_fport = fsock) AND
					    (con^.u_fhost = fhost) THEN BEGIN
{$IFC DEBUG}
			if BCBitAnd(NDEBUG,INFOMSG) OR
			   BCBitAnd(NDEBUG,PROTERR) THEN
				WriteLn('UDP: Connection already exists.');
{$ENDC}
			udp_open := NIL;
			EXIT(udp_open);
			END;

		ocon := con;
		con := con^.u_next;
		END;

	con := {(UDPCONN*) } POINTER(ORD4(NewPtr(sizeof(udp_conn))));
	if (con = NIL) THEN BEGIN
		CantAlloc(StrCvt('UDP'),StrCvt('connection'));
		udp_open := NIL;
		EXIT(udp_open);
		END;

	if (firstudp <> NIL) THEN ocon^.u_next := con
	    ELSE firstudp := con;

	con^.u_next := NIL;

	con^.u_lport := lsock;	        { fill in connection info }
	con^.u_fport := fsock;
	con^.u_fhost := fhost;
	con^.u_rcv   := handler;
	con^.u_data  := data;

	udp_open := con;
END; { udp_open }

FUNCTION udp_ckcon(fhost: in_name; fsock:integer): UDPCONN;
VAR
	con: UDPCONN;
BEGIN
	con := firstudp;
	while con <> NIL DO BEGIN
		IF (con^.u_fport = fsock) AND (con^.u_fhost = fhost)
		    THEN leave
		    ELSE con := con^.u_next;
		END;
	udp_ckcon := con;
END;  {	 end of udp_ckcon()  }

{ close a udp connection - remove the connection from udp's list of
	connections and deallocate it.
   But only if the connection is not null.  1/16/84 <J. H. Saltzer>
}

PROCEDURE udp_close(con: UDPCONN);
VAR
	pcon: UDPCONN;
BEGIN

	if (con = NIL) THEN EXIT(udp_close);

	{ This next line of code makes no sense: if the firstudp happens
	  to be deallocated (closed), then the entire chain is thrown away,
	  since there is no way to pick up the chain -- I think that
	  firstudp should be made to point at the next udp connection
	  in the list, just as if other udp connections were closed, then
	  they would be linked over (to preserve other connections). }

	if (firstudp = con) THEN BEGIN
		{ This is rewritten to meet my expectations }
		{ was: firstudp := NIL }
		firstudp := firstudp^.u_next;
		END
	else BEGIN
		pcon := firstudp;
		WHILE (pcon <> NIL) DO BEGIN
			IF pcon^.u_next = con THEN leave;
			pcon := pcon^.u_next;
			END;

		if (pcon = NIL) THEN BEGIN
{$IFC DEBUG}
		    WriteLn('UDPClose: could not find connection to close');
{$ENDC}
		    EXIT(udp_close);
		    END;

		pcon^.u_next := con^.u_next;
		END;

	DisposPtr(POINTER(ORD4(con)));
END; { udp_close}

FUNCTION udp_socket{: Integer};
BEGIN
    if (socket<> 0) THEN BEGIN
	    udp_socket := Socket;
	    Socket := Socket + 1;
	    EXIT(udp_socket);
	    END;

    socket := LoWord(TickCount);
    if (socket < 1000) THEN socket := socket + 1000;
    udp_socket := socket;
    socket := socket + 1;
END; { udp_socket }

{ This routine handles incoming UDP packets. They're handed to it by the
	internet layer. It demultiplexes the incoming packet based on the
	local port and upcalls the appropriate routine. }

PROCEDURE udpdemux(p: PACKET; len: Integer; host: in_name);
VAR
	pip: Ref_IP;
	pup: Ref_udp;
	php: ph;
	con: UDPCONN;
	osum, xsum: integer;
	data: PTR;
	plen: integer;
	RawDataPtr: PTR;
	Dummy: Integer;	        { Return value from ICMP call }
BEGIN
	CheckTask;

	{ First let's verify that it's a valid UDP packet. }
{$IFC DEBUG}
	if BCBitAnd(NDEBUG,INFOMSG) THEN BEGIN
		Write('UDP: Received packet of length ',len,
			' from host ');out_inaddr(host);
		WriteLn('.');
		END;
{$ENDC}

	pip := in_head(p);
	pup := udp_head(pip);
	plen := { bswap } (pup^.ud_len);

	if(plen > len) THEN BEGIN
{$IFC DEBUG}
		if BCBitAnd(NDEBUG,INFOMSG) OR BCBitAnd(NDEBUG,PROTERR) THEN BEGIN
			WriteLn('UDP: Received bad len: rcvd: ',len,
				', hdr: ',{ bswap } (pup^.ud_len) + UDPLEN);
			END;
{$ENDC}

		in_free(p);
		exit(udpdemux);
		END;

	osum := pup^.ud_cksum;
	if (osum <> 0) THEN BEGIN
		if Odd(len) THEN BEGIN
			RawDataPtr := POINTER( ORD4(pup) + len);
			RawDataPtr^ := 0;
			END;
		php.ph_src := host;
		php.ph_dest := pip^.ip_dest;
		php.ph_zero := 0;
		php.ph_prot := UDPPROT;
		php.ph_len  := pup^.ud_len;

		pup^.ud_cksum := cksum(@php, sizeof(ph) div 2);
		xsum := BitNOT(cksum(POINTER(ORD4(pup)),(len+1) div 2));
		pup^.ud_cksum := osum;
		if (xsum <> osum) THEN BEGIN
{$IFC DEBUG}
			if BCBitAnd(NDEBUG,INFOMSG) OR BCBitAnd(NDEBUG,PROTERR)
			   THEN WriteLn('UDP: Received bad checksum.');
{$ENDC}
			in_free(p);
			exit(udpdemux);
			END;
		END;

	{ udpswap(pup); } { Swapping unnecessary since 68000 doesnot byte swap
			     integer representations }
{$IFC DEBUG}
	if BCBitAnd(NDEBUG,INFOMSG) THEN BEGIN
		Write('UDP: Got packet for port ',pup^.ud_dstp,
		      ' from port ',pup^.ud_srcp,' on host ');
		out_inaddr(host);
		WriteLn('.');
		END;
{$ENDC}

	{ ok, accept it. run through the demux table and try to upcall it }

	con := firstudp;
	WHILE (con <> NIL) DO
	BEGIN
		if (con^.u_lport <> 0) AND (con^.u_lport <> pup^.ud_dstp)
			THEN con := con^.u_next
		ELSE BEGIN
{$IFC DEBUG}
		    if BCBitAnd(NDEBUG,INFOMSG) THEN BEGIN
			Write('UDPDEMUX: Foo Data := ');
			WriteLong(ORD4(con^.u_data)); WriteLn('');
			END;
{$ENDC}

		    if (con^.u_rcv <> NIL) THEN
			    CALL4A(POINTER(ORD4(p)),plen-UDPLEN,host,
				   con^.u_data,con^.u_rcv);
		    exit(udpdemux);
		    END;
		END;

{$IFC DEBUG}
	if BCBitAnd(NDEBUG,INFOMSG) OR BCBitAnd(NDEBUG,PROTERR) THEN
		WriteLn('UDP: No connection for packet; packet dropped.');
{$ENDC}

	{ send destination unreachable }
	Dummy := icmp_destun(host, in_head(p), DSTPORT);

	udp_free(p);
END; { udpdemux }

{ Fill in the udp header on a packet, checksum it and pass it to
	Internet. }

FUNCTION udp_write(u: UDPCONN; p: PACKET; len: Integer): Integer;
VAR
	pup: Ref_UDP;
	php: ph;
	udplen: Integer;
	host: in_name;
	RawDataPtr: PTR;
BEGIN

{$IFC DEBUG}
	if BCBitAnd(NDEBUG,TCTRACE) THEN BEGIN
	    WriteLn('UDP: Sending packet, length ',len,
		    ' lport ',u^.u_lport,', fport ',u^.u_fport,'.');
	    END;
	if BCBitAnd(NDEBUG,INFOMSG) THEN BEGIN
	    Write('UDP: buffer address ');
	    WriteLong(ORD4(p^.nb_buff));
	    WriteLn('');
	    END;
{$ENDC}

	pup := udp_head(in_head(p));
	udplen := len + sizeof(udp);
	if Odd(udplen)  THEN BEGIN
		{ (( byte*)pup)[udplen] := 0; }
		RawDataPtr := POINTER(ORD4(pup) + udplen);
		RawDataPtr^ := 0;
		END;

	host := u^.u_fhost;
	pup^.ud_len := udplen;
	pup^.ud_srcp := u^.u_lport;
	pup^.ud_dstp := u^.u_fport;
	{ udpswap(pup); } { No swapping is needed on the 68000 }

	php.ph_src := in_mymach(host);
	php.ph_dest := host;
	php.ph_zero := 0;
	php.ph_prot := UDPPROT;
	php.ph_len := pup^.ud_len;

	{ The next two statements look very strange: why is the checksum
	  being done twice on two different blocks with two different
	  lengths and put in the same place? I have a suspicion that the
	  first statement does a checksum over the header and stores that
	  checksum in the header, and then the entire packet with header
	  is checksumed and that value is then placed into the header as
	  well. This seems like a silly way to do checksumming }

	pup^.ud_cksum := cksum(@php, sizeof(ph) div 2);
	pup^.ud_cksum := BitNOT(cksum(POINTER(ORD4(pup)),(udplen+1) div 2));

	udp_write := in_write(udp_ip_connection, p, udplen, host);
END; {udp_ write}

(*
PROCEDURE udpswap(pup:Ref_udp);
{ This procedure is unnecessary on the 68000 but is left for historical reasons }
BEGIN
    pup^.ud_srcp :=  { bswap } (pup^.ud_srcp);
    pup^.ud_dstp := { bswap } (pup^.ud_dstp);
    pup^.ud_len := { bswap } (pup^.ud_len);
    pup^.ud_cksum := { bswap }(pup^.ud_cksum);
END; { udpswap }
*)

{ Dump the internal table of UDP connections. }

PROCEDURE TabTo(fromPos,toPos:Integer);
VAR i:Integer;
BEGIN
	for i := fromPos+1 to toPos do Write(' ');
END;

PROCEDURE udp_table;
CONST
	initItem = 6;
	udpDialog = 93;
VAR
	con: UDPCONN;
	tmp:STR255;
	it:INTEGER;
	dp:DialogPtr;
	iType:INTEGER;
	itemHndl:Handle;
	box:Rect;

    PROCEDURE SetIt(number:LONGINT);
    BEGIN
	NumToStr(number,tmp);
	GetDItem(dp,it,iType,itemHndl,box);
	SetIText(itemHndl,tmp);
    END;

BEGIN
	dp := GetNewDialog(udpDialog,NIL,POINTER(-1));
	con := firstudp;
	it := initItem;
	WHILE (con <> NIL) DO BEGIN
		SetIt(con^.u_lport);
		it := it + 1;
		SetIt(con^.u_fport);
		it := it + 1;
		cvt_inaddr(con^.u_fhost,tmp);
		GetDItem(dp,it,iType,itemHndl,box);
		SetIText(itemHndl,tmp);
		it := it + 1;
		SetIt(ORD4(con^.u_rcv));
		it := it + 1;
		SetIt(ORD4(con^.u_data));
		it := it + 1;
		con := con^.u_next;
		END;
	MsgRegister(dp);
END; { udp_table }

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.