httpauth.lpr 2.7 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788
  1. (* _ _
  2. * | |__ _ __ ___ ___ | | __
  3. * | '_ \| '__/ _ \ / _ \| |/ /
  4. * | |_) | | | (_) | (_) | <
  5. * |_.__/|_| \___/ \___/|_|\_\
  6. *
  7. * Microframework which helps to develop web Pascal applications.
  8. *
  9. * Copyright (c) 2012-2020 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. {$WARN 5024 OFF}
  32. uses
  33. SysUtils,
  34. BrookHTTPAuthentication,
  35. BrookHTTPRequest,
  36. BrookHTTPResponse,
  37. BrookHTTPServer;
  38. type
  39. THTTPServer = class(TBrookHTTPServer)
  40. protected
  41. function DoAuthenticate(ASender: TObject;
  42. AAuthentication: TBrookHTTPAuthentication; ARequest: TBrookHTTPRequest;
  43. AResponse: TBrookHTTPResponse): Boolean; override;
  44. procedure DoRequest(ASender: TObject; ARequest: TBrookHTTPRequest;
  45. AResponse: TBrookHTTPResponse); override;
  46. end;
  47. function THTTPServer.DoAuthenticate(ASender: TObject;
  48. AAuthentication: TBrookHTTPAuthentication; ARequest: TBrookHTTPRequest;
  49. AResponse: TBrookHTTPResponse): Boolean;
  50. begin
  51. AAuthentication.Credentials.Realm := 'My realm';
  52. Result := AAuthentication.Credentials.UserName.Equals('abc') and
  53. AAuthentication.Credentials.Password.Equals('123');
  54. if not Result then
  55. AAuthentication.Deny(
  56. '<html><head><title>Denied</title></head><body><font color="red">Go away</font></body></html>',
  57. 'text/html; charset=utf-8');
  58. end;
  59. procedure THTTPServer.DoRequest(ASender: TObject; ARequest: TBrookHTTPRequest;
  60. AResponse: TBrookHTTPResponse);
  61. begin
  62. AResponse.Send(
  63. '<html><head><title>Secret</title></head><body><font color="green">Secret page</font></body></html>',
  64. 'text/html; charset=utf-8', 200);
  65. end;
  66. begin
  67. with THTTPServer.Create(nil) do
  68. try
  69. Authenticated := True;
  70. NoFavicon := True;
  71. Open;
  72. if not Active then
  73. Exit;
  74. WriteLn('Server running at http://localhost:', Port);
  75. ReadLn;
  76. finally
  77. Free;
  78. end;
  79. end.