(*@\\\0000000D01*)
(*@/// procedure t_tcpip.close_socket(var socket:TSocket); *)
procedure t_tcpip.close_socket(var socket:TSocket);
begin
if socket<>INVALID_SOCKET then begin
Winsock.CloseSocket(socket);
if assigned(f_tracer) then
f_tracer('Closed socket ID '+inttostr(socket),tt_socket);
socket:=INVALID_SOCKET;
end;
end;
(*@\\\0000000501*)
(*@/// procedure t_tcpip.close_socket_linger(var socket:TSocket); *)
procedure t_tcpip.close_socket_linger(var socket:TSocket);
var
linger: TLinger;
begin
if socket<>INVALID_SOCKET then begin
linger.l_onoff:=1;
linger.l_linger:=fingerd_timeout;
winsock.setsockopt(socket,sol_socket,SO_LINGER,PChar(@linger),sizeof(linger));
winsock.shutdown(socket,1);
close_socket(socket);
socket:=INVALID_SOCKET;
end;
end;
(*@\\\0000000842*)
(*@/// function t_tcpip.Socket_by_name(const service:string):smallint; *)
function t_tcpip.Socket_by_name(const service:string):smallint;
var
service_entry : PServEnt;
s: string;
begin
s:=service+#0;
(*$ifdef ver80 *)
service_entry:=Winsock.GetServByName(pchar(@s[1]),'tcp');
(*$else *)
(*$ifopt h- *)
service_entry:=Winsock.GetServByName(pchar(@s[1]),'tcp');
(*$else *)
service_entry:=Winsock.GetServByName(pchar(s),'tcp');
(*$endif *)
(*$endif *)
if service_entry=nil then
result:=0
else
result:=winsock.htons(service_entry^.s_port);
end;
(*@\\\0000000E02*)
(*@/// procedure t_tcpip.Login; *)
procedure t_tcpip.Login;
begin
if f_logged_in then logout;
ip_address:=lookup_hostname(f_hostname);
if ip_address=INVALID_IP_ADDRESS then
raise ETcpIpError.Create('Couldn''t resolve hostname '+f_hostname);
open_socket_out(f_socket,f_Socket_number,ip_address);
if f_socket=INVALID_SOCKET then
raise ESocketError.Create(WSAGetLastError);
f_eof:=false;
f_logged_in:=true;
end;
(*@\\\0000000315*)
(*@/// procedure t_tcpip.LogOut; *)
procedure t_tcpip.LogOut;
begin
close_socket(f_socket);
f_socket:=invalid_socket;
f_logged_in:=false;
end;
(*@\\\0000000501*)
(*@/// procedure t_tcpip.SendCommand(const s:string); *)
procedure t_tcpip.SendCommand(const s:string);
begin
self.write_s(f_socket,s+#13#10);
if assigned(f_tracer) then
f_tracer(s,tt_proto_sent);
end;
(*@\\\0000000301*)
(*@/// function t_tcpip.eof(f_socket:TSocket):boolean; !!! *)
function t_tcpip.eof(f_socket:TSocket):boolean;
begin
eof:=f_eof or (socket_state(f_socket)<>connected);
end;
(*@\\\0000000114*)
(*@/// procedure t_tcpip.read_var(f_socket:TSocket; var buf; size:integer; var _ok:integer); *)
procedure t_tcpip.read_var(f_socket:TSocket; var buf; size:integer; var _ok:integer);
var
temp_buf: pointer;
error: integer;
begin
temp_buf:=NIL;
try
if @buf=NIL then
getmem(temp_buf,size) (* alloc for the -> /dev/null *)
else
temp_buf:=@buf;
repeat
_ok:=Winsock.recv(F_Socket,temp_Buf^,Size,0);
if _ok<=0 then begin
error:=Winsock.WSAGetLastError;
(* listening socket is always non-blocking, but this causes
problems with the recv command *)
if error=wsaewouldblock then begin
if f_async then begin
f_newdata:=false;
while not f_newdata do
Application.ProcessMessages;
end;
end;
f_eof:=error<>wsaewouldblock;
end
else
if assigned(f_tracer) then
f_tracer('Received '+inttostr(_ok)+' bytes on socket ID '+
inttostr(f_socket),tt_socket);
until f_eof or (_ok>0);
finally
if @buf=NIL then
freemem(temp_buf,size)
end;
end;
(*@\\\0000000601*)
(*@/// function t_tcpip.read_line(f_socket:TSocket):string; *)
function t_tcpip.read_line(f_socket:TSocket):string;
var
x: char;
ok: integer;
s: string;
begin
s:='';
repeat
read_var(f_socket,x,1,ok);
if x=#13 then (* at least NCSA 1.3 does send a #10 only *)
else if x=#10 then begin
result:=s;
EXIT;
end
else begin
s:=s+x;
end;
until eof(f_socket);
end;
(*@\\\*)
(*@/// procedure t_tcpip.write_buf(f_socket:TSocket; const buf; size:integer); *)
procedure t_tcpip.write_buf(f_socket:TSocket; const buf; size:integer);
begin
if Winsock.Send(F_Socket,pointer(@buf)^,size,0)=SOCKET_ERROR then
EXIT (* Error writing *)
else
if assigned(f_tracer) then
f_tracer('Sent '+inttostr(size)+' bytes on socket ID '+
inttostr(f_socket),tt_socket);
end;
(*@\\\0000000801*)
(*@/// procedure t_tcpip.write_s(f_socket:TSocket; const s:string); *)
procedure t_tcpip.write_s(f_socket:TSocket; const s:string);
begin
(*$ifdef ver80 *)
write_buf(f_socket,pchar(@s[1])^,length(s));
(*$else *)
(*$ifopt h- *)
write_buf(f_socket,pchar(@s[1])^,length(s));
(*$else *)
write_buf(f_socket,pchar(s)^,length(s));
(*$endif *)
(*$endif *)
end;
(*@\\\0000000801*)
(*@/// procedure t_tcpip.SetStream(value:TStream); *)
procedure t_tcpip.SetStream(value:TStream);
begin
TMemoryStream(f_stream).LoadFromStream(value);
end;
(*@\\\0000000301*)
(*@/// procedure t_tcpip.action; *)
procedure t_tcpip.action;
var
p: pointer;
ok,ok2:integer;
begin
login;
TMemorystream(f_stream).clear;
while not eof(f_socket) do begin
read_var(f_socket,f_buffer^,buf_size,ok);
p:=f_buffer;
while ok>0 do begin (* just to be sure everything goes into the stream *)
ok2:=f_stream.write(p^,ok);
dec(ok,ok2);
p:=pointer(longint(p)+ok2);
end;
end;
f_stream.seek(0,0);
end;
(*@\\\0000000303*)
(*@\\\*)
{ Finger client and demon }
(*@/// class t_finger(t_tcpip) *)
(*@/// constructor t_finger.Create(Aowner:TComponent); *)
constructor t_finger.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_Socket_number:=IPPORT_FINGER; (* 79 *)
end;
(*@\\\0000000403*)
(*@/// procedure t_finger.action; *)
procedure t_finger.action;
var
p: pointer;
ok,ok2:integer;
s: string;
begin
login;
s:=f_user+#13#10;
write_s(f_socket,s);
TMemorystream(f_stream).clear;
while not eof(f_socket) do begin
read_var(f_socket,f_buffer^,buf_size,ok);
p:=f_buffer;
while ok>0 do begin (* just to be sure everything goes into the stream *)
ok2:=f_stream.write(p^,ok);
dec(ok,ok2);
p:=pointer(longint(p)+ok2);
end;
end;
f_stream.seek(0,0); (* set the stream back to start *)
logout;
end;
(*@\\\0000000D10*)
(*@\\\0000000301*)
(*@/// class t_fingerd(t_tcpip) *)
(*@/// constructor t_fingerd.Create(Aowner:TComponent); *)
constructor t_fingerd.Create(Aowner:TComponent);
begin
inherited create(AOwner);
f_Socket_number:=IPPORT_FINGER; (* 79 *)
f_answer:=TStringList.Create;
end;
