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