1package Crypt::OICQ; 2 3# $Id: OICQ.pm,v 1.4 2006/01/20 21:31:27 tans Exp $ 4 5# Copyright (c) 2002-2006 Shufeng Tan. All rights reserved. 6# 7# This package is free software and is provided "as is" without express 8# or implied warranty. It may be used, redistributed and/or modified 9# under the terms of the Perl Artistic License (see 10# http://www.perl.com/perl/misc/Artistic.html) 11 12use 5.008; 13use strict; 14use warnings; 15 16our $VERSION = '1.1'; 17 18our @ISA = qw(Exporter); 19our @EXPORT_OK = qw(encrypt decrypt); 20 21sub new { 22 my ($class) = @_; 23 bless {}, $class; 24} 25 26my $TEA_ROUNDS = 0x10; 27my $TEA_DELTA = 0x9E3779B9; 28my $TEA_SUM = 0xE3779B90; 29 30sub tea_decrypt { 31 use integer; 32 my ($c_block, $key) = @_; 33 my ($y, $z) = unpack("NN", $c_block); 34 my ($a, $b, $c, $d) = unpack("NNNN", $key); 35 my $sum = $TEA_SUM; 36 my $n = $TEA_ROUNDS; 37 while ($n-- > 0) { 38 $z -= ($y<<4)+$c ^ $y+$sum ^ (0x07ffffff & ($y>>5))+$d; 39 $y -= ($z<<4)+$a ^ $z+$sum ^ (0x07ffffff & ($z>>5))+$b; 40 $sum -= $TEA_DELTA; 41 } 42 pack("NN", $y, $z); 43} 44 45sub decrypt { 46 my ($self, $crypt, $key) = @_; 47 48 my $crypt_len = length($crypt); 49 if (($crypt_len % 8) || ($crypt_len < 16)) { 50 die "Crypt::OICQ::decrypt error: invalid input length $crypt_len\n"; 51 } 52 53 my $c_buf = substr($crypt, 0, 8); 54 my $p_buf = tea_decrypt($c_buf, $key); 55 my $pad_len = ord(substr($p_buf, 0, 1) & "\007"); 56 my $plain_len = $crypt_len - $pad_len - 10; 57 my $plain = $p_buf; 58 my $pre_plain = $p_buf; 59 my $pre_crypt = $c_buf; 60 61 for (my $i = 8; $i < $crypt_len; $i += 8) { 62 $c_buf = substr($crypt, $i, 8); 63 $p_buf = tea_decrypt($c_buf ^ $pre_plain, $key); 64 $pre_plain = $p_buf; 65 $p_buf ^= $pre_crypt; 66 $plain .= $p_buf; 67 $pre_crypt = $c_buf; 68 } 69 if (substr($plain, -7, 7) ne "\0\0\0\0\0\0\0") { 70 die "Crypt::OICQ::decrypt error: data dumped\n", 71 "crypt: ", unpack("H*", $crypt), "\n", 72 "key: ", unpack("H*", $key), "\n", 73 "plain: ", unpack("H*", $plain), "\n"; 74 } 75 return substr($plain, -7-$plain_len, $plain_len); 76} 77 78sub tea_encrypt { 79 use integer; 80 my ($p_block, $key) = @_; 81 my ($y, $z) = unpack("NN", $p_block); 82 my ($a, $b, $c, $d) = unpack("NNNN", $key); 83 my $sum = 0; 84 my $n = $TEA_ROUNDS; 85 while ($n-- > 0) { 86 $sum += $TEA_DELTA; 87 $y += ($z<<4)+$a ^ $z+$sum ^ (0x07ffffff & ($z>>5))+$b; 88 $z += ($y<<4)+$c ^ $y+$sum ^ (0x07ffffff & ($y>>5))+$d; 89 } 90 pack("NN", $y, $z); 91} 92 93sub encrypt { 94 my ($self, $plain, $key) = @_; 95 my $plain_len = length($plain); 96 my $head_pad_len = ($plain_len + 10) % 8; 97 $head_pad_len = 8 - $head_pad_len if $head_pad_len; 98 my $padded_plain = chr(0xa8 + $head_pad_len) . 99 rand_str(2+$head_pad_len) . 100 #(chr(0xad) x (2 + $head_pad_len)) . 101 $plain . ("\0" x 7); 102 my $padded_plain_len = length($padded_plain); 103 my $crypt = ""; 104 my $pre_plain = "\0" x 8; 105 my $pre_crypt = $pre_plain; 106 for (my $i = 0; $i < $padded_plain_len; $i += 8) { 107 my $p_buf = substr($padded_plain, $i, 8) ^ $pre_crypt; 108 my $c_buf = tea_encrypt($p_buf, $key); 109 $c_buf ^= $pre_plain; 110 $crypt .= $c_buf; 111 $pre_crypt = $c_buf; 112 $pre_plain = $p_buf; 113 } 114 return $crypt; 115} 116 117sub rand_str { 118 my $len = pop; 119 join('', map(pack("C", rand(0xff)), 1..$len)); 120} 121 1221; 123 124__END__ 125 126=head1 NAME 127 128Crypt::OICQ - cryptographic algorithm used by OICQ protocol 129 130=head1 SYNOPSIS 131 132 use Crypt::OICQ; 133 $oicq = new Crypt::OICQ; 134 135=head1 DESCRIPTION 136 137=head2 EXPORT 138 139None by default. 140 141encrypt and decrypt may be exported. 142 143=head1 AUTHOR 144 145Shufeng Tan <lt>perloicq@yahoo.com<gt> 146 147=head1 SEE ALSO 148 149L<perl>. 150 151=cut 152