123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234 |
- (* Feel free to use this example code in any way
- you see fit (Public Domain) *)
- // Original example: https://gnunet.org/svn/libmicrohttpd/doc/examples/tlsauthentication.c
- (*
- * Generate PEM files for test this example:
- *
- * openssl req -newkey rsa:2048 -new -nodes -x509 -days 3650 -keyout key.pem -out cert.pem
- *
- * or
- *
- * openssl req -newkey rsa:2048 -new -nodes -x509 -days 3650 -keyout server.key -out server.pem
- *)
- program tlsauthentication;
- {$mode objfpc}{$H+}
- uses
- SysUtils, ctypes, cmem, cutils, libmicrohttpd;
- const
- PORT = 8888;
- REALM = '"Maintenance"';
- USER = 'a legitimate user';
- PASSWORD = 'and his password';
- SERVERKEYFILE = 'server.key';
- SERVERCERTFILE = 'server.pem';
- function iif(c: cbool; t, f: culong): culong;
- begin
- if c then
- Result := t
- else
- Result := f;
- end;
- function string_to_base64(message: Pcchar): Pcchar;
- var
- lookup: Pcchar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
- l: culong;
- i: cint;
- tmp: Pcchar;
- len: SizeInt;
- begin
- len := strlen(message);
- tmp := Malloc(len * 2);
- if nil = tmp then
- Exit(tmp);
- tmp[0] := #0;
- i := 0;
- while i < len do
- begin
- l := (culong(message[i]) shl 16)
- or iif((i + 1) < len, culong(message[i + 1]) shl 8, 0)
- or iif((i + 2) < len, culong(message[i + 2]), 0);
- strncat(tmp, @lookup[(l shr 18) and $3F], 1);
- strncat(tmp, @lookup[(l shr 12) and $3F], 1);
- if i + 1 < len then
- strncat(tmp, @lookup[(l shr 6) and $3F], 1);
- if i + 2 < len then
- strncat(tmp, @lookup[l and $3F], 1);
- i += 3;
- end;
- if (len mod 3 = 1) then
- strncat(tmp, '===', 3 - len mod 3);
- Result := tmp;
- end;
- function get_file_size(filename: Pcchar): clong;
- var
- fp: FILEptr;
- size: clong;
- begin
- fp := fopen(filename, fopenread);
- if Assigned(fp) then
- begin
- if 0 <> fseek(fp, 0, SEEK_END) then
- size := 0;
- size := ftell(fp);
- if -1 = size then
- size := 0;
- fclose(fp);
- Result := size;
- end
- else
- Result := 0;
- end;
- function load_file(filename: Pcchar): Pcchar;
- var
- fp: FILEptr;
- buffer: Pcchar;
- size: clong;
- begin
- size := get_file_size(filename);
- if size = 0 then
- Exit(nil);
- fp := fopen(filename, fopenread);
- if not Assigned(fp) then
- Exit(nil);
- buffer := Malloc(size);
- if not Assigned(buffer) then
- begin
- fclose(fp);
- Exit(nil);
- end;
- if size <> fread(buffer, 1, size, fp) then
- begin
- free(buffer);
- buffer := nil;
- end;
- fclose(fp);
- Result := buffer;
- end;
- function ask_for_authentication(connection: PMHD_Connection;
- realm: Pcchar): cint; cdecl;
- var
- ret: cint;
- response: PMHD_Response;
- headervalue: Pcchar;
- strbase: Pcchar = 'Basic realm=';
- begin
- response := MHD_create_response_from_buffer(0, nil, MHD_RESPMEM_PERSISTENT);
- if not Assigned(response) then
- Exit(MHD_NO);
- headervalue := Malloc(strlen(strbase) + strlen(realm) + 1);
- if not Assigned(headervalue) then
- Exit(MHD_NO);
- strcpy(headervalue, strbase);
- strcat(headervalue, realm);
- ret := MHD_add_response_header(response, 'WWW-Authenticate', headervalue);
- Free(headervalue);
- if ret <> 1 then
- begin
- MHD_destroy_response(response);
- Exit(MHD_NO);
- end;
- ret := MHD_queue_response(connection, MHD_HTTP_UNAUTHORIZED, response);
- MHD_destroy_response(response);
- Result := ret;
- end;
- function is_authenticated(connection: PMHD_Connection;
- username, password: Pcchar): cint; cdecl;
- var
- headervalue: Pcchar;
- expected_b64, expected: Pcchar;
- strbase: Pcchar = 'Basic ';
- authenticated: cint;
- begin
- headervalue := MHD_lookup_connection_value(connection, MHD_HEADER_KIND,
- 'Authorization');
- if nil = headervalue then
- Exit(0);
- if 0 <> strncmp(headervalue, strbase, strlen(strbase)) then
- Exit(0);
- expected := malloc(strlen(username) + 1 + strlen(password) + 1);
- if nil = expected then
- Exit(0);
- strcpy(expected, username);
- strcat(expected, ':');
- strcat(expected, password);
- expected_b64 := string_to_base64(expected);
- free(expected);
- if nil = expected_b64 then
- Exit(0);
- authenticated := cint(strcomp(headervalue + strlen(strbase), expected_b64) = 0);
- Free(expected_b64);
- Result := authenticated;
- end;
- function secret_page(connection: PMHD_Connection): cint; cdecl;
- var
- ret: cint;
- response: PMHD_Response;
- page: Pcchar = '<html><body>A secret.</body></html>';
- begin
- response := MHD_create_response_from_buffer(strlen(page), Pointer(page),
- MHD_RESPMEM_PERSISTENT);
- if not Assigned(response) then
- Exit(MHD_NO);
- ret := MHD_queue_response(connection, MHD_HTTP_OK, response);
- MHD_destroy_response(response);
- Result := ret;
- end;
- function answer_to_connection(cls: Pointer; connection: PMHD_Connection;
- url: Pcchar; method: Pcchar; version: Pcchar; upload_data: Pcchar;
- upload_data_size: Psize_t; con_cls: PPointer): cint; cdecl;
- begin
- if 0 <> strcomp(method, 'GET') then
- Exit(MHD_NO);
- if nil = con_cls^ then
- begin
- con_cls^ := connection;
- Exit(MHD_YES);
- end;
- if is_authenticated(connection, USER, PASSWORD) <> 1 then
- Exit(ask_for_authentication(connection, REALM));
- Result := secret_page(connection);
- end;
- var
- daemon: PMHD_Daemon;
- key_pem: Pcchar;
- cert_pem: Pcchar;
- begin
- key_pem := load_file(SERVERKEYFILE);
- cert_pem := load_file(SERVERCERTFILE);
- if (key_pem = nil) or (cert_pem = nil) then
- begin
- WriteLn('The key/certificate files could not be read.');
- Halt(1);
- end;
- daemon := MHD_start_daemon(MHD_USE_SELECT_INTERNALLY or MHD_USE_SSL, PORT,
- nil, nil, @answer_to_connection, nil, MHD_OPTION_HTTPS_MEM_KEY, key_pem,
- MHD_OPTION_HTTPS_MEM_CERT, cert_pem, MHD_OPTION_END);
- if nil = daemon then
- begin
- WriteLn(cert_pem);
- Free(key_pem);
- Free(cert_pem);
- Halt(1);
- end;
- ReadLn;
- MHD_stop_daemon(daemon);
- Free(key_pem);
- Free(cert_pem);
- end.
|