1#!/usr/bin/perl 2 3=pod 4 5/* 6 * 7 * Copyright (C) 2008 MaxMind LLC 8 * 9 * This library is free software; you can redistribute it and/or 10 * modify it under the terms of the GNU Lesser General Public 11 * License as published by the Free Software Foundation; either 12 * version 2.1 of the License, or (at your option) any later version. 13 * 14 * This library is distributed in the hope that it will be useful, 15 * but WITHOUT ANY WARRANTY; without even the implied warranty of 16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 * Lesser General Public License for more details. 18 * 19 * You should have received a copy of the GNU Lesser General Public 20 * License along with this library; if not, write to the Free Software 21 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 22 */ 23 24=cut 25 26=pod 27 28pure perl version of geoipupdate. can handle anything, that 29 30 GeoIP_update_database 31 GeoIP_update_database_general 32 33handle. It is a drop in replacement for geoipupdate, as opposide to geoipupdate is the 34pp version able to handle proxy requests even with authentication and can be used with 35https 36 37=cut 38 39use strict; 40use warnings; 41 42our $VERSION = '0.08'; 43 44use 5.008; 45use Data::Dumper; 46use Digest::MD5; 47use File::Spec; 48use File::Basename; 49use Getopt::Std; 50use HTTP::Request::Common; 51use LWP::UserAgent; 52use PerlIO::gzip; 53use URI; 54 55my $ua = LWP::UserAgent->new( agent => "pp_geoipupdate/$VERSION" ); 56$ua->env_proxy; 57 58## --- for auth proxies use 59## $ua->proxy(['http', 'ftp'] => 'http://username:password@proxy.myorg.com'); 60 61my $license_file = 'GeoIP.conf'; 62my $update_host = 'updates.maxmind.com'; 63my $proto = 'http'; 64my %opts; 65 66if ( !getopts( 'hvf:d:', \%opts ) or $opts{h} ) { 67 print STDERR 68 "Usage: geoipupdate [-hv] [-f license_file] [-d custom directory]\n"; 69 exit @ARGV ? 1 : 0; 70} 71 72my $rootdir = File::Spec->rootdir; 73$opts{d} ||= File::Spec->catfile( $rootdir, qw/ usr local share GeoIP / ); 74$opts{f} 75 ||= File::Spec->catfile( $rootdir, qw/ usr local etc /, $license_file ); 76 77die "dir $opts{d} does not exist or is not readable or is not a directory\n" 78 unless -d $opts{d}; 79die "license_file $opts{f} does not exist, is not readable or is not a file\n" 80 unless -f $opts{f}; 81 82# 83# --- parse license file 84# 85open my $fh, '<', $opts{f} 86 or die "Error opening GeoIP Configuration file $opts{f}\n"; 87print "Opened License file $opts{f}\n" if $opts{v}; 88 89my ( $user_id, $license_key, @product_ids ); 90{ 91 local $_; 92 93 while (<$fh>) { 94 next if /^\s*#/; # skip comments 95 /^\s*UserId\s+(\d+)/ and $user_id = $1, next; 96 /^\s*LicenseKey\s+(\S{12})/ and $license_key = $1, next; 97 /^\s*ProductIds\s+(\d+(?:[a-zA-Z]{2,3})?(?:\s+\d+(?:[a-zA-Z]{2,3})?)*)/ 98 and @product_ids = split( /\s+/, $1 ), next; 99 100 } 101} 102 103if ( $opts{v} ) { 104 print "User id $user_id\n" if $user_id; 105 print "Read in license key $license_key\n"; 106 print "Product ids @product_ids\n"; 107} 108 109my $err_cnt = 0; 110 111my $print_on_error = sub { 112 my $err = shift; 113 return unless $err; 114 if ( $err !~ /^No new updates available/i ) { 115 print STDERR $err, $/; 116 $err_cnt++; 117 } 118 else { 119 print $err; 120 } 121}; 122 123if ($user_id) { 124 for my $product_id (@product_ids) { 125 126 # update the databases using the user id string, 127 # the license key string and the product id for each database 128 eval { 129 GeoIP_update_database_general( 130 $user_id, $license_key, 131 $product_id, $opts{v} 132 ); 133 }; 134 $print_on_error->($@); 135 } 136} 137else { 138 139 # Old format with just license key for MaxMind GeoIP Country database updates 140 # here for backwards compatibility 141 eval { GeoIP_update_database( $license_key, $opts{v} ); }; 142 $print_on_error->($@); 143} 144 145exit( $err_cnt > 0 ? 1 : 0 ); 146 147sub GeoIP_update_database_general { 148 my ( $user_id, $license_key, $product_id, $verbose, $client_ipaddr ) = @_; 149 my $u = URI->new("$proto://$update_host/app/update_getfilename"); 150 $u->query_form( product_id => $product_id ); 151 152 print 'Send request ' . $u->as_string, "\n" if ($verbose); 153 my $res = $ua->request( GET $u->as_string, Host => $update_host ); 154 die $res->status_line unless ( $res->is_success ); 155 156 # make sure to use only the filename for security reason 157 my $geoip_filename 158 = File::Spec->catfile( $opts{d}, basename( $res->content ) ); 159 160 # /* get MD5 of current GeoIP database file */ 161 my $old_md5 = _get_hexdigest($geoip_filename); 162 163 print "MD5 sum of database $geoip_filename is $old_md5\n" if $verbose; 164 165 unless ($client_ipaddr) { 166 print 'Send request ' . $u->as_string, "\n" if ($verbose); 167 168 # /* get client ip address from MaxMind web page */ 169 $res = $ua->request( 170 GET "$proto://$update_host/app/update_getipaddr", 171 Host => $update_host 172 ); 173 die $res->status_line unless ( $res->is_success ); 174 $client_ipaddr = $res->content; 175 } 176 177 print "client ip address: $client_ipaddr\n" if $verbose; 178 my $hex_digest2 179 = Digest::MD5->new->add( $license_key, $client_ipaddr )->hexdigest; 180 print "md5sum of ip address and license key is $hex_digest2\n" 181 if $verbose; 182 183 my $mk_db_req_cref = sub { 184 185 $u->path('/app/update_secure'); 186 $u->query_form( 187 db_md5 => shift, 188 challenge_md5 => $hex_digest2, 189 user_id => $user_id, 190 edition_id => $product_id 191 ); 192 print 'Send request ' . $u->as_string, "\n" if ($verbose); 193 return $ua->request( GET $u->as_string, Host => $update_host ); 194 }; 195 $res = $mk_db_req_cref->($old_md5); 196 die $res->status_line unless ( $res->is_success ); 197 198 # print Dumper($res); 199 print "Downloading gzipped GeoIP Database...\n" if $verbose; 200 201 _gunzip_and_replace( 202 $res->content, 203 $geoip_filename, 204 sub { 205 206 # as sanity check request a update for the new downloaded file 207 # md5 of the new unpacked file 208 my $new_md5 = _get_hexdigest(shift); 209 return $mk_db_req_cref->($new_md5); 210 } 211 ); 212 print "Done\n" if $verbose; 213} 214 215sub GeoIP_update_database { 216 my ( $license_key, $verbose ) = @_; 217 my $geoip_filename = File::Spec->catfile( $opts{d}, 'GeoIP.dat' ); 218 219 # /* get MD5 of current GeoIP database file */ 220 my $hexdigest = _get_hexdigest($geoip_filename); 221 222 print "MD5 sum of database $geoip_filename is $hexdigest\n" if $verbose; 223 224 my $u = URI->new("$proto://$update_host/app/update"); 225 $u->query_form( license_key => $license_key, md5 => $hexdigest ); 226 227 print 'Send request ' . $u->as_string, "\n" if ($verbose); 228 my $res = $ua->request( GET $u->as_string, Host => $update_host ); 229 die $res->status_line unless ( $res->is_success ); 230 print "Downloading gzipped GeoIP Database...\n" if $verbose; 231 _gunzip_and_replace( $res->content, $geoip_filename ); 232 print "Done\n" if $verbose; 233 234} 235 236# --- hexdigest of the file or 00000000000000000000000000000000 237sub _get_hexdigest { 238 my $md5 = '0' x 32; 239 if ( open my $fh, '<:raw', shift ) { 240 $md5 = Digest::MD5->new->addfile($fh)->hexdigest; 241 } 242 return $md5; 243} 244 245sub _gunzip_and_replace { 246 my ( $content, $geoip_filename, $sanity_check_c ) = @_; 247 my $max_retry = 1; 248 249 my $tmp_fname = $geoip_filename . '.test'; 250 251 { 252 253 # --- error if our content does not start with the gzip header 254 die $content || 'Not a gzip file' 255 if substr( $content, 0, 2 ) ne "\x1f\x8b"; 256 257 # --- uncompress the gzip data 258 { 259 local $_; 260 open my $gin, '<:gzip', \$content or die $!; 261 open my $gout, '>:raw', $tmp_fname or die $!; 262 print {$gout} $_ while (<$gin>); 263 } 264 265 # --- sanity check 266 if ( defined $sanity_check_c ) { 267 die "Download failed" if $max_retry-- <= 0; 268 my $res = $sanity_check_c->($tmp_fname); 269 die $res->status_line unless ( $res->is_success ); 270 $content = $res->content; 271 272 redo if ( $content !~ /^No new updates available/ ); 273 } 274 } 275 276 # --- install GeoIP.dat.test -> GeoIP.dat 277 rename( $tmp_fname, $geoip_filename ) or die $!; 278} 279 280