2011-08-16 8 views
1

このコードはa minimal SSL server開始します:OpenSSLのコードはXP上で動作しますが、Vistaで永遠にハングアップし、

WSAStartup(MakeWord(1,1), WData); 
SSL_library_init; 
SSL_load_error_strings; 
ctx := SSL_CTX_new(SSLv23_server_method); 
SSL_CTX_use_certificate_chain_file(ctx, 'cert.pem'); 
SSL_CTX_use_PrivateKey_file(ctx, 'key.pem', 1); 
SSL_CTX_check_private_key(ctx); 
bio_ssl := BIO_new_ssl(ctx, 0); 
bio_in := BIO_new_accept('443'); 
BIO_set_accept_bios(bio_in, bio_ssl); 
BIO_do_accept(bio_in); // set up the socket 
BIO_do_accept(bio_in); // wait for connection 

すべてはXP上で正常に動作します。コードは接続を待つ第2のBIO_do_accept() のままであり、ブラウザからHTTPS要求を送信すると、 はBIO_do_accept()を返します。

32ビットVista Home Premiumおよび64ビットWindows 7では、2番目のBIO_do_accept()が永久にハングし、ブラウザが接続できません。 なぜですか?

32ビット.EXEのさまざまな互換モード(Windows XP、Windows NTなど)を変更しても効果はありません。 私はOpenSSL 1.0.0dを使用しています。

+2

すべての関数はステータスコードまたはブール結果を返します。したがって、 'BIO_do_accept'を呼び出す前にその関数の値をチェックしてみてください。 'BIO_do_accept'関数の呼び出しの前に問題が発生している可能性があるからです。 – RRUZ

+0

実際のコードcheck()はすべての呼び出しを行います。それらの誰もエラーを返すことはありません。上記のソースからチェックを外してしまいました。 –

+0

私はUACと関係があると思います。おそらく、Vista/Win7では、ポートを開いたり受信したりするために特別な権限が必要になるかもしれません。それを管理者として実行すると機能しますか? – shunty

答えて

1

これはおそらく、2回の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. 
関連する問題