它可能與雙BIO_do_accept()調用有關。
我參加了OpenSSL的S_SERVER.C代碼,做了一些修改,並將其分解到下面的簡單版本。它適用於Vista和Windows 7!它使用來自上述問題代碼的完全不同的一組BIO調用,非阻塞作品,以及(不同於S_SERVER.C和網絡上的大多數服務器示例),Google Chrome瀏覽器POST通過question 7054471超時正確抓取。
program s_server;
uses sysutils, winsock, windows;
const
SSLEAY32DLL = 'ssleay32.dll';
SSL_FILETYPE_PEM = 1;
SSL_SENT_SHUTDOWN = 1;
SSL_RECEIVED_SHUTDOWN = 2;
function BIO_f_ssl: pointer; cdecl; external SSLEAY32DLL;
function SSL_CTX_check_private_key(ctx: pointer): BOOL; cdecl; external SSLEAY32DLL;
function SSL_CTX_ctrl(ctx: pointer; cmd, i: integer; p: pointer): integer; cdecl; external SSLEAY32DLL;
procedure SSL_CTX_free(ctx: pointer); cdecl; external SSLEAY32DLL;
function SSL_CTX_new(meth: pointer): pointer; cdecl; external SSLEAY32DLL;
procedure SSL_CTX_set_quiet_shutdown(ctx: pointer; mode: integer); cdecl; external SSLEAY32DLL;
function SSL_CTX_use_certificate_chain_file(ctx: pointer; fname: pchar): integer; cdecl; external SSLEAY32DLL;
function SSL_CTX_use_PrivateKey_file(ctx: pointer; fname: pchar; itype: integer): integer; cdecl; external SSLEAY32DLL;
procedure SSL_library_init; cdecl; external SSLEAY32DLL;
procedure SSL_load_error_strings; cdecl; external SSLEAY32DLL;
function SSL_new(ctx: pointer): pointer; cdecl; external SSLEAY32DLL;
procedure SSL_set_accept_state(b: pointer); cdecl; external SSLEAY32DLL;
procedure SSL_set_bio(ssl, readbio, writebio: pointer); cdecl; external SSLEAY32DLL;
procedure SSL_set_shutdown(ssl: pointer; mode: integer); cdecl; external SSLEAY32DLL;
function SSLv23_server_method: pointer; cdecl; external SSLEAY32DLL;
const
LIBEAY32DLL = 'libeay32.dll';
BIO_NOCLOSE = $00;
BIO_CLOSE = $01;
function BIO_ctrl(bp: pointer; cmd: integer; larg: integer; parg: pointer): integer; cdecl; external LIBEAY32DLL;
function BIO_f_buffer: pointer; cdecl; external LIBEAY32DLL;
procedure BIO_free_all(bp: pointer); cdecl; external LIBEAY32DLL;
function BIO_gets(b: pointer; buf: pchar; size: integer): integer; cdecl; external LIBEAY32DLL;
function BIO_int_ctrl(bp: pointer; cmd: integer; i1, i2: integer): integer; cdecl; external LIBEAY32DLL;
function BIO_new(t: pointer): pointer; cdecl; external LIBEAY32DLL;
function BIO_new_socket(sock, flag: integer): pointer; cdecl; external LIBEAY32DLL;
function BIO_push(b: pointer; append: pointer): pointer; cdecl; external LIBEAY32DLL;
function BIO_socket_ioctl(sock: integer; ctl: cardinal; p: pointer): integer; cdecl; external LIBEAY32DLL;
function BIO_test_flags(bp: pointer; flags: integer): integer; cdecl; external LIBEAY32DLL;
function BIO_write(bp, buffer: pointer; size: integer): integer; cdecl; external LIBEAY32DLL;
procedure OPENSSL_load_builtin_modules; cdecl; external LIBEAY32DLL;
function BIO_flush(b: pointer): integer; const BIO_CTRL_FLUSH = 11; begin result := BIO_ctrl(b, BIO_CTRL_FLUSH, 0, nil); end;
function BIO_set_ssl(b, ssl: pointer; c: integer): integer; const BIO_C_SET_SSL = 109; begin result := BIO_ctrl(b, BIO_C_SET_SSL, c, ssl); end;
function BIO_should_retry(b: pointer): boolean; const BIO_FLAGS_SHOULD_RETRY = 8; begin result := BIO_test_flags(b, BIO_FLAGS_SHOULD_RETRY) <> 0; end;
function SSL_CTX_set_options(ctx: pointer; op: integer): integer; const SSL_CTRL_OPTIONS = 32; begin result := SSL_CTX_ctrl(ctx, SSL_CTRL_OPTIONS, op, nil); end;
procedure confirm(b: boolean); begin {$WARN SYMBOL_PLATFORM OFF} win32check(b); {$WARN SYMBOL_PLATFORM ON} end;
const
DEFAULTPORT = 443;
MAXWAIT = 500; // 500ms max for read
function getresponse(const ip, request: string): string;
var body: string;
begin // ignore request and just announce ip
body := '<HTML><HEAD><TITLE>Hello!</TITLE></HEAD><H1>Your IP is...</H1><BODY>' + ip + '</BODY></HTML>';
result := 'HTTP/1.0 200 OK'#13#10'Connection: Close'#13#10'Content-Type: text/HTML'#13#10'Content-Length: ' + IntToStr(length(body)) + #13#10#13#10 + body;
end;
const BUFSIZE = 16*1024; // used in openssl s_server.c
var
buf: packed array[0..BUFSIZE-1] of char;
request, response: string;
ctx: pointer;
procedure read_and_respond(const ip: string; sock: integer);
var
i, j, k: integer; start: cardinal;
con, io, ssl_bio, sbio: pointer;
label err, endlabel, write_error;
begin
io := BIO_new(BIO_f_buffer);
ssl_bio := BIO_new(BIO_f_ssl); if (io = nil) or (ssl_bio = nil) then goto err;
// enable non-blocking
i := 1; if BIO_socket_ioctl(sock, FIONBIO, @i) < 0 then writeln('Can''t unblock!');
con := SSL_new(ctx); if con = nil then goto err;
sbio := BIO_new_socket(sock, BIO_NOCLOSE);
SSL_set_bio(con, sbio, sbio);
SSL_set_accept_state(con);
BIO_set_ssl(ssl_bio, con, BIO_CLOSE);
BIO_push(io, ssl_bio);
request := ''; start := gettickcount;
repeat
i := BIO_gets(io, @buf, bufsize-1);
if i < 0 then // error
if not BIO_should_retry(io) then goto err
else continue
else if i > 0 then
begin
buf[i] := #0;
request := request + buf;
if length(request) > BUFSIZE then break; // stop malicious request
end;
until (gettickcount - start) > MAXWAIT; // could also stop if post body == content-length
response := getresponse(ip, request);
i := 1; j := length(response);
while i <= j do
begin
k := BIO_write(io, @response[i], j-i+1);
if k <= 0 then
if BIO_should_retry(io) then continue
else break
else inc(i, k);
end;
while BIO_flush(io) <= 0 do
if not BIO_should_retry(io) then break;
SSL_set_shutdown(con, SSL_SENT_SHUTDOWN or SSL_RECEIVED_SHUTDOWN); // re-use session
err: if io <> nil then BIO_free_all(io); // including ssl_bio
end;
var listen_socket: integer;
procedure do_server;
var server, client: TSockAddr; sock, clientlen: integer;
begin
listen_socket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
confirm(listen_socket <> INVALID_SOCKET);
fillchar(server, sizeof(server), 0);
server.sin_family := AF_INET;
server.sin_port := htons(DEFAULTPORT);
server.sin_addr.s_addr := INADDR_ANY;
confirm(bind(listen_socket, server, sizeof(server)) <> INVALID_SOCKET);
confirm(listen(listen_socket, 128) <> INVALID_SOCKET);
while TRUE do
begin
fillchar(client, sizeof(client), 0);
clientlen := sizeof(client);
sock := accept(listen_socket, @client, @clientlen);
if sock <> INVALID_SOCKET then
begin
read_and_respond(inet_ntoa(client.sin_addr), sock);
shutdown(sock, SD_BOTH);
closesocket(sock);
end;
end;
end;
procedure shutdownserver;
begin
closesocket(listen_socket);
SSL_CTX_free(ctx);
WSAcleanup;
end;
function consolehandler(signal: DWORD): BOOL; stdcall;
begin // handle some console events
case signal of
CTRL_C_EVENT, CTRL_BREAK_EVENT: result := TRUE; // handle these by ignoring them
CTRL_CLOSE_EVENT, CTRL_LOGOFF_EVENT, CTRL_SHUTDOWN_EVENT:
begin
shutdownserver;
result := FALSE; // avoid popup
end
else result := FALSE; // not handling
end; // case
end;
procedure main;
var WData: TWSAData;
begin
allocconsole;
confirm(SetConsoleCtrlHandler(@ConsoleHandler, TRUE));
if WSAStartup(MakeWord(2, 2), WData) <> 0 then
confirm(WSAStartup(MakeWord(1,1), WData) = 0);
SSL_library_init;
SSL_load_error_strings;
OPENSSL_load_builtin_modules;
ctx := SSL_CTX_new(SSLv23_server_method); confirm(ctx <> nil);
confirm(SSL_CTX_use_certificate_chain_file(ctx, 'cert.pem') > 0);
confirm(SSL_CTX_use_PrivateKey_file(ctx, 'key.pem', SSL_FILETYPE_PEM) > 0);
confirm(SSL_CTX_check_private_key(ctx));
SSL_CTX_set_quiet_shutdown(ctx, 1);
SSL_CTX_set_options(ctx, 0);
repeat
try
do_server
except
on E: Exception do writeln(E.Message);
end;
until FALSE;
end;
begin
main
end.
您正在使用的所有函數都會返回一個狀態碼或布爾結果,因此請在調用「BIO_do_accept」之前嘗試檢查該函數的值。因爲在調用'BIO_do_accept'函數之前可能會出現問題。 – RRUZ
真正的代碼檢查()的每一個呼叫;他們沒有一個返回錯誤。 check()已經被排除在上面的源頭之外,不會把它弄亂。 –
我的猜測是它與UAC有關。也許Vista/Win7需要額外的權限來打開/偵聽端口。如果以管理員身份運行它,它會起作用嗎? – shunty