1package Crypt::Imail; 2 3use 5.008; 4use strict; 5use warnings; 6 7our $VERSION = '0.01'; 8 9sub new { bless {}, ref($_[0]) || $_[0] } 10 11sub decrypt { 12 my $self = shift; 13 my ($user, $epass) = @_; 14 15 my @user = map ord($_), split //, $user; 16 17 my @key = map $user[0] - $_, @user; 18 @key = map @key, (0..20); 19 20 my @epass = ($epass =~ /(..)/g); 21 22 my %data = $self->_data('decrypt'); 23 24 my @pass; 25 { 26 my $counter = 0; 27 @pass = map $data{$_} + $key[$counter++], @epass; 28 } 29 30join '', map chr($_ - ($user[0] - 97)), @pass; 31} 32 33sub encrypt { 34 my $self = shift; 35 my ($user, $pass) = @_; 36 37 my @auser = map ord($_), split //, $user; 38 my @apass = map ord($_), split //, $pass; 39 40 my @key = map $auser[0] - $_, @auser; 41 @key = map @key, (0 .. 12); # hack - be sure it's large enough 42 43 my $offset = $auser[0] - 97; 44 my @epass = map {($apass[$_] + $offset) - $key[$_]} (0..$#apass); 45 46 my %data = $self->_data('encrypt'); 47 48join '', map $data{$_}, @epass; 49} 50 51sub _data { 52 my $self = shift; 53 54 my $count = -97; 55 my @nums = (0..9,'A'..'F'); 56 57 my %hash; 58 for my $base (@nums) { 59 for (@nums) { 60 if ($_[0] eq 'decrypt') { 61 $hash{$base.$_} = $count++; 62 }elsif ($_[0] eq 'encrypt') { 63 $hash{$count++} = $base.$_; 64 }else{ 65 warn "pass either encrypt or decrypt to the data function"; 66 } 67 } 68 } 69 70%hash; 71} 72 731; 74__END__ 75 76=head1 NAME 77 78Crypt::Imail - encrypt and decrypt IMail passwords 79 80=head1 SYNOPSIS 81 82 use Crypt::Imail; 83 84 $im = Crypt::Imail->new(); 85 86 my $encrypted_pass = $im->encrypt($user, $password); 87 88 my $password = $im->decrypt($user, $encrypted_pass); 89 90 91=head1 ABSTRACT 92 93Used to Encrypt and Decrypt passwords generated by imail. 94 95=head1 DESCRIPTION 96 97This package is used to encrypt and decrypt passwords generated by IMail. 98 99See: http://www.ipswitch.com/products/imail_server/ 100 101This came about because I kept reading newsgroup posts about how horrible 102IMails encryption scheme was. Then one day I get a call that a friend needs 103to move all the email accounts from and NT box running imail to linux and 104wants to have as little disruption as possible to everyone's services. So 105I wrote this object for him. I hope two things come out of it. First, 106I hope this proves helpful to others. Secondly, I hope it doesn't because 107Imail got their act together and fixed their "encryption" scheme. 108 109=head2 EXPORT 110 111None by default. 112 113=head1 SEE ALSO 114 115perl(1); 116 117=head1 AUTHOR 118 119Stephen D. Wells, E<lt>wells@cedarnet.orgE<gt> 120 121=head1 COPYRIGHT AND LICENSE 122 123Copyright 2003 by Stephen D. Wells. All rights reserved. 124 125This library is free software; you can redistribute it and/or modify 126it under the same terms as Perl itself. 127 128=cut 129