| 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;
|
|---|
