httpauth.lpr 2.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687
  1. (* _ _
  2. * | |__ _ __ ___ ___ | | __
  3. * | '_ \| '__/ _ \ / _ \| |/ /
  4. * | |_) | | | (_) | (_) | <
  5. * |_.__/|_| \___/ \___/|_|\_\
  6. *
  7. * Microframework which helps to develop web Pascal applications.
  8. *
  9. * Copyright (c) 2012-2021 Silvio Clecio <[email protected]>
  10. *
  11. * Brook framework is free software; you can redistribute it and/or
  12. * modify it under the terms of the GNU Lesser General Public
  13. * License as published by the Free Software Foundation; either
  14. * version 2.1 of the License, or (at your option) any later version.
  15. *
  16. * Brook framework is distributed in the hope that it will be useful,
  17. * but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  19. * Lesser General Public License for more details.
  20. *
  21. * You should have received a copy of the GNU Lesser General Public
  22. * License along with Brook framework; if not, write to the Free Software
  23. * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  24. *)
  25. program httpauth;
  26. {
  27. Test using cURL:
  28. curl -u abc:123 http://localhost:<PORT>
  29. }
  30. {$MODE DELPHI}
  31. uses
  32. SysUtils,
  33. BrookHTTPAuthentication,
  34. BrookHTTPRequest,
  35. BrookHTTPResponse,
  36. BrookHTTPServer;
  37. type
  38. THTTPServer = class(TBrookHTTPServer)
  39. protected
  40. function DoAuthenticate(ASender: TObject;
  41. AAuthentication: TBrookHTTPAuthentication; ARequest: TBrookHTTPRequest;
  42. AResponse: TBrookHTTPResponse): Boolean; override;
  43. procedure DoRequest(ASender: TObject; ARequest: TBrookHTTPRequest;
  44. AResponse: TBrookHTTPResponse); override;
  45. end;
  46. function THTTPServer.DoAuthenticate(ASender: TObject;
  47. AAuthentication: TBrookHTTPAuthentication; ARequest: TBrookHTTPRequest;
  48. AResponse: TBrookHTTPResponse): Boolean;
  49. begin
  50. AAuthentication.Credentials.Realm := 'My realm';
  51. Result := AAuthentication.Credentials.UserName.Equals('abc') and
  52. AAuthentication.Credentials.Password.Equals('123');
  53. if not Result then
  54. AAuthentication.Deny(
  55. '<html><head><title>Denied</title></head><body><font color="red">Go away</font></body></html>',
  56. 'text/html; charset=utf-8');
  57. end;
  58. procedure THTTPServer.DoRequest(ASender: TObject; ARequest: TBrookHTTPRequest;
  59. AResponse: TBrookHTTPResponse);
  60. begin
  61. AResponse.Send(
  62. '<html><head><title>Secret</title></head><body><font color="green">Secret page</font></body></html>',
  63. 'text/html; charset=utf-8', 200);
  64. end;
  65. begin
  66. with THTTPServer.Create(nil) do
  67. try
  68. Authenticated := True;
  69. NoFavicon := True;
  70. Open;
  71. if not Active then
  72. Exit;
  73. WriteLn('Server running at http://localhost:', Port);
  74. ReadLn;
  75. finally
  76. Free;
  77. end;
  78. end.