view release on metacpan or  search on metacpan

lib/SMB/Crypt.pm  view on Meta::CPAN

	my $c = permute($key, $des_perm1);
	my $d = [ splice(@$c, 28) ];

	my @ki;
	for my $i (0 .. 15) {
		lshift($c, $des_sc[$i]);
		lshift($d, $des_sc[$i]);

		$ki[$i] = permute([ @$c, @$d ], $des_perm2);
	}

	my $l = permute($arr, $des_perm3);
	my $r = [ splice(@$l, 32) ];

	for my $i (0 .. 15) {
		my $er = permute($r, $des_perm4);

		xor_inplace($er, $ki[$forw ? $i : 15 - $i]);

		my @b;
		for my $j (0 .. 7) {
			$b[$j] = [];
			for my $k (0 .. 5) {
				$b[$j][$k] = $er->[$j * 6 + $k];
			}
		}

		for my $j (0 .. 7) {
			my $m = ($b[$j][0] << 1) | ($b[$j][5] << 0);
			my $n = ($b[$j][1] << 3) | ($b[$j][2] << 2) | ($b[$j][3] << 1) | ($b[$j][4] << 0);

			for my $k (0 .. 3) {
				$b[$j][$k] = $des_sbox[$j][$m][$n] & (1 << (3 - $k)) ? 1 : 0;
			}
		}

		my @cb;
		for my $j (0 .. 7) {
			for my $k (0 .. 3) {
				$cb[$j * 4 + $k] = $b[$j][$k];
			}
		}

		my $pcb = permute(\@cb, $des_perm5);

		xor_inplace($l, $pcb);

		($l, $r) = ($r, $l);
	}

	return permute([ @$r, @$l ], $des_perm6 );
}

sub des_crypt56 ($$;$) {
	my $data = shift // die "No 8-byte data to crypt";
	my $str  = shift // die "No 7-byte key to crypt";
	my $forw = shift // 1;

	if (has_Crypt_DES()) {
		return Crypt::DES->new(des_str_to_key($str))->encrypt($data);
	}

	my $arr = [ map { ord($_) } split '', $data ];
	my $key = [ map { ord($_) } split '', des_str_to_key($str) ];

	my $arrb = [];
	my $keyb = [];
	for my $i (0 .. 63) {
		$arrb->[$i] = $arr->[$i / 8] & (1 << (7 - $i % 8)) ? 1 : 0;
		$keyb->[$i] = $key->[$i / 8] & (1 << (7 - $i % 8)) ? 1 : 0;
	}

	my $outb = des_dohash($arrb, $keyb, $forw);

	my $out = [ (0) x 8 ];
	for my $i (0 .. 63) {
		$out->[$i / 8] |= 1 << (7 - $i % 8)
			if $outb->[$i];
	}

	return join('', map { chr($_) } @$out);
}

# MD4 parts for SMB authentication, ported from samba crypto/md4.c

our @md4_state;

sub md4_F { my ($x, $y, $z) = @_; return ($x & $y) | ((~$x) & $z); }
sub md4_G { my ($x, $y, $z) = @_; return ($x & $y) | ($x & $z) | ($y & $z); }
sub md4_H { my ($x, $y, $z) = @_; return $x ^ $y ^ $z; }

# uint32 arithmetic in perl, hopefully works on all platforms
sub add32 (@) {
	my @sum = (0, 0);
	for (@_) {
		$sum[0] += $_ & 0xFFFF;
		$sum[1] += ($_ >> 16) & 0xFFFF;
	}
	$sum[1] += $sum[0] >> 16;
	$sum[0] &= 0xFFFF;
	$sum[1] &= 0xFFFF;

	return ($sum[1] << 16) + $sum[0];
}

sub lshift32 ($$) {
	my ($num, $count) = @_;

	return (($num << $count) & 0xFFFFFFFF) | ($num >> (32 - $count));
}

sub md4_ROUND1 {
	my ($a, $b, $c, $d, $X, $s) = @_;

	$md4_state[$a] = lshift32(add32($md4_state[$a], md4_F(@md4_state[$b, $c, $d]), $X, 0x00000000), $s);
}

sub md4_ROUND2 {
	my ($a, $b, $c, $d, $X, $s) = @_;

lib/SMB/Crypt.pm  view on Meta::CPAN

	md5_STEP(\&md5_F4, 3, 0, 1, 2, $_[15], 0xfe2ce6e0, 10);
	md5_STEP(\&md5_F4, 2, 3, 0, 1, $_[ 6], 0xa3014314, 15);
	md5_STEP(\&md5_F4, 1, 2, 3, 0, $_[13], 0x4e0811a1, 21);
	md5_STEP(\&md5_F4, 0, 1, 2, 3, $_[ 4], 0xf7537e82,  6);
	md5_STEP(\&md5_F4, 3, 0, 1, 2, $_[11], 0xbd3af235, 10);
	md5_STEP(\&md5_F4, 2, 3, 0, 1, $_[ 2], 0x2ad7d2bb, 15);
	md5_STEP(\&md5_F4, 1, 2, 3, 0, $_[ 9], 0xeb86d391, 21);

	$md5_state[$_] = add32($md5_state[$_], $old_state[$_]) for 0 .. 3;
}

sub md5 ($;$) {
	if (has_Digest_MD5()) {
		return Digest::MD5::md5(join '', @_);
	}

	my $data = md5_pad64(join '', @_);

	@md5_state = ( 0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476 );

	for my $i (0 .. length($data) / 64 - 1) {
		md5_ROUND(unpack 'V16', substr $data, $i * 64, 64);
	}

	pack 'V4', @md5_state;
}

sub hmac_md5 ($$) {
	my ($data, $key) = @_;

	$key = md5($key) if length($key) > 64;

	my $ipad = $key ^ ("\x36" x 64);
	my $opad = $key ^ ("\x5c" x 64);

	return md5($opad, md5($ipad, $data));
}

1;

__END__
# ----------------------------------------------------------------------------

=head1 NAME

SMB::Crypt - Fallback implementations of cryptography algorithms for SMB

=head1 SYNOPSIS

	use SMB::Crypt qw(md4 md5);

	my $digest1 = md4($data);

	my $digest2 = md5($data);

=head1 ABSTRACT

This module provides fallback implementations for DES, MD4 and MD5 in
pure perl to reduce dependence on non-standard perl modules.

However it is recommended to install L<Crypt::DES>, L<Digest::MD4> and
L<Digest::MD5> modules to get improved performance.

=head1 EXPORTED FUNCTIONS

By default, functions B<des_crypt56>, B<md4>, B<md5> and B<hmac_md5> are exported using the standard L<Exporter> mechanism.

=over 4

=item des_crypt56 EIGHT_BYTE_INPUT SEVEN_BYTE_KEY_STR [FORWARD=1]

Returns output of eight bytes that is a permutation of the input according to a key.

If L<Crypt::DES> is found, it is used, otherwise pure perl fallback implemenation is used.

=item md4 DATA

Returns digest of 16 bytes, similar to Digest::MD4::md4.

If L<Digest::MD4> is found, it is used, otherwise pure perl fallback implemenation is used.

=item md5 DATA ...

Returns digest of 16 bytes, similar to Digest::MD5::md5.

If L<Digest::MD5> is found, it is used, otherwise pure perl fallback implemenation is used.

=item hmac_md5 DATA KEY

Returns digest of 16 bytes, similar to Digest::HMAC_MD5::hmac_md5. Uses B<md5> internally.

=back

=head1 AUTHOR

Mikhael Goikhman <migo@cpan.org>

=head1 ACKNOWLEGDEMENTS

Ported from samba project.