adssearch.pl

samba-3.0.22.tar.gz 编译smb服务器的源码

	return "";
}

sub get_samba_info {

	if (! -x $testparm) { return -1; }
	
	my $tmp;
	open(TESTPARM, "$testparm -s -v 2> /dev/null |");
	while (my $line = <TESTPARM>) {
		chomp($line);
		if ($line =~ /netbios name/) {
			($tmp, $machine) = split(/=/, $line);
			$machine =~ s/\s+|\t+//g;
		}
		if ($line =~ /realm/) {
			($tmp, $realm) = split(/=/, $line);
			$realm =~ s/\s+|\t+//g;
		}
		if ($line =~ /workgroup/) {
			($tmp, $workgroup) = split(/=/, $line);
			$workgroup =~ s/\s+|\t+//g;
		}
	}
	close(TESTPARM);
	return 0;
}

sub gen_upn {
	my $machine = shift;
	my $realm = shift;
	if ($machine && $realm) {
		return sprintf("%s\@%s", lc($machine), uc($realm));
	};
	return undef;
}

sub get_password {
	if (!$password && $opt_simpleauth && check_ticket($user)) {
		return prompt_password($user);
	}
	return "";
}

sub get_user {
	my $user = shift || prompt_user();
	return $user;
}

sub get_machine_password {

	my $workgroup = shift || "";
	$workgroup = uc($workgroup);

	my ($found, $tmp);
	-x $tdbdump || die "tdbdump is not installed. cannot proceed autodetection\n";
	-r $secrets_tdb || die "cannot read $secrets_tdb. cannot proceed autodetection\n";

	# get machine-password
	my $key = sprintf("SECRETS/MACHINE_PASSWORD/%s", $workgroup);
	open(SECRETS,"$tdbdump $secrets_tdb |");
	while(my $line = <SECRETS>) {
		chomp($line);
		if ($found) {
			$line =~ s/\\00//;
			($line,$password) = split(/"/, $line);
			last;
		}
		if ($line =~ /$key/) {
			$found = 1;
		}
	}
	close(SECRETS);

	if ($found) {
		print "Successfully autodetected machine password for workgroup: $workgroup\n";
		return $password;
	} else {
		warn "No machine password available for $workgroup\n";
	}
	return "";
}

sub prompt_password {

	my $acct = shift || "";
	if ($acct =~ /\%/) {
		($acct, $password) = split(/\%/, $acct);
		return $password;
	}
	system "stty -echo";
	print "Enter password for $acct:";
	my $password = <STDIN>;
	chomp($password);
	print "\n";
	system "stty echo";
	return $password;
}

sub prompt_user {

	print "Enter Username:";
	my $user = <STDIN>;
	chomp($user);
	print "\n";
	return $user;
}

sub check_ticket {
	return 0;
	# works only for heimdal
	return system("$klist -t");
}

sub get_ticket {

	my $KRB5_CONFIG = "/tmp/.krb5.conf.telads-$<";

	open(KRB5CONF, "> $KRB5_CONFIG") || die "cannot write $KRB5_CONFIG";
	printf  KRB5CONF "# autogenerated by $0\n";
	printf  KRB5CONF "[libdefaults]\n\tdefault_realm = %s\n\tclockskew = %d\n", uc($realm), 60*60;
	printf  KRB5CONF "[realms]\n\t%s = {\n\t\tkdc = %s\n\t}\n", uc($realm), $server;
	close(KRB5CONF);

	if ( system("KRB5_CONFIG=$KRB5_CONFIG $kinit $user") != 0) {
		return -1;
	}

	return 0;
}

sub check_user {
	my $acct = shift || "";
	if ($acct =~ /\%/) {
		($acct, $password) = split(/\%/, $acct);
	}
	return $acct;
}

sub check_ctrls ($$@) {

	# bogus function??
	my $server = shift || "";
	$dse = shift || get_dse($server) || return -1;
	my @ctrls = @_;

	my $dse_controls = $dse->get_value('supportedControl', asref => '1');
	my @dse_controls = @$dse_controls;

	foreach my $i (@ctrls) {
		# we could use -> supported_control but this 
		# is only available in newer versions of perl-ldap
#		if ( ! $dse->supported_control( $i ) ) {
		if ( grep(/$i->type()/, @dse_controls) ) { 
			printf("required control: %s is not supported by ADS-server.\n", $i->type());
			return -1;
		}
	}
	return 0;
}

sub get_base_from_rootdse {

	my $server = shift || "";
	$dse = shift || get_dse($server,$async_ldap_hd) || return -1;
	return $dse->get_value('defaultNamingContext');
}

sub get_realm_from_rootdse {

	my $server = shift || "";
	$dse = shift || get_dse($server,$async_ldap_hd) || return -1;
	my $service = $dse->get_value('ldapServiceName') || "";
	if ($service) {
		my ($t,$realm) = split(/\@/, $service);
		return $realm;
	} else {
		die "very odd: could not get realm";
	}
}

sub get_sasl_mechs_from_rootdse {

	my $server = shift || "";
	$dse = shift || get_dse($server,$async_ldap_hd) || return -1;
	my $mechs = $dse->get_value('supportedSASLMechanisms', asref => 1);
	return @$mechs;
}

sub get_dse {

	my $server = shift || return undef;
	$async_ldap_hd = shift || get_ldap_hd($server,1);
	if (!$async_ldap_hd) {
		print "oh, no connection\n";
		return undef;
	}
	my $mesg = $async_ldap_hd->bind() || die "cannot bind\n";
	if ($mesg->code) { die "failed to bind\n"; };
	my $dse = $async_ldap_hd->root_dse( attrs => ['*', "supportedExtension", "supportedFeatures" ] );

	return $dse;
}

sub process_servername {

	my $name = shift || return "";
	if ($name =~ /^ldaps:\/\//i ) {
		$name =~ s#^ldaps://##i;
		$uri = sprintf("%s://%s", "ldaps", $name);
	} else {
		$name =~ s#^ldap://##i;
		$uri = sprintf("%s://%s", "ldap", $name);
	}
	return $name;
}

sub get_ldap_hd {

	my $server = shift || return undef;
	my $async = shift || "0";
	my $hd;
	die "uri unavailable" if (!$uri);
	if ($uri =~ /^ldaps:\/\//i ) {
		$port = $port || 636;
		use Net::LDAPS;
		$hd = Net::LDAPS->new( $server, async => $async, port => $port ) || 
			die "host $server not available: $!";
	} else {
		$port = $port || 389;
		$hd = Net::LDAP->new( $server, async => $async, port => $port ) || 
			die "host $server not available: $!";
	}
	$hd->debug($opt_debug);
	if ($opt_starttls) {
		$hd->start_tls( verify => 'none' );
	}

	return $hd;
}

sub get_sasl_hd {

	if (!$have_sasl) {
		print "no sasl support\n";
		return undef;
	}

	my $hd;
	if ($sasl_mech && $sasl_mech eq "GSSAPI") {
		my $user = sprintf("%s\@%s", $user, uc($realm));
		if (check_ticket($user) != 0 && get_ticket($user) != 0) {
			print "Could not get Kerberos ticket for user [$user]\n";
			return undef;
		}

		$hd = Authen::SASL->new( mechanism => 'GSSAPI' ) || die "nope";
		my $conn = $hd->client_new("ldap", $server);
		
		if ($conn->code == -1) {
		        printf "%s\n", $conn->error();
			return undef;
		};

	} elsif ($sasl_mech) {

		# here comes generic sasl code
		$hd = Authen::SASL->new( mechanism => $sasl_mech, 
			callback  => { 
				user => \&get_user, 
				pass => \&get_password 
			} 
		) || die "nope";
	} else {
		$sasl_bind = 0;
		print "no supported SASL mechanism found (@sasl_mechs).\n";
		print "falling back to simple bind.\n";
		return undef;
	}

	return $hd;
}

sub check_sasl_mech {
	my $mech_check = shift;
	my $have_mech = 0;
	foreach my $mech (@sasl_mechs) {
		$have_mech = 1 if ($mech eq uc($mech_check));
	}
	if (!$have_mech) {
		return -1;
	}
	return 0;
}


sub parse_ads_h {

	-e "$ads_h" || die "cannot open samba3 ads.h ($ads_h): $!";
	open(ADSH,"$ads_h");
	while (my $line = <ADSH>) {
		chomp($line);
		if ($line =~ /#define.UF.*0x/) {
			my ($tmp, $name, $val) = split(/\s+/,$line);
			next if ($name =~ /UNUSED/);
#			$ads_uf{$name} = sprintf("%d", hex $val);
			$ads_uf{$name} = hex $val;
		}
		if ($line =~ /#define.GROUP_TYPE.*0x/) {
			my ($tmp, $name, $val) = split(/\s+/,$line);
			$ads_grouptype{$name} = hex $val;
		}
		if ($line =~ /#define.ATYPE.*0x/) {
			my ($tmp, $name, $val) = split(/\s+/,$line);
			$ads_atype{$name} = 
				(exists $ads_atype{$val}) ? $ads_atype{$val} : hex $val;
		}
		if ($line =~ /#define.GTYPE.*0x/) {
			my ($val, $i);
			my ($tmp, $name, @val) = split(/\s+/,$line);
			foreach my $tempval (@val) {
				if ($tempval =~ /^0x/) {
					$val = $tempval;
					last;
				}
			}
			next if (!$val);
			$ads_gtype{$name} = sprintf("%d", hex $val);
		}

	}
	close(ADSH);
}

sub store_result ($) {

	my $entry = shift;
	return if (!$entry);
	$entry_store{$entry->dn} = $entry;
}

sub display_result_diff ($) {

	my $entry_new = shift;
	return if ( !$entry_new);

	if ( !exists $entry_store{$entry_new->dn}) {
		print "can't display any differences yet. full dump...\n";
		display_entry_generic($entry_new);
		return;
	}

	my $entry_old = $entry_store{$entry_new->dn};

	foreach my $attr (sort $entry_new->attributes) {
		if ( $entry_new->exists($attr) && ! $entry_old->exists($attr)) {
			display_attr_generic("add:\t", $entry_new, $attr);
			next;
		}
	}

	foreach my $attr (sort $entry_old->attributes) {
		if (! $entry_new->exists($attr) && $entry_old->exists($attr)) {
			display_attr_generic("del:\t", $entry_old, $attr);
			next;
		}

		# now check for all values if they have changed, display changes
		my ($old_vals, $new_vals, @old_vals, @new_vals, %old, %new);

		$old_vals = $entry_old->get_value($attr, asref => 1);
		@old_vals = @$old_vals;
		$new_vals = $entry_new->get_value($attr, asref => 1);
		@new_vals = @$new_vals;

		if (scalar(@old_vals) == 1 && scalar(@new_vals) == 1) {
			if ($old_vals[0] ne $new_vals[0]) {
				display_attr_generic("old:\t", $entry_old, $attr);
				display_attr_generic("new:\t", $entry_new, $attr);
			}
			next;
		}

		# handle multivalued diffs
		foreach my $val (@old_vals) { $old{$val} = "dummy"; };
		foreach my $val (@new_vals) { $new{$val} = "dummy"; };
		foreach my $val (sort keys %new) {
			if (!exists $old{$val}) {
				display_value_generic("add:\t", $attr, $val);
			}
		}
		foreach my $val (sort keys %old) {
			if (!exists $new{$val}) {
				display_value_generic("del:\t", $attr, $val);
			}
		}
	}
	print "\n";

}

sub sid2string ($) {

	# Fix from Michael James <[e-mail]>
	my $binary_sid = shift;
	my($sid_rev, $num_auths, $id1, $id2, @ids) = unpack("H2 H2 n N V*", $binary_sid);
	my $sid_string = join("-", "S", hex($sid_rev), ($id1<<32)+$id2, @ids);
	return $sid_string;
			
}

sub string_to_guid {
	my $string = shift;
	return undef unless $string =~ /([0-9,a-z]{8})-([0-9,a-z]{4})-([0-9,a-z]{4})-([0-9,a-z]{2})([0-9,a-z]{2})-([0-9,a-z]{2})([0-9,a-z]{2})([0-9,a-z]{2})([0-9,a-z]{2})([0-9,a-z]{2})([0-9,a-z]{2})/i;
	
	return 	pack("I", hex $1) . 
		pack("S", hex $2) . 
		pack("S", hex $3) . 
		pack("C", hex $4) . 
		pack("C", hex $5) .
		pack("C", hex $6) . 
		pack("C", hex $7) . 
		pack("C", hex $8) . 
		pack("C", hex $9) . 
		pack("C", hex $10) . 
		pack("C", hex $11);

#	print "$1\n$2\n$3\n$4\n$5\n$6\n$7\n$8\n$9\n$10\n$11\n";
}
							       
sub bindstring_to_guid {
	my $str = shift;
	return pack("H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2", 
		substr($str,0,2),
		substr($str,2,2),
		substr($str,4,2),
		substr($str,6,2),
		substr($str,8,2),
		substr($str,10,2),
		substr($str,12,2),
		substr($str,14,2),
		substr($str,16,2),
		substr($str,18,2),
		substr($str,20,2),
		substr($str,22,2),
		substr($str,24,2),
		substr($str,26,2),
		substr($str,28,2),
		substr($str,30,2));
}

sub guid_to_string {
	my $guid = shift;
	my $string = sprintf "%08X-%04X-%04X-%02X%02X-%02X%02X%02X%02X%02X%02X", 
		unpack("I", $guid), 
		unpack("S", substr($guid, 4, 2)), 
		unpack("S", substr($guid, 6, 2)),
		unpack("C", substr($guid, 8, 1)),
		unpack("C", substr($guid, 9, 1)),
		unpack("C", substr($guid, 10, 1)),
		unpack("C", substr($guid, 11, 1)),
		unpack("C", substr($guid, 12, 1)),
		unpack("C", substr($guid, 13, 1)),
		unpack("C", substr($guid, 14, 1)),
		unpack("C", substr($guid, 15, 1)); 
	return lc($string);
}

sub guid_to_bindstring {
	my $guid = shift;
	return unpack("H" . 2 * length($guid), $guid),
}

sub dump_wknguid {
	print "Dumping Well known GUIDs:\n";
	foreach my $wknguid (keys %wknguids) {

		my $guid = bindstring_to_guid($wknguids{$wknguid});
		my $str  = guid_to_string($guid);
		my $back = guid_to_bindstring($guid);

		printf "wkguid:             %s\n", $wknguid;
		printf "bind_string format: %s\n", $wknguids{$wknguid};
		printf "string format:      %s\n", guid_to_string($guid);
		printf "back to bind_string:%s\n", guid_to_bindstring($guid);
				
		printf "use base: \"<WKGUID=%s,%s>\"\n", guid_to_bindstring($guid), $base;
	}
}

sub gen_bitmask_string_format($%) {
	my $mod = shift;
        my (%tmp) = @_;
	my @list;
	foreach my $key (sort keys %tmp) {
		push(@list, sprintf("%s %s", $tmp{$key}, $key));
	}
	return join("\n$mod$tabsize",@list);
}


sub nt_to_unixtime ($) {
	# the number of 100 nanosecond intervals since jan. 1. 1601 (utc)
	my $t64 = shift;
	$t64 =~ s/(.+).{7,7}/$1/;
	$t64 -= 11644473600;
	return $t64;
}

sub dump_equal {
	my $val = shift;
	my $mod = shift || die "no mod";
        my (%header) = @_;
	my %tmp;
	my $found = 0;
	foreach my $key (keys %header) {
		if ($header{$key} eq $val) {
			$tmp{"($val)"} = $key;
			$found = 1;
			last;
		}
	}
	if (!$found) { $tmp{$val} = ""; };
	return gen_bitmask_string_format($mod,%tmp);
}

sub dump_bitmask {
	my $op = shift || die "no op";
	my $val = shift; 
	my $mod = shift || die "no mod";
        my (%header) = @_;
	my %tmp;
	$tmp{""} = $val;
	foreach my $key (sort keys %header) {	# sort by val !
		if ($op eq "&") {
			$tmp{$key} = ( $val & $header{$key} ) ? $set:$unset; 
		} elsif ($op eq "==") {
			$tmp{$key} = ( $val == $header{$key} ) ? $set:$unset; 
		} else {
			print "unknown operator: $op\n";
			return;
		}
	}
	return gen_bitmask_string_format($mod,%tmp);
}

sub dump_bitmask_and {
	return dump_bitmask("&",@_);
}

sub dump_bitmask_equal {
	return dump_bitmask("==",@_);
}

sub dump_uac {
	return dump_bitmask_and(@_,%ads_uf); # ads_uf ?
}

sub dump_uascompat {
	return dump_bitmask_equal(@_,%ads_uascompat);
}

sub dump_gpoptions {
	return dump_bitmask_equal(@_,%ads_gpoptions);
}

sub dump_gpflags {
	return dump_bitmask_equal(@_,%ads_gpflags);
}