125 lines
3.4 KiB
Perl
125 lines
3.4 KiB
Perl
# ====================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::Socket::Client::SSLHandle
|
|
# Author: Jason Rhinelander
|
|
# CVS Info :
|
|
# $Id: SSLHandle.pm,v 1.3 2004/01/13 01:35:20 jagerman Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ====================================================================
|
|
#
|
|
# Description:
|
|
# A tied filehandle for SSL connections with GT::Socket::Client (via
|
|
# Net::SSLeay::Handle).
|
|
#
|
|
|
|
package GT::Socket::Client::SSLHandle;
|
|
use strict;
|
|
use vars qw/$VERSION $ERROR/;
|
|
use GT::Socket::Client;
|
|
use Net::SSLeay 1.06 qw/print_errs/;
|
|
|
|
*ERROR = \$GT::Socket::Client::ERROR;
|
|
|
|
$VERSION = sprintf "%d.%03d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/;
|
|
|
|
Net::SSLeay::load_error_strings();
|
|
Net::SSLeay::SSLeay_add_ssl_algorithms();
|
|
Net::SSLeay::randomize();
|
|
|
|
sub TIEHANDLE {
|
|
my ($class, $socket) = @_;
|
|
|
|
my $ctx = Net::SSLeay::CTX_new()
|
|
or return ssl_err("Failed to create new SSL CTX: $!", "SSL CTX_new");
|
|
my $ssl = Net::SSLeay::new($ctx)
|
|
or return ssl_err("Failed to create SSL: $!", "SSL new");
|
|
|
|
my $fileno = fileno($socket);
|
|
Net::SSLeay::set_fd($ssl, $fileno);
|
|
|
|
my $connect = Net::SSLeay::connect($ssl);
|
|
|
|
${*$socket}{SSLHandle_ssl} = $ssl;
|
|
${*$socket}{SSLHandle_ctx} = $ctx;
|
|
${*$socket}{SSLHandle_fileno} = $fileno;
|
|
|
|
return bless $socket, $class;
|
|
}
|
|
|
|
sub PRINT {
|
|
my $socket = shift;
|
|
my $ssl = ${*$socket}{SSLHandle_ssl};
|
|
my $ret = 0;
|
|
for (@_) {
|
|
defined or last;
|
|
$ret = Net::SSLeay::write($ssl, $_);
|
|
if (!$ret) {
|
|
ssl_err("Could not write to SSL socket: $!", "SSL write");
|
|
last;
|
|
}
|
|
}
|
|
return $ret;
|
|
}
|
|
|
|
sub READLINE {
|
|
my $socket = shift;
|
|
my $ssl = ${*$socket}{SSLHandle_ssl};
|
|
my $line = Net::SSLeay::ssl_read_until($ssl);
|
|
if (!$line) {
|
|
ssl_err("Could not readline from SSL socket: $!", "SSL ssl_read_until");
|
|
return undef;
|
|
}
|
|
return $line;
|
|
}
|
|
|
|
sub READ {
|
|
my ($socket, $buffer, $length, $offset) = \(@_);
|
|
my $ssl = ${*$$socket}{SSLHandle_ssl};
|
|
if (defined $$offset) {
|
|
my $read = Net::SSLeay::ssl_read_all($ssl, $$length)
|
|
or return ssl_err("Could not read_all from SSL socket: $!", "SSL ssl_read_all");
|
|
my $buf_length = length($$buffer);
|
|
$$offset > $buf_length and $$buffer .= chr(0) x ($$offset - $buf_length);
|
|
substr($$buffer, $$offset) = $read;
|
|
return length($read);
|
|
}
|
|
else {
|
|
return length(
|
|
$$buffer = Net::SSLeay::ssl_read_all($ssl, $$length)
|
|
or return ssl_err("Could not read_all from SSL socket: $!", "SSL ssl_read_all")
|
|
);
|
|
}
|
|
}
|
|
|
|
sub WRITE {
|
|
my $socket = shift;
|
|
my ($buffer, $length, $offset) = @_;
|
|
$offset = 0 unless defined $offset;
|
|
|
|
# Return number of characters written
|
|
my $ssl = ${*$socket}{SSLHandle_ssl};
|
|
Net::SSLeay::write($ssl, substr($buffer, $offset, $length))
|
|
or return ssl_err("Could not write to SSL socket: $!", "SSL write");
|
|
return $length;
|
|
}
|
|
|
|
sub CLOSE {
|
|
my $socket = shift;
|
|
my $fileno = fileno($socket);
|
|
Net::SSLeay::free(${*$socket}{SSLHandle_ssl});
|
|
Net::SSLeay::CTX_free(${*$socket}{SSLHandle_ctx});
|
|
close $socket;
|
|
}
|
|
|
|
sub FILENO { fileno($_[0]) }
|
|
|
|
sub ssl_err {
|
|
my ($msg, $key) = @_;
|
|
$ERROR = "$msg\n" . print_errs($key); # Also sets $GT::Socket::Client::ERROR
|
|
return undef;
|
|
}
|
|
|
|
1;
|