521 lines
14 KiB
Perl
521 lines
14 KiB
Perl
# ==================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::MD5
|
|
# Author: Scott Beck (see pod for details)
|
|
# CVS Info : 087,071,086,086,085
|
|
# $Id: MD5.pm,v 1.19 2004/11/17 01:23:30 jagerman Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# See bottom for addition Copyrights.
|
|
# ==================================================================
|
|
#
|
|
# Description: This is an implementation of the MD5 algorithm in perl.
|
|
#
|
|
|
|
package GT::MD5;
|
|
# ==================================================================
|
|
use strict;
|
|
use vars qw($VERSION @ISA @EXPORTER @EXPORT_OK $DATA);
|
|
|
|
@EXPORT_OK = qw(md5 md5_hex md5_base64);
|
|
|
|
@ISA = qw(Exporter);
|
|
$VERSION = sprintf "%d.%03d", q$Revision: 1.19 $ =~ /(\d+)\.(\d+)/;
|
|
|
|
$DATA = <<'END_OF_CODE';
|
|
use integer;
|
|
|
|
# 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 }
|
|
|
|
@GT::MD5::DATA = split "\n", q|
|
|
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 */|;
|
|
|
|
|
|
# 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 = "\n";
|
|
# while(<DATA>) {
|
|
for (@GT::MD5::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 $su = 32 - $3;
|
|
my $sh = (1 << $3) - 1;
|
|
|
|
$c = "$1=(((\$r=$2)<<$3)|((\$r>>$su)&$sh))+$4";
|
|
|
|
#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";
|
|
}
|
|
# close DATA;
|
|
|
|
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();
|
|
|
|
#########################################
|
|
# Private output converter functions:
|
|
sub _encode_hex { unpack 'H*', $_[0] }
|
|
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
|
|
}
|
|
|
|
#########################################
|
|
# OOP interface:
|
|
sub new {
|
|
my $proto = shift;
|
|
my $class = ref $proto || $proto;
|
|
my $self = {};
|
|
bless $self, $class;
|
|
$self->reset();
|
|
$self
|
|
}
|
|
|
|
sub reset {
|
|
my $self = shift;
|
|
delete $self->{_data};
|
|
$self->{_state} = [A,B,C,D];
|
|
$self->{_length} = 0;
|
|
$self
|
|
}
|
|
|
|
sub add {
|
|
my $self = shift;
|
|
$self->{_data} .= join '', @_ if @_;
|
|
my ($i,$c);
|
|
for $i (0 .. (length $self->{_data})/64-1) {
|
|
my @X = unpack 'V16', substr $self->{_data}, $i*64, 64;
|
|
@{$self->{_state}} = round(@{$self->{_state}},@X);
|
|
++$c;
|
|
}
|
|
if ($c) {
|
|
substr ($self->{_data}, 0, $c*64) = '';
|
|
$self->{_length} += $c*64;
|
|
}
|
|
$self
|
|
}
|
|
|
|
sub finalize {
|
|
my $self = shift;
|
|
$self->{_data} .= chr(128);
|
|
my $l = $self->{_length} + length $self->{_data};
|
|
$self->{_data} .= "\0" x (($l%64<=56?56:120)-$l%64);
|
|
$l = ($l-1)*8;
|
|
$self->{_data} .= pack 'VV', $l & MAX , ($l >> 16 >> 16);
|
|
$self->add();
|
|
$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>};
|
|
my $read = 0;
|
|
my $buffer = '';
|
|
$self->add($buffer) while $read = read $fh, $buffer, 8192;
|
|
die "GT::MD5 read failed: $!" unless defined $read;
|
|
$self
|
|
}
|
|
|
|
sub add_bits {
|
|
my $self = shift;
|
|
return $self->add( pack 'B*', shift ) if @_ == 1;
|
|
my ($b,$n) = @_;
|
|
die "GT::MD5 Invalid number of bits\n" if $n%8;
|
|
$self->add( substr $b, 0, $n/8 )
|
|
}
|
|
|
|
sub digest {
|
|
my $self = shift;
|
|
$self->finalize();
|
|
my $res = pack 'V4', @{$self->{_state}};
|
|
$self->reset();
|
|
$res
|
|
}
|
|
|
|
sub hexdigest {
|
|
_encode_hex($_[0]->digest)
|
|
}
|
|
|
|
sub b64digest {
|
|
_encode_base64($_[0]->digest)
|
|
}
|
|
|
|
sub clone {
|
|
my $self = shift;
|
|
my $clone = {
|
|
_state => [@{$self->{_state}}],
|
|
_length => $self->{_length},
|
|
_data => $self->{_data}
|
|
};
|
|
bless $clone, ref $self || $self;
|
|
}
|
|
|
|
#########################################
|
|
# Procedural interface:
|
|
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 { _encode_hex &md5 }
|
|
sub md5_base64 { _encode_base64 &md5 }
|
|
END_OF_CODE
|
|
|
|
# Load either Digest::MD5 or GT::MD5 functions.
|
|
eval {
|
|
local $SIG{__DIE__};
|
|
require Digest::MD5;
|
|
foreach (@EXPORT_OK) { delete $GT::MD5::{$_}; } # Do not remove.
|
|
import Digest::MD5 (@EXPORT_OK);
|
|
*GT::MD5::md5_hex = sub { &Digest::MD5::md5_hex };
|
|
*GT::MD5::md5 = sub { &Digest::MD5::md5 };
|
|
*GT::MD5::md5_base64 = sub { &Digest::MD5::md5_base64 };
|
|
@ISA = 'Digest::MD5';
|
|
1;
|
|
}
|
|
or do {
|
|
local $@;
|
|
eval $DATA;
|
|
$@ and die "GT::MD5 => can't compile: $@";
|
|
};
|
|
|
|
require Exporter;
|
|
import Exporter;
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
GT::MD5 - Perl implementation of Ron Rivests MD5 Algorithm
|
|
|
|
=head1 DISCLAIMER
|
|
|
|
Majority of this module's code is borrowed from Digest::Perl::MD5 (Version 1.8).
|
|
|
|
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";
|
|
|
|
The digest methods are destructive. That means you can only call them
|
|
once and the $md5 objects is reset after use. You can make a copy with clone:
|
|
|
|
$md5->clone->hexdigest
|
|
|
|
=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 100 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. But You should
|
|
use C<Digest::MD5> for those amounts of data anyway.
|
|
|
|
=back
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<Digest::MD5>
|
|
|
|
L<md5(1)>
|
|
|
|
RFC 1321
|
|
|
|
tools/md5: a small BSD compatible md5 tool written in pure perl.
|
|
|
|
=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-1992, 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
|
|
(<N.Winton (at) axion.bt.co.uk>).
|
|
|
|
C<Digest::MD5> was made by Gisle Aas <gisle (at) 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 (at) lackas.net>.
|
|
|
|
=cut
|