Changeset: 60bc5b33a191 for MonetDB URL: http://dev.monetdb.org/hg/MonetDB?cmd=changeset;node=60bc5b33a191 Modified Files: clients/ChangeLog.Aug2011 clients/perl/Mapi.pm Branch: Aug2011 Log Message:
Mapi.pm: add support for proto v9 Implemented hashing support during challenge/response and v9 support such that we can log into current mserver5's with mclient.pl again. diffs (108 lines): diff --git a/clients/ChangeLog.Aug2011 b/clients/ChangeLog.Aug2011 --- a/clients/ChangeLog.Aug2011 +++ b/clients/ChangeLog.Aug2011 @@ -1,6 +1,9 @@ # ChangeLog file for clients # This file is updated with Maddlog +* Sun Jul 17 2011 Fabian Groffen <[email protected]> +- Made Mapi.pm usable with current versions of MonetDB again + * Mon Apr 18 2011 Fabian Groffen <[email protected]> - When the first non-option argument of mclient does not refer to an exising file, it now is taken as database name. This allows to simply diff --git a/clients/perl/Mapi.pm b/clients/perl/Mapi.pm --- a/clients/perl/Mapi.pm +++ b/clients/perl/Mapi.pm @@ -20,7 +20,56 @@ use strict; use Socket; use IO::Socket; -#use IO::Handle; +use Digest::MD5 'md5_hex'; +use Digest::SHA qw(sha1_hex sha256_hex sha512_hex); + +sub pass_chal { + my ($passwd, @challenge) = @_; + if (@challenge[2] == 9) { + my $pwhash = @challenge[5]; + if ($pwhash eq 'SHA512') { + $passwd = sha512_hex($passwd); + } elsif ($pwhash eq 'SHA256') { + $passwd = sha256_hex($passwd); + } elsif ($pwhash eq 'SHA1') { + $passwd = sha1_hex($passwd); + } elsif ($pwhash eq 'MD5') { + $passwd = md5_hex($passwd); + } else { + warn "unsupported password hash: ".$pwhash; + return; + } + } elsif (@challenge[2] == 8) { + # can leave passwd cleartext + } else { + warn "unsupported protocol version: ".@challenge[2]; + return; + } + + my @cyphers = split(/,/, @challenge[3]); + my $chal; + foreach (@cyphers) { + if ($_ eq 'SHA512') { + $chal = "{$_}".sha512_hex($passwd.@challenge[0]); + last; + } elsif ($_ eq 'SHA256') { + $chal = "{$_}".sha256_hex($passwd.@challenge[0]); + last; + } elsif ($_ eq 'SHA1') { + $chal = "{$_}".sha1_hex($passwd.@challenge[0]); + last; + } elsif ($_ eq 'MD5') { + $chal = "{$_}".md5_hex($passwd.@challenge[0]); + last; + } + } + if (!$chal) { + # we assume v8's "plain" + $chal = "{plain}".$passwd.@challenge[0]; + } + + return $chal; +} sub new { my $mapi = shift; @@ -54,12 +103,15 @@ #binmode($self->{socket},":utf8"); #block challenge:mserver:8:cypher(s):content_byteorder(BIG/LIT)\n"); + #block challenge:mserver:9:cypher(s):content_byteorder(BIG/LIT):pwhash\n"); my $block = $self->getblock(); my @challenge = split(/:/, $block); print "Connection to socket established ($block)\n" if ($self->{trace}); + my $passchal = pass_chal($passwd, @challenge) || die; + # content_byteorder(BIG/LIT):user:{cypher_algo}mypasswordchallenge_cyphered:lang:database: - $self->putblock("LIT:$user:{plain}$passwd" . @challenge[0] . ":$lang:$db:\n"); + $self->putblock("LIT:$user:$passchal:$lang:$db:\n"); my $prompt = $self->getblock(); if ($prompt =~ /^\^mapi:monetdb:/) { # full reconnect @@ -67,13 +119,14 @@ print "Following redirect: $prompt\n" if ($self->{trace}); my @tokens = split(/[\n\/:\?]+/, $prompt); # dirty, but it's Perl anyway return new Mapi(@tokens[3], @tokens[4], $user, $passwd, $lang, @tokens[5], $trace); - } elsif ($prompt =~ /^\^mapi:merovingian:proxy/) { + } elsif ($prompt =~ /^\^mapi:merovingian:\/\/proxy/) { # proxied redirect do { print "Being proxied by $host:$port\n" if ($self->{trace}); $block = $self->getblock(); @challenge = split(/:/, $block); - $self->putblock("LIT:$user:{plain}$passwd" . @challenge[0] . ":$lang:$db:\n"); + $passchal = pass_chal($passwd, @challenge) || die; + $self->putblock("LIT:$user:$passchal:$lang:$db:\n"); $prompt = $self->getblock(); } while ($prompt =~ /^\^mapi:merovingian:proxy/); } # TODO: don't die on warnings (#) _______________________________________________ Checkin-list mailing list [email protected] http://mail.monetdb.org/mailman/listinfo/checkin-list
