File nsupdate-gss of Package nsupdate-gss

Overview Repositories Revisions Requests Users Attributes Meta

File nsupdate-gss of Package nsupdate-gss

#!/usr/bin/perl -w
# update a win2000 DNS server using gss-tsig 
# tridge@samba.org, October 2002

# jmruiz@animatika.net
# updated, 2004-Enero

# dag@wieers.com
# updated, 2007-EMC

# See draft-ietf-dnsext-gss-tsig-02, RFC2845 and RFC2930

use strict;
use lib "GSSAPI-0.12";
use Net::DNS;
use GSSAPI;
use Data::Dumper;
use Authen::Krb5;
use Getopt::Long;
use Sys::Hostname;
#use Net::Address::IPv4::Local;
    
my $alg = "gss.microsoft.com";

#######################################################################
# signing callback function for TSIG module
sub gss_sign($$)
{
    my $key = shift;
    my $data = shift;
    my $sig;
    $key->get_mic(0, $data, $sig);
    return $sig;
}

#####################################################################
# write a string into a file
sub FileSave($$)
{
    my($filename) = shift;
    my($v) = shift;
    local(*FILE);
    open(FILE, ">$filename") || die "can't open $filename";    
    print FILE $v;
    close(FILE);
}

#######################################################################
# verify a TSIG signature from a DNS server reply
#
sub sig_verify($$)
{
    my $context = shift;
    my $packet = shift;

my $tsig = ($packet->additional)[0];
    print "calling sig_data\n";
    my $sigdata = $tsig->sig_data($packet);

print "sig_data_done\n";

return $context->verify_mic($sigdata, $tsig->{"mac"}, 0);
}

#######################################################################
# find the nameserver for the domain
#
sub find_nameservers($)
{
    my $domain = shift;
    my $res = Net::DNS::Resolver->new;
    $res->nameservers($domain);
    return $res;
}

#######################################################################
# find a server name for a domain - currently uses the LDAP SRV record.
# I wonder if there is a _dns record type?
sub find_server_name($)
{
    my $domain = shift;
    my $res = Net::DNS::Resolver->new;
    my $srv_query = $res->query("_ldap._tcp.$domain.", "SRV");
    if (!defined($srv_query)) {
	return undef;
    }
    my $server_name = ($srv_query->answer)[0]->{"target"};
    return $server_name;
}

#######################################################################
# 
#
sub negotiate_tkey($$$$$$)
{

my $nameserver = shift;
    my $domain = shift;
    my $server_name = shift;
    my $key_name = shift;
    my $keytab = shift;
    my $hostname = shift;

my $status;

my $context = GSSAPI::Context->new;
    my $name = GSSAPI::Name->new;

# use a principal name of dns/server@DOMAIN
    $status = $name->import($name, "dns/" . $server_name . "@" . uc($domain));
    if (! $status) {
	print "import name: $status\n";
	return undef;
    }

$status = GSSAPI::Cred::acquire_cred(undef, 120, undef, GSS_C_INITIATE,
					 my $cred, my $oidset, my $time);

if (not $status and -e $keytab) {
#	print "create krbtgt using keytab\n";
	my $cc_obj = Authen::Krb5::cc_default() || die "Problem with cc_default: ".Authen::Krb5::error();
	my $client_name = uc($hostname)."\$\@$domain";
	my $client_obj = Authen::Krb5::parse_name($client_name) || die "cannot parse client [$client_name]: ".Authen::Krb5::error();
	my $server_name = "krbtgt/$domain\@$domain";
	my $server_obj = Authen::Krb5::parse_name($server_name) || die "cannot parse server [$server_name]: ".Authen::Krb5::error();
	$cc_obj->initialize($client_obj);
	my $keytab_obj = Authen::Krb5::kt_resolve($keytab) || die "Problem with kt_resolve [$keytab]: ".Authen::Krb5::error();
	Authen::Krb5::get_in_tkt_with_keytab($client_obj, $server_obj, $keytab_obj, $cc_obj) || die "Cant authenticate client [$client_name]: ".Authen::Krb5::error();

$status = GSSAPI::Cred::acquire_cred(undef, 120, undef, GSS_C_INITIATE,
					 my $cred, my $oidset, my $time);
    }

if (not $status) {
#	print "acquire_cred: $status\n";
	return undef;
    }

#   print "creds acquired\n";

# call gss_init_sec_context()
    $status = $context->init($cred, $name, undef, $flags,
			     0, undef, "", undef, my $tok,
			     undef, undef);
    if (! $status) {
	print "init_sec_context: $status\n";
	return undef;
    }

#   print "init done\n";

my $gss_query = Net::DNS::Packet->new("$key_name", "TKEY", "IN");

# note that Windows2000 uses a SPNEGO wrapping on GSSAPI data sent to the nameserver.
    # I tested using the gen_negTokenTarg() call from Samba 3.0 and it does work, but
    # for this utility it is better to use plain GSSAPI/krb5 data so as to reduce the
    # dependence on external libraries. If we ever want to sign DNS packets using
    # NTLMSSP instead of krb5 then the SPNEGO wrapper could be used

#   print "calling RR new\n";

$a = Net::DNS::RR->new(
			   Name    => "$key_name",
			   Type    => "TKEY",
			   TTL     => 0,
			   Class   => "ANY",
			   mode => 3,
			   algorithm => $alg,
			   inception => time,
			   expiration => time + 24*60*60,
			   key => $tok,
			   other_data => "",
			   );

$gss_query->push("answer", $a);

my $reply = $nameserver->send($gss_query);

if (!defined($reply) || $reply->header->{'rcode'} ne 'NOERROR') {
	print "failed to send TKEY\n";
	return undef;
    }

my $key2 = ($reply->answer)[0]->{"key"};

# call gss_init_sec_context() again. Strictly speaking
    # we should loop until this stops returning CONTINUE
    # but I'm a lazy bastard
    $status = $context->init($cred, $name, undef, $flags,
			     0, undef, $key2, undef, $tok,
			     undef, undef);
    if (! $status) {
	print "init_sec_context step 2: $status\n";
	return undef;
    }

#    print "verifying\n";

### FIXME: Check fails !
    # check the signature on the TKEY reply
    my $rc = sig_verify($context, $reply);
    if (! $rc) {
	print "Failed to verify TKEY reply: $rc\n";
#		return undef;
    }

#    print "verifying done\n";

return $context;
}

#######################################################################
# MAIN
#######################################################################

my %opt;

unless (GetOptions(\%opt, qw(keytabfile=s name=s domain=s ip=s ttl=s server=s))) {
    exit(1);
}

Authen::Krb5::init_context() || die "Problem with init_context: ".Authen::Krb5::error();

$opt{name} = hostname() if (not $opt{name});
$opt{domain} = Authen::Krb5::get_default_realm() if (not $opt{domain});
$opt{ttl} = 3600 if (not $opt{ttl});

$opt{keytab} = $ENV{KRB5_KTNAME} if (not $opt{keytab});
if (not $opt{keytab}) {
	my @list = split(':', Authen::Krb5::kt_default_name());
	$opt{keytab} = $list[1];
}

# find the name of the DNS server
my $server_name = find_server_name($opt{domain});
$server_name = $opt{server} if (defined($opt{server}));

# find the IP address
#$opt{ip} = Net::Address::IPv4::Local->connected_to($server_name) if (not $opt{ip});
my @lines = qx|/sbin/ifconfig eth0| or die("Can't get info from ifconfig: ".$!);
foreach(@lines){
	$opt{ip} = $1 if(/inet addr:([\d.]+)/);
}

warn "$0: $opt{name}.$opt{domain} set to $opt{ip} using $server_name for $opt{ttl} secs\n";

# find the nameservers
my $nameserver = find_nameservers("$opt{domain}.");

$nameserver->nameservers($opt{server}) if (defined($opt{server}));
#print $nameserver->print;

warn "Found ".$nameserver->nameservers." nameserver(s)\n";

if (!defined($nameserver) || $nameserver->{'errorstring'} ne 'NOERROR') {
    print "Failed to find a nameserver for domain $opt{domain}\n";
    exit 1;
}

if (!defined($server_name)) {
    print "Failed to find a DNS server name for $opt{domain}\n";
    exit 1;
}
warn "Using DNS server name $server_name\n";

$nameserver->nameservers($server_name);

# use a long random key name
my $key_name = int(rand 10000000000000);

# negotiate a TKEY key
my $gss_context = negotiate_tkey($nameserver, $opt{domain}, $server_name, $key_name, $opt{keytab}, $opt{name});
if (!defined($gss_context)) {
    print "Failed to negotiate a TKEY\n";
    exit 1;
}
#print "Negotiated TKEY $key_name\n";

# construct a signed update
my $update = Net::DNS::Update->new($opt{domain});

$update->push("pre", yxdomain("$opt{domain}"));
$update->push("update", rr_del("$opt{name}.$opt{domain}. A"));
$update->push("update", rr_add("$opt{name}.$opt{domain}. $opt{ttl} A $opt{ip}"));

my $sig = Net::DNS::RR->new(
			    Name    => $key_name,
			    Type    => "TSIG",
			    TTL     => 0,
			    Class   => "ANY",
			    Algorithm => $alg,
			    Time_Signed => time,
			    Fudge => 36000,
			    Mac_Size => 0,
			    Mac => "",
			    Key => $gss_context,
			    Sign_Func => \&gss_sign,
			    Other_Len => 0,
			    Other_Data => "",
			    Error => 0,
			    );

$update->push("additional", $sig);

# send the dynamic update
my $update_reply = $nameserver->send($update);

if (! defined($update_reply)) {
    print "No reply to dynamic update\n";
    exit 1;
}

# make sure it worked
my $result = $update_reply->header->{"rcode"};

warn "Update gave rcode $result\n";

if ($result ne 'NOERROR') {
    exit 1;
}

exit 0;

Places

File nsupdate-gss of Package nsupdate-gss

Places