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 13use strict; 14use lib "GSSAPI"; 15use Net::DNS; 16use GSSAPI; 17use Getopt::Long; 18 19my $opt_wipe = 0; 20my $opt_add = 0; 21my $opt_noverify = 0; 22my $opt_verbose = 0; 23my $opt_help = 0; 24my $opt_nameserver; 25my $opt_realm; 26my $opt_ntype = "A"; 27 28# main program 29GetOptions ( 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 42sub 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 62if ($opt_help) { 63 ShowHelp(); 64} 65 66if ($#ARGV != 3) { 67 ShowHelp(); 68} 69 70 71my $host = $ARGV[0]; 72my $domain = $ARGV[1]; 73my $target = $ARGV[2]; 74my $ttl = $ARGV[3]; 75my $alg = "gss.microsoft.com"; 76 77 78 79####################################################################### 80# signing callback function for TSIG module 81sub 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 94sub 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# 108sub 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# 126sub 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 138sub 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# 156sub 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 271if (!$opt_realm) { 272 $opt_realm = $domain; 273} 274 275# find the name of the DNS server 276if (!$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 286my $nameserver = find_nameserver($opt_nameserver); 287if (!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 294my $key_name = int(rand 10000000000000); 295 296# negotiate a TKEY key 297my $gss_context = negotiate_tkey($nameserver, $domain, $opt_nameserver, $key_name); 298if (!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 305my $update = Net::DNS::Update->new($domain); 306 307$update->push("pre", yxdomain("$domain")); 308if (!$opt_add) { 309 $update->push("update", rr_del("$host.$domain. $opt_ntype")); 310} 311if (!$opt_wipe) { 312 $update->push("update", rr_add("$host.$domain. $ttl $opt_ntype $target")); 313} 314 315my $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 336my $update_reply = $nameserver->send($update); 337 338if (! defined($update_reply)) { 339 print "No reply to dynamic update\n"; 340 exit 1; 341} 342 343# make sure it worked 344my $result = $update_reply->header->{"rcode"}; 345 346($opt_verbose || $result ne 'NOERROR') && print "Update gave rcode $result\n"; 347 348if ($result ne 'NOERROR') { 349 exit 1; 350} 351 352exit 0; 353