ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/AnyEvent-Porttracker/Porttracker.pm
(Generate patch)

Comparing cvsroot/AnyEvent-Porttracker/Porttracker.pm (file contents):
Revision 1.18 by root, Wed Jan 7 01:41:33 2015 UTC vs.
Revision 1.19 by root, Tue Jul 26 16:12:46 2016 UTC

… …
101 101
102use AnyEvent (); 102use AnyEvent ();
103use AnyEvent::Handle (); 103use AnyEvent::Handle ();
104 104
105use MIME::Base64 (); 105use MIME::Base64 ();
106use Digest::HMAC_MD6 ();
107use JSON (); 106use JSON ();
108 107
109our $VERSION = '1.01'; 108our $VERSION = 1.02;
110 109
111sub call { 110sub call {
112 my ($self, $type, @args) = @_; 111 my ($self, $type, @args) = @_;
113 112
114 $self->{$type} 113 $self->{$type}
… …
118 : () 117 : ()
119} 118}
120 119
121=item $api = new AnyEvent::Porttracker [key => value...] 120=item $api = new AnyEvent::Porttracker [key => value...]
122 121
123Creates a new porttracker API connection object and tries to connect to 122Creates a new porttracker API connection object and tries to connect
124the specified host (see below). After the connection has been established, 123to the specified host (see below). After the connection has been
125the TLS handshake (if requested) will take place, followed by a login 124established, the TLS handshake (if requested) will take place, followed
126attempt using either the C<none>, C<login_cram_md6> or C<login> methods, 125by a login attempt using either the C<none>, C<login_cram_sha3>,
127in this order of preference (typically, C<login_cram_md6> is used, which 126C<login_cram_md6> or C<login> methods, in this order of preference
127(typically, C<login_cram_sha3> is used, which shields against some
128shields against some man-in-the-middle attacks and avoids transferring the 128man-in-the-middle attacks and avoids transferring the password).
129password).
130 129
131It is permissible to send requests immediately after creating the object - 130It is permissible to send requests immediately after creating the object -
132they will be queued until after successful login. 131they will be queued until after successful login.
133 132
134Possible key-value pairs are: 133Possible key-value pairs are:
… …
408 407
409sub _login { 408sub _login {
410 my ($self) = @_; 409 my ($self) = @_;
411 410
412 my ($auths, $nonce) = @{ delete $self->{hello} or return }; 411 my ($auths, $nonce) = @{ delete $self->{hello} or return };
412 use Data::Dump; ddx $auths;#d#
413 413
414 if (grep $_ eq "none", @$auths) { 414 if (grep $_ eq "none", @$auths) {
415 $self->_login_success ("none"); 415 $self->_login_success ("none");
416 } elsif (grep $_ eq "login_cram_sha3", @$auths) {
417 my $cc = join "", map chr 256 * rand, 0..63;
416 418
419 require Digest::SHA3;
420 require Digest::HMAC;
421
422 my $hmac_sha3 = sub ($$){ # $key, $text
423 Digest::HMAC::hmac ($_[1], $_[0], \&Digest::SHA3::sha3_512, 72)
424 };
425
426 my $key = $hmac_sha3->($self->{pass}, $self->{user});
427 my $cr = $hmac_sha3->($key, "$cc$nonce");
428 my $sr = $hmac_sha3->($key, "$nonce$cc");
429
430 $cc = MIME::Base64::encode_base64 $cc;
431 $cr = MIME::Base64::encode_base64 $cr;
432
433 $self->_req (login_cram_sha3 => $self->{user}, $cr, $cc, sub {
434 my ($self, $ok, $msg) = @_;
435
436 $ok
437 or return call $self, on_login_failure => $msg;
438
439 (MIME::Base64::decode_base64 $msg) eq $sr
440 or return call $self, on_login_failure => "sr and cr mismatch, possible man in the middle attack";
441
442 $self->_login_success ("login_cram_sha3");
443 });
417 } elsif (grep $_ eq "login_cram_md6", @$auths) { 444 } elsif (grep $_ eq "login_cram_md6", @$auths) {
418 my $cc = join "", map chr 256 * rand, 0..63; 445 my $cc = join "", map chr 256 * rand, 0..63;
419 446
447 require Digest::HMAC_MD6;
448
420 my $key = Digest::HMAC_MD6::hmac_md6 $self->{pass}, $self->{user}, 64, 256; 449 my $key = Digest::HMAC_MD6::hmac_md6 ($self->{pass}, $self->{user}, 64, 256);
421 my $cr = Digest::HMAC_MD6::hmac_md6_base64 $key, "$cc$nonce", 64, 256; 450 my $cr = Digest::HMAC_MD6::hmac_md6 ($key, "$cc$nonce", 64, 256);
422 my $sr = Digest::HMAC_MD6::hmac_md6_base64 $key, "$nonce$cc", 64, 256; 451 my $sr = Digest::HMAC_MD6::hmac_md6 ($key, "$nonce$cc", 64, 256);
423 452
424 $cc = MIME::Base64::encode_base64 $cc; 453 $cc = MIME::Base64::encode_base64 $cc;
454 $cr = MIME::Base64::encode_base64 $cr;
425 455
426 $self->_req (login_cram_md6 => $self->{user}, $cr, $cc, sub { 456 $self->_req (login_cram_md6 => $self->{user}, $cr, $cc, sub {
427 my ($self, $ok, $msg) = @_; 457 my ($self, $ok, $msg) = @_;
428 458
429 $ok 459 $ok
430 or return call $self, on_login_failure => $msg; 460 or return call $self, on_login_failure => $msg;
431 461
432 $msg eq $sr 462 (MIME::Base64::decode_base64 $msg) eq $sr
433 or return call $self, on_login_failure => "sr and cr mismatch, possible man in the middle attack"; 463 or return call $self, on_login_failure => "sr and cr mismatch, possible man in the middle attack";
434 464
435 $self->_login_success ("login_cram_md6"); 465 $self->_login_success ("login_cram_md6");
436 }); 466 });
437 } elsif (grep $_ eq "login", @$auths) { 467 } elsif (grep $_ eq "login", @$auths) {

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines