Changeset 139


Ignore:
Timestamp:
Sep 9, 2022, 9:41:42 PM (21 months ago)
Author:
chronos
Message:
  • Fixed: Better handle invalid not found pages including correct HTTP code.
Location:
trunk
Files:
2 added
28 edited

Legend:

Unmodified
Added
Removed

  • trunk/Application/UWebSession.pas

    r138 r139  
    99
    1010type
     11
    1112  { TWebSession }
    1213
    … …  
    2526    BaseURL: string;
    2627    ModuleManager: TModuleManager;
     28    procedure PageNotFound;
    2729    procedure InitDatabase;
    2830    constructor Create; override;
    … …  
    3840  UCore, UModuleSystem, UModuleZdechovNET, UModuleUser, UPageAdmin, UModuleTV,
    3941  UModuleFinance, UModuleNetwork, UModulePortal, UModuleIS, UModuleBase,
    40   UModuleNews;
     42  UModuleNews, UPageNotFound;
    4143
    4244resourcestring
    … …  
    187189end;
    188190
     191procedure TWebSession.PageNotFound;
     192var
     193  Page: TPageNotFound;
     194begin
     195  Page := TPageNotFound.Create(nil);
     196  try
     197    if Assigned(Page.OnProduce) then
     198      Page.OnProduce(Self);
     199  finally
     200    Page.Free;
     201  end;
     202end;
     203
    189204
    190205end.

  • trunk/Modules/Base/UModuleBase.pas

    r138 r139  
    2121    HandlerData: THTTPHandlerData;
    2222    constructor Create(Owner: TComponent); override;
    23     destructor Destroy; override;
    2423    procedure Start; override;
    2524    procedure Stop; override;
    26     procedure Install; override;
    27     procedure Uninstall; override;
    28     procedure Upgrade; override;
    2925    property OnGeneratePage: TGeneratePageEvent read FOnGeneratePage write FOnGeneratePage;
    3026  end;
    … …  
    4743  Author := 'Chronosoft';
    4844  Dependencies.Add('System');
    49 end;
    50 
    51 destructor TModuleBase.Destroy;
    52 begin
    53   inherited;
    5445end;
    5546
    … …  
    7667end;
    7768
    78 procedure TModuleBase.Install;
    79 begin
    80   inherited Install;
    81 end;
    82 
    83 procedure TModuleBase.Uninstall;
    84 begin
    85   inherited Uninstall;
    86 end;
    87 
    88 procedure TModuleBase.Upgrade;
    89 begin
    90   inherited Upgrade;
    91 end;
    92 
    9369end.
    9470

  • trunk/Modules/Finance/UModuleFinance.pas

    r137 r139  
    44
    55uses
    6   Classes, SysUtils, UModularSystem, UModuleBase,
    7   UWebPage;
     6  Classes, SysUtils, UModularSystem, UModuleBase, UWebPage;
    87
    98type
    … …  
    1716    ModuleBase: TModuleBase;
    1817    constructor Create(Owner: TComponent); override;
    19     destructor Destroy; override;
    2018    procedure Start; override;
    2119    procedure Stop; override;
    2220    procedure Install; override;
    2321    procedure Uninstall; override;
    24     procedure Upgrade; override;
    2522  end;
    2623
    … …  
    4239  Author := 'Chronosoft';
    4340  Dependencies.Add('Base');
    44 end;
    45 
    46 destructor TModuleFinance.Destroy;
    47 begin
    48   inherited;
    4941end;
    5042
    … …  
    163155end;
    164156
    165 procedure TModuleFinance.Upgrade;
    166 begin
    167   inherited;
    168 end;
    169 
    170157end.
    171158

  • trunk/Modules/Finance/UPageFinance.pas

    r137 r139  
    1212  TWebPageFinance = class(TWebPage)
    1313    procedure DataModuleProduce(HandlerData: THTTPHandlerData);
    14   private
    15     { private declarations }
    16   public
    17     { public declarations }
    1814  end;
    1915

  • trunk/Modules/Network/UPageNetwork.pas

    r137 r139  
    88type
    99  TWebPageNetwork = class(TWebPage)
    10   private
    11     { private declarations }
    12   public
    13     { public declarations }
    1410  end;
    1511

  • trunk/Modules/ZdechovNET/UAboutPage.pas

    r138 r139  
    3636begin
    3737  with TWebSession(HandlerData) do begin
     38    if Request.Path.Count > 1 then begin
     39      PageNotFound;
     40      Exit;
     41    end;
     42
    3843    ModuleUser.LoadUserInfo;
    3944    with HtmlDocument.Body, SubItems.AddString do begin

  • trunk/Modules/ZdechovNET/UContactPage.pas

    r138 r139  
    1212  TContactPage = class(TWebPage)
    1313    procedure DataModuleProduce(HandlerData: THTTPHandlerData);
    14   private
    15     { private declarations }
    1614  public
    1715    ModuleUser: TModuleUser;
    … …  
    3230begin
    3331  with TWebSession(HandlerData), HtmlDocument.Body, SubItems.AddString do begin
     32    if Request.Path.Count > 1 then begin
     33      PageNotFound;
     34      Exit;
     35    end;
     36
    3437    ModuleUser.LoadUserInfo;
    3538    Text := '<strong>Kontaktní informace</strong><br/>' +

  • trunk/Modules/ZdechovNET/UDocumentsPage.pas

    r138 r139  
    1212  TDocumentsPage = class(TWebPage)
    1313    procedure DataModuleProduce(HandlerData: THTTPHandlerData);
    14   private
    15     { private declarations }
    1614  public
    1715    ModuleUser: TModuleUser;

  • trunk/Modules/ZdechovNET/UHistoryPage.pas

    r138 r139  
    1313  THistoryPage = class(TWebPage)
    1414    procedure DataModuleProduce(HandlerData: THTTPHandlerData);
    15   private
    16     { private declarations }
    1715  public
    1816    ModuleUser: TModuleUser;
    … …  
    3836begin
    3937  with TWebSession(HandlerData) do begin
     38    if Request.Path.Count > 1 then begin
     39      PageNotFound;
     40      Exit;
     41    end;
     42
    4043    ModuleUser.LoadUserInfo;
    4144    with HtmlDocument.Body, SubItems.AddString do begin

  • trunk/Modules/ZdechovNET/UHostingPage.pas

    r138 r139  
    1313  THostingPage = class(TWebPage)
    1414    procedure DataModuleProduce(HandlerData: THTTPHandlerData);
    15   private
    16     { private declarations }
    1715  public
    1816    ModuleUser: TModuleUser;
    … …  
    3836begin
    3937  with TWebSession(HandlerData) do begin
     38    if Request.Path.Count > 1 then begin
     39      PageNotFound;
     40      Exit;
     41    end;
     42
    4043    ModuleUser.LoadUserInfo;
    4144    with HtmlDocument.Body, SubItems.AddString do begin

  • trunk/Modules/ZdechovNET/UIPTVPage.pas

    r138 r139  
    8888begin
    8989  with TWebSession(HandlerData) do begin
     90    if Request.Path.Count > 1 then begin
     91      PageNotFound;
     92      Exit;
     93    end;
     94
    9095    ModuleUser.LoadUserInfo;
    9196    with HtmlDocument.Body, SubItems.AddString do begin

  • trunk/Modules/ZdechovNET/UInternetPage.pas

    r138 r139  
    1212  TInternetPage = class(TWebPage)
    1313    procedure DataModuleProduce(HandlerData: THTTPHandlerData);
    14   private
    15     { private declarations }
    1614  public
    1715    ModuleUser: TModuleUser;
    … …  
    3432begin
    3533  with TWebSession(HandlerData) do begin
     34    if Request.Path.Count > 1 then begin
     35      PageNotFound;
     36      Exit;
     37    end;
     38
    3639    ModuleUser.LoadUserInfo;
    3740    with HtmlDocument.Body, SubItems.AddString do begin

  • trunk/Modules/ZdechovNET/ULinksPage.pas

    r138 r139  
    1212  TLinksPage = class(TWebPage)
    1313    procedure DataModuleProduce(HandlerData: THTTPHandlerData);
    14   private
    15     { private declarations }
    1614  public
    1715    ModuleUser: TModuleUser;
    … …  
    3432begin
    3533  with TWebSession(HandlerData), HtmlDocument.Body, SubItems.AddString do begin
     34    if Request.Path.Count > 1 then begin
     35      PageNotFound;
     36      Exit;
     37    end;
     38
    3639    ModuleUser.LoadUserInfo;
    3740    Text := '<strong>Odkazy související s obcí:</strong><br/>' +

  • trunk/Modules/ZdechovNET/UNetworkPage.pas

    r138 r139  
    1212  TNetworkPage = class(TWebPage)
    1313    procedure DataModuleProduce(HandlerData: THTTPHandlerData);
    14   private
    15     { private declarations }
    1614  public
    1715    ModuleUser: TModuleUser;
    … …  
    3634begin
    3735  with TWebSession(HandlerData) do begin
     36    if Request.Path.Count > 1 then begin
     37      PageNotFound;
     38      Exit;
     39    end;
     40
    3841    ModuleUser.LoadUserInfo;
    3942    with HtmlDocument.Body, SubItems.AddString do begin

  • trunk/Modules/ZdechovNET/UPlansPage.pas

    r138 r139  
    1313  TPlansPage = class(TWebPage)
    1414    procedure DataModuleProduce(HandlerData: THTTPHandlerData);
    15   private
    16     { private declarations }
    1715  public
    1816    ModuleUser: TModuleUser;
    … …  
    3836begin
    3937  with TWebSession(HandlerData) do begin
     38    if Request.Path.Count > 1 then begin
     39      PageNotFound;
     40      Exit;
     41    end;
     42
    4043    ModuleUser.LoadUserInfo;
    4144    with HtmlDocument.Body, SubItems.AddString do begin

  • trunk/Modules/ZdechovNET/UProjectsPage.pas

    r138 r139  
    1313  TProjectsPage = class(TWebPage)
    1414    procedure DataModuleProduce(HandlerData: THTTPHandlerData);
    15   private
    16     { private declarations }
    1715  public
    1816    ModuleUser: TModuleUser;
    … …  
    3836begin
    3937  with TWebSession(HandlerData) do begin
     38    if Request.Path.Count > 1 then begin
     39      PageNotFound;
     40      Exit;
     41    end;
     42
    4043    ModuleUser.LoadUserInfo;
    4144    with HtmlDocument.Body, SubItems.AddString do begin

  • trunk/Modules/ZdechovNET/URobotsPage.pas

    r138 r139  
    3636begin
    3737  with TWebSession(HandlerData) do begin
     38    if Request.Path.Count > 1 then begin
     39      PageNotFound;
     40      Exit;
     41    end;
     42
    3843    ModuleUser.LoadUserInfo;
    3944    with HtmlDocument.Body, SubItems.AddString do begin

  • trunk/Modules/ZdechovNET/UVoIPPage.pas

    r138 r139  
    1212  TVoIPPage = class(TWebPage)
    1313    procedure DataModuleProduce(HandlerData: THTTPHandlerData);
    14   private
    15     { private declarations }
    1614  public
    1715    ModuleUser: TModuleUser;
    … …  
    3432begin
    3533  with TWebSession(HandlerData) do begin
     34    if Request.Path.Count > 1 then begin
     35      PageNotFound;
     36      Exit;
     37    end;
     38
    3639    ModuleUser.LoadUserInfo;
    3740    with HtmlDocument.Body, SubItems.AddString do begin

  • trunk/Modules/ZdechovNET/UWebCamPage.pas

    r138 r139  
    5353      CameraId := -1;
    5454      NotFound := False;
    55       if Request.Path.Count >= 2 then begin
     55      if Request.Path.Count = 2 then begin
    5656        SubPageName := Request.Path[1];
    5757        if TryStrToInt(SubPageName, Value) then
    5858          CameraId := Value else
    5959          NotFound := True;
    60       end;
    61       if not NotFound then begin
    62     //for I := 0 to HandlerData.Request.Query.Count - 1 do
    63       //Text := Text + HandlerData.Request.Query[I] + ' ';
    64 
    65       //HandlerData.Request.Query.Values['W'] := 'dsd';
    66       //HandlerData.Request.Query.Values['H'] := 'dsd';
     60      end else
     61      if Request.Path.Count > 2 then NotFound := True;
     62      if NotFound then begin
     63        PageNotFound;
     64        Exit;
     65      end;
     66
    6767      if HandlerData.Request.Query.TryGetValue('W', WidthValue) then
    6868        ImageWidth := StrToInt(WidthValue)
    … …  
    9191
    9292      Text := Text + '<br/><strong>Kamery v okolí:</strong><br />' +
    93         '<a href="http://www.mestovsetin.cz/vismo/dokumenty2.asp?id_org=18676&amp;id=480245">Vsetínské kamery</a><br />' +
     93        '<a href="https://www.mestovsetin.cz/webove%2Dkamery/d-480245">Vsetínské kamery</a><br />' +
    9494        '<a href="https://www.huslenky.cz/webkamery%2Dhuslenky/ds-1119/archiv=0&amp;p1=1020">Kamery v Huslenkách</a><br/>' +
    95         '<a href="http://kamery.hovnet.cz/">Kamery v Hovnetu</a><br/>' +
     95        '<a href="https://kamery.hovnet.cz/">Kamery v Hovnetu</a><br/>' +
    9696        '</td><td style="width: 80%" valign="top">';
    9797
    … …  
    101101        Text := Text + GetSingle(HandlerData, CameraId);
    102102      end;
    103 
    104103      Text := Text + '</td></tr></table>';
    105       end else Text := 'Stránka nenalezena.';
    106104    end;
    107105    GeneratePage(Self);

  • trunk/Packages/Common/UFormAbout.pas

    r137 r139  
    2020    PanelButtons: TPanel;
    2121    procedure ButtonHomePageClick(Sender: TObject);
    22     procedure FormCreate(Sender: TObject);
    2322    procedure FormShow(Sender: TObject);
    24   private
    25     { private declarations }
    2623  public
    2724    AboutDialog: TObject; //TAboutDialog
    … …  
    7774end;
    7875
    79 procedure TFormAbout.FormCreate(Sender: TObject);
    80 begin
    81 end;
    82 
    8376end.
    8477

  • trunk/Packages/Common/UGenerics.pas

    r138 r139  
    4343  for I := 0 to Count - 1 do begin
    4444    Result := Result + Items[I];
    45     if I > 0 then Result := Result + Separator;
     45    if I < Count - 1 then Result := Result + Separator;
    4646  end;
    4747end;

  • trunk/Packages/CoolWeb/WebServer/UHTTPServer.pas

    r138 r139  
    4343
    4444  THTTPResponse = class
     45    StatusCode: string;
    4546    ContentType: string;
    4647    Content: TMemoryStreamEx;
    … …  
    123124  SPageNotFound = 'Page %s not found.';
    124125
     126const
     127  StatusCodeNotFound = '404 Not Found';
     128
    125129
    126130implementation
    … …  
    134138begin
    135139  with HandlerData, Response.Content do begin
    136     //Response.Cookies.Values['Test'] := 'Halo';
    137     //Response.Cookies.Values['Test2'] := 'Halo2';
    138 
    139     //HTTPServer.SessionHandler.Variables.Values['Session1'] := 'Value1';
    140     //HTTPServer.SessionHandler.Variables.Values['Session2'] := 'Value2';
    141 
    142140    WriteString('<a href="?ServerInfo">Refresh</a>');
    143141
    … …  
    192190begin
    193191  with HandlerData, Response.Content do begin
     192    Response.StatusCode := StatusCodeNotFound;
    194193    WriteString('<html><body>' + Format(SPageNotFound, [Implode('/', Request.Path)]) + '</body></html>');
    195194  end;
    … …  
    224223    end else
    225224    with Response.Content do begin
    226       //WriteLn(Format(SFileNotFound, [Request.Path.Implode('/', StrToStr)]));
     225      Response.StatusCode := StatusCodeNotFound;
    227226      WriteString('<html><body>' + Format(SFileNotFound, [Implode('/', Request.Path)]) + '</body></html>');
    228227    end;
    … …  
    248247procedure THTTPResponse.Assign(Source: THTTPResponse);
    249248begin
     249  StatusCode := Source.StatusCode;
    250250  Content.Assign(Source.Content);
    251251  ContentType := Source.ContentType;
    … …  
    263263constructor THTTPResponse.Create;
    264264begin
     265  StatusCode := '200 OK';
    265266  Content := TMemoryStreamEx.Create;
    266267  Cookies := TCookieList.Create;
    … …  
    291292begin
    292293  I := 0;
    293   while (I < Count) and (TRequestHandler(Items[I]).Name <> AName) do Inc(I);
    294   if I < Count then Result := TRequestHandler(Items[I]) else Result := nil;
     294  while (I < Count) and (Items[I].Name <> AName) do Inc(I);
     295  if I < Count then Result := Items[I]
     296    else Result := nil;
    295297end;
    296298

  • trunk/Packages/CoolWeb/WebServer/UHTTPServerTCP.pas

    r138 r139  
    117117
    118118    with Response do begin
    119       SendString('HTTP/1.0 200 OK'#13#10);
     119      SendString('HTTP/1.0 ' + StatusCode + #13#10);
    120120      Headers.Add('Content-Length', IntToStr(Content.Size));
    121121      Headers.Add('Connection', 'close');

  • trunk/Packages/CoolWeb/WebServer/UTurboPowerForm.pas

    r137 r139  
    2424    procedure AShowSourceExecute(Sender: TObject);
    2525    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    26   private
    27     { private declarations }
    2826  public
    2927    HtmlSource: string;

  • trunk/Packages/PersistentData/Demo/UFormMain.pas

    r137 r139  
    2020    procedure ComboBox1Change(Sender: TObject);
    2121    procedure FormShow(Sender: TObject);
    22   private
    23     { private declarations }
    2422  public
    2523    Client: TPDClient;

  • trunk/Pages/UPageAdmin.pas

    r138 r139  
    1717    procedure HandleInstall(HandlerData: THTTPHandlerData);
    1818    procedure HandleUninstall(HandlerData: THTTPHandlerData);
    19   public
    20     { public declarations }
    2119  end;
    2220

  • trunk/UCore.pas

    r137 r139  
    1414
    1515type
     16
    1617  { TCore }
    1718

  • trunk/ZdechovNET.lpi

    r138 r139  
    118118      </Item6>
    119119    </RequiredPackages>
    120     <Units Count="40">
     120    <Units Count="41">
    121121      <Unit0>
    122122        <Filename Value="ZdechovNET.lpr"/>
    … …  
    135135        <IsPartOfProject Value="True"/>
    136136        <ComponentName Value="ServerInfoPage"/>
     137        <HasResources Value="True"/>
    137138        <ResourceBaseClass Value="DataModule"/>
    138139      </Unit3>
    … …  
    339340        <ResourceBaseClass Value="DataModule"/>
    340341      </Unit39>
     342      <Unit40>
     343        <Filename Value="Pages/UPageNotFound.pas"/>
     344        <IsPartOfProject Value="True"/>
     345        <ComponentName Value="PageNotFound"/>
     346        <ResourceBaseClass Value="DataModule"/>
     347      </Unit40>
    341348    </Units>
    342349  </ProjectOptions>
Note: See TracChangeset for help on using the changeset viewer.