home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / TCPStuff.p < prev    next >
Encoding:
Text File  |  1995-10-04  |  32.4 KB  |  1,127 lines  |  [TEXT/CWIE]

  1. unit TCPStuff;
  2.  
  3. { TCPStuff © Peter Lewis, Oct 1991 }
  4. { This source is Freeware }
  5.  
  6. interface
  7.  
  8.     uses
  9.         TextUtils, TCPTypes, TCPUtils;
  10.  
  11.     const
  12.     { Amount of space to allocate for each TCP connection }
  13.         INCOMINGBUFSIZE = 100;    { Incoming buffer size, used for buffering ReceiveUpTo. }
  14.         control_block_max = 260;
  15.         tooManyControlBlocks = -23098;
  16.  
  17.     type
  18.         OSErrPtr = ^OSErr;
  19.  
  20. { TCP connection description: }
  21.         TCPConnectionType = record
  22.                 magic: OSType;    { A magic number to try and avoid problems with released connection IDs. }
  23.                 stream: StreamPtr;
  24.                 closedone: boolean;
  25.                 laststate: integer;
  26.                 asends, asendcompletes: longint;
  27.                 closeuserptr: OSErrPtr;
  28.                 incomingPtr: Ptr;                                { Pointer into inBuf of next byte to read. }
  29.                 incomingSize: longint;                        { Number of bytes left in inBuf. }
  30.                 buffer: ptr;        { connection buffer. }
  31.                 inBuf: array[1..INCOMINGBUFSIZE] of SignedByte;    {Input buffer. }
  32.             end;
  33.         TCPConnectionPtr = ^TCPConnectionType;
  34.  
  35.         MyControlBlock = record
  36.                 tcp: TCPControlBlock;
  37.                 inuse: boolean;
  38.                 userptr: OSErrPtr;
  39.                 proc: procPtr;
  40.                 tcpc: TCPConnectionPtr;
  41.             end;
  42.         MyControlBlockPtr = ^MyControlBlock;
  43.  
  44.     type
  45.         UDPConnectionRecord = record
  46.                 magic: OSType;    { A magic number to try and avoid problems with released connection IDs. }
  47.                 stream: StreamPtr;
  48.                 outstanding: integer;
  49.             end;
  50.         UDPConnectionPtr = ^UDPConnectionRecord;
  51.  
  52.     var
  53.         icmp_sent_out, icmp_got_back: longint;
  54.         largest_mtu: longint;
  55.         largest_minimum_tcp_buffer_size: longint;
  56.  
  57.     function TCPInit: OSErr;
  58.     procedure TCPFinish;
  59.  
  60.     function TCPActiveOpen (var connection: TCPConnectionPtr; buffersize: longint; localport: integer; remoteIP: longint; remoteport: integer; userptr: OSErrPtr): OSErr;
  61.     function TCPPassiveOpen (var connection: TCPConnectionPtr; buffersize: longint; localport: integer; remoteIP: longint; remoteport: integer; userptr: OSErrPtr): OSErr;
  62.     function TCPPassiveOpenDynamic (var connection: TCPConnectionPtr; buffersize: longint; var localport: integer; remoteIP: longint; remoteport: integer; userptr: OSErrPtr): OSErr;
  63.     function TCPCreateConnectionForStream (var connection: TCPConnectionPtr; strm: streamPtr): OSErr;
  64.     function TCPFlush (connection: TCPConnectionptr): OSErr;
  65.     function TCPClose (connection: TCPConnectionPtr; userptr: OSErrPtr): OSErr;
  66.     function TCPAbort (connection: TCPConnectionPtr): OSErr;
  67.     function TCPRelease (var connection: TCPConnectionPtr): OSErr;
  68.     procedure TCPRawState (connection: TCPConnectionPtr; var state: integer; var localhost: longint; var localport: integer; var remotehost: longint; var remoteport: integer; var available: longint);
  69.     function TCPState (connection: TCPConnectionPtr): TCPStateType;
  70.     function TCPCharsAvailable (connection: TCPConnectionPtr): longint;
  71.     function TCPLocalPort (connection: TCPConnectionPtr): integer;
  72.     function TCPRemoteIP (connection: TCPConnectionPtr): IPAddr;
  73.     function TCPRawReceiveChars (connection: TCPConnectionPtr; returnPtr: ptr; readCount: integer): OSErr;
  74. { Use EITHER RawReceive, or the other Receives.  Don't combine them for one stream! }
  75.     function TCPReceiveChars (connection: TCPConnectionPtr; returnPtr: ptr; readCount: integer): OSErr;
  76.     function TCPReadByte (connection: TCPConnectionPtr; timeout: longint; var b: SignedByte): OSErr;
  77.     function TCPReceiveUpTo (connection: TCPConnectionPtr; termChar: signedByte;{}
  78.                                     charTimeOut: longint; readPtr: ptr; readSize: longint; var readPos: longint;{}
  79.                                     var gottermchar: boolean): OSErr;
  80.     function TCPSend (connection: TCPConnectionPtr; writePtr: ptr; writeCount: integer; push: boolean): OSErr;
  81.     function TCPSendAsync (connection: TCPConnectionPtr; writePtr: ptr; writeCount: integer; push: boolean; userptr: OSErrPtr): OSErr;
  82.  
  83.     function UDPCreate (var connection: UDPConnectionPtr; buffer_size: longint; var localport: integer): OSErr;
  84.     function UDPRead (connection: UDPConnectionPtr; timeout: integer; var remoteIP: longint; var remoteport: integer;{}
  85.                                     var datap: ptr; var datalen: integer): OSErr;
  86.     function UDPReturnBuffer (connection: UDPConnectionPtr; datap: ptr): OSErr;
  87.     function UDPDatagramsAvailable (connection: UDPConnectionPtr): integer;
  88.     function UDPWrite (connection: UDPConnectionPtr; remoteIP: longint; remoteport: integer;{}
  89.                                     datap: ptr; datalen: integer; checksum: boolean): OSErr;
  90.     function UDPRelease (var connection: UDPConnectionPtr): OSErr;
  91.     function UDPMTU (remoteIP: longint; var mtu: longint): OSErr;
  92.  
  93.     function IPGetMyIPAddr (var myIP: longint): OSErr;
  94.     function IPSendICMPEcho (remotehost: ipAddr; timeout: integer; datap: ptr; datalen: integer; complete: ProcPtr; userdata: univ ptr; extradata: univ ptr): OSErr;
  95. {procedure ICMPCompletion (cbp: IPControlBlockPtr; userdata: ptr;extradata:ptr);}
  96.  
  97.     procedure UDPZeroCB (var cb: UDPControlBlock; stream: StreamPtr; call: integer);
  98.     procedure TCPControlAsync (pbp: TCPControlBlockPtr; comp: ProcPtr);
  99. { pbp MUST be a ptr to an XTCPControlBlock }
  100.  
  101.     function GetMinimumBufferSize (remote_ip: IPAddr; tcp: boolean): longint;
  102.     function GetBufferSize (remote_ip: IPAddr; desired: longint; tcp: boolean): longint;
  103.  
  104. implementation
  105.  
  106.     uses
  107.         Memory, Errors, Devices, Events, 
  108.         DNR, MyMathUtils, MyCallProc, TCPUtils, MyMemory, MyTypes;
  109.  
  110.     const
  111.         MAGICNUMBER = 'TMGK';    { Unique value used to trap illegal connection IDs. }
  112.         UDPMagic = 'UDPM';
  113.         UDPBad = '????';
  114.         dispose_block_max = 100;
  115.  
  116.     type
  117.         MyControlBlockArray = array[1..control_block_max] of MyControlBlockPtr;
  118.  
  119.     type
  120.         stackframe = packed record
  121.                 frameptr: ptr;
  122.                 returnptr: ptr;
  123.                 paramblockptr: ptr;
  124.             end;
  125.         stackframeptr = ^stackframe;
  126.  
  127.     var
  128.         controlblocks: MyControlBlockArray;
  129.         disposeblocks: array[1..dispose_block_max] of ptr;
  130.         gTCPPreCompletionProc:UniversalProcPtr;
  131.         gDoIOCompletionProc:UniversalProcPtr;
  132.         gIPICMPCompletionProc:UniversalProcPtr;
  133.         gTCPSendCompleteProc:UniversalProcPtr;
  134.         gMyNotifyProc:UniversalProcPtr;
  135.         
  136.     const
  137.         max_ICMPDataArray = 100;
  138.     type
  139.         ICMPData = record
  140.                 complete: ProcPtr;
  141.                 userdata: ptr;
  142.                 extradata: ptr;
  143.             end;
  144.         ICMPDataArray = array[1..max_ICMPDataArray] of ICMPData;
  145.     var
  146.         icmp_data_array: ICMPDataArray;
  147.  
  148. {$IFC not GENERATINGPOWERPC}
  149.     function GetStackFrame: stackframeptr;
  150.     inline
  151.         $2E8E;
  152. {$ENDC}
  153.  
  154.     procedure TCPPreCompletionPascal(pbp: TCPControlBlockPtr);
  155.         var
  156.             prp: TCPXControlBlockPtr;
  157.     begin
  158.         prp := TCPXControlBlockPtr(ord(pbp) - 4);
  159.         if prp^.completion <> nil then begin
  160.             CallPascal04(pbp, prp^.completion);
  161.         end;
  162.     end;
  163.  
  164. {$IFC GENERATINGPOWERPC}
  165.     procedure TCPPreCompletion(pbp: TCPControlBlockPtr);
  166.     begin
  167.         TCPPreCompletionPascal(pbp);
  168.     end;
  169. {$ELSEC}
  170.     procedure TCPPreCompletion; { All C functions look like pascal paramterless procedures from the procs point of view }
  171.     begin
  172.         TCPPreCompletionPascal(TCPControlBlockPtr(GetStackFrame^.paramblockptr));
  173.     end;
  174. {$ENDC}
  175.  
  176.     procedure TCPControlAsync (pbp: TCPControlBlockPtr; comp: ProcPtr);
  177.         var
  178.             err: OSErr;
  179.             prp: TCPXControlBlockPtr;
  180.     begin
  181.         prp := TCPXControlBlockPtr(ord(pbp) - 4);
  182.         prp^.completion := comp;
  183.         pbp^.ioCompletion := gTCPPreCompletionProc;
  184.         err := PBControlAsync(ParmBlkPtr(pbp));
  185.         if err <> noErr then begin
  186.             pbp^.ioResult := err;
  187.             if prp^.completion <> nil then begin
  188.                 CallPascal04(pbp, prp^.completion);
  189.             end;
  190.         end;
  191.     end;
  192.  
  193.     procedure IOCompletionPascal (cbp: MyControlBlockPtr);
  194.     begin
  195.         with cbp^ do begin
  196.             if userptr <> nil then begin
  197.                 userptr^ := cbp^.tcp.ioResult;
  198.             end;
  199.             inuse := false;
  200.             if proc <> nil then begin
  201.                 CallPascal04(cbp, proc);
  202.             end;
  203.         end;
  204.     end;
  205.  
  206. {$IFC GENERATINGPOWERPC}
  207.     procedure DoIOCompletion (cbp: MyControlBlockPtr);
  208.     begin
  209.         IOCompletionPascal(cbp);
  210.     end;
  211. {$ELSEC}
  212.     procedure DoIOCompletion; { All C functions look like pascal paramterless procedures from the procs point of view }
  213.     begin
  214.         IOCompletionPascal(MyControlBlockPtr(GetStackFrame^.paramblockptr));
  215.     end;
  216. {$ENDC}
  217.  
  218.     procedure ZotBlocks;
  219.         var
  220.             i: integer;
  221.     begin
  222.         for i := 1 to dispose_block_max do begin
  223.             if disposeblocks[i] <> nil then begin
  224.                 MDisposePtr(disposeblocks[i]);
  225.             end;
  226.         end;
  227.     end;
  228.  
  229.     procedure AddBlock (p: univ ptr);
  230. { Called at interupt level }
  231. { Must work even while ZotBlocks is in progress }
  232.         var
  233.             i: integer;
  234.     begin
  235.         for i := 1 to dispose_block_max do begin
  236.             if disposeblocks[i] = nil then begin
  237.                 disposeblocks[i] := p;
  238.                 leave;
  239.             end;
  240.         end;
  241.     end;
  242.  
  243.     procedure ZeroCB (var cb: TCPControlBlock; stream: StreamPtr; call: integer);
  244.     begin
  245.         MZero(@cb, SizeOf(cb));
  246.         cb.tcpStream := stream;
  247.         cb.ioCRefNum := mactcp_driver_refnum;
  248.         cb.csCode := call;
  249.     end;
  250.  
  251.     function GetCB (var cbp: MyControlBlockPtr; tcpc: TCPConnectionPtr; call: integer; userptr: OSErrPtr; proc: procptr): OSErr;
  252. { NOTE: Must not move memory if there is a free block available (ie, during a Completion call) }
  253.         var
  254.             err: OSErr;
  255.             i: integer;
  256.     begin
  257.         i := 1;
  258.         while (i < control_block_max) & (controlblocks[i] <> nil) & controlblocks[i]^.inuse do begin
  259.             i := i + 1;
  260.         end;
  261.         cbp := controlblocks[i];
  262.         err := noErr;
  263.         if cbp = nil then begin
  264.             err := MNewPtr(cbp, SizeOf(MyControlBlock));
  265.             if err = noErr then begin
  266.                 cbp^.inuse := false;
  267.                 controlblocks[i] := cbp;
  268.             end;
  269.         end;
  270.         if (err = noErr) & not cbp^.inuse then begin
  271.             ZeroCB(cbp^.tcp, tcpc^.stream, call);
  272.             cbp^.tcp.ioCompletion := gDoIOCompletionProc;
  273.             cbp^.inuse := true;
  274.             cbp^.userptr := userptr;
  275.             cbp^.tcpc := tcpc;
  276.             cbp^.proc := proc;
  277.             if userptr <> nil then begin
  278.                 userptr^ := inprogress;
  279.             end;
  280.             GetCB := noErr;
  281.         end
  282.         else begin
  283.             cbp := nil;
  284.             GetCB := memFullErr;
  285.         end;
  286.     end;
  287.  
  288.     procedure FreeCB (var cbp: MyControlBlockPtr);
  289.     begin
  290.         if cbp <> nil then begin
  291.             cbp^.inuse := false;
  292.         end;
  293.         cbp := nil;
  294.     end;
  295.  
  296.     function GetMinimumBufferSize (remote_ip: IPAddr; tcp: boolean): longint;
  297.         var
  298.             mtu: longint;
  299.             err: OSErr;
  300.             mult: integer;
  301.     begin
  302.         if tcp then begin
  303.             mult := 4;
  304.         end
  305.         else begin
  306.             mult := 2;
  307.         end;
  308.         err := noErr;
  309.         if (remote_ip = 0) then begin
  310.             err := IPGetMyIPAddr(remote_ip);
  311.         end;
  312.         if err = noErr then begin
  313.             err := UDPMTU(remote_ip, mtu);
  314.         end;
  315.         if err <> noErr then begin
  316.             mtu := largest_mtu;
  317.         end;
  318.         largest_mtu := Max(mtu, largest_mtu);
  319.         largest_minimum_tcp_buffer_size := Max(4096, largest_mtu * 4 + 1024);
  320.         GetMinimumBufferSize := Max(4096, mtu * mult + 1024);
  321.     end;
  322.  
  323.     function GetBufferSize (remote_ip: IPAddr; desired: longint; tcp: boolean): longint;
  324.         var
  325.             minimum: longint;
  326.     begin
  327.         if desired = 0 then begin
  328.             desired := 6 * 1024;
  329.         end;
  330.         minimum := GetMinimumBufferSize(remote_ip, tcp);
  331.         GetBufferSize := Max(minimum, desired);
  332.     end;
  333.  
  334.     procedure DestroyConnection (var connection: TCPConnectionPtr);
  335.     begin
  336.         connection^.magic := '????';
  337.         if connection^.buffer <> nil then begin
  338.             MDisposePtr(connection^.buffer);
  339.         end;
  340.         MDisposePtr(connection);
  341.     end;
  342.  
  343.     function ValidateConnection (connection: TCPConnectionPtr): OSErr;
  344.     begin
  345.         if (connection = nil) | (connection^.magic <> MAGICNUMBER) then begin
  346.             ValidateConnection := connectionDoesntExistErr;
  347.         end
  348.         else begin
  349.             ValidateConnection := noErr;
  350.         end;
  351.     end;
  352.  
  353.     function MyPBControlAsync (var cbp: MyControlBlockPtr): OSErr;
  354.         var
  355.             oe: OSErr;
  356.     begin
  357.         oe := PBControlAsync(ParmBlkPtr(cbp));
  358.         if oe <> noErr then begin
  359.             FreeCB(cbp);
  360.         end;
  361.         MyPBControlAsync := oe;
  362.     end;
  363.  
  364.     procedure SetUserPtr (userptr: OSErrPtr; oe: OSErr);
  365.     begin
  366.         if userptr <> nil then begin
  367.             if oe <> noErr then begin
  368.                 userptr^ := oe;
  369.             end;
  370.         end;
  371.     end;
  372.  
  373.     function TCPCreateConnectionForStream (var connection: TCPConnectionPtr; strm: streamPtr): OSErr;
  374.         var
  375.             oe: OSErr;
  376.     begin
  377.         oe := MNewPtr(connection, sizeof(TCPConnectionType));
  378.         if oe = noErr then begin
  379.             with connection^ do begin
  380.                 buffer := nil;
  381.                 magic := MAGICNUMBER;
  382.                 asends := 0;
  383.                 asendcompletes := 0;
  384.                 closedone := false;
  385.                 incomingSize := 0;
  386.                 stream := strm;
  387.             end;
  388.         end;
  389.         TCPCreateConnectionForStream := oe;
  390.     end;
  391.  
  392.     function CreateStream (var connection: TCPConnectionPtr; remoteIP: longint; buffersize: longint): OSErr;
  393.         var
  394.             oe: OSErr;
  395.     begin
  396.         buffersize := GetBufferSize(remoteIP, buffersize, true);
  397.         oe := MNewPtr(connection, sizeof(TCPConnectionType));
  398.         if oe = noErr then begin
  399.             with connection^ do begin
  400.                 oe := MNewPtr(buffer, buffersize);
  401.                 if oe = noErr then begin
  402.                     magic := MAGICNUMBER;
  403.                     asends := 0;
  404.                     asendcompletes := 0;
  405.                     closedone := false;
  406.                     incomingSize := 0;
  407.                     ZotBlocks;
  408.                     oe := MTTCPCreate(stream, buffer, buffersize);
  409.                 end;
  410.             end;
  411.             if (oe <> noErr) then begin
  412.                 DestroyConnection(connection);
  413.             end;
  414.         end;
  415.         CreateStream := oe;
  416.     end;
  417.  
  418.     function PAOpen (var connection: TCPConnectionPtr; cs: integer; buffersize: longint;var localport: integer; remoteIP: longint; remoteport: integer; userptr: OSErrPtr): OSErr;
  419.         var
  420.             oe, ooe: OSErr;
  421.             cbp: MyControlBlockPtr;
  422.     begin
  423.         oe := CreateStream(connection, remoteIP, buffersize);
  424.         if oe = noErr then begin
  425.             with connection^ do begin
  426.                 ZotBlocks;
  427.                 oe := GetCB(cbp, connection, cs, userptr, nil);
  428.                 if oe = noErr then begin
  429.                     cbp^.tcp.open.localPort := localPort;
  430.                     cbp^.tcp.open.remoteHost := remoteIP;
  431.                     cbp^.tcp.open.remotePort := remoteport;
  432.                     cbp^.tcp.open.ulpTimeoutAction := -1;
  433.                     oe := MyPBControlAsync(cbp);
  434.                     if (oe=noErr) & (cs=TCPcsPassiveOpen) then begin
  435.                         while (cbp^.tcp.ioResult>=0) & (cbp^.tcp.open.localPort=0) do begin
  436.                             ;
  437.                         end;
  438.                         localport:=cbp^.tcp.open.localPort;
  439.                     end;
  440.                 end;
  441.                 if oe <> noErr then begin
  442.                     ooe := MTTCPRelease(stream);
  443.                     DestroyConnection(connection);
  444.                 end;
  445.             end;
  446.         end;
  447.         SetUserPtr(userptr, oe);
  448.         PAOpen := oe;
  449.     end;
  450.  
  451. { Open a connection to another machine }
  452.     function TCPActiveOpen (var connection: TCPConnectionPtr; buffersize: longint; localport: integer; remoteIP: longint; remoteport: integer; userptr: OSErrPtr): OSErr;
  453.     begin
  454.         TCPActiveOpen := PAOpen(connection, TCPcsActiveOpen, buffersize, localport, remoteIP, remoteport, userptr);
  455.     end;
  456.  
  457. { Open a socket on this machine, to wait for a connection }
  458.     function TCPPassiveOpen (var connection: TCPConnectionPtr; buffersize: longint; localport: integer; remoteIP: longint; remoteport: integer; userptr: OSErrPtr): OSErr;
  459.     begin
  460.         TCPPassiveOpen := PAOpen(connection, TCPcsPassiveOpen, buffersize, localport, remoteIP, remoteport, userptr);
  461.     end;
  462.  
  463. { Open a socket on this machine, to wait for a connection }
  464.     function TCPPassiveOpenDynamic (var connection: TCPConnectionPtr; buffersize: longint; var localport: integer; remoteIP: longint; remoteport: integer; userptr: OSErrPtr): OSErr;
  465.     begin
  466.         TCPPassiveOpenDynamic := PAOpen(connection, TCPcsPassiveOpen, buffersize, localport, remoteIP, remoteport, userptr);
  467.     end;
  468.  
  469.     function TCPRawReceiveChars (connection: TCPConnectionPtr; returnPtr: ptr; readCount: integer): OSErr;
  470. { Return readCount characters from the TCP connection. }
  471. { WARNING: Doesnt handle incoming buffer, so don't use with TCPReceiveUptp or ReadByte }
  472.         var
  473.             cb: TCPControlBlock;
  474.             oe: OSErr;
  475.     begin
  476.         oe := noErr;
  477.         while (oe = noErr) & (readCount > 0) do begin
  478.             ZotBlocks;
  479.             ZeroCB(cb, connection^.stream, TCPcsRcv);
  480.             cb.receive.rcvBuff := returnPtr;
  481.             cb.receive.rcvBuffLength := readCount;
  482.             oe := PBControlSync(@cb);
  483.             longint(returnPtr) := longint(returnPtr) + cb.receive.rcvBuffLength;
  484.             readCount := readCount - cb.receive.rcvBuffLength;
  485.         end;
  486.         TCPRawReceiveChars := oe;
  487.     end;
  488.  
  489. { Return readCount characters from the TCP connection.}
  490.     function TCPReceiveChars (connection: TCPConnectionPtr; returnPtr: ptr; readCount: integer): OSErr;
  491.         var
  492.             l: longint;
  493.             p: Ptr;
  494.             oe: OSErr;
  495.     begin
  496.         oe := ValidateConnection(connection);
  497.         if oe = noErr then begin
  498.             if readCount < 0 then begin
  499.                 oe := invalidLengthErr;
  500.             end
  501.             else if readCount > 0 then begin
  502.                 p := returnPtr;
  503.                 with connection^ do begin
  504.                     if incomingSize > 0 then begin
  505.             { Read as much as there is or as much as we need, whichever is less. }
  506.                         if readCount < incomingSize then begin
  507.                             l := readCount;
  508.                         end else begin
  509.                             l := incomingSize;
  510.                         end;
  511.                         BlockMoveData(incomingPtr, p, l);
  512.                         incomingPtr := Ptr(ord4(incomingPtr) + l);
  513.                         incomingSize := incomingSize - l;
  514.                         p := Ptr(ord4(p) + l);
  515.                         readCount := readCount - l;
  516.                     end;
  517.                 end;
  518.                 { If there's more needed, then read it from the connection. }
  519.                 if readCount > 0 then begin
  520.                         { Issue a read and wait until it all arrives). }
  521.                     oe := TCPRawReceiveChars(connection, p, readCount);
  522.                 end;
  523.             end;
  524.         end;
  525.         TCPReceiveChars := oe;
  526.     end;
  527.  
  528.     function TCPReadByte (connection: TCPConnectionPtr; timeout: longint; var b: SignedByte): OSErr;
  529.         { Return the next byte in the buffer, reading more in if necessary. }
  530.         var
  531.             waitUntil: longint;
  532.             readIn: longint;
  533.             oe: OSErr;
  534.     begin
  535.         oe := ValidateConnection(connection);
  536.         if oe = noErr then begin
  537.             with connection^ do begin            { Check if we need to read in more bytes. }
  538.                 if incomingSize = 0 then begin
  539.                     if (timeout = 0) and (TCPCharsAvailable(connection) = 0) then begin
  540.                         oe := commandTimeoutErr;
  541.                     end
  542.                     else begin
  543.                         waitUntil := TickCount + timeout;
  544.     { keep on trying to read until we get at least one, or the time-out happens. }
  545.                         while (oe = noErr) and (incomingSize = 0) do begin                { Get the status. }
  546.                             readIn := TCPCharsAvailable(connection);    { If there's something there to read, do so. }
  547.                             if readIn > 0 then begin    { Don't read any more than will fit in the buffer. }
  548.                                 if readIn > INCOMINGBUFSIZE then begin
  549.                                     readIn := INCOMINGBUFSIZE;
  550.                                 end;
  551.                         { Issue the read. }
  552.                                 oe := TCPRawReceiveChars(connection, @inBuf, readIn);
  553.                                 if oe = noErr then begin
  554.                                     incomingSize := readIn;
  555.                                     incomingPtr := @inBuf;
  556.                                 end;
  557.                             end        { If not, do another round or get out, depending on the timeout condition. }
  558.                             else if TickCount > waitUntil then begin
  559.                                 oe := commandTimeOutErr;
  560.                             end;
  561.                         end;
  562.                     end;
  563.                 end;
  564.                 { Get the byte to return. }
  565.                 if incomingSize > 0 then begin
  566.                     b := incomingPtr^;
  567.                     incomingPtr := Ptr(ord4(incomingPtr) + 1);
  568.                     incomingSize := incomingSize - 1;
  569.                 end else begin
  570.                     b := 0;
  571.                 end;
  572.             end;
  573.         end;
  574.         TCPReadByte := oe;
  575.     end;
  576.  
  577. { Pass in a block of memory (readPtr,readSize), already containing readPos bytes}
  578. { TCPReceiveUpTo will then read characters until a termChar character is reached,}
  579. { or until waitForChars ticks go by without receiving any bytes.  If waitForChars is}
  580. { zero, then TCPReceiveUpTo will return immediately.  }
  581.     function TCPReceiveUpTo (connection: TCPConnectionPtr; termChar: signedByte;{}
  582.                                     charTimeOut: longint; readPtr: ptr; readSize: longint; var readPos: longint;{}
  583.                                     var gottermchar: boolean): OSErr;
  584.         var
  585.             oe: OSErr;
  586.             inChar: SignedByte;
  587.             p: Ptr;
  588.     begin
  589.         oe := ValidateConnection(connection);
  590.         gottermchar := false;
  591.         if oe = noErr then begin
  592. { Cycle until the timeout happens or we see the termintor character or we run out of room. }
  593.             while (oe = noErr) and (readPos < readSize) and not gottermchar do begin            { Get the next character. }
  594.                 oe := TCPReadByte(connection, charTimeOut, inChar);                    { Ignore the character if it's a zero. }
  595.                 if (oe = noErr) then begin            { Put it in the result. }
  596.                     p := Ptr(ord4(readPtr) + readPos);
  597.                     p^ := inChar;
  598.                     readPos := readPos + 1;
  599.                     gottermchar := inChar = termChar;
  600.                 end;
  601.             end;
  602.             if oe = commandTimeOutErr then begin
  603.                 oe := noErr;
  604.             end;
  605.         end;
  606.         TCPReceiveUpTo := oe;
  607.     end;
  608.  
  609.     function TCPSend (connection: TCPConnectionPtr; writePtr: ptr; writeCount: integer; push: boolean): OSErr;
  610.         var
  611.             wds: wdsType;
  612.             oe: OSErr;
  613.             cb: TCPControlBlock;
  614.     begin
  615.         oe := ValidateConnection(connection);
  616.         if oe = nOErr then begin
  617.             if writeCount > 0 then begin
  618.                 wds.buffer := writePtr;
  619.                 wds.size := writeCount;
  620.                 wds.term := 0;
  621.                 ZotBlocks;
  622.                 ZeroCB(cb, connection^.stream, TCPcsSend);
  623.                 cb.send.wds := @wds;
  624.                 cb.send.pushFlag := ord(push);
  625.                 oe := PBControlSync(@cb);
  626.             end
  627.             else if writeCount < 0 then begin
  628.                 oe := InvalidLengthErr;
  629.             end;
  630.         end;
  631.         TCPSend := oe;
  632.     end;
  633.  
  634.     procedure TCPSendComplete (cbp: MyControlBlockPtr);
  635.         var
  636.             oe: OSErr;
  637.     begin
  638.         AddBlock(cbp^.tcp.send.wds);
  639.         with cbp^.tcpc^ do begin
  640.             asendcompletes := asendcompletes + 1;
  641.             if (asendcompletes = asends) and closedone then begin
  642.                 oe := GetCB(cbp, cbp^.tcpc, TCPcsClose, closeuserptr, nil);
  643. { GetCB won't NewPtr because the completion has just released a block }
  644.                 if oe = noErr then begin
  645.                     oe := MyPBControlAsync(cbp);
  646.                 end;
  647.             end;
  648.         end;
  649.     end;
  650.  
  651.     function TCPSendAsync (connection: TCPConnectionPtr; writePtr: ptr; writeCount: integer; push: boolean; userptr: OSErrPtr): OSErr;
  652.         type
  653.             myblock = record
  654.                     wds: wdsType;
  655.                     data: array[0..100] of byte;
  656.                 end;
  657.             myblockptr = ^myblock;
  658.         var
  659.             oe: OSErr;
  660.             cbp: MyControlBlockPtr;
  661.             p: myblockptr;
  662.     begin
  663.         oe := ValidateConnection(connection);
  664.         if oe = nOErr then begin
  665.             if writeCount > 0 then begin
  666.                 oe := MNewPtr(p, writeCount + SizeOf(wdsType));
  667.                 if oe = noErr then begin
  668.                     p^.wds.buffer := @p^.data;
  669.                     p^.wds.size := writeCount;
  670.                     p^.wds.term := 0;
  671.                     with p^.wds do begin
  672.                         BlockMoveData(writePtr, buffer, size);
  673.                     end;
  674.                     oe := GetCB(cbp, connection, TCPcsSend, userptr, gTCPSendCompleteProc);
  675.                     cbp^.tcp.send.wds := POINTER(p);
  676.                     cbp^.tcp.send.pushFlag := ord(push);
  677.                     with connection^ do begin
  678.                         asends := asends + 1;
  679.                     end;
  680.                     oe := MyPBControlAsync(cbp);
  681.                     if oe <> noErr then begin
  682.                         MDisposePtr(p);
  683.                     end;
  684.                 end;
  685.             end
  686.             else if writeCount < 0 then begin
  687.                 oe := InvalidLengthErr;
  688.             end;
  689.         end;
  690.         TCPSendAsync := oe;
  691.     end;
  692.  
  693.     function TCPClose (connection: TCPConnectionPtr; userptr: OSErrPtr): OSErr;
  694.         var
  695.             oe: OSErr;
  696.             cbp: MyControlBlockPtr;
  697.     begin
  698.         oe := ValidateConnection(connection);
  699.         if oe = noErr then begin
  700.             with connection^ do begin
  701.                 if closedone then begin
  702.                     if userptr <> nil then begin
  703.                         userptr^ := noErr;
  704.                     end;
  705.                 end else begin
  706.                     closeuserptr := userptr;
  707.                     if userptr <> nil then begin
  708.                         userptr^ := inProgress;
  709.                     end;
  710.                     closedone := true;
  711.                     if asends = asendcompletes then begin
  712.                         ZotBlocks;
  713.                         oe := GetCB(cbp, connection, TCPcsClose, userptr, nil);
  714.                         if oe = noErr then begin
  715.                             oe := MyPBControlAsync(cbp);
  716.                         end;
  717.                     end;
  718.                 end;
  719.             end;
  720.         end;
  721.         SetUserPtr(userptr, oe);
  722.         TCPClose := oe;
  723.     end;
  724.  
  725.     function TCPAbort (connection: TCPConnectionPtr): OSErr;
  726.         var
  727.             oe: OSErr;
  728.             cb: TCPControlBlock;
  729.     begin
  730.         oe := ValidateConnection(connection);
  731.         if oe = noErr then begin
  732.             ZotBlocks;
  733.             ZeroCB(cb, connection^.stream, TCPcsAbort);
  734.             oe := PBControlSync(@cb);
  735.         end;
  736.         TCPAbort := oe;
  737.     end;
  738.  
  739. { Release the TCP stream, including the buffer.}
  740.     function TCPRelease (var connection: TCPConnectionPtr): OSErr;
  741.         var
  742.             oe: OSErr;
  743.     begin
  744.         oe := noErr;
  745.         oe := ValidateConnection(connection);
  746.         if oe = noErr then begin
  747.             ZotBlocks;
  748.             oe := MTTCPRelease(connection^.stream);
  749.             DestroyConnection(connection);
  750.         end;
  751.         TCPRelease := oe;
  752.     end;
  753.  
  754. {    TCPRawState(connectionID) -- Return the state of the TCP connection.}
  755.     procedure TCPRawState (connection: TCPConnectionPtr; var state: integer; var localhost: longint; var localport: integer; var remotehost: longint; var remoteport: integer; var available: longint);
  756.         var
  757.             cb: TCPControlBlock;
  758.             oe: OSErr;
  759.     begin
  760.         localhost := 0;
  761.         localport := 0;
  762.         remotehost := 0;
  763.         remoteport := 0;
  764.         available := 0;
  765.  
  766.         oe := ValidateConnection(connection);
  767.         if oe <> noErr then begin
  768.             state := 99; { Error -> Closed }
  769.         end
  770.         else begin
  771.             ZotBlocks;
  772.             ZeroCB(cb, connection^.stream, TCPcsStatus);
  773.             oe := PBControlSync(@cb);
  774.             if oe <> noErr then begin
  775.                 state := 99; { Closed }
  776.             end
  777.             else begin
  778.                 state := cb.status.connectionState;
  779.                 connection^.laststate := state;
  780.                 localhost := cb.status.localhost;
  781.                 localport := cb.status.localport;
  782.                 remotehost := cb.status.remotehost;
  783.                 remoteport := cb.status.remoteport;
  784.                 available := cb.status.amtUnreadData + connection^.incomingSize;
  785.             end;
  786.         end;
  787.     end;
  788.  
  789. { Return the state of the TCP connection.}
  790.     function TCPState (connection: TCPConnectionPtr): TCPStateType;
  791.         var
  792.             state: integer;
  793.             localhost: longint;
  794.             localport: integer;
  795.             remotehost: longint;
  796.             remoteport: integer;
  797.             available: longint;
  798.     begin
  799.         TCPRawState(connection, state, localhost, localport, remotehost, remoteport, available);
  800.         case state of
  801.             0: 
  802.                 TCPState := T_Closed;
  803.             2: 
  804.                 TCPState := T_Listening;
  805.             4, 6: 
  806.                 TCPState := T_Opening;
  807.             8: 
  808.                 TCPState := T_Established;
  809.             10, 12, 16, 18, 20: 
  810.                 TCPState := T_Closing;
  811.             14: 
  812.                 TCPState := T_PleaseClose;
  813.             98: 
  814.                 TCPState := T_WaitingForOpen;
  815.             99: 
  816.                 TCPState := T_Closed;
  817.             otherwise
  818.                 TCPState := T_Unknown;
  819.         end;
  820.     end;
  821.  
  822. {    Return the number of characters available for reading from the TCP connection.}
  823.     function TCPCharsAvailable (connection: TCPConnectionPtr): longint;
  824.         var
  825.             state: integer;
  826.             localhost: longint;
  827.             localport: integer;
  828.             remotehost: longint;
  829.             remoteport: integer;
  830.             available: longint;
  831.     begin
  832.         TCPRawState(connection, state, localhost, localport, remotehost, remoteport, available);
  833.         TCPCharsAvailable := available;
  834.     end;
  835.  
  836.     function TCPLocalPort (connection: TCPConnectionPtr): integer;
  837.         var
  838.             state: integer;
  839.             localhost: longint;
  840.             localport: integer;
  841.             remotehost: longint;
  842.             remoteport: integer;
  843.             available: longint;
  844.     begin
  845.         TCPRawState(connection, state, localhost, localport, remotehost, remoteport, available);
  846.         TCPLocalPort := localport;
  847.     end;
  848.  
  849.     function TCPRemoteIP (connection: TCPConnectionPtr): IPAddr;
  850.         var
  851.             state: integer;
  852.             localhost: longint;
  853.             localport: integer;
  854.             remotehost: longint;
  855.             remoteport: integer;
  856.             available: longint;
  857.     begin
  858.         TCPRawState(connection, state, localhost, localport, remotehost, remoteport, available);
  859.         TCPRemoteIP := remotehost;
  860.     end;
  861.  
  862.     function TCPFlush (connection: TCPConnectionptr): OSErr;
  863.         var
  864.             buffer: array[0..255] of signedByte;
  865.             f: longint;
  866.             oe: OSErr;
  867.     begin
  868.         f := TCPCharsAvailable(connection);
  869.         oe := noErr;
  870.         while (f > 0) and (oe = noErr) do begin
  871.             if f > 256 then begin
  872.                 f := 256;
  873.             end;
  874.             oe := TCPReceiveChars(connection, @buffer, f);
  875.             if oe = noErr then begin
  876.                 f := TCPCharsAvailable(connection);
  877.             end;
  878.         end;
  879.         TCPFlush := oe;
  880.     end;
  881.  
  882.     procedure UDPZeroCB (var cb: UDPControlBlock; stream: StreamPtr; call: integer);
  883.     begin
  884.         MZero(@cb, SizeOf(cb));
  885.         cb.udpStream := stream;
  886.         cb.ioCRefNum := mactcp_driver_refnum;
  887.         cb.csCode := call;
  888.     end;
  889.  
  890.     procedure MyNotify (stream: streamPtr; eventCode: integer; connection: UDPConnectionPtr; icmpMsg: ptr);
  891.     begin
  892.         stream := stream; { UNUSED! }
  893.         icmpMsg := icmpMsg; { UNUSED! }
  894.         if eventCode = UDPDataArrival then begin
  895.             if connection^.magic = UDPMagic then begin
  896.                 connection^.outstanding := connection^.outstanding + 1;
  897.             end;
  898.         end;
  899.     end;
  900.  
  901.     function UDPCreate (var connection: UDPConnectionPtr; buffer_size: longint; var localport: integer): OSErr;
  902.         var
  903.             oe: OSErr;
  904.             cb: UDPControlBlock;
  905.     begin
  906.         buffer_size := GetBufferSize(0, buffer_size, false);
  907.         oe := MNewPtr(connection, SizeOf(UDPConnectionRecord) + buffer_size);
  908.         if oe = noErr then begin
  909.             connection^.magic := UDPMagic;
  910.             UDPZeroCB(cb, nil, UDPcsCreate);
  911.             cb.create.rcvBuff := ptr(longint(connection) + SizeOf(UDPConnectionRecord));
  912.             cb.create.rcvBuffLen := buffer_size;
  913.             cb.create.notifyProc := gMyNotifyProc;
  914.             cb.create.userDataPtr := ptr(connection);
  915.             cb.create.localport := localport;
  916.             oe := PBControlSync(@cb);
  917.             localport := cb.create.localport;
  918.             connection^.stream := cb.udpStream;
  919.             connection^.outstanding := 0;
  920.         end;
  921.         UDPCreate := oe;
  922.     end;
  923.  
  924.     function UDPRead (connection: UDPConnectionPtr; timeout: integer; var remoteIP: longint; var remoteport: integer;{}
  925.                                     var datap: ptr; var datalen: integer): OSErr;
  926.         var
  927.             oe: OSErr;
  928.             cb: UDPControlBlock;
  929.     begin
  930.         UDPZeroCB(cb, connection^.stream, UDPcsRead);
  931.         cb.receive.timeout := timeout;
  932.         oe := PBControlSync(@cb);
  933.         if oe = noErr then begin
  934.             connection^.outstanding := connection^.outstanding - 1;
  935.         end;
  936.         remoteIP := cb.receive.remoteIP;
  937.         remoteport := cb.receive.remoteport;
  938.         datap := cb.receive.rcvBuff;
  939.         datalen := cb.receive.rcvBuffLen;
  940.         UDPRead := oe;
  941.     end;
  942.  
  943.     function UDPReturnBuffer (connection: UDPConnectionPtr; datap: ptr): OSErr;
  944.         var
  945.             oe: OSErr;
  946.             cb: UDPControlBlock;
  947.     begin
  948.         UDPZeroCB(cb, connection^.stream, UDPcsBfrReturn);
  949.         cb.return.rcvBuff := datap;
  950.         oe := PBControlSync(@cb);
  951.         UDPReturnBuffer := oe;
  952.     end;
  953.  
  954.     function UDPDatagramsAvailable (connection: UDPConnectionPtr): integer;
  955.     begin
  956.         UDPDatagramsAvailable := connection^.outstanding;
  957.     end;
  958.  
  959.     function UDPWrite (connection: UDPConnectionPtr; remoteIP: longint; remoteport: integer;{}
  960.                                     datap: ptr; datalen: integer; checksum: boolean): OSErr;
  961.         var
  962.             oe: OSErr;
  963.             cb: UDPControlBlock;
  964.             wds: wdsType;
  965.     begin
  966.         UDPZeroCB(cb, connection^.stream, UDPcsWrite);
  967.         cb.send.remoteIP := remoteIP;
  968.         cb.send.remotePort := remoteport;
  969.         wds.size := datalen;
  970.         wds.buffer := datap;
  971.         wds.term := 0;
  972.         cb.send.wds := @wds;
  973.         cb.send.checksum := ord(checksum);
  974.         oe := PBControlSync(@cb);
  975.         UDPWrite := oe;
  976.     end;
  977.  
  978.     function UDPRelease (var connection: UDPConnectionPtr): OSErr;
  979.         var
  980.             oe: OSErr;
  981.             cb: UDPControlBlock;
  982.     begin
  983.         UDPZeroCB(cb, connection^.stream, UDPcsRelease);
  984.         oe := PBControlSync(@cb);
  985.         connection^.magic := UDPBad;
  986.         MDisposePtr(connection);
  987.         UDPRelease := oe;
  988.     end;
  989.  
  990.     function UDPMTU (remoteIP: longint; var mtu: longint): OSErr;
  991.         var
  992.             oe: OSErr;
  993.             cb: UDPControlBlock;
  994.     begin
  995.         UDPZeroCB(cb, nil, UDPcsMaxMTUSize);
  996.         cb.mtu.remoteIP := remoteIP;
  997.         oe := PBControlSync(@cb);
  998.         mtu := BAND(cb.mtu.mtuSize, $FFFF);
  999.         UDPMTU := oe;
  1000.     end;
  1001.  
  1002.     procedure IPZeroCB (var cb: IPControlBlock; call: integer);
  1003.     { Zero out the control block parameters. }
  1004.     begin
  1005.         MZero(@cb, SizeOf(cb));
  1006.         cb.ioCRefNum := mactcp_driver_refnum;
  1007.         cb.csCode := call;
  1008.     end;
  1009.  
  1010.     procedure IPCallCompletion (cbp: IPControlBlockPtr; userdata, extradata: ptr; addr: UniversalProcPtr);
  1011.     begin
  1012.         CallPascal0444(cbp,userdata,extradata,addr);
  1013.     end;
  1014.  
  1015.     procedure IPICMPCompletionPascal (cbp: IPControlBlockPtr);
  1016.         var
  1017.             index: integer;
  1018.     begin
  1019. {        DebugStr('IPICMPCompletionPascal'); }
  1020.         icmp_got_back := icmp_got_back + 1;
  1021.         with cbp^.echoinfo do begin
  1022.             index := ord(userDataPtr);
  1023.             if (index > 0) & (icmp_data_array[index].complete <> nil) then begin
  1024.                 IPCallCompletion(cbp, icmp_data_array[index].userdata, icmp_data_array[index].extradata, icmp_data_array[index].complete);
  1025.                 icmp_data_array[index].complete := nil;
  1026.             end;
  1027.         end;
  1028.     end;
  1029.  
  1030. {$IFC GENERATINGPOWERPC}
  1031.     procedure IPICMPCompletion(cbp: IPControlBlockPtr);
  1032.     begin
  1033.         IPICMPCompletionPascal(cbp);
  1034.     end;
  1035. {$ELSEC}
  1036.     procedure IPICMPCompletion;
  1037.     begin
  1038.         IPICMPCompletionPascal(IPControlBlockPtr(GetStackFrame^.paramblockptr));
  1039.     end;
  1040. {$ENDC}
  1041.  
  1042.     function IPSendICMPEcho (remotehost: ipAddr; timeout: integer; datap: ptr; datalen: integer; complete: ProcPtr; userdata: univ ptr; extradata: univ ptr): OSErr;
  1043.         var
  1044.             cb: IPControlBlock;
  1045.             i, index: integer;
  1046.             oe: OSErr;
  1047.     begin
  1048. {        DebugStr('IPSendICMPEcho');}
  1049.         index := -1;
  1050.         if complete <> nil then begin
  1051.             for i := 1 to max_ICMPDataArray do begin
  1052.                 if icmp_data_array[i].complete = nil then begin
  1053.                     index := i;
  1054.                     icmp_data_array[i].complete := complete;
  1055.                     icmp_data_array[i].userdata := userdata;
  1056.                     icmp_data_array[i].extradata := extradata;
  1057.                     leave;
  1058.                 end;
  1059.             end;
  1060.         end;
  1061.         IPZeroCB(cb, TCPcsEchoICMP);
  1062.         cb.echo.dest := remotehost;
  1063.         cb.echo.data.buffer := datap;
  1064.         cb.echo.data.size := datalen;
  1065.         cb.echo.timeout := timeout;
  1066.         cb.echo.options := nil;
  1067.         cb.echo.optlength := 0;
  1068.         cb.echo.icmpCompletion := gIPICMPCompletionProc;
  1069.         cb.echo.userDataPtr := ptr(ord4(index)); { Avoid tickling MW bug }
  1070.         oe := PBControlSync(@cb);
  1071.         if oe = noErr then begin
  1072.             icmp_sent_out := icmp_sent_out + 1;
  1073.         end;
  1074.         IPSendICMPEcho := oe;
  1075.     end;
  1076.  
  1077.     function IPGetMyIPAddr (var myIP: longint): OSErr;
  1078.         var
  1079.             cb: IPControlBlock;
  1080.             oe: OSErr;
  1081.     begin
  1082.         IPZeroCB(cb, TCPcsGetMyIP);
  1083.         oe := PBControlSync(@cb);
  1084.         myIP := cb.getmyip.ourAddress;
  1085.         IPGetMyIPAddr := oe;
  1086.     end;
  1087.  
  1088.     function TCPInit: OSErr;
  1089.         var
  1090.             oe: OSErr;
  1091.             i: integer;
  1092.             junkl: longint;
  1093.     begin
  1094.         InitTCPUtils;
  1095.         gTCPPreCompletionProc := NewProc(@TCPPreCompletion, uppC04ProcInfo);
  1096.         gDoIOCompletionProc := NewProc(@DoIOCompletion, uppC04ProcInfo);
  1097.         gIPICMPCompletionProc := NewProc(@IPICMPCompletion, uppC04ProcInfo);
  1098.         gTCPSendCompleteProc := NewProc(@TCPSendComplete,uppPascal04ProcInfo);
  1099.         gMyNotifyProc := NewProc(@MyNotify,uppPascal04244ProcInfo);
  1100.         oe := OpenDriver('.IPP', mactcp_driver_refnum);
  1101.         for i := 1 to control_block_max do begin
  1102.             controlblocks[i] := nil;
  1103.         end;
  1104.         for i := 1 to max_ICMPDataArray do begin
  1105.             icmp_data_array[i].complete := nil;
  1106.         end;
  1107.         largest_mtu := 576;
  1108.         largest_minimum_tcp_buffer_size := 4096;
  1109.         if oe = noErr then begin
  1110.             junkl := GetMinimumBufferSize(0, true);
  1111.         end;
  1112.         TCPInit := oe;
  1113.     end;
  1114.  
  1115.     procedure TCPFinish;
  1116.         var
  1117.             i: integer;
  1118.     begin
  1119.         for i := 1 to control_block_max do begin
  1120.             if controlblocks[i] <> nil then begin
  1121.                 MDisposePtr(controlblocks[i]);
  1122.             end;
  1123.         end;
  1124.     end;
  1125.  
  1126. end.
  1127.