program MacTjaapHTTPD10;

{ From Peter's PNL Libraries }
{ Copyright 1992 Peter N Lewis }
{ This source may be used for any non-commercial purposes as long as I get a mention }
{ in the About box and Docs of any derivative program.  It may not be used in any commercial }
{ application without my permission }

uses
 TCPTypes, TCPStuff, TCPConnections;



const
 header = 'HTTP/1.1 200 OK';
 headerserver = 'Server: MacTjaapHTTPD/0.1';
 headerdate = 'Date: Fri, 25 Oct 2013 23:54:00';
 headerconnection = 'Connection: close';
 headerlast = 'Last-Modified: Fri, 20 Apr 1962 01:30:00';
 headercontent = 'Content-Type: text/html';

 html = 'This is the welcome page of a MacTjaapHTTPD server for Macintosh.
';
 html2 = 'It is based on TCPExample from Peter N Lewis, copyright 1992

';
 html3 = '

On this page is not much, but I will provide a link to the post in the 68kMLA forum:
';
 html4 = 'click here';

 dest_name = 'www.apache.org';
 nul = chr(0);
 lf = chr(10);
 cr = chr(13);
 localport = 80;
 remotehost = 0;
 remoteport = 0;
 dataptr = 0;



var
 oe: OSErr;
 cp: connectionIndex;
 quitNow: boolean;
 cer: connectionEventRecord; { Event record for TCP events, simmilar to EventRecord }
 s: str255;
 t: str255;
 u: str255;
 v: str255;

 count: longInt;
 gotlinefeed: boolean;
begin
ShowText;
quitNow := false;
oe := InitConnections; { Startup the TCP units }
if oe = noErr then begin
 oe := FindAddress(cp, dest_name, nil);
 if oe = noErr then begin
  count := 0;
  while not quitNow do begin
   if GetConnectionEvent(any_connection, cer) then begin { Get the next TCP event }
    case cer.event of
     C_Found:  begin






{function NewPassiveConnection (var cp: connectionIndex; buffersize: longInt; localport: integer; remotehost: longInt; remoteport: integer; dataptr: univ ptr): OSErr;}

      oe := NewPassiveConnection(cp, Default_TCPBUFFERSIZE, localport, remotehost, remoteport, nil);





     end;
     C_SearchFailed:  begin
      writeln('Couldn''t fine the address for ', dest_name);
      quitNow := true;
     end;
     C_Established:  begin { Happens once per succesful connection establishment }
      writeln('Connection Established');

      s := concat(header, cr, lf, headerserver, cr, lf, headerdate, cr, lf, headerlast, cr, lf, headercontent, cr, lf, cr, lf, html, cr, lf);
      t := concat(html2, cr, lf);
      u := concat(html3, cr, lf);
      v := concat(html4, cr, lf);

      oe := TCPSend(cer.tcpc, @s[1], length(s), true);
      oe := TCPSend(cer.tcpc, @t[1], length(t), true);
      oe := TCPSend(cer.tcpc, @u[1], length(u), true);
      oe := TCPSend(cer.tcpc, @v[1], length(v), true);

                           {to let the browser know that the page is sendI close the connection}
                           {function TCPClose (connection: TCPConnectionPtr; userptr: OSErrPtr): OSErr;}
      CloseConnection(cer.connection); { Close our side of the connection }



      if oe <> noErr then
      CloseConnection(cp); { Better close the connection if we can't send anything to it! }
     end;
     C_FailedToOpen: 
      writeln('Ooops, connection failed to open... Error is ', cer.value, ' Timed out is ', cer.timedout);
{ Example, network unreachable etc.  Error code is in cer.value }
     C_Closing:  begin
      writeln('Connection closing');{ Gets called when the connection starts closing down}
      CloseConnection(cer.connection); { Close our side of the connection }
     end;
     C_Closed:  begin
      writeln('Connection closed, quit now');
      quitNow := true; { The connection is closed, quit the program }
     end;
     C_CharsAvailable:  begin
{$PUSH}
{$R-}
      oe := TCPReceiveUpTo(cer.tcpc, 10, 60, @s[1], 255, count, gotlinefeed);
{ Recieve characters up to a line feed }
      if (count > 0) & (s[count] = lf) then { strip off linefeed }
      count := count - 1;
      if (count > 0) & (s[count] = cr) then { strip off cr }
      count := count - 1;
      s[0] := chr(count);
{$POP}
      if gotlinefeed then begin { if we got a linefeed, print the string, otherwise go round again and wait for more characters }
      writeln(s);
      count := 0;
      end;
     end;
    end;
   end;
  end;
 end;
 FinishEverything; { Close everything, clean up }
{ ALWAY CALL THIS, OR YOU WILL BE SORRY! }
end;
writeln('Click to quit');
while not Button do
 ;
end.