<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/local/bin/perl
#
# @(#) dyndns.pl - Update Your Dynamic DNS address.
# @(#) $Id: dyndns.pl,v 1.13 2001/12/13 17:17:55 jaalto Exp $
#
# {{{ Documentation
#
#   File id
#
#       Copyright (C)   1999-2002 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 (Emacs lisp package).
#       ftp://ftp.csd.uu.se/pub/users/andersl/beta/ to get the latest.
#
#       There is also lines that look like # ....... &amp;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&amp;started=1&amp;hostname=YES&amp;host_id=yourhost.ourdomain.ext&amp;myip=ipaddress&amp;wildcard=OFF&amp;mx=mail.exchanger.ext&amp;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&amp;started=1&amp;hostname=YES&amp;host_id=yourhost.ourdomain.ext&amp;myip=ipaddress&amp;wildcard=OFF&amp;mx=mail.exchanger.ext&amp;backmx=NO HTTP/1.1
#
#	2001-06, the above specification has changed. The new specification
#	is listed in http://support.dyndns.org/dyndns/clients/devel/query.shtml
#	and look like this:
#
#
#	http://username:password@members.dyndns.org/nic/update?system=dyndns&amp;hostname=yourhost.ourdomain.ext,yourhost2.dyndns.org&amp; myip=ipaddress&amp;wildcard=OFF&amp;mx=mail.exchanger.ext&amp;backmx=NO&amp;offline=NO
#
#	GET /nic/update?system=statdns&amp;hostname=yourhost.ourdomain.ext,yourhost2.dyndns.org &amp;myip=ipaddress&amp;wildcard=OFF&amp;mx=mail.exchanger.ext&amp;backmx=NO&amp;offline=NO HTTP/1.1
#	Host: members.dyndns.org
#	Authorization: Basic username:pass (note: username:pass must be encoded in base64)
#	User-Agent: myclient/1.0 me@null.net
#
#	...A test account is available for client testing to avoid having your
#	own hostnames blocked. Hosts test.* (all available domains) can be
#	updated under this account, and we unblock them on a fairly regular
#	basis. The username and password for this account are both "test".
#
#   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'     =&gt; qw( pod2text );
    use autouse 'Pod::Html'     =&gt; qw( pod2html );

    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 following variable is updated by Emacs setup whenever
    #   this file is saved. See Tiny Tools Emacs library collection
    #   at http://tiny-tools.sourceforge.net/ and Emacs
    #	lisp package tinyperl.el

    $VERSION = '2001.1217';


}

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

# {{{ Initialize

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

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

	$FILE_ID
	$VERSION2
	$CONTACT
	$URL
	$DYNDNS_PL_CFG
	$STATUS_CODE_HASH
    );

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

    my $id = "$LIB.Initialize";

    $FILE_ID  = q$Id: dyndns.pl,v 1.13 2001/12/13 17:17:55 jaalto Exp $;
    $VERSION2 = (split (' ', $FILE_ID))[2];
    $CONTACT  = "jari.aalto\@poboxes.com";
    $URL      = "http://poboxes.com/jari.aalto";

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

    $OUTPUT_AUTOFLUSH = 1;

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

    %STATUS_CODE_HASH =
    (
	# Pre-Update Errors
	#
	#   The codes above are only only given once, regardless of how many
	#   hosts are in the update.

	"badauth"	=&gt; "Bad authorization (username or password)"
	, "badsys"	=&gt; "The system parameter given was not valid."
	, "badagent"	=&gt; "The useragent your client sent has been blocked"
		. " at the access level. Support of this return code is optional."

	# Update Complete
	#
	#   The codes below indicate that the update was completed, in some
	#   fashion or another. This includes abusive updates, see the
	#   abuse code for more information.
	#
	#   Note that "update complete" messages will be followed by the IP
	#   address updated for confirmation purposes. This value will be
	#   space-separated from the update code.

	, "good"	=&gt; "Update good and successful, IP updated"
	, "nochg"	=&gt; "No changes, update considered abusive"

	# Input Error Conditions
	#
	#   The codes below indicate fatal errors, after which updating should
	#   be stopped pending user confirmation of settings or other
	#   appropriate data.
	#
	#   notfqdn will be returned once if no hosts are given.

	, "notfqdn"	=&gt; "A Fully-Qualified Domain Name was not provided."
	, "nohost"	=&gt; "The hostname specified does not exist"
	, "!donator"	=&gt; "The offline setting was set, when the user"
			. " is not a donator, this is only returned once"
	, "!yours"	=&gt; "The hostname specified exists, but not under"
			. " the username currently being used"
	, "abuse"	=&gt; "The hostname specified is blocked for abuse;"
			. " contact support to be unblocked"

	# Server Error Conditions
	#
	#   The conditions represented by the codes below should cause the
	#   client to stop and request that the user inform support what
	#   code was received. These are hard server errors that will have
	#   to be investigated.
	#
	#   Note: dnserr will be followed by a numeric packet ID which
	#   should be reported to the support department along with the
	#   error.

	, "numhost"	=&gt; "Too many or too few hosts found"
	, "dnserr"	=&gt; "DNS error encountered"

	# Wait Conditions
	#
	#   When one of the below codes is received, wait for the specified
	#   conditions to be met before attempting another update. Note:
	#   "xx" can be any integer. Note: An optional explanation of the
	#   delay may be present after the wait code, separated from the
	#   code by a space. Due to difficulties in implementation, the
	#   wuxxxx return has been removed from the spec.

	, "wxxh"	=&gt; "Wait xx hours."
	, "wxxm"	=&gt; "Wait xx minutes."
	, "wxxs"	=&gt; "Wait xx seconds."

	# Emergency Conditions

	#   To be used when things have all gone horribly wrong, mostly if
	#   the database or DNS server have died for whatever reason. Also
	#   will be sent if the NIC is closed for any reason, unless a
	#   timeframe is known.

	, "911"		=&gt; "Shutdown until notified otherwise via status.shtml"
	#   Same as 911, for British users :)
	, "999"		=&gt; "Shutdown until notified otherwise via status.shtml"
    );
}

# }}}
# {{{ Help page


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

=pod

=head1 NAME

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&lt;--login LOGINNAME&gt;

Use dyndns account LOGINNAME

=item B&lt;--password PASSWORD&gt;

Use dyndns account PASSWORD

=item B&lt;--Host HOST&gt;

Update account information registered for HOST

=item B&lt;--mxhost MX-HOST-NAME&gt;

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&lt;--Wildcard&gt;

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

=item B&lt;--Mx-option&gt;

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.

=item B&lt;--Offline-option&gt;

If given, Sets the host to offline mode "YES". The Default is "NO" . This
feature is only available to donators. The "!donator" return will be used if
this is set on a non-donator host.

=back

=head2 Special options

=over 4

=item B&lt;--ethernet CARD&gt;

The automatic IP detection uses ifconfig(1) in Linux system. You
can change the defaalt C&lt;eth0&gt; device from where the IP added is read
with this option.

=back

=head2 Miscellaneous options

=over 4

=item B&lt;--debug LEVEL&gt;

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

=item B&lt;--help&gt;

Print help

=item B&lt;--help-html&gt;

Print help in HTML format.

=item B&lt;--test&gt;

Run in test mode, do not actually do anything.

=item B&lt;--Test-driver&gt;

Run internal integrity test. This is for developer only.

=item B&lt;--test-account&gt;

Use DYNDNS test accoutn options. All command line values are ignored.
You should run this ONLY if you're a developer and you have read
client page C&lt;http://support.dyndns.org/dyndns/clients/devel/&gt;

=item B&lt;--verbose&gt;

Print informational messages.

=item B&lt;--Version&gt;

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.

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 remembering the last used IP to
prevent updating the same IP address again. This is necessary
in order to comply guidelines of dyndns. If you delete the last ip
address file, you force the program to request update again. You
should not normally need to touch the file where the ip address
is stored.

=head1 TROUBLESHOOTING

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

=head1 EXAMPLES

This program runs with Perl 5.004 or never. That is: Win32 Activestate
state build 520 or newer or Unix perl 5.004 or never. You can check
your perl version with "perl --version"

To upate your account information in Unix:

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

To update your account information in Win32, place this program along the
PATH and instruct perl to search PATH with command line option `-S'.
Win32 does not know how to run .pl programs, so you have to call Perl
explicitly:

    dos&gt; perl -S dyndns.pl --login LOGIN --password PASS --Host your.dyndns.org
	 =======

If you're running a local Web server, dyndns can direct calls to it.
Add C&lt;--Wildcard&gt; option to enable `www.*' web server redirection.

=head1 ENVIRONMENT

Define a variable DYNDNS_PL_CONFIG to point to a B&lt;permanent&gt; 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 registry
    ControlPanel-&gt;System-&gt;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

&lt;known limitations&gt;

=head1 AVAILABILITY

CPAN entry is at
http://cpan.perl.org/modules/by-authors/id/J/JA/JARIAALTO/
Reach author at C&lt;jari.aalto@poboxes.com&gt;

See also http://support.dyndns.org/dyndns/clients/

You can also develop your own client with alternative
language. The instructions are in page:
http://support.dyndns.org/dyndns/clients/devel.shtml

=head1 SCRIPT CATEGORIES

CPAN/Administrative
FCPAN/Networking

=head1 PREREQUISITES

None.

=head1 COREQUISITES

None.

=head1 OSNAMES

C&lt;any&gt;

=head1 VERSION

$Id: dyndns.pl,v 1.13 2001/12/13 17:17:55 jaalto Exp $

=head1 AUTHOR

Copyright (C) 1999-2002 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...
    my $type = shift;  # optional arg, type

    if ( $type eq -html )
    {
	pod2html $PROGRAM_NAME;
    }
    else
    {
	pod2text $PROGRAM_NAME;
    }

    defined $msg  and  print $msg;

    exit 1;
}



# }}}
# {{{ Command line arguments

# ************************************************************** &amp;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, $helpHTML, $version, $testAccount, $testDriver );

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

	$debug
	$verb
	$test
    );

    $debug = 0;

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

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

    GetOptions      # Getopt::Long
    (
	  "h|help"		=&gt; \$help
        , "help-html"           =&gt; \$helpHTML
	, "verbose"		=&gt; \$verb
	, "test"		=&gt; \$test
	, "Test-driver"		=&gt; \$testDriver
	, "test-account"	=&gt; \$testAccount
	, "Version"		=&gt; \$version
	, "debug"		=&gt; \$debug

	, "ethernet=s"		=&gt; \$ETHERNET

	, "login=s"		=&gt; \$LOGIN
	, "password=s"		=&gt; \$PASS
	, "Host=s"		=&gt; \$HOST
	, "mxhost=s"		=&gt; \$MXHOST
	, "Wildcard"		=&gt; \$OPT_WILDCARD
	, "Mx-option"		=&gt; \$OPT_MX
	, "Offline-option"      =&gt; \$OPT_OFFLINE
    );

    $version		and die "$VERSION $PROGNAME $CONTACT $URL\n";
    $help		and Help();
    $helpHTML		and Help(undef, -html);
    $testDriver		and TestDriver();

    $verb = 1		if  $debug;
    $verb = 1		if  $test;
    $ETHERNET = "eth0"	unless defined $ETHERNET;

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

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


    if ( defined $testAccount )
    {
	$LOGIN = "test";
	$PASS  = "test";
	$HOST  = "test.sea.dyndns.org";
    }
}

# }}}
# {{{ IP addresses

# ****************************************************************************
#
#   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 );

    unless ( -f $DYNDNS_PL_CFG )
    {

	$verb  and  print "$id: No file DYNDNS_PL_CFG [$DYNDNS_PL_CFG]\n";
	return;
    }

    $debug  and  print "$id: opening [$DYNDNS_PL_CFG]\n";

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

    my $ip;

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

    close FILE;


    $debug  and  print "$id: Last saved 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, "&gt; $DYNDNS_PL_CFG"
	or die "$id: Cannot write DYNDNS_PL_CFG at [$DYNDNS_PL_CFG] $ERRNO";

    print FILE "$ip\n";


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

    close FILE;
}

# ****************************************************************************
#
#   DESCRIPTION
#
#       Parse Ip address from INPUT by searching REGEXP line.
#	IP address must be the first numeric expression.
#
#   INPUT PARAMETERS
#
#	$	    regexp. Submatch 1 must contain the IP address portion.
#	@	    List of lines to search. Typically command's output.
#
#   RETURN VALUES
#
#	$	    ip address
#
# ****************************************************************************

sub IpAddressGenericParser ( $ @ )
{
    my $id		  = "$LIB.IpAddressGenericParser";
    my ($regexp, @lines ) = @ARG;

    local $ARG;
    my    $ip;

    for ( @lines )
    {
	if ( /$regexp/ )
	{
	    if ( not defined $1 )	    # User gave non-fucntional regexp
	    {
		if ( /(\d[\d.]+)/ )	    # try generic IP matcher
		{
		    $ip = $1;
		}
	    }
	    else
	    {
		$ip = $1;
	    }

	    $debug  and  print "$id: Matched [$ARG]\n";
	    last;
	}

    }

    $debug  and  print "$id: IP is [$ip]\n$id: Response=&gt;\n@lines\n";

    unless( $ip )
    {
	die "$id: [PANIC] Can't read IP [$regexp] [@lines].\n"
	    , "Contact $CONTACT"
	    ;
    }

    $ip;
}

# ****************************************************************************
#
#   DESCRIPTION
#
#       Get current IP by running COMMAND and searching for line
#	matching REGEXP. The IP address must be the first numeric
#	expression in the found REGEXP line.
#
#   INPUT PARAMETERS
#
#	$	    Command  which return IP address
#	$	    Regular expression to find line containing IP address.
#
#   RETURN VALUES
#
#	$	    ip address
#
# ****************************************************************************

sub GetIpAddressGenericParser ( $ $ )
{
    my $id	        = "$LIB.GetIpAddressGenericParser";
    my ($cmd, $regexp ) = @ARG;

    my @list = qx($cmd);

    $debug  and  print "$id: [$cmd] [@list]\n";

    unless ( @list )
    {
	die "$id: [PANIC] command [$cmd] did not return response.";
    }

    my $ip = IpAddressGenericParser $regexp, @list;

    $ip;
}

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

sub GetIpAddressWin32 ()
{
    my $id   = "$LIB.GetIpAddressWin32";
    my $cmd  = "ipconfig";

    #	The output looks like this:
    #
    #	Connection-specific DNS Suffix  . :
    #	IP Address. . . . . . . . . . . . : 212.246.177.28
    #	Subnet Mask . . . . . . . . . . . : 255.255.255.255
    #	Default Gateway . . . . . . . . . : 212.246.177.28

    my $ip = GetIpAddressGenericParser $cmd, 'IP\s+Address.*[ \t](\d[\d.]+)';

    $verb  and  print "$id: $cmd =&gt; $ip\n";

    $ip;
}

# ****************************************************************************
#
#   DESCRIPTION
#
#       Get current IP address information from ethernet CARD.
#       Global variable ETHERNET can be set via command line option.
#
#   INPUT PARAMETERS
#
#	none
#
#   RETURN VALUES
#
#	string
#
# ****************************************************************************

sub GetIpAddressIfconfig ()
{
    my $id = "$LIB.GetIpAddressIfconfig";
    my $cmd  = "ifconfig $ETHERNET";

    # $ /sbin/ifconfig eth0
    # eth0      Link encap:Ethernet  HWaddr 00:10:5A:64:8D:32
    # 	    inet addr:12.246.164.15  Bcast:255.255.255.255  Mask:255.255.255.0
    # 	    UP BROADCAST RUNNING  MTU:1500  Metric:1
    # 	    RX packets:38180 errors:0 dropped:0 overruns:0 frame:0
    # 	    TX packets:12211 errors:0 dropped:0 overruns:0 carrier:1
    # 	    collisions:46 txqueuelen:100
    # 	    Interrupt:11 Base address:0xec00

    my $ip = GetIpAddressGenericParser $cmd, 'inet\s+addr:\s*(\d[\d.]+)';

    $verb  and  print "$id: $cmd =&gt; $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 = "$LIB.GetIpAddress";

    my $ret;

    if ( $WIN32 )
    {
	$ret = GetIpAddressWin32();
    }
    elsif ( -x "/sbin/ifconfig"  or  -x "/usr/sbin/ifconfig")
    {
	$ret = GetIpAddressIfconfig();
    }
    else
    {
	die "$id: Don't know how to get your IP address in this OS"
	    . "Please contain maintainer $CONTACT"
	    ;
    }

    $ret;
}



# ****************************************************************************
#
#   DESCRIPTION
#
#       See if there is anything to inform about status code
#
#   INPUT PARAMETERS
#
#	$code
#	$description
#
#   RETURN VALUES
#
#	None
#
# ****************************************************************************

sub StatusCodeHandle ( $ $ )
{
    my $id		= "$LIB.StatusCodeHandle";
    my ($code, $desc)	= @ARG;

    # TODO:

}

# ****************************************************************************
#
#   DESCRIPTION
#
#       Parse status code
#
#   INPUT PARAMETERS
#
#	$response   HTTP response string
#
#   RETURN VALUES
#
#	$code, $string	    status code and description string
#
# ****************************************************************************

sub StatusCodeParse ( $ )
{
    my $id	 = "$LIB.StatusCodeParse";
    local ($ARG) = @ARG;

    #	The response look like:
    #
    #    dyndns.pl.main: Updating IP 212.246.177.25
    #    HTTP/1.1 200 OK
    #    Connection: close
    #    Date: Sun, 10 Jun 2001 22:11:25 GMT
    #    Pragma: no-cache
    #    Server: Apache/1.3.20 (Unix) mod_perl/1.25
    #    Content-Type: text/plain
    #    Client-Date: Sun, 10 Jun 2001 22:16:54 GMT
    #    Client-Peer: 66.37.218.209:80
    #
    #    nohost 212.246.177.25


    # Get last string from the @lines

    my $code = (reverse split /\n/)[0];

    if ( $code =~ /([a-zA-Z]+)/ )		    # find first word
    {
	$code = $1;
    }


    my $desc = "WARNING there is no ret code description defined for [$code]";


    if ( exists $STATUS_CODE_HASH{$code} )
    {
	$desc = $STATUS_CODE_HASH{$code};
    }
    elsif ( $code =~ /good/i )
    {
	$desc = "Update successful.";
    }

    $code, $desc;
}




# }}}
# {{{ Main and test drivers


# ****************************************************************************
#
#   DESCRIPTION
#
#       Test Driver for the program. Exists when done.
#
#   INPUT PARAMETERS
#
#	none
#
#   RETURN VALUES
#
#	none
#
# ****************************************************************************


sub TestDriver ()
{
    my $id = "$LIB.TestDriver";
    print "$id: BEGIN\n";

    $debug = 10;
    $verb  = $debug;

    my (@response, $ip);

    @response = split /\r?\n/, '
eth0      Link encap:Ethernet  HWaddr 00:10:5A:64:8D:32
	    inet addr:12.246.164.15  Bcast:255.255.255.255  Mask:255.255.255.0
	    UP BROADCAST RUNNING  MTU:1500  Metric:1
	    RX packets:38180 errors:0 dropped:0 overruns:0 frame:0
	    TX packets:12211 errors:0 dropped:0 overruns:0 carrier:1
	    collisions:46 txqueuelen:100
	    Interrupt:11 Base address:0xec00';

    $ip = IpAddressGenericParser 'inet\s+addr:[ \t]*(\d[\d.]+)', @response;

    @response =  split /\r?\n/, '
Connection-specific DNS Suffix  . :
IP Address. . . . . . . . . . . . : 212.246.177.28
Subnet Mask . . . . . . . . . . . : 255.255.255.255
Default Gateway . . . . . . . . . : 212.246.177.28';


    $ip = IpAddressGenericParser 'IP\s+Address.*[ \t](\d[\d.]+)', @response;


    print "$id: END\n";
    die;
}


# ****************************************************************************
#
#   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() || "NoLastIPKnown";


    $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  unless $test;


    $debug  and  print "$id: saved last used IP Address\n";

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

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

    #   This is old, do not use
    my $url2 =
	""
	. "http://${LOGIN}:${PASS}\@${connect}"
	. "/nic/dyndns"
	. "?action=edit&amp;started=1&amp;hostname=YES"
	. "&amp;host_id=${HOST}"
	. "&amp;myip=${ip}"
	. "&amp;wildcard=$OPT_WILDCARD"
	. "&amp;backmx=$OPT_MX"
	;

    # 2001-06 Specification has changed, this is new one:

    my $url =
	""
	. "http://${LOGIN}:${PASS}\@${connect}"
	. "/nic/update"
	. "?system=dyndns"
	. "&amp;hostname=${HOST}"    # hostname=host,host,host..
	. "&amp;myip=${ip}"
	. "&amp;wildcard=$OPT_WILDCARD"
	. "&amp;backmx=$OPT_MX"
	. "&amp;offline=$OPT_OFFLINE"
	;

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

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

    $req-&gt;user_agent( "Perl client $PROGNAME/$VERSION.$VERSION2 $CONTACT");
    $req-&gt;header( "Host", $connect );
    $req-&gt;authorization_basic( $LOGIN, $PASS );

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

    unless ( $test )
    {
	my $resp = $ua-&gt;request( $req );
	my $return = $resp-&gt;as_string;
	my( $code, $str ) = StatusCodeParse( $return );

	if ( $verb )
	{
	    print $return;
	    print "\n$str\n";
	}

	StatusCodeHandle( $code, $str );
    }

    $debug  and  print "$id: done.\n";
}

# }}}


Main();


0;		    # Perl scripts (.pl) must return 0, Libraries (.pm) 1
__END__
</pre></body></html>