1#! @PERL@ -w 2use MIME::Base64; 3use Digest::MD5 qw(md5 md5_hex); 4 5# Test CRAM-MD5 (RFC 2195) authentication. See also RFC 1734 for POP3 AUTH. 6 7# To duplicate the example in RFC 2195: 8# $ perl testcrammd5.pl 9# Username? tim 10# Password? tanstaaftanstaaf 11# Challenge? PDE4OTYuNjk3MTcwOTUyQHBvc3RvZmZpY2UucmVzdG9uLm1jaS5uZXQ+ 12# Response: 13# dGltIGI5MTNhNjAyYzdlZGE3YTQ5NWI0ZTZlNzMzNGQzODkw 14 15# To use with courier-imap: 16# telnet localhost 110 17# capa 18# << check for SASL CRAM-MD5 in response 19# auth cram-md5 20# << note the challenge, paste it into this program 21# << paste back the response 22# 23# or: 24# telnet localhost 143 25# << check for [CAPABILITY ... AUTH=CRAM-MD5 ...] in response 26# a authenticate cram-md5 27# << note the challenge, paste it into this program 28# << paste back the response 29 30# Remember: to get CRAM-MD5 authentication working in Courier-IMAP you 31# need to set several things: 32# - settings POP3AUTH in pop3d and/or IMAP_CAPABILITY in imapd 33# - in userdb set attribute hmac-md5pw (or pop3-hmac-md5pw etc) 34# userdbpw -hmac-md5 | userdb fred@flintstone.org set hmac-md5pw 35# Password: 36# Reenter password: 37# makeuserdb 38# - in mysql/pgsql/ldap set cleartext password 39 40print "Username? "; 41$username = <STDIN>; 42chomp($username); 43print "Password? "; 44$password = <STDIN>; 45chomp($password); 46 47print "Send: AUTH CRAM-MD5 (or for imap, A AUTHENTICATE CRAM-MD5)\n"; 48print "Paste the challenge here:\n+ "; 49$challenge = <STDIN>; 50chomp($challenge); 51$challenge =~ s/^\+?\ *//; 52$challenge = decode_base64($challenge); 53 54if (length($password) > 64) { 55 $password = md5($password); 56} 57while (length($password) < 64) { 58 $password = $password . "\0"; 59} 60 61$digest = md5_hex(($password ^ "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\") . 62 md5(($password ^ "6666666666666666666666666666666666666666666666666666666666666666") . $challenge)); 63$resp = encode_base64("$username $digest"); 64print "Send this response:\n$resp\n"; 65