The sample for 'access' from the manual drives me crazy.
http://www.freepascal.org/docs-html/rtl/sockets/fpaccept.html
S:=fpSocket (AF_INET,SOCK_STREAM,0);
if SocketError<>0 then
(* ERROR! SHOULD BE "IF S = -1" *)
(* (SocketError can be 25 while S is <> -1, and this signals success) *)
if fpBind(S,@SAddr,sizeof(saddr))=-1 then
(* ERROR! Incompatible types: got "^sockaddr_in" expected "psockaddr" *)
if Accept(S,FromName,Sin,Sout) then
(* WARNING: Accept is deprecated *)
(* ERROR: fromname contains nonsense characters *)
PError ('Server : Accept : '+fromname);
(* ERROR: should bei "writeln" instead of "PError" *)
When I fix the errors and try work around the Warning with this:
slen := sizeof(saddr);
fpAccept (S, @SAddr, @slen);
FromName := NetAddrToStr(SAddr.sin_addr);
Sock2Text(S,Sin,Sout);
reset (Sin);
rwrite (Sout);
then reset (Sin) crashes or hangs, and it also triggers a deprecated
warning.
Here is my version of it. It works only in Linux, but at least it works:
{$mode fpc}
{$I+,O+,R+,T+} { check io, overflow, range, stack }
uses
unixtype, Sockets, baseunix;
Var
FromName : string;
Buffer : shortstring;
S : Longint;
Sin,Sout : Text;
SAddr : sockaddr;
slen : SockLen_t;
filedescr: cint;
numread : TsSize;
procedure perror (const S:string);
begin
writeln (S,SocketError);
halt(100);
end;
begin
S:=fpSocket (AF_INET,SOCK_STREAM,0);
if S = -1 then
Perror ('Server : Socket : ');
SAddr.sin_family:=AF_INET;
SAddr.sin_port:=htons(5000);
SAddr.sin_addr.s_addr:=0;
if fpBind(S,@SAddr,sizeof(saddr))=-1 then
PError ('Server : Bind : ');
if fpListen (S,1)=-1 then
PError ('Server : Listen : ');
Writeln('Waiting for Connect from Client');
slen := sizeof(saddr);
filedescr := fpaccept(S, @SAddr, @slen);
if filedescr = -1 then
PError ('Server : Accept : ');
{ ### should verify that SAddr.sin_family is AF_INET }
FromName := NetAddrToStr(SAddr.sin_addr);
writeln ('Connect from ',FromName);
numread := fpread (filedescr, buffer[1], sizeof(buffer)-1);
if numread <> -1 then begin
buffer[0] := chr(numread);
write (buffer);
end;
end.
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
