proxy2.pas

httpanalyzer, source code for delphi

unit proxy2;

interface
uses classes, WSocket, winsock, SysUtils, mem_utils, SyncObjs;

const
 ProxyEngineVersion = 100;
 ProxyEngineCopyright = 'All rights reserved by Thorsten Schmidt';

type
 TConnection = ( connect2net, connect2sameproxy);

 TProxyClient = class;
 TProxyClientClass = class of TProxyClient;

 TProxyClientEvent = procedure(Sender : TObject;
                                msg : pchar) of object;

 TProxyClientData = function(Sender: TObject; runnr : integer; p : pointer; VAR s:longint): pointer of object;


 TProxyClient = class(TThread)    // entspricht redirect mit dest_* als ziel
 protected   // in anderer UNIT NICHT MEHR SICHTBAR!!!!!!!!!!!!
  del1,del2,del3,del4 : boolean;
  Proc_P1_dbgout, Proc_P2_dbgout, Proc_VIP_dbgout : TProxyClientEvent;

  Proc_P1_DataReceived, Proc_P2_DataReceived : TProxyClientData;

  FIdstr : string;   // "unique" identification string

  close_p1_after_send: boolean;

  already : boolean;  // hat die andere Verbindung schon den Befehl zum schlie遝n bekommen  ?
  connected : boolean; // sind wir verbunden   ?
   got_addr : boolean; // haben wir die zieladdr wohin wir connecten sollen schon ?

  buf_init : boolean;
  buf_p : pointer;
  buf_s : longint;

  client_ip   : TSockAddrIn;



  FsocksAuthentication : TSocksAuthentication;
  FSocksLevel : string;
  FSocksPassword : string;
  FSocksPort : string;
  FSocksServer : string;
  FSocksUsercode : string;

  procedure P1_DataAvailable(Sender: TObject; Error: Word);   virtual;
  procedure P1_DataSent(Sender: TObject; Error: Word);     virtual;
  procedure P1_SessionClosed(Sender: TObject; Error: Word); virtual;
  procedure P1_BgException(Sender: TObject; E: Exception; var CanClose: Boolean); virtual;
  procedure P1_Error(Sender: TObject);      virtual;

  procedure P2_DataAvailable(Sender: TObject; Error: Word);    virtual;
  procedure P2_SessionConnected(Sender: TObject; Error: Word); virtual;

  procedure P2_DataSent(Sender: TObject; Error: Word);  virtual;
  procedure P2_SessionClosed(Sender: TObject; Error: Word);  virtual;
  procedure P2_BgException(Sender: TObject; E: Exception; var CanClose: Boolean); virtual;
  procedure P2_Error(Sender: TObject);     virtual;

  procedure On_P1_dbgout(p: pchar);     virtual;
  procedure On_P2_dbgout(p: pchar);   virtual;
  procedure On_Vip_dbgout(p : Pchar);   virtual;

  function On_P1_DataAvailable(p : pointer; VAR s : longint) : pointer;  virtual;
  function On_P2_DataAvailable(p : pointer; VAR s : longint) : pointer; virtual;

  procedure before_work;  virtual;
  procedure after_work;   virtual;
  procedure look4addr; virtual;

  function Do_Connect2 : boolean; virtual; // wrapper: FP2.Connect

  function Do_Send2(Data : Pointer; Len : Integer): integer;  virtual;   // wrapper:  FP2.Send(data,len)
  Function Do_Send2Str(Str : string): Integer;  virtual; // wrapper: FP2.SendStr(str)

  function Do_Send1(Data : Pointer; Len : Integer): integer;  virtual;   // wrapper:  FP1.Send(data,len)
  Function Do_Send1Str(Str : string): Integer; virtual; // wrapper: FP1.SendStr(str)


  public
  Peer : string; // Remote IP which connects
  FP1HSocket : TSocket;

  FP1Socket  : TWSocket;
  FP2Socket : TWSocket;

  dest_addr, dest_port, dest_proto : string;
  Connectiontype : Tconnection;
  run_nr : longint;
  LastTransmission : longint; // Last Time (in Gettickcounts) P2 sent or received; default=-1
  anyrec : boolean; // Anything already received ?

  procedure close;   virtual;
  procedure pause;   virtual;
  procedure resume;  virtual;
  procedure release;   virtual;
  constructor Create;  virtual;
  destructor Destroy; override;
 protected


    procedure Execute; override;



 published
   property Idstr : string read FIdstr write FIdstr;



     { Triggered when line 1/2 produces a message }
   property OnP1MsgDbg : TProxyClientEvent
                                           read Proc_P1_dbgout
                                           write Proc_P1_dbgout;
   property OnP2MsgDbg : TProxyClientEvent
                                           read Proc_P2_dbgout
                                           write Proc_P2_dbgout;
   property OnVIPMsgDbg : TProxyClientEvent
                                           read Proc_vip_dbgout
                                           write Proc_vip_dbgout;

   property OnP1DataReceived : TProxyClientData
                                           read Proc_P1_DataReceived
                                           write Proc_P1_DataReceived;
   property OnP2DataReceived : TProxyClientData
                                           read Proc_P2_DataReceived
                                           write Proc_P2_DataReceived;

   property socksAuthentication  : TSocksAuthentication read FsocksAuthentication write FsocksAuthentication;
   property socksLevel : string  read FSocksLevel write FSocksLevel;
   property socksPassword : string read FSocksPassword write FSocksPassword;
   property socksPort : string   read   FsocksPort write FsocksPort;
   property socksServer : string  read FsocksServer write FsocksServer;
   property socksUserCode : string read FsocksUserCode  write   FsocksUserCode;
 end;

 TTelnetProxy = class(TProxyClient)

  function search_destaddr : boolean;
  procedure before_work; override;
  procedure look4addr; override;

 end;



 TFtpProxy = class(TProxyClient)
    ftp_ready : boolean;
  procedure P2_DataAvailable(Sender: TObject; Error: Word); override;
  function search_destaddr : boolean;
   procedure before_work; override;
  procedure look4addr; override;
 end;





var running_nr : longint = 0;

function readfirstln(p_in : pchar; p_in_size : longint; VAR index_cr: longint) : string;
// liefert leeren String zur點k, wenn noch kein #13 gefunden wurde

var
 LockEvents : TCriticalSection;


implementation
uses windows, messages,  chars, httphelp; //, u_main, dialogs, saving, httphelp;




///////////////////// TELNET PROXY /////////////////////

procedure TTelnetProxy.before_work;
begin;
    if connectiontype=connect2sameproxy then begin;
      on_p2_dbgout(Pchar('Tries to connect to : '+dest_addr+' at Port:'+dest_port));
      got_addr:=true;
      FP2Socket.addr:=dest_addr;
      FP2Socket.Port:=dest_port;
      Do_Connect2;
      exit;
   end;
   Do_Send1str('Telnet Proxy Syntax: Destaddr Portnr>');
end;

procedure TTelnetProxy.look4addr;
begin;
           On_P1_dbgout('P1 looking for TELNET-dest. addr....');
            if search_destaddr=true then begin;
             fp2socket.Addr:=dest_addr;
             fp2socket.port:=dest_port;
             Do_Connect2;
             got_addr:=true;
            end;
end;


function TTelnetProxy.search_destaddr : boolean;
var firstln : string;
    new : string;
    i1, i2: longint;
    nport, ndests : string;
    buf2_p : pointer;
    buf2_s : longint;
    temp_p : pchar;
begin;
if buf_init=true then begin   // buf_p, buf_s
 firstln:=readfirstln(buf_p,buf_s,i1);
 if length(firstln)>0 then begin;

  On_P1_dbgout(Pchar('Analyse "'+firstln+'"; '));
  new:=trim(firstln);
  ndests:=new;
  i2:=pos(' ',new);
  if i2>0 then begin;
    nport:=copy(new,i2+1,length(new)-i2);
    dest_port:=nport;
    ndests:=copy(new,1,i2-1);
     On_P1_dbgout(Pchar('New port found: "'+nport+'"; '));
  end;
  // showmessage(ndests);
   On_P1_dbgout(Pchar('Host found: "'+ndests+'"; '));
   dest_addr:=ndests;

   (*DA diese Routine ja nur aufgerufen wird wenn es keine Weiterleitung zu einem Proxy
     gleicher  Art verlangt ist,
     wird jetzt der Proxy Overhead rausgeschnitten *)
   //buf_p, buf_s
   buf2_s:=buf_s-i1-2;
   if (buf2_s)>0 then begin; // nach addr ist noch ein rest 黚rig
    // Do_P2_dbgout(Pchar('Rest: i1='+inttostr(i1)+' buf_s='+inttostr(buf_s)));
     getmem(buf2_p,buf2_s);
     temp_p:=buf_p;
     inc(temp_p,i1+2);
     mem_copy(buf2_p,temp_p,buf2_s);
     freemem(buf_p,buf_s);
     getmem(buf_p, buf2_s);
     mem_copy(buf_p, buf2_p, buf2_s);
     buf_s:=buf2_s;
     On_P2_dbgout(buf_p);
   end
   else begin
   // Do_P2_dbgout('No rest');
    freemem(buf_p,buf_s);
    buf_p:=nil;
    buf_init:=false;
   end;

   search_destaddr:=true;
 end
 else search_destaddr:=false;
end
else search_destaddr:=false;
end;


/////////////////////////// FTP PROXY  ////////////////

procedure TFtpProxy.before_work;
begin;
    if connectiontype=connect2sameproxy then begin;
      On_p2_dbgout(Pchar('Tries to connect to : '+dest_addr+' at Port:'+dest_port));
      got_addr:=true;
      FP2Socket.addr:=dest_addr;
      FP2Socket.Port:=dest_port;
      Do_Connect2;
      exit;
   end;
   Do_Send1str('220 FTP Proxy Syntax: Username@Servaddr:Serverport>'+#13+#10);
end;

procedure TFTPProxy.look4addr;
begin;
   On_P1_dbgout('P1 looking for FTP-dest. addr + port....');
            if search_destaddr=true then begin;
             fp2socket.Addr:=dest_addr;
             fp2socket.port:=dest_port;
             Do_Connect2;
             got_addr:=true;
            end;
end;


procedure TFtpProxy.P2_DataAvailable(Sender: TObject; Error: Word);

var
    Buffer : array [0..4095] of char;
    Count  : Integer;
begin
    { Receive as much data as possible                                      }
    Count := FP2Socket.Receive(@Buffer, SizeOf(Buffer)-1);

    { If data received, then process it                                     }
    if Count > 0 then begin;
      On_P2_dbgout(Pchar('P2 Data received ('+inttostr(count)+' Bytes)'));
      buffer[count]:=#0;
     // Do_P2_dbgout(buffer);

     if (ftp_ready=false) then begin;
        // if 220 then
        ftp_ready:=true;
        sleep(100);
        //Do_P2_dbgout('Now ready');
        connected:=true;
        On_p2_dbgout(Pchar('P2 Buffer ('+inttostr(buf_s)+' sent (frm SessionConnected): '));

         Do_Send2(buf_p,buf_s);


        freemem(buf_p,buf_s);
        buf_p:=nil;
        buf_s:=0;
        buf_init:=false;
        if connectiontype=connect2net then  exit;
      end;

      if Fp1Socket.State=wsconnected then begin;
         Do_Send1(@buffer,count);
      end;

    end;
end;




function TFtpProxy.search_destaddr : boolean;
var firstln : string;
    new,new2 : string;
    i1, i2,bufi: longint;
    nport, ndests : string;
    buf2_p : pointer;
    buf2_s : longint;
    temp_p, temp_p2 : pchar;

    userstr : string;

begin;
if buf_init=true then begin   // buf_p, buf_s
 firstln:=readfirstln(buf_p,buf_s,i1);
 if length(firstln)>0 then begin;

  On_P1_dbgout(Pchar('Analyse "'+firstln+'"; '));
  new2:=trim(firstln);


  bufi:=pos('@',new2);
  new:=copy(new2,bufi+1,length(new2)-bufi);
  userstr:=copy(new2,1,bufi-1);

 // Do_P1_dbgout(Pchar('i1='+inttostr(i1)+' bufi='+inttostr(bufi)+' Analyse "'+new+'"; Usercmd="'+userstr));


  ndests:=new;
  i2:=pos(':',new);
  if i2>0 then begin;
    nport:=copy(new,i2+1,length(new)-i2);
    dest_port:=nport;
    ndests:=copy(new,1,i2-1);
     On_P1_dbgout(Pchar('New port found: "'+nport+'"; '));
  end;
  // showmessage(ndests);
   On_P1_dbgout(Pchar('Host found: "'+ndests+'"; '));
   dest_addr:=ndests;

   (*DA diese Routine ja nur aufgerufen wird wenn es keine Weiterleitung zu einem Proxy
     gleicher  Art verlangt ist,
     wird jetzt der Proxy Overhead rausgeschnitten *)
   //buf_p, buf_s
   buf2_s:=buf_s-(i1-bufi);
   getmem(buf2_p,buf2_s);
   temp_p:=buf_p;
   mem_copy(buf2_p,temp_p,bufi-1);

   temp_p:=buf_p;
   inc(temp_p,i1-1);
   temp_p2:=buf2_p;
   inc(temp_p2,bufi-1);
   ///if buf_s-i1>0 then memcopy(temp_p2,temp_p,buf_s-i1);
   mem_copy(temp_p2,temp_p,buf_s-i1+1);

   freemem(buf_p,buf_s);
   getmem(buf_p, buf2_s);
   mem_copy(buf_p, buf2_p, buf2_s);
   buf_s:=buf2_s;
   //do_p1_dbgout(PCHAR(inttostr(buf2_s)));
  // Do_P1_dbgout(buf_p);
  // Do_P1_dbgout(Pchar(showmem(buf_p,buf_s)));

   search_destaddr:=true;
 end
 else search_destaddr:=false;
end
else search_destaddr:=false;
end;



function readfirstln(p_in : pchar; p_in_size : longint; VAR index_cr: longint) : string;
// liefert leeren String zur點k, wenn noch kein #13 gefunden wurde
var
 buf_firstln, firstln: string;
 pin : pchar;
 pl : longint;
begin;
 buf_firstln:='';
 firstln:='';
 pin:=p_in;
 for pl:=1 to p_in_size do begin;
  if ord(pin^)<>13 then buf_firstln:=buf_firstln+pin^ else begin;
   firstln:=buf_firstln;
   index_cr:=pl;
  // readfirstln:=firstln;
  // showmessage(inttostr(pl));
   break;
  end;
  if pl<p_in_size then inc(pin);
 end;
 index_cr:=pl;
 readfirstln:=firstln;
end;





function state2text(inputs : TSocketState) : string;
var bufs : string;
begin;
bufs:='';
case inputs of
  wsInvalidState : bufs:='Socket state invalid';
  wsOpened       : bufs:='Socket opened';
  wsBound        : bufs:='Socket bound';
  wsConnecting   : bufs:='Socket connecting';
  wsConnected    : bufs:='Socket connected';
  wsAccepting    : bufs:='Socket accepting';
  wsListening    : bufs:='Socket listening';
  wsClosed       : bufs:='Socket closed';
else bufs:='Socket state unknown'; end;
state2text:=bufs;

end;













//*********************************************************************************
//**********************************************************************************
//***********************************************************************************




                      
function TProxyClient.Do_Connect2 : boolean;
begin;
  FP2Socket.Connect;
  Do_Connect2:=true;
end;


function TProxyClient.Do_Send2(Data : Pointer; Len : Integer): integer;
begin;
 do_send2:=FP2Socket.send(data,len);
end;

Function TProxyClient.Do_Send2Str(Str : string): Integer;
begin;
  Do_Send2Str:=FP2Socket.Sendstr(str);
end;

function TProxyClient.Do_Send1(Data : Pointer; Len : Integer): integer;
begin;
 do_send1:=FP1Socket.send(data,len);
end;

Function TProxyClient.Do_Send1Str(Str : string): Integer;
begin;
  Do_Send1Str:=FP1Socket.Sendstr(str);
end;


function TProxyClient.On_P1_DataAvailable(p : pointer; VAR s : longint) : pointer;
begin;
  if Assigned(Proc_P1_DataReceived) then begin
     LockEvents.Acquire;
     try
      result:=Proc_P1_DataReceived(self,run_nr,p,s);
     finally
      LockEvents.Release;
     end;
  end