# ==================================================================== # 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;