
unit ASWSMClient;

interface

uses
  WinSock;
  
procedure NewPeer(aSocket: tSocket; const aBasePath, aBaseFile: string);

var
  RC: Integer;

implementation

uses
  Windows, WSocket, Classes, SysUtils, HomeTool, ASWSPlugin, ASWSMain;

type
  tPeerThread = class(tThread)
  private
    Peer      : tWSocket;
    fSock     : tSocket;
    PeerBuf   : string;
    Connected : Boolean;
    HeadAvail : Boolean;
    DataStart : Integer;
    noReply   : Boolean;
    FileOK    : Boolean;
    ClientDone: Boolean;
    ReqFile   : string;
    BaseFile  : string;
    BasePath  : string;
    DataSent  : Boolean;
    PeerHost  : string;
    gfhExt    : string;
    gfhHandle : Integer;
    gfhResult : string;
    LogItem   : string;
    fMaxTicks : Integer;
    fTimeOut  : Integer;
    procedure PSC(Sender: TObject; Error: Word);
    procedure PDA(Sender: TObject; Error: Word);
    procedure PDS(Sender: TObject; Error: Word);
    procedure PCS(Sender: TObject; OldState, NewState: TSocketState);
    //
    procedure ParseReq(const aValue: string);
    function  TryThis(aStr, aSubStr: string): Boolean;
    procedure Reply(ErCode: Integer; const aMsg, aOtherFields: string);
    procedure Wait;
    function GetFileHdr(const aFileExt: string; aFile: tHandle): string;
    procedure DoGetFileHdr;
    procedure SendFile(aHandle: Integer; const aFileName: string);
    procedure SendRequestedFile;
    procedure IncRC;
    procedure DecRC;
    procedure AddLog(const anItem: string);
    procedure DoAddLog;
  public
    constructor Create(aSock: tSocket; const aBasePath, aBaseFile: string);
    procedure Execute; override;
    destructor Destroy; override;
  end;

{ tPeerThread }

constructor tPeerThread.Create;
begin
  fSock := aSock;
  BaseFile := aBaseFile;
  BasePath := aBasePath;
  FreeOnTerminate := True;
  fMaxTicks := (Str2Int(F_ASWSMain.Edit13.Text, 40) * 1000);
  inherited Create(True);
end;

function NumOnly(const aValue: string): string;
var
  i: Integer;
begin
  Result := '';
  i := 1;
  while (i <= Length(aValue)) and (aValue[i] < '0') do Inc(i);
  while (i <= Length(aValue)) and (aValue[i] in ['0'..'9']) do begin
    Result := Result + aValue[i];
    Inc(i);
  end;
end;

procedure tPeerThread.Execute;
var
  lZ: Integer;
  lS: Integer;
  lP: Integer;
  lB: Boolean;
  PeerName: TSockAddrIn;
begin
  Peer := tWSocket.Create(nil);
  with Peer do try
    OnSessionAvailable := PSC;
    OnDataAvailAble    := PDA;
    OnDataSent	       := PDS;
    OnChangeState      := PCS;
    //
    Peer.Dup(fSock);
    Peer.MultiThreaded := True;
    PeerBuf   := '';
    Connected := (Peer.State = wsConnected);
    Synchronize(IncRc);
    NoReply := True;
    fTimeOut := GetTickCount;
    if Connected then begin
      Peer.GetPeerName(PeerName, Sizeof(PeerName));
      PeerHost   := IntToStr(ord(PeerName.sin_addr.S_un_b.s_b1)) + '.' + IntToStr(ord(PeerName.sin_addr.S_un_b.s_b2)) + '.' + IntToStr(ord(PeerName.sin_addr.S_un_b.s_b3)) + '.' + IntToStr(ord(PeerName.sin_addr.S_un_b.s_b4));
      repeat
	Sleep(100);
	Peer.ProcessMessages;
	if not HeadAvail then begin
	  lZ := 4;
	  lS := Pos(#13#10#13#10, PeerBuf);
	  if (lS > 0) then begin
	    lP := Pos('CONTENT-LENGTH:', UpperCase(PeerBuf));
	    DataStart := lS + lZ;
	    if (lP > 0) then lB := Length(PeerBuf) >= DataStart - 1 + Str2Int(NumOnly(Copy(PeerBuf, lP + 15, Length(PeerBuf))), 0)
			else lB := True;
	    if lB then begin
	      HeadAvail := True;
	      try
		ParseReq(Copy(PeerBuf, 1, lS - 1));
	      except
		// ignore all errors
	      end;
	    end;
	  end;
	end;
	if not ClientDone and (GetTickCount - fTimeOut > fMaxTicks) then Break;
      until ClientDone or not Connected;
    end;
  finally
    if Connected then Peer.Close;
    while Connected do begin
      Sleep(100);
      Peer.ProcessMessages;
    end;
    Synchronize(DecRc);
  end;
end;

destructor tPeerThread.Destroy;
begin
  Peer.Free;
  inherited;
end;

procedure tPeerThread.IncRC;
begin
  Inc(RC);
  F_ASWSMain.ClientsNum := RC;
end;

procedure tPeerThread.DecRC;
begin
  Dec(RC);
  F_ASWSMain.ClientsNum := RC;
end;

function GetHTTPStat(aStatus: Integer): string;
var
  lK: string;
begin
  case aStatus of
    100:	lK := 'Continue';
    101:	lK := 'Switching Protocols';
    200:	lK := 'OK';
    201:	lK := 'Created';
    202:	lK := 'Accepted';
    203:	lK := 'Non-Authoritative Information';
    204:	lK := 'No Content';
    205:	lK := 'Reset Content';
    206:	lK := 'Partial Content';
    300:	lK := 'Multiple Choices';
    301:	lK := 'Moved Permanently';
    302:	lK := 'Found';
    303:	lK := 'See Other';
    304:	lK := 'Not Modified';
    305:	lK := 'Use Proxy';
    307:	lK := 'Temporary Redirect';
    400:	lK := 'Bad Request';
    401:	lK := 'Unauthorized';
    402:	lK := 'Payment Required';
    403:	lK := 'Forbidden';
    404:	lK := 'Not Found';
    405:	lK := 'Method Not Allowed';
    406:	lK := 'Not Acceptable';
    407:	lK := 'Proxy Authentication Required';
    408:	lK := 'Request Time-out';
    409:	lK := 'Conflict';
    410:	lK := 'Gone';
    411:	lK := 'Length Required';
    412:	lK := 'Precondition Failed';
    413:	lK := 'Request Entity Too Large';
    414:	lK := 'Request-URI Too Large';
    415:	lK := 'Unsupported Media Type';
    416:	lK := 'Requested range not satisfiable';
    417:	lK := 'Expectation Failed';
    500:	lK := 'Internal Server Error';
    501:	lK := 'Not Implemented';
    502:	lK := 'Bad Gateway';
    503:	lK := 'Service Unavailable';
    504:	lK := 'Gateway Time-out';
    505:	lK := 'HTTP Version not supported';
    else 	lK := 'Unknown status';
  end;
  Result := 'HTTP/1.0 ' + IntToStr(aStatus) + ' ' + lK + #13#10;
end;

procedure tPeerThread.Reply(ErCode: Integer; const aMsg, aOtherFields: string);
var
  lS: string;
  lZ: string;
begin
  lZ := '<HTML><h2>' + aMsg + '</h2></HTML>';
  lS := GetHTTPStat(ErCode) +
	aOtherFields +
	'Content-Type: text/html'#13#10 +
	'Content-Length: ' + IntToStr(Length(lZ)) + #13#10 +
	'Content:'#13#10#13#10 + lZ;
  DataSent := False;
  if Connected then begin
    Peer.SendStr(lS);
    Wait;
  end;
  noReply := False;
end;

function toDef(const S: string): string;
begin
  if (Trim(S) = '') then Result := 'binary/data'
		    else Result := S;
end;

procedure tPeerThread.DoGetFileHdr;
begin
  gfhResult := 'Server: AlekShWS/0.3'#13#10 +
   'Content-Type: ' + toDef(F_ASWSMain.Ext2Str[gfhExt]) + #13#10 +
   'Content-Length: ' + IntToStr(FileSeek(gfhHandle, 0, 2)) + #13#10#13#10;
end;

function tPeerThread.GetFileHdr(const aFileExt: string; aFile: tHandle): string;
begin
  gfhExt := aFileExt;
  gfhHandle := aFile;
  Synchronize(DoGetFileHdr);
  Result := gfhResult;
end;

procedure tPeerThread.SendFile(aHandle: Integer; const aFileName: string);
const
  BufSize = 4096;	// not too big -- many client will overload memory
var
  B: pointer;	// local buffer
  M: Integer;   // total size to send
  S: Integer;	// sended bytes
  T: Integer;	// to read
begin
  //F_ASWSMain.Status := 'Posting...';
  M := FileSeek(aHandle, 0, 2);
  S := 0;
  if (M > 0) then begin
    GetMem(B, BufSize);
    try
      FileSeek(aHandle, 0, 0);
      repeat
	T := Min(M - S, BufSize);
	if (T > 0) then begin
	  FileRead(aHandle, B^, T);
	  DataSent := False;
	  if Connected then begin
	    Peer.Send(B, T);
	    Wait;
	  end
	  else Break;
	  Inc(S, T);
	end;
	//F_ASWSMain.UpdateResult(fOH, fLVC, Format('Posted %d of %d', [S, M]));
      until (T < 1) or not Connected;
    finally
      FreeMem(B, BufSize);
    end;
  end;
  //F_ASWSMain.AddResult(fOH, 'Posted <' + aFileName + '>');
end;

function tPeerThread.TryThis(aStr, aSubStr: string): Boolean;
var
  lP : Integer;
  lA : string;
  lF : string;
  lS : string;
  lCI,
  lCO: string;
//  lPI: TProcessInformation;
//  lSI: tStartUpInfo;
//  lEC: DWord;
  lFH: tHandle;
  lFO: tHandle;
//  lBuf: array[0..4096] of Char;
  lPg: Boolean;
  lOK: Boolean;
  PGFields: string;
  Status  : Integer;
begin
  Result := False;
  lP := Pos(aSubStr, aStr);
  if (lP = 1) then begin
    Delete(aStr, 1, lP + Length(aSubStr));
    lP := Pos('HTTP/1.', aStr);
    if (lP = Length(aStr) - 7) then ReqFile := Trim(Copy(aStr, 1, Pred(lP)))
			       else ReqFile := '';
    if (ReqFile = '/') then ReqFile := BaseFile;
    if (aSubStr = 'POST') then ReqFile := ReqFile + '?' + Copy(PeerBuf, DataStart, Length(PeerBuf));
    {if (Pos('/ASWSMASTER/COMMAND/' + F_ASWSMain_Edit15_Text, ReqFile) = 1) then begin
      if (Pos('DOSTOPPG', ReqFile) > 0) and F_ASWSMain_StopBtn_Enabled then F_ASWSMain.FreePlugins(ciClosed) else
      if (Pos('DOSTARTPG', ReqFile) > 0) and F_ASWSMain_StopBtn_Enabled then F_ASWSMain.LoadPlugins;
      if Connected then Reply(200, 'Command OK', '');
      Peer.Abort;
      Exit;
    end;}
    if (aSubStr = 'PUT') then begin
      lS := BasePath + ReqFile;
      if FileExists(lS) then Reply(406, 'File already exists', '')
      else begin
	lFH := FileCreate(lS);
	if (lFH > 0) then try
	  FileWrite(lFH, PeerBuf[DataStart], Length(PeerBuf) - DataStart + 1);
	finally
	  FileClose(lFH);
	  Reply(200, 'File saved', '');
	end
	else Reply(406, 'Cannot create such a file: ' + ReqFile, '');
      end;
      Exit;
    end;
    //fLVC := 0;
    //fOH := F_ASWSMain.AddOperation(PeerHost + ': ' + aSubStr + ' <' + ReqFile + '>', Self);
    Result := (ReqFile <> '');
    if Result then begin
      lP := Pos('?', ReqFile);
      if (lP > 0) then begin
	lF  := Copy(ReqFile, 2, lP - 2);
	lA  := Copy(ReqFile, lP + 1, Length(ReqFile));
	lPg := (FindPlugin(lF) >= 0);
	lFH := -1;
	lFO := -1;
	if not lPg then begin
	  {lF  := '"' + F_ASWSMain_BasePath + lF + '" ' + lA;
	  FillChar(lSI, SizeOf(lSI), 0);
	  lCI := F_ASWSMain.TempPath + 'CGIIN_' + IntToStr(RC) + '.TMP';
	  lFO := FileCreate(lCI);
	  lCO := F_ASWSMain.TempPath + 'CGIOU_' + IntToStr(RC) + '.HTM';
	  lFH := FileCreate(lCO);}
	end;
	if lPg or (lFH <> -1) then
	  try
	    if not lPg then begin
	      lOK := False;
	      {lA := lA + #13#10#27;
	      StrCopy(lBuf, PChar(lA));
	      FileWrite(lFO, lBuf, Length(lBuf));
	      FileSeek(lFO, 0, 0);
	      lSI.cb := SizeOf(lSI);
	      lSI.dwFlags := STARTF_USESHOWWINDOW + STARTF_USESTDHANDLES;
	      lSI.wShowWindow := sw_hide;
	      lSI.hStdOutPut := lFH;
	      lSI.hStdInput  := lFO;
	      if CreateProcess(nil, PChar(lF), nil, nil, false, 0, nil, PChar(F_ASWSMain_BasePath), lSI, lPI) then begin
		//F_ASWSMain.Status := 'Waiting for CGI-proggy...';
		repeat
		  GetExitCodeProcess(lPI.hProcess, lEC);
		  Application.ProcessMessages;
		until (lEC <> Still_Active);
		lOK := True;
	      end
	      else lOK := False;}
	    end
	    else begin
	      PGFields := '';
	      Status := 200;
	      lOK := (QueryPlugin2(lF, PeerHost, {Copy(}PeerBuf{, 1, DataStart)}, lA, lCO, PGFields, Status) >= 0);
	      lA := F_ASWSMain.Header + lCO + F_ASWSMain.Footer;
	      if lOK then begin
		if (Pos('CONTENT-TYPE: ', UpperCase(PGFields)) < 1) then PGFields := PGFields + 'Content-type: text/html'#13#10;
		lS := GetHTTPStat(Status) + PGFields + 'Content-Length: ' + IntToStr(Length(lA)) + #13#10'Content:' +  #13#10#13#10 + lA;
		DataSent := False;
		if Connected then begin
		  Peer.SendStr(lS);
		  Wait;
		end;
	      end;
	    end;
	    if lOK then begin
	      noReply := False;
	      if not lPg then begin
		lS := GetHTTPStat(200) + GetFileHdr('HTM', lFH);
		DataSent := False;
		if Connected then begin
		  Peer.SendStr(lS);
		  //Memo2.Lines.Add(lS);
		  Wait;
		  SendFile(lFH, lCO);
		end
		//else Memo2.Lines.Add('Peer closed.');
	      end;
	    end
	    else begin
	      Reply(405, 'Cannot run plugin (' + ReqFile + ')', '');
	      //F_ASWSMain.AddResult(fOH, 'Not Executed <' + lF + '>');
	      Result := False;
	    end;
	  finally
	    if not lPg then begin
	      FileClose(lFH);
	      FileClose(lFO);
	      DeleteFile(lCO);
	      DeleteFile(lCI);
	    end;
	  end
	else begin
	  Reply(500, 'Cannot create temporary file. CGI fail.', '');
	  Result := False;
	end;
      end
      else FileOK := FileExists(BasePath + ReqFile);
    end;
  end;
  //if Result then FileLabel.Caption := ReqFile
end;

procedure tPeerThread.SendRequestedFile;
var
  fH: Integer;
  lS: string;
begin
  fH := FileOpen(BasePath + ReqFile, fmOpenRead + fmShareDenyWrite);
  if (fH <> -1) then try
    DataSent := False;
    lS := GetHTTPStat(200) + GetFileHdr(Copy(ExtractFileExt(ReqFile), 2, MAX_PATH), fH);
    if Connected then begin
      Peer.SendStr(lS);
      Wait;
      SendFile(fH, ReqFile);
    end
  finally
    FileClose(fH);
  end
  else Reply(404, 'Unable to open this file for read', '');
end;

procedure tPeerThread.ParseReq(const aValue: string);
var
  lS : tStrings;
  lVs: string;
  isF: Boolean;
begin
  lS := tStringList.Create;
  try
    lS.Text := aValue;
    if (lS.Count > 0) then begin
      lVs := lS[0];
      AddLog(lVs);
      IsF := TryThis(lVs, 'GET');
      if not IsF then IsF := TryThis(lVs, 'POST');
      if not isF then IsF := TryThis(lVs, 'PUT');
      if not IsF then
	if noReply then Reply(501, 'Request not supported', '')
	else
      else
	if not FileOK and noReply then Reply(404, '<h2>File not really found</h2>', '')
	else
	  if noReply then SendRequestedFile;
    end
    else Reply(400, 'You doesn''t say anything! Try again', '');
    Sleep(200);
    Peer.ProcessMessages;
  finally
    lS.Free;
    ClientDone := True;
  end;
end;

procedure tPeerThread.PSC(Sender: TObject; Error: Word);
begin
  Connected := False;
end;

procedure tPeerThread.PDA(Sender: TObject; Error: Word);
var
  BufSize: Integer;
  lSz: Integer;
  lOL: Integer;
begin
  fTimeOut := GetTickCount;	// reset timeout
  BufSize := Peer.RcvdCount;
  lOL := Length(PeerBuf);
  SetLength(PeerBuf, lOL + BufSize);
  lSz := Peer.Receive(@PeerBuf[lOL + 1], BufSize);
  SetLength(PeerBuf, lOL + lSz);
end;

procedure tPeerThread.PDS(Sender: TObject; Error: Word);
begin
  DataSent := True;
end;

procedure tPeerThread.PCS(Sender: TObject; OldState, NewState: TSocketState);
begin
  Connected := (NewState = wsConnected);
end;

procedure tPeerThread.Wait;
var
  lTimeOut: Integer;
begin
  lTimeOut := GetTickCount;
  repeat
    Sleep(10);
    Peer.ProcessMessages;
  until DataSent or not Connected or (GetTickCount - lTImeOut > fMaxTicks);
  Sleep(20);
  Peer.ProcessMessages;
end;

procedure tPeerThread.AddLog(const anItem: string);
begin
  LogItem := anItem;
  Synchronize(DoAddLog);
end;

procedure tPeerThread.DoAddLog;
begin
  with F_ASWSMain do
    if CheckBox5.Checked then
      AddTextToFile(Edit12.Text, DateTimeToStr(Now) + #9 + PeerHost + #9 + LogItem, True);
end;

//

procedure NewPeer(aSocket: tSocket; const aBasePath, aBaseFile: string);
begin
  with tPeerThread.Create(aSocket, aBasePath, aBaseFile) do Resume;
end;

end.

