1#!/usr/bin/perl -w 2# 3# adssearch.pl - query an Active Directory server and 4# display objects in a human readable format 5# 6# Copyright (C) Guenther Deschner <gd@samba.org> 2003-2005 7# 8# TODO: add range retrieval 9# write sddl-converter, decode userParameters 10# chase referrals 11# apparently only win2k3 allows simple-binds with machine-accounts. 12# make sasl support independent from Authen::SASL::Cyrus v >0.11 13use strict; 14 15use Net::LDAP; 16use Net::LDAP::Control; 17use Convert::ASN1; 18use Time::Local; 19use POSIX qw(strftime); 20use Getopt::Long; 21 22my $have_sasl; 23my $works_sasl; 24my $pref_version; 25BEGIN { 26 my $class = 'Authen::SASL'; 27 $pref_version = "0.32"; 28 if ( eval "require $class;" ) { 29 $have_sasl = 1; 30 } 31 if ( eval "Net::LDAP->VERSION($pref_version);" ) { 32 $works_sasl = 1; 33 } 34} 35 36# users may set defaults here 37my $base = ""; 38my $binddn = ""; 39my $password = ""; 40my $server = ""; 41 42my $tdbdump = "/usr/bin/tdbdump"; 43my $testparm = "/usr/bin/testparm"; 44my $net = "/usr/bin/net"; 45my $dig = "/usr/bin/dig"; 46my $nmblookup = "/usr/bin/nmblookup"; 47my $secrets_tdb = "/etc/samba/secrets.tdb"; 48my $klist = "/usr/bin/klist"; 49my $kinit = "/usr/bin/kinit"; 50my $ads_h = "/home/gd/ads.h"; 51my $page_size = "1000"; 52my $workgroup = ""; 53my $machine = ""; 54my $realm = ""; 55 56# parse input 57my ( 58 $opt_base, 59 $opt_binddn, 60 $opt_debug, 61 $opt_display_extendeddn, 62 $opt_display_metadata, 63 $opt_display_raw, 64 $opt_dump_rootdse, 65 $opt_dump_schema, 66 $opt_dump_wknguid, 67 $opt_help, 68 $opt_host, 69 $opt_machine, 70 $opt_notify, 71 $opt_notify_nodiffs, 72 $opt_password, 73 $opt_port, 74 $opt_realm, 75 $opt_saslmech, 76 $opt_scope, 77 $opt_simpleauth, 78 $opt_starttls, 79 $opt_user, 80 $opt_workgroup, 81); 82 83GetOptions( 84 'base|b=s' => \$opt_base, 85 'D|DN=s' => \$opt_binddn, 86 'debug=i' => \$opt_debug, 87 'extendeddn|e' => \$opt_display_extendeddn, 88 'help' => \$opt_help, 89 'host|h=s' => \$opt_host, 90 'machine|P' => \$opt_machine, 91 'metadata|m' => \$opt_display_metadata, 92 'nodiffs' => \$opt_notify_nodiffs, 93 'notify|n' => \$opt_notify, 94 'password|w=s' => \$opt_password, 95 'port=i' => \$opt_port, 96 'rawdisplay' => \$opt_display_raw, 97 'realm|R=s' => \$opt_realm, 98 'rootDSE' => \$opt_dump_rootdse, 99 'saslmech|Y=s' => \$opt_saslmech, 100 'schema|c' => \$opt_dump_schema, 101 'scope|s=s' => \$opt_scope, 102 'simpleauth|x' => \$opt_simpleauth, 103 'tls|Z' => \$opt_starttls, 104 'user|U=s' => \$opt_user, 105 'wknguid' => \$opt_dump_wknguid, 106 'workgroup|k=s' => \$opt_workgroup, 107 ); 108 109 110# activate controls 111my $paging = 1 if !$opt_notify; 112 113if (!@ARGV && !$opt_dump_schema && !$opt_dump_rootdse && !$opt_notify || $opt_help) { 114 usage(); 115 exit 1; 116} 117 118# get the query 119my $query = shift; 120my @attrs = @ARGV; 121 122# some global vars 123my ($filter, $dse, $uri); 124my ($attr, $value); 125my (@ctrls, @ctrls_s); 126my ($ctl_paged, $cookie); 127my ($page_count, $total_entry_count); 128my ($sasl_hd, $async_ldap_hd, $sync_ldap_hd); 129my ($mesg, $usn); 130my (%entry_store); 131my $async_search; 132my (%ads_atype, %ads_gtype, %ads_uf); 133 134# fixed values and vars 135my $set = "X"; 136my $unset = "-"; 137 138# get defaults 139my $scope = $opt_scope || "sub"; 140my $port = $opt_port; 141 142my %ads_controls = ( 143"LDAP_SERVER_NOTIFICATION_OID" => "1.2.840.113556.1.4.528", 144"LDAP_SERVER_EXTENDED_DN_OID" => "1.2.840.113556.1.4.529", 145"LDAP_PAGED_RESULT_OID_STRING" => "1.2.840.113556.1.4.319", 146"LDAP_SERVER_SD_FLAGS_OID" => "1.2.840.113556.1.4.801", 147"LDAP_SERVER_SORT_OID" => "1.2.840.113556.1.4.473", 148"LDAP_SERVER_RESP_SORT_OID" => "1.2.840.113556.1.4.474", 149"LDAP_CONTROL_VLVREQUEST" => "2.16.840.1.113730.3.4.9", 150"LDAP_CONTROL_VLVRESPONSE" => "2.16.840.1.113730.3.4.10", 151"LDAP_SERVER_RANGE_RETRIEVAL" => "1.2.840.113556.1.4.802", #unsure 152"LDAP_SERVER_SHOW_DELETED_OID" => "1.2.840.113556.1.4.417", 153"LDAP_SERVER_CROSSDOM_MOVE_TARGET_OID" => "1.2.840.113556.1.4.521", 154"LDAP_SERVER_LAZY_COMMIT_OID" => "1.2.840.113556.1.4.619", 155"LDAP_SERVER_TREE_DELETE_OID" => "1.2.840.113556.1.4.805", 156"LDAP_SERVER_DIRSYNC_OID" => "1.2.840.113556.1.4.841", 157"LDAP_SERVER_VERIFY_NAME_OID" => "1.2.840.113556.1.4.1338", 158"LDAP_SERVER_DOMAIN_SCOPE_OID" => "1.2.840.113556.1.4.1339", 159"LDAP_SERVER_SEARCH_OPTIONS_OID" => "1.2.840.113556.1.4.1340", 160"LDAP_SERVER_PERMISSIVE_MODIFY_OID" => "1.2.840.113556.1.4.1413", 161"LDAP_SERVER_ASQ_OID" => "1.2.840.113556.1.4.1504", 162"NONE (Get stats control)" => "1.2.840.113556.1.4.970", 163"LDAP_SERVER_QUOTA_CONTROL_OID" => "1.2.840.113556.1.4.1852", 164); 165 166my %ads_capabilities = ( 167"LDAP_CAP_ACTIVE_DIRECTORY_OID" => "1.2.840.113556.1.4.800", 168"LDAP_CAP_ACTIVE_DIRECTORY_V51_OID" => "1.2.840.113556.1.4.1670", 169"LDAP_CAP_ACTIVE_DIRECTORY_LDAP_INTEG_OID" => "1.2.840.113556.1.4.1791", 170); 171 172my %ads_extensions = ( 173"LDAP_START_TLS_OID" => "1.3.6.1.4.1.1466.20037", 174"LDAP_TTL_EXTENDED_OP_OID" => "1.3.6.1.4.1.1466.101.119.1", 175"LDAP_SERVER_FAST_BIND_OID" => "1.2.840.113556.1.4.1781", 176"NONE (TTL refresh extended op)" => "1.3.6.1.4.1.1466.101.119.1", 177); 178 179my %ads_matching_rules = ( 180"LDAP_MATCHING_RULE_BIT_AND" => "1.2.840.113556.1.4.803", 181"LDAP_MATCHING_RULE_BIT_OR" => "1.2.840.113556.1.4.804", 182); 183 184my %wknguids = ( 185"WELL_KNOWN_GUID_COMPUTERS" => "AA312825768811D1ADED00C04FD8D5CD", 186"WELL_KNOWN_GUID_DOMAIN_CONTROLLERS" => "A361B2FFFFD211D1AA4B00C04FD7D83A", 187"WELL_KNOWN_GUID_SYSTEM" => "AB1D30F3768811D1ADED00C04FD8D5CD", 188"WELL_KNOWN_GUID_USERS" => "A9D1CA15768811D1ADED00C04FD8D5CD", 189); 190 191my %ads_systemflags = ( 192"FLAG_DONT_REPLICATE" => 0x00000001, # 1 193"FLAG_REPLICATE_TO_GC" => 0x00000002, # 2 194"FLAG_ATTRIBUTE_CONSTRUCT" => 0x00000004, # 4 195"FLAG_CATEGORY_1_OBJECT" => 0x00000010, # 16 196"FLAG_DELETE_WITHOUT_TOMBSTONE" => 0x02000000, # 33554432 197"FLAG_DOMAIN_DISALLOW_MOVE" => 0x04000000, # 67108864 198"FLAG_DOMAIN_DISALLOW_RENAME" => 0x08000000, # 134217728 199#"FLAG_CONFIG_CAN_MOVE_RESTRICTED" => 0x10000000, # 268435456 # only setable on creation 200#"FLAG_CONFIG_CAN_MOVE" => 0x20000000, # 536870912 # only setable on creation 201#"FLAG_CONFIG_CAN_RENAME" => 0x40000000, # 1073741824 # only setable on creation 202"FLAG_DISALLOW_DELETE" => 0x80000000, # 2147483648 203); 204 205my %ads_mixed_domain = ( 206"NATIVE_LEVEL_DOMAIN" => 0, 207"MIXED_LEVEL_DOMAIN" => 1, 208); 209 210my %ads_ds_func = ( 211"DS_BEHAVIOR_WIN2000" => 0, # untested 212"DS_BEHAVIOR_WIN2003" => 2, 213); 214 215my %ads_instance_type = ( 216"DS_INSTANCETYPE_IS_NC_HEAD" => 0x1, 217"IT_WRITE" => 0x4, 218"IT_NC_ABOVE" => 0x8, 219); 220 221my %ads_uacc = ( 222 "ACCOUNT_NEVER_EXPIRES" => 0x000000, # 0 223 "ACCOUNT_OK" => 0x800000, # 8388608 224 "ACCOUNT_LOCKED_OUT" => 0x800010, # 8388624 225); 226 227my %munged_dial = ( 228 "CtxCfgPresent" => \&dump_int, 229 "CtxCfgFlags1" => \&dump_int, 230 "CtxCallback" => \&dump_string, 231 "CtxShadow" => \&dump_string, 232 "CtxMaxConnectionTime" => \&dump_int, 233 "CtxMaxDisconnectionTime"=> \&dump_int, 234 "CtxMaxIdleTime" => \&dump_int, 235 "CtxKeyboardLayout" => \&dump_int, 236 "CtxMinEncryptionLevel" => \&dump_int, 237 "CtxWorkDirectory" => \&dump_string, 238 "CtxNWLogonServer" => \&dump_string, 239 "CtxWFHomeDir" => \&dump_string, 240 "CtxWFHomeDirDrive" => \&dump_string, 241 "CtxWFProfilePath" => \&dump_string, 242 "CtxInitialProgram" => \&dump_string, 243 "CtxCallbackNumber" => \&dump_string, 244); 245 246 247$SIG{__WARN__} = sub { 248 use Carp; 249 Carp::cluck (shift); 250}; 251 252# parse ads.h 253parse_ads_h(); 254 255# if there is data missing, we try to autodetect with samba-tools (if installed) 256# this might fill up workgroup, machine, realm 257get_samba_info(); 258 259# get a workgroup 260$workgroup = $workgroup || $opt_workgroup || ""; 261 262# get the server 263$server = process_servername($opt_host) || 264 detect_server($workgroup,$opt_realm) || 265 die "please define server to query with -h host\n"; 266 267 268# get the base 269$base = $opt_base || 270 get_base_from_rootdse($server,$dse); 271 272# get the realm 273$realm = $opt_realm || 274 get_realm_from_rootdse($server,$dse); 275 276# get sasl mechs 277my @sasl_mechs = get_sasl_mechs_from_rootdse($server,$dse); 278my $sasl_mech = "GSSAPI"; 279if ($opt_saslmech) { 280 $sasl_mech = sprintf("%s", (check_sasl_mech($opt_saslmech) == 0)?uc($opt_saslmech):""); 281} 282 283# set bind type 284my $sasl_bind = 1 if (!$opt_simpleauth); 285 286# get username 287my $user = check_user($opt_user) || $ENV{'USER'} || ""; 288 289# gen upn 290my $upn = sprintf("%s", gen_upn($opt_machine ? "$machine\$" : $user, $realm)); 291 292# get binddn 293$binddn = $opt_binddn || $upn; 294 295# get the password 296$password = $password || $opt_password; 297if (!$password) { 298 $password = $opt_machine ? get_machine_password($workgroup) : get_password(); 299} 300 301my %attr_handler = ( 302 "accountExpires" => \&dump_nttime, 303 "badPasswordTime" => \&dump_nttime, 304 "creationTime" => \&dump_nttime, 305 "currentTime" => \&dump_timestr, 306 "domainControllerFunctionality" => \&dump_ds_func, 307 "domainFunctionality" => \&dump_ds_func, 308 "dSCorePropagationData" => \&dump_timestr, 309 "forceLogoff" => \&dump_nttime_abs, 310 "forestFunctionality" => \&dump_ds_func, 311 "groupType" => \&dump_gtype, 312 "instanceType" => \&dump_instance_type, 313 "lastLogon" => \&dump_nttime, 314 "lastLogonTimestamp" => \&dump_nttime, 315 "lockoutTime" => \&dump_nttime, 316 "lockoutDuration" => \&dump_nttime_abs, 317 "lockOutObservationWindow" => \&dump_nttime_abs, 318# "logonHours" => \&dump_not_yet, 319 "maxPwdAge" => \&dump_nttime_abs, 320 "minPwdAge" => \&dump_nttime_abs, 321 "modifyTimeStamp" => \&dump_timestr, 322# "msRADIUSFramedIPAddress" => \&dump_ipaddr, 323# "msRASSavedFramedIPAddress" => \&dump_ipaddr, 324 "ntMixedDomain" => \&dump_mixed_domain, 325 "nTSecurityDescriptor" => \&dump_secdesc, 326 "objectGUID" => \&dump_guid, 327 "objectSid" => \&dump_sid, 328 "pwdLastSet" => \&dump_nttime, 329 "sAMAccountType" => \&dump_atype, 330 "systemFlags" => \&dump_systemflags, 331 "supportedControl", => \&dump_controls, 332 "supportedCapabilities", => \&dump_capabilities, 333 "supportedExtension", => \&dump_extension, 334 "tokenGroups", => \&dump_sid, 335 "userAccountControl" => \&dump_uac, 336 "msDS-User-Account-Control-Computed" => \&dump_uacc, 337 "userFlags" => \&dump_uf, 338 "userParameters" => \&dump_munged_dial, 339 "whenChanged" => \&dump_timestr, 340 "whenCreated" => \&dump_timestr, 341); 342 343 344 345################ 346# subfunctions # 347################ 348 349sub usage { 350 print "usage: $0 [--base|-b base] [--debug level] [--debug level] [--DN|-D binddn] [--extendeddn|-e] [--help] [--host|-h host] [--machine|-P] [--metadata|-m] [--nodiffs] [--notify|-n] [--password|-w password] [--port port] [--rawdisplay] [--realm|-R realm] [--rootdse] [--saslmech|-Y saslmech] [--schema|-c] [--scope|-s scope] [--simpleauth|-x] [--starttls|-Z] [--user|-U user] [--wknguid] [--workgroup|-k workgroup] filter [attrs]\n"; 351 print "\t--base|-b [base]\n\t\tUse base [base]\n"; 352 print "\t--debug [level]\n\t\tUse debuglevel (for Net::LDAP)\n"; 353 print "\t--DN|-D [binddn]\n\t\tUse binddn or principal\n"; 354 print "\t--extendeddn|-e\n\t\tDisplay extended dn (LDAP_SERVER_EXTENDED_DN_OID)\n"; 355 print "\t--help\n\t\tDisplay help page\n"; 356 print "\t--host|-h [host]\n\t\tQuery Host [host] (either a hostname or an LDAP uri)\n"; 357 print "\t--machine|-P\n\t\tUse samba3 machine account stored in $secrets_tdb (needs root access)\n"; 358 print "\t--metdata|-m\n\t\tDisplay replication metadata\n"; 359 print "\t--nodiffs\n\t\tDisplay no diffs but full entry dump when running in notify mode\n"; 360 print "\t--notify|-n\n\t\tActivate asynchronous change notification (LDAP_SERVER_NOTIFICATION_OID)\n"; 361 print "\t--password|-w [password]\n\t\tUse [password] for binddn\n"; 362 print "\t--port [port]\n\t\tUse [port] when connecting ADS\n"; 363 print "\t--rawdisplay\n\t\tDo not interpret values\n"; 364 print "\t--realm|-R [realm]\n\t\tUse [realm] when trying to construct bind-principal\n"; 365 print "\t--rootdse\n\t\tDisplay RootDSE (anonymously)\n"; 366 print "\t--saslmech|-Y [saslmech]\n\t\tUse SASL Mechanism [saslmech] when binding\n"; 367 print "\t--schema|-c\n\t\tDisplay DSE-Schema\n"; 368 print "\t--scope|-s [scope]\n\t\tUse scope [scope] (sub, base, one)\n"; 369 print "\t--simpleauth|-x\n\t\tUse simple bind (otherwise SASL binds are performed)\n"; 370 print "\t--starttls|-Z\n\t\tUse Start TLS extended operation to secure LDAP traffic\n"; 371 print "\t--user|-U [user]\n\t\tUse [user]\n"; 372 print "\t--wknguid\n\t\tDisplay well known guids\n"; 373 print "\t--workgroup|-k [workgroup]\n\t\tWhen LDAP-Server is not known try to find a Domain-Controller for [workgroup]\n"; 374} 375 376sub write_ads_list { 377 my ($mod,$attr,$value) = @_; 378 my $ofh = select(STDOUT); 379 $~ = "ADS_LIST"; 380 select($ofh); 381 write(); 382 383format ADS_LIST = 384@<<<< @>>>>>>>>>>>>>>>>>>>>>>>: @* 385$mod, $attr, $value 386. 387} 388 389sub write_ads { 390 my ($mod,$attr,$value) = @_; 391 my $ofh = select(STDOUT); 392 $~ = "ADS"; 393 select($ofh); 394 write(); 395 396format ADS = 397@<<<< @>>>>>>>>>>>>>>>>>>>>>>>: ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 398$mod, $attr, $value 399~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 400 $value 401. 402} 403 404sub detect_server { 405 406 my $workgroup = shift; 407 my $realm = shift; 408 my $result; 409 my $found; 410 411 # try net cache (nbt records) 412 if ( -x $net && $workgroup ) { 413 my $key = sprintf("NBT/%s#1C", uc($workgroup)); 414 chomp($result = `$net cache search $key 2>&1 /dev/null`); 415 $result =~ s/^.*Value: //; 416 $result =~ s/:.*//; 417 return $result if $result; 418 printf("%10s query failed for [%s]\n", "net cache", $key); 419 } 420 421 # try dns SRV entries 422 if ( -x $dig && $realm ) { 423 my $key = sprintf("_ldap._tcp.%s", lc($realm)); 424 chomp($result = `$dig $key SRV +short +search | egrep "^[0-9]" | head -1`); 425 $result =~ s/.* //g; 426 $result =~ s/.$//g; 427 return $result if $result; 428 printf("%10s query failed for [%s]\n", "dns", $key); 429 } 430 431 # try netbios broadcast query 432 if ( -x $nmblookup && $workgroup ) { 433 my $key = sprintf("%s#1C", uc($workgroup)); 434 my $pattern = sprintf("%s<1c>", uc($workgroup)); 435 chomp($result = `$nmblookup $key -d 0 | grep '$pattern'`); 436 $result =~ s/\s.*//; 437 return $result if $result; 438 printf("%10s query failed for [%s]\n", "nmblookup", $key); 439 } 440 441 return ""; 442} 443 444sub get_samba_info { 445 446 if (! -x $testparm) { return -1; } 447 448 my $tmp; 449 open(TESTPARM, "$testparm -s -v 2> /dev/null |"); 450 while (my $line = <TESTPARM>) { 451 chomp($line); 452 if ($line =~ /netbios name/) { 453 ($tmp, $machine) = split(/=/, $line); 454 $machine =~ s/\s+|\t+//g; 455 } 456 if ($line =~ /realm/) { 457 ($tmp, $realm) = split(/=/, $line); 458 $realm =~ s/\s+|\t+//g; 459 } 460 if ($line =~ /workgroup/) { 461 ($tmp, $workgroup) = split(/=/, $line); 462 $workgroup =~ s/\s+|\t+//g; 463 } 464 } 465 close(TESTPARM); 466 return 0; 467} 468 469sub gen_upn { 470 my $machine = shift; 471 my $realm = shift; 472 if ($machine && $realm) { 473 return sprintf("%s\@%s", lc($machine), uc($realm)); 474 }; 475 return undef; 476} 477 478sub get_password { 479 if (!$password && $opt_simpleauth && check_ticket($user)) { 480 return prompt_password($user); 481 } 482 return ""; 483} 484 485sub get_user { 486 my $user = shift || prompt_user(); 487 return $user; 488} 489 490sub get_machine_password { 491 492 my $workgroup = shift || ""; 493 $workgroup = uc($workgroup); 494 495 my ($found, $tmp); 496 -x $tdbdump || die "tdbdump is not installed. cannot proceed autodetection\n"; 497 -r $secrets_tdb || die "cannot read $secrets_tdb. cannot proceed autodetection\n"; 498 499 # get machine-password 500 my $key = sprintf("SECRETS/MACHINE_PASSWORD/%s", $workgroup); 501 open(SECRETS,"$tdbdump $secrets_tdb |"); 502 while(my $line = <SECRETS>) { 503 chomp($line); 504 if ($found) { 505 $line =~ s/\\00//; 506 ($line,$password) = split(/"/, $line); 507 last; 508 } 509 if ($line =~ /$key/) { 510 $found = 1; 511 } 512 } 513 close(SECRETS); 514 515 if ($found) { 516 print "Successfully autodetected machine password for workgroup: $workgroup\n"; 517 return $password; 518 } else { 519 warn "No machine password available for $workgroup\n"; 520 } 521 return ""; 522} 523 524sub prompt_password { 525 526 my $acct = shift || ""; 527 if ($acct =~ /\%/) { 528 ($acct, $password) = split(/\%/, $acct); 529 return $password; 530 } 531 system "stty -echo"; 532 print "Enter password for $acct:"; 533 my $password = <STDIN>; 534 chomp($password); 535 print "\n"; 536 system "stty echo"; 537 return $password; 538} 539 540sub prompt_user { 541 542 print "Enter Username:"; 543 my $user = <STDIN>; 544 chomp($user); 545 print "\n"; 546 return $user; 547} 548 549sub check_ticket { 550 return system("$klist -t"); 551} 552 553sub get_ticket { 554 555 my $KRB5_CONFIG = "/tmp/.krb5.conf.telads-$<"; 556 557 open(KRB5CONF, "> $KRB5_CONFIG") || die "cannot write $KRB5_CONFIG"; 558 printf KRB5CONF "# autogenerated by $0\n"; 559 printf KRB5CONF "[libdefaults]\n\tdefault_realm = %s\n\tclockskew = %d\n", uc($realm), 60*60; 560 printf KRB5CONF "[realms]\n\t%s = {\n\t\tkdc = %s\n\t}\n", uc($realm), $server; 561 close(KRB5CONF); 562 563 if ( system("KRB5_CONFIG=$KRB5_CONFIG $kinit $user") != 0) { 564 return -1; 565 } 566 567 return 0; 568} 569 570sub check_user { 571 my $acct = shift || ""; 572 if ($acct =~ /\%/) { 573 ($acct, $password) = split(/\%/, $acct); 574 } 575 return $acct; 576} 577 578sub check_ctrls ($$@) { 579 580 # bogus function?? 581 my $server = shift || ""; 582 $dse = shift || get_dse($server) || return -1; 583 my @ctrls = @_; 584 585 my $dse_controls = $dse->get_value('supportedControl', asref => '1'); 586 my @dse_controls = @$dse_controls; 587 588 foreach my $i (@ctrls) { 589 # we could use -> supported_control but this 590 # is only available in newer versions of perl-ldap 591# if ( ! $dse->supported_control( $i ) ) { 592 if ( grep(/$i->type()/, @dse_controls) ) { 593 printf("required control: %s is not supported by ADS-server.\n", $i->type()); 594 return -1; 595 } 596 } 597 return 0; 598} 599 600sub get_base_from_rootdse { 601 602 my $server = shift || ""; 603 $dse = shift || get_dse($server,$async_ldap_hd) || return -1; 604 return $dse->get_value('defaultNamingContext'); 605} 606 607sub get_realm_from_rootdse { 608 609 my $server = shift || ""; 610 $dse = shift || get_dse($server,$async_ldap_hd) || return -1; 611 my $service = $dse->get_value('ldapServiceName') || ""; 612 if ($service) { 613 my ($t,$realm) = split(/\@/, $service); 614 return $realm; 615 } else { 616 die "very odd: could not get realm"; 617 } 618} 619 620sub get_sasl_mechs_from_rootdse { 621 622 my $server = shift || ""; 623 $dse = shift || get_dse($server,$async_ldap_hd) || return -1; 624 my $mechs = $dse->get_value('supportedSASLMechanisms', asref => 1); 625 return @$mechs; 626} 627 628sub get_dse { 629 630 my $server = shift || return undef; 631 $async_ldap_hd = shift || get_ldap_hd($server,1); 632 if (!$async_ldap_hd) { 633 print "oh, no connection\n"; 634 return undef; 635 } 636 my $mesg = $async_ldap_hd->bind() || die "cannot bind\n"; 637 if ($mesg->code) { die "failed to bind\n"; }; 638 my $dse = $async_ldap_hd->root_dse( attrs => ['*', "supportedExtension", "supportedFeatures" ] ); 639 640 return $dse; 641} 642 643sub process_servername { 644 645 my $name = shift || return ""; 646 if ($name =~ /^ldaps:\/\//i ) { 647 $name =~ s#^ldaps://##i; 648 $uri = sprintf("%s://%s", "ldaps", $name); 649 } else { 650 $name =~ s#^ldap://##i; 651 $uri = sprintf("%s://%s", "ldap", $name); 652 } 653 return $name; 654} 655 656sub get_ldap_hd { 657 658 my $server = shift || return undef; 659 my $async = shift || "0"; 660 my $hd; 661 die "uri unavailable" if (!$uri); 662 if ($uri =~ /^ldaps:\/\//i ) { 663 $port = $port || 636; 664 use Net::LDAPS; 665 $hd = Net::LDAPS->new( $server, async => $async, port => $port ) || 666 die "host $server not available: $!"; 667 } else { 668 $port = $port || 389; 669 $hd = Net::LDAP->new( $server, async => $async, port => $port ) || 670 die "host $server not available: $!"; 671 } 672 $hd->debug($opt_debug); 673 if ($opt_starttls) { 674 $hd->start_tls( verify => 'none' ); 675 } 676 677 return $hd; 678} 679 680sub get_sasl_hd { 681 682 if (!$have_sasl) { 683 print "no sasl support\n"; 684 return undef; 685 } 686 687 my $hd; 688 if ($sasl_mech && $sasl_mech eq "GSSAPI") { 689 my $user = sprintf("%s\@%s", $user, uc($realm)); 690 if (check_ticket($user) != 0 && get_ticket($user) != 0) { 691 print "Could not get Kerberos ticket for user [$user]\n"; 692 return undef; 693 } 694 695 $hd = Authen::SASL->new( mechanism => 'GSSAPI' ) || die "nope"; 696 my $conn = $hd->client_new("ldap", $server); 697 698 if ($conn->code == -1) { 699 printf "%s\n", $conn->error(); 700 return undef; 701 }; 702 703 } elsif ($sasl_mech) { 704 705 # here comes generic sasl code 706 $hd = Authen::SASL->new( mechanism => $sasl_mech, 707 callback => { 708 user => \&get_user, 709 pass => \&get_password 710 } 711 ) || die "nope"; 712 } else { 713 $sasl_bind = 0; 714 print "no supported SASL mechanism found (@sasl_mechs).\n"; 715 print "falling back to simple bind.\n"; 716 return undef; 717 } 718 719 return $hd; 720} 721 722sub check_sasl_mech { 723 my $mech_check = shift; 724 my $have_mech = 0; 725 foreach my $mech (@sasl_mechs) { 726 $have_mech = 1 if ($mech eq uc($mech_check)); 727 } 728 if (!$have_mech) { 729 return -1; 730 } 731 return 0; 732} 733 734 735sub parse_ads_h { 736 737 -e "$ads_h" || die "cannot open samba3 ads.h ($ads_h): $!"; 738 open(ADSH,"$ads_h"); 739 while (my $line = <ADSH>) { 740 chomp($line); 741 if ($line =~ /#define.UF.*0x/) { 742 my ($tmp, $name, $val) = split(/\s+/,$line); 743 next if ($name =~ /UNUSED/); 744 $ads_uf{$name} = hex $val; 745 } 746 if ($line =~ /#define.GTYPE.*0x/) { 747 my ($tmp, $name, $val) = split(/\s+/,$line); 748 $ads_gtype{$name} = hex $val; 749 } 750 if ($line =~ /#define.ATYPE.*0x/) { 751 my ($tmp, $name, $val) = split(/\s+/,$line); 752 $ads_atype{$name} = 753 (exists $ads_atype{$val}) ? $ads_atype{$val} : hex $val; 754 } 755 } 756 close(ADSH); 757} 758 759sub store_result ($) { 760 761 my $entry = shift; 762 return if (!$entry); 763 $entry_store{$entry->dn} = $entry; 764} 765 766sub display_result_diff ($) { 767 768 my $entry_new = shift; 769 return if ( !$entry_new); 770 771 if ( !exists $entry_store{$entry_new->dn}) { 772 print "can't display any differences yet. full dump...\n"; 773 display_entry_generic($entry_new); 774 return; 775 } 776 777 my $entry_old = $entry_store{$entry_new->dn}; 778 779 foreach my $attr (sort $entry_new->attributes) { 780 if ( $entry_new->exists($attr) && ! $entry_old->exists($attr)) { 781 display_attr_generic("add:\t", $entry_new, $attr); 782 next; 783 } 784 } 785 786 foreach my $attr (sort $entry_old->attributes) { 787 if (! $entry_new->exists($attr) && $entry_old->exists($attr)) { 788 display_attr_generic("del:\t", $entry_old, $attr); 789 next; 790 } 791 792 # now check for all values if they have changed, display changes 793 my ($old_vals, $new_vals, @old_vals, @new_vals, %old, %new); 794 795 $old_vals = $entry_old->get_value($attr, asref => 1); 796 @old_vals = @$old_vals; 797 $new_vals = $entry_new->get_value($attr, asref => 1); 798 @new_vals = @$new_vals; 799 800 if (scalar(@old_vals) == 1 && scalar(@new_vals) == 1) { 801 if ($old_vals[0] ne $new_vals[0]) { 802 display_attr_generic("old:\t", $entry_old, $attr); 803 display_attr_generic("new:\t", $entry_new, $attr); 804 } 805 next; 806 } 807 808 # handle multivalued diffs 809 foreach my $val (@old_vals) { $old{$val} = "dummy"; }; 810 foreach my $val (@new_vals) { $new{$val} = "dummy"; }; 811 foreach my $val (sort keys %new) { 812 if (!exists $old{$val}) { 813 display_value_generic("add:\t", $attr, $val); 814 } 815 } 816 foreach my $val (sort keys %old) { 817 if (!exists $new{$val}) { 818 display_value_generic("del:\t", $attr, $val); 819 } 820 } 821 } 822 print "\n"; 823 824} 825 826sub sid2string ($) { 827 828 my $binary_sid = shift; 829 my $inbuf2; 830 my $sid_rev; # [1] 831 my $num_auths; # [1] 832 my @id_auth; # [6] 833 my @sub_auths; 834 my $subauth; # [16] 835 my $sid_strout; 836 my $ia; 837 838 my $tmp_sid = unpack 'H*', $binary_sid; 839 840 # split the binary string 841 ($sid_rev, $num_auths, 842 $id_auth[0], $id_auth[1], $id_auth[2], $id_auth[3], $id_auth[4], $id_auth[5], 843 $sub_auths[0], $sub_auths[1], $sub_auths[2], $sub_auths[3], $sub_auths[4], $inbuf2) 844 = unpack 'H2 H2 H2 H2 H2 H2 H2 H2 h8 h8 h8 h8 h8 h*',"$binary_sid"; 845 846 # don't ask... 847 for ( my $i = 0; $i < $num_auths; $i++ ) { 848 $sub_auths[$i] = reverse $sub_auths[$i]; 849 } 850 851 # build the identifier authority 852 if ( ($id_auth[0] != 0) || ($id_auth[1] != 0) ) { 853 $ia = $id_auth[0]. 854 $id_auth[1]. 855 $id_auth[2]. 856 $id_auth[3]. 857 $id_auth[4]. 858 $id_auth[5]; 859 } else { 860 $ia = ($id_auth[5]) + 861 ($id_auth[4] << 8) + 862 ($id_auth[3] << 16) + 863 ($id_auth[2] << 24); 864 } 865 866 # build the sid 867 $sid_strout = sprintf("S-%lu-%lu",hex($sid_rev),hex($ia)); 868 869 for (my $i = 0; $i < $num_auths; $i++ ) { 870 $sid_strout .= sprintf( "-%lu", hex($sub_auths[$i]) ); 871 } 872 873 return $sid_strout; 874} 875 876sub string_to_guid { 877 my $string = shift; 878 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; 879 880 return pack("I", hex $1) . 881 pack("S", hex $2) . 882 pack("S", hex $3) . 883 pack("C", hex $4) . 884 pack("C", hex $5) . 885 pack("C", hex $6) . 886 pack("C", hex $7) . 887 pack("C", hex $8) . 888 pack("C", hex $9) . 889 pack("C", hex $10) . 890 pack("C", hex $11); 891 892# print "$1\n$2\n$3\n$4\n$5\n$6\n$7\n$8\n$9\n$10\n$11\n"; 893} 894 895sub bindstring_to_guid { 896 my $str = shift; 897 return pack("H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2", 898 substr($str,0,2), 899 substr($str,2,2), 900 substr($str,4,2), 901 substr($str,6,2), 902 substr($str,8,2), 903 substr($str,10,2), 904 substr($str,12,2), 905 substr($str,14,2), 906 substr($str,16,2), 907 substr($str,18,2), 908 substr($str,20,2), 909 substr($str,22,2), 910 substr($str,24,2), 911 substr($str,26,2), 912 substr($str,28,2), 913 substr($str,30,2)); 914} 915 916sub guid_to_string { 917 my $guid = shift; 918 my $string = sprintf "%08X-%04X-%04X-%02X%02X-%02X%02X%02X%02X%02X%02X", 919 unpack("I", $guid), 920 unpack("S", substr($guid, 4, 2)), 921 unpack("S", substr($guid, 6, 2)), 922 unpack("C", substr($guid, 8, 1)), 923 unpack("C", substr($guid, 9, 1)), 924 unpack("C", substr($guid, 10, 1)), 925 unpack("C", substr($guid, 11, 1)), 926 unpack("C", substr($guid, 12, 1)), 927 unpack("C", substr($guid, 13, 1)), 928 unpack("C", substr($guid, 14, 1)), 929 unpack("C", substr($guid, 15, 1)); 930 return lc($string); 931} 932 933sub guid_to_bindstring { 934 my $guid = shift; 935 return unpack("H" . 2 * length($guid), $guid), 936} 937 938sub dump_wknguid { 939 print "Dumping Well known GUIDs:\n"; 940 foreach my $wknguid (keys %wknguids) { 941 942 my $guid = bindstring_to_guid($wknguids{$wknguid}); 943 my $str = guid_to_string($guid); 944 my $back = guid_to_bindstring($guid); 945 946 printf "wkguid: %s\n", $wknguid; 947 printf "bind_string format: %s\n", $wknguids{$wknguid}; 948 printf "string format: %s\n", guid_to_string($guid); 949 printf "back to bind_string:%s\n", guid_to_bindstring($guid); 950 951 printf "use base: \"<WKGUID=%s,%s>\"\n", guid_to_bindstring($guid), $base; 952 } 953} 954 955sub gen_bitmask_string_format($%) { 956 my $mod = shift; 957 my (%tmp) = @_; 958 my @list; 959 foreach my $key (sort keys %tmp) { 960 push(@list, sprintf("%s %s", $tmp{$key}, $key)); 961 } 962 return join("\n$mod\t\t\t",@list); 963} 964 965sub nt_to_unixtime ($) { 966 # the number of 100 nanosecond intervals since jan. 1. 1601 (utc) 967 my $t64 = shift; 968 $t64 =~ s/(.+).{7,7}/$1/; 969 $t64 -= 11644473600; 970 return $t64; 971} 972 973sub dump_equal { 974 my $val = shift; 975 my $mod = shift || die "no mod"; 976 my (%header) = @_; 977 my %tmp; 978 my $found = 0; 979 foreach my $key (keys %header) { 980 if ($header{$key} eq $val) { 981 $tmp{"($val)"} = $key; 982 $found = 1; 983 last; 984 } 985 } 986 if (!$found) { $tmp{$val} = ""; }; 987 return gen_bitmask_string_format($mod,%tmp); 988} 989 990sub dump_bitmask { 991 my $op = shift || die "no op"; 992 my $val = shift; 993 my $mod = shift || die "no mod"; 994 my (%header) = @_; 995 my %tmp; 996 $tmp{""} = $val; 997 foreach my $key (sort keys %header) { 998 if ($op eq "&") { 999 $tmp{$key} = ( $val & $header{$key} ) ? $set:$unset; 1000 } elsif ($op eq "==") { 1001 $tmp{$key} = ( $val == $header{$key} ) ? $set:$unset; 1002 } else { 1003 print "unknown operator: $op\n"; 1004 return; 1005 } 1006 } 1007 return gen_bitmask_string_format($mod,%tmp); 1008} 1009 1010sub dump_bitmask_and { 1011 return dump_bitmask("&",@_); 1012} 1013 1014sub dump_bitmask_equal { 1015 return dump_bitmask("==",@_); 1016} 1017 1018sub dump_uac { 1019 return dump_bitmask_and(@_,%ads_uf); # ads_uf ? 1020} 1021 1022sub dump_uacc { 1023 return dump_bitmask_equal(@_,%ads_uacc); 1024} 1025 1026sub dump_uf { 1027 return dump_bitmask_and(@_,%ads_uf); 1028} 1029 1030sub dump_gtype { 1031 return dump_bitmask_and(@_,%ads_gtype); 1032} 1033 1034sub dump_atype { 1035 return dump_bitmask_equal(@_,%ads_atype); 1036} 1037 1038sub dump_controls { 1039 return dump_equal(@_,%ads_controls); 1040} 1041 1042sub dump_capabilities { 1043 return dump_equal(@_,%ads_capabilities); 1044} 1045 1046sub dump_extension { 1047 return dump_equal(@_,%ads_extensions); 1048} 1049 1050sub dump_systemflags { 1051 return dump_bitmask_and(@_,%ads_systemflags); 1052} 1053 1054sub dump_instance_type { 1055 return dump_bitmask_and(@_,%ads_instance_type); 1056} 1057 1058sub dump_ds_func { 1059 return dump_bitmask_equal(@_,%ads_ds_func); 1060} 1061 1062sub dump_mixed_domain { 1063 return dump_bitmask_equal(@_,%ads_mixed_domain); 1064} 1065 1066sub dump_sid { 1067 my $bin_sid = shift; 1068 return sid2string($bin_sid); 1069} 1070 1071sub dump_guid { 1072 my $guid = shift; 1073 return guid_to_string($guid); 1074} 1075 1076sub dump_secdesc { 1077 my $val = shift; 1078 return "FIXME: write sddl-converter!"; 1079} 1080 1081sub dump_nttime { 1082 my $nttime = shift; 1083 if ($nttime == 0) { 1084 return sprintf("%s (%s)", "never", $nttime); 1085 } 1086 my $localtime = localtime(nt_to_unixtime($nttime)); 1087 return sprintf("%s (%s)", $localtime, $nttime); 1088} 1089 1090sub dump_nttime_abs { 1091 if ($_[0] == 9223372036854775807) { 1092 return sprintf("%s (%s)", "now", $_[0]); 1093 } 1094 if ($_[0] == -9223372036854775808 || $_[0] == 0) { # 0x7FFFFFFFFFFFFFFF 1095 return sprintf("%s (%s)", "never", $_[0]); 1096 } 1097 # FIXME: actually *do* abs time ! 1098 return dump_nttime($_[0]); 1099} 1100 1101sub dump_timestr { 1102 my $time = shift; 1103 my ($year,$mon,$mday,$hour,$min,$sec,$zone) = 1104 unpack('a4 a2 a2 a2 a2 a2 a4', $time); 1105 $mon -= 1; 1106 my $localtime = localtime(timegm($sec,$min,$hour,$mday,$mon,$year)); 1107 return sprintf("%s (%s)", $localtime, $time); 1108} 1109 1110sub dump_string { 1111 return $_[0]; 1112} 1113 1114sub dump_int { 1115 return sprintf("%d", $_[0]); 1116} 1117 1118sub dump_munged_dial { 1119 my $dial = shift; 1120 return "FIXME! decode this"; 1121} 1122 1123sub construct_filter { 1124 1125 my $tmp = shift; 1126 1127 if (!$tmp || $opt_notify) { 1128 return "(objectclass=*)"; 1129 } 1130 1131 if ($tmp && $tmp !~ /^.*\=/) { 1132 return "(ANR=$tmp)"; 1133 } 1134 1135 return $tmp; 1136 # (&(objectCategory=person) 1137 # (userAccountControl:$ads_matching_rules{LDAP_MATCHING_RULE_BIT_AND}:=2)) 1138} 1139 1140sub construct_attrs { 1141 1142 my @attrs = @_; 1143 1144 if (!@attrs) { 1145 push(@attrs,"*"); 1146 } 1147 1148 if ($opt_notify) { 1149 push(@attrs,"uSNChanged"); 1150 } 1151 1152 if ($opt_display_metadata) { 1153 push(@attrs,"msDS-ReplAttributeMetaData"); 1154 push(@attrs,"replPropertyMetaData"); 1155 } 1156 1157 push(@attrs,"nTSecurityDescriptor"); 1158 push(@attrs,"msDS-KeyVersionNumber"); 1159 push(@attrs,"msDS-User-Account-Control-Computed"); 1160 push(@attrs,"modifyTimeStamp"); 1161 1162 return sort @attrs; 1163} 1164 1165sub print_header { 1166 1167 print "\n"; 1168 printf "%10s: %s\n", "uri", $uri; 1169 printf "%10s: %s\n", "port", $port; 1170 printf "%10s: %s\n", "base", $base; 1171 printf "%10s: %s\n", $sasl_bind ? "principal" : "binddn", $sasl_bind ? $upn : $binddn; 1172 printf "%10s: %s\n", "password", $password; 1173 printf "%10s: %s\n", "bind-type", $sasl_bind ? "SASL" : "simple"; 1174 printf "%10s: %s\n", "sasl-mech", $sasl_mech if ($sasl_mech); 1175 printf "%10s: %s\n", "filter", $filter; 1176 printf "%10s: %s\n", "scope", $scope; 1177 printf "%10s: %s\n", "attrs", join(", ", @attrs); 1178 printf "%10s: %s\n", "controls", join(", ", @ctrls_s); 1179 printf "%10s: %s\n", "page_size", $page_size if ($paging); 1180 printf "%10s: %s\n", "start_tls", $opt_starttls ? "yes" : "no"; 1181 printf "\n"; 1182} 1183 1184sub gen_controls { 1185 1186 my $asn = Convert::ASN1->new; 1187 $asn->prepare( 1188 q< ExtendedDn ::= SEQUENCE { 1189 mode INTEGER 1190 } 1191 > 1192 ); 1193 1194 my $ctl_extended_dn_val = $asn->encode( mode => '1'); 1195 my $ctl_extended_dn =Net::LDAP::Control->new( 1196 type => $ads_controls{'LDAP_SERVER_EXTENDED_DN_OID'}, 1197 critical => 'true', 1198 value => $ctl_extended_dn_val); 1199 1200 my $ctl_notification = Net::LDAP::Control->new( 1201 type => $ads_controls{'LDAP_SERVER_NOTIFICATION_OID'}, 1202 critical => 'true'); 1203 1204 $ctl_paged = Net::LDAP::Control->new( 1205 type => $ads_controls{'LDAP_PAGED_RESULT_OID_STRING'}, 1206 critical => 'true', 1207 size => $page_size); 1208 1209 if ($paging) { 1210 push(@ctrls, $ctl_paged); 1211 push(@ctrls_s, "LDAP_PAGED_RESULT_OID_STRING" ); 1212 } 1213 1214 if ($opt_display_extendeddn) { 1215 push(@ctrls, $ctl_extended_dn); 1216 push(@ctrls_s, "LDAP_SERVER_EXTENDED_DN_OID"); 1217 } 1218 if ($opt_notify) { 1219 push(@ctrls, $ctl_notification); 1220 push(@ctrls_s, "LDAP_SERVER_NOTIFICATION_OID"); 1221 } 1222 1223 return @ctrls; 1224} 1225 1226sub display_value_generic ($$$) { 1227 1228 my ($mod,$attr,$value) = @_; 1229 return unless (defined($value) and defined($attr)); 1230 1231 if ( ! $opt_display_raw && exists $attr_handler{$attr} ) { 1232 $value = $attr_handler{$attr}($value,$mod); 1233 write_ads_list($mod,$attr,$value); 1234 return; 1235 } 1236 write_ads($mod,$attr,$value); 1237} 1238 1239sub display_attr_generic ($$$) { 1240 1241 my ($mod,$entry,$attr) = @_; 1242 return if (!$attr || !$entry); 1243 1244 my $ref = $entry->get_value($attr, asref => 1); 1245 my @values = @$ref; 1246 1247 foreach my $value (@values) { 1248 display_value_generic($mod,$attr,$value); 1249 } 1250} 1251 1252sub display_entry_generic ($) { 1253 1254 my $entry = shift; 1255 return if (!$entry); 1256 1257 foreach my $attr ( $entry->attributes) { 1258 display_attr_generic("\t",$entry,$attr); 1259 } 1260} 1261 1262sub display_ldap_err ($) { 1263 my $msg = shift; 1264 1265 print_header(); 1266 my ($package, $filename, $line, $subroutine) = caller(0); 1267 1268 print "got error from ADS:\n"; 1269 printf("%s(%d): ERROR (%s): %s\n", 1270 $subroutine, $line, $msg->code, $msg->error); 1271 1272} 1273 1274sub process_result { 1275 1276 my ($msg,$entry) = @_; 1277 1278 if (!defined($msg)) { 1279 return; 1280 } 1281 1282 if ($msg->code) { 1283 display_ldap_err($msg); 1284 exit 1; 1285 } 1286 1287 if (!defined($entry)) { 1288 return; 1289 } 1290 1291 if ($entry->isa('Net::LDAP::Reference')) { 1292 foreach my $ref ($entry->references) { 1293 print "\ngot Reference: [$ref]\n"; 1294 } 1295 return; 1296 } 1297 1298 print "\nfound entry: ".$entry->dn."\n".("-" x 80)."\n"; 1299 1300 display_entry_generic($entry); 1301} 1302 1303sub default_callback { 1304 1305 my ($res,$obj) = @_; 1306 1307 if (!$opt_notify) { 1308 return process_result($res,$obj); 1309 } 1310} 1311 1312sub error_callback { 1313 1314 my ($msg,$entry) = @_; 1315 1316 if (!$msg) { 1317 return; 1318 } 1319 1320 if ($msg->code) { 1321 display_ldap_err($msg); 1322 exit(1); 1323 } 1324 return; 1325} 1326 1327sub notify_callback { 1328 1329 my ($msg, $obj) = @_; 1330 1331 if (! defined($obj)) { 1332 return; 1333 } 1334 1335 if ($obj->isa('Net::LDAP::Reference')) { 1336 foreach my $ref ($obj->references) { 1337 print "\ngot Reference: [$ref]\n"; 1338 } 1339 return; 1340 } 1341 1342 while (1) { 1343 1344 my $async_entry = $async_search->pop_entry; 1345 1346 printf("\ngot changenotify for dn: [%s]\n%s\n", $async_entry->dn, ("-" x 80)); 1347 1348 my $new_usn = $async_entry->get_value('uSNChanged'); 1349 if (!$usn || $new_usn > $usn) { 1350 $usn = $new_usn; 1351 if ($opt_notify_nodiffs) { 1352 display_entry_generic($async_entry); 1353 } else { 1354 display_result_diff($async_entry); 1355 } 1356 } 1357 store_result($async_entry); 1358 } 1359} 1360 1361sub do_bind($$) { 1362 1363 my $async_ldap_hd = shift || return undef; 1364 my $sasl_bind = shift; 1365 1366 if ($sasl_bind) { 1367 if (!$works_sasl) { 1368 print "this version of Net::LDAP does not have proper SASL support.\n"; 1369 print "Need at least perl-ldap V. $pref_version\n"; 1370 } 1371 $sasl_hd = get_sasl_hd(); 1372 if (!$sasl_hd) { 1373 print "failed to create SASL handle\n"; 1374 return -1; 1375 } 1376 $mesg = $async_ldap_hd->bind( 1377 sasl => $sasl_hd, 1378 callback => \&error_callback 1379 ) || die "doesnt work"; 1380 } else { 1381 $sasl_mech = ""; 1382 $mesg = $async_ldap_hd->bind( 1383 $binddn, 1384 password => $password, 1385 callback => \&error_callback 1386 ) || die "doesnt work"; 1387 }; 1388 if ($mesg->code) { 1389 display_ldap_err($mesg); 1390 return -1; 1391 } 1392 return 0; 1393} 1394 1395sub do_unbind() { 1396 if ($async_ldap_hd) { 1397 $async_ldap_hd->unbind; 1398 } 1399 if ($sync_ldap_hd) { 1400 $sync_ldap_hd->unbind; 1401 } 1402} 1403 1404############################################################################### 1405 1406sub main () { 1407 1408 $filter = construct_filter($query); 1409 @attrs = construct_attrs(@attrs); 1410 @ctrls = gen_controls(); 1411 if (check_ctrls($server,$dse,@ctrls) == -1) { 1412 print "not all required LDAP Controls are supported by this server\n"; 1413 exit 1; 1414 } 1415 1416 if ($opt_dump_rootdse) { 1417 print "Dumping Root-DSE:\n"; 1418 display_entry_generic($dse); 1419 exit 0; 1420 } 1421 1422 if ($opt_dump_wknguid) { 1423 dump_wknguid(); 1424 exit 0; 1425 } 1426 1427 if (do_bind($async_ldap_hd, $sasl_bind) == -1) { 1428 exit 1; 1429 } 1430 1431 print_header(); 1432 1433 if ($opt_dump_schema) { 1434 print "Dumping Schema:\n"; 1435 my $ads_schema = $async_ldap_hd->schema; 1436 $ads_schema->dump; 1437 exit 0; 1438 } 1439 1440 while (1) { 1441 1442 $async_search = $async_ldap_hd->search( 1443 base => $base, 1444 filter => $filter, 1445 attrs => [ @attrs ], 1446 control => [ @ctrls ], 1447 callback => \&default_callback, 1448 scope => $scope, 1449 ) || die "cannot search"; 1450 1451 if ($opt_notify) { 1452 1453 print "[$base] is registered now for change-notify\n"; 1454 print "\nWaiting for change-notify...\n"; 1455 1456 my $sync_ldap_hd = get_ldap_hd($server,0); 1457 if (do_bind($sync_ldap_hd, $sasl_bind) == -1) { 1458 exit 2; 1459 } 1460 1461 my $sync_search = $sync_ldap_hd->search( 1462 base => $base, 1463 filter => $filter, 1464 attrs => [ @attrs ], 1465 callback => \¬ify_callback, 1466 scope => $scope, 1467 ) || die "cannot search"; 1468 1469 } 1470 1471 $total_entry_count += $async_search->count; 1472 ++$page_count; 1473 print "-" x 80 . "\n"; 1474 printf("Got %d Entries in Page %d \n\n", 1475 $async_search->count, $page_count); 1476 my ($resp) = $async_search->control( 1477 $ads_controls{'LDAP_PAGED_RESULT_OID_STRING'} ) or last; 1478 last unless ref $resp && $ctl_paged->cookie($resp->cookie); 1479 } 1480 1481 if ($async_search->entries == 0) { 1482 print "No entries found with filter $filter\n"; 1483 } else { 1484 print "Got $total_entry_count Entries in $page_count Pages\n" if ($paging); 1485 } 1486 1487 do_unbind() 1488} 1489 1490main(); 1491 1492exit 0; 1493