source4/scripting/bin/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;