Indy10 - D7

[Hannes Gouws]

Hi - I advance - sorry for the loooonnnngggg message, but the more info I
give you, the better you will understand what my app is supposed to do.!



I have create a captive portal application using the winpkfilter library and
Indy 10 with D7 Enterprise.

The pc this software will be running on will be configured as an internet
gateway with 2 network adapters. 1 for internet and 1 for internal network
(LAN)

My application executes 2 threads

Thread1 listens on a specific network adapter (LAN) via winpkfilter's NDIS
intermediate driver. From Thread1, I can monitor all inbound and outbound
network packets. I am specifically interested in outbound HTTP packets
(destined to port 80), which I then redirect to 192.168.0.1:80 by directly
modifying the raw TCP and IP packets.

Thread2 checks for incomming http request on my local pc (192.168.0.1:80)
and blocks all outbound internet traffic by first server a web page for
authentication (basic logon page). When the user logs on, I get a POST
command back with the username and password params, which I then parse and
validate. If not valid username and password, same login page gets served
again with message that login is not valid.

Now when the user logs in and authentication is sucessful, my TidHttpServer
must serve as a internet gateway.

My problem is with the gateway side of it, I've tried a couple of thing but
as soon as the user logs in sucessfully and I then redirect him to the
original reguested page, it does load, but the images are lost...

here is some code I used for the http redirection in Thread2:

First I validate if the logon details and if sucess I call this function
from my main IdHTTPServer1CommandGet event.

This procedure serve only the actaul HTML text....

procedure TdmHttpServer.RedirUserToWWW(AContext: TIdContext; ARequestInfo:
TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
lsResponse: String;
begin

lsResponse := idHttpClient.Get(ARequestInfo.Referer);
AResponseInfo.ContentText := lsResponse;
AResponseInfo.WriteContent;

end;

Now I get a request back again into my main IdHTTPServer1CommandGet event
for the rest of the content like images etc...

The following code serves the rest of the html document like images etc..

var
lsHost: String;
lStream: TMemoryStream;
lsFileName: String;
begin


lsHost := 'http://'+ARequestInfo.Host;

lsFileName := lsHost+ARequestInfo.Document;

lStream := TMemoryStream.Create;
try
idHttpClient.Get(lsFileName, lStream);
AResponseInfo.ContentStream := lStream;
AResponseInfo.WriteContent;
finally
AResponseInfo.ContentStream.Free;
AResponseInfo.ContentStream := nil;
end;
end;



Any help/input/comment/criticism here would be appreciated

[Remy Lebeau (TeamB)]

Post by Hannes Gouws
Now when the user logs in and authentication is sucessful,
my TidHttpServer must serve as a internet gateway.

TIdHTTPServer is not really designed for that. You should consider using
TIdHTTPProxyServer or TIdMappedPortTCP instead.

Post by Hannes Gouws
This procedure serve only the actaul HTML text....

<snip>

Post by Hannes Gouws
Now I get a request back again into my main IdHTTPServer1CommandGet event
for the rest of the content like images etc...

Did you verify that all of that code is being called at the correct times?
Did you verify with a packet sniffer that you are actually passing the data
along correctly when needed? Your descriptions are too vague, and your code
too incomplete, to really diagnose your problem.


Gambit

[Hannes Gouws]

Here is my complete code... If it will be too difficult to implement it with
a TidHttpServer, please give me some examples of how I can implement it with
TIdMappedPortTCP or anything else for that matter.


Many thanks in advance!





unit udmHttpServer;

interface

uses
WinTypes, WinProcs, Messages, SysUtils, Classes, Controls, Forms,
{$IFDEF DELPHI7_UP}
StrUtils,
{$ENDIF}
IniFiles, StdCtrls, ExtCtrls, WinSock, WSocket, WSocketS, HttpSrv,
HttpProt, HTTPProd, IdBaseComponent, IdComponent,
IdCustomTCPServer, IdCustomHTTPServer, IdHTTPServer, IdContext,
uhtmlConstants, HTTPApp, unitConstants, wispClasses, Globals,
IdTCPConnection, IdTCPClient, IdHTTP, IdIntercept, IdInterceptThrottler,
IdIOHandler, IdIOHandlerStream;

type
TdmHttpServer = class(TDataModule)
ppLogin: TPageProducer;
ppHelp: TPageProducer;
IdHTTPServer1: TIdHTTPServer;
ppGenereal: TPageProducer;
ppInfo: TPageProducer;
ppInfoBox: TPageProducer;
ppInfoBoxEnd: TPageProducer;
ppLogout: TPageProducer;
ppPasswords: TPageProducer;
ppPasswordUpdated: TPageProducer;
ppReachedMax: TPageProducer;
ppReceipt: TPageProducer;
ppReceiptCheckOut: TPageProducer;
ppRestricted: TPageProducer;
ppSignup1: TPageProducer;
ppSignup2: TPageProducer;
ppSignup3: TPageProducer;
ppWelcome: TPageProducer;
ppStyleCSS: TPageProducer;
idHttpClient: TIdHTTP;
ppWeb: TPageProducer;
HttpGateway: THttpServer;
procedure ppLoginHTMLTag(Sender: TObject; Tag: TTag;
const TagString: String; TagParams: TStrings;
var ReplaceText: String);
procedure IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
procedure DataModuleCreate(Sender: TObject);
private
FLoginMessage: String;
FThrottle: TIdInterceptThrottler;
FClientAccount: TwispClientAccount;

procedure RedirUserToWWW(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);

procedure ProcessPostCommand(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);

procedure ProcessGetCommand(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);

function ExtractRequestFileformURL(const aURL: String): String;
function GetPageProducerFromURL(const aURL: String): TPageProducer;
function IsRootFile(const aURL: String; var aFileName: String): Boolean;
procedure SetLoginMessage(const Value: String);
public
property LoginMessage: String read FLoginMessage write SetLoginMessage;
end;

var
dmHttpServer: TdmHttpServer;

implementation

{$R *.dfm}

procedure TdmHttpServer.ppLoginHTMLTag(Sender: TObject; Tag: TTag;
const TagString: String; TagParams: TStrings; var ReplaceText: String);
begin
if TagString = 'MESSAGE' then begin
ReplaceText := FLoginMessage;
FLoginMessage := '';
end;

if TagString = 'SERVERIP' then
ReplaceText := '192.168.0.1';
end;

procedure TdmHttpServer.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin

if ARequestInfo.Command = 'GET' then begin
ProcessGetCommand(aContext, ARequestInfo, AResponseInfo);
Exit;
end;

if ARequestInfo.Command = 'POST' then begin
ProcessPostCommand(aContext, ARequestInfo, AResponseInfo);
Exit;
end;

end;

procedure TdmHttpServer.ProcessPostCommand(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
var
liParamIndex: Integer;
lsMessage: String;
lsDocName: String;
lsUserName, lsPassword, lsUserIP: String;
begin

{
What we can expect when a user logs in

'userlogin=hannes123'
'userpass=123456789'
'Login= Login '
'infobox=check'
}

lsDocName := ARequestInfo.Document;

if CompareText(lsDocName, '/') = 0 then begin {Login}

for liParamIndex := 0 to ARequestInfo.Params.Count-1 do begin

if CompareText('userlogin', ARequestInfo.Params.Names[liParamIndex]) =
0 then
lsUserName :=
ARequestInfo.Params.Values[ARequestInfo.Params.Names[liParamIndex]];

if CompareText('userpass', ARequestInfo.Params.Names[liParamIndex]) =
0 then
lsPassword :=
ARequestInfo.Params.Values[ARequestInfo.Params.Names[liParamIndex]];

end;

if wispSession.ClientsAccounts.LogInUser(lsUserName, lsPassword,
ARequestInfo.RemoteIP, lsMessage) then begin

RedirUserToWWW(AContext, ARequestInfo, AResponseInfo);

end else begin
FLoginMessage := lsMessage;
AResponseInfo.ContentText := ppLogin.Content;
end;

end;

end;

procedure TdmHttpServer.ProcessGetCommand(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
var
ppHtml: TPageProducer;
lsFileName: String;
lstmpFileName: String;
lsHost: String;
lStream: TMemoryStream;
lPlan: TwispClientAccountPricingPlan;
begin

ppHtml := GetPageProducerFromURL(ARequestInfo.Document);

if Assigned(ppHtml) then
AResponseInfo.ContentText := ppHtml.Content
else
if IsRootFile(ARequestInfo.Document, lsFileName) then
AResponseInfo.ServeFile(AContext, lsFileName)
else begin

{Not on this sever - download it from the Host eg. www.google.com
etc.!}

FClientAccount :=
wispSession.ClientsAccounts.IsUserLoggedInByIP(ARequestInfo.RemoteIP);
lPlan :=
FClientAccount.ClientAccountPricingPlans.CurrentClientAccountPricingPlan;

//FThrottle := TIdInterceptThrottler.Create(AContext.Connection);
//AContext.Connection.IOHandler.Intercept := FThrottle;
//FThrottle.BitsPerSec := (lPlan.DownloadLimit*1024)*8; //As per the
client account.

try

if CompareText(ARequestInfo.Host,
wispSession.Configs.CurrentConfig.IPAddress) <> 0 then begin

lsHost := 'http://'+ARequestInfo.Host;

lsFileName := lsHost+ARequestInfo.Document;

lStream := TMemoryStream.Create;
try
idHttpClient.Get(lsFileName, lStream);
AResponseInfo.WriteContent;
finally
AResponseInfo.ContentStream.Free;
AResponseInfo.ContentStream := nil;
end;

end;

finally
AContext.Connection.IOHandler.Intercept.Free;
AContext.Connection.IOHandler.Intercept := nil;
end;

end;

end;

function TdmHttpServer.GetPageProducerFromURL(
const aURL: String): TPageProducer;
var
sReqeustedDoc: String;
sppFileName: String;
liIndex: Integer;
begin

Result := nil;

if aURL = '/' then begin
Result := ppLogin;
Exit;
end;

sReqeustedDoc := ExtractRequestFileformURL(aURL);

for liIndex := 0 to ComponentCount-1 do begin

if Components[liIndex] is TPageProducer then begin

sppFileName :=
ExtractFileName(TPageProducer(Components[liIndex]).HTMLFile);

if CompareText(sppFileName, sReqeustedDoc) = 0 then begin
Result := TPageProducer(Components[liIndex]);
Exit;
end;

end;

end;

end;

function TdmHttpServer.IsRootFile(const aURL: String;
var aFileName: String): Boolean;
begin

aFileName := '';

Result :=
FileExists(TwispSession(Owner).RootPath+ExtractRequestFileformURL(aURL));

aFileName := TwispSession(Owner).RootPath+ExtractRequestFileformURL(aURL);

end;

function TdmHttpServer.ExtractRequestFileformURL(
const aURL: String): String;
begin
Result := ExtractFileName(Copy(aURL, 2, Length(aURL)));
end;

procedure TdmHttpServer.DataModuleCreate(Sender: TObject);
var
liIndex: Integer;
pp: TPageProducer;
begin

for liIndex := 0 to ComponentCount-1 do begin

if Components[liIndex] is TPageProducer then begin

pp := TPageProducer(Components[liIndex]);

pp.HTMLFile := TwispSession(Owner).TemplatePath+Copy(pp.Name, 3,
Length(pp.Name))+'.htm';

end;

end;

end;

procedure TdmHttpServer.RedirUserToWWW(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo;
AResponseInfo: TIdHTTPResponseInfo);
var
lsResponse: String;
lPlan: TwispClientAccountPricingPlan;
begin

FClientAccount :=
wispSession.ClientsAccounts.IsUserLoggedInByIP(ARequestInfo.RemoteIP);
lPlan :=
FClientAccount.ClientAccountPricingPlans.CurrentClientAccountPricingPlan;

//FThrottle := TIdInterceptThrottler.Create(idHttpClient);
//AContext.Connection.IOHandler.Intercept := FThrottle;
//FThrottle.BitsPerSec := (lPlan.DownloadLimit*1024)*8; //As per the
client account.

lsResponse := idHttpClient.Get(ARequestInfo.Referer);
AResponseInfo.ContentText := lsResponse;
AResponseInfo.WriteContent;

//AContext.Connection.IOHandler.Intercept.Free;
//AContext.Connection.IOHandler.Intercept := nil;

end;

procedure TdmHttpServer.SetLoginMessage(const Value: String);
begin
FLoginMessage := Value;
end;

end.

Post by Remy Lebeau (TeamB)

Post by Hannes Gouws
Now when the user logs in and authentication is sucessful,
my TidHttpServer must serve as a internet gateway.

TIdHTTPServer is not really designed for that. You should consider using
TIdHTTPProxyServer or TIdMappedPortTCP instead.

Post by Hannes Gouws
This procedure serve only the actaul HTML text....

<snip>

Post by Hannes Gouws
Now I get a request back again into my main IdHTTPServer1CommandGet event
for the rest of the content like images etc...

Did you verify that all of that code is being called at the correct times?
Did you verify with a packet sniffer that you are actually passing the
data along correctly when needed? Your descriptions are too vague, and
your code too incomplete, to really diagnose your problem.
Gambit