2024-09-24 14:54:57 +02:00

261 lines
7.6 KiB
Perl

#!/usr/bin/perl
=pod
/*
*
* Copyright (C) 2008 MaxMind LLC
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version.
*
* This library 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
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
=cut
=pod
pure perl version of geoipupdate. can handle anything, that
GeoIP_update_database
GeoIP_update_database_general
handle. It is a drop in replacement for geoipupdate, as opposide to geoipupdate is the
pp version able to handle proxy requests even with authentication and can be used with
https
=cut
use strict;
use warnings;
our $VERSION = '0.07';
use 5.008;
use Data::Dumper;
use Digest::MD5;
use File::Spec;
use File::Basename;
use Getopt::Std;
use HTTP::Request::Common;
use LWP::UserAgent;
use PerlIO::gzip;
use URI;
my $ua = LWP::UserAgent->new( agent => "pp_geoipupdate/$VERSION" );
$ua->env_proxy;
## --- for auth proxies use
## $ua->proxy(['http', 'ftp'] => 'http://username:password@proxy.myorg.com');
my $license_file = 'GeoIP.conf';
my $update_host = 'updates.maxmind.com';
my $proto = 'http';
my %opts;
if ( !getopts( 'hvf:d:', \%opts ) or $opts{h} ) {
print STDERR
"Usage: geoipupdate [-hv] [-f license_file] [-d custom directory]\n";
exit @ARGV ? 1 : 0;
}
my $rootdir = File::Spec->rootdir;
$opts{d} ||= File::Spec->catfile( $rootdir, qw/ usr local share GeoIP / );
$opts{f} ||=
File::Spec->catfile( $rootdir, qw/ usr local etc /, $license_file );
die "dir $opts{d} does not exist or is not readable or is not a directory\n"
unless -d $opts{d};
die "license_file $opts{f} does not exist, is not readable or is not a file\n"
unless -f $opts{f};
#
# --- parse license file
#
open my $fh, '<', $opts{f}
or die "Error opening GeoIP Configuration file $opts{f}\n";
print "Opened License file $opts{f}\n" if $opts{v};
my ( $user_id, $license_key, @product_ids );
{
local $_;
while (<$fh>) {
next if /^\s*#/; # skip comments
/^\s*UserId\s+(\d+)/ and $user_id = $1, next;
/^\s*LicenseKey\s+(\S{12})/ and $license_key = $1, next;
/^\s*ProductIds\s+(\d+(?:[a-zA-Z]{2,3})?(?:\s+\d+(?:[a-zA-Z]{2,3})?)*)/
and @product_ids = split( /\s+/, $1 ), next;
}
}
if ( $opts{v} ) {
print "User id $user_id\n" if $user_id;
print "Read in license key $license_key\n";
print "Product ids @product_ids\n";
}
if ($user_id) {
for my $product_id (@product_ids) {
# update the databases using the user id string,
# the license key string and the product id for each database
eval {
GeoIP_update_database_general( $user_id, $license_key,
$product_id, $opts{v} );
};
my $err = $@;
die $err if $err and $err !~ /^No new updates available/i;
print $err;
}
} else {
# Old format with just license key for MaxMind GeoIP Country database updates
# here for backwards compatibility
eval { GeoIP_update_database( $license_key, $opts{v} ); };
my $err = $@;
die $err if $err and $err !~ /^No new updates available/i;
print $err;
}
exit 0;
sub GeoIP_update_database_general {
my ( $user_id, $license_key, $product_id, $verbose, $client_ipaddr ) = @_;
my $u = URI->new("$proto://$update_host/app/update_getfilename");
$u->query_form( product_id => $product_id );
print 'Send request ' . $u->as_string, "\n" if ($verbose);
my $res = $ua->request( GET $u->as_string, Host => $update_host );
die $res->status_line unless ( $res->is_success );
# make sure to use only the filename for security reason
my $geoip_filename = File::Spec->catfile( $opts{d}, basename($res->content) );
# /* get MD5 of current GeoIP database file */
my $old_md5 = _get_hexdigest($geoip_filename);
print "MD5 sum of database $geoip_filename is $old_md5\n" if $verbose;
unless ($client_ipaddr) {
print 'Send request ' . $u->as_string, "\n" if ($verbose);
# /* get client ip address from MaxMind web page */
$res = $ua->request( GET "$proto://$update_host/app/update_getipaddr",
Host => $update_host );
die $res->status_line unless ( $res->is_success );
$client_ipaddr = $res->content;
}
print "client ip address: $client_ipaddr\n" if $verbose;
my $hex_digest2 =
Digest::MD5->new->add( $license_key, $client_ipaddr )->hexdigest;
print "md5sum of ip address and license key is $hex_digest2\n" if $verbose;
my $mk_db_req_cref = sub {
$u->path('/app/update_secure');
$u->query_form(
db_md5 => shift,
challenge_md5 => $hex_digest2,
user_id => $user_id,
edition_id => $product_id
);
print 'Send request ' . $u->as_string, "\n" if ($verbose);
return $ua->request( GET $u->as_string, Host => $update_host );
};
$res = $mk_db_req_cref->($old_md5);
die $res->status_line unless ( $res->is_success );
# print Dumper($res);
print "Downloading gzipped GeoIP Database...\n" if $verbose;
_gunzip_and_replace(
$res->content,
$geoip_filename,
sub {
# as sanity check request a update for the new downloaded file
# md5 of the new unpacked file
my $new_md5 = _get_hexdigest(shift);
return $mk_db_req_cref->($new_md5);
}
);
print "Done\n" if $verbose;
}
sub GeoIP_update_database {
my ( $license_key, $verbose ) = @_;
my $geoip_filename = File::Spec->catfile( $opts{d}, 'GeoIP.dat' );
# /* get MD5 of current GeoIP database file */
my $hexdigest = _get_hexdigest($geoip_filename);
print "MD5 sum of database $geoip_filename is $hexdigest\n" if $verbose;
my $u = URI->new("$proto://$update_host/app/update");
$u->query_form( license_key => $license_key, md5 => $hexdigest );
print 'Send request ' . $u->as_string, "\n" if ($verbose);
my $res = $ua->request( GET $u->as_string, Host => $update_host );
die $res->status_line unless ( $res->is_success );
print "Downloading gzipped GeoIP Database...\n" if $verbose;
_gunzip_and_replace( $res->content, $geoip_filename );
print "Done\n" if $verbose;
}
# --- hexdigest of the file or 00000000000000000000000000000000
sub _get_hexdigest {
my $md5 = '0' x 32;
if ( open my $fh, '<:raw', shift ) {
$md5 = Digest::MD5->new->addfile($fh)->hexdigest;
}
return $md5;
}
sub _gunzip_and_replace {
my ( $content, $geoip_filename, $sanity_check_c ) = @_;
my $max_retry = 1;
my $tmp_fname = $geoip_filename . '.test';
{
# --- error if our content does not start with the gzip header
die $content || 'Not a gzip file' if substr( $content, 0, 2 ) ne "\x1f\x8b";
# --- uncompress the gzip data
{
local $_;
open my $gin, '<:gzip', \$content or die $!;
open my $gout, '>:raw', $tmp_fname or die $!;
print {$gout} $_ while (<$gin>);
}
# --- sanity check
if ( defined $sanity_check_c ) {
die "Download failed" if $max_retry-- <= 0;
my $res = $sanity_check_c->($tmp_fname);
die $res->status_line unless ( $res->is_success );
$content = $res->content;
redo if ( $content !~ /^No new updates available/ );
}
}
# --- install GeoIP.dat.test -> GeoIP.dat
rename( $tmp_fname, $geoip_filename ) or die $!;
}