IO-Socket-Forwarder

 view release on metacpan or  search on metacpan

lib/IO/Socket/Forwarder.pm  view on Meta::CPAN

sub _debug {
    require Time::HiRes;
    my $time = Time::HiRes::time();
    my @date = localtime $time;
    my $out = "@_";
    $out =~ s/([^ -~])/sprintf("\\x%02x", ord $1)/ge;
    warn sprintf("%02d:%02d:%02d.%03d: %s\n",
		 @date[2, 1, 0], 1000 * ($time - int $time), $out);
}

# lazy accessors to IO::Socket::SSL
# we use it but don't depend on it!
sub _ssl_error { $IO::Socket::SSL::SSL_ERROR }
sub _ssl_want_read { IO::Socket::SSL::SSL_WANT_READ() }
sub _ssl_want_write { IO::Socket::SSL::SSL_WANT_WRITE() }

sub _min { $_[0] < $_[1] ? $_[0] : $_[1] }

sub forward_sockets {
    my ($s1, $s2, %opts) = @_;

    my $debug = delete $opts{debug};
    $debug = $IO::Socket::Forwarder::debug unless defined $debug;

    my $io_buffer_size = delete $opts{io_buffer_size} || _default_io_buffer_size;
    my $io_chunk_size  = delete $opts{io_chunk_size}  || _default_io_chunk_size;

    my $fn1 = fileno $s1;
    defined $fn1 or croak "socket 1 is not a valid file handle";
    my $fn2 = fileno $s2;
    defined $fn1 or croak "socket 2 is not a valid file handle";

    my $ssl1 = $s1->isa('IO::Socket::SSL');
    my $ssl2 = $s2->isa('IO::Socket::SSL');

    $debug and _debug "s1 fn=$fn1, ssl=$ssl1";
    $debug and _debug "s2 fn=$fn2, ssl=$ssl2";

    my $b1to2 = delete $opts{buffer_1to2} // '';
    my $b2to1 = delete $opts{buffer_2to1} // '';

    if ($debug) {
	_debug "b1to2: $b1to2";
	_debug "b2to1: $b2to1";

lib/IO/Socket/Forwarder.pm  view on Meta::CPAN

  forward_sockets($sock1, $sock2);

  forward_sockets($sock3, $sock4, debug => 1);


=head1 DESCRIPTION

This module allows to forward data between two sockets bidirectionally.

IO::Socket::SSL sockets are also supported.

=head2 FUNCTIONS

=over 4

=item forward_sockets($sock1, $sock2, %opts)

Reads and writes data from both sockets simultaneously forwarding it.

On return both sockets will be closed.

This function automatically detects if any of the sockets is of type
L<IO::Socket::SSL> and doesn't require any extra configuration to
handle them.

The following options are accepted:

=over 4

=item debug => 1

turn on debugging. I

lib/IO/Socket/Forwarder.pm  view on Meta::CPAN

these options allow to preload some data into the buffers used for
transferring data between the two sockets.

=back

=back

=head1 SEE ALSO

L<IO::Socket>, L<IO::Socket::SSL>.

The samples directory contains a couple of scripts showing how to use
this module.

=head1 BUGS AND SUPPORT

Please report any bugs or feature requests through the web interface
at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=IO-Socket-Forwarder>
or just send my an email with the details.

samples/sproxy2gmane.pl  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;

use IO::Socket::SSL;
use IO::Socket::Forwarder qw(forward_sockets);

my $port = $ARGV[0] || 3333;

my $listener = IO::Socket::SSL->new(LocalPort => $port,
				    Proto => 'tcp',
				    Listen => 2,
				    ReuseAddr => 1)
    or die "unable to create socket" . IO::Socket::SSL::errstr();

while (1) {
    my $local = $listener->accept();
    my $nntp = IO::Socket::INET->new('news.gmane.org:nntp');
    forward_sockets($local, $nntp);
}