OpenSSL with nonblocking sockets (in Perl)

From Devpit

Jump to: navigation, search

SSL/TLS is complete chaos with little documentation. OpenSSL is a huge library. It has tons of functionality, and has some reasonable documentation, but gives you no idea where to start. Perl has, as usual, lots of modules and few to the point. Net::SSLeay seems to be Perl's raw canonical wrapper for OpenSSL, although if I hadn't told you, you'd have to examine a dozen modules with similar names before you came to this conclusion.

The hardest part, as usual, is getting started and figuring out the general framework. Specifics are actually pretty well documented by OpenSSL, although you have to guess at how the C translates through Net::SSLeay into Perl. The critical elements of Net::SSLeay are in some examples that are hard to read and bug-ridden to boot. Try guessing by looking for patterns defined by the parts of the interface you already know; this is not easy, but may be your only option. OpenSSL exports two key object types for dealing with SSL. They are SSL_CTX (the "context" object) and SSL. Usually you only want one SSL_CTX object and several SSL objects. SSL_CTX holds your local certificate if you're writing a server.

I need to make the poor quality of Net::SSLeay abundantly clear. OpenSSL is robust, but you need to carefully pick and choose and inspect what you use from Net::SSLeay. Needless to say, we'd like to be able to write very robust software that doesn't sometimes fail or act strangely. Be careful; Net::SSLeay is riddled with bugs. For the most part, I use it only to import raw OpenSSL interfaces and avoid anything written in Net::SSLeay that's written in native Perl because it's so bug-ridden. For example, let's look at ssl_write_CRLF, which by name sounds like a central element. Its contents is simply:

return ssl_write_all($_[0], $_[1]) + ssl_write_all($_[0], $CRLF);

Well, what if ssl_write_all() returns undef because of an error on the first call but not the second? First off, your code should emit an uninitialized warning (you do use warnings, and pay attention to them, right?) but Net::SSLeay doesn't use warnings, so you won't even know something is fishy. Second, your code will have written a blank line and silently discarded the important information. I think this is a problem! There are many similar bugs; I'd report them, but the upshot is that Net::SSLeay was simply written without care and my bug reports would turn into a rewrite. Generally the most common code path works, but god help you with nonblocking IO, where read and write calls "fail" intermittently to avoid blocking. Stick with the raw OpenSSL functions that Net::SSLeay will load for you (they work well). You can tell the difference because the raw OpenSSL functions do not appear in Net/SSLeay.pm.

After exploring this chaos for some time, I gleaned the critical elements for using nonblocking IO with SSL in Perl. I wrote some code that shows exactly what needs to be done, complete with error reporting and the appropriate retries. This is a trivial web server. Run it, and visit https://localhost:8888/ and your browser should show a copy of /usr/share/games/fortune/fortunes. The debugging output may help you trace execution if you get lost in the looping for reading and writing.

Here are some good references:

And without further ado, here's the example:

#!/usr/bin/perl

use strict;
use warnings;

=pod

A trivial web server to demonstrate using select() with Net::SSLeay's OpenSSL
wrapper.

Note: This assumes that select()ing for read is sufficient for reading and
select()ing for write is sufficient for writing. This is currently true since
OpenSSL disabled renegotiation due to security problems, but it may not remain
true. Refer to the discussion regarding SSL_ERROR_WANT_READ
and SSL_ERROR_WANT_WRITE at http://www.openssl.org/docs/ssl/SSL_get_error.html

=cut

use Errno;
use Fcntl;
use Net::SSLeay ();
use Socket;

our $debug = 1;

# Somehow you have to guarantee that these are called just once. Alas,
# Net::SSLeay should've taken care of this with more "use"s, such as
# "use Net::SSLeay::load_error_strings;". At least by using this hack we
# cooperate with other callers in working around Net::SSLeay's deficiency.
Net::SSLeay::load_error_strings(); eval 'no warnings "redefine"; sub Net::SSLeay::load_error_strings () {}'; die $@ if $@;
Net::SSLeay::SSLeay_add_ssl_algorithms(); eval 'no warnings "redefine"; sub Net::SSLeay::SSLeay_add_ssl_algorithms () {}'; die $@ if $@;
Net::SSLeay::ENGINE_load_builtin_engines(); eval 'no warnings "redefine"; sub Net::SSLeay::ENGINE_load_builtin_engines () {}'; die $@ if $@;
Net::SSLeay::ENGINE_register_all_complete(); eval 'no warnings "redefine"; sub Net::SSLeay::ENGINE_register_all_complete () {}'; die $@ if $@;
Net::SSLeay::randomize(); eval 'no warnings "redefine"; sub Net::SSLeay::randomize (;$$) {}'; die $@ if $@;

sub start_listening {
        my ($port) = @_;

        my $socket;
        socket($socket, PF_INET, SOCK_STREAM, getprotobyname("tcp")) or die("socket: $!\n");
        setsockopt($socket, SOL_SOCKET, SO_REUSEADDR, 1) or die("setsockopt SOL_SOCKET, SO_REUSEADDR: $!\n");
        bind($socket, pack_sockaddr_in($port, INADDR_ANY)) or die("bind ${port}: $!\n");
        listen($socket, SOMAXCONN) or die("listen ${port}: $!\n");

        # Set FD_CLOEXEC.
        $_ = fcntl($socket, F_GETFD, 0) or die "fcntl: $!\n";
        fcntl($socket, F_SETFD, $_ | FD_CLOEXEC) or die "fnctl: $!\n";

        return $socket;
}

sub myaccept {
        my ($socket) = @_;

        die "accept: $!\n" unless accept(my $connection, $socket);
        $_ = select($connection); $| = 1; select $_;

        # Set FD_CLOEXEC.
        $_ = fcntl($connection, F_GETFD, 0) or die "fcntl: $!\n";
        fcntl($connection, F_SETFD, $_ | FD_CLOEXEC) or die "fnctl: $!\n";

        # Set O_NONBLOCK.
        $_ = fcntl($connection, F_GETFL, 0) or die "fcntl F_GETFL: $!\n";  # 0 for error, 0e0 for 0.
        fcntl($connection, F_SETFL, $_ | O_NONBLOCK) or die "fcntl F_SETFL O_NONBLOCK: $!\n";  # 0 for error, 0e0 for 0.

        return $connection;
}

# Net::SSLeay's error functions are terrible. These are a bit more programmable and readable.
sub ssl_get_error {
        my $errors = "";
        my $errnos = [];
        while(my $errno = Net::SSLeay::ERR_get_error()) {
                push @$errnos, $errno;
                $errors .= Net::SSLeay::ERR_error_string($errno) . "\n";
        }
        return $errors, $errnos if wantarray;
        return $errors;
}

sub ssl_check_die {
        my ($message) = @_;
        my ($errors, $errnos) = ssl_get_error();
        die "${message}: ${errors}" if @$errnos;
        return;
}

sub main {
        $| = 1;

        # The CTX ("context") should be shared between many SSL connections. A CTX
        # could apply to multiple listening sockets, or each listening socket could
        # have its own CTX. Each CTX may represent only one local certificate.
        my $ctx = Net::SSLeay::CTX_new();
        ssl_check_die("SSL CTX_new");

        # OP_ALL enables all harmless work-arounds for buggy clients.
        Net::SSLeay::CTX_set_options($ctx, Net::SSLeay::OP_ALL());
        ssl_check_die("SSL CTX_set_options");

        # Modes:
        # 0x1: SSL_MODE_ENABLE_PARTIAL_WRITE
        # 0x2: SSL_MODE_ACCEPT_MOVING_WRITE_BUFFER
        # 0x4: SSL_MODE_AUTO_RETRY
        # 0x8: SSL_MODE_NO_AUTO_CHAIN
        # 0x10: SSL_MODE_RELEASE_BUFFERS (ignored before OpenSSL v1.0.0)
        Net::SSLeay::CTX_set_mode($ctx, 0x11);
        ssl_check_die("SSL CTX_set_mode");

        # Load certificate. This will prompt for a password if necessary.
        Net::SSLeay::CTX_use_RSAPrivateKey_file($ctx, "/tmp/ssl/hobbiton.org.pem", Net::SSLeay::FILETYPE_PEM());
        ssl_check_die("SSL CTX_use_RSAPrivateKey_file");
        Net::SSLeay::CTX_use_certificate_file($ctx, "/tmp/ssl/hobbiton.org.pem", Net::SSLeay::FILETYPE_PEM());
        ssl_check_die("SSL CTX_use_certificate_file");

        my $socket = start_listening(8888);
        while(1) {
                my $connection = myaccept($socket);

                # Each connection needs an SSL object, which is associated with the shared CTX.
                my $ssl = Net::SSLeay::new($ctx);
                ssl_check_die("SSL new");
                Net::SSLeay::set_fd($ssl, fileno($connection));
                ssl_check_die("SSL set_fd");
                Net::SSLeay::accept($ssl);
                ssl_check_die("SSL accept");

                my $http_header = "";
                print "Read returned" if $debug;
                until($http_header =~ qr~\n\r?\n~s) {
                        my $vec = "";
                        vec($vec, fileno($connection), 1) = 1;
                        select($vec, undef, undef, undef);

                        # Repeat read() until EAGAIN before select()ing for more. SSL may already be
                        # holding the last packet in its buffer, so if we aren't careful to decode
                        # everything that's pending we could block forever at select(). This would be
                        # after SSL already read "\r\n\r\n" but before it decoded and returned it. As
                        # documented, OpenSSL returns data from only one SSL record per call, but its
                        # internal system call to read may gather more than one record. In short, a
                        # socket may not become readable again after reading, but note that writing
                        # doesn't have this problem since a socket will always become writable again
                        # after writing.

                        while(1) {
                                # 16384 is the maximum amount read() can return; larger values allocate memory
                                # that can't be unused as part of the buffer passed to read().
                                my $read_buffer = Net::SSLeay::read($ssl, 16384);
                                ssl_check_die("SSL read");
                                die "read: $!\n" unless defined $read_buffer or $!{EAGAIN} or $!{EINTR} or $!{ENOBUFS};
                                if(defined $read_buffer) {
                                        printf " %s bytes,", length($read_buffer) if $debug;
                                        $http_header .= $read_buffer;
                                } else {
                                        print " undef," if $debug;
                                        last;
                                }
                        }
                }
                print "\n" if $debug;

                print $http_header if $debug;

                my $write_buffer = "HTTP/1.0 200 OK\r\n\r\n" . `cat /usr/share/games/fortune/fortunes`;

                print "Write returned" if $debug;
                while(length($write_buffer)) {
                        my $vec = "";
                        vec($vec, fileno($connection), 1) = 1;
                        select(undef, $vec, undef, undef);

                        my $write = Net::SSLeay::write($ssl, $write_buffer);
                        ssl_check_die("SSL write");
                        die "write: $!\n" unless $write != -1 or $!{EAGAIN} or $!{EINTR} or $!{ENOBUFS};
                        print " ${write}," if $debug;
                        substr($write_buffer, 0, $write, "") if $write > 0;
                }
                print "\n" if $debug;

                # Paired with closing connection.
                Net::SSLeay::free($ssl);
                ssl_check_die("SSL free");
                close($connection);
        }

        # Paired with closing listening socket.
        Net::SSLeay::CTX_free($ctx);
        ssl_check_die("SSL CTX_free");
        close($socket);
}

exit main();
Personal tools
sponsored projects
Google AdSense