#!/usr/local/bin/perl
#
# @(#) dyndns.pl - Update Your Dynamic DNS address.
# @(#) $Id: dyndns.pl,v 1.7 2001/06/10 22:55:39 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 (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
#
# 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&hostname=yourhost.ourdomain.ext,yourhost2.dyndns.org& myip=ipaddress&wildcard=OFF&mx=mail.exchanger.ext&backmx=NO&offline=NO
#
# GET /nic/update?system=statdns&hostname=yourhost.ourdomain.ext,yourhost2.dyndns.org &myip=ipaddress&wildcard=OFF&mx=mail.exchanger.ext&backmx=NO&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' => qw( pod2text );
use autouse 'Pod::Html' => 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 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://tiny-tools.sourceforge.net/ and in the zip kit, Emacs
# lisp package file tinymy.el
$VERSION = '2001.0611';
}
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.7 2001/06/10 22:55:39 jaalto Exp $;
$VERSION2 = (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. ";
}
%STATUS_CODE_HASH =
(
# Pre-Update Errors
#
# The codes above are only only given once, regardless of how many
# hosts are in the update.
"badauth" => "Bad authorization (username or password)"
, "badsys" => "The system parameter given was not valid."
, "badagent" => "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" => "Update good and successful, IP updated"
, "nochg" => "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" => "A Fully-Qualified Domain Name was not provided."
, "nohost" => "The hostname specified does not exist"
, "!donator" => "The offline setting was set, when the user"
. " is not a donator, this is only returned once"
, "!yours" => "The hostname specified exists, but not under"
. " the username currently being used"
, "abuse" => "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" => "Too many or too few hosts found"
, "dnserr" => "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" => "Wait xx hours."
, "wxxm" => "Wait xx minutes."
, "wxxs" => "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" => "Shutdown until notified otherwise via status.shtml"
# Same as 911, for British users :)
, "999" => "Shutdown until notified otherwise via status.shtml"
);
}
# }}}
# {{{ 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<--Mx-option>
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<--Offline-option>
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 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<--help-html>
Print help in HTML format.
=item B<--test>
Run in test mode, do not actually do anything.
=item B<--test-account>
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
=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
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 serach PATH with command line option `-S'. Sinde
Win32 does not know .pl programs, you have to call perl explicitly:
dos> perl -S 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 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
=head1 AVAILABILITY
CPAN entry is at http://www.perl.com/CPAN-local//scripts/
Reach author at C
=head1 SCRIPT CATEGORIES
CPAN/Administrative
FCPAN/Networking
=head1 PREREQUISITES
None.
=head1 COREQUISITES
None.
=head1 OSNAMES
C
=head1 VERSION
$Id: dyndns.pl,v 1.7 2001/06/10 22:55:39 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...
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
# ************************************************************** &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 );
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" => \$help
, "help-html" => \$helpHTML
, "verbose" => \$verb
, "test" => \$test
, "test-account" => \$testAccount
, "Version" => \$version
, "debug" => \$debug
, "login=s" => \$LOGIN
, "password=s" => \$PASS
, "Host=s" => \$HOST
, "mxhost=s" => \$MXHOST
, "Wildcard" => \$OPT_WILDCARD
, "Mx-option" => \$OPT_MX
, "Offline-option" => \$OPT_OFFLINE
);
$version and die "$VERSION $PROGNAME $CONTACT $URL\n";
$help and Help();
$helpHTML and Help(undef, -html);
$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";
}
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 );
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 = ) )
{
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 Win32 IPconfig.exe
#
# INPUT PARAMETERS
#
# none
#
# RETURN VALUES
#
# $ ip address
#
# ****************************************************************************
sub GetIpAddressWin32 ()
{
my $id = "$LIB.GetIpAddressWin32";
my $cmd = "ipconfig";
my @list = qx(ipconfig);
my @ip = grep /\.\s+\.:\s+\S+/, @list;
my ( $ip ) = $ip[0] =~ /:\s+(\S+)/;
$debug and print "$id: IP is $ip\n$cmd Response=>\n@list\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"
, "Please contain maintainer at $CONTACT"
;
}
}
# ****************************************************************************
#
# 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
# Get last string from the @lines
my $code = (reverse split /\n/)[0];
my $desc = "WARNING $code";
if ( exists $STATUS_CODE_HASH{$code} )
{
$desc = $STATUS_CODE_HASH{$code};
}
elsif ( $code =~ /good/i )
{
"Update successfull.";
}
$code, $desc;
}
# }}}
# {{{ Main
# ****************************************************************************
#
# 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&started=1&hostname=YES"
. "&host_id=${HOST}"
. "&myip=${ip}"
. "&wildcard=$OPT_WILDCARD"
. "&backmx=$OPT_MX"
;
# 2001-06 Specification has changed, this is new one:
my $url =
""
. "http://${LOGIN}:${PASS}\@${connect}"
. "/nic/update"
. "?system=dyndns"
. "&hostname=${HOST}" # hostname=host,host,host..
. "&myip=${ip}"
. "&wildcard=$OPT_WILDCARD"
. "&backmx=$OPT_MX"
. "&offline=$OPT_OFFLINE"
;
$url .= "&mx=$HOSTMX" if $HOSTMX;
$req = new HTTP::Request( 'GET', $url );
$req->user_agent( "Perl client $PROGNAME/$VERSION.$VERSION2 $CONTACT");
$req->header( "Host", $connect );
$req->authorization_basic( $LOGIN, $PASS );
if ( $test or $debug )
{
print $req->as_string;
}
unless ( $test )
{
my $resp = $ua->request( $req );
my $return = $resp->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__