… | |
… | |
22 | |
22 | |
23 | package AnyEvent::MP::Transport; |
23 | package AnyEvent::MP::Transport; |
24 | |
24 | |
25 | use common::sense; |
25 | use common::sense; |
26 | |
26 | |
27 | use Scalar::Util; |
27 | use Scalar::Util (); |
|
|
28 | use List::Util (); |
28 | use MIME::Base64 (); |
29 | use MIME::Base64 (); |
29 | use Storable (); |
30 | use Storable (); |
30 | use JSON::XS (); |
31 | use JSON::XS (); |
31 | |
32 | |
32 | use Digest::MD6 (); |
33 | use Digest::MD6 (); |
33 | use Digest::HMAC_MD6 (); |
34 | use Digest::HMAC_MD6 (); |
34 | |
35 | |
35 | use AE (); |
36 | use AE (); |
36 | use AnyEvent::Socket (); |
37 | use AnyEvent::Socket (); |
37 | use AnyEvent::Handle (); |
38 | use AnyEvent::Handle 4.92 (); |
38 | |
39 | |
39 | use base Exporter::; |
40 | use base Exporter::; |
40 | |
41 | |
41 | our $VERSION = '0.0'; |
42 | our $VERSION = '0.0'; |
42 | our $PROTOCOL_VERSION = 0; |
43 | our $PROTOCOL_VERSION = 0; |
… | |
… | |
112 | peername => $peername, # for verification |
113 | peername => $peername, # for verification |
113 | ; |
114 | ; |
114 | |
115 | |
115 | =cut |
116 | =cut |
116 | |
117 | |
|
|
118 | sub LATENCY() { 3 } # assumed max. network latency |
|
|
119 | |
117 | our @FRAMINGS = qw(json storable); # the framing types we accept and send, in order of preference |
120 | our @FRAMINGS = qw(json storable); # the framing types we accept and send, in order of preference |
118 | our @AUTH_SND = qw(hmac_md6_64_256); # auth types we send |
121 | our @AUTH_SND = qw(hmac_md6_64_256); # auth types we send |
119 | our @AUTH_RCV = (@AUTH_SND, qw(cleartext)); # auth types we accept |
122 | our @AUTH_RCV = (@AUTH_SND, qw(cleartext)); # auth types we accept |
120 | |
123 | |
121 | #AnyEvent::Handle::register_write_type mp_record => sub { |
124 | #AnyEvent::Handle::register_write_type mp_record => sub { |
… | |
… | |
132 | Scalar::Util::weaken (my $self = $self); |
135 | Scalar::Util::weaken (my $self = $self); |
133 | |
136 | |
134 | $arg{secret} = AnyEvent::MP::Base::default_secret () |
137 | $arg{secret} = AnyEvent::MP::Base::default_secret () |
135 | unless exists $arg{secret}; |
138 | unless exists $arg{secret}; |
136 | |
139 | |
137 | $arg{timeout} = 3#d# |
140 | $arg{timeout} = 30 |
138 | unless exists $arg{timeout}; |
141 | unless exists $arg{timeout}; |
|
|
142 | |
|
|
143 | $arg{timeout} = 1 + LATENCY |
|
|
144 | if $arg{timeout} < 1 + LATENCY; |
139 | |
145 | |
140 | my $secret = $arg{secret}; |
146 | my $secret = $arg{secret}; |
141 | |
147 | |
142 | if ($secret =~ /-----BEGIN RSA PRIVATE KEY-----.*-----END RSA PRIVATE KEY-----.*-----BEGIN CERTIFICATE-----.*-----END CERTIFICATE-----/s) { |
148 | if ($secret =~ /-----BEGIN RSA PRIVATE KEY-----.*-----END RSA PRIVATE KEY-----.*-----BEGIN CERTIFICATE-----.*-----END CERTIFICATE-----/s) { |
143 | # assume TLS mode |
149 | # assume TLS mode |
… | |
… | |
157 | autocork => 1, |
163 | autocork => 1, |
158 | no_delay => 1, |
164 | no_delay => 1, |
159 | on_error => sub { |
165 | on_error => sub { |
160 | $self->error ($_[2]); |
166 | $self->error ($_[2]); |
161 | }, |
167 | }, |
162 | timeout => $AnyEvent::MP::Base::CONNECT_TIMEOUT, |
168 | rtimeout => $AnyEvent::MP::Base::CONNECT_TIMEOUT, |
163 | peername => delete $arg{peername}, |
169 | peername => delete $arg{peername}, |
164 | ; |
170 | ; |
165 | |
171 | |
166 | my $greeting_kv = $self->{greeting} ||= {}; |
172 | my $greeting_kv = $self->{greeting} ||= {}; |
167 | |
173 | |
… | |
… | |
268 | $self->{s_framing} = $s_framing; |
274 | $self->{s_framing} = $s_framing; |
269 | |
275 | |
270 | $hdl->rbuf_max (undef); |
276 | $hdl->rbuf_max (undef); |
271 | my $queue = delete $self->{queue}; # we are connected |
277 | my $queue = delete $self->{queue}; # we are connected |
272 | |
278 | |
273 | $self->{hdl}->timeout ($self->{remote_greeting}{timeout}); |
279 | $self->{hdl}->rtimeout ($self->{remote_greeting}{timeout}); |
|
|
280 | $self->{hdl}->wtimeout ($arg{timeout} - LATENCY); |
|
|
281 | $self->{hdl}->on_wtimeout (sub { $self->send (["", "devnull"]) }); |
274 | |
282 | |
275 | $self->connected; |
283 | $self->connected; |
276 | |
284 | |
277 | my $src_node = $self->{node}; |
285 | # send queued messages |
278 | |
|
|
279 | $self->send ($_) |
286 | $self->send ($_) |
280 | for @$queue; |
287 | for @$queue; |
|
|
288 | |
|
|
289 | # receive handling |
|
|
290 | my $src_node = $self->{node}; |
281 | |
291 | |
282 | my $rmsg; $rmsg = sub { |
292 | my $rmsg; $rmsg = sub { |
283 | $_[0]->push_read ($r_framing => $rmsg); |
293 | $_[0]->push_read ($r_framing => $rmsg); |
284 | |
294 | |
285 | local $AnyEvent::MP::Base::SRCNODE = $src_node; |
295 | local $AnyEvent::MP::Base::SRCNODE = $src_node; |