Tadashi Okoshi
slash****@users*****
2005年 10月 25日 (火) 04:20:49 JST
Index: affelio_farm/admin/skelton/affelio/extlib/Digest/Perl/MD5.pm diff -u affelio_farm/admin/skelton/affelio/extlib/Digest/Perl/MD5.pm:1.1.1.1 affelio_farm/admin/skelton/affelio/extlib/Digest/Perl/MD5.pm:removed --- affelio_farm/admin/skelton/affelio/extlib/Digest/Perl/MD5.pm:1.1.1.1 Tue Oct 25 04:14:40 2005 +++ affelio_farm/admin/skelton/affelio/extlib/Digest/Perl/MD5.pm Tue Oct 25 04:20:49 2005 @@ -1,421 +0,0 @@ -#!/usr/local/bin/perl -w -#$Id: MD5.pm,v 1.1.1.1 2005/10/24 19:14:40 slash5234 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]); - #my $right = $_[0] >> (32 - $_[1]); - #my $rmask = (1 << $_[1]) - 1; - ($_[0] << $_[1]) | (( $_[0] >> (32 - $_[1]) ) & ((1 << $_[1]) - 1)); - #$_[0] << $_[1] | (($_[0]>> (32 - $_[1])) & (1 << (32 - $_[1])) - 1); -} - -sub gen_code { - # Discard upper 32 bits on 64 bit archs. - my $MSK = ((1 << 16) << 16) ? ' & ' . MAX : ''; -# FF => "X0=rotate_left(((X1&X2)|(~X1&X3))+X0+X4+X6$MSK,X5)+X1$MSK;", -# GG => "X0=rotate_left(((X1&X3)|(X2&(~X3)))+X0+X4+X6$MSK,X5)+X1$MSK;", - 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;", - ); - #unless ( (1 << 16) << 16) { %f = %{$CODES{'32bit'}} } - #else { %f = %{$CODES{'64bit'}} } - - 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\((.*),(.*)\)\+(.*)$//; - - #my $rotate = "(($2 << $3) || (($2 >> (32 - $3)) & (1 << $2) - 1)))"; - $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; - #print "$dump\n"; - #exit 0; -} - -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.Win****@axion*****>). - -C<Digest::MD5> was made by Gisle Aas <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 <delta****@clack*****>. - -=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 */
