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