1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
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<Net::Proxy::Connecter::dual> is a C<Net::Proxy::Connector>
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<in> connector.
The C<server_first> and C<client_first> options are required: they
are hashrefs containing the options necessary to create two C<out>
C<Net::Proxy::Connector> objects that will be used to connect to
the requested service.
The C<Net::Proxy::Connector::dual> 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<client_first>
connector. Otherwise, at the end of the timeout, it is connected
via the C<server_first> connector.
=over 4
=item * host
The hostname on which the connector will listen for client connections.
Default is C<localhost>.
=item * port
The port on which the connector will listen for client connections.
=item * server_first
Typically an C<out> connector to a SSH server or any service that sends
a banner line.
=item * client_first
Typically an C<out> 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<< <book@cpan.org> >>.
=head1 ACKNOWLEDGMENTS
This module is based on a script named B<sslh>, which I wrote with
Frdric Pl C<< <sslh@wattoo.org> >> (who had the original insight
about the fact that not all servers speak first on the wire).
Frdric wrote a C program, while I wrote a Perl script (based on my
experience with B<connect-tunnel>).
Now that C<Net::Proxy> 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
|
