Skip Menu |
 

This queue is for tickets about the Net-SSLeay CPAN distribution.

Report information
The Basics
Id: 80485
Status: resolved
Worked: 30 min
Priority: 0/
Queue: Net-SSLeay

People
Owner: MIKEM [...] cpan.org
Requestors: kmx [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



Subject: SNI support (server side)
What I am sending is a patch adding server side SNI support. Unfortunately it does not contain neither documentation nor tests and I am currently short of time to prepare it in release quality.

Example:

Show quoted text
# ... initialize Net::SSLeay

my %hostnames = (
  'sni1' => { cert=>'sni1.pem', key=>'sni1.key' },
  'sni2' => { cert=>'sni2.pem', key=>'sni2.key' }, 
);

Show quoted text
# create a new context for each certificate/key pair
for my $name (keys %hostnames) {
  $hostnames{$name}->{ctx} = Net::SSLeay::CTX_new or die;
  Net::SSLeay::CTX_set_cipher_list($hostnames{$name}->{ctx}, 'ALL');
  Net::SSLeay::set_cert_and_key($hostnames{$name}->{ctx}, $hostnames{$name}->{cert}, $hostnames{$name}->{key}) or die;
}

Show quoted text
# create default context
my $ctx = Net::SSLeay::CTX_new or die;
Net::SSLeay::CTX_set_cipher_list($ctx, 'ALL');
Net::SSLeay::set_cert_and_key($ctx, 'cert.pem','key.pem') or die;

Show quoted text
# set callback
Net::SSLeay::CTX_set_tlsext_servername_callback($ctx, sub {
  my $ssl = shift;
  my $h = Net::SSLeay::get_servername($ssl);
  Net::SSLeay::set_SSL_CTX($ssl, $hostnames{$h}->{ctx}) if exists $hostnames{$h};
} );

Show quoted text
# ... later

$s = Net::SSLeay::new($ctx);
Net::SSLeay::set_fd($s, fileno($accepted_socket));
Net::SSLeay::accept($s);

Subject: SNI-support.diff
Download SNI-support.diff
text/x-diff 2.5k
Index: SSLeay.xs =================================================================== --- SSLeay.xs (revision 354) +++ SSLeay.xs (working copy) @@ -665,6 +665,49 @@ return res; } +#if OPENSSL_VERSION_NUMBER >= 0x0090806fL && !defined(OPENSSL_NO_TLSEXT) + +int tlsext_servername_callback_invoke(SSL *ssl, int *ad, void *arg) +{ + dSP; + int count = -1; + int res; + SV * cb_func, *cb_data; + + PR1("STARTED: tlsext_servername_callback_invoke\n"); + + cb_func = cb_data_advanced_get(arg, "tlsext_servername_callback!!func"); + cb_data = cb_data_advanced_get(arg, "tlsext_servername_callback!!data"); + + if(!SvOK(cb_func)) + croak ("Net::SSLeay: tlsext_servername_callback_invoke called, but not set to point to any perl function.\n"); + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + XPUSHs(sv_2mortal(newSViv(PTR2IV(ssl)))); + XPUSHs(sv_2mortal(newSVsv(cb_data))); + PUTBACK; + + count = call_sv(cb_func, G_SCALAR); + + SPAGAIN; + + if (count != 1) + croak("Net::SSLeay: tlsext_servername_callback_invoke perl function did not return a scalar.\n"); + + res = POPi; + + PUTBACK; + FREETMPS; + LEAVE; + + return res; +} + +#endif + #if defined(SSL_F_SSL_SET_HELLO_EXTENSION) || defined(SSL_F_SSL_SET_SESSION_TICKET_EXT) int ssleay_session_secret_cb_invoke(SSL* s, void* secret, int *secret_len, @@ -1560,6 +1603,9 @@ SSL_get_SSL_CTX(s) SSL * s +SSL_CTX * +SSL_set_SSL_CTX(SSL *ssl, SSL_CTX* ctx) + long SSL_ctrl(ssl,cmd,larg,parg) SSL * ssl @@ -1682,6 +1728,30 @@ long SSL_set_tlsext_host_name(SSL *ssl, const char *name) +const char * +SSL_get_servername(const SSL *s, int type=TLSEXT_NAMETYPE_host_name) + +int +SSL_get_servername_type(const SSL *s) + +void +SSL_CTX_set_tlsext_servername_callback(ctx,callback=&PL_sv_undef,data=&PL_sv_undef) + SSL_CTX * ctx + SV * callback + SV * data + CODE: + if (callback==NULL || !SvOK(callback)) { + SSL_CTX_set_tlsext_servername_callback(ctx, NULL); + SSL_CTX_set_tlsext_servername_arg(ctx, NULL); + cb_data_advanced_put(ctx, "tlsext_servername_callback!!data", NULL); + cb_data_advanced_put(ctx, "tlsext_servername_callback!!func", NULL); + } else { + cb_data_advanced_put(ctx, "tlsext_servername_callback!!data", newSVsv(data)); + cb_data_advanced_put(ctx, "tlsext_servername_callback!!func", newSVsv(callback)); + SSL_CTX_set_tlsext_servername_callback(ctx, &tlsext_servername_callback_invoke); + SSL_CTX_set_tlsext_servername_arg(ctx, (void*)ctx); + } + #endif BIO_METHOD *
Subject: Re: [rt.cpan.org #80485] SNI support (server side)
Date: Wed, 31 Oct 2012 15:44:28 +1000
To: bug-Net-SSLeay [...] rt.cpan.org
From: Mike McCauley <mikem [...] open.com.au>
Download (untitled) / with headers
text/plain 2.2k
Hi, thanks for the patch. Now in svn 355 Cheers. On Tuesday, October 30, 2012 07:56:08 AM kmx via RT wrote: Show quoted text
> Tue Oct 30 07:56:06 2012: Request 80485 was acted upon. > Transaction: Ticket created by KMX > Queue: Net-SSLeay > Subject: SNI support (server side) > Broken in: (no value) > Severity: (no value) > Owner: Nobody > Requestors: kmx@cpan.org > Status: new > Ticket <URL: https://rt.cpan.org/Ticket/Display.html?id=80485 > > > > What I am sending is a patch adding server side SNI support. Unfortunately > it does not contain neither documentation nor tests and I am currently > short of time to prepare it in release quality. > > Example: > > # ... initialize Net::SSLeay > > my %hostnames = ( > 'sni1' => { cert=>'sni1.pem', key=>'sni1.key' }, > 'sni2' => { cert=>'sni2.pem', key=>'sni2.key' }, > ); > > # create a new context for each certificate/key pair > for my $name (keys %hostnames) { > $hostnames{$name}->{ctx} = Net::SSLeay::CTX_new or die; > Net::SSLeay::CTX_set_cipher_list($hostnames{$name}->{ctx}, 'ALL'); > Net::SSLeay::set_cert_and_key($hostnames{$name}->{ctx}, > $hostnames{$name}->{cert}, $hostnames{$name}->{key}) or die; > } > > # create default context > my $ctx = Net::SSLeay::CTX_new or die; > Net::SSLeay::CTX_set_cipher_list($ctx, 'ALL'); > Net::SSLeay::set_cert_and_key($ctx, 'cert.pem','key.pem') or die; > > # set callback > Net::SSLeay::CTX_set_tlsext_servername_callback($ctx, sub { > my $ssl = shift; > my $h = Net::SSLeay::get_servername($ssl); > Net::SSLeay::set_SSL_CTX($ssl, $hostnames{$h}->{ctx}) if exists > $hostnames{$h}; } ); > > # ... later > > $s = Net::SSLeay::new($ctx); > Net::SSLeay::set_fd($s, fileno($accepted_socket)); > Net::SSLeay::accept($s);
-- Mike McCauley mikem@open.com.au Open System Consultants Pty. Ltd 9 Bulbul Place Currumbin Waters QLD 4223 Australia http://www.open.com.au Phone +61 7 5598-7474 Fax +61 7 5598-7070 Radiator: the most portable, flexible and configurable RADIUS server anywhere. SQL, proxy, DBM, files, LDAP, NIS+, password, NT, Emerald, Platypus, Freeside, TACACS+, PAM, external, Active Directory, EAP, TLS, TTLS, PEAP, TNC, WiMAX, RSA, Vasco, Yubikey, MOTP, HOTP, TOTP, DIAMETER etc. Full source on Unix, Windows, MacOSX, Solaris, VMS, NetWare etc.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.