examples/misc/adssearch.pl

   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
  13 use strict;
  14
  15 use Net::LDAP;
  16 use Net::LDAP::Control;
  17 use Convert::ASN1;
  18 use Time::Local;
  19 use POSIX qw(strftime);
  20 use Getopt::Long;
  21
  22 my $have_sasl;
  23 my $works_sasl;
  24 my $pref_version;
  25 BEGIN {
  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
  37 my $base        = "";
  38 my $binddn      = "";
  39 my $password    = "";
  40 my $server      = "";
  41
  42 my $tdbdump     = "/usr/bin/tdbdump";
  43 my $testparm    = "/usr/bin/testparm";
  44 my $net         = "/usr/bin/net";
  45 my $dig         = "/usr/bin/dig";
  46 my $nmblookup   = "/usr/bin/nmblookup";
  47 my $secrets_tdb = "/etc/samba/secrets.tdb";
  48 my $klist       = "/usr/bin/klist";
  49 my $kinit       = "/usr/bin/kinit";
  50 my $ads_h       = "/home/gd/ads.h";
  51 my $page_size   = "1000";
  52 my $workgroup   = "";
  53 my $machine     = "";
  54 my $realm       = "";
  55
  56 # parse input
  57 my (
  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
  83 GetOptions(
  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
 111 my $paging      = 1 if !$opt_notify;
 112
 113 if (!@ARGV && !$opt_dump_schema && !$opt_dump_rootdse && !$opt_notify || $opt_help) {
 114         usage();
 115         exit 1;
 116 }
 117
 118 # get the query
 119 my $query       = shift;
 120 my @attrs       = @ARGV;
 121
 122 # some global vars
 123 my ($filter, $dse, $uri);
 124 my ($attr, $value);
 125 my (@ctrls, @ctrls_s);
 126 my ($ctl_paged, $cookie);
 127 my ($page_count, $total_entry_count);
 128 my ($sasl_hd, $async_ldap_hd, $sync_ldap_hd);
 129 my ($mesg, $usn);
 130 my (%entry_store);
 131 my $async_search;
 132 my (%ads_atype, %ads_gtype, %ads_uf);
 133
 134 # fixed values and vars
 135 my $set         = "X";
 136 my $unset       = "-";
 137
 138 # get defaults
 139 my $scope       = $opt_scope    || "sub";
 140 my $port        = $opt_port;
 141
 142 my %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
 166 my %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
 172 my %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
 179 my %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
 184 my %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
 191 my %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
 205 my %ads_mixed_domain = (
 206 "NATIVE_LEVEL_DOMAIN"                   => 0,
 207 "MIXED_LEVEL_DOMAIN"                    => 1,
 208 );
 209
 210 my %ads_ds_func = (
 211 "DS_BEHAVIOR_WIN2000"                   => 0,   # untested
 212 "DS_BEHAVIOR_WIN2003"                   => 2,
 213 );
 214
 215 my %ads_instance_type = (
 216 "DS_INSTANCETYPE_IS_NC_HEAD"            => 0x1,
 217 "IT_WRITE"                              => 0x4,
 218 "IT_NC_ABOVE"                           => 0x8,
 219 );
 220
 221 my %ads_uacc = (
 222         "ACCOUNT_NEVER_EXPIRES" => 0x000000, # 0
 223         "ACCOUNT_OK"            => 0x800000, # 8388608
 224         "ACCOUNT_LOCKED_OUT"    => 0x800010, # 8388624
 225 );
 226
 227 my %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
 253 parse_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
 257 get_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
 277 my @sasl_mechs  = get_sasl_mechs_from_rootdse($server,$dse);
 278 my $sasl_mech   = "GSSAPI";
 279 if ($opt_saslmech) {
 280         $sasl_mech = sprintf("%s", (check_sasl_mech($opt_saslmech) == 0)?uc($opt_saslmech):"");
 281 }
 282
 283 # set bind type
 284 my $sasl_bind = 1 if (!$opt_simpleauth);
 285
 286 # get username
 287 my $user        = check_user($opt_user) || $ENV{'USER'} || "";
 288
 289 # gen upn
 290 my $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;
 297 if (!$password) {
 298         $password = $opt_machine ? get_machine_password($workgroup) : get_password();
 299 }
 300
 301 my %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
 349 sub 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
 376 sub write_ads_list {
 377         my ($mod,$attr,$value) = @_;
 378         my $ofh = select(STDOUT);
 379         $~ = "ADS_LIST";
 380         select($ofh);
 381         write();
 382
 383 format ADS_LIST =
 384 @<<<< @>>>>>>>>>>>>>>>>>>>>>>>: @*
 385 $mod, $attr, $value
 386 .
 387 }
 388
 389 sub write_ads {
 390         my ($mod,$attr,$value) = @_;
 391         my $ofh = select(STDOUT);
 392         $~ = "ADS";
 393         select($ofh);
 394         write();
 395
 396 format ADS =
 397 @<<<< @>>>>>>>>>>>>>>>>>>>>>>>: ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 398 $mod, $attr, $value
 399 ~~                              ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 400                                 $value
 401 .
 402 }
 403
 404 sub 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
 444 sub 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
 469 sub 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
 478 sub get_password {
 479         if (!$password && $opt_simpleauth && check_ticket($user)) {
 480                 return prompt_password($user);
 481         }
 482         return "";
 483 }
 484
 485 sub get_user {
 486         my $user = shift || prompt_user();
 487         return $user;
 488 }
 489
 490 sub 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
 524 sub 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
 540 sub prompt_user {
 541
 542         print "Enter Username:";
 543         my $user = <STDIN>;
 544         chomp($user);
 545         print "\n";
 546         return $user;
 547 }
 548
 549 sub check_ticket {
 550         return system("$klist -t");
 551 }
 552
 553 sub 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
 570 sub check_user {
 571         my $acct = shift || "";
 572         if ($acct =~ /\%/) {
 573                 ($acct, $password) = split(/\%/, $acct);
 574         }
 575         return $acct;
 576 }
 577
 578 sub 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
 600 sub 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
 607 sub 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
 620 sub 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
 628 sub 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
 643 sub 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
 656 sub 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
 680 sub 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
 722 sub 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
 735 sub 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
 759 sub store_result ($) {
 760
 761         my $entry = shift;
 762         return if (!$entry);
 763         $entry_store{$entry->dn} = $entry;
 764 }
 765
 766 sub 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
 826 sub 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
 876 sub 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
 895 sub 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
 916 sub 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
 933 sub guid_to_bindstring {
 934         my $guid = shift;
 935         return unpack("H" . 2 * length($guid), $guid),
 936 }
 937
 938 sub 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
 955 sub 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
 965 sub 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
 973 sub 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
 990 sub 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
1010 sub dump_bitmask_and {
1011         return dump_bitmask("&",@_);
1012 }
1013
1014 sub dump_bitmask_equal {
1015         return dump_bitmask("==",@_);
1016 }
1017
1018 sub dump_uac {
1019         return dump_bitmask_and(@_,%ads_uf); # ads_uf ?
1020 }
1021
1022 sub dump_uacc {
1023         return dump_bitmask_equal(@_,%ads_uacc);
1024 }
1025
1026 sub dump_uf {
1027         return dump_bitmask_and(@_,%ads_uf);
1028 }
1029
1030 sub dump_gtype {
1031         return dump_bitmask_and(@_,%ads_gtype);
1032 }
1033
1034 sub dump_atype {
1035         return dump_bitmask_equal(@_,%ads_atype);
1036 }
1037
1038 sub dump_controls {
1039         return dump_equal(@_,%ads_controls);
1040 }
1041
1042 sub dump_capabilities {
1043         return dump_equal(@_,%ads_capabilities);
1044 }
1045
1046 sub dump_extension {
1047         return dump_equal(@_,%ads_extensions);
1048 }
1049
1050 sub dump_systemflags {
1051         return dump_bitmask_and(@_,%ads_systemflags);
1052 }
1053
1054 sub dump_instance_type {
1055         return dump_bitmask_and(@_,%ads_instance_type);
1056 }
1057
1058 sub dump_ds_func {
1059         return dump_bitmask_equal(@_,%ads_ds_func);
1060 }
1061
1062 sub dump_mixed_domain {
1063         return dump_bitmask_equal(@_,%ads_mixed_domain);
1064 }
1065
1066 sub dump_sid {
1067         my $bin_sid = shift;
1068         return sid2string($bin_sid);
1069 }
1070
1071 sub dump_guid {
1072         my $guid = shift;
1073         return guid_to_string($guid);
1074 }
1075
1076 sub dump_secdesc {
1077         my $val = shift;
1078         return "FIXME: write sddl-converter!";
1079 }
1080
1081 sub 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
1090 sub 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
1101 sub 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
1110 sub dump_string {
1111         return $_[0];
1112 }
1113
1114 sub dump_int {
1115         return sprintf("%d", $_[0]);
1116 }
1117
1118 sub dump_munged_dial {
1119         my $dial = shift;
1120         return "FIXME! decode this";
1121 }
1122
1123 sub 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
1140 sub 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
1165 sub 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
1184 sub 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
1226 sub 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
1239 sub 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
1252 sub 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
1262 sub 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
1274 sub 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
1303 sub default_callback {
1304
1305         my ($res,$obj) = @_;
1306
1307         if (!$opt_notify) {
1308                 return process_result($res,$obj);
1309         }
1310 }
1311
1312 sub 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
1327 sub 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
1361 sub 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
1395 sub 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
1406 sub 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 => \&notify_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
1490 main();
1491
1492 exit 0;