PageRenderTime 11ms CodeModel.GetById 1ms app.highlight 4ms RepoModel.GetById 1ms app.codeStats 1ms

/components/fpweb/demo/fptemplate/sessions/urlsessions-login/cgi/webmodule.pas

http://github.com/graemeg/lazarus
Pascal | 378 lines | 287 code | 59 blank | 32 comment | 30 complexity | 6b061dfcc630f728a667323f99bc9607 MD5 | raw file
  1 unit webmodule;
  2
  3{$mode objfpc}{$H+}
  4
  5interface
  6
  7uses
  8  Classes, SysUtils, FileUtil, LResources, HTTPDefs, websession, fpHTTP, fpWeb; 
  9
 10type
 11
 12  { TFPWebModule1 }
 13
 14  TFPWebModule1 = class(TFPWebModule)
 15    procedure DataModuleAfterResponse(Sender: TObject; AResponse: TResponse);
 16    procedure DataModuleCreate(Sender: TObject);
 17    procedure loginRequest(Sender: TObject; ARequest: TRequest;
 18      AResponse: TResponse; var Handled: Boolean);
 19    procedure logoutRequest(Sender: TObject; ARequest: TRequest;
 20      AResponse: TResponse; var Handled: Boolean);
 21    procedure someactionRequest(Sender: TObject; ARequest: TRequest;
 22      AResponse: TResponse; var Handled: Boolean);
 23  private
 24    { private declarations }
 25    LoggedInLoginName : String;
 26    SessionID: String;
 27    SessionDBFile : String;
 28    UserDBFile : String;
 29    SessionVariable: String;
 30    TimeoutMinutes: Integer;
 31    function RemoveExpiredSessions(SL:TStringList; const SIDToDelete:String):Boolean;
 32    function NotLoggedIn:Boolean;
 33    function CommonTemplateTagReplaces(const TagString:String;
 34      TagParams: TStringList; Out ReplaceText: String):Boolean;
 35
 36    procedure loginReplaceTag(Sender: TObject; const TagString:String;
 37      TagParams: TStringList; Out ReplaceText: String);
 38    procedure logoutReplaceTag(Sender: TObject; const TagString:String;
 39      TagParams: TStringList; Out ReplaceText: String);
 40    procedure welcomeReplaceTag(Sender: TObject; const TagString:String;
 41      TagParams: TStringList; Out ReplaceText: String);
 42    procedure someactionReplaceTag(Sender: TObject; const TagString:String;
 43      TagParams: TStringList; Out ReplaceText: String);
 44  public
 45    { public declarations }
 46  end; 
 47
 48var
 49  FPWebModule1: TFPWebModule1; 
 50
 51implementation
 52
 53{ TFPWebModule1 }
 54
 55procedure TFPWebModule1.DataModuleAfterResponse(Sender: TObject;
 56  AResponse: TResponse);
 57var
 58  sessiondatabase:TStringList;
 59  SIDLastRefresh:String;
 60begin
 61  //update the session DB for the current session
 62  if (SessionID <> '')and(LoggedinLoginName <> '') then
 63  begin//for many concurrent request websites this part needs to be modified to have some kind of locking while writing into the file/relational database
 64    SIDLastRefresh := '';
 65    sessiondatabase := TStringList.Create;
 66    if FileExists(sessiondbfile) then
 67      sessiondatabase.LoadFromFile(sessiondbfile);
 68    SIDLastRefresh := sessiondatabase.Values[SessionID];
 69    if SIDLastRefresh <> '' then
 70    begin
 71      sessiondatabase.Values[SessionID] := DateTimeToStr(Now) + LoggedinLoginName;//update the Last refresh time
 72      sessiondatabase.SaveToFile(sessiondbfile);
 73    end;
 74    sessiondatabase.Free;
 75  end;
 76
 77  //reset global variables for apache modules for the next incoming request
 78  LoggedInLoginName := '';
 79  SessionID := '';
 80  //
 81end;
 82
 83procedure TFPWebModule1.DataModuleCreate(Sender: TObject);
 84begin
 85  Template.AllowTagParams := true;
 86  Template.StartDelimiter := '{+'; //The default is { and } which is usually not good if we use Javascript in our templates
 87  Template.EndDelimiter := '+}';
 88  sessiondbfile := 'session-db.txt';//This will contain the sessionID=expiration pairs
 89  userdbfile := 'userdb.txt';      //This simulates a user database with passwords
 90  TimeOutMinutes := 2;             //With a session timeout of 2 minutes
 91  SessionVariable := 'sid';        //Query parameter name for the session ID, for all links in the templates
 92  LongTimeFormat := 'hh:mm:ss';    //to save on date time conversion code
 93  ShortDateFormat := 'YYYY/MM/DD'; //to save on date time conversion code
 94end;
 95
 96function FindNameInList(const SL:TStrings; const N:String):String;
 97var
 98    i : Integer;
 99begin
100  Result := '';
101  for i := 0 to SL.Count - 1 do
102    if SL.Names[i] = N then
103    begin
104      Result := SL.Values[SL.Names[i]];
105      break;
106    end;
107end;
108
109function TFPWebModule1.RemoveExpiredSessions(SL:TStringList; const SIDToDelete:String):Boolean;
110var
111  DT:TDateTime;
112  i, j: Integer;
113  s, SIDLastRefresh: String;
114begin
115  Result := false;
116
117  if SL.Count <= 0 then Exit;
118  i := 0;
119  repeat
120    s := SL[i];
121    j := pos('=', s);
122    if j > 0 then
123    begin
124      if copy(s, 1, j - 1) = SIDToDelete then
125      begin
126        SL.Delete(i);
127        dec(i);
128      end else begin
129        SIDLastRefresh := copy(s, j + 1, 19);{YYYY/MM/DD hh:mm:ss}
130        DT := StrToDateTime(SIDLastRefresh);
131        if ((Now - DT) > (TimeOutMinutes/1440)) then
132        begin
133          Result := true;
134          SL.Delete(i);
135          dec(i);
136        end;
137      end;
138    end;
139    inc(i);
140  until i >= SL.Count;
141end;
142
143function TFPWebModule1.NotLoggedIn:Boolean;
144var
145  sessiondatabase:TStringlist;
146  SIDLastRefresh:String;
147begin
148  Result := false;
149
150  //check if the current sessionID is valid
151  SessionID := UpperCase(Request.QueryFields.Values[SessionVariable]);
152  if SessionID <> '' then
153  begin
154    sessiondatabase := TStringList.Create;
155    if FileExists(sessiondbfile) then
156      sessiondatabase.LoadFromFile(sessiondbfile);
157//    if RemoveExpiredSessions(sessiondatabase, '') then  //Remove all expired sessions
158//      sessiondatabase.SaveToFile(sessiondbfile);   {enough to purge only at logout events}
159    RemoveExpiredSessions(sessiondatabase, '');      {                                     }
160    SIDLastRefresh := sessiondatabase.Values[SessionID];
161    sessiondatabase.Free;
162
163    if SIDLastRefresh <> '' then
164    begin
165      LoggedinLoginName := copy(SIDLastRefresh, 20, 1024);
166      Exit;//OK
167    end;
168  end;
169
170  //show the login screen again with the expired session message
171  Template.FileName := 'testurllogin.html';
172  Template.OnReplaceTag := @loginReplaceTag;
173  Request.QueryFields.Add('MSG=SESSIONEXPIRED');
174  Response.Content := Template.GetContent;
175  Result := true;
176end;
177
178procedure TFPWebModule1.loginRequest(Sender: TObject; ARequest: TRequest;
179  AResponse: TResponse; var Handled: Boolean);
180var
181  loginname, pwd, pwd1 : String;
182  userdatabase, sessiondatabase : TStringlist;
183  G : TGUID;
184begin
185  Handled := true;
186  Template.FileName := 'testurllogin.html';
187  Template.OnReplaceTag := @loginReplaceTag;
188  AResponse.CustomHeaders.Add('Pragma=no-cache');//do not cache the response in the web browser
189
190  if FindNameInList(ARequest.ContentFields, 'LoginName') = '' then
191  begin//called the login action without parameters -> display the login page
192    ARequest.QueryFields.Add('MSG=NORMAL');
193    AResponse.Content := Template.GetContent;
194    Exit;
195  end;
196
197  loginname := Trim(ARequest.ContentFields.Values['LoginName']);
198  pwd := Trim(ARequest.ContentFields.Values['Password']);
199  if (pwd = '') or (loginname = '') then
200  begin//empty login name or password -> return to the login screen
201    ARequest.QueryFields.Add('MSG=MISSING');
202    AResponse.Content := Template.GetContent;
203    Exit;
204  end;
205
206  //simulate a user database loaded into a stringlist
207  userdatabase := TStringlist.Create;
208  userdatabase.LoadFromFile(userdbfile);
209  //
210
211  pwd1 := userdatabase.values[LoginName];
212  userdatabase.free;
213  if pwd <> pwd1 then
214  begin//either the password or the login name was invalid
215    ARequest.QueryFields.Add('MSG=INVLOGIN');
216    AResponse.Content := Template.GetContent;
217    Exit;
218  end;
219
220  //succesful login
221  LoggedInLoginName := loginname;
222
223  //session starting, need to store it somewhere next to the name of the logged in person
224  sessiondatabase := TStringList.Create;
225  if FileExists(sessiondbfile) then
226    sessiondatabase.LoadFromFile(sessiondbfile);
227  CreateGUID(G);
228  SessionID:=UpperCase(GuiDToString(G));
229  sessiondatabase.Add(SessionID + '=' + DateTimeToStr(Now) + LoggedinLoginName);//create a new entry for this session
230  sessiondatabase.SaveToFile(sessiondbfile);//for many concurrent request websites this part needs to be modified to have some kind of locking while writing into the file/relational database
231  sessiondatabase.Free;
232
233  //generate the Welcome page content
234  Template.FileName := 'testurlwelcome.html';
235  Template.OnReplaceTag := @welcomeReplaceTag;
236  AResponse.Content := Template.GetContent;
237end;
238
239procedure TFPWebModule1.loginReplaceTag(Sender: TObject; const TagString:
240  String; TagParams: TStringList; Out ReplaceText: String);
241begin
242  {Handle tags used in multiple templates}
243  if CommonTemplateTagReplaces(TagString, TagParams, ReplaceText) then
244    Exit;
245
246  {Handle tags specific to this template if there are any}
247  if AnsiCompareText(TagString, 'MESSAGE') = 0 then
248  begin
249    ReplaceText := TagParams.Values[Request.QueryFields.Values['MSG']];
250  end else
251
252  {Message for tags not handled}
253  begin
254    ReplaceText := '[Template tag {+' + TagString + '+} is not implemented yet.]';
255  end;
256end;
257
258procedure TFPWebModule1.welcomeReplaceTag(Sender: TObject; const TagString:String;
259      TagParams: TStringList; Out ReplaceText: String);
260begin
261  {Handle tags used in multiple templates}
262  if CommonTemplateTagReplaces(TagString, TagParams, ReplaceText) then
263    Exit;
264
265  {Handle tags specific to this template if there are any}
266
267
268  {Message for tags not handled}
269  begin
270    ReplaceText := '[Template tag {+' + TagString + '+} is not implemented yet.]';
271  end;
272end;
273
274procedure TFPWebModule1.logoutRequest(Sender: TObject; ARequest: TRequest;
275  AResponse: TResponse; var Handled: Boolean);
276var
277  sessiondatabase : TStringList;
278begin
279  Handled := true;
280
281  if NotLoggedIn then Exit;
282
283  //delete the sessionID from the sessiondb with all expired sessions
284  sessiondatabase := TStringList.Create;
285  if FileExists(sessiondbfile) then
286    sessiondatabase.LoadFromFile(sessiondbfile);
287  RemoveExpiredSessions(sessiondatabase, SessionID);
288  sessiondatabase.SaveToFile(sessiondbfile);//for many concurrent request websites this part needs to be modified to have some kind of locking while writing into the file/relational database
289  sessiondatabase.Free;
290  //
291
292  Template.FileName := 'testurllogout.html';
293  Template.OnReplaceTag := @logoutReplaceTag;
294  AResponse.Content := Template.GetContent;//generate the Logout page content.
295end;
296
297procedure TFPWebModule1.logoutReplaceTag(Sender: TObject; const TagString:String;
298  TagParams: TStringList; Out ReplaceText: String);
299begin
300  {Handle tags used in multiple templates}
301  if CommonTemplateTagReplaces(TagString, TagParams, ReplaceText) then
302    Exit;
303
304  {Handle tags specific to this template if there are any}
305
306
307  {Message for tags not handled}
308  begin
309    ReplaceText := '[Template tag {+' + TagString + '+} is not implemented yet.]';
310  end;
311end;
312
313procedure TFPWebModule1.someactionRequest(Sender: TObject; ARequest: TRequest;
314  AResponse: TResponse; var Handled: Boolean);
315begin
316  Handled := true;
317
318  if NotLoggedIn then Exit;
319
320  Template.FileName := 'testurlsomepage.html';
321  Template.OnReplaceTag := @someactionReplaceTag;
322  AResponse.Content := Template.GetContent;
323end;
324
325procedure TFPWebModule1.someactionReplaceTag(Sender: TObject; const TagString:
326  String; TagParams: TStringList; Out ReplaceText: String);
327begin
328  {Handle tags used in multiple templates}
329  if CommonTemplateTagReplaces(TagString, TagParams, ReplaceText) then
330    Exit;
331
332  {Handle tags specific to this template if there are any}
333
334
335  {Message for tags not handled}
336  begin
337    ReplaceText := '[Template tag {+' + TagString + '+} is not implemented yet.]';
338  end;
339end;
340
341function TFPWebModule1.CommonTemplateTagReplaces(const TagString:String;
342  TagParams: TStringList; out ReplaceText: String):Boolean;
343begin
344  Result := true;
345
346  if AnsiCompareText(TagString, 'SESSION-VARIABLE') = 0 then
347  begin
348    ReplaceText := SessionVariable + '=' + SessionID;
349  end else
350
351  if AnsiCompareText(TagString, 'DATETIME') = 0 then
352  begin
353    ReplaceText := FormatDateTime(TagParams.Values['FORMAT'], Now);
354  end else
355
356  if AnsiCompareText(TagString, 'SESSIONID') = 0 then
357  begin
358    ReplaceText := SessionID;
359  end else
360
361  if AnsiCompareText(TagString, 'MINUTESLEFT') = 0 then
362  begin
363    ReplaceText := IntToStr(TimeOutMinutes);
364  end else
365
366  if AnsiCompareText(TagString, 'LOGINNAME') = 0 then
367  begin
368    ReplaceText := LoggedInLoginName;
369  end else
370
371  Result := false;
372end;
373
374initialization
375  {$I webmodule.lrs}
376
377  RegisterHTTPModule('TFPWebModule1', TFPWebModule1); 
378end.