examples/perfcounter/perf_writer.c: fix memset
[kamenim/samba-autobuild/.git] / examples / misc / cldap.pl
1 #!/usr/bin/perl -w
2
3 # Copyright (C) Guenther Deschner <gd@samba.org> 2006
4
5 use strict;
6 use IO::Socket;
7 use Convert::ASN1 qw(:debug);
8 use Getopt::Long;
9
10 # TODO: timeout handling, user CLDAP query
11
12 ##################################
13
14 my $server = "";
15 my $domain = "";
16 my $host   = "";
17
18 ##################################
19
20 my (
21         $opt_debug,
22         $opt_domain,
23         $opt_help,
24         $opt_host,
25         $opt_server,
26 );
27
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
39 );
40
41 my %cldap_samlogon_types = (
42         SAMLOGON_AD_UNK_R       => 23,
43         SAMLOGON_AD_R           => 25,
44 );
45
46 my $MAX_DNS_LABEL = 255 + 1;
47
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,
64 );
65
66 sub usage { 
67         print "usage: $0 [--domain|-d domain] [--help] [--host|-h host] [--server|-s server]\n\n";
68 }
69
70 sub connect_cldap ($) {
71
72         my $server = shift || return undef;
73         
74         return IO::Socket::INET->new(
75                 PeerAddr        => $server,
76                 PeerPort        => 389,
77                 Proto           => 'udp',
78                 Type            => SOCK_DGRAM,
79                 Timeout         => 10,
80         );
81 }
82
83 sub send_cldap_netlogon ($$$$) {
84
85         my ($sock, $domain, $host, $ntver) = @_;
86
87         my $asn_cldap_req = Convert::ASN1->new;
88
89         $asn_cldap_req->prepare(q<
90
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
104                                         }
105                                         [CONTEXT 3] SEQUENCE {
106                                                 host_attr OCTET STRING,
107                                                 host_val  OCTET STRING
108                                         }
109                                         [CONTEXT 3] SEQUENCE {
110                                                 ntver_attr OCTET STRING,
111                                                 ntver_val  OCTET STRING
112                                         }
113                                 }
114                                 SEQUENCE {
115                                         netlogon OCTET STRING
116                                 }
117                         }
118                 }
119         >);
120
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: $@";
137
138         if ($opt_debug) {
139                 print"------------\n";
140                 asn_dump($pdu_req);
141                 print"------------\n";
142         }
143
144         return $sock->send($pdu_req) || die "no send: $@";
145 }
146
147 # from source/libads/cldap.c :
148 #
149 #/*
150 #  These seem to be strings as described in RFC1035 4.1.4 and can be:
151 #
152 #   - a sequence of labels ending in a zero octet
153 #   - a pointer
154 #   - a sequence of labels ending with a pointer
155 #
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.
160 #
161 #  A pointer consists of a 14 bit offset from the beginning of the data.
162 #
163 #  struct ptr {
164 #    unsigned ident:2; // must be 11
165 #    unsigned offset:14; // from the beginning of data
166 #  };
167 #
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.
171 #*/
172
173 sub pull_netlogon_string (\$$$) {
174         
175         my ($ret, $ptr, $str) = @_;
176
177         my $pos = $ptr;
178
179         my $followed_ptr = 0;
180         my $ret_len = 0;
181
182         my $retp = pack("x$MAX_DNS_LABEL");
183
184         do {
185         
186                 $ptr = unpack("c", substr($str, $pos, 1));
187                 $pos++;
188
189                 if (($ptr & 0xc0) == 0xc0) {
190
191                         my $len;
192
193                         if (!$followed_ptr) {
194                                 $ret_len += 2;
195                                 $followed_ptr = 1;
196                         }
197
198                         my $tmp0 = $ptr; #unpack("c", substr($str, $pos-1, 1));
199                         my $tmp1 = unpack("c", substr($str, $pos, 1));
200
201                         if ($opt_debug) {
202                                 printf("tmp0: 0x%x\n", $tmp0);
203                                 printf("tmp1: 0x%x\n", $tmp1);
204                         }
205
206                         $len = (($tmp0 & 0x3f) << 8) | $tmp1;
207                         $ptr = unpack("c", substr($str, $len, 1));
208                         $pos = $len;
209
210                 } elsif ($ptr) {
211
212                         my $len = scalar $ptr;
213
214                         if ($len + 1 > $MAX_DNS_LABEL) {
215                                 warn("invalid string size: %d", $len + 1);
216                                 return 0;
217                         }
218
219                         $ptr = unpack("a*", substr($str, $pos, $len));
220
221                         $retp = sprintf("%s%s\.", $retp, $ptr);
222
223                         $pos += $len;
224                         if (!$followed_ptr) {
225                                 $ret_len += $len + 1;
226                         }
227                 }
228
229         } while ($ptr);
230
231         $retp =~ s/\.$//; #ugly hack...
232
233         $$ret = $retp;
234
235         return $followed_ptr ? $ret_len : $ret_len + 1;
236 }
237
238 sub dump_cldap_flags ($) {
239
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");
262 }
263
264 sub guid_to_string ($) {
265
266         my $guid = shift || return undef;
267         if ((my $len = length $guid) != 16) {
268                 printf("invalid length: %d\n", $len);
269                 return undef;
270         }
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);
284 }
285
286 sub recv_cldap_netlogon ($\$) {
287
288         my ($sock, $return_string) = @_;
289         my ($ret, $pdu_out);
290
291         $ret = $sock->recv($pdu_out, 8192) || die "failed to read from socket: $@";
292         #$ret = sysread($sock, $pdu_out, 8192);
293
294         if ($opt_debug) {
295                 print"------------\n";
296                 asn_dump($pdu_out);
297                 print"------------\n";
298         }
299
300         my $asn_cldap_rep = Convert::ASN1->new;
301         my $asn_cldap_rep_fail = Convert::ASN1->new;
302
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
313                                                 }
314                                         }
315                                 }
316                         }
317                 }
318                 SEQUENCE {
319                         msgid2 INTEGER,
320                         [APPLICATION 5] SEQUENCE {
321                                 error_code ENUMERATED,
322                                 matched_dn OCTET STRING,
323                                 error_message OCTET STRING
324                         }
325                 }
326         >);
327
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
335                         }
336                 }
337         >);
338
339         my $asn1_rep =  $asn_cldap_rep->decode($pdu_out) || 
340                         $asn_cldap_rep_fail->decode($pdu_out) || 
341                         die "failed to decode pdu: $@";
342
343         if ($asn1_rep->{'error_code'} == 0) {
344                 $$return_string = $asn1_rep->{'val'};
345         } 
346
347         return $ret;
348 }
349
350 sub parse_cldap_reply ($) {
351
352         my $str = shift || return undef;
353         my %hash;
354         my $p = 0;
355
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;
359
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);
366
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} = "";
371         }
372
373         $p += pull_netlogon_string($hash{server_site_name}, $p, $str);
374         $p += pull_netlogon_string($hash{client_site_name}, $p, $str);
375
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;
379
380         return %hash;
381 }
382
383 sub display_cldap_reply {
384
385         my $server = shift;
386         my (%hash) = @_;
387
388         my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($server);
389
390         printf("Information for Domain Controller: %s\n\n", $name);
391
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});
399         }
400
401         # guid
402         printf("GUID: %s\n", guid_to_string($hash{guid}));
403
404         # flags
405         dump_cldap_flags($hash{flags});
406
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});
411
412         printf("Pre-Win2k Domain:\t%s\n", $hash{netbios_domain});
413         printf("Pre-Win2k Hostname:\t%s\n", $hash{netbios_hostname});
414
415         if ($hash{unk}) { 
416                 printf("Unk:\t\t\t%s\n", $hash{unk}); 
417         }
418         if ($hash{user_name}) { 
419                 printf("User name:\t%s\n", $hash{user_name}); 
420         }
421
422         printf("Server Site Name:\t%s\n", $hash{server_site_name});
423         printf("Client Site Name:\t%s\n", $hash{client_site_name});
424
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});
429 }
430
431 sub main() {
432
433         my ($ret, $sock, $reply);
434
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,
441         );
442
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);
449         }
450
451         if (!$server || !$host || $opt_help) {
452                 usage();
453                 exit 1;
454         }
455
456         my $ntver = sprintf("%c%c%c%c", 6,0,0,0);
457
458         $sock = connect_cldap($server);
459         if (!$sock) {
460                 die("could not connect to $server");
461         }
462
463         $ret = send_cldap_netlogon($sock, $domain, $host, $ntver);
464         if (!$ret) {
465                 close($sock);
466                 die("failed to send CLDAP request to $server");
467         }
468
469         $ret = recv_cldap_netlogon($sock, $reply);
470         if (!$ret) {
471                 close($sock);
472                 die("failed to receive CLDAP reply from $server");
473         }
474         close($sock);
475
476         if (!$reply) {
477                 printf("no 'NetLogon' attribute received\n");
478                 exit 0;
479         }
480
481         %cldap_netlogon_reply = parse_cldap_reply($reply);
482         if (!%cldap_netlogon_reply) {
483                 die("failed to parse CLDAP reply from $server");
484         }
485
486         display_cldap_reply($server, %cldap_netlogon_reply);
487
488         exit 0;
489 }
490
491 main();