Indy10 - D7
Hannes Gouws
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)
"Hannes Gouws" <Hannes...@bcx.co.za> wrote in message
news:485a...@newsgroups.borland.com...
> 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.
> This procedure serve only the actaul HTML text....
<snip>
> 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
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.
"Remy Lebeau (TeamB)" <no....@no.spam.com> wrote in message
news:485acd5e$1...@newsgroups.borland.com...