view release on metacpan or  search on metacpan

SmbHash.pm  view on Meta::CPAN

use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
@ISA = qw(Exporter);
$VERSION = '0.12';
@EXPORT = qw( ntlmgen );

# The mdfour function is available for exporting if they really want
# it =)
@EXPORT_OK = qw( lmhash nthash ntlmgen mdfour smbhash E_P24 E_P21 SMBNTencrypt );

# Works out if local system has Digest::MD4 and Encode
my $HaveDigestMD4;
my $HaveUnicode;
BEGIN {
	$HaveDigestMD4 = 0;
	$HaveUnicode = 0;
	if ( eval "require 'Digest/MD4.pm';" ) {
		$HaveDigestMD4 = 1;
	}
	if (eval "require Encode;") {
		import Encode;
		$HaveUnicode = 1;
	}
}


# lmhash PASSWORD
# Generates lanman password hash for a given password, returns the hash
#
# Extracted and ported from SAMBA/source/libsmb/smbencrypt.c:nt_lm_owf_gen
sub lmhash($;$) {
	my ( $pass, $pwenc ) = @_;
	my ( @p16 );

	$pass = "" unless defined($pass);
	$pass = uc($pass);
	if (!$HaveUnicode) {
		if (defined($pwenc)) {
			croak "Encode module not found: no encoding support";
		}
	}
	else {
		$pwenc = "iso-8859-1" unless defined($pwenc);
		$pass = encode($pwenc,$pass);
	}

	$pass = substr($pass,0,14);
	@p16 = E_P16($pass);
	return join("", map {sprintf("%02X",$_);} @p16);
}

# nthash PASSWORD
# Generates nt md4 password hash for a given password, returns the hash
#
# Extracted and ported from SAMBA/source/libsmb/smbencrypt.c:nt_lm_owf_gen
sub nthash($) {
	my ( $pass ) = @_;
	my ( $hex );
	my ( $digest );
	$pass = substr(defined($pass)?$pass:"",0,128);
	if (!$HaveUnicode) {
		# No unicode support: do a really broken to ucs2 convert
		$pass =~ s/(.)/$1\000/sg;
	}
	else {
		$pass = encode('ucs2', $pass);
		$pass = pack("v*", unpack("n*",$pass));
	}
	$hex = "";
	if ( $HaveDigestMD4 ) {
		eval {
			$digest = new Digest::MD4;
			$digest->reset();
			$digest->add($pass);
			$hex = $digest->hexdigest();
			$hex =~ tr/a-z/A-Z/;
		};
		$HaveDigestMD4 = 0 unless ( $hex );
	}
	$hex = sprintf("%02X"x16,mdfour($pass)) unless ( $hex );
	return $hex;
}

# ntlmgen PASSWORD, LMHASH, NTHASH
# Generate lanman and nt md4 password hash for given password, and assigns
# values to arguments. Combined function of lmhash and nthash
sub ntlmgen {
	my ( $nthash, $lmhash );
	$nthash = nthash($_[0]);
	$lmhash = lmhash($_[0]);
	if ( $#_ == 2 ) {
		$_[1] = $lmhash;
		$_[2] = $nthash;
	}
	return ( $lmhash, $nthash );
}

# Support functions
# Ported from SAMBA/source/lib/md4.c:F,G and H respectfully
sub F { my ( $X, $Y, $Z ) = @_; return ($X&$Y) | ((~$X)&$Z); }
sub G { my ( $X, $Y, $Z) = @_; return ($X&$Y) | ($X&$Z) | ($Y&$Z); }
sub H { my ($X, $Y, $Z) = @_; return $X^$Y^$Z; }

# Needed? because perl seems to choke on overflowing when doing bitwise
# operations on numbers larger than 32 bits. Well, it did on my machine =)
sub add32 {
	my ( @v ) = @_;
	my ( $ret, @sum );
	foreach ( @v ) {
		$_ = [ ($_&0xffff0000)>>16, ($_&0xffff) ];
	}
	@sum = ();
	foreach ( @v ) {
		$sum[0] += $_->[0];
		$sum[1] += $_->[1];
	}
	$sum[0] += ($sum[1]&0xffff0000)>>16;
	$sum[1] &= 0xffff;
	$sum[0] &= 0xffff;
	$ret = ($sum[0]<<16) | $sum[1];
	return $ret;
}