tdb: Don't purge records to a blocked freelist
[Samba.git] / examples / misc / cldap.pl
blobc33fdedfbfebb06cf297530d42405c2a9987bbf9
1 #!/usr/bin/perl -w
3 # Copyright (C) Guenther Deschner <gd@samba.org> 2006
5 use strict;
6 use IO::Socket;
7 use Convert::ASN1 qw(:debug);
8 use Getopt::Long;
10 # TODO: timeout handling, user CLDAP query
12 ##################################
14 my $server = "";
15 my $domain = "";
16 my $host = "";
18 ##################################
20 my (
21 $opt_debug,
22 $opt_domain,
23 $opt_help,
24 $opt_host,
25 $opt_server,
28 my %cldap_flags = (
29 ADS_PDC => 0x00000001, # DC is PDC
30 ADS_GC => 0x00000004, # DC is a GC of forest
31 ADS_LDAP => 0x00000008, # DC is an LDAP server
32 ADS_DS => 0x00000010, # DC supports DS
33 ADS_KDC => 0x00000020, # DC is running KDC
34 ADS_TIMESERV => 0x00000040, # DC is running time services
35 ADS_CLOSEST => 0x00000080, # DC is closest to client
36 ADS_WRITABLE => 0x00000100, # DC has writable DS
37 ADS_GOOD_TIMESERV => 0x00000200, # DC has hardware clock (and running time)
38 ADS_NDNC => 0x00000400, # DomainName is non-domain NC serviced by LDAP server
41 my %cldap_samlogon_types = (
42 SAMLOGON_AD_UNK_R => 23,
43 SAMLOGON_AD_R => 25,
46 my $MAX_DNS_LABEL = 255 + 1;
48 my %cldap_netlogon_reply = (
49 type => 0,
50 flags => 0x0,
51 guid => 0,
52 forest => undef,
53 domain => undef,
54 hostname => undef,
55 netbios_domain => undef,
56 netbios_hostname => undef,
57 unk => undef,
58 user_name => undef,
59 server_site_name => undef,
60 client_site_name => undef,
61 version => 0,
62 lmnt_token => 0x0,
63 lm20_token => 0x0,
66 sub usage {
67 print "usage: $0 [--domain|-d domain] [--help] [--host|-h host] [--server|-s server]\n\n";
70 sub connect_cldap ($) {
72 my $server = shift || return undef;
74 return IO::Socket::INET->new(
75 PeerAddr => $server,
76 PeerPort => 389,
77 Proto => 'udp',
78 Type => SOCK_DGRAM,
79 Timeout => 10,
83 sub send_cldap_netlogon ($$$$) {
85 my ($sock, $domain, $host, $ntver) = @_;
87 my $asn_cldap_req = Convert::ASN1->new;
89 $asn_cldap_req->prepare(q<
91 SEQUENCE {
92 msgid INTEGER,
93 [APPLICATION 3] SEQUENCE {
94 basedn OCTET STRING,
95 scope ENUMERATED,
96 dereference ENUMERATED,
97 sizelimit INTEGER,
98 timelimit INTEGER,
99 attronly BOOLEAN,
100 [CONTEXT 0] SEQUENCE {
101 [CONTEXT 3] SEQUENCE {
102 dnsdom_attr OCTET STRING,
103 dnsdom_val OCTET STRING
105 [CONTEXT 3] SEQUENCE {
106 host_attr OCTET STRING,
107 host_val OCTET STRING
109 [CONTEXT 3] SEQUENCE {
110 ntver_attr OCTET STRING,
111 ntver_val OCTET STRING
114 SEQUENCE {
115 netlogon OCTET STRING
121 my $pdu_req = $asn_cldap_req->encode(
122 msgid => 0,
123 basedn => "",
124 scope => 0,
125 dereference => 0,
126 sizelimit => 0,
127 timelimit => 0,
128 attronly => 0,
129 dnsdom_attr => $domain ? 'DnsDomain' : "",
130 dnsdom_val => $domain ? $domain : "",
131 host_attr => 'Host',
132 host_val => $host,
133 ntver_attr => 'NtVer',
134 ntver_val => $ntver,
135 netlogon => 'NetLogon',
136 ) || die "failed to encode pdu: $@";
138 if ($opt_debug) {
139 print"------------\n";
140 asn_dump($pdu_req);
141 print"------------\n";
144 return $sock->send($pdu_req) || die "no send: $@";
147 # from source/libads/cldap.c :
150 # These seem to be strings as described in RFC1035 4.1.4 and can be:
152 # - a sequence of labels ending in a zero octet
153 # - a pointer
154 # - a sequence of labels ending with a pointer
156 # A label is a byte where the first two bits must be zero and the remaining
157 # bits represent the length of the label followed by the label itself.
158 # Therefore, the length of a label is at max 64 bytes. Under RFC1035, a
159 # sequence of labels cannot exceed 255 bytes.
161 # A pointer consists of a 14 bit offset from the beginning of the data.
163 # struct ptr {
164 # unsigned ident:2; // must be 11
165 # unsigned offset:14; // from the beginning of data
166 # };
168 # This is used as a method to compress the packet by eliminated duplicate
169 # domain components. Since a UDP packet should probably be < 512 bytes and a
170 # DNS name can be up to 255 bytes, this actually makes a lot of sense.
173 sub pull_netlogon_string (\$$$) {
175 my ($ret, $ptr, $str) = @_;
177 my $pos = $ptr;
179 my $followed_ptr = 0;
180 my $ret_len = 0;
182 my $retp = pack("x$MAX_DNS_LABEL");
184 do {
186 $ptr = unpack("c", substr($str, $pos, 1));
187 $pos++;
189 if (($ptr & 0xc0) == 0xc0) {
191 my $len;
193 if (!$followed_ptr) {
194 $ret_len += 2;
195 $followed_ptr = 1;
198 my $tmp0 = $ptr; #unpack("c", substr($str, $pos-1, 1));
199 my $tmp1 = unpack("c", substr($str, $pos, 1));
201 if ($opt_debug) {
202 printf("tmp0: 0x%x\n", $tmp0);
203 printf("tmp1: 0x%x\n", $tmp1);
206 $len = (($tmp0 & 0x3f) << 8) | $tmp1;
207 $ptr = unpack("c", substr($str, $len, 1));
208 $pos = $len;
210 } elsif ($ptr) {
212 my $len = scalar $ptr;
214 if ($len + 1 > $MAX_DNS_LABEL) {
215 warn("invalid string size: %d", $len + 1);
216 return 0;
219 $ptr = unpack("a*", substr($str, $pos, $len));
221 $retp = sprintf("%s%s\.", $retp, $ptr);
223 $pos += $len;
224 if (!$followed_ptr) {
225 $ret_len += $len + 1;
229 } while ($ptr);
231 $retp =~ s/\.$//; #ugly hack...
233 $$ret = $retp;
235 return $followed_ptr ? $ret_len : $ret_len + 1;
238 sub dump_cldap_flags ($) {
240 my $flags = shift || return;
241 printf("Flags:\n".
242 "\tIs a PDC: %s\n".
243 "\tIs a GC of the forest: %s\n".
244 "\tIs an LDAP server: %s\n".
245 "\tSupports DS: %s\n".
246 "\tIs running a KDC: %s\n".
247 "\tIs running time services: %s\n".
248 "\tIs the closest DC: %s\n".
249 "\tIs writable: %s\n".
250 "\tHas a hardware clock: %s\n".
251 "\tIs a non-domain NC serviced by LDAP server: %s\n",
252 ($flags & $cldap_flags{ADS_PDC}) ? "yes" : "no",
253 ($flags & $cldap_flags{ADS_GC}) ? "yes" : "no",
254 ($flags & $cldap_flags{ADS_LDAP}) ? "yes" : "no",
255 ($flags & $cldap_flags{ADS_DS}) ? "yes" : "no",
256 ($flags & $cldap_flags{ADS_KDC}) ? "yes" : "no",
257 ($flags & $cldap_flags{ADS_TIMESERV}) ? "yes" : "no",
258 ($flags & $cldap_flags{ADS_CLOSEST}) ? "yes" : "no",
259 ($flags & $cldap_flags{ADS_WRITABLE}) ? "yes" : "no",
260 ($flags & $cldap_flags{ADS_GOOD_TIMESERV}) ? "yes" : "no",
261 ($flags & $cldap_flags{ADS_NDNC}) ? "yes" : "no");
264 sub guid_to_string ($) {
266 my $guid = shift || return undef;
267 if ((my $len = length $guid) != 16) {
268 printf("invalid length: %d\n", $len);
269 return undef;
271 my $string = sprintf "%08X-%04X-%04X-%02X%02X-%02X%02X%02X%02X%02X%02X",
272 unpack("I", $guid),
273 unpack("S", substr($guid, 4, 2)),
274 unpack("S", substr($guid, 6, 2)),
275 unpack("C", substr($guid, 8, 1)),
276 unpack("C", substr($guid, 9, 1)),
277 unpack("C", substr($guid, 10, 1)),
278 unpack("C", substr($guid, 11, 1)),
279 unpack("C", substr($guid, 12, 1)),
280 unpack("C", substr($guid, 13, 1)),
281 unpack("C", substr($guid, 14, 1)),
282 unpack("C", substr($guid, 15, 1));
283 return lc($string);
286 sub recv_cldap_netlogon ($\$) {
288 my ($sock, $return_string) = @_;
289 my ($ret, $pdu_out);
291 $ret = $sock->recv($pdu_out, 8192) || die "failed to read from socket: $@";
292 #$ret = sysread($sock, $pdu_out, 8192);
294 if ($opt_debug) {
295 print"------------\n";
296 asn_dump($pdu_out);
297 print"------------\n";
300 my $asn_cldap_rep = Convert::ASN1->new;
301 my $asn_cldap_rep_fail = Convert::ASN1->new;
303 $asn_cldap_rep->prepare(q<
304 SEQUENCE {
305 msgid INTEGER,
306 [APPLICATION 4] SEQUENCE {
307 dn OCTET STRING,
308 SEQUENCE {
309 SEQUENCE {
310 attr OCTET STRING,
311 SET {
312 val OCTET STRING
318 SEQUENCE {
319 msgid2 INTEGER,
320 [APPLICATION 5] SEQUENCE {
321 error_code ENUMERATED,
322 matched_dn OCTET STRING,
323 error_message OCTET STRING
328 $asn_cldap_rep_fail->prepare(q<
329 SEQUENCE {
330 msgid2 INTEGER,
331 [APPLICATION 5] SEQUENCE {
332 error_code ENUMERATED,
333 matched_dn OCTET STRING,
334 error_message OCTET STRING
339 my $asn1_rep = $asn_cldap_rep->decode($pdu_out) ||
340 $asn_cldap_rep_fail->decode($pdu_out) ||
341 die "failed to decode pdu: $@";
343 if ($asn1_rep->{'error_code'} == 0) {
344 $$return_string = $asn1_rep->{'val'};
347 return $ret;
350 sub parse_cldap_reply ($) {
352 my $str = shift || return undef;
353 my %hash;
354 my $p = 0;
356 $hash{type} = unpack("L", substr($str, $p, 4)); $p += 4;
357 $hash{flags} = unpack("L", substr($str, $p, 4)); $p += 4;
358 $hash{guid} = unpack("a16", substr($str, $p, 16)); $p += 16;
360 $p += pull_netlogon_string($hash{forest}, $p, $str);
361 $p += pull_netlogon_string($hash{domain}, $p, $str);
362 $p += pull_netlogon_string($hash{hostname}, $p, $str);
363 $p += pull_netlogon_string($hash{netbios_domain}, $p, $str);
364 $p += pull_netlogon_string($hash{netbios_hostname}, $p, $str);
365 $p += pull_netlogon_string($hash{unk}, $p, $str);
367 if ($hash{type} == $cldap_samlogon_types{SAMLOGON_AD_R}) {
368 $p += pull_netlogon_string($hash{user_name}, $p, $str);
369 } else {
370 $hash{user_name} = "";
373 $p += pull_netlogon_string($hash{server_site_name}, $p, $str);
374 $p += pull_netlogon_string($hash{client_site_name}, $p, $str);
376 $hash{version} = unpack("L", substr($str, $p, 4)); $p += 4;
377 $hash{lmnt_token} = unpack("S", substr($str, $p, 2)); $p += 2;
378 $hash{lm20_token} = unpack("S", substr($str, $p, 2)); $p += 2;
380 return %hash;
383 sub display_cldap_reply {
385 my $server = shift;
386 my (%hash) = @_;
388 my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($server);
390 printf("Information for Domain Controller: %s\n\n", $name);
392 printf("Response Type: ");
393 if ($hash{type} == $cldap_samlogon_types{SAMLOGON_AD_R}) {
394 printf("SAMLOGON_USER\n");
395 } elsif ($hash{type} == $cldap_samlogon_types{SAMLOGON_AD_UNK_R}) {
396 printf("SAMLOGON\n");
397 } else {
398 printf("unknown type 0x%x, please report\n", $hash{type});
401 # guid
402 printf("GUID: %s\n", guid_to_string($hash{guid}));
404 # flags
405 dump_cldap_flags($hash{flags});
407 # strings
408 printf("Forest:\t\t\t%s\n", $hash{forest});
409 printf("Domain:\t\t\t%s\n", $hash{domain});
410 printf("Domain Controller:\t%s\n", $hash{hostname});
412 printf("Pre-Win2k Domain:\t%s\n", $hash{netbios_domain});
413 printf("Pre-Win2k Hostname:\t%s\n", $hash{netbios_hostname});
415 if ($hash{unk}) {
416 printf("Unk:\t\t\t%s\n", $hash{unk});
418 if ($hash{user_name}) {
419 printf("User name:\t%s\n", $hash{user_name});
422 printf("Server Site Name:\t%s\n", $hash{server_site_name});
423 printf("Client Site Name:\t%s\n", $hash{client_site_name});
425 # some more int
426 printf("NT Version:\t\t%d\n", $hash{version});
427 printf("LMNT Token:\t\t%.2x\n", $hash{lmnt_token});
428 printf("LM20 Token:\t\t%.2x\n", $hash{lm20_token});
431 sub main() {
433 my ($ret, $sock, $reply);
435 GetOptions(
436 'debug' => \$opt_debug,
437 'domain|d=s' => \$opt_domain,
438 'help' => \$opt_help,
439 'host|h=s' => \$opt_host,
440 'server|s=s' => \$opt_server,
443 $server = $server || $opt_server;
444 $domain = $domain || $opt_domain || undef;
445 $host = $host || $opt_host;
446 if (!$host) {
447 $host = `/bin/hostname`;
448 chomp($host);
451 if (!$server || !$host || $opt_help) {
452 usage();
453 exit 1;
456 my $ntver = sprintf("%c%c%c%c", 6,0,0,0);
458 $sock = connect_cldap($server);
459 if (!$sock) {
460 die("could not connect to $server");
463 $ret = send_cldap_netlogon($sock, $domain, $host, $ntver);
464 if (!$ret) {
465 close($sock);
466 die("failed to send CLDAP request to $server");
469 $ret = recv_cldap_netlogon($sock, $reply);
470 if (!$ret) {
471 close($sock);
472 die("failed to receive CLDAP reply from $server");
474 close($sock);
476 if (!$reply) {
477 printf("no 'NetLogon' attribute received\n");
478 exit 0;
481 %cldap_netlogon_reply = parse_cldap_reply($reply);
482 if (!%cldap_netlogon_reply) {
483 die("failed to parse CLDAP reply from $server");
486 display_cldap_reply($server, %cldap_netlogon_reply);
488 exit 0;
491 main();