Codebase list libpoe-component-sslify-perl / 3e003c9
add actual hook functionality for connection done Apocalypse 13 years ago
3 changed file(s) with 92 addition(s) and 55 deletion(s). Raw diff Collapse all Expand all
1010
1111 # Override TIEHANDLE because we create a CTX
1212 sub TIEHANDLE {
13 my ( $class, $socket, $version, $options, $ctx ) = @_;
13 my ( $class, $socket, $version, $options, $ctx, $connref ) = @_;
1414
1515 # create a context, if necessary
1616 if ( ! defined $ctx ) {
2828 # again, because OpenSSL I/O functions (read, write, ...) can handle that entirely
2929 # by self (it's needed to connect() once to determine connection type).
3030 my $res = Net::SSLeay::connect( $ssl ) or die_if_ssl_error( 'ssl connect' );
31 warn "Net::SSLeay::connect(TIEHANDLE) -> $res";
31 #warn "Net::SSLeay::connect(TIEHANDLE) -> $res";
3232 my $self = bless {
3333 'ssl' => $ssl,
3434 'ctx' => $ctx,
3636 'fileno' => $fileno,
3737 'client' => 1,
3838 'status' => $res,
39 'on_connect' => $connref,
3940 }, $class;
4041
4142 return $self;
66
77 # Ties the socket
88 sub TIEHANDLE {
9 my ( $class, $socket, $ctx ) = @_;
9 my ( $class, $socket, $ctx, $connref ) = @_;
1010
1111 my $ssl = Net::SSLeay::new( $ctx ) or die_now( "Failed to create SSL $!" );
1212
1919 # again, because OpenSSL I/O functions (read, write, ...) can handle that entirely
2020 # by self (it's needed to accept() once to determine connection type).
2121 my $res = Net::SSLeay::accept( $ssl ) and die_if_ssl_error( 'ssl accept' );
22 warn "Net::SSLeay::accept(TIEHANDLE) -> $res";
22 #warn "Net::SSLeay::accept(TIEHANDLE) -> $res";
2323 my $self = bless {
2424 'ssl' => $ssl,
2525 'ctx' => $ctx,
2626 'socket' => $socket,
2727 'fileno' => $fileno,
2828 'status' => $res,
29 'on_connect' => $connref,
2930 }, $class;
3031
3132 return $self;
4243 my $res;
4344 if ( exists $self->{'client'} ) {
4445 $res = Net::SSLeay::connect( $self->{'ssl'} );
45 warn "Net::SSLeay::connect($method) -> $res";
46 # warn "Net::SSLeay::connect($method) -> $res";
4647 } else {
4748 $res = Net::SSLeay::accept( $self->{'ssl'} );
48 warn "Net::SSLeay::accept($method) -> $res";
49 # warn "Net::SSLeay::accept($method) -> $res";
4950 }
5051
5152 if ( $res == 0 ) {
5354 } elsif ( $res == 1 ) {
5455 $self->{'status'} = 1;
5556
56 # TODO call the hook function for successful connect
57 warn "CALLING HOOK FUNCTION for " . ( exists $self->{'client'} ? 'CLIENT' : 'SERVER' );
57 # call the hook function for successful connect
58 $self->{'on_connect'}->( $self ) if defined $self->{'on_connect'};
5859 }
5960 }
6061 }
4646
4747 =func Client_SSLify
4848
49 Accepts a socket, returns a brand new socket SSLified. Optionally accepts SSL
50 context data.
51 my $socket = shift; # get the socket from somewhere
52 $socket = Client_SSLify( $socket ); # the default
53 $socket = Client_SSLify( $socket, $version, $options ); # sets more options for the context
54 $socket = Client_SSLify( $socket, undef, undef, $ctx ); # pass in a custom context
55
56 If $ctx is defined, SSLify will ignore other args. If $ctx isn't defined, SSLify
57 will create it from the $version + $options parameters.
58
59 Known versions:
60 * sslv2
61 * sslv3
62 * tlsv1
63 * default
64
65 By default we use the version: default
66
67 By default we don't set any options
68
69 NOTE: The way to have a client socket with proper certificates set up is:
70 my $socket = shift; # get the socket from somewhere
71 my $ctx = SSLify_ContextCreate( 'server.key', 'server.crt' );
72 $socket = Client_SSLify( $socket, undef, undef, $ctx );
73
74 BEWARE: If you passed in a CTX, SSLify will do Net::SSLeay::CTX_free( $ctx ) when the
75 socket is destroyed. This means you cannot reuse contexts!
49 Accepts a socket, returns a brand new socket SSLified. Optionally accepts SSL
50 context data. Also accepts a subref to call when connection/negotiation is done.
51
52 my $socket = shift; # get the socket from somewhere
53 $socket = Client_SSLify( $socket ); # the default
54 $socket = Client_SSLify( $socket, $version, $options ); # sets more options for the context
55 $socket = Client_SSLify( $socket, undef, undef, $ctx ); # pass in a custom context
56 $socket = Client_SSLify( $socket, sub { print "CONNECTED" } ); # call your connection function
57
58 If $ctx is defined, SSLify will ignore other args. If $ctx isn't defined, SSLify
59 will create it from the $version + $options parameters.
60
61 Known versions:
62 * sslv2
63 * sslv3
64 * tlsv1
65 * default
66
67 By default we use the version: default
68
69 By default we don't set any options
70
71 NOTE: The way to have a client socket with proper certificates set up is:
72
73 my $socket = shift; # get the socket from somewhere
74 my $ctx = SSLify_ContextCreate( 'server.key', 'server.crt' );
75 $socket = Client_SSLify( $socket, undef, undef, $ctx );
76
77 BEWARE: If you passed in a CTX, SSLify will do Net::SSLeay::CTX_free( $ctx ) when the
78 socket is destroyed. This means you cannot reuse contexts!
79
80 NOTE: You can pass the subref anywhere in the arguments, we'll figure it out for you! If you want to call a POE event, please look
81 into the postback/callback stuff in POE::Session. The subref will get the socket as the sole argument.
82
83 $socket = Client_SSLify( $socket, $session->callback( 'got_connect' => @args ) );
7684 =cut
7785
7886 sub Client_SSLify {
7987 # Get the socket + version + options + ctx
80 my( $socket, $version, $options, $ctx ) = @_;
88 my( $socket, $version, $options, $ctx, $connref ) = @_;
8189
8290 # Validation...
8391 if ( ! defined $socket ) {
8492 die "Did not get a defined socket";
93 }
94
95 # Mangle the connref stuff
96 if ( defined $version and ref $version and ref( $version ) eq 'CODE' ) {
97 $connref = $version;
98 $version = $options = $ctx = undef;
99 } elsif ( defined $options and ref $options and ref( $options ) eq 'CODE' ) {
100 $connref = $options;
101 $options = $ctx = undef;
102 } elsif ( defined $ctx and ref $ctx and ref( $ctx ) eq 'CODE' ) {
103 $connref = $ctx;
104 $ctx = undef;
85105 }
86106
87107 # From IO::Handle POD
92112
93113 # Now, we create the new socket and bind it to our subclass of Net::SSLeay::Handle
94114 my $newsock = gensym();
95 tie( *$newsock, 'POE::Component::SSLify::ClientHandle', $socket, $version, $options, $ctx ) or die "Unable to tie to our subclass: $!";
115 tie( *$newsock, 'POE::Component::SSLify::ClientHandle', $socket, $version, $options, $ctx, $connref ) or die "Unable to tie to our subclass: $!";
96116
97117 # All done!
98118 return $newsock;
100120
101121 =func Server_SSLify
102122
103 Accepts a socket, returns a brand new socket SSLified
104 my $socket = shift; # get the socket from somewhere
105 $socket = Server_SSLify( $socket );
106
107 NOTE: SSLify_Options must be set first!
108
109 Furthermore, you can pass in your own $ctx object if you desire. This allows you to set custom parameters
110 per-connection, for example.
111 my $socket = shift; # get the socket from somewhere
112 my $ctx = SSLify_ContextCreate();
113 # set various options on $ctx as desired
114 $socket = Server_SSLify( $socket, $ctx );
115
116 NOTE: You can use SSLify_GetCTX to modify the global, and avoid doing this on every connection if the
117 options are the same...
123 Accepts a socket, returns a brand new socket SSLified. Also accepts a custom context. Also accepts a subref
124 to call when connection/negotiation is done.
125
126 my $socket = shift; # get the socket from somewhere
127 $socket = Server_SSLify( $socket );
128 $socket = Server_SSLify( $socket, $ctx ); # use your custom context
129 $socket = Server_SSLify( $socket, sub { print "CONNECTED" } ); # call your connection function
130
131 NOTE: SSLify_Options must be set first!
132
133 Furthermore, you can pass in your own $ctx object if you desire. This allows you to set custom parameters
134 per-connection, for example.
135
136 my $socket = shift; # get the socket from somewhere
137 my $ctx = SSLify_ContextCreate();
138 # set various options on $ctx as desired
139 $socket = Server_SSLify( $socket, $ctx );
140
141 NOTE: You can use SSLify_GetCTX to modify the global, and avoid doing this on every connection if the
142 options are the same...
143
144 NOTE: You can pass the subref anywhere in the arguments, we'll figure it out for you! If you want to call a POE event, please look
145 into the postback/callback stuff in POE::Session. The subref will get the socket as the sole argument.
146
147 $socket = Server_SSLify( $socket, $session->callback( 'got_connect' => @args ) );
118148 =cut
119149
120150 sub Server_SSLify {
121151 # Get the socket!
122 my $socket = shift;
123 my $custom_ctx = shift;
152 my( $socket, $custom_ctx, $connref ) = @_;
124153
125154 # Validation...
126155 if ( ! defined $socket ) {
130159 # If we don't have a ctx ready, we can't do anything...
131160 if ( ! defined $ctx and ! defined $custom_ctx ) {
132161 die 'Please do SSLify_Options() first ( or pass in a $ctx object )';
162 }
163
164 # mangle custom_ctx depending on connref
165 if ( ref $custom_ctx and ref( $custom_ctx ) eq 'CODE' ) {
166 $connref = $custom_ctx;
167 $custom_ctx = $ctx;
133168 }
134169
135170 # From IO::Handle POD
140175
141176 # Now, we create the new socket and bind it to our subclass of Net::SSLeay::Handle
142177 my $newsock = gensym();
143 tie( *$newsock, 'POE::Component::SSLify::ServerHandle', $socket, ( $custom_ctx || $ctx ) ) or die "Unable to tie to our subclass: $!";
178 tie( *$newsock, 'POE::Component::SSLify::ServerHandle', $socket, $custom_ctx, $connref ) or die "Unable to tie to our subclass: $!";
144179
145180 # All done!
146181 return $newsock;