Unter den Demos gibt es eine (Delphi) Demo zu https (Datei: httpsserv\http.pas). Hieraus folgendes Codeschnipsel, mein Problem steckt im try Block zur SSL Fehlerbehandlung:
Code: Alles auswählen
procedure TTCPHttpThrd.Execute;
var
timeout: integer;
s: string;
method, uri, protocol: string;
size: integer;
x, n: integer;
resultcode: integer;
begin
timeout := 1000;
// Note: There's no need for installing a client certificate in the
// webbrowser. The server asks the webbrowser to send a certificate but
// if nothing is installed the software will work because the server
// doesn't check to see if a client certificate was supplied. If you
// want you can install:
//
// file: c_cacert.p12
// password: c_cakey
//
Sock.SSL.CertCAFile := ExtractFilePath(ParamStr(0)) + 's_cabundle.pem';
Sock.SSL.CertificateFile := ExtractFilePath(ParamStr(0)) + 's_cacert.pem';
Sock.SSL.PrivateKeyFile := ExtractFilePath(ParamStr(0)) + 's_cakey.pem';
Sock.SSL.KeyPassword := 's_cakey';
Sock.SSL.verifyCert := True;
try
if (not Sock.SSLAcceptConnection) or
(Sock.SSL.LastError <> 0) then
begin
MessageDlg('Error while accepting SSL connection: ' + Sock.SSL.LastErrorDesc, mtError, [mbAbort], 0);
Exit;
end;
except
MessageDlg('Exception while accepting SSL connection', mtError, [mbAbort], 0);
Exit;
end;
//read request line
s := sock.RecvString(timeout);
if sock.lasterror <> 0 then
Exit;
if s = '' then
Exit;
method := fetch(s, ' ');
if (s = '') or (method = '') then
Exit;
uri := fetch(s, ' ');
if uri = '' then
Exit;
protocol := fetch(s, ' ');
headers.Clear;
size := -1;
//read request headers
if protocol <> '' then
begin
if pos('HTTP/', protocol) <> 1 then
Exit;
repeat
s := sock.RecvString(Timeout);
if sock.lasterror <> 0 then
Exit;
if s <> '' then
Headers.add(s);
if Pos('CONTENT-LENGTH:', Uppercase(s)) = 1 then
Size := StrToIntDef(SeparateRight(s, ' '), -1);
until s = '';
end;
//recv document...
InputData.Clear;
if size >= 0 then
begin
InputData.SetSize(Size);
x := Sock.RecvBufferEx(InputData.Memory, Size, Timeout);
InputData.SetSize(x);
if sock.lasterror <> 0 then
Exit;
end;
OutputData.Clear;
ResultCode := ProcessHttpRequest(method, uri);
sock.SendString('HTTP/1.0 ' + IntTostr(ResultCode) + CRLF);
if protocol <> '' then
begin
headers.Add('Content-length: ' + IntTostr(OutputData.Size));
headers.Add('Connection: close');
headers.Add('Date: ' + Rfc822DateTime(now));
headers.Add('Server: Synapse HTTP server demo');
headers.Add('');
for n := 0 to headers.count - 1 do
sock.sendstring(headers[n] + CRLF);
end;
if sock.lasterror <> 0 then
Exit;
Sock.SendBuffer(OutputData.Memory, OutputData.Size);
end;
- 2021-12-16 07_51_09-Lazarus IDE v2.2.0RC2 - httpserv (debugging ...).png (6.11 KiB) 1506 mal betrachtet
daraufhin folgt dann auch noch ein SIGSEV.
- 2021-12-16 08_06_11-Error.png (5.59 KiB) 1495 mal betrachtet
Erst mal dachte ich, das liegt daran dass das Delphi Code ist, aber dann fand ich das da:
https://stackoverflow.com/questions/267 ... messagedlg
Die Messages in den Hauptthread zu schaffen oder MessageBox zu verwenden ist nicht das Problem, sondern die Frage, ob ich mich irre? Ist das Synapse Sample tatsächlich weder unter Delphi noch unter FPC lauffähig?
Armin.
Verein
Links
