(*
This file is part of libmicrohttpd
Copyright (C) 2007, 2008 Christian Grothoff (and other contributing authors)
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*)
(**
* @file https_fileserver_example.pp (Original: https_fileserver_example.c)
* @brief a simple HTTPS file server using TLS.
*
* Usage :
*
* 'https_fileserver_example HTTP-PORT'
*
* The certificate & key are required by the server to operate, Omitting the
* path arguments will cause the server to use the hard coded example certificate & key.
*
* 'certtool' may be used to generate these if required.
*
* @author Sagie Amir / Silvio Clécio
*)
program https_fileserver_example;
{$mode objfpc}{$H+}
uses
sysutils, BaseUnix, cutils, libmicrohttpd;
const
BUF_SIZE = 1024;
MAX_URL_LEN = 255;
// TODO remove if unused
CAFILE: Pcchar = 'ca.pem';
CRLFILE: Pcchar = 'crl.pem';
EMPTY_PAGE: Pcchar = '<html><head><title>File not found</title></head><body>File not found</body></html>';
(* Test Certificate *)
cert_pem: array[0..980] of AnsiChar =
'-----BEGIN CERTIFICATE-----'#10+
'MIICpjCCAZCgAwIBAgIESEPtjjALBgkqhkiG9w0BAQUwADAeFw0wODA2MDIxMjU0'#10+
'MzhaFw0wOTA2MDIxMjU0NDZaMAAwggEfMAsGCSqGSIb3DQEBAQOCAQ4AMIIBCQKC'#10+
'AQC03TyUvK5HmUAirRp067taIEO4bibh5nqolUoUdo/LeblMQV+qnrv/RNAMTx5X'#10+
'fNLZ45/kbM9geF8qY0vsPyQvP4jumzK0LOJYuIwmHaUm9vbXnYieILiwCuTgjaud'#10+
'3VkZDoQ9fteIo+6we9UTpVqZpxpbLulBMh/VsvX0cPJ1VFC7rT59o9hAUlFf9jX/'#10+
'GmKdYI79MtgVx0OPBjmmSD6kicBBfmfgkO7bIGwlRtsIyMznxbHu6VuoX/eVxrTv'#10+
'rmCwgEXLWRZ6ru8MQl5YfqeGXXRVwMeXU961KefbuvmEPccgCxm8FZ1C1cnDHFXh'#10+
'siSgAzMBjC/b6KVhNQ4KnUdZAgMBAAGjLzAtMAwGA1UdEwEB/wQCMAAwHQYDVR0O'#10+
'BBYEFJcUvpjvE5fF/yzUshkWDpdYiQh/MAsGCSqGSIb3DQEBBQOCAQEARP7eKSB2'#10+
'RNd6XjEjK0SrxtoTnxS3nw9sfcS7/qD1+XHdObtDFqGNSjGYFB3Gpx8fpQhCXdoN'#10+
'8QUs3/5ZVa5yjZMQewWBgz8kNbnbH40F2y81MHITxxCe1Y+qqHWwVaYLsiOTqj2/'#10+
'0S3QjEJ9tvklmg7JX09HC4m5QRYfWBeQLD1u8ZjA1Sf1xJriomFVyRLI2VPO2bNe'#10+
'JDMXWuP+8kMC7gEvUnJ7A92Y2yrhu3QI3bjPk8uSpHea19Q77tul1UVBJ5g+zpH3'#10+
'OsF5p0MyaVf09GTzcLds5nE/osTdXGUyHJapWReVmPm3Zn6gqYlnzD99z+DPIgIV'#10+
'RhZvQx74NQnS6g=='#10+
'-----END CERTIFICATE-----'#10;
key_pem: array[0..1674] of AnsiChar =
'-----BEGIN RSA PRIVATE KEY-----'#10+
'MIIEowIBAAKCAQEAtN08lLyuR5lAIq0adOu7WiBDuG4m4eZ6qJVKFHaPy3m5TEFf'#10+
'qp67/0TQDE8eV3zS2eOf5GzPYHhfKmNL7D8kLz+I7psytCziWLiMJh2lJvb2152I'#10+
'niC4sArk4I2rnd1ZGQ6EPX7XiKPusHvVE6VamacaWy7pQTIf1bL19HDydVRQu60+'#10+
'faPYQFJRX/Y1/xpinWCO/TLYFcdDjwY5pkg+pInAQX5n4JDu2yBsJUbbCMjM58Wx'#10+
'7ulbqF/3lca0765gsIBFy1kWeq7vDEJeWH6nhl10VcDHl1PetSnn27r5hD3HIAsZ'#10+
'vBWdQtXJwxxV4bIkoAMzAYwv2+ilYTUOCp1HWQIDAQABAoIBAArOQv3R7gmqDspj'#10+
'lDaTFOz0C4e70QfjGMX0sWnakYnDGn6DU19iv3GnX1S072ejtgc9kcJ4e8VUO79R'#10+
'EmqpdRR7k8dJr3RTUCyjzf/C+qiCzcmhCFYGN3KRHA6MeEnkvRuBogX4i5EG1k5l'#10+
'/5t+YBTZBnqXKWlzQLKoUAiMLPg0eRWh+6q7H4N7kdWWBmTpako7TEqpIwuEnPGx'#10+
'u3EPuTR+LN6lF55WBePbCHccUHUQaXuav18NuDkcJmCiMArK9SKb+h0RqLD6oMI/'#10+
'dKD6n8cZXeMBkK+C8U/K0sN2hFHACsu30b9XfdnljgP9v+BP8GhnB0nCB6tNBCPo'#10+
'32srOwECgYEAxWh3iBT4lWqL6bZavVbnhmvtif4nHv2t2/hOs/CAq8iLAw0oWGZc'#10+
'+JEZTUDMvFRlulr0kcaWra+4fN3OmJnjeuFXZq52lfMgXBIKBmoSaZpIh2aDY1Rd'#10+
'RbEse7nQl9hTEPmYspiXLGtnAXW7HuWqVfFFP3ya8rUS3t4d07Hig8ECgYEA6ou6'#10+
'OHiBRTbtDqLIv8NghARc/AqwNWgEc9PelCPe5bdCOLBEyFjqKiT2MttnSSUc2Zob'#10+
'XhYkHC6zN1Mlq30N0e3Q61YK9LxMdU1vsluXxNq2rfK1Scb1oOlOOtlbV3zA3VRF'#10+
'hV3t1nOA9tFmUrwZi0CUMWJE/zbPAyhwWotKyZkCgYEAh0kFicPdbABdrCglXVae'#10+
'SnfSjVwYkVuGd5Ze0WADvjYsVkYBHTvhgRNnRJMg+/vWz3Sf4Ps4rgUbqK8Vc20b'#10+
'AU5G6H6tlCvPRGm0ZxrwTWDHTcuKRVs+pJE8C/qWoklE/AAhjluWVoGwUMbPGuiH'#10+
'6Gf1bgHF6oj/Sq7rv/VLZ8ECgYBeq7ml05YyLuJutuwa4yzQ/MXfghzv4aVyb0F3'#10+
'QCdXR6o2IYgR6jnSewrZKlA9aPqFJrwHNR6sNXlnSmt5Fcf/RWO/qgJQGLUv3+rG'#10+
'7kuLTNDR05azSdiZc7J89ID3Bkb+z2YkV+6JUiPq/Ei1+nDBEXb/m+/HqALU/nyj'#10+
'P3gXeQKBgBusb8Rbd+KgxSA0hwY6aoRTPRt8LNvXdsB9vRcKKHUFQvxUWiUSS+L9'#10+
'/Qu1sJbrUquKOHqksV5wCnWnAKyJNJlhHuBToqQTgKXjuNmVdYSe631saiI7PHyC'#10+
'eRJ6DxULPxABytJrYCRrNqmXi5TCiqR2mtfalEMOPxz8rUU8dYyx'#10+
'-----END RSA PRIVATE KEY-----'#10;
function file_reader(cls: Pointer; pos: cuint64; buf: Pcchar;
max: size_t): ssize_t; cdecl;
var
&file: FILEptr;
begin
&file := cls;
fseek(&file, pos, SEEK_SET);
Result := fread(buf, 1, max, &file);
end;
procedure file_free_callback(cls: Pointer); cdecl;
var
&file: FILEptr;
begin
&file := cls;
fclose(&file);
end;
function http_ahc(cls: Pointer; connection: PMHD_Connection; url: Pcchar;
method: Pcchar; version: Pcchar; upload_data: Pcchar;
upload_data_size: Psize_t; ptr: PPointer): cint; cdecl;
const
aptr: cint = 0;
var
response: PMHD_Response;
ret: cint;
&file: FILEptr;
buf: stat;
begin
if 0 <> strcomp(method, MHD_HTTP_METHOD_GET) then
Exit(MHD_NO); (* unexpected method *)
if @aptr <> ptr^ then
begin
(* do never respond on first call *)
ptr^ := @aptr;
Exit(MHD_YES);
end;
ptr^ := nil; (* reset when done *)
if (0 = FpStat(@url[1], buf)) and fpS_ISREG(buf.st_mode) then
&file := fopen(@url[1], fopenread)
else
&file := nil;
if &file = nil then
begin
response := MHD_create_response_from_buffer(strlen(EMPTY_PAGE),
Pointer(EMPTY_PAGE), MHD_RESPMEM_PERSISTENT);
ret := MHD_queue_response(connection, MHD_HTTP_NOT_FOUND, response);
MHD_destroy_response(response);
end
else
begin
response := MHD_create_response_from_callback(buf.st_size, 32 * 1024, (* 32k page size *)
@file_reader, &file, @file_free_callback);
if response = nil then
begin
fclose(&file);
Exit(MHD_NO);
end;
ret := MHD_queue_response(connection, MHD_HTTP_OK, response);
MHD_destroy_response(response);
end;
Result := ret;
end;
var
TLS_daemon: PMHD_Daemon;
begin
if argc = 2 then
begin
(* TODO check if this is truly necessary - disallow usage of the blocking /dev/random *)
(* gcry_control(GCRYCTL_ENABLE_QUICK_RANDOM, 0); *)
TLS_daemon := MHD_start_daemon(MHD_USE_THREAD_PER_CONNECTION or
MHD_USE_DEBUG or MHD_USE_SSL, StrToInt(argv[1]), nil, nil,
@http_ahc, nil, MHD_OPTION_CONNECTION_TIMEOUT, 256,
MHD_OPTION_HTTPS_MEM_KEY, key_pem,
MHD_OPTION_HTTPS_MEM_CERT, cert_pem,
MHD_OPTION_END);
end
else
begin
WriteLn(' Usage: ', argv[0], ' HTTP-PORT');
Halt(1);
end;
if TLS_daemon = nil then
begin
WriteLn(stderr, 'Error: failed to start TLS_daemon');
Halt(1);
end
else
WriteLn('MHD daemon listening on port ', argv[1]);
ReadLn;
MHD_stop_daemon(TLS_daemon);
end.
