nspamper

#!/usr/bin/perl -w

#
# Copyright (c) 2008 Rainer Clasen
#
# This program is free software; you can redistribute it and/or modify
# it under the terms described in the file LICENSE included in this
# distribution.
#

=head1 NAME

nspamper - daemon to update dynamic DNS names

=head1 SYNOPSIS

 nspamper <options>

=head1 DESCRIPTION

This is a bind9 nsupdate client to keep a dynamic A record up to date

Changes must be triggered using L<nspamper-change> which writes the new IP
to a UNIX Socket. Permissions to this socket determin who's able to
submitt new IPs.

This daemon will retry to send the update until the Nameserver returns the
proper IP. Updates and IP verification are directly sent to the Nameserver
listed in the Zone's SOA.

Once the update was successfull, this script assumes, the server won't
forget the IP and therefor sleeps until the IP is changed again.

This has to run as daemon, to avoid problems with overlapping requests.
That means it gracefully accepts a new IP although the current one wasn't
accepted by the nameserver, yet.

=head1 OPTIONS

=over 4

=item B<--config>=I<config>

Config file to read hostname and tsig key from. See FILES for details.

=item B<--[no]daemon>

Do (not) detach from tty.

=item B<--help>

Displays short usage info.

=item B<--key>=I<key-string>

TSIG key string. BEWARE: this will show up within ps. Please use the
config file for this.

=item B<--name>=I<hostname>

Dyndns hostname to take care of.

=item B<--pidfile>=I<pidfile-path>

Pidfile name.

=item B<--socketpath>=I<socket-path>

Alternative path for unix socket to listen on. Make sure you use the same
path for nspamper-change.

=item B<--statuspath>=I<status-path>

path to store status information in.

=back

=cut


use strict;
use Sys::Syslog;
use Socket;
use POSIX;
use Nspamper;
use Getopt::Long;


our $VERSION = "0.1.2";
my $prog = "nspamper";

my $daemon = 1;
my $conf = "/etc/$prog.conf";
my $ostatuspath = "/var/lib/$prog";
my $osocketpath = "/var/run/$prog.sock";
my $opidfile = "/var/run/$prog.pid";

my $wanthelp;
my $needhelp;

GetOptions(
	"config=s"	=> \$conf,
	"daemon!"	=> \$daemon,
	"help|h!"	=> \$wanthelp,
	"pidfile=s"	=> \$opidfile,
	"socketpath=s"	=> \$osocketpath,
	"statuspath=s"	=> \$ostatuspath,
) || $needhelp++;

if( $wanthelp ){
	print <<EOF;
usage: $0 [<options> ...]
client daemon for dynaimc DNS / nsupdates

options:
 --config=<conf>      config file
 --[no]daemon         do (not) detach from tty
 --help|-h            this info
 --pidfile=<file>     where to record the process ID
 --socketpath=<sock>  path for unix socket to listen on
 --statuspath=<dir>   path to keep status information in (last known IP)

EOF
	exit 0;
}

if( $needhelp ){
	print STDERR "use $0 --help for usage info\n";
	exit 0
}

# read config
our( $statuspath, $socketpath, $pidfile, @names );
if( -r $conf ){
	if( ! do $conf ){
		print STDERR "failed to read $conf\n";
		exit 1;
	}
}

# set defaults / cmdline
$statuspath ||= $ostatuspath;
$socketpath ||= $osocketpath;
$pidfile ||= $opidfile;

if( ! @names ){
	print STDERR "no names configured, exiting\n";
	exit 1;
}

our $terminate;
my %want;

our %rr = (
	A	=> 1,
	AAAA	=> 1,
);

foreach my $ent ( @names ){
	# TODO: automagically split name -> host + domain
	unless( $ent->{domain} =~ /^[a-z][\w.]+$/ ){
		print STDERR "invalid domain: $ent->{domain}\n";
		++$terminate;
	}

	unless( $ent->{host} =~ /^[a-z][\w.]+$/ ){
		print STDERR "invalid name: $ent->{host}\n";
		++$terminate;
	}

	unless( $ent->{key} =~ /^\S+==$/ ){
		print STDERR "invalid TSIG key for $ent->{host}: $ent->{key}\n";
		++$terminate;
	}

	$ent->{updated} = 0;

	$ent->{link} ||= 'default';

	$want{$ent->{link}} = {};
}
exit 1 if $terminate;

# daemonize
use vars qw( $cleanup );

if( $daemon ){
	# TODO: close STDERR, detach tty

	my $pid = fork;
	if( $pid < 0 ){
		print STDERR "fork() failed: $!\n";
		exit 1;

	} elsif( $pid > 0 ){
		exit 0;
	}

	open( STDIN, "</dev/null");
	open( STDOUT, ">/dev/null");
	open( STDERR, ">&STDOUT");
}


openlog( $prog, "pid", "daemon" );
syslog( "info", "starting" );
&pidfile( $pidfile ) or exit 1;

$cleanup++;
END {
	if( $cleanup ){
		syslog( "info", "exiting" );
		close SOCK;
		unlink $socketpath;
		unlink $pidfile;
	}
}

$SIG{INT} = $SIG{TERM} = sub {
	syslog( "info", "got SIG$_[0]" );
	$terminate++;
};


unlink $socketpath;
if( ! socket( SOCK, PF_UNIX, SOCK_STREAM, 0 )){
	syslog( "err", "failed to open socket: $!" );
	exit 1;
}
if( ! bind( SOCK, sockaddr_un($socketpath)) ){
	syslog( "err", "failed to bind socket: $!" );
	exit 1;
}
chmod( 0770, $socketpath );
if( ! listen( SOCK, SOMAXCONN) ){
	syslog( "err", "failedt to listen: $!");
	exit 1;
}

&read_status;

my $timeout = undef;
while(1){
	last if $terminate;

	my $pamper = Nspamper->new;

	my $retry;
	foreach my $ent ( @names ){
		next if $ent->{updated};
		my $want = $want{$ent->{link}}
			or next;

		my $name = "$ent->{host}.$ent->{domain}";
		syslog( "debug", "checking $name");

		my $changes = $pamper->compare(
			$ent->{domain},
			$ent->{host},
			$want,
		);

		if( ! $changes ){
			syslog( "notice", "failed to check changes for $name");
			++$retry;

		} elsif( ! @$changes ){
			syslog( "debug", "no changes for $name");
			++$ent->{updated};

		} else {
			syslog( "debug", "updating $ent->{host}");
			foreach my $c ( @$changes ){
				syslog( "debug", "set $c->{name}"
					."/$c->{type}=".($c->{want}||'undef')
					." @". join(',', $c->{resolver}->nameservers) );
			}

			if( ! $pamper->update( $ent->{key}, $ent->{algorithm}, $changes ) ){
				syslog( "notice", "failed to update $name");
				++$retry;
			} else {
				syslog( "info", "updated $name, to verify");
				++$retry;
			}
		}
	}

	$timeout = $retry ? 10 : undef; # TODO: configurable
	syslog( "debug", "waiting for IP change" ) unless $timeout;

	my $rin = '';
	vec( $rin, fileno(SOCK), 1 ) = 1;
	if( 0 >= select( $rin, undef, undef, $timeout ) ){
		next;
	}

	if( ! accept( CLIENT, SOCK) ){
		syslog( "err", "accept failed: $!" );
		next;
	}

	while(<CLIENT>){
		chomp;

		my( $link, $rr, $data ) = split(/\s/, $_, 3);

		if( ! $want{$link} ){
			syslog( "err", "update for unknown link: $link");
			next;
		}

		if( ! $rr{$rr} ){
			syslog( "err", "update for unknown type: $rr");
			next;
		}

		syslog( "debug", "got new data for $link/$rr: ".($data||'undef'));

		if( $data eq '' ){
			$data = undef;
		} # TODO: check data

		$want{$link}{$rr} = $data;
		&write_status_rr( $link, $rr, $data );

		foreach my $ent ( @names ){
			$ent->{link} eq $link
				or next;

			$ent->{updated} = 0;
		}
	}
}


# remember IP for restart
sub write_status_rr {
	my( $link, $rr, $data ) = @_;

	syslog( "info", "remembering new $link/$rr=".($data||'undef'));

	my $fn = "$statuspath/$link.$rr";
	if( open( my $fh, ">", $fn) ){
		print $fh "$data\n";
		close $fh;
		return 1;
	}

	syslog( "err", "failed to open $fn: $!" );
	return;
}

sub is_ip {
	my $in = shift
		or return;

	my @q = ( $in =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/ )
		or return;

	foreach my $b( @q ){
		return unless defined $b;
		return if $b > 255;
	}
	return 1;

}

# read stored IP on startup
sub read_status {
	my $fail;

	foreach my $link ( sort keys %want ){
		foreach my $rr ( sort keys %rr ){
			&read_status_rr( $link, $rr )
				or ++$fail;
		}
	}

	return !$fail;
}

sub read_status_rr {
	my( $link, $rr ) = @_;

	my $fn = "$statuspath/$link.$rr";

	open( my $fh, "<", $fn ) or return;
	my $data = <$fh>;
	close $fh;

	chomp $data;
	if( $data eq '' ){
		$data = undef;
	} # TODO: check data

	$want{$link}{$rr} = $data;
	syslog('debug', "old $link/$rr=".($data||'undef') );

	return 1;
}

# wait until we get a new IP
sub wait_newip {
	my( $timeout ) = @_;

}


sub pidfile {
	my $file = shift;

	my $pid = $$;
	if( open( my $fh, "<", $file )){
		# lockfile exists!

		my $oldpid = <$fh>;
		close($fh);
		chomp $oldpid;

		if( ($oldpid =~ /^\d+$/) && ! kill 0, $oldpid ){
			syslog( "info", "overriding stale lockfile");
			unlink( $file );

		} else {
			syslog( "err", "already runing with PID $oldpid");
			return;
		}
	}

	# TODO: use Proc::PID::File
	if( sysopen(my $fh, $file, O_WRONLY | O_EXCL | O_CREAT, 0644) ){
		print $fh $pid, "\n";
		close $fh;
		return 1;
	}

	syslog( "err", "cannot create pidfile $file: $!" );
	return;
}


=head1 FILES

/etc/nspamper.conf - config file. Uses perl syntax. The following settings
are known:

=over 4

=item B<@names> = (I<hashrefs_of_name_and_key>)

List of hostnames and keys.

 @names = ({
    name => "host1",
    domain => "dyn.example.org",
    key => "<key1>",
    link => 'default',
 }, {
    name => "host2",
    domain => "dyn.example.org",
    key => "<key2>",
    link => 'tdsl',
 });

TSIG key as generated with:

 dnssec-keygen  -a HMAC-MD5 -b 512 -n USER <hostname>

They look like:

 abcdefghijklmnpfsuwjfsafjewuioglkgjosperjgfkcsigrekglfdgoegjfdsgisohruahfuiafduafdaasu==

=item B<$pidfile> = 'I<pidfile-path>';

Pidfile name.

=item B<$socketpath> = 'I<socket-path>';

Alternative path for unix socket to listen on. Make sure you use the same
path for nspamper-change.

=item B<$statuspath> = 'I<status-path>';

path to store status information in.

=back

=head1 BUGS

Search the source for "TODO" to find some, but I bet there are plenty
more.

=head1 AUTHOR

Rainer Clasen E<lt>rc@zuto.deE<gt>

=head1 SEE ALSO

L<nspamper-change>, L<nsupdate>.

=cut

__END__