Multi-Threaded HTTP Proxy Server

Post date: Aug 18, 2010 12:35:30 AM

//Multi-Threaded HTTP Proxy Server
//by ujija
program proxy;
uses
  KOL,
  Windows,
  Winsock,
  Classes;
type TCompletionPort=class
  public
    FHandle:THandle;
    constructor Create(dwNumberOfConcurentThreads:DWORD);
    destructor Destroy;override;
    function AssociateDevice(hDevice:THandle;dwCompKey:DWORD):boolean;
  end;
  TAcceptThread=class(TThread)
  private
    FListenSocket:TSocket;
    FListenPort:Word;
    FClientList:TList;
    procedure GarbageCollect;
  protected
    procedure Execute;  override;
  public
    constructor Create(AListenPort:Word);reintroduce;
    destructor Destroy;override;
  end;
type TClientThread=class(TThread)
  public
    procedure Execute;  override;
  end;
type TClient=class
  private
    FSocket:TSocket;
    FEvent:THandle;
    ov:POVERLAPPED;
    Buffer:Pointer;
    BufSize:Cardinal;
    procedure Write(Buf:Pointer;Size:Cardinal);
  public
    FOppositeClient:TClient;
    FLastActivity:double;
    constructor Create;
    destructor Destroy;override;
    procedure Connect(ARequest:string);
    procedure Disconnect;
    procedure Complete(dwNumBytes:Cardinal);virtual;abstract;
  end;
  TInternalClient=class(TClient)
  public
    procedure Complete(dwNumBytes:Cardinal);override;
  end;
  TExternalClient=class(TClient)
  public
    procedure Complete(dwNumBytes:Cardinal);override;
  end;
//-------------------------------implementation-------------------------------
var
  FCompPort:TCompletionPort;
  Msg : Tmsg;
{ TCompletionPort }
constructor TCompletionPort.Create(dwNumberOfConcurentThreads: DWORD);
begin
  FHandle:=CreateIoCompletionPort(INVALID_HANDLE_VALUE,0,0,dwNumberOfConcurentThreads);
end;
function TCompletionPort.AssociateDevice(hDevice: THandle;
  dwCompKey: DWORD): boolean;
begin
  result:=CreateIoCompletionPort(hDevice,FHandle,dwCompKey,0)=FHandle;
end;
destructor TCompletionPort.Destroy;
begin
  CloseHandle(FHandle);
  inherited;
end;
{ TAcceptThread }
constructor TAcceptThread.Create(AListenPort: Word);
begin
  inherited Create(false);
  FListenPort:= AListenPort;
  FClientList:= TList.Create;
end;
destructor TAcceptThread.Destroy;
begin
  FClientList.Free;
  inherited;
end;
procedure TAcceptThread.GarbageCollect;
var
  AClient:TClient;
  i:integer;
begin
  for i:=0 to FClientList.Count-1 do begin
    AClient:=TClient(FClientList[i]);
    if Assigned(AClient) then
      if (AClient.FSocket=INVALID_SOCKET) and ((now-AClient.FLastActivity)>7E-4) then
    begin
      FClientList[i]:=nil;
      if Assigned(AClient.FOppositeClient) then AClient.FOppositeClient.Free;
      AClient.Free;
    end;
  end;
  FClientList.Pack;
  FClientList.Capacity:=FClientList.Count;
end;
procedure TAcceptThread.Execute;
var
  FAddr: TSockAddrIn;
  Len: Integer;
  ClientSocket:TSocket;
  InternalClient:TClient;
begin
  FListenSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
  FAddr.sin_family := PF_INET;
  FAddr.sin_addr.s_addr := INADDR_ANY;
  FAddr.sin_port := htons(FListenPort);
  bind(FListenSocket, FAddr, SizeOf(FAddr));
  listen(FListenSocket, SOMAXCONN);
  try
    while not Terminated do begin
      Len:=sizeof(FAddr);
      ClientSocket:=accept(FListenSocket, @FAddr, @Len);
      try
        GarbageCollect;
        if ClientSocket<>INVALID_SOCKET then begin
          InternalClient:=TInternalClient.Create;
          InternalClient.FSocket:=ClientSocket;
          FClientList.Add(InternalClient);
          FCompPort.AssociateDevice(InternalClient.FSocket,Cardinal(InternalClient));
          InternalClient.Complete(0);
        end;
      except end;
    end;
  finally
    shutdown(FListenSocket,2);
    closesocket(FListenSocket);
  end;
end;
{ TClientThread }
procedure TClientThread.Execute;
var
  CompKey,dwNumBytes:Cardinal;
  ov:POVERLAPPED;
begin
  try
    while not Terminated do begin
      if GetQueuedCompletionStatus(FCompPort.FHandle,dwNumBytes,CompKey,ov,INFINITE) and (dwNumBytes>0) then
      begin
        if TClient(CompKey).FSocket<>INVALID_SOCKET then begin
          TClient(CompKey).Complete(dwNumBytes);
          TClient(CompKey).FLastActivity:=now;
        end;
      end else
        TClient(CompKey).Disconnect;
    end;
  except
    TClientThread.Create(false);
  end;
end;
{ TClient }
constructor TClient.Create;
begin
  FSocket:=INVALID_SOCKET;
  BufSize:=8192;
  GetMem(Buffer,BufSize);
  new(ov);
  ov.Internal:=0;
  ov.InternalHigh:=0;
  ov.Offset:=0;
  ov.OffsetHigh:=0;
  ov.hEvent:=0;
  FEvent:=CreateEvent(nil,true,false,nil);
  FLastActivity:=now;
end;
destructor TClient.Destroy;
begin
  Disconnect;
  CloseHandle(FEvent);
  FreeMem(Buffer);
  Dispose(ov);
  inherited;
end;
////////////////////////////////////////////////////////////////////////////////
//
//  Ïðèåì çàïðîñà íà ïîäêëþ÷åíèå ê óäàëåííîìó õîñòó
procedure TClient.Connect(ARequest: string);
var
  f,t:integer;
  ARemoteAddress:string;
  ARemotePort:string;
  he:PHostEnt;
  FAddr:TSockAddrIn;
begin
  f:=Pos('/',ARequest)+2;
  t:=Pos('HTTP',ARequest)-1;
  ARemoteAddress:=Copy(ARequest,f,t-f);
  t:=Pos('/',ARemoteAddress);
  if t<>0 then ARemoteAddress:=Copy(ARemoteAddress,0,t-1);
  t:=Pos(':',ARemoteAddress);
  if t<>0 then begin
    ARemotePort:=Copy(ARemoteAddress,t+1,Length(ARemoteAddress)-t);
    ARemoteAddress:=Copy(ARemoteAddress,0,t-1);
  end else
    ARemotePort:='80';
 // WriteLn('Trying to connect: '+ ARemoteAddress);
 // WriteLn(Int2STR( FAddr.sin_addr.s_addr));
  he:=GetHostByName(PChar(ARemoteAddress));
  if not Assigned(he) then exit;
  ARemoteAddress:=inet_ntoa(PInAddr(he.h_addr_list^)^);
  FSocket:=socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
  FAddr.sin_family:=PF_INET;
  FAddr.sin_addr.s_addr :=inet_addr(PChar(ARemoteAddress));
  try
    FAddr.sin_port := htons(Str2Int(ARemotePort));
    if WinSock.connect(FSocket, FAddr, SizeOf(FAddr))=SOCKET_ERROR then FSocket:=INVALID_SOCKET;
  except
  //  WriteLn('Connection failed');
  end;
end;
procedure TClient.Disconnect;
begin
  if FSocket<>INVALID_SOCKET then begin
    shutdown(FSocket,2);
    closesocket(FSocket);
    FSocket:=INVALID_SOCKET;
    if Assigned(FOppositeClient) then FOppositeClient.Disconnect;
  end;
end;
procedure TClient.Write(Buf: Pointer; Size: Cardinal);
var
  BytesWrite:Cardinal;
begin
  ov.hEvent:=FEvent or 1;
  WriteFile(FSocket,Buf^,Size,BytesWrite,ov);
  ov.hEvent:=0;
end;
{ TInternalClient }
procedure TInternalClient.Complete(dwNumBytes: Cardinal);
var
  BytesRead:Cardinal;
begin
  if dwNumBytes>0 then begin
    if not Assigned(FOppositeClient) then begin
      FOppositeClient:=TExternalClient.Create;
      FOppositeClient.FOppositeClient:=self;
      FOppositeClient.Connect(PChar(Buffer));
      if FOppositeClient.FSocket=INVALID_SOCKET then begin
        Disconnect;
        exit;
      end;
      FCompPort.AssociateDevice(FOppositeClient.FSocket,Cardinal(FOppositeClient));
      FOppositeClient.Complete(0);
    end;
    FOppositeClient.Write(Buffer,dwNumBytes);
  end;
  ReadFile(FSocket,Buffer^,BufSize,BytesRead,ov);
end;
{ TExternalClient }
procedure TExternalClient.Complete(dwNumBytes: Cardinal);
var
  BytesRead:Cardinal;
begin
  if dwNumBytes>0 then FOppositeClient.Write(Buffer,dwNumBytes);
  ReadFile(FSocket,Buffer^,BufSize,BytesRead,ov);
end;
function windowproc(w:hwnd;m:word;p:word;l:longint):longint;stdcall;
begin
   if m = $0002 {WM_DESTROY} then
   Begin
     WSACleanup;
     postquitmessage(0);
     Result:=0;
     exit;
    End
    else Result:=DefWindowProc(w,m,p,l);
end;
{ Graphik}
const
  ClientThreadCount : integer = 8;
  ListenPort : Dword = 8080;
var
  WSAData:TWSAData;
  i:integer;
begin
  WSACleanup;
  FCompPort:=TCompletionPort.Create(ClientThreadCount);
  if FCompPort.FHandle<>0 then
  begin
    WSAStartup($0101, WSAData);
    for i:=0 to ClientThreadCount-1 do TClientThread.Create(false);
    TAcceptThread.Create(ListenPort);
  end;
  while GetMessage(msg, 0, 0, 0) do begin
    DispatchMessage(msg);
    TranslateMessage(msg);
  end;
end.