#!/usr/local/bin/perl
#
# @(#) dyndns.pl - Update Your Dynamic DNS address.
# @(#) $Id: dyndns.pl,v 1.4 2001/01/18 19:41:44 jaalto Exp $
#
# {{{ Documentation
#
#   File id
#
#       Copyright (C)   1999-2001 Jari Aalto
#       Created:        1999-11
#       Keywords:       Perl, dynamic IP update, dyndns.org
#       PerlVer:        5.004
#
#       This program is free software; you can redistribute it and/or
#       modify it under the terms of the GNU General Public License as
#       published by the Free Software Foundation; either version 2 of
#       the License, or (at your option) any later version.
#
#       This program is distributed in the hope that it will be useful, but
#       WITHOUT ANY WARRANTY; without even the implied warranty of
#       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#       General Public License for more details.
#
#       You should have received a copy of the GNU General Public License along
#       with this program; if not, write to the Free Software Foundation,
#       Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#   About program layout
#
#       The {{ }}} marks you see in this file are party of file fold
#       conrol package called folding.el (Unix Emacs lisp package).
#       ftp://ftp.csd.uu.se/pub/users/andersl/beta/ to get the latest.
#
#       There is also lines that look like # ....... &tag ... and they
#       are generated by Emacs Lisp package tinybm.el, which is also
#       document structure tool. You can jump between the blocks with
#       Ctrl-up and Ctrl-down keys and create those "bookmarks" with
#       Emacs M-x tibm-insert. See mentioned URL cs.uta.fi.
#
#   Funny identifiers at the top of file
#
#       The GNU RCS ident(1) program can print usefull information out
#       of all variables that are in format $ IDENTIFIER: text $
#       See also Unix man pages for command what(1) which outputs all lines
#       matching @( # ). Try commands:
#
#       % what  PRGNAME
#       % ident PRGNAME
#
#   Details how to uodate dyndns.org account
#
#	To create an account [2000-11-04]
#	http://members.dyndns.org/newacct
#
#	According to the developer page at
#	http://support.dyndns.org/dyndns/clients/devel.shtml
#
#	majordomo@dyndns.org with "subscribe devel" in the body of the message
#	The signup e-mail will have information about the test account
#	to be used in client testing to avoid blocks on your own account.
#
#	Authentication in URL (all one line):
#
#	http://username:password@members.dyndns.org/nic/dyndns?action=edit&started=1&hostname=YES&host_id=yourhost.ourdomain.ext&myip=ipaddress&wildcard=OFF&mx=mail.exchanger.ext&backmx=NO
#
#	HTTP GET Request
#	followed by at least a Host: header,
#	an Authorization: header, and a User-Agent: header):
#
#	GET /nic/dyndns?action=edit&started=1&hostname=YES&host_id=yourhost.ourdomain.ext&myip=ipaddress&wildcard=OFF&mx=mail.exchanger.ext&backmx=NO HTTP/1.1
#
#   Change Log:

# }}}


IMPORT:                            # This is just syntactic sugar: actually no-op
{
    use 5.004;

    use Env;
    use strict;
    use English;
    use File::Basename;
    use Getopt::Long;


    use autouse 'Pod::Text'     => qw( pod2text );

    use HTTP::Request::Common;
    use HTTP::Headers;
    use LWP::UserAgent;
    use LWP::UserAgent;
    use LWP::Simple;


    use vars qw ( $VERSION );

    #   This is for use of Makefile.PL and ExtUtils::MakeMaker
    #   So that it puts the tardist number in format YYYY.MMDD
    #   The REAL version number is defined later

    #   The following variable is updated by Emacs setup whenever
    #   this file is saved. See Tiny Tools Emacs library collection
    #   at http://www.sourceforge.net/ and in the zip kit, Emacs
    #	lisp package file tinymy.el

    $VERSION = '2001.0118';

}

my $CONNECT_SITE = "members.dyndns.org";


# ****************************************************************************
#
#   DESCRIPTION
#
#       Set global variables for the program
#
#   INPUT PARAMETERS
#
#	none
#
#   RETURN VALUES
#
#       none
#
# ****************************************************************************

sub Initialize ()
{
    use vars qw
    (
	$PROGNAME
	$LIB
	$WIN32

	$FILE_ID
	$VERSION
	$CONTACT
	$URL
	$DYNDNS_PL_CFG
    );

    $PROGNAME	= basename $PROGRAM_NAME;
    $LIB	= $PROGNAME;

    my $id = "$LIB.Initialize";

    $FILE_ID  = q$Id: dyndns.pl,v 1.4 2001/01/18 19:41:44 jaalto Exp $;
    $VERSION = (split (' ', $FILE_ID))[2];
    $CONTACT = "<jari.aalto\@poboxes.com>";
    $URL     = "http://poboxes.com/jari.aalto/";

    $WIN32   = 1   if  $OSNAME =~ /win32/i;

    $OUTPUT_AUTOFLUSH = 1;

    unless ( defined $DYNDNS_PL_CFG )
    {
	die "$id: Environment variable DYNDNS_PL_CFG missing. ";
    }

}


# }}}
# {{{ Help page


# ***************************************************************** &help ****
#
#   DESCRIPTION
#
#       Print help and exit.
#
#   INPUT PARAMETERS
#
#	$msg	[optional] Reason why function was called.-
#
#   RETURN VALUES
#
#       none
#
# ****************************************************************************

=pod

=head1 NAME

@(#) dns-dyndns.pl - Update www.dyndns.org Dynamic IP address

=head1 SYNOPSIS

    dyndns.pl --login LOGIN --pass PASSWORD --Host yourhost.dyndns.org

=head1 OPTIONS

=head2 Gneneral options

=over 4

=item B<--login LOGINNAME>

Use dyndns account LOGINNAME

=item B<--password PASSWORD>

Use dyndns account PASSWORD

=item B<--Host HOST>

Update account information registered for HOST

=item B<--mxhost MX-HOST-NAME>

Update account information with MX hostname. Specifies a Mail eXchanger for
use with the host being modified. Must resolve to an IP address, or it will
be ignored.

The servers you list need to be correctly configured to accept mail for
your hostname, or this will do no good. Setting up a server as an MX
without permission of the administrator may get them angry at you. If we
are contacted about such an infraction, we will remove the MX record and
possibly take further action to prevent it from happening again. Any mail
sent to a misconfigured server listed as an MX may bounce, and may be lost.

=item B<--Wildcard>

Turn on Wildcard option. The wildcard aliases *.yourhost.ourdomain.ext to
the same address as yourhost.ourdomain.ext.

=item B<--Mxoption>

Turn on MX option. Request that the MX in the previous parameter be set up
as a backup. This means that mail will first attempt to deliver to your
host directly, and will be delivered to the MX listed as a backup.

=back

=head2 Miscellaneous options

=over 4

=item B<--debug LEVEL>

Turn on debug with positive LEVEL number. Zero means no debug.

=item B<--help>

Print help

=item B<--test>

Run in test mode, do not actually do anything.

=item B<--verbose>

Print informational messages.

=item B<--Version>

Print contact and version information

=back

=head1 README

This is a Perl client for updating a dynamic DNS IP information at
http://www.dyndns.org/ or http://members.dyndns.org/. Visit the page and
create an account as instructed and remember the login, password and host
name you regeistered. For developing your own client with alternative
language, refer to page:
http://support.dyndns.org/dyndns/clients/devel.shtml

The Dynamic DNS service allows you to alias a dynamic IP address to a
static hostname, allowing your computer to be more easily accessed from
various locations on the Internet. We provide this service for free to the
Internet community as a whole.

A separate file is used for rememberring the last used IP to
prevent updating the same IP address again. (Following the
guidelines of dyndns.)

=head1 TROUBLESHOOTING

Turn on --debug to see exact details what HTTP requests are
sent and received.

=head1 EXAMPLES

To upate your account information:

    % dyndns.pl --login LOGIN --password PASS --Host your.dyndns.org

If you're running a Web server, you also want to add C<--Wildcard>
option.

=head1 ENVIRONMENT

Define a variable DYNDNS_PL_CONFIG to point to a B<permanent> location of
last saved IP address. Make sure that this file does not get deleted. If
the file gets deleted and you happen to update SAME ip twice, according to
dyndns FAQ, your address may be blocked.

    in your $HOME/.cshrc
    setenv DYNDNS_PL_CFG $HOME/config/dyndns.pl.conf

    in your $HOME/.bashrc
    export DYNDNS_PL_CFG=$HOME/config/dyndns.pl.conf

    in you Win32 C:/AUTOEXEC.BAT
    set DYNDNS_PL_CFG=C:/must-not-be-temp-dir/dyndns.pl.conf

    For win2000 and WinME, you must set the value in Windows
    ControlPanel->System->Environment.

=head1 FILES

See ENVIRONMENT

=head1 SEE ALSO

LPW::UserAgent

For more about approved clients for dyndns.org, refer to:
http://members.dyndns.org/nic/clients/testing

=head1 BUGS

<known limitations>

=head1 AVAILABILITY

CPAN entry is at http://www.perl.com/CPAN-local//scripts/
Reach author at C<jari.aalto@poboxes.com>

=head1 SCRIPT CATEGORIES

CPAN/Administrative
FCPAN/Networking

=head1 PREREQUISITES

None.

=head1 COREQUISITES

None.

=head1 OSNAMES

C<any>

=head1 VERSION

$Id: dyndns.pl,v 1.4 2001/01/18 19:41:44 jaalto Exp $

=head1 AUTHOR

Copyright (C) 1999-2001 Jari Aalto. All rights reserved.
This program is free software; you can redistribute and/or modify program
under the same terms as Perl itself or in terms of Gnu General Public
licence v2 or later.

=cut


sub Help (;$)
{
    my $id  = "$LIB.Help";
    my $msg = shift;  # optional arg, why are we here...

    pod2text $PROGRAM_NAME;

    defined $msg  and  print $msg;

    exit 1;
}



# }}}
# {{{ Command line arguments

# ************************************************************** &args *******
#
#   DESCRIPTION
#
#       Read and interpret command line arguments ARGV. Sets global variables
#
#   INPUT PARAMETERS
#
#	none
#
#   RETURN VALUES
#
#	none
#
# ****************************************************************************

sub HandleCommandLineArgs ()
{
    my    $id = "$LIB.HandleCommandLineArgs";

    my ( $help, $version );

    use vars qw
    (
	$LOGIN
	$PASS
	$HOST
	$MXHOST
	$OPT_WILDCARD
	$OPT_MX

	$debug
	$verb
	$test
    );

    $debug = 0;

    # .................................................... read args ...

    Getopt::Long::config( qw
    (
	no_ignore_case
        require_order
    ));

    GetOptions      # Getopt::Long
    (
	  "h|help"		=> \$help
	, "verbose"		=> \$verb
	, "test"		=> \$test
	, "Version"		=> \$version
	, "debug"		=> \$debug

	, "login=s"		=> \$LOGIN
	, "password=s"		=> \$PASS
	, "Host=s"		=> \$HOST
	, "mxhost=s"		=> \$MXHOST
	, "Wildcard"		=> \$OPT_WILDCARD
	, "Mxoption"		=> \$OPT_MX
    );

    $version        and die "$VERSION $PROGNAME $CONTACT $URL\n";
    $help           and Help();
    $verb = 1	    if  $debug;
    $verb = 1	    if  $test;

    unless ( $LOGIN  and  $PASS  and  $HOST)
    {
	die "$id: Need minimum options: --login .. --pass .. --Host ..";
    }

    if ( defined $OPT_WILDCARD )
    {
	$OPT_WILDCARD = "ON";
    }
    else
    {
	$OPT_WILDCARD = "OFF";
    }

    if ( defined $OPT_MX )
    {
	$OPT_MX = "YES";
    }
    else
    {
	$OPT_MX = "NO";
    }

}

# }}}


# ****************************************************************************
#
#   DESCRIPTION
#
#       Return last used ip address.
#
#	http://support.dyndns.org/dyndns/faq.shtml
#
#	A Dynamic DNS hostname only needs to
#       be updated when your IP address has changed. Any updates more
#       frequently than this - from the same IP address - will be
#       considered abusive by the update system and may result in your
#       hostname becoming blocked. Any script which runs periodically
#       should check to make sure that the IP has actually changed before
#       making an update, or the host will become blocked. An exception to
#       this is for users with mostly static IP addresses; you may update
#       24-30 days after your previous update with the same IP address to
#       "touch" the record and prevent it from expiring. Users will receive
#       an e-mail notification if a host has been unchanged for 28 days.
#
#   INPUT PARAMETERS
#
#	none
#
#   RETURN VALUES
#
#	string
#
# ****************************************************************************

sub GetIpAddressLast ()
{
    my $id = "$LIB.GetIpAddressLast";

    local ( *FILE, $ARG );

    return unless -f $DYNDNS_PL_CFG;

    open FILE, $DYNDNS_PL_CFG
	or die "$id: Cannot open DYNDNS_PL_CFG at [$DYNDNS_PL_CFG] $ERRNO";

    my $ip;

    while ( defined( $ARG = <FILE>) )
    {
	if ( /^\s*([\d.]+)\s*$/ )
	{
	    $ip = $1;
	    last;
	}
    }

    close FILE;


    $debug  and  print "$id: IP is $ip\n";

    $ip;
}


# ****************************************************************************
#
#   DESCRIPTION
#
#       Write last used IP address
#
#   INPUT PARAMETERS
#
#	$	ip address to write
#
#   RETURN VALUES
#
#	none
#
# ****************************************************************************

sub WriteIpAddress ( $ )
{
    my $id   = "$LIB.WriteIpAddress";
    my ($ip) = @ARG;

    local ( *FILE, $ARG );

    open FILE, "> $DYNDNS_PL_CFG"
	or die "$id: Cannot write DYNDNS_PL_CNG at [$DYNDNS_PL_CFG] $ERRNO";

    print FILE "$ip\n";


    $debug  and  print "$id Wrote $ip to $DYNDNS_PL_CFG\n";

    close FILE;
}



# ****************************************************************************
#
#   DESCRIPTION
#
#       Get current IP by running IPconfig.exe
#
#   INPUT PARAMETERS
#
#	none
#
#   RETURN VALUES
#
#	$	    ip address
#
# ****************************************************************************


sub GetIpAddressWin32 ()
{
    my @list = `ipconfig`;

    my @ip = grep /\.\s+\.:\s+\S+/, @list;
    my ( $ip ) = $ip[0] =~ /:\s+(\S+)/;


    $debug  and  print "$id: IP is $ip\n";

    $ip;
}


# ****************************************************************************
#
#   DESCRIPTION
#
#       Get current IP address information. dies if cannot detect ip address.
#
#   INPUT PARAMETERS
#
#	none
#
#   RETURN VALUES
#
#	string
#
# ****************************************************************************

sub GetIpAddress ()
{
    my $id = "GetIpAddress";

    if ( $WIN32 )
    {
	GetIpAddressWin32();
    }
    else
    {
	die "$id: Don't know how to get your IP address in this OS";
    }
}


# ****************************************************************************
#
#   DESCRIPTION
#
#       Main entry point
#
#   INPUT PARAMETERS
#
#	none
#
#   RETURN VALUES
#
#	none
#
# ****************************************************************************

sub Main ()
{
    Initialize();
    HandleCommandLineArgs();

    my $id      = "$LIB.main";

    my $connect = $CONNECT_SITE;
    my $ip	= GetIpAddress();
    my $lastIP	= GetIpAddressLast();


    $debug  and  print "$id: IP now '$ip' IP last '$lastIP'\n";

    if ( defined $lastIP  and not $test )
    {
	if ( $ip  eq  $lastIP )
	{
	    die "$id: It is not allowed to update same IP address twice: $ip";
	}
    }

    WriteIpAddress $ip;


    my $ua = new LWP::UserAgent
	or die "$id: LWP::UserAgent failed $ERRNO";

    $verb  and  print "$id: Updating IP $ip\n";


    my $url =
	""
	. "http://${LOGIN}:${PASS}\@${connect}"
	. "/nic/dyndns"
	. "?action=edit&started=1&hostname=YES"
	. "&host_id=${HOST}"
	. "&myip=${ip}"
	. "&wildcard=$OPT_WILDCARD"
	. "&backmx=$OPT_MX"
	;

    $url .= "&mx=$HOSTMX" if $HOSTMX;

    $req  = new HTTP::Request( 'GET', $url );

    $req->user_agent( "Perl client $PROGNAME" );
    $req->header( "Host", $HOST );
    $req->authorization_basic( $LOGIN, $PASS );

    if ( $test  or  $debug )
    {
	print $req->as_string;
    }

    unless ( $test )
    {
	$resp = $ua->request( $req );
	$verb  and  print $resp->as_string;
    }
}


Main();


__END__
