diff -r 22486c9c7b15 -r 378360dbbdba releasing/cbrtools/perl/Digest/Perl/MD5.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/releasing/cbrtools/perl/Digest/Perl/MD5.pm Wed Jun 30 11:35:58 2010 +0800 @@ -0,0 +1,418 @@ +# This library is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +# Copyright 2000 Christian Lackas, Imperia Software Solutions +# Copyright 1998-1999 Gisle Aas. +# Copyright 1995-1996 Neil Winton. +# Copyright 1991-1992 RSA Data Security, Inc. + +#!/usr/local/bin/perl -w +#$Id: MD5.pm,v 1.16 2000/09/19 22:19:31 lackas Exp $ + +package Digest::Perl::MD5; +use strict; +use integer; +use Exporter; +use vars qw($VERSION @ISA @EXPORTER @EXPORT_OK); + +@EXPORT_OK = qw(md5 md5_hex md5_base64); + +@ISA = 'Exporter'; +$VERSION = '1.5'; + +# I-Vektor +sub A() { 0x67_45_23_01 } +sub B() { 0xef_cd_ab_89 } +sub C() { 0x98_ba_dc_fe } +sub D() { 0x10_32_54_76 } + +# for internal use +sub MAX() { 0xFFFFFFFF } + +# padd a message to a multiple of 64 +sub padding($) { + my $l = length (my $msg = shift() . chr(128)); + $msg .= "\0" x (($l%64<=56?56:120)-$l%64); + $l = ($l-1)*8; + $msg .= pack 'VV', $l & MAX , ($l >> 16 >> 16); +} + + +sub rotate_left($$) { + ($_[0] << $_[1]) | (( $_[0] >> (32 - $_[1]) ) & ((1 << $_[1]) - 1)); +} + +sub gen_code { + # Discard upper 32 bits on 64 bit archs. + my $MSK = ((1 << 16) << 16) ? ' & ' . MAX : ''; + my %f = ( + FF => "X0=rotate_left((X3^(X1&(X2^X3)))+X0+X4+X6$MSK,X5)+X1$MSK;", + GG => "X0=rotate_left((X2^(X3&(X1^X2)))+X0+X4+X6$MSK,X5)+X1$MSK;", + HH => "X0=rotate_left((X1^X2^X3)+X0+X4+X6$MSK,X5)+X1$MSK;", + II => "X0=rotate_left((X2^(X1|(~X3)))+X0+X4+X6$MSK,X5)+X1$MSK;", + ); + + my %s = ( # shift lengths + S11 => 7, S12 => 12, S13 => 17, S14 => 22, S21 => 5, S22 => 9, S23 => 14, + S24 => 20, S31 => 4, S32 => 11, S33 => 16, S34 => 23, S41 => 6, S42 => 10, + S43 => 15, S44 => 21 + ); + + my $insert = ""; + while() { + chomp; + next unless /^[FGHI]/; + my ($func,@x) = split /,/; + my $c = $f{$func}; + $c =~ s/X(\d)/$x[$1]/g; + $c =~ s/(S\d{2})/$s{$1}/; + $c =~ s/^(.*)=rotate_left\((.*),(.*)\)\+(.*)$//; + + $c = "\$r = $2; + $1 = ((\$r << $3) | ((\$r >> (32 - $3)) & ((1 << $3) - 1))) + $4"; + $insert .= "\t$c\n"; + } + + my $dump = ' + sub round { + my ($a,$b,$c,$d) = @_[0 .. 3]; + my $r; + + ' . $insert . ' + $_[0]+$a' . $MSK . ', $_[1]+$b ' . $MSK . + ', $_[2]+$c' . $MSK . ', $_[3]+$d' . $MSK . '; + }'; + eval $dump; +} + +gen_code(); + + +# object part of this module +sub new { + my $class = shift; + bless {}, ref($class) || $class; +} + +sub reset { + my $self = shift; + delete $self->{data}; + $self +} + +sub add(@) { + my $self = shift; + $self->{data} .= join'', @_; + $self +} + +sub addfile { + my ($self,$fh) = @_; + if (!ref($fh) && ref(\$fh) ne "GLOB") { + require Symbol; + $fh = Symbol::qualify($fh, scalar caller); + } + $self->{data} .= do{local$/;<$fh>}; + $self +} + +sub digest { + md5(shift->{data}) +} + +sub hexdigest { + md5_hex(shift->{data}) +} + +sub b64digest { + md5_base64(shift->{data}) +} + +sub md5(@) { + my $message = padding(join'',@_); + my ($a,$b,$c,$d) = (A,B,C,D); + my $i; + for $i (0 .. (length $message)/64-1) { + my @X = unpack 'V16', substr $message,$i*64,64; + ($a,$b,$c,$d) = round($a,$b,$c,$d,@X); + } + pack 'V4',$a,$b,$c,$d; +} + + +sub md5_hex(@) { + unpack 'H*', &md5; +} + +sub md5_base64(@) { + encode_base64(&md5); +} + + +sub encode_base64 ($) { + my $res; + while ($_[0] =~ /(.{1,45})/gs) { + $res .= substr pack('u', $1), 1; + chop $res; + } + $res =~ tr|` -_|AA-Za-z0-9+/|;#` + chop $res;chop $res; + $res; +} + +1; + +=head1 NAME + +Digest::MD5::Perl - Perl implementation of Ron Rivests MD5 Algorithm + +=head1 DISCLAIMER + +This is B an interface (like C) but a Perl implementation of MD5. +It is written in perl only and because of this it is slow but it works without C-Code. +You should use C instead of this module if it is available. +This module is only usefull for + +=over 4 + +=item + +computers where you cannot install C (e.g. lack of a C-Compiler) + +=item + +encrypting only small amounts of data (less than one million bytes). I use it to +hash passwords. + +=item + +educational purposes + +=back + +=head1 SYNOPSIS + + # Functional style + use Digest::MD5 qw(md5 md5_hex md5_base64); + + $hash = md5 $data; + $hash = md5_hex $data; + $hash = md5_base64 $data; + + + # OO style + use Digest::MD5; + + $ctx = Digest::MD5->new; + + $ctx->add($data); + $ctx->addfile(*FILE); + + $digest = $ctx->digest; + $digest = $ctx->hexdigest; + $digest = $ctx->b64digest; + +=head1 DESCRIPTION + +This modules has the same interface as the much faster C. So you can +easily exchange them, e.g. + + BEGIN { + eval { + require Digest::MD5; + import Digest::MD5 'md5_hex' + }; + if ($@) { # ups, no Digest::MD5 + require Digest::Perl::MD5; + import Digest::Perl::MD5 'md5_hex' + } + } + +If the C module is available it is used and if not you take +C. + +You can also install the Perl part of Digest::MD5 together with Digest::Perl::MD5 +and use Digest::MD5 as normal, it falls back to Digest::Perl::MD5 if it +cannot load its object files. + +For a detailed Documentation see the C module. + +=head1 EXAMPLES + +The simplest way to use this library is to import the md5_hex() +function (or one of its cousins): + + use Digest::Perl::MD5 'md5_hex'; + print 'Digest is ', md5_hex('foobarbaz'), "\n"; + +The above example would print out the message + + Digest is 6df23dc03f9b54cc38a0fc1483df6e21 + +provided that the implementation is working correctly. The same +checksum can also be calculated in OO style: + + use Digest::MD5; + + $md5 = Digest::MD5->new; + $md5->add('foo', 'bar'); + $md5->add('baz'); + $digest = $md5->hexdigest; + + print "Digest is $digest\n"; + +=head1 LIMITATIONS + +This implementation of the MD5 algorithm has some limitations: + +=over 4 + +=item + +It's slow, very slow. I've done my very best but Digest::MD5 is still about 135 times faster. +You can only encrypt Data up to one million bytes in an acceptable time. But it's very usefull +for encrypting small amounts of data like passwords. + +=item + +You can only encrypt up to 2^32 bits = 512 MB on 32bit archs. You should use C +for those amounts of data. + +=item + +C loads all data to encrypt into memory. This is a todo. + +=back + +=head1 SEE ALSO + +L + +L + +RFC 1321 + +=head1 COPYRIGHT + +This library is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + + Copyright 2000 Christian Lackas, Imperia Software Solutions + Copyright 1998-1999 Gisle Aas. + Copyright 1995-1996 Neil Winton. + Copyright 1991-1992 RSA Data Security, Inc. + +The MD5 algorithm is defined in RFC 1321. The basic C code +implementing the algorithm is derived from that in the RFC and is +covered by the following copyright: + +=over 4 + +=item + +Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All +rights reserved. + +License to copy and use this software is granted provided that it +is identified as the "RSA Data Security, Inc. MD5 Message-Digest +Algorithm" in all material mentioning or referencing this software +or this function. + +License is also granted to make and use derivative works provided +that such works are identified as "derived from the RSA Data +Security, Inc. MD5 Message-Digest Algorithm" in all material +mentioning or referencing the derived work. + +RSA Data Security, Inc. makes no representations concerning either +the merchantability of this software or the suitability of this +software for any particular purpose. It is provided "as is" +without express or implied warranty of any kind. + +These notices must be retained in any copies of any part of this +documentation and/or software. + +=back + +This copyright does not prohibit distribution of any version of Perl +containing this extension under the terms of the GNU or Artistic +licenses. + +=head1 AUTHORS + +The original MD5 interface was written by Neil Winton +(C). + +C was made by Gisle Aas (I took his Interface +and part of the documentation) + +Thanks to Guido Flohr for his 'use integer'-hint. + +This release was made by Christian Lackas . + +=cut + +__DATA__ +FF,$a,$b,$c,$d,$_[4],7,0xd76aa478,/* 1 */ +FF,$d,$a,$b,$c,$_[5],12,0xe8c7b756,/* 2 */ +FF,$c,$d,$a,$b,$_[6],17,0x242070db,/* 3 */ +FF,$b,$c,$d,$a,$_[7],22,0xc1bdceee,/* 4 */ +FF,$a,$b,$c,$d,$_[8],7,0xf57c0faf,/* 5 */ +FF,$d,$a,$b,$c,$_[9],12,0x4787c62a,/* 6 */ +FF,$c,$d,$a,$b,$_[10],17,0xa8304613,/* 7 */ +FF,$b,$c,$d,$a,$_[11],22,0xfd469501,/* 8 */ +FF,$a,$b,$c,$d,$_[12],7,0x698098d8,/* 9 */ +FF,$d,$a,$b,$c,$_[13],12,0x8b44f7af,/* 10 */ +FF,$c,$d,$a,$b,$_[14],17,0xffff5bb1,/* 11 */ +FF,$b,$c,$d,$a,$_[15],22,0x895cd7be,/* 12 */ +FF,$a,$b,$c,$d,$_[16],7,0x6b901122,/* 13 */ +FF,$d,$a,$b,$c,$_[17],12,0xfd987193,/* 14 */ +FF,$c,$d,$a,$b,$_[18],17,0xa679438e,/* 15 */ +FF,$b,$c,$d,$a,$_[19],22,0x49b40821,/* 16 */ +GG,$a,$b,$c,$d,$_[5],5,0xf61e2562,/* 17 */ +GG,$d,$a,$b,$c,$_[10],9,0xc040b340,/* 18 */ +GG,$c,$d,$a,$b,$_[15],14,0x265e5a51,/* 19 */ +GG,$b,$c,$d,$a,$_[4],20,0xe9b6c7aa,/* 20 */ +GG,$a,$b,$c,$d,$_[9],5,0xd62f105d,/* 21 */ +GG,$d,$a,$b,$c,$_[14],9,0x2441453,/* 22 */ +GG,$c,$d,$a,$b,$_[19],14,0xd8a1e681,/* 23 */ +GG,$b,$c,$d,$a,$_[8],20,0xe7d3fbc8,/* 24 */ +GG,$a,$b,$c,$d,$_[13],5,0x21e1cde6,/* 25 */ +GG,$d,$a,$b,$c,$_[18],9,0xc33707d6,/* 26 */ +GG,$c,$d,$a,$b,$_[7],14,0xf4d50d87,/* 27 */ +GG,$b,$c,$d,$a,$_[12],20,0x455a14ed,/* 28 */ +GG,$a,$b,$c,$d,$_[17],5,0xa9e3e905,/* 29 */ +GG,$d,$a,$b,$c,$_[6],9,0xfcefa3f8,/* 30 */ +GG,$c,$d,$a,$b,$_[11],14,0x676f02d9,/* 31 */ +GG,$b,$c,$d,$a,$_[16],20,0x8d2a4c8a,/* 32 */ +HH,$a,$b,$c,$d,$_[9],4,0xfffa3942,/* 33 */ +HH,$d,$a,$b,$c,$_[12],11,0x8771f681,/* 34 */ +HH,$c,$d,$a,$b,$_[15],16,0x6d9d6122,/* 35 */ +HH,$b,$c,$d,$a,$_[18],23,0xfde5380c,/* 36 */ +HH,$a,$b,$c,$d,$_[5],4,0xa4beea44,/* 37 */ +HH,$d,$a,$b,$c,$_[8],11,0x4bdecfa9,/* 38 */ +HH,$c,$d,$a,$b,$_[11],16,0xf6bb4b60,/* 39 */ +HH,$b,$c,$d,$a,$_[14],23,0xbebfbc70,/* 40 */ +HH,$a,$b,$c,$d,$_[17],4,0x289b7ec6,/* 41 */ +HH,$d,$a,$b,$c,$_[4],11,0xeaa127fa,/* 42 */ +HH,$c,$d,$a,$b,$_[7],16,0xd4ef3085,/* 43 */ +HH,$b,$c,$d,$a,$_[10],23,0x4881d05,/* 44 */ +HH,$a,$b,$c,$d,$_[13],4,0xd9d4d039,/* 45 */ +HH,$d,$a,$b,$c,$_[16],11,0xe6db99e5,/* 46 */ +HH,$c,$d,$a,$b,$_[19],16,0x1fa27cf8,/* 47 */ +HH,$b,$c,$d,$a,$_[6],23,0xc4ac5665,/* 48 */ +II,$a,$b,$c,$d,$_[4],6,0xf4292244,/* 49 */ +II,$d,$a,$b,$c,$_[11],10,0x432aff97,/* 50 */ +II,$c,$d,$a,$b,$_[18],15,0xab9423a7,/* 51 */ +II,$b,$c,$d,$a,$_[9],21,0xfc93a039,/* 52 */ +II,$a,$b,$c,$d,$_[16],6,0x655b59c3,/* 53 */ +II,$d,$a,$b,$c,$_[7],10,0x8f0ccc92,/* 54 */ +II,$c,$d,$a,$b,$_[14],15,0xffeff47d,/* 55 */ +II,$b,$c,$d,$a,$_[5],21,0x85845dd1,/* 56 */ +II,$a,$b,$c,$d,$_[12],6,0x6fa87e4f,/* 57 */ +II,$d,$a,$b,$c,$_[19],10,0xfe2ce6e0,/* 58 */ +II,$c,$d,$a,$b,$_[10],15,0xa3014314,/* 59 */ +II,$b,$c,$d,$a,$_[17],21,0x4e0811a1,/* 60 */ +II,$a,$b,$c,$d,$_[8],6,0xf7537e82,/* 61 */ +II,$d,$a,$b,$c,$_[15],10,0xbd3af235,/* 62 */ +II,$c,$d,$a,$b,$_[6],15,0x2ad7d2bb,/* 63 */ +II,$b,$c,$d,$a,$_[13],21,0xeb86d391,/* 64 */