LCA2011 version
[tridge/junkcode.git] / tsig-gss / nsupdate-gss
1 #!/usr/bin/perl -w
2 # update a win2000 DNS server using gss-tsig 
3 # tridge@samba.org, October 2002
4
5 # jmruiz@animatika.net
6 # updated, 2004-Enero
7
8 # tridge@samba.org, September 2009
9 # added --verbose, --noverify, --ntype and --nameserver
10
11 # See draft-ietf-dnsext-gss-tsig-02, RFC2845 and RFC2930
12
13 use strict;
14 use lib "GSSAPI";
15 use Net::DNS;
16 use GSSAPI;
17 use Getopt::Long;
18
19 my $opt_wipe = 0;
20 my $opt_add = 0;
21 my $opt_noverify = 0;
22 my $opt_verbose = 0;
23 my $opt_help = 0;
24 my $opt_nameserver;
25 my $opt_realm;
26 my $opt_ntype = "A";
27
28 # main program
29 GetOptions (
30             'h|help|?' => \$opt_help,
31             'wipe' => \$opt_wipe,
32             'realm=s' => \$opt_realm,
33             'nameserver=s' => \$opt_nameserver,
34             'ntype=s' => \$opt_ntype,
35             'add' => \$opt_add,
36             'noverify' => \$opt_noverify,
37             'verbose' => \$opt_verbose
38             );
39
40 #########################################
41 # display help text
42 sub ShowHelp()
43 {
44     print "
45  nsupdate with gssapi
46  Copyright (C) tridge\@samba.org
47
48  Usage: nsupdate-gss [options] HOST DOMAIN TARGET TTL
49
50  Options:
51          --wipe               wipe all records for this name
52          --add                add to any existing records
53          --ntype=TYPE         specify name type (default A)
54          --nameserver=server  specify a specific nameserver
55          --noverify           don't verify the MIC of the reply
56          --verbose            show detailed steps
57            
58 ";
59     exit(0);
60 }
61
62 if ($opt_help) {
63         ShowHelp();
64 }
65
66 if ($#ARGV != 3) {
67         ShowHelp();
68 }
69
70
71 my $host = $ARGV[0];
72 my $domain = $ARGV[1];
73 my $target = $ARGV[2];
74 my $ttl = $ARGV[3];
75 my $alg = "gss.microsoft.com";
76
77
78
79 #######################################################################
80 # signing callback function for TSIG module
81 sub gss_sign($$)
82 {
83     my $key = shift;
84     my $data = shift;
85     my $sig;
86     $key->get_mic(0, $data, $sig);
87     return $sig;
88 }
89
90
91
92 #####################################################################
93 # write a string into a file
94 sub FileSave($$)
95 {
96     my($filename) = shift;
97     my($v) = shift;
98     local(*FILE);
99     open(FILE, ">$filename") || die "can't open $filename";    
100     print FILE $v;
101     close(FILE);
102 }
103
104
105 #######################################################################
106 # verify a TSIG signature from a DNS server reply
107 #
108 sub sig_verify($$)
109 {
110     my $context = shift;
111     my $packet = shift;
112
113     my $tsig = ($packet->additional)[0];
114     $opt_verbose && print "calling sig_data\n";
115     my $sigdata = $tsig->sig_data($packet);
116
117     $opt_verbose && print "sig_data_done\n";
118
119     return $context->verify_mic($sigdata, $tsig->{"mac"}, 0);
120 }
121
122
123 #######################################################################
124 # find the nameserver for the domain
125 #
126 sub find_nameserver($)
127 {
128     my $server_name = shift;
129     return Net::DNS::Resolver->new(
130             nameservers => [$server_name],
131             recurse     => 0,
132             debug       => 0);
133 }
134
135
136 #######################################################################
137 # find a server name for a domain - currently uses the NS record
138 sub find_server_name($)
139 {
140     my $domain = shift;
141     my $res = Net::DNS::Resolver->new;
142     my $srv_query = $res->query("$domain.", "NS");
143     if (!defined($srv_query)) {
144         return undef;
145     }
146     my $server_name;
147     foreach my $rr (grep { $_->type eq 'NS' } $srv_query->answer) {
148             $server_name = $rr->nsdname;
149     }
150     return $server_name;
151 }
152
153 #######################################################################
154
155 #
156 sub negotiate_tkey($$$$)
157 {
158
159     my $nameserver = shift;
160     my $domain = shift;
161     my $server_name = shift;
162     my $key_name = shift;
163
164     my $status;
165
166     my $context = GSSAPI::Context->new;
167     my $name = GSSAPI::Name->new;
168
169     # use a principal name of dns/server@REALM
170     $opt_verbose &&
171         print "Using principal dns/" . $server_name . "@" . uc($opt_realm) . "\n";
172     $status = $name->import($name, "dns/" . $server_name . "@" . uc($opt_realm));
173     if (! $status) {
174             print "import name: $status\n";
175             return undef;
176     }
177
178     my $flags = 
179         GSS_C_REPLAY_FLAG | GSS_C_MUTUAL_FLAG | 
180         GSS_C_SEQUENCE_FLAG | GSS_C_CONF_FLAG | 
181         GSS_C_INTEG_FLAG | GSS_C_DELEG_FLAG;
182
183
184     $status = GSSAPI::Cred::acquire_cred(undef, 120, undef, GSS_C_INITIATE,
185                                          my $cred, my $oidset, my $time);
186
187     if (! $status) {
188         print "acquire_cred: $status\n";
189         return undef;
190     }
191
192     $opt_verbose && print "creds acquired\n";
193
194     # call gss_init_sec_context()
195     $status = $context->init($cred, $name, undef, $flags,
196                              0, undef, "", undef, my $tok,
197                              undef, undef);
198     if (! $status) {
199             print "init_sec_context: $status\n";
200             return undef;
201     }
202
203     $opt_verbose && print "init done\n";
204
205     my $gss_query = Net::DNS::Packet->new("$key_name", "TKEY", "IN");
206
207     # note that Windows2000 uses a SPNEGO wrapping on GSSAPI data sent to the nameserver.
208     # I tested using the gen_negTokenTarg() call from Samba 3.0 and it does work, but
209     # for this utility it is better to use plain GSSAPI/krb5 data so as to reduce the
210     # dependence on external libraries. If we ever want to sign DNS packets using
211     # NTLMSSP instead of krb5 then the SPNEGO wrapper could be used
212
213     $opt_verbose && print "calling RR new\n";
214
215     $a = Net::DNS::RR->new(
216                            Name    => "$key_name",
217                            Type    => "TKEY",
218                            TTL     => 0,
219                            Class   => "ANY",
220                            mode => 3,
221                            algorithm => $alg,
222                            inception => time,
223                            expiration => time + 24*60*60,
224                            key => $tok,
225                            other_data => "",
226                            );
227
228     $gss_query->push("answer", $a);
229
230     my $reply = $nameserver->send($gss_query);
231
232     if (!defined($reply) || $reply->header->{'rcode'} ne 'NOERROR') {
233         print "failed to send TKEY\n";
234         return undef;
235     }
236
237     my $key2 = ($reply->answer)[0]->{"key"};
238
239     # call gss_init_sec_context() again. Strictly speaking
240     # we should loop until this stops returning CONTINUE
241     # but I'm a lazy bastard
242     $status = $context->init($cred, $name, undef, $flags,
243                              0, undef, $key2, undef, $tok,
244                              undef, undef);
245     if (! $status) {
246         print "init_sec_context step 2: $status\n";
247         return undef;
248     }
249
250     if (!$opt_noverify) {
251             $opt_verbose && print "verifying\n";
252
253             # check the signature on the TKEY reply
254             my $rc = sig_verify($context, $reply);
255             if (! $rc) {
256                     print "Failed to verify TKEY reply: $rc\n";
257 #               return undef;
258             }
259
260             $opt_verbose && print "verifying done\n";
261     }
262
263     return $context;
264 }
265
266
267 #######################################################################
268 # MAIN
269 #######################################################################
270
271 if (!$opt_realm) {
272         $opt_realm = $domain;
273 }
274
275 # find the name of the DNS server
276 if (!$opt_nameserver) {
277         $opt_nameserver = find_server_name($domain);
278         if (!defined($opt_nameserver)) {
279                 print "Failed to find a DNS server name for $domain\n";
280                 exit 1;
281         }
282 }
283 $opt_verbose && print "Using DNS server name $opt_nameserver\n";
284
285 # connect to the nameserver
286 my $nameserver = find_nameserver($opt_nameserver);
287 if (!defined($nameserver) || $nameserver->{'errorstring'} ne 'NOERROR') {
288         print "Failed to connect to nameserver for domain $domain\n";
289         exit 1;
290 }
291
292
293 # use a long random key name
294 my $key_name = int(rand 10000000000000);
295
296 # negotiate a TKEY key
297 my $gss_context = negotiate_tkey($nameserver, $domain, $opt_nameserver, $key_name);
298 if (!defined($gss_context)) {
299     print "Failed to negotiate a TKEY\n";
300     exit 1;
301 }
302 $opt_verbose && print "Negotiated TKEY $key_name\n";
303
304 # construct a signed update
305 my $update = Net::DNS::Update->new($domain);
306
307 $update->push("pre", yxdomain("$domain"));
308 if (!$opt_add) {
309         $update->push("update", rr_del("$host.$domain. $opt_ntype"));
310 }
311 if (!$opt_wipe) {
312         $update->push("update", rr_add("$host.$domain. $ttl $opt_ntype $target"));
313 }
314
315 my $sig = Net::DNS::RR->new(
316                             Name    => $key_name,
317                             Type    => "TSIG",
318                             TTL     => 0,
319                             Class   => "ANY",
320                             Algorithm => $alg,
321                             Time_Signed => time,
322                             Fudge => 36000,
323                             Mac_Size => 0,
324                             Mac => "",
325                             Key => $gss_context,
326                             Sign_Func => \&gss_sign,
327                             Other_Len => 0,
328                             Other_Data => "",
329                             Error => 0,
330                             mode => 3,
331                             );
332
333 $update->push("additional", $sig);
334
335 # send the dynamic update
336 my $update_reply = $nameserver->send($update);
337
338 if (! defined($update_reply)) {
339     print "No reply to dynamic update\n";
340     exit 1;
341 }
342
343 # make sure it worked
344 my $result = $update_reply->header->{"rcode"};
345
346 ($opt_verbose || $result ne 'NOERROR') && print "Update gave rcode $result\n";
347
348 if ($result ne 'NOERROR') {
349     exit 1;
350 }
351
352 exit 0;