#!/usr/bin/perl -Tw

eval 'exec /usr/bin/perl -Tw -S $0 ${1+"$@"}'
    if 0; # not running under some shell
# $Id: geoiplite-update,v 1.2 2008/12/03 22:16:40 ken Exp $

BEGIN {
    $ENV{PATH} = '/usr/local/bin:/usr/bin:/bin'; # Use untainted PATH.
    delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; # Make %ENV safer
}

use strict;
use Fcntl qw( :seek );
require Getopt::Long;
require Pod::Usage;
require IO::File;
require File::Path;
require HTTP::Request;
require Geo::IP;
require Time::Local;
require HTTP::Date;
require LWP::UserAgent;
require File::Temp;
require HTTP::Status;
require Compress::Zlib;

my $defaults =
{
 config => '/etc/geoiplite-update.conf',
 umask => '022',
};

################################################################################
{
    my $options = _parse_options();
    _parse_config( $options );
    _update_databases( $options );
}

################################################################################
sub _parse_options {

    # Parse command line options.
    my $verbose = undef;
    my $options = { 'verbose' => \$verbose,
		    'quiet' => sub { $verbose = not $_[1] } };
    my $option_parser =
      Getopt::Long::Parser->new( config => [ 'bundling', 'no_debug' ] );
    $option_parser->getoptions( $options, 'help|h|?', 'man', 'verbose|v',
				'quiet|q', 'config|c=s' )
      or Pod::Usage::pod2usage( 2 );
    $options->{verbose} = $verbose;
    delete $options->{verbose} unless defined $options->{verbose};
    delete $options->{quiet};
    $options->{config} = $defaults->{config} unless defined $options->{config};

    # Print help message if user requested it.
    Pod::Usage::pod2usage( 1 ) if $options->{help};
    # TODO: man doesn't work in taint mode
    Pod::Usage::pod2usage( -exitval => 0, -verbose => 2 ) if $options->{man};

    $options;
}

################################################################################
sub _parse_config {
    my $options = shift;

    unless ( -e $options->{config} ) {
	die "Error: config file does not exist: $options->{config}";
    }
    unless ( -r $options->{config} ) {
	die "Error: config file unreadable: $options->{config}";
    }

    my @configs = qw( base_url databases directory umask );
    my $configs_regex = join( '|', map { uc } @configs );

    my $fh = IO::File->new( "<$options->{config}" )
      or die "Error: could not open config file: $options->{config}";
    my $lineno = 0;
    while ( 1 ) {
	++$lineno;
	my $line = $fh->getline;
	last if not defined $line;
	if ( $line =~ m!^\s*($configs_regex)\s*=\s*"?([^"\r\n]*)!oi ) {
	    $options->{lc($1)} = $2;
	}
	elsif ( $line =~ m!^\s*$! ) {
	    # ignore blank lines
	}
	elsif ( $line =~ m!^\s*#! ) {
	    # ignore comments
	}
	else {
	    warn "Warning: line $lineno of $options->{config} ignored:\n$line";
	}
    }
    $fh->close
      or die "Error: could not close config file: $options->{config}";

    foreach my $config ( @configs ) {
	if ( defined $options->{$config} ) {
	    warn "Info: found setting: $config = '$options->{$config}'\n"
	      if $options->{verbose};
	}
	elsif ( defined $defaults->{$config} ) {
	    warn "Info: using default: $config = '$defaults->{$config}'\n"
	      if $options->{verbose};
	    $options->{$config} = $defaults->{$config};
	}
	else {
	    die "Error: \U$config\E not defined in config file:" .
	      " $options->{config}";
	}
    }

    $options->{base_url} .= '/' if substr( $options->{base_url}, -1 ) ne '/';
    $options->{databases} = [ split( ' ', $options->{databases} ) ];
    chop $options->{directory} if substr( $options->{directory}, -1 ) eq '/';
    $options->{umask} = oct( $options->{umask} ) if $options->{umask} =~ m!^0!;
}

################################################################################
sub _update_databases {
    my $options = shift;

    return unless @{$options->{databases}};

    if ( not -e $options->{directory} ) {
	warn "Info: creating directory: $options->{directory}\n"
	  if $options->{verbose};
	eval {
	    File::Path::mkpath( $options->{directory}, 0, $options->{umask} );
	  };
	if ( $@ ) {
	    die "Error: could not create $options->{directory}: $@";
	}
    }
    elsif ( not -d $options->{directory} ) {
	die "Error: not a directory: $options->{directory}";
    }

    foreach my $database ( @{$options->{databases}} ) {
	( my $dbnogz = $database ) =~ s!.gz$!!;
	$dbnogz =~ s!^.*/!!; # remove any subdirectory prefix
	my $file = "$options->{directory}/$dbnogz";
	my $url = "$options->{base_url}$database";
	my $request = HTTP::Request->new( GET => $url );
	my $mdate;
	if ( -e $file ) {
	    die "Error: database file unreadable: $file" unless -r $file;
	    my $gi = Geo::IP->open( $file, &Geo::IP::GEOIP_STANDARD() );
	    die "Error: could not open $file" unless defined $gi;
	    my( $version, $db_date ) = split( ' ', $gi->database_info );
	    if ( $db_date !~ m!^(\d\d\d\d)(\d\d)(\d\d)$! ) {
		warn "Warning: invalid database date in $file: $db_date;" .
		  " will try to download new file\n";
	    }
	    else {
		my( $year, $mon, $mday ) = ( $1, $2, $3 );
		my $db_time =
		  Time::Local::timegm( 0, 0, 0, $mday, $mon-1, $year-1900 );
		if ( time - $db_time < 32*86400 ) {
		    warn "Info: less than 32 days old ($db_date): $file\n"
		      if $options->{verbose};
		    next;
		}
		else {
		    warn "Info: more than 31 days old ($db_date): $file\n"
		      if $options->{verbose};
		    if ( my $mtime = ( stat( $file ) )[9] ) {
			$mdate = HTTP::Date::time2str( $mtime );
			warn "Info: Last-Modified($dbnogz): $mdate\n"
			  if $options->{verbose};
			$request->header( 'If-Modified-Since' => $mdate );
		    }
		}
	    }
	}

	warn "Info: checking for update at $url\n" if $options->{verbose};
	my $ua = new LWP::UserAgent;
	my $gzfh = new File::Temp;
	my $response = $ua->request( $request, ">&=" . fileno($gzfh) );
	if ( $response->code == &HTTP::Status::RC_NOT_MODIFIED() ) {
	    warn "Info: $database not modified since $mdate\n"
	      if $options->{verbose};
	    next;
	}
	elsif ( not $response->is_success ) {
	    die "Error: could not retrieve $url: " . $response->status_line;
	}

	seek( $gzfh, 0, SEEK_END )
	  or die "Error: could not seek to end of tempfile";
	my $length = tell( $gzfh );
	if ( $length == -1 ) {
	    warn "Warning: could not tell length of downloaded file: $!\n";
	}
	else {
	    my $content_length = $response->header( 'Content-Length' );
	    if ( not defined $content_length ) {
		warn "Warning: no Content-Length header\n";
	    }
	    elsif ( $length < $content_length ) {
		die "Error: download truncated: " .
		  "only $length out of $content_length bytes received";
	    }
	    elsif ( $length > $content_length ) {
		die "Error: Content-Length mismatch: " .
		  "expected $content_length bytes, got $length";
	    }
	    elsif ( $options->{verbose} ) {
		warn "Info: download complete ($length bytes)\n";
	    }
	}

	seek( $gzfh, 0, SEEK_SET )
	  or die "Error: could not seek to start of tempfile";
	my $dbfh = File::Temp->new( DIR => $options->{directory},
				    TEMPLATE => "$dbnogz.XXXXXX",
				    UNLINK => 0 );
	my $chmod = 0666 & ~ $options->{umask};
	chmod $chmod, $dbfh->filename;
	warn "Info: decompressing downloaded file\n" if $options->{verbose};
	my $gz = Compress::Zlib::gzopen( $gzfh, 'rb' )
	  or die "Error: could not gzopen tempfile: $Compress::Zlib::gzerrno";
	my $buffer;
	while ( $gz->gzread( $buffer ) > 0 ) {
	    print $dbfh $buffer;
	}
	die "Error: could not gzread tempfile: $Compress::Zlib::gzerrno"
	  if $Compress::Zlib::gzerrno != &Compress::Zlib::Z_STREAM_END();
	close( $dbfh ) or die "Error: could not close $dbfh: $!";
	if ( my $gzerror = $gz->gzclose() ) {
	    die "Error: could not gzclose tempfile: $Compress::Zlib::gzerrno";
	}

	if ( my $lmtime = $response->last_modified ) {
	    # make sure the file has the same last modification time
	    utime $lmtime, $lmtime, $dbfh->filename;
	}

	if ( $options->{verbose} ) {
	    if ( -e $file ) {
		warn "Info: overwriting old $dbnogz\n";
	    }
	    else {
		warn "Info: creating $dbnogz\n";
	    }
	}
	unless( rename $dbfh->filename, $file ) {
	    my $error = "$!";
	    unlink $dbfh->filename;
	    die "Error: could not rename $dbfh to $file: $error";
	}
    }
}

################################################################################

__END__

=pod

=head1 NAME

    geoiplite-update - update MaxMind's "lite" databases

=head1 SYNOPSIS

    geoiplite-update
    geoiplite-update -c /etc/geoiplite-update.conf

=head1 OPTIONS

  -h, --help         brief help message
      --man          full documentation
  -q, --quiet        do not display informational messages (default)
  -v, --verbose      display informational messages
  -c, --config=FILE  configuration file

=head1 DESCRIPTION

This program will check for monthly updates to MaxMind's "lite"
databases.  It will download, decompress, and install the databases
you specify.

MaxMind offer free databases from the following location:

   http://www.maxmind.com/download/geoip/database/

There is a "country" database that maps IP address to country code and
a "city" database that also maps to region and city.

=head2 configuration file

The configuration file is C</etc/geoiplite-update.conf>.  It should
define three values:

=over 4

=item BASE_URL (required)

URL where database files are located.  For example:

  BASE_URL=http://www.maxmind.com/download/geoip/database/

=item DATABASES (required)

List of database files to update.  For example:

  DATABASES="GeoIP.dat.gz GeoLiteCity.dat.gz"

=item DIRECTORY (required)

Directory to store downloaded databases.  For example:

  DIRECTORY=/usr/share/GeoIP

=item UMASK (optional)

The umask to use when creating database directory or files.  Defaults
to 022, so that directory is created with permissions 755 and files
are created with permissions 644.

=back

=head1 AUTHOR

Ken Neighbors <ken@nsds.com>

=head1 COPYRIGHT and LICENSE

Copyright (c) 2006 Ken Neighbors.  All rights reserved.  This module
is free software; you can redistribute it and/or modify it under the
same terms as Perl itself.

=cut

1;
