--- cvsroot/AnyEvent-Porttracker/Porttracker.pm	2015/01/07 01:41:33	1.18
+++ cvsroot/AnyEvent-Porttracker/Porttracker.pm	2016/07/26 16:12:46	1.19
@@ -103,10 +103,9 @@
 use AnyEvent::Handle ();
 
 use MIME::Base64 ();
-use Digest::HMAC_MD6 ();
 use JSON ();
 
-our $VERSION = '1.01';
+our $VERSION = 1.02;
 
 sub call {
    my ($self, $type, @args) = @_;
@@ -120,13 +119,13 @@
 
 =item $api = new AnyEvent::Porttracker [key => value...]
 
-Creates a new porttracker API connection object and tries to connect to
-the specified host (see below). After the connection has been established,
-the TLS handshake (if requested) will take place, followed by a login
-attempt using either the C<none>, C<login_cram_md6> or C<login> methods,
-in this order of preference (typically, C<login_cram_md6> is used, which
-shields against some man-in-the-middle attacks and avoids transferring the
-password).
+Creates a new porttracker API connection object and tries to connect
+to the specified host (see below). After the connection has been
+established, the TLS handshake (if requested) will take place, followed
+by a login attempt using either the C<none>, C<login_cram_sha3>,
+C<login_cram_md6> or C<login> methods, in this order of preference
+(typically, C<login_cram_sha3> is used, which shields against some
+man-in-the-middle attacks and avoids transferring the password).
 
 It is permissible to send requests immediately after creating the object -
 they will be queued until after successful login.
@@ -410,18 +409,49 @@
    my ($self) = @_;
 
    my ($auths, $nonce) = @{ delete $self->{hello} or return };
+   use Data::Dump; ddx $auths;#d#
 
    if (grep $_ eq "none", @$auths) {
       $self->_login_success ("none");
+   } elsif (grep $_ eq "login_cram_sha3", @$auths) {
+      my $cc = join "", map chr 256 * rand, 0..63;
+
+      require Digest::SHA3;
+      require Digest::HMAC;
+
+      my $hmac_sha3 = sub ($$){ # $key, $text
+         Digest::HMAC::hmac ($_[1], $_[0], \&Digest::SHA3::sha3_512, 72)
+      };
+
+      my $key = $hmac_sha3->($self->{pass}, $self->{user});
+      my $cr  = $hmac_sha3->($key, "$cc$nonce");
+      my $sr  = $hmac_sha3->($key, "$nonce$cc");
+
+      $cc = MIME::Base64::encode_base64 $cc;
+      $cr = MIME::Base64::encode_base64 $cr;
+
+      $self->_req (login_cram_sha3 => $self->{user}, $cr, $cc, sub {
+         my ($self, $ok, $msg) = @_;
 
+         $ok
+            or return call $self, on_login_failure => $msg;
+
+         (MIME::Base64::decode_base64 $msg) eq $sr
+            or return call $self, on_login_failure => "sr and cr mismatch, possible man in the middle attack";
+
+         $self->_login_success ("login_cram_sha3");
+      });
    } elsif (grep $_ eq "login_cram_md6", @$auths) {
       my $cc = join "", map chr 256 * rand, 0..63;
 
-      my $key = Digest::HMAC_MD6::hmac_md6 $self->{pass}, $self->{user}, 64, 256;
-      my $cr  = Digest::HMAC_MD6::hmac_md6_base64 $key, "$cc$nonce", 64, 256;
-      my $sr  = Digest::HMAC_MD6::hmac_md6_base64 $key, "$nonce$cc", 64, 256;
+      require Digest::HMAC_MD6;
+
+      my $key = Digest::HMAC_MD6::hmac_md6 ($self->{pass}, $self->{user}, 64, 256);
+      my $cr  = Digest::HMAC_MD6::hmac_md6 ($key, "$cc$nonce", 64, 256);
+      my $sr  = Digest::HMAC_MD6::hmac_md6 ($key, "$nonce$cc", 64, 256);
 
       $cc = MIME::Base64::encode_base64 $cc;
+      $cr = MIME::Base64::encode_base64 $cr;
 
       $self->_req (login_cram_md6 => $self->{user}, $cr, $cc, sub {
          my ($self, $ok, $msg) = @_;
@@ -429,7 +459,7 @@
          $ok
             or return call $self, on_login_failure => $msg;
 
-         $msg eq $sr
+         (MIME::Base64::decode_base64 $msg) eq $sr
             or return call $self, on_login_failure => "sr and cr mismatch, possible man in the middle attack";
 
          $self->_login_success ("login_cram_md6");