tlsauthentication.pp 6.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234
  1. (* Feel free to use this example code in any way
  2. you see fit (Public Domain) *)
  3. // Original example: https://gnunet.org/svn/libmicrohttpd/doc/examples/tlsauthentication.c
  4. (*
  5. * Generate PEM files for test this example:
  6. *
  7. * openssl req -newkey rsa:2048 -new -nodes -x509 -days 3650 -keyout key.pem -out cert.pem
  8. *
  9. * or
  10. *
  11. * openssl req -newkey rsa:2048 -new -nodes -x509 -days 3650 -keyout server.key -out server.pem
  12. *)
  13. program tlsauthentication;
  14. {$mode objfpc}{$H+}
  15. uses
  16. SysUtils, ctypes, cmem, cutils, libmicrohttpd;
  17. const
  18. PORT = 8888;
  19. REALM = '"Maintenance"';
  20. USER = 'a legitimate user';
  21. PASSWORD = 'and his password';
  22. SERVERKEYFILE = 'server.key';
  23. SERVERCERTFILE = 'server.pem';
  24. function iif(c: cbool; t, f: culong): culong;
  25. begin
  26. if c then
  27. Result := t
  28. else
  29. Result := f;
  30. end;
  31. function string_to_base64(message: Pcchar): Pcchar;
  32. var
  33. lookup: Pcchar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  34. l: culong;
  35. i: cint;
  36. tmp: Pcchar;
  37. len: SizeInt;
  38. begin
  39. len := strlen(message);
  40. tmp := Malloc(len * 2);
  41. if nil = tmp then
  42. Exit(tmp);
  43. tmp[0] := #0;
  44. i := 0;
  45. while i < len do
  46. begin
  47. l := (culong(message[i]) shl 16)
  48. or iif((i + 1) < len, culong(message[i + 1]) shl 8, 0)
  49. or iif((i + 2) < len, culong(message[i + 2]), 0);
  50. strncat(tmp, @lookup[(l shr 18) and $3F], 1);
  51. strncat(tmp, @lookup[(l shr 12) and $3F], 1);
  52. if i + 1 < len then
  53. strncat(tmp, @lookup[(l shr 6) and $3F], 1);
  54. if i + 2 < len then
  55. strncat(tmp, @lookup[l and $3F], 1);
  56. i += 3;
  57. end;
  58. if (len mod 3 = 1) then
  59. strncat(tmp, '===', 3 - len mod 3);
  60. Result := tmp;
  61. end;
  62. function get_file_size(filename: Pcchar): clong;
  63. var
  64. fp: FILEptr;
  65. size: clong;
  66. begin
  67. fp := fopen(filename, fopenread);
  68. if Assigned(fp) then
  69. begin
  70. if 0 <> fseek(fp, 0, SEEK_END) then
  71. size := 0;
  72. size := ftell(fp);
  73. if -1 = size then
  74. size := 0;
  75. fclose(fp);
  76. Result := size;
  77. end
  78. else
  79. Result := 0;
  80. end;
  81. function load_file(filename: Pcchar): Pcchar;
  82. var
  83. fp: FILEptr;
  84. buffer: Pcchar;
  85. size: clong;
  86. begin
  87. size := get_file_size(filename);
  88. if size = 0 then
  89. Exit(nil);
  90. fp := fopen(filename, fopenread);
  91. if not Assigned(fp) then
  92. Exit(nil);
  93. buffer := Malloc(size);
  94. if not Assigned(buffer) then
  95. begin
  96. fclose(fp);
  97. Exit(nil);
  98. end;
  99. if size <> fread(buffer, 1, size, fp) then
  100. begin
  101. free(buffer);
  102. buffer := nil;
  103. end;
  104. fclose(fp);
  105. Result := buffer;
  106. end;
  107. function ask_for_authentication(connection: PMHD_Connection;
  108. realm: Pcchar): cint; cdecl;
  109. var
  110. ret: cint;
  111. response: PMHD_Response;
  112. headervalue: Pcchar;
  113. strbase: Pcchar = 'Basic realm=';
  114. begin
  115. response := MHD_create_response_from_buffer(0, nil, MHD_RESPMEM_PERSISTENT);
  116. if not Assigned(response) then
  117. Exit(MHD_NO);
  118. headervalue := Malloc(strlen(strbase) + strlen(realm) + 1);
  119. if not Assigned(headervalue) then
  120. Exit(MHD_NO);
  121. strcpy(headervalue, strbase);
  122. strcat(headervalue, realm);
  123. ret := MHD_add_response_header(response, 'WWW-Authenticate', headervalue);
  124. Free(headervalue);
  125. if ret <> 1 then
  126. begin
  127. MHD_destroy_response(response);
  128. Exit(MHD_NO);
  129. end;
  130. ret := MHD_queue_response(connection, MHD_HTTP_UNAUTHORIZED, response);
  131. MHD_destroy_response(response);
  132. Result := ret;
  133. end;
  134. function is_authenticated(connection: PMHD_Connection;
  135. username, password: Pcchar): cint; cdecl;
  136. var
  137. headervalue: Pcchar;
  138. expected_b64, expected: Pcchar;
  139. strbase: Pcchar = 'Basic ';
  140. authenticated: cint;
  141. begin
  142. headervalue := MHD_lookup_connection_value(connection, MHD_HEADER_KIND,
  143. 'Authorization');
  144. if nil = headervalue then
  145. Exit(0);
  146. if 0 <> strncmp(headervalue, strbase, strlen(strbase)) then
  147. Exit(0);
  148. expected := malloc(strlen(username) + 1 + strlen(password) + 1);
  149. if nil = expected then
  150. Exit(0);
  151. strcpy(expected, username);
  152. strcat(expected, ':');
  153. strcat(expected, password);
  154. expected_b64 := string_to_base64(expected);
  155. free(expected);
  156. if nil = expected_b64 then
  157. Exit(0);
  158. authenticated := cint(strcomp(headervalue + strlen(strbase), expected_b64) = 0);
  159. Free(expected_b64);
  160. Result := authenticated;
  161. end;
  162. function secret_page(connection: PMHD_Connection): cint; cdecl;
  163. var
  164. ret: cint;
  165. response: PMHD_Response;
  166. page: Pcchar = '<html><body>A secret.</body></html>';
  167. begin
  168. response := MHD_create_response_from_buffer(strlen(page), Pointer(page),
  169. MHD_RESPMEM_PERSISTENT);
  170. if not Assigned(response) then
  171. Exit(MHD_NO);
  172. ret := MHD_queue_response(connection, MHD_HTTP_OK, response);
  173. MHD_destroy_response(response);
  174. Result := ret;
  175. end;
  176. function answer_to_connection(cls: Pointer; connection: PMHD_Connection;
  177. url: Pcchar; method: Pcchar; version: Pcchar; upload_data: Pcchar;
  178. upload_data_size: Psize_t; con_cls: PPointer): cint; cdecl;
  179. begin
  180. if 0 <> strcomp(method, 'GET') then
  181. Exit(MHD_NO);
  182. if nil = con_cls^ then
  183. begin
  184. con_cls^ := connection;
  185. Exit(MHD_YES);
  186. end;
  187. if is_authenticated(connection, USER, PASSWORD) <> 1 then
  188. Exit(ask_for_authentication(connection, REALM));
  189. Result := secret_page(connection);
  190. end;
  191. var
  192. daemon: PMHD_Daemon;
  193. key_pem: Pcchar;
  194. cert_pem: Pcchar;
  195. begin
  196. key_pem := load_file(SERVERKEYFILE);
  197. cert_pem := load_file(SERVERCERTFILE);
  198. if (key_pem = nil) or (cert_pem = nil) then
  199. begin
  200. WriteLn('The key/certificate files could not be read.');
  201. Halt(1);
  202. end;
  203. daemon := MHD_start_daemon(MHD_USE_SELECT_INTERNALLY or MHD_USE_SSL, PORT,
  204. nil, nil, @answer_to_connection, nil, MHD_OPTION_HTTPS_MEM_KEY, key_pem,
  205. MHD_OPTION_HTTPS_MEM_CERT, cert_pem, MHD_OPTION_END);
  206. if nil = daemon then
  207. begin
  208. WriteLn(cert_pem);
  209. Free(key_pem);
  210. Free(cert_pem);
  211. Halt(1);
  212. end;
  213. ReadLn;
  214. MHD_stop_daemon(daemon);
  215. Free(key_pem);
  216. Free(cert_pem);
  217. end.