r12336: A couple of fixes and enhancements for adssearch.pl (espc. to debug
[bbaumbach/samba-autobuild/.git] / 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_asq,
59         $opt_base, 
60         $opt_binddn,
61         $opt_debug,
62         $opt_display_extendeddn,
63         $opt_display_metadata,
64         $opt_display_raw,
65         $opt_dump_rootdse,
66         $opt_dump_schema,
67         $opt_dump_wknguid,
68         $opt_help, 
69         $opt_host, 
70         $opt_machine,
71         $opt_notify, 
72         $opt_notify_nodiffs, 
73         $opt_password,
74         $opt_port,
75         $opt_realm,
76         $opt_saslmech,
77         $opt_scope, 
78         $opt_simpleauth,
79         $opt_starttls,
80         $opt_user,
81         $opt_verbose,
82         $opt_workgroup,
83 );
84
85 GetOptions(
86         'asq=s'         => \$opt_asq,
87         'base|b=s'      => \$opt_base,
88         'D|DN=s'        => \$opt_binddn,
89         'debug=i'       => \$opt_debug,
90         'extendeddn|e'  => \$opt_display_extendeddn,
91         'help'          => \$opt_help,
92         'host|h=s'      => \$opt_host,
93         'machine|P'     => \$opt_machine,
94         'metadata|m'    => \$opt_display_metadata,
95         'nodiffs'       => \$opt_notify_nodiffs,
96         'notify|n'      => \$opt_notify,
97         'password|w=s'  => \$opt_password,
98         'port=i'        => \$opt_port,
99         'rawdisplay'    => \$opt_display_raw,
100         'realm|R=s'     => \$opt_realm,
101         'rootDSE'       => \$opt_dump_rootdse,
102         'saslmech|Y=s'  => \$opt_saslmech,
103         'schema|c'      => \$opt_dump_schema,
104         'scope|s=s'     => \$opt_scope,
105         'simpleauth|x'  => \$opt_simpleauth,
106         'tls|Z'         => \$opt_starttls,
107         'user|U=s'      => \$opt_user,
108         'verbose|v'     => \$opt_verbose,
109         'wknguid'       => \$opt_dump_wknguid,
110         'workgroup|k=s' => \$opt_workgroup,
111         );
112
113
114 # activate controls
115 my $paging      = 1 if !$opt_notify;
116
117 if (!@ARGV && !$opt_dump_schema && !$opt_dump_rootdse && !$opt_notify || $opt_help) {
118         usage();
119         exit 1;
120 }
121
122 # get the query
123 my $query       = shift;
124 my @attrs       = @ARGV;
125
126 # some global vars
127 my ($filter, $dse, $uri);
128 my ($attr, $value);
129 my (@ctrls, @ctrls_s);
130 my ($ctl_paged, $cookie);
131 my ($page_count, $total_entry_count);
132 my ($sasl_hd, $async_ldap_hd, $sync_ldap_hd);
133 my ($mesg, $usn);
134 my (%entry_store);
135 my $async_search;
136 my (%ads_atype, %ads_gtype, %ads_grouptype, %ads_uf);
137
138 # fixed values and vars
139 my $set         = "X";
140 my $unset       = "-";
141 my $tabsize     = "\t\t\t";
142
143 # get defaults
144 my $scope       = $opt_scope    || "sub"; 
145 my $port        = $opt_port;
146
147 my %ads_controls = (
148 "LDAP_SERVER_NOTIFICATION_OID"          => "1.2.840.113556.1.4.528",
149 "LDAP_SERVER_EXTENDED_DN_OID"           => "1.2.840.113556.1.4.529",
150 "LDAP_PAGED_RESULT_OID_STRING"          => "1.2.840.113556.1.4.319",
151 "LDAP_SERVER_SD_FLAGS_OID"              => "1.2.840.113556.1.4.801",
152 "LDAP_SERVER_SORT_OID"                  => "1.2.840.113556.1.4.473",
153 "LDAP_SERVER_RESP_SORT_OID"             => "1.2.840.113556.1.4.474",
154 "LDAP_CONTROL_VLVREQUEST"               => "2.16.840.1.113730.3.4.9",
155 "LDAP_CONTROL_VLVRESPONSE"              => "2.16.840.1.113730.3.4.10",
156 "LDAP_SERVER_RANGE_RETRIEVAL"           => "1.2.840.113556.1.4.802", #unsure
157 "LDAP_SERVER_SHOW_DELETED_OID"          => "1.2.840.113556.1.4.417",
158 "LDAP_SERVER_CROSSDOM_MOVE_TARGET_OID"  => "1.2.840.113556.1.4.521",
159 "LDAP_SERVER_LAZY_COMMIT_OID"           => "1.2.840.113556.1.4.619",
160 "LDAP_SERVER_TREE_DELETE_OID"           => "1.2.840.113556.1.4.805",
161 "LDAP_SERVER_DIRSYNC_OID"               => "1.2.840.113556.1.4.841",
162 "LDAP_SERVER_VERIFY_NAME_OID"           => "1.2.840.113556.1.4.1338",
163 "LDAP_SERVER_DOMAIN_SCOPE_OID"          => "1.2.840.113556.1.4.1339",
164 "LDAP_SERVER_SEARCH_OPTIONS_OID"        => "1.2.840.113556.1.4.1340",
165 "LDAP_SERVER_PERMISSIVE_MODIFY_OID"     => "1.2.840.113556.1.4.1413",
166 "LDAP_SERVER_ASQ_OID"                   => "1.2.840.113556.1.4.1504",
167 "NONE (Get stats control)"              => "1.2.840.113556.1.4.970",
168 "LDAP_SERVER_QUOTA_CONTROL_OID"         => "1.2.840.113556.1.4.1852",
169 );
170
171 my %ads_capabilities = (
172 "LDAP_CAP_ACTIVE_DIRECTORY_OID"         => "1.2.840.113556.1.4.800",
173 "LDAP_CAP_ACTIVE_DIRECTORY_V51_OID"     => "1.2.840.113556.1.4.1670",
174 "LDAP_CAP_ACTIVE_DIRECTORY_LDAP_INTEG_OID" => "1.2.840.113556.1.4.1791",
175 );
176
177 my %ads_extensions = (
178 "LDAP_START_TLS_OID"                    => "1.3.6.1.4.1.1466.20037",
179 "LDAP_TTL_EXTENDED_OP_OID"              => "1.3.6.1.4.1.1466.101.119.1",
180 "LDAP_SERVER_FAST_BIND_OID"             => "1.2.840.113556.1.4.1781", 
181 "NONE (TTL refresh extended op)"        => "1.3.6.1.4.1.1466.101.119.1",
182 );
183
184 my %ads_matching_rules = (
185 "LDAP_MATCHING_RULE_BIT_AND"            => "1.2.840.113556.1.4.803",
186 "LDAP_MATCHING_RULE_BIT_OR"             => "1.2.840.113556.1.4.804",
187 );
188
189 my %wknguids = (
190 "WELL_KNOWN_GUID_COMPUTERS"             => "AA312825768811D1ADED00C04FD8D5CD",
191 "WELL_KNOWN_GUID_DOMAIN_CONTROLLERS"    => "A361B2FFFFD211D1AA4B00C04FD7D83A",
192 "WELL_KNOWN_GUID_SYSTEM"                => "AB1D30F3768811D1ADED00C04FD8D5CD",
193 "WELL_KNOWN_GUID_USERS"                 => "A9D1CA15768811D1ADED00C04FD8D5CD",
194 );
195
196 my %ads_systemflags = (
197 "FLAG_DONT_REPLICATE"                   => 0x00000001,  # 1
198 "FLAG_REPLICATE_TO_GC"                  => 0x00000002,  # 2
199 "FLAG_ATTRIBUTE_CONSTRUCT"              => 0x00000004,  # 4
200 "FLAG_CATEGORY_1_OBJECT"                => 0x00000010,  # 16
201 "FLAG_DELETE_WITHOUT_TOMBSTONE"         => 0x02000000,  # 33554432
202 "FLAG_DOMAIN_DISALLOW_MOVE"             => 0x04000000,  # 67108864
203 "FLAG_DOMAIN_DISALLOW_RENAME"           => 0x08000000,  # 134217728
204 #"FLAG_CONFIG_CAN_MOVE_RESTRICTED"      => 0x10000000,  # 268435456     # only setable on creation
205 #"FLAG_CONFIG_CAN_MOVE"                 => 0x20000000,  # 536870912     # only setable on creation
206 #"FLAG_CONFIG_CAN_RENAME"               => 0x40000000,  # 1073741824    # only setable on creation
207 "FLAG_DISALLOW_DELETE"                  => 0x80000000,  # 2147483648
208 );
209
210 my %ads_mixed_domain = (
211 "NATIVE_LEVEL_DOMAIN"                   => 0,
212 "MIXED_LEVEL_DOMAIN"                    => 1,
213 );
214
215 my %ads_ds_func = (
216 "DS_BEHAVIOR_WIN2000"                   => 0,   # untested
217 "DS_BEHAVIOR_WIN2003"                   => 2,
218 );
219
220 my %ads_instance_type = (
221 "DS_INSTANCETYPE_IS_NC_HEAD"            => 0x1,
222 "IT_WRITE"                              => 0x4,
223 "IT_NC_ABOVE"                           => 0x8,
224 );
225
226 my %ads_uacc = (
227         "ACCOUNT_NEVER_EXPIRES"         => 0x000000, # 0 
228         "ACCOUNT_OK"                    => 0x800000, # 8388608
229         "ACCOUNT_LOCKED_OUT"            => 0x800010, # 8388624
230 );
231
232 my %ads_gpoptions = (
233         "GPOPTIONS_INHERIT"             => 0,
234         "GPOPTIONS_BLOCK_INHERITANCE"   => 1,
235 );
236
237 my %ads_gplink_opts = (
238         "GPLINK_OPT_NONE"               => 0,
239         "GPLINK_OPT_DISABLED"           => 1,
240         "GPLINK_OPT_ENFORCED"           => 2,
241 );
242
243 my %ads_gpflags = (
244         "GPFLAGS_ALL_ENABLED"                   => 0,
245         "GPFLAGS_USER_SETTINGS_DISABLED"        => 1,
246         "GPFLAGS_MACHINE_SETTINGS_DISABLED"     => 2,
247         "GPFLAGS_ALL_DISABLED"                  => 3,
248 );
249
250 my %ads_serverstate = (
251         "SERVER_ENABLED"                => 1,
252         "SERVER_DISABLED"               => 2,
253 );
254
255 my %ads_sdeffective = (
256         "OWNER_SECURITY_INFORMATION"    => 0x01,
257         "DACL_SECURITY_INFORMATION"     => 0x04,
258         "SACL_SECURITY_INFORMATION"     => 0x10,
259 );
260
261 my %ads_trustattrs = (
262         "TRUST_ATTRIBUTE_NON_TRANSITIVE"        => 1,
263         "TRUST_ATTRIBUTE_TREE_PARENT"           => 2,
264         "TRUST_ATTRIBUTE_TREE_ROOT"             => 3,
265         "TRUST_ATTRIBUTE_UPLEVEL_ONLY"          => 4,
266 );
267
268 my %ads_trustdirection = (
269         "TRUST_DIRECTION_INBOUND"               => 1,
270         "TRUST_DIRECTION_OUTBOUND"              => 2,
271         "TRUST_DIRECTION_BIDIRECTIONAL"         => 3,
272 );
273
274 my %ads_trusttype = (
275         "TRUST_TYPE_DOWNLEVEL"                  => 1,
276         "TRUST_TYPE_UPLEVEL"                    => 2,
277         "TRUST_TYPE_KERBEROS"                   => 3,
278         "TRUST_TYPE_DCE"                        => 4,
279 );
280
281 my %ads_pwdproperties = (
282         "DOMAIN_PASSWORD_COMPLEX"               => 1, 
283         "DOMAIN_PASSWORD_NO_ANON_CHANGE"        => 2, 
284         "DOMAIN_PASSWORD_NO_CLEAR_CHANGE"       => 4, 
285         "DOMAIN_LOCKOUT_ADMINS"                 => 8, 
286         "DOMAIN_PASSWORD_STORE_CLEARTEXT"       => 16, 
287         "DOMAIN_REFUSE_PASSWORD_CHANGE"         => 32,
288 );
289
290 my %ads_uascompat = (
291         "LANMAN_USER_ACCOUNT_SYSTEM_NOLIMITS"   => 0,
292         "LANMAN_USER_ACCOUNT_SYSTEM_COMPAT"     => 1,
293 );
294
295 my %ads_frstypes = (
296         "REPLICA_SET_SYSVOL"            => 2,   # unsure
297         "REPLICA_SET_DFS"               => 1,   # unsure
298         "REPLICA_SET_OTHER"             => 0,   # unsure
299 );
300
301 my %ads_gp_cse_extensions = (
302 "Administrative Templates Extension"    => "35378EAC-683F-11D2-A89A-00C04FBBCFA2",
303 "Disk Quotas"                           => "3610EDA5-77EF-11D2-8DC5-00C04FA31A66",
304 "EFS Recovery"                          => "B1BE8D72-6EAC-11D2-A4EA-00C04F79F83A",
305 "Folder Redirection"                    => "25537BA6-77A8-11D2-9B6C-0000F8080861",
306 "IP Security"                           => "E437BC1C-AA7D-11D2-A382-00C04F991E27",
307 "Internet Explorer Maintenance"         => "A2E30F80-D7DE-11d2-BBDE-00C04F86AE3B",
308 "QoS Packet Scheduler"                  => "426031c0-0b47-4852-b0ca-ac3d37bfcb39",
309 "Scripts"                               => "42B5FAAE-6536-11D2-AE5A-0000F87571E3",
310 "Security"                              => "827D319E-6EAC-11D2-A4EA-00C04F79F83A",
311 "Software Installation"                 => "C6DC5466-785A-11D2-84D0-00C04FB169F7",
312 );
313
314 # guess work
315 my %ads_gpcextensions = (
316 "Administrative Templates"              => "0F6B957D-509E-11D1-A7CC-0000F87571E3",
317 "Certificates"                          => "53D6AB1D-2488-11D1-A28C-00C04FB94F17",
318 "EFS recovery policy processing"        => "B1BE8D72-6EAC-11D2-A4EA-00C04F79F83A",
319 "Folder Redirection policy processing"  => "25537BA6-77A8-11D2-9B6C-0000F8080861",
320 "Folder Redirection"                    => "88E729D6-BDC1-11D1-BD2A-00C04FB9603F",
321 "Registry policy processing"            => "35378EAC-683F-11D2-A89A-00C04FBBCFA2",
322 "Remote Installation Services"          => "3060E8CE-7020-11D2-842D-00C04FA372D4",
323 "Security Settings"                     => "803E14A0-B4FB-11D0-A0D0-00A0C90F574B",
324 "Security policy processing"            => "827D319E-6EAC-11D2-A4EA-00C04F79F83A",
325 "unknown"                               => "3060E8D0-7020-11D2-842D-00C04FA372D4",
326 "unknown2"                              => "53D6AB1B-2488-11D1-A28C-00C04FB94F17",
327 );
328
329 my %ads_gpo_default_guids = (
330 "Default Domain Policy"                 => "31B2F340-016D-11D2-945F-00C04FB984F9",
331 "Default Domain Controllers Policy"     => "6AC1786C-016F-11D2-945F-00C04fB984F9",
332 "mist"                                  => "61718096-3D3F-4398-8318-203A48976F9E",
333 );
334
335 my %munged_dial = (
336         "CtxCfgPresent"         => \&dump_int,
337         "CtxCfgFlags1"          => \&dump_int,
338         "CtxCallback"           => \&dump_string,
339         "CtxShadow"             => \&dump_string,
340         "CtxMaxConnectionTime"  => \&dump_int,
341         "CtxMaxDisconnectionTime"=> \&dump_int,
342         "CtxMaxIdleTime"        => \&dump_int,
343         "CtxKeyboardLayout"     => \&dump_int,
344         "CtxMinEncryptionLevel" => \&dump_int,
345         "CtxWorkDirectory"      => \&dump_string,
346         "CtxNWLogonServer"      => \&dump_string,
347         "CtxWFHomeDir"          => \&dump_string,
348         "CtxWFHomeDirDrive"     => \&dump_string,
349         "CtxWFProfilePath"      => \&dump_string,
350         "CtxInitialProgram"     => \&dump_string,
351         "CtxCallbackNumber"     => \&dump_string,
352 );
353
354 $SIG{__WARN__} = sub {
355         use Carp;
356         Carp::cluck (shift);
357 };
358
359 # parse ads.h
360 parse_ads_h();
361
362 # if there is data missing, we try to autodetect with samba-tools (if installed)
363 # this might fill up workgroup, machine, realm
364 get_samba_info();
365
366 # get a workgroup
367 $workgroup      = $workgroup || $opt_workgroup || "";
368
369 # get the server
370 $server         = process_servername($opt_host) || 
371                   detect_server($workgroup,$opt_realm) || 
372                   die "please define server to query with -h host\n";
373
374
375 # get the base
376 $base           = $opt_base || 
377                   get_base_from_rootdse($server,$dse);
378
379 # get the realm
380 $realm          = $opt_realm || 
381                   get_realm_from_rootdse($server,$dse);
382
383 # get sasl mechs
384 my @sasl_mechs  = get_sasl_mechs_from_rootdse($server,$dse);
385 my $sasl_mech   = "GSSAPI";
386 if ($opt_saslmech) {
387         $sasl_mech = sprintf("%s", (check_sasl_mech($opt_saslmech) == 0)?uc($opt_saslmech):"");
388 }
389
390 # set bind type
391 my $sasl_bind = 1 if (!$opt_simpleauth);
392
393 # get username
394 my $user        = check_user($opt_user) || $ENV{'USER'} || "";
395
396 # gen upn
397 my $upn         = sprintf("%s", gen_upn($opt_machine ? "$machine\$" : $user, $realm));
398
399 # get binddn
400 $binddn         = $opt_binddn || $upn;
401
402 # get the password
403 $password       = $password || $opt_password;
404 if (!$password) {
405         $password = $opt_machine ? get_machine_password($workgroup) : get_password();
406 }
407
408 my %attr_handler = (
409         "Token-Groups-No-GC-Acceptable" => \&dump_sid,  #wrong name
410         "accountExpires"                => \&dump_nttime,
411         "badPasswordTime"               => \&dump_nttime,                       
412         "creationTime"                  => \&dump_nttime,
413         "currentTime"                   => \&dump_timestr,
414         "domainControllerFunctionality" => \&dump_ds_func,
415         "domainFunctionality"           => \&dump_ds_func,
416         "fRSReplicaSetGUID"             => \&dump_guid,
417         "fRSReplicaSetType"             => \&dump_frstype,
418         "fRSVersionGUID"                => \&dump_guid,
419         "flags"                         => \&dump_gpflags,      # fixme: possibly only on gpos!
420         "forceLogoff"                   => \&dump_nttime_abs,
421         "forestFunctionality"           => \&dump_ds_func,
422 #       "gPCMachineExtensionNames"      => \&dump_gpcextensions,
423 #       "gPCUserExtensionNames"         => \&dump_gpcextensions,
424         "gPLink"                        => \&dump_gplink,
425         "gPOptions"                     => \&dump_gpoptions,
426         "groupType"                     => \&dump_gtype,
427         "instanceType"                  => \&dump_instance_type,
428         "lastLogon"                     => \&dump_nttime,
429         "lastLogonTimestamp"            => \&dump_nttime,
430         "lockOutObservationWindow"      => \&dump_nttime_abs,
431         "lockoutDuration"               => \&dump_nttime_abs,
432         "lockoutTime"                   => \&dump_nttime,
433 #       "logonHours"                    => \&dump_logonhours,
434         "maxPwdAge"                     => \&dump_nttime_abs,
435         "minPwdAge"                     => \&dump_nttime_abs,
436         "modifyTimeStamp"               => \&dump_timestr,
437         "msDS-Behavior-Version"         => \&dump_ds_func,      #unsure
438         "msDS-User-Account-Control-Computed" => \&dump_uacc,
439 #       "msRADIUSFramedIPAddress"       => \&dump_ipaddr,
440 #       "msRASSavedFramedIPAddress"     => \&dump_ipaddr,
441         "nTMixedDomain"                 => \&dump_mixed_domain,
442         "nTSecurityDescriptor"          => \&dump_secdesc,
443         "objectGUID"                    => \&dump_guid,
444         "objectSid"                     => \&dump_sid,
445         "pKT"                           => \&dump_pkt,
446         "pKTGuid"                       => \&dump_guid,
447         "pwdLastSet"                    => \&dump_nttime,
448         "pwdProperties"                 => \&dump_pwdproperties,
449         "sAMAccountType"                => \&dump_atype,
450         "sDRightsEffective"             => \&dump_sdeffective,
451         "securityIdentifier"            => \&dump_sid,
452         "serverState"                   => \&dump_serverstate,
453         "supportedCapabilities",        => \&dump_capabilities,
454         "supportedControl",             => \&dump_controls,
455         "supportedExtension",           => \&dump_extension,
456         "systemFlags"                   => \&dump_systemflags,
457         "tokenGroups",                  => \&dump_sid,
458         "tokenGroupsGlobalAndUniversal" => \&dump_sid,
459         "trustAttributes"               => \&dump_trustattr,
460         "trustDirection"                => \&dump_trustdirection,
461         "trustType"                     => \&dump_trusttype,
462         "uASCompat"                     => \&dump_uascompat,
463         "userAccountControl"            => \&dump_uac,
464         "userCertificate"               => \&dump_cert,
465         "userFlags"                     => \&dump_uf,
466         "userParameters"                => \&dump_munged_dial,
467         "whenChanged"                   => \&dump_timestr,
468         "whenCreated"                   => \&dump_timestr,
469 #       "dSCorePropagationData"         => \&dump_timestr,
470 );
471
472
473
474 ################
475 # subfunctions #
476 ################
477
478 sub usage {
479         print "usage: $0 [--asq] [--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";
480         print "\t--asq [attribute]\n\t\tAttribute to use for a attribute scoped query (LDAP_SERVER_ASQ_OID)\n";
481         print "\t--base|-b [base]\n\t\tUse base [base]\n";
482         print "\t--debug [level]\n\t\tUse debuglevel (for Net::LDAP)\n";
483         print "\t--DN|-D [binddn]\n\t\tUse binddn or principal\n";
484         print "\t--extendeddn|-e\n\t\tDisplay extended dn (LDAP_SERVER_EXTENDED_DN_OID)\n";
485         print "\t--help\n\t\tDisplay help page\n";
486         print "\t--host|-h [host]\n\t\tQuery Host [host] (either a hostname or an LDAP uri)\n";
487         print "\t--machine|-P\n\t\tUse samba3 machine account stored in $secrets_tdb (needs root access)\n";
488         print "\t--metdata|-m\n\t\tDisplay replication metadata\n";
489         print "\t--nodiffs\n\t\tDisplay no diffs but full entry dump when running in notify mode\n";
490         print "\t--notify|-n\n\t\tActivate asynchronous change notification (LDAP_SERVER_NOTIFICATION_OID)\n";
491         print "\t--password|-w [password]\n\t\tUse [password] for binddn\n";
492         print "\t--port [port]\n\t\tUse [port] when connecting ADS\n";
493         print "\t--rawdisplay\n\t\tDo not interpret values\n";
494         print "\t--realm|-R [realm]\n\t\tUse [realm] when trying to construct bind-principal\n";
495         print "\t--rootdse\n\t\tDisplay RootDSE (anonymously)\n";
496         print "\t--saslmech|-Y [saslmech]\n\t\tUse SASL Mechanism [saslmech] when binding\n";
497         print "\t--schema|-c\n\t\tDisplay DSE-Schema\n";
498         print "\t--scope|-s [scope]\n\t\tUse scope [scope] (sub, base, one)\n";
499         print "\t--simpleauth|-x\n\t\tUse simple bind (otherwise SASL binds are performed)\n";
500         print "\t--starttls|-Z\n\t\tUse Start TLS extended operation to secure LDAP traffic\n";
501         print "\t--user|-U [user]\n\t\tUse [user]\n";
502         print "\t--wknguid\n\t\tDisplay well known guids\n";
503         print "\t--workgroup|-k [workgroup]\n\t\tWhen LDAP-Server is not known try to find a Domain-Controller for [workgroup]\n";
504 }
505
506 sub write_ads_list {
507         my ($mod,$attr,$value) = @_;
508         my $ofh = select(STDOUT);
509         $~ = "ADS_LIST";
510         select($ofh);
511         write();
512
513 format ADS_LIST =
514 @<<<< @>>>>>>>>>>>>>>>>>>>>>>>: @*
515 $mod, $attr, $value
516 .
517 }
518
519 sub write_ads {
520         my ($mod,$attr,$value) = @_;
521         my $ofh = select(STDOUT);
522         $~ = "ADS";
523         select($ofh);
524         write();
525
526 format ADS =
527 @<<<< @>>>>>>>>>>>>>>>>>>>>>>>: ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
528 $mod, $attr, $value
529 ~~                              ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
530                                 $value
531 .
532 }
533
534 sub detect_server {
535
536         my $workgroup = shift;
537         my $realm = shift;
538         my $result;
539         my $found;
540
541         # try net cache (nbt records)
542         if ( -x $net && $workgroup ) {
543                 my $key = sprintf("NBT/%s#1C", uc($workgroup));
544                 chomp($result = `$net cache search $key 2>&1 /dev/null`);
545                 $result =~ s/^.*Value: //;
546                 $result =~ s/:.*//;
547                 return $result if $result;
548                 printf("%10s query failed for [%s]\n", "net cache", $key);
549         }
550
551         # try dns SRV entries
552         if ( -x $dig && $realm ) {
553                 my $key = sprintf("_ldap._tcp.%s", lc($realm));
554                 chomp($result = `$dig $key SRV +short +search | egrep "^[0-9]" | head -1`);
555                 $result =~ s/.* //g;
556                 $result =~ s/.$//g;
557                 return $result if $result;
558                 printf("%10s query failed for [%s]\n", "dns", $key);
559         }
560
561         # try netbios broadcast query
562         if ( -x $nmblookup && $workgroup ) {
563                 my $key = sprintf("%s#1C", uc($workgroup));
564                 my $pattern = sprintf("%s<1c>", uc($workgroup));
565                 chomp($result = `$nmblookup $key -d 0 | grep '$pattern'`);
566                 $result =~ s/\s.*//;
567                 return $result if $result;
568                 printf("%10s query failed for [%s]\n", "nmblookup", $key);
569         }
570
571         return "";
572 }
573
574 sub get_samba_info {
575
576         if (! -x $testparm) { return -1; }
577         
578         my $tmp;
579         open(TESTPARM, "$testparm -s -v 2> /dev/null |");
580         while (my $line = <TESTPARM>) {
581                 chomp($line);
582                 if ($line =~ /netbios name/) {
583                         ($tmp, $machine) = split(/=/, $line);
584                         $machine =~ s/\s+|\t+//g;
585                 }
586                 if ($line =~ /realm/) {
587                         ($tmp, $realm) = split(/=/, $line);
588                         $realm =~ s/\s+|\t+//g;
589                 }
590                 if ($line =~ /workgroup/) {
591                         ($tmp, $workgroup) = split(/=/, $line);
592                         $workgroup =~ s/\s+|\t+//g;
593                 }
594         }
595         close(TESTPARM);
596         return 0;
597 }
598
599 sub gen_upn {
600         my $machine = shift;
601         my $realm = shift;
602         if ($machine && $realm) {
603                 return sprintf("%s\@%s", lc($machine), uc($realm));
604         };
605         return undef;
606 }
607
608 sub get_password {
609         if (!$password && $opt_simpleauth && check_ticket($user)) {
610                 return prompt_password($user);
611         }
612         return "";
613 }
614
615 sub get_user {
616         my $user = shift || prompt_user();
617         return $user;
618 }
619
620 sub get_machine_password {
621
622         my $workgroup = shift || "";
623         $workgroup = uc($workgroup);
624
625         my ($found, $tmp);
626         -x $tdbdump || die "tdbdump is not installed. cannot proceed autodetection\n";
627         -r $secrets_tdb || die "cannot read $secrets_tdb. cannot proceed autodetection\n";
628
629         # get machine-password
630         my $key = sprintf("SECRETS/MACHINE_PASSWORD/%s", $workgroup);
631         open(SECRETS,"$tdbdump $secrets_tdb |");
632         while(my $line = <SECRETS>) {
633                 chomp($line);
634                 if ($found) {
635                         $line =~ s/\\00//;
636                         ($line,$password) = split(/"/, $line);
637                         last;
638                 }
639                 if ($line =~ /$key/) {
640                         $found = 1;
641                 }
642         }
643         close(SECRETS);
644
645         if ($found) {
646                 print "Successfully autodetected machine password for workgroup: $workgroup\n";
647                 return $password;
648         } else {
649                 warn "No machine password available for $workgroup\n";
650         }
651         return "";
652 }
653
654 sub prompt_password {
655
656         my $acct = shift || "";
657         if ($acct =~ /\%/) {
658                 ($acct, $password) = split(/\%/, $acct);
659                 return $password;
660         }
661         system "stty -echo";
662         print "Enter password for $acct:";
663         my $password = <STDIN>;
664         chomp($password);
665         print "\n";
666         system "stty echo";
667         return $password;
668 }
669
670 sub prompt_user {
671
672         print "Enter Username:";
673         my $user = <STDIN>;
674         chomp($user);
675         print "\n";
676         return $user;
677 }
678
679 sub check_ticket {
680         return 0;
681         # works only for heimdal
682         return system("$klist -t");
683 }
684
685 sub get_ticket {
686
687         my $KRB5_CONFIG = "/tmp/.krb5.conf.telads-$<";
688
689         open(KRB5CONF, "> $KRB5_CONFIG") || die "cannot write $KRB5_CONFIG";
690         printf  KRB5CONF "# autogenerated by $0\n";
691         printf  KRB5CONF "[libdefaults]\n\tdefault_realm = %s\n\tclockskew = %d\n", uc($realm), 60*60;
692         printf  KRB5CONF "[realms]\n\t%s = {\n\t\tkdc = %s\n\t}\n", uc($realm), $server;
693         close(KRB5CONF);
694
695         if ( system("KRB5_CONFIG=$KRB5_CONFIG $kinit $user") != 0) {
696                 return -1;
697         }
698
699         return 0;
700 }
701
702 sub check_user {
703         my $acct = shift || "";
704         if ($acct =~ /\%/) {
705                 ($acct, $password) = split(/\%/, $acct);
706         }
707         return $acct;
708 }
709
710 sub check_ctrls ($$@) {
711
712         # bogus function??
713         my $server = shift || "";
714         $dse = shift || get_dse($server) || return -1;
715         my @ctrls = @_;
716
717         my $dse_controls = $dse->get_value('supportedControl', asref => '1');
718         my @dse_controls = @$dse_controls;
719
720         foreach my $i (@ctrls) {
721                 # we could use -> supported_control but this 
722                 # is only available in newer versions of perl-ldap
723 #               if ( ! $dse->supported_control( $i ) ) {
724                 if ( grep(/$i->type()/, @dse_controls) ) { 
725                         printf("required control: %s is not supported by ADS-server.\n", $i->type());
726                         return -1;
727                 }
728         }
729         return 0;
730 }
731
732 sub get_base_from_rootdse {
733
734         my $server = shift || "";
735         $dse = shift || get_dse($server,$async_ldap_hd) || return -1;
736         return $dse->get_value('defaultNamingContext');
737 }
738
739 sub get_realm_from_rootdse {
740
741         my $server = shift || "";
742         $dse = shift || get_dse($server,$async_ldap_hd) || return -1;
743         my $service = $dse->get_value('ldapServiceName') || "";
744         if ($service) {
745                 my ($t,$realm) = split(/\@/, $service);
746                 return $realm;
747         } else {
748                 die "very odd: could not get realm";
749         }
750 }
751
752 sub get_sasl_mechs_from_rootdse {
753
754         my $server = shift || "";
755         $dse = shift || get_dse($server,$async_ldap_hd) || return -1;
756         my $mechs = $dse->get_value('supportedSASLMechanisms', asref => 1);
757         return @$mechs;
758 }
759
760 sub get_dse {
761
762         my $server = shift || return undef;
763         $async_ldap_hd = shift || get_ldap_hd($server,1);
764         if (!$async_ldap_hd) {
765                 print "oh, no connection\n";
766                 return undef;
767         }
768         my $mesg = $async_ldap_hd->bind() || die "cannot bind\n";
769         if ($mesg->code) { die "failed to bind\n"; };
770         my $dse = $async_ldap_hd->root_dse( attrs => ['*', "supportedExtension", "supportedFeatures" ] );
771
772         return $dse;
773 }
774
775 sub process_servername {
776
777         my $name = shift || return "";
778         if ($name =~ /^ldaps:\/\//i ) {
779                 $name =~ s#^ldaps://##i;
780                 $uri = sprintf("%s://%s", "ldaps", $name);
781         } else {
782                 $name =~ s#^ldap://##i;
783                 $uri = sprintf("%s://%s", "ldap", $name);
784         }
785         return $name;
786 }
787
788 sub get_ldap_hd {
789
790         my $server = shift || return undef;
791         my $async = shift || "0";
792         my $hd;
793         die "uri unavailable" if (!$uri);
794         if ($uri =~ /^ldaps:\/\//i ) {
795                 $port = $port || 636;
796                 use Net::LDAPS;
797                 $hd = Net::LDAPS->new( $server, async => $async, port => $port ) || 
798                         die "host $server not available: $!";
799         } else {
800                 $port = $port || 389;
801                 $hd = Net::LDAP->new( $server, async => $async, port => $port ) || 
802                         die "host $server not available: $!";
803         }
804         $hd->debug($opt_debug);
805         if ($opt_starttls) {
806                 $hd->start_tls( verify => 'none' );
807         }
808
809         return $hd;
810 }
811
812 sub get_sasl_hd {
813
814         if (!$have_sasl) {
815                 print "no sasl support\n";
816                 return undef;
817         }
818
819         my $hd;
820         if ($sasl_mech && $sasl_mech eq "GSSAPI") {
821                 my $user = sprintf("%s\@%s", $user, uc($realm));
822                 if (check_ticket($user) != 0 && get_ticket($user) != 0) {
823                         print "Could not get Kerberos ticket for user [$user]\n";
824                         return undef;
825                 }
826
827                 $hd = Authen::SASL->new( mechanism => 'GSSAPI' ) || die "nope";
828                 my $conn = $hd->client_new("ldap", $server);
829                 
830                 if ($conn->code == -1) {
831                         printf "%s\n", $conn->error();
832                         return undef;
833                 };
834
835         } elsif ($sasl_mech) {
836
837                 # here comes generic sasl code
838                 $hd = Authen::SASL->new( mechanism => $sasl_mech, 
839                         callback  => { 
840                                 user => \&get_user, 
841                                 pass => \&get_password 
842                         } 
843                 ) || die "nope";
844         } else {
845                 $sasl_bind = 0;
846                 print "no supported SASL mechanism found (@sasl_mechs).\n";
847                 print "falling back to simple bind.\n";
848                 return undef;
849         }
850
851         return $hd;
852 }
853
854 sub check_sasl_mech {
855         my $mech_check = shift;
856         my $have_mech = 0;
857         foreach my $mech (@sasl_mechs) {
858                 $have_mech = 1 if ($mech eq uc($mech_check));
859         }
860         if (!$have_mech) {
861                 return -1;
862         }
863         return 0;
864 }
865
866
867 sub parse_ads_h {
868
869         -e "$ads_h" || die "cannot open samba3 ads.h ($ads_h): $!";
870         open(ADSH,"$ads_h");
871         while (my $line = <ADSH>) {
872                 chomp($line);
873                 if ($line =~ /#define.UF.*0x/) {
874                         my ($tmp, $name, $val) = split(/\s+/,$line);
875                         next if ($name =~ /UNUSED/);
876 #                       $ads_uf{$name} = sprintf("%d", hex $val);
877                         $ads_uf{$name} = hex $val;
878                 }
879                 if ($line =~ /#define.GROUP_TYPE.*0x/) {
880                         my ($tmp, $name, $val) = split(/\s+/,$line);
881                         $ads_grouptype{$name} = hex $val;
882                 }
883                 if ($line =~ /#define.ATYPE.*0x/) {
884                         my ($tmp, $name, $val) = split(/\s+/,$line);
885                         $ads_atype{$name} = 
886                                 (exists $ads_atype{$val}) ? $ads_atype{$val} : hex $val;
887                 }
888                 if ($line =~ /#define.GTYPE.*0x/) {
889                         my ($val, $i);
890                         my ($tmp, $name, @val) = split(/\s+/,$line);
891                         foreach my $tempval (@val) {
892                                 if ($tempval =~ /^0x/) {
893                                         $val = $tempval;
894                                         last;
895                                 }
896                         }
897                         next if (!$val);
898                         $ads_gtype{$name} = sprintf("%d", hex $val);
899                 }
900
901         }
902         close(ADSH);
903 }
904
905 sub store_result ($) {
906
907         my $entry = shift;
908         return if (!$entry);
909         $entry_store{$entry->dn} = $entry;
910 }
911
912 sub display_result_diff ($) {
913
914         my $entry_new = shift;
915         return if ( !$entry_new);
916
917         if ( !exists $entry_store{$entry_new->dn}) {
918                 print "can't display any differences yet. full dump...\n";
919                 display_entry_generic($entry_new);
920                 return;
921         }
922
923         my $entry_old = $entry_store{$entry_new->dn};
924
925         foreach my $attr (sort $entry_new->attributes) {
926                 if ( $entry_new->exists($attr) && ! $entry_old->exists($attr)) {
927                         display_attr_generic("add:\t", $entry_new, $attr);
928                         next;
929                 }
930         }
931
932         foreach my $attr (sort $entry_old->attributes) {
933                 if (! $entry_new->exists($attr) && $entry_old->exists($attr)) {
934                         display_attr_generic("del:\t", $entry_old, $attr);
935                         next;
936                 }
937
938                 # now check for all values if they have changed, display changes
939                 my ($old_vals, $new_vals, @old_vals, @new_vals, %old, %new);
940
941                 $old_vals = $entry_old->get_value($attr, asref => 1);
942                 @old_vals = @$old_vals;
943                 $new_vals = $entry_new->get_value($attr, asref => 1);
944                 @new_vals = @$new_vals;
945
946                 if (scalar(@old_vals) == 1 && scalar(@new_vals) == 1) {
947                         if ($old_vals[0] ne $new_vals[0]) {
948                                 display_attr_generic("old:\t", $entry_old, $attr);
949                                 display_attr_generic("new:\t", $entry_new, $attr);
950                         }
951                         next;
952                 }
953
954                 # handle multivalued diffs
955                 foreach my $val (@old_vals) { $old{$val} = "dummy"; };
956                 foreach my $val (@new_vals) { $new{$val} = "dummy"; };
957                 foreach my $val (sort keys %new) {
958                         if (!exists $old{$val}) {
959                                 display_value_generic("add:\t", $attr, $val);
960                         }
961                 }
962                 foreach my $val (sort keys %old) {
963                         if (!exists $new{$val}) {
964                                 display_value_generic("del:\t", $attr, $val);
965                         }
966                 }
967         }
968         print "\n";
969
970 }
971
972 sub sid2string ($) {
973
974         # Fix from Michael James <michael@james.st>
975         my $binary_sid = shift;
976         my($sid_rev, $num_auths, $id1, $id2, @ids) = unpack("H2 H2 n N V*", $binary_sid);
977         my $sid_string = join("-", "S", hex($sid_rev), ($id1<<32)+$id2, @ids);
978         return $sid_string;
979                         
980 }
981
982 sub string_to_guid {
983         my $string = shift;
984         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;
985         
986         return  pack("I", hex $1) . 
987                 pack("S", hex $2) . 
988                 pack("S", hex $3) . 
989                 pack("C", hex $4) . 
990                 pack("C", hex $5) .
991                 pack("C", hex $6) . 
992                 pack("C", hex $7) . 
993                 pack("C", hex $8) . 
994                 pack("C", hex $9) . 
995                 pack("C", hex $10) . 
996                 pack("C", hex $11);
997
998 #       print "$1\n$2\n$3\n$4\n$5\n$6\n$7\n$8\n$9\n$10\n$11\n";
999 }
1000                                                                
1001 sub bindstring_to_guid {
1002         my $str = shift;
1003         return pack("H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2 H2", 
1004                 substr($str,0,2),
1005                 substr($str,2,2),
1006                 substr($str,4,2),
1007                 substr($str,6,2),
1008                 substr($str,8,2),
1009                 substr($str,10,2),
1010                 substr($str,12,2),
1011                 substr($str,14,2),
1012                 substr($str,16,2),
1013                 substr($str,18,2),
1014                 substr($str,20,2),
1015                 substr($str,22,2),
1016                 substr($str,24,2),
1017                 substr($str,26,2),
1018                 substr($str,28,2),
1019                 substr($str,30,2));
1020 }
1021
1022 sub guid_to_string {
1023         my $guid = shift;
1024         my $string = sprintf "%08X-%04X-%04X-%02X%02X-%02X%02X%02X%02X%02X%02X", 
1025                 unpack("I", $guid), 
1026                 unpack("S", substr($guid, 4, 2)), 
1027                 unpack("S", substr($guid, 6, 2)),
1028                 unpack("C", substr($guid, 8, 1)),
1029                 unpack("C", substr($guid, 9, 1)),
1030                 unpack("C", substr($guid, 10, 1)),
1031                 unpack("C", substr($guid, 11, 1)),
1032                 unpack("C", substr($guid, 12, 1)),
1033                 unpack("C", substr($guid, 13, 1)),
1034                 unpack("C", substr($guid, 14, 1)),
1035                 unpack("C", substr($guid, 15, 1)); 
1036         return lc($string);
1037 }
1038
1039 sub guid_to_bindstring {
1040         my $guid = shift;
1041         return unpack("H" . 2 * length($guid), $guid),
1042 }
1043
1044 sub dump_wknguid {
1045         print "Dumping Well known GUIDs:\n";
1046         foreach my $wknguid (keys %wknguids) {
1047
1048                 my $guid = bindstring_to_guid($wknguids{$wknguid});
1049                 my $str  = guid_to_string($guid);
1050                 my $back = guid_to_bindstring($guid);
1051
1052                 printf "wkguid:             %s\n", $wknguid;
1053                 printf "bind_string format: %s\n", $wknguids{$wknguid};
1054                 printf "string format:      %s\n", guid_to_string($guid);
1055                 printf "back to bind_string:%s\n", guid_to_bindstring($guid);
1056                                 
1057                 printf "use base: \"<WKGUID=%s,%s>\"\n", guid_to_bindstring($guid), $base;
1058         }
1059 }
1060
1061 sub gen_bitmask_string_format($%) {
1062         my $mod = shift;
1063         my (%tmp) = @_;
1064         my @list;
1065         foreach my $key (sort keys %tmp) {
1066                 push(@list, sprintf("%s %s", $tmp{$key}, $key));
1067         }
1068         return join("\n$mod$tabsize",@list);
1069 }
1070
1071
1072 sub nt_to_unixtime ($) {
1073         # the number of 100 nanosecond intervals since jan. 1. 1601 (utc)
1074         my $t64 = shift;
1075         $t64 =~ s/(.+).{7,7}/$1/;
1076         $t64 -= 11644473600;
1077         return $t64;
1078 }
1079
1080 sub dump_equal {
1081         my $val = shift;
1082         my $mod = shift || die "no mod";
1083         my (%header) = @_;
1084         my %tmp;
1085         my $found = 0;
1086         foreach my $key (keys %header) {
1087                 if ($header{$key} eq $val) {
1088                         $tmp{"($val)"} = $key;
1089                         $found = 1;
1090                         last;
1091                 }
1092         }
1093         if (!$found) { $tmp{$val} = ""; };
1094         return gen_bitmask_string_format($mod,%tmp);
1095 }
1096
1097 sub dump_bitmask {
1098         my $op = shift || die "no op";
1099         my $val = shift; 
1100         my $mod = shift || die "no mod";
1101         my (%header) = @_;
1102         my %tmp;
1103         $tmp{""} = $val;
1104         foreach my $key (sort keys %header) {   # sort by val !
1105                 if ($op eq "&") {
1106                         $tmp{$key} = ( $val & $header{$key} ) ? $set:$unset; 
1107                 } elsif ($op eq "==") {
1108                         $tmp{$key} = ( $val == $header{$key} ) ? $set:$unset; 
1109                 } else {
1110                         print "unknown operator: $op\n";
1111                         return;
1112                 }
1113         }
1114         return gen_bitmask_string_format($mod,%tmp);
1115 }
1116
1117 sub dump_bitmask_and {
1118         return dump_bitmask("&",@_);
1119 }
1120
1121 sub dump_bitmask_equal {
1122         return dump_bitmask("==",@_);
1123 }
1124
1125 sub dump_uac {
1126         return dump_bitmask_and(@_,%ads_uf); # ads_uf ?
1127 }
1128
1129 sub dump_uascompat {
1130         return dump_bitmask_equal(@_,%ads_uascompat);
1131 }
1132
1133 sub dump_gpoptions {
1134         return dump_bitmask_equal(@_,%ads_gpoptions);
1135 }
1136
1137 sub dump_gpflags {
1138         return dump_bitmask_equal(@_,%ads_gpflags);
1139 }
1140
1141 sub dump_uacc {
1142         return dump_bitmask_equal(@_,%ads_uacc); 
1143 }
1144
1145 sub dump_uf {
1146         return dump_bitmask_and(@_,%ads_uf);
1147 }
1148
1149 sub dump_gtype {
1150         my $ret = dump_bitmask_and(@_,%ads_grouptype);
1151         $ret .= "\n$tabsize\t";
1152         $ret .= dump_bitmask_equal(@_,%ads_gtype);
1153         return $ret;
1154 }
1155
1156 sub dump_atype {
1157         return dump_bitmask_equal(@_,%ads_atype);
1158 }
1159
1160 sub dump_controls {
1161         return dump_equal(@_,%ads_controls);
1162 }
1163
1164 sub dump_capabilities {
1165         return dump_equal(@_,%ads_capabilities);
1166 }
1167
1168 sub dump_extension {
1169         return dump_equal(@_,%ads_extensions);
1170 }
1171
1172 sub dump_systemflags {
1173         return dump_bitmask_and(@_,%ads_systemflags);
1174 }
1175
1176 sub dump_instance_type {
1177         return dump_bitmask_and(@_,%ads_instance_type);
1178 }
1179
1180 sub dump_ds_func {
1181         return dump_bitmask_equal(@_,%ads_ds_func);
1182 }
1183
1184 sub dump_serverstate {
1185         return dump_bitmask_equal(@_,%ads_serverstate);
1186 }
1187
1188 sub dump_sdeffective {
1189         return dump_bitmask_and(@_,%ads_sdeffective);
1190 }
1191
1192 sub dump_trustattr {
1193         return dump_bitmask_equal(@_,%ads_trustattrs);
1194 }
1195
1196 sub dump_trusttype {
1197         return dump_bitmask_equal(@_,%ads_trusttype);
1198 }
1199
1200 sub dump_trustdirection {
1201         return dump_bitmask_equal(@_,%ads_trustdirection);
1202 }
1203
1204 sub dump_pwdproperties {
1205         return dump_bitmask_and(@_,%ads_pwdproperties);
1206 }
1207
1208 sub dump_frstype {
1209         return dump_bitmask_equal(@_,%ads_frstypes)
1210 }
1211
1212 sub dump_mixed_domain {
1213         return dump_bitmask_equal(@_,%ads_mixed_domain);
1214 }
1215
1216 sub dump_sid {
1217         my $bin_sid = shift;
1218         return sid2string($bin_sid);
1219 }
1220
1221 sub dump_guid {
1222         my $guid = shift;
1223         return guid_to_string($guid);
1224 }
1225
1226 sub dump_secdesc {
1227         my $val = shift;
1228         return "FIXME: write sddl-converter!";
1229 }
1230
1231 sub dump_nttime {
1232         my $nttime = shift;
1233         if ($nttime == 0) {
1234                 return sprintf("%s (%s)", "never", $nttime);
1235         }
1236         my $localtime = localtime(nt_to_unixtime($nttime));
1237         return sprintf("%s (%s)", $localtime, $nttime);
1238 }
1239
1240 sub dump_nttime_abs {
1241         if ($_[0] == 9223372036854775807) {
1242                 return sprintf("%s (%s)", "now", $_[0]);
1243         }
1244         if ($_[0] == -9223372036854775808 || $_[0] == 0) { # 0x7FFFFFFFFFFFFFFF
1245                 return sprintf("%s (%s)", "never", $_[0]);
1246         }
1247         # FIXME: actually *do* abs time !
1248         return dump_nttime($_[0]);
1249 }
1250
1251 sub dump_timestr {
1252         my $time = shift;
1253         if ($time eq "16010101000010.0Z") {
1254                 return sprintf("%s (%s)", "never", $time);
1255         }
1256         my ($year,$mon,$mday,$hour,$min,$sec,$zone) = 
1257                 unpack('a4 a2 a2 a2 a2 a2 a4', $time);
1258         $mon -= 1;
1259         my $localtime = localtime(timegm($sec,$min,$hour,$mday,$mon,$year));
1260         return sprintf("%s (%s)", $localtime, $time);
1261 }
1262
1263 sub dump_string {
1264         return $_[0];
1265 }
1266
1267 sub dump_int {
1268         return sprintf("%d", $_[0]);
1269 }
1270
1271 sub dump_munged_dial {
1272         my $dial = shift;
1273         return "FIXME! decode this";
1274 }
1275
1276 sub dump_cert {
1277  
1278         my $cert = shift;
1279         open(OPENSSL, "| /usr/bin/openssl x509 -text -inform der");
1280         print OPENSSL $cert;
1281         close(OPENSSL);
1282         return "";
1283 }
1284
1285 sub dump_pkt {
1286         my $pkt = shift;
1287         return "not yet";
1288         printf("%s: ", $pkt);
1289         printf("%02X", $pkt);
1290         
1291 }
1292
1293 sub dump_gplink {
1294
1295         my $gplink = shift;
1296         my $gplink_mod = $gplink;
1297         my @links = split("\\]\\[", $gplink_mod);
1298         foreach my $link (@links) {
1299                 $link =~ s/^\[|\]$//g;
1300                 my ($ldap_link, $opt) = split(";", $link);
1301                 my @array = ( "$opt", "\t" );
1302                 printf("%slink: %s, opt: %s\n", $tabsize, $ldap_link, dump_bitmask_and(@array, %ads_gplink_opts));
1303         }
1304         return $gplink;
1305 }
1306
1307 sub construct_filter {
1308
1309         my $tmp = shift;
1310
1311         if (!$tmp || $opt_notify) {
1312                 return "(objectclass=*)";
1313         }
1314
1315         if ($tmp && $tmp !~ /^.*\=/) {
1316                 return "(ANR=$tmp)";
1317         }
1318
1319         return $tmp;
1320         # (&(objectCategory=person)
1321         # (userAccountControl:$ads_matching_rules{LDAP_MATCHING_RULE_BIT_AND}:=2))
1322 }
1323
1324 sub construct_attrs {
1325         
1326         my @attrs = @_;
1327         
1328         if (!@attrs) {
1329                 push(@attrs,"*");
1330         }
1331
1332         if ($opt_notify) {
1333                 push(@attrs,"uSNChanged");
1334         }
1335
1336         if ($opt_display_metadata) {
1337                 push(@attrs,"msDS-ReplAttributeMetaData");
1338                 push(@attrs,"replPropertyMetaData");
1339         }
1340
1341         if ($opt_verbose) {
1342                 push(@attrs,"nTSecurityDescriptor");
1343                 push(@attrs,"msDS-KeyVersionNumber");
1344                 push(@attrs,"msDS-User-Account-Control-Computed");
1345                 push(@attrs,"modifyTimeStamp");
1346         }
1347
1348         return sort @attrs;
1349 }
1350
1351 sub print_header {
1352
1353         print "\n";
1354         printf "%10s: %s\n", "uri", $uri;
1355         printf "%10s: %s\n", "port", $port;
1356         printf "%10s: %s\n", "base", $base;
1357         printf "%10s: %s\n", $sasl_bind ? "principal" : "binddn", $sasl_bind ? $upn : $binddn;
1358         printf "%10s: %s\n", "password", $password;
1359         printf "%10s: %s\n", "bind-type", $sasl_bind ? "SASL" : "simple";
1360         printf "%10s: %s\n", "sasl-mech", $sasl_mech if ($sasl_mech);
1361         printf "%10s: %s\n", "filter", $filter;
1362         printf "%10s: %s\n", "scope", $scope;
1363         printf "%10s: %s\n", "attrs", join(", ", @attrs);
1364         printf "%10s: %s\n", "controls", join(", ", @ctrls_s);
1365         printf "%10s: %s\n", "page_size", $page_size if ($paging);
1366         printf "%10s: %s\n", "start_tls", $opt_starttls ? "yes" : "no";
1367         printf "\n";
1368 }
1369
1370 sub gen_controls {
1371
1372         # setup attribute-scoped query control
1373         my $asq_asn = Convert::ASN1->new;
1374         $asq_asn->prepare(
1375                 q<      asq ::= SEQUENCE {
1376                                 sourceAttribute   OCTET_STRING
1377                         }
1378                 >
1379         );
1380         my $ctl_asq_val = $asq_asn->encode( sourceAttribute => $opt_asq);
1381         my $ctl_asq = Net::LDAP::Control->new(
1382                 type => $ads_controls{'LDAP_SERVER_ASQ_OID'},
1383                 critical => 'true',
1384                 value => $ctl_asq_val);
1385
1386
1387         # setup extended dn control
1388         my $asn_extended_dn = Convert::ASN1->new;
1389         $asn_extended_dn->prepare(
1390                 q<      ExtendedDn ::= SEQUENCE {
1391                                 mode     INTEGER
1392                         }
1393                 >
1394         );
1395
1396         my $ctl_extended_dn_val = $asn_extended_dn->encode( mode => '1');
1397         my $ctl_extended_dn =Net::LDAP::Control->new( 
1398                 type => $ads_controls{'LDAP_SERVER_EXTENDED_DN_OID'},
1399                 critical => 'true',
1400                 value => $ctl_extended_dn_val);
1401
1402
1403         # setup notify control
1404         my $ctl_notification = Net::LDAP::Control->new( 
1405                 type => $ads_controls{'LDAP_SERVER_NOTIFICATION_OID'},
1406                 critical => 'true');
1407
1408
1409         # setup paging control
1410         $ctl_paged = Net::LDAP::Control->new( 
1411                 type => $ads_controls{'LDAP_PAGED_RESULT_OID_STRING'},
1412                 critical => 'true',
1413                 size => $page_size);
1414
1415
1416         if ($paging) {
1417                 push(@ctrls, $ctl_paged);
1418                 push(@ctrls_s, "LDAP_PAGED_RESULT_OID_STRING" );
1419         }
1420
1421         if ($opt_display_extendeddn) {
1422                 push(@ctrls, $ctl_extended_dn);
1423                 push(@ctrls_s, "LDAP_SERVER_EXTENDED_DN_OID");
1424         } 
1425         if ($opt_notify) {
1426                 push(@ctrls, $ctl_notification);
1427                 push(@ctrls_s, "LDAP_SERVER_NOTIFICATION_OID");
1428         }
1429         
1430         if ($opt_asq) {
1431                 push(@ctrls, $ctl_asq);
1432                 push(@ctrls_s, "LDAP_SERVER_ASQ_OID");
1433         }
1434         
1435         return @ctrls;
1436 }
1437
1438 sub display_value_generic ($$$) {
1439
1440         my ($mod,$attr,$value) = @_;
1441         return unless (defined($value) and defined($attr));
1442
1443         if ( ! $opt_display_raw && exists $attr_handler{$attr} ) {
1444                 $value = $attr_handler{$attr}($value,$mod);
1445                 write_ads_list($mod,$attr,$value);
1446                 return;
1447         }
1448         write_ads($mod,$attr,$value);
1449 }
1450
1451 sub display_attr_generic ($$$) {
1452
1453         my ($mod,$entry,$attr) = @_;
1454         return if (!$attr || !$entry);
1455
1456         my $ref = $entry->get_value($attr, asref => 1);
1457         my @values = @$ref;
1458
1459         foreach my $value ( sort @values) {
1460                 display_value_generic($mod,$attr,$value);
1461         }
1462 }
1463
1464 sub display_entry_generic ($) {
1465
1466         my $entry = shift;
1467         return if (!$entry);
1468
1469         foreach my $attr ( sort $entry->attributes) {
1470                 display_attr_generic("\t",$entry,$attr);        
1471         }
1472 }
1473
1474 sub display_ldap_err ($) {
1475
1476         my $msg = shift;
1477         print_header();
1478         my ($package, $filename, $line, $subroutine) = caller(0);
1479
1480         print "got error from ADS:\n";
1481         printf("%s(%d): ERROR (%s): %s\n", 
1482                 $subroutine, $line, $msg->code, $msg->error);
1483
1484 }
1485
1486 sub process_result {
1487
1488         my ($msg,$entry) = @_;
1489
1490         if (!defined($msg)) { 
1491                 return; 
1492         }
1493
1494         if ($msg->code) {
1495                 display_ldap_err($msg);
1496                 exit 1;
1497         }
1498
1499         if (!defined($entry)) {
1500                 return;
1501         }
1502
1503         if ($entry->isa('Net::LDAP::Reference')) {
1504                 foreach my $ref ($entry->references) {
1505                         print "\ngot Reference: [$ref]\n";
1506                 }
1507                 return;
1508         }
1509
1510         print "\nfound entry: ".$entry->dn."\n".("-" x 80)."\n";
1511
1512         display_entry_generic($entry);
1513 }
1514
1515 sub default_callback {
1516
1517         my ($res,$obj) = @_;
1518
1519         if (!$opt_notify) {
1520                 return process_result($res,$obj);
1521         } 
1522 }
1523
1524 sub error_callback {
1525
1526         my ($msg,$entry) = @_;
1527
1528         if (!$msg) { 
1529                 return; 
1530         }
1531
1532         if ($msg->code) {
1533                 display_ldap_err($msg);
1534                 exit(1);
1535         }
1536         return;
1537 }
1538
1539 sub notify_callback {
1540
1541         my ($msg, $obj) = @_;
1542
1543         if (! defined($obj)) {
1544                 return;
1545         }
1546
1547         if ($obj->isa('Net::LDAP::Reference')) {
1548                 foreach my $ref ($obj->references) {
1549                         print "\ngot Reference: [$ref]\n";
1550                 }
1551                 return;
1552         }
1553
1554         while (1) {
1555
1556                 my $async_entry = $async_search->pop_entry;
1557
1558                 if (!$async_entry->dn) {
1559                         print "very weird. entry has no dn\n";
1560                         next;
1561                 }
1562         
1563                 printf("\ngot changenotify for dn: [%s]\n%s\n", $async_entry->dn, ("-" x 80));
1564
1565                 my $new_usn = $async_entry->get_value('uSNChanged');
1566                 if (!$usn || $new_usn > $usn) {
1567                         $usn = $new_usn;
1568                         if ($opt_notify_nodiffs) {
1569                                 display_entry_generic($async_entry);
1570                         } else {
1571                                 display_result_diff($async_entry);
1572                         }
1573                 } 
1574                 store_result($async_entry);
1575         }
1576 }
1577
1578 sub do_bind($$) {
1579
1580         my $async_ldap_hd = shift || return undef;
1581         my $sasl_bind = shift;
1582
1583         if ($sasl_bind) {
1584                 if (!$works_sasl) {
1585                         print "this version of Net::LDAP does not have proper SASL support.\n";
1586                         print "Need at least perl-ldap V. $pref_version\n";
1587                 }
1588                 $sasl_hd = get_sasl_hd();
1589                 if (!$sasl_hd) {
1590                         print "failed to create SASL handle\n";
1591                         return -1;
1592                 }
1593                 $mesg = $async_ldap_hd->bind( 
1594                         sasl => $sasl_hd, 
1595                         callback => \&error_callback 
1596                 ) || die "doesnt work"; 
1597         } else {
1598                 $sasl_mech = "";
1599                 $mesg = $async_ldap_hd->bind( 
1600                         $binddn, 
1601                         password => $password, 
1602                         callback => \&error_callback
1603                 ) || die "doesnt work";
1604         };
1605         if ($mesg->code) { 
1606                 display_ldap_err($mesg);
1607                 return -1;
1608         }
1609         return 0;
1610 }
1611
1612 sub do_unbind() {
1613         if ($async_ldap_hd) {
1614                 $async_ldap_hd->unbind;
1615         }
1616         if ($sync_ldap_hd) {
1617                 $sync_ldap_hd->unbind;
1618         }
1619 }
1620
1621 ###############################################################################
1622
1623 sub main () {
1624
1625         $filter = construct_filter($query);
1626         @attrs  = construct_attrs(@attrs);
1627         @ctrls  = gen_controls();
1628         if (check_ctrls($server,$dse,@ctrls) == -1) {
1629                 print "not all required LDAP Controls are supported by this server\n";
1630                 exit 1;
1631         }
1632
1633         if ($opt_dump_rootdse) {
1634                 print "Dumping Root-DSE:\n";
1635                 display_entry_generic($dse);
1636                 exit 0;
1637         }
1638
1639         if ($opt_dump_wknguid) {
1640                 dump_wknguid();
1641                 exit 0;
1642         }
1643
1644         if (do_bind($async_ldap_hd, $sasl_bind) == -1) {
1645                 exit 1;
1646         }
1647
1648         print_header();
1649
1650         if ($opt_dump_schema) {
1651                 print "Dumping Schema:\n";
1652                 my $ads_schema = $async_ldap_hd->schema;
1653                 $ads_schema->dump;
1654                 exit 0;
1655         }
1656
1657         while (1) {
1658
1659                 $async_search = $async_ldap_hd->search( 
1660                         base => $base, 
1661                         filter => $filter, 
1662                         attrs => [ @attrs ],
1663                         control => [ @ctrls ], 
1664                         callback => \&default_callback,
1665                         scope => $scope,
1666                                 ) || die "cannot search";
1667
1668                 if ($opt_notify) {
1669
1670                         print "Base [$base] is registered now for change-notify\n";
1671                         print "\nWaiting for change-notify...\n";
1672
1673                         my $sync_ldap_hd = get_ldap_hd($server,0);
1674                         if (do_bind($sync_ldap_hd, $sasl_bind) == -1) {
1675                                 exit 2;
1676                         }
1677
1678                         my $sync_search = $sync_ldap_hd->search( 
1679                                 base => $base, 
1680                                 filter => $filter, 
1681                                 attrs => [ @attrs ],
1682                                 callback => \&notify_callback,
1683                                 scope => $scope,
1684                                 ) || die "cannot search";
1685
1686                 }
1687
1688                 $total_entry_count += $async_search->count;
1689                 ++$page_count;
1690                 print "-" x 80 . "\n";
1691                 printf("Got %d Entries in Page %d \n\n", 
1692                         $async_search->count, $page_count);
1693                 my ($resp) = $async_search->control( 
1694                         $ads_controls{'LDAP_PAGED_RESULT_OID_STRING'} ) or last;
1695                 last unless ref $resp && $ctl_paged->cookie($resp->cookie);
1696         }
1697
1698         if ($async_search->entries == 0) {
1699                 print "No entries found with filter $filter\n";
1700         } else {
1701                 print "Got $total_entry_count Entries in $page_count Pages\n" if ($paging);
1702         }
1703
1704         do_unbind()
1705 }
1706
1707 main();
1708
1709 exit 0;