src/util/cramtest.pl

   1 #!/usr/bin/perl
   2 # SPDX-License-Identifier: GPL-2.0-only
   3
   4 # This script is contributed by Vadim Vygonets to aid in debugging CRAM-MD5
   5 # authentication.
   6
   7 # A patch was contributed by Jon Warbrick to upgrade it to use the Digest::MD5
   8 # module instead of the deprecated MD5 module.
   9
  10 # The script prompts for three data values: a user name, a password, and the
  11 # challenge as sent out by an SMTP server. The challenge is a base-64 string.
  12 # It should be copied (cut-and-pasted) literally as the third data item. The
  13 # output of the program is the base-64 string that is to be returned as the
  14 # response to the challenge. Using the example in RFC 2195:
  15 #
  16 # User: tim
  17 # Password: tanstaaftanstaaf
  18 # Challenge: PDE4OTYuNjk3MTcwOTUyQHBvc3RvZmZpY2UucmVzdG9uLm1jaS5uZXQ+
  19 # dGltIGI5MTNhNjAyYzdlZGE3YTQ5NWI0ZTZlNzMzNGQzODkw
  20 #
  21 # The last line is what you you would send back to the server.
  22
  23
  24 # Copyright (c) 2002
  25 #       Vadim Vygonets <vadik-exim@vygo.net>.  All rights reserved.
  26 # Public domain is OK with me.
  27
  28 BEGIN { pop @INC if $INC[-1] eq '.' };
  29
  30 use MIME::Base64;
  31 use Digest::MD5;
  32
  33 print "User: ";
  34 chop($user = <>);
  35 print "Password: ";
  36 chop($passwd = <>);
  37 print "Challenge: ";
  38 chop($chal = <>);
  39 $chal =~ s/^334 //;
  40
  41 $context = new Digest::MD5;
  42 if (length($passwd) > 64) {
  43         $context->add($passwd);
  44         $passwd = $context->digest();
  45         $context->reset();
  46 }
  47
  48 @passwd = unpack("C*", pack("a64", $passwd));
  49 for ($i = 0; $i < 64; $i++) {
  50         $pass_ipad[$i] = $passwd[$i] ^ 0x36;
  51         $pass_opad[$i] = $passwd[$i] ^ 0x5C;
  52 }
  53 $context->add(pack("C64", @pass_ipad), decode_base64($chal));
  54 $digest = $context->digest();
  55 $context->reset();
  56 $context->add(pack("C64", @pass_opad), $digest);
  57 $digest = $context->digest();
  58
  59 print encode_base64($user . " " . unpack("H*", $digest));
  60
  61 # End