package Sprocket::SSL;

use strict;
use warnings;

use Net::SSLeay qw( ERROR_WANT_READ ERROR_WANT_WRITE );
use Net::SSLeay::Handle;
use POSIX qw( F_GETFL F_SETFL O_NONBLOCK EAGAIN EWOULDBLOCK );
use Symbol qw( gensym );
use base qw( Net::SSLeay::Handle );
Net::SSLeay::load_error_strings();
Net::SSLeay::SSLeay_add_ssl_algorithms();
Net::SSLeay::randomize();

our %fnlist;

sub tie_socket {
    my ( $socket, $key, $cert ) = @_;

    # TODO graceful recovery of these errors
    my $ctx = Net::SSLeay::CTX_new()
        or die("Failed to create SSL_CTX $!");

    #$Net::SSLeay::ssl_version = 10; # insist on TLSv1
    #$Net::SSLeay::ssl_version = 3;  # insist on SSLv3

    Net::SSLeay::CTX_set_options( $ctx, &Net::SSLeay::OP_ALL )
        and Net::SSLeay::die_if_ssl_error("ssl set options");

    # partial write
    Net::SSLeay::CTX_set_mode( $ctx, 1 )
        and Net::SSLeay::die_if_ssl_error("ssl set options");

    # The following will ask password unless private key is not encrypted
    Net::SSLeay::CTX_use_RSAPrivateKey_file( $ctx, $key, &Net::SSLeay::FILETYPE_PEM );
    Net::SSLeay::die_if_ssl_error("key");

    Net::SSLeay::CTX_use_certificate_file( $ctx, $cert, &Net::SSLeay::FILETYPE_PEM );
    Net::SSLeay::die_if_ssl_error("cert");
                
    my $newsock = gensym();
    tie( *$newsock, 'Sprocket::SSL', $socket, $ctx ) or die "Unable to tie to ssl: $!";

    return $socket = $newsock;
}

sub _get_self {
  return $fnlist{fileno( shift )};
}

sub _get_ssl {
  my $socket = shift;
  return $fnlist{fileno( $socket )}->{ssl};
}

sub _set_filenum_obj {
    my ( $self, $fileno, $ssl, $ctx, $socket, $accepted ) = @_;
    $fnlist{$fileno} = {
        ssl             => $ssl,
        ctx             => $ctx,
        socket          => $socket,
        _is_accepted    => $accepted,
    };
}

sub TIEHANDLE {
    my ( $class, $socket, $ctx ) = @_;
   
    # setup non blocking on the socket
    my $flags = fcntl( $socket, F_GETFL, 0 ) or die $!;
    until ( fcntl( $socket, F_SETFL, $flags | O_NONBLOCK ) ) {
        die $! unless $! == EAGAIN or $! == EWOULDBLOCK;
    }
    
    $class->_initialize();
    
    my $ssl = Net::SSLeay::new( $ctx )
        or die_now("Failed to create SSL $!");
    
    my $fileno = fileno( $socket );
    
    Net::SSLeay::set_fd( $ssl, $fileno );
    
    my $accepted = 0;
    my $resp = Net::SSLeay::accept( $ssl );
    if ( $resp <= 0 ) {
        my $errno = Net::SSLeay::get_error( $ssl, $resp );
        unless ( $errno == ERROR_WANT_READ or $errno == ERROR_WANT_WRITE ) {
            warn "handshake failed! errnum: $errno";
            return undef;
        }
    } else {
        $accepted = 1;
    }
    
    $fnlist{$fileno} = {
        ssl             => $ssl,
        ctx             => $ctx,
        socket          => $socket,
        _is_accepted    => $accepted,
    };
    
    return bless( $socket, $class );
}

sub READ {
    my ( $socket, $buf, $len, $offset ) = \ (@_);
    my $ssl = $$socket->_get_ssl();
    my $self = $$socket->_get_self();
  
    if ( exists $self->{_is_accepted} && $self->{_is_accepted} == 0 ) {
        my $resp = Net::SSLeay::accept( $ssl );
        if ( $resp <= 0 ) {
            if ( Net::SSLeay::get_error($ssl, $resp) == ERROR_WANT_READ ) {
                return $$len;
            } else {
                return undef;
            }
        }
        $self->{_is_accepted} = 1;
        return $$len;
    }
  
    unless (defined $$offset) {
        $$buf = Net::SSLeay::read($ssl, $$len);
        return length( $$buf ) if defined $$buf;
        $$buf = "";
        return;
    }
  
    my $read = Net::SSLeay::read( $ssl, $$len );
    return undef unless ( defined( $read ) );
  
    my $buf_len = length( $$buf );
    $$offset > $buf_len and $$buf .= chr(0) x ( $$offset - $buf_len );
    substr( $$buf, $$offset ) = $read;
    return length( $read );
}

sub WRITE {
    my ( $socket, $buf, $len, $offset ) = @_;
    $offset = 0 unless defined $offset;
    my $ssl  = $socket->_get_ssl();
    my $self = $socket->_get_self();
    
    my $wrote_len = Net::SSLeay::write( $ssl, substr( $buf, $offset, $len ) );
  
    warn "wrote: $wrote_len";
    return 0 if $wrote_len < 0;
    return $wrote_len;
}

sub CLOSE {
    my $socket = shift;
    my $fileno = fileno( $socket );
    my $self = $socket->_get_self();

    delete $fnlist{$fileno};
    Net::SSLeay::free( $self->{ssl} );
    Net::SSLeay::CTX_free( $self->{ctx} );
    delete @{$self}{qw( ssl ctx socket )};
    close( $socket );
    return;
}
    
1;