#!/usr/bin/perl -Tw
#
#   $Id: ez-ip.pl,v 1.3 2000/09/26 19:01:09 dgregor Exp $
#
# Copyright (c) 1998 Daniel J. Gregor, Jr., All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
# 	This product includes software developed by Daniel J. Gregor, Jr.
# 4. The name of Daniel J. Gregor, Jr. may not be used to endorse or promote
#    products derived from this software without specific prior written
#    permission.
# 
# THIS SOFTWARE IS PROVIDED BY DANIEL J. GREGOR, JR. ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL DANIEL J. GREGOR, JR. BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
# 
# 
# TODO
# 1. interactive support
# 2. verbose/debug mode

use IO::Socket;
use FileHandle;

$server = "www.ez-ip.net";
$serverport = 80;
$url = "/members/update/";

$usage = "Usage: ez-ip.pl [<config_file>]\n";

if (@ARGV == 0) {
	# need to prompt user for info here
	die "Interactive support not yet added.  Use configuration file.\n" .
		$usage;
} elsif (@ARGV == 1) {
	$config_file = shift(@ARGV);
	open(CONF, "<" . $config_file) ||
		die "Could not open config file \"$config_file\": $!\n";

	while (<CONF>) {
		chomp();	# kill newline
		s/#.*//;	# kill comments
		s/^\s+//;	# kill leading spaces
		s/\s+$//;	# kill trailing spaces
		m/^$/ && next;	# line is empty -- skip to next line

		m/^userid=(.*)$/ && do {
			$userid = $1;
			next;
		};

		m/^password=(.*)$/ && do {
			$password = $1;
			next;
		};

		m/^ipaddress=(.*)$/ && do {
			$ipaddress = $1;
			next;
		};

		m/^wildcard=(.*)$/ && do {
			if ($1 eq "yes" || $1 eq "no") {
				$wildcard = $1;
			} else {
				die "wildcard value must be \"yes\" or \"no\"\n";
			}
			next;
		};

		m/^mx=(.*)$/ && do {
			$mx = $1;
			next;
		};

		die "Unknown configuration parameter on line $.\n";
	}

	close(CONF);
} else {
	die $usage;
}

# userid and password are required
die "a userid hasn't been defined\n" unless defined($userid);
die "a password hasn't been defined\n" unless defined($password);

# these aren't required, so fill in defaults if they aren't defined.
$ipaddress = "" unless defined($ipaddress);
$wildcard = "no" unless defined($wildcard);
$mx = "" unless defined($mx);

$serverconn = new IO::Socket::INET (
        PeerAddr => $server,
        PeerPort => $serverport,
        Proto => 'tcp',
        );

die "Could not connect to $server: $!\n" unless defined($serverconn);

$serverconn->autoflush(1);

$serverconn->print("GET ${url}?" .
	"mode=update" . 
	"&ipaddress=" . escape($ipaddress) .
	"&wildcard=" . escape($wildcard) .
	"&mx=" . escape($mx) .
	" HTTP/1.0\r\n" .
	"Authorization: Basic " . b64encode($userid . ":" . $password) .
		"\r\n" .
	"\r\n");

$response = "";
while ($line = $serverconn->getline()) {
	$response .= $line;
}

$response =~ m?^HTTP/\d+\.\d+\s+(\d+)\s+([^\r\n]*)[\r\n]? ||
	die "Could not parse HTTP header response from server:\n$response\n";
$respresultcode = $1;
$respreason = $2;

if ($respresultcode == 200) {
	$response =~ m/DNS Entries Updated/ && exit(0);
	die "Unknown response from server:\n$response\n";
} elsif ($respresultcode == 401) {
	die "Server did not accept authorization information (userid/password).\n";
} else {
	die "Unknown result code \"$respresultcode $respreason\" received.\n";
}

# Stolen from CGI.pm
sub escape {
        my($toencode) = @_;
        $toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
        return $toencode;
}

# b64encode hacked from:
# base64.pl -- A perl package to handle MIME-style BASE64 encoding
# A. P. Barrett <barrett@ee.und.ac.za>, October 1993
# $Revision: 1.3 $$Date: 2000/09/26 19:01:09 $
sub b64encode
{
    local ($_) = @_;
    local ($chunk);
    local ($result);

    $base64_alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
                       'abcdefghijklmnopqrstuvwxyz'.
                       '0123456789+/';
    $base64_pad = '=';
 
    $uuencode_alphabet = q|`!"#$%&'()*+,-./0123456789:;<=>?|.
                       '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_'; # double that '\\'!


    # Build some strings for use in tr/// commands.
    # Some uuencodes use " " and some use "`", so we handle both.
    # We also need to protect backslashes.
    ($tr_uuencode = " ".$uuencode_alphabet) =~ s/\\/\\\\/;
    $tr_base64 = "A".$base64_alphabet;
 
    # break into chunks of 45 input chars, use perl's builtin
    # uuencoder to convert each chunk to uuencode format,
    # then kill the leading "M", translate to the base64 alphabet,
    # and finally append a newline.
    while (s/^((.|\n){45})//) {
        #warn "in:$&:\n";
        $chunk = substr(pack("u", $&), $[+1, 60);
        #warn "packed    :$chunk:\n";
        eval qq{
            \$chunk =~ tr|$tr_uuencode|$tr_base64|;
        };
        #warn "translated:$chunk:\n";
        $result .= $chunk . "\n";
    }
 
    # any leftover chars go onto a shorter line
    # with uuencode padding converted to base64 padding
    if ($_ ne "") {
        #warn "length ".length($_)." \$_:$_:\n";
        #warn "enclen ", int((length($_)+2)/3)*4 - (45-length($_))%3, "\n";
        $chunk = substr(pack("u", $_), $[+1,
                        int((length($_)+2)/3)*4 - (45-length($_))%3);
        #warn "chunk:$chunk:\n";
        eval qq{
            \$chunk =~ tr|$tr_uuencode|$tr_base64|;
        };
        #warn "translated:$chunk:\n";
        $result .= $chunk . ($base64_pad x ((60 - length($chunk)) % 4)) . "\n";
    }
 
    # return result
    $result;
}

