--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/releasing/cbrtools/perl/Digest/Perl/MD5.pm Fri Jun 25 18:37:20 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(<DATA>) {
+ 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<not> an interface (like C<Digest::MD5>) 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<Digest::MD5> instead of this module if it is available.
+This module is only usefull for
+
+=over 4
+
+=item
+
+computers where you cannot install C<Digest::MD5> (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<Digest::MD5>. 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<Digest::MD5> module is available it is used and if not you take
+C<Digest::Perl::MD5>.
+
+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<Digest::MD5> 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<Digest::MD5>
+for those amounts of data.
+
+=item
+
+C<Digest::Perl::MD5> loads all data to encrypt into memory. This is a todo.
+
+=back
+
+=head1 SEE ALSO
+
+L<Digest::MD5>
+
+L<md5sum(1)>
+
+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<N.Winton@axion.bt.co.uk>).
+
+C<Digest::MD5> was made by Gisle Aas <gisle@aas.no> (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 <delta@clackas.de>.
+
+=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 */