[fpc-pascal]Sockets

Sun Aug 18 12:27:54 CEST 2002

It is an old code. But it is very similar to BUG 1694. In my case, the
client was not a VB program, but the apache module mod_lisp. This module
open socket connection to another server to pass HTTP parameters from Apache
to another server (A Freepascal Program in my case :-) ).
I have done it in LISP and VB without any problem. I have tried with
FreePascal but fail to do it :-(

!!! Warning !!! Crappy test code ahead :-)
----------------------------------------------------------------------------
----
Uses Sockets;

Var
     lSock : LongInt;
     uSock : LongInt;
     sAddr : TInetSockAddr;

     lLen  : LongInt;
     sLine : String;

     SIn   : Text;
     SOut  : Text;

     AAA   : Boolean;

Procedure PError (Const S : String);

Begin
     Writeln (S, SocketError);
     Halt (100);
End;

Begin
     lSock:=Socket (AF_Inet, Sock_Stream, PF_Unspec);
     If SocketError<>0 Then PError ('Server : Socket : ');

     sAddr.Family:=AF_Inet;
     sAddr.Port  :=lo (3000) shl 8 or hi (3000);
     sAddr.Addr  :=(1 shl 24) or 127;

     If Not Bind (lSock, sAddr, SizeOf (sAddr)) Then PError ('Server : Bind
: ');
     If Not Listen (lSock, 1) Then PError ('Server : Listen : ');

     Repeat
          Writeln ('Accepting connection...');
          lLen :=SizeOf (sAddr);
          uSock:=Accept (lSock, sAddr, lLen);
          If SocketError<>0 Then PError ('Server : Accept : ');
          Writeln ('Connection accepted...');

          Sock2Text (USock, SIn, SOut); Write ('a');

          Reset (SIn); Write ('b');
          Rewrite (SOut); Write ('c');
          AAA:=False;
          While Not Eof (SIn) Do
          Begin
               ReadLn (SIn, sLine); write (sline, ';;');
               If AAA=True Then
               Begin
                    AAA:=False;
                    Writeln ('url = ', sLine);
               End;
               If sLine='url' Then AAA:=True;
               If sLine='end' Then Break;
          End;
          Write ('d');

          sLine:='<!DOCTYPE HTML PUBLIC "-//IETF//DTD
HTML//EN"><HTML><HEAD></HEAD><BODY><H1>mod_lisp 2.0b2</H1><P>This is a
constant html string sent by Apache + mod_lisp 2.0b2 + FreePascal +
Windows</P></BODY></HTML>';

          Writeln (SOut, 'Status');
          Writeln (SOut, '200 OK');
          Writeln (SOut, 'Content-Type');
          Writeln (SOut, 'text/html');
          Writeln (SOut, 'Content-Length');
          Writeln (SOut, Length (sLine)+2);
          Writeln (SOut, 'Keep-Socket');
          Writeln (SOut, '0');
          writeln (SOut, 'end');
          Writeln (SOut, sLine);

          Close (Sin);
          Close (SOut);

          ShutDown (uSock, 2);
     Until False;
End.
----------------------------------------------------------------------------
----
  -----Message d'origine-----
  De : fpc-pascal-admin at deadlock.et.tudelft.nl
[mailto:fpc-pascal-admin at deadlock.et.tudelft.nl]De la part de Peter H.M.
Brooks
  Envoyé : dimanche 18 août 2002 00:31
  À : fpc-pascal at deadlock.et.tudelft.nl
  Objet : Re: [fpc-pascal]Sockets

    ----- Original Message -----
    From: Thierry Cabuzel
    To: fpc-pascal at deadlock.et.tudelft.nl
    Sent: Sunday, August 18, 2002 12:19 AM
    Subject: RE: [fpc-pascal]Sockets

    If someone have sothing like this I would be pleased too. I have already
tried to do something like this and fall. The client connect to the server,
send the first packet, close the connection, reopen another connection, and
send another packet. At this point the server only receive garbage :-(

  Do you have some code and a log?

  I am surprised, though that you close the connection. Surely, for the
duration of the conversation, you should hold the connection open - if you
are using TCP, that is. With UDP you would expect one packet per
conversation and it shouldn't matter if you close the connection (in fact
you don't have a connection end to end, only a local connection).

  Actually, maybe that is your problem (though the code would be needed to
know). With UDP you only send one packet and it is a connection less
conversation - it is up to the higher levels to establish a re-try or other
packet loss mechanism.

  It would be good to hear from somebody who has had both a TCP and a UDP
protocol working.

  Peter
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20020818/5e6f2c8d/attachment.html>