paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 07:47:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

Try several ports before failing

Browse Source
This commit is contained in:
Pierre Muller 2023-09-10 11:11:31 +00:00
parent b6b3cc88f8
commit 64a7bc13d6
1 changed files with 134 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

180
tests/tbs/tb0524.pp
View File

@ -4,8 +4,15 @@ program tb0524;
uses sockets,baseunix,sysutils;
const port=6667;
const default_port=6667;
textfile = 'tb0524.txt';
{$ifdef debug}
verbose = true;
{$else}
verbose = false;
{$endif}
var
used_port : word;
procedure reset_textfile;
var
@ -32,13 +39,43 @@ function server_failed : boolean;
var
f : text;
st : string;
retry : boolean;
begin
server_failed:=false;
assign(f,textfile);
reset(f);
readln(f,st);
if pos('Server startup failed',st)=1 then
server_failed:=true;
retry:=true;
while retry do
begin
reset(f);
readln(f,st);
if pos('Server startup failed',st)=1 then
begin
server_failed:=true;
exit;
end;
if pos('port=',st)=1 then
begin
val(copy(st,length('port=')+1,length(st)),used_port);
writeln('Server started at port ',used_port);
retry:=false;
end
else
begin
sleep(1000);
retry:=true;
end;
close(f);
end;
end;
procedure write_server_port(used_port : word);
var
f : text;
begin
assign(f,textfile);
rewrite(f);
writeln(f,'port=',used_port);
writeln('Using port ',used_port);
close(f);
end;
@ -50,7 +87,11 @@ var s,t:string;
len:longInt;
sin,sout:text;
i:byte;
port : word;
server_started : boolean;
attempt_count : longint;
const
max_attempt_count = 50;
begin
reset_textfile;
lsock:=fpsocket(af_inet,sock_stream,0);
@ -60,46 +101,84 @@ begin
stop(1);
end;
with saddr do
port:=default_port-1;
attempt_count:=0;
server_started:=false;
while (attempt_count<max_attempt_count) and not server_started do
begin
sin_family:=af_inet;
sin_port:=ntobe(word(6667));
sin_addr:=NoAddress;
end;
inc(port);
if verbose then
writeln('Trying to use port ',port,' to start the server');
inc(attempt_count);
with saddr do
begin
sin_family:=af_inet;
sin_port:=ntobe(port);
sin_addr:=NoAddress;
end;
if fpbind(lsock,@saddr,sizeof(saddr))<>0 then
begin
writeln('bind call error:',socketerror);
stop(1);
if fpbind(lsock,@saddr,sizeof(saddr))<>0 then
if attempt_count<max_attempt_count then
begin
writeln('bind call error:',socketerror);
continue;
end
else
begin
writeln('bind call error:',socketerror);
stop(1);
end;
if verbose then
writeln('fpbind OK for port ',port);
if fplisten(lsock,1)<>0 then
if attempt_count<max_attempt_count then
begin
writeln('listen call error:',socketerror);
continue;
end
else
begin
writeln('listen call error:',socketerror);
stop(1);
end;
if verbose then
writeln('fplisten OK for port ',port);
write_server_port(port);
server_started:=true;
len:=sizeof(saddr);
usock:=fpaccept(lsock,@saddr,@len);
if usock=-1 then
if attempt_count<max_attempt_count then
begin
writeln('accept call error:',SocketError);
continue;
end
else
begin
writeln('accept call error:',SocketError);
stop(1);
end;
if verbose then
writeln('fpaccept OK for port ',port);
sock2text(usock,sin,sout);
reset(sin);
rewrite(sout);
repeat
readln(sin,s);
t:='';
for i:=length(s) downto 1 do
t:=t+s[i];
writeln(sout,t);
until eof(sin);
close(sin);
close(sout);
fpshutdown(usock,2);
end;
if fplisten(lsock,1)<>0 then
begin
writeln('listen call error:',socketerror);
stop(1);
end;
len:=sizeof(saddr);
usock:=fpaccept(lsock,@saddr,@len);
if usock=-1 then
begin
writeln('accept call error:',SocketError);
stop(1);
end;
sock2text(usock,sin,sout);
reset(sin);
rewrite(sout);
repeat
readln(sin,s);
t:='';
for i:=length(s) downto 1 do
t:=t+s[i];
writeln(sout,t);
until eof(sin);
close(sin);
close(sout);
fpshutdown(usock,2);
if verbose then
writeln('Server at port ',port,' ending without error');
end;
procedure do_client;
@ -112,7 +191,7 @@ var s:sizeint;
begin
s:=fpsocket(af_inet,sock_stream,0);
saddr.sin_family:=af_inet;
saddr.sin_port:=htons(port);
saddr.sin_port:=htons(used_port);
saddr.sin_addr.s_addr:=hosttonet($7f000001); {127.0.0.1}
if not connect(s,saddr,sin,sout) then
begin
@ -122,17 +201,26 @@ begin
writeln(sout,'abcd');
readln(sin,str);
if str<>'dcba' then
halt(1);
begin
writeln('Expecting dcba, but got ',str);
halt(1);
end;
writeln(sout,'1234');
readln(sin,str);
if str<>'4321' then
halt(1);
begin
writeln('Expecting 4321, but got ',str);
halt(1);
end;
close(sin);
close(sout);
fpshutdown(s,2);
if verbose then
writeln('Client at port ',used_port,' ending without error');
end;
begin
used_port:=default_port;
if fpfork=0 then
do_server
else