7
  0   ˆl–Ðz¾”ÊeJi@à]¸)‹FÿÂ„_‹uÐb&=LV[(ÆÅ )}    package Net::SSLeay::Handle;

use 5.8.1;

use strict;

use Socket;
use Net::SSLeay;

require Exporter;

=encoding utf-8

=head1 NAME

Net::SSLeay::Handle - Perl module that lets SSL (HTTPS) sockets be
handled as standard file handles.

=head1 SYNOPSIS

  use Net::SSLeay::Handle qw/shutdown/;
  my ($host, $port) = ("localhost", 443);

  tie(*SSL, "Net::SSLeay::Handle", $host, $port);

  print SSL "GET / HTTP/1.0\r\n";
  shutdown(\*SSL, 1);
  print while (<SSL>);
  close SSL;                                                       

=head1 DESCRIPTION

Net::SSLeay::Handle allows you to request and receive HTTPS web pages
using "old-fashion" file handles as in:

    print SSL "GET / HTTP/1.0\r\n";

and

    print while (<SSL>);

If you export the shutdown routine, then the only extra code that
you need to add to your program is the tie function as in:

    my $socket;
    if ($scheme eq "https") {
        tie(*S2, "Net::SSLeay::Handle", $host, $port);
        $socket = \*S2;
    else {
        $socket = Net::SSLeay::Handle->make_socket($host, $port);
    }
    print $socket $request_headers;
    ... 

=cut

use vars qw(@ISA @EXPORT_OK $VERSION);
@ISA = qw(Exporter);
@EXPORT_OK = qw(shutdown);
$VERSION = '1.94';

my $Initialized;       #-- only _initialize() once
my $Debug = 0;         #-- pretty hokey

#== Tie Handle Methods ========================================================
#
# see perldoc perltie for details.
#
#==============================================================================

sub TIEHANDLE {
    my ($class, $socket, $port) = @_;
    $Debug > 10 and print "TIEHANDLE(@{[join ', ', @_]})\n";

    ref $socket eq "GLOB" or $socket = $class->make_socket($socket, $port);

    $class->_initialize();

    my $ctx = Net::SSLeay::CTX_new() or die_now("Failed to create SSL_CTX $!");
    my $ssl = Net::SSLeay::new($ctx) or die_now("Failed to create SSL $!");

    my $fileno = fileno($socket);

  Net::SSLeay::set_fd($ssl, $fileno);   # Must use fileno

    my $resp = Net::SSLeay::connect($ssl);

    $Debug and print "Cipher '" . Net::SSLeay::get_cipher($ssl) . "'\n";

	my $self = bless {
        ssl    => $ssl, 
        ctx    => $ctx,
        socket => $socket,
        fileno => $fileno,
    }, $class;

    return $self;
}

sub PRINT {
    my $self = shift;

    my $ssl  = _get_ssl($self);
    my $resp = 0;
    for my $msg (@_) {
        defined $msg or last;
        $resp = Net::SSLeay::write($ssl, $msg) or last;
    }
    return $resp;
}

sub READLINE {
    my $self = shift;
    my $ssl  = _get_ssl($self);
	if (wantarray) {
		my @lines;
		while (my $line = Net::SSLeay::ssl_read_until($ssl)) {
			push @lines, $line;
		}
		return @lines;
	} else {
		my $line = Net::SSLeay::ssl_read_until($ssl); 
		return $line ? $line : undef;
	}
}

sub READ {
    my ($self, $buf, $len, $offset) = \ (@_);
    my $ssl = _get_ssl($$self);
    defined($$offset) or 
      return length($$buf = Net::SSLeay::ssl_read_all($ssl, $$len));

    defined(my $read = Net::SSLeay::ssl_read_all($ssl, $$len))
      or return undef;

    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 $self = shift;
    my ($buf, $len, $offset) = @_;
    $offset = 0 unless defined $offset;

    # Return number of characters written.
    my $ssl  = $self->_get_ssl();
    return $len if Net::SSLeay::write($ssl, substr($buf, $offset, $len));
    return undef;
}

sub CLOSE {
    my $self = shift;
    my $fileno = $self->{fileno};
    $Debug > 10 and print "close($fileno)\n";
    Net::SSLeay::free ($self->{ssl});
    Net::SSLeay::CTX_free ($self->{ctx});
    close $self->{socket};
}

sub FILENO  { $_[0]->{fileno} }


=head1 FUNCTIONS

=over

=item shutdown

  shutdown(\*SOCKET, $mode)

Calls to the main shutdown() don't work with tied sockets created with this
module.  This shutdown should be able to distinquish between tied and untied
sockets and do the right thing.

=cut