package Net::Proxy::Connector::dual; use strict; use warnings; use Carp; use Scalar::Util qw( reftype ); use Net::Proxy::Connector; our @ISA = qw( Net::Proxy::Connector ); sub init { my ($self) = @_; # check connectors for my $conn (qw( client_first server_first )) { croak "'$conn' connector required" if !exists $self->{$conn}; croak "'$conn' connector must be a HASHREF" if ref $self->{$conn} ne 'HASH'; croak "'type' key required for '$conn' connector" if !exists $self->{$conn}{type}; croak "'hook' key is not a CODE reference for '$conn' connector" if $self->{$conn}{hook} && reftype( $self->{$conn}{hook} ) ne 'CODE'; # load the class my $class = 'Net::Proxy::Connector::' . $self->{$conn}{type}; eval "require $class"; croak "Couldn't load $class for '$conn' connector: $@" if $@; # create and store the Connector object $self->{$conn} = $class->new( $self->{$conn} ); $self->{$conn}->set_proxy($self->{_proxy_}); } # other parameters croak q{Parameter 'port' is required} if !exists $self->{port}; $self->{timeout} ||= 1; # by default wait for one second $self->{host} ||= 'localhost'; # by default listen on localhost return; } # IN *listen = \&Net::Proxy::Connector::raw_listen; sub accept_from { my ( $self, $listen ) = @_; my $sock = $self->raw_accept_from($listen); # find out who speaks first # if the client talks first, it's a client_first connection my $waiter = IO::Select->new($sock); my @waited = $waiter->can_read( $self->{timeout} ); my $type = @waited ? 'client_first' : 'server_first'; # do the outgoing connection $self->{$type}->_out_connect_from($sock); return $sock; } # OUT # READ *read_from = \&Net::Proxy::Connector::raw_read_from; # WRITE *write_to = \&Net::Proxy::Connector::raw_write_to; 1; __END__ =head1 NAME Net::Proxy::Connector::dual - Y-shaped Net::Proxy connector =head1 DESCRIPTION C is a C that can forward the connection to two distinct services, based on the client connection, before any data is exchanged. =head1 CONNECTOR OPTIONS This connector can only work as an C connector. The C and C options are required: they are hashrefs containing the options necessary to create two C C objects that will be used to connect to the requested service. The C object decides between the two services by waiting during a short timeout. If the client sends some data directly, then it is connected via the C connector. Otherwise, at the end of the timeout, it is connected via the C connector. =over 4 =item * host The hostname on which the connector will listen for client connections. Default is C. =item * port The port on which the connector will listen for client connections. =item * server_first Typically an C connector to a SSH server or any service that sends a banner line. =item * client_first Typically an C connectrot to a web server or SSL server. =item * timeout The timeout in seconds (can be decimal) to make a decision. Default is 1 second. =back =head1 AUTHOR Philippe 'BooK' Bruhat, C<< >>. =head1 ACKNOWLEDGMENTS This module is based on a script named B, which I wrote with Frédéric Plé C<< >> (who had the original insight about the fact that not all servers speak first on the wire). Frédéric wrote a C program, while I wrote a Perl script (based on my experience with B). Now that C is available, I've ported the Perl script to use it. =head1 COPYRIGHT Copyright 2006 Philippe 'BooK' Bruhat, All Rights Reserved. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut