├── t └── 00-notests.t ├── .whitesource ├── MANIFEST ├── .aspell.local.pws ├── xt ├── 50_manifest.t ├── 60_changelog.t ├── 02_pod.t ├── 00_perlversion.t └── 20_kwalitee.t ├── MANIFEST.SKIP ├── .gitignore ├── 2lib ├── CONTRIBUTING.md ├── cpanfile ├── ChangeLog ├── sandbox ├── genMETA.pl └── genMETA.pm ├── Makefile.PL ├── SECURITY.md ├── doc ├── make-doc.pl ├── geoip.man ├── geoip.md ├── geoip.3 └── geoip.html ├── README.md └── geoip /t/00-notests.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use 5.014000; 4 | use warnings; 5 | 6 | say "1..1"; 7 | say "ok 1"; 8 | -------------------------------------------------------------------------------- /.whitesource: -------------------------------------------------------------------------------- 1 | { 2 | "generalSettings": { 3 | "shouldScanRepo": true 4 | }, 5 | "checkRunSettings": { 6 | "vulnerableCheckRunConclusionLevel": "failure" 7 | } 8 | } 9 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | geoip 2 | ChangeLog 3 | CONTRIBUTING.md 4 | SECURITY.md 5 | cpanfile 6 | lib/App/geoip.pm 7 | Makefile.PL 8 | MANIFEST 9 | README.md 10 | 2lib 11 | t/00-notests.t 12 | -------------------------------------------------------------------------------- /.aspell.local.pws: -------------------------------------------------------------------------------- 1 | personal_ws-1.1 en 15 2 | cavac 3 | CIDR 4 | dsn 5 | geoip 6 | json 7 | Makefile 8 | MariaDB 9 | MaxMind 10 | maxmind 11 | Modularization 12 | PostgreSQL 13 | pre 14 | ShareAlike 15 | VPN 16 | whois 17 | -------------------------------------------------------------------------------- /xt/50_manifest.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | 7 | eval "use Test::DistManifest"; 8 | plan skip_all => "Test::DistManifest required for testing MANIFEST" if $@; 9 | manifest_ok (); 10 | done_testing; 11 | -------------------------------------------------------------------------------- /xt/60_changelog.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use 5.014000; 4 | use Test::More; 5 | 6 | eval "use Test::CPAN::Changes"; 7 | plan skip_all => "Test::CPAN::Changes required for this test" if $@; 8 | 9 | changes_file_ok ("ChangeLog"); 10 | 11 | done_testing; 12 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | ^\.aspell.local.pws 2 | ^\.git.* 3 | ^\.whitesource 4 | ^blib 5 | ^doc 6 | ^sandbox 7 | ^Talk 8 | [gbx]z$ 9 | MANIFEST.SKIP 10 | ^Makefile$ 11 | ^pm_to 12 | ^MYMETA 13 | ^\.releaserc 14 | ^\.travis.yml 15 | .*\.zip$ 16 | ^old/ 17 | \.tmp$ 18 | ^xt/ 19 | -------------------------------------------------------------------------------- /xt/02_pod.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use Test::More; 4 | 5 | eval "use Test::Pod::Links"; 6 | plan skip_all => "Test::Pod::Links required for testing POD Links" if $@; 7 | eval { 8 | no warnings "redefine"; 9 | no warnings "once"; 10 | *Test::XTFiles::all_files = sub { "geoip"; }; 11 | }; 12 | Test::Pod::Links->new (ignore_match => qr{^https://www.maxmind.com})->all_pod_files_ok; 13 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | old/ 2 | blib 3 | cover_db 4 | Makefile 5 | META.yml 6 | META.json 7 | MYMETA.yml 8 | MYMETA.json 9 | pm_to_blib 10 | *.tar.gz 11 | *.tbz 12 | *.tgz 13 | *.txz 14 | *.zip 15 | *.old 16 | *.gcov 17 | *.gcda 18 | *.gcno 19 | .perlcriticrc 20 | lib/App/geoip.pm 21 | App-geo* 22 | xx* 23 | valgrind.log 24 | pod2htm* 25 | nytprof* 26 | tmp/* 27 | sandbox/cover_db* 28 | Talk/*.mp4 29 | Talk/*.jpg 30 | *-git 31 | -------------------------------------------------------------------------------- /xt/00_perlversion.t: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | eval "use Test::More 0.93"; 7 | eval "use Test::MinimumVersion"; 8 | if ($@) { 9 | print "1..0 # Test::MinimumVersion required for compatability tests\n"; 10 | exit 0; 11 | } 12 | 13 | all_minimum_version_ok ("5.014.000", { paths => [ 14 | "geoip", glob ("t/*"), glob ("xt/*"), glob ("*.PL"), 15 | ]}); 16 | 17 | done_testing (); 18 | -------------------------------------------------------------------------------- /2lib: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | use 5.012001; 4 | use warnings; 5 | use autodie; 6 | 7 | open my $fh, "<", "geoip"; 8 | my $src = do { local $/; <$fh> }; 9 | close $fh; 10 | 11 | $src =~ s{^our \$VERSION\s*=\s*"([0-9.]+)\K\s*-\s*[-0-9]+(?=")}{}m; 12 | my $vsn = $1 or die "No version in geoip\n"; 13 | say "Writing App::geoip version $vsn"; 14 | 15 | -d "lib" or mkdir "lib"; 16 | -d "lib/App" or mkdir "lib/App"; 17 | open $fh, ">", "lib/App/geoip.pm"; 18 | print $fh $src; 19 | close $fh; 20 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # General 2 | 3 | I am always open to improvements and suggestions. 4 | Use [issues](https://github.com/Tux/GeoIP2/issues) 5 | 6 | # Style 7 | 8 | I will never accept pull request that do not strictly conform to my 9 | style, however you might hate it. You can read the reasoning behind 10 | my [preferences](http://tux.nl/style.html). 11 | 12 | I really do not care about mixed spaces and tabs in (leading) whitespace 13 | 14 | Perl::Tidy will help getting the code in shape, but as all software, it 15 | is not perfect. You can find my preferences for these in 16 | [.perltidy](https://github.com/Tux/Release-Checklist/blob/master/.perltidyrc) and 17 | [.perlcritic](https://github.com/Tux/Release-Checklist/blob/master/.perlcriticrc). 18 | 19 | # Requirements 20 | 21 | The minimum version required to use this module is stated in 22 | [Makefile.PL](./Makefile.PL) 23 | -------------------------------------------------------------------------------- /xt/20_kwalitee.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | 7 | BEGIN { $ENV{AUTHOR_TESTING} = 1; } 8 | eval "use Test::Kwalitee qw( kwalitee_ok );"; 9 | if ($@) { 10 | print "1..0 # Test::Kwalitee required for this test\n"; 11 | exit 0; 12 | } 13 | 14 | kwalitee_ok (qw( 15 | -has_meta_yml 16 | -metayml_conforms_spec_current 17 | -metayml_conforms_to_known_spec 18 | -metayml_declares_perl_version 19 | -metayml_has_license 20 | -metayml_has_provides 21 | -metayml_is_parsable 22 | -no_symlinks 23 | )); 24 | 25 | my @experimental = qw( 26 | no_stdin_for_prompting 27 | prereq_matches_use 28 | has_test_pod 29 | has_test_pod_coverage 30 | use_warnings 31 | 32 | build_prereq_matches_use 33 | easily_repackageable 34 | easily_repackageable_by_debian 35 | easily_repackageable_by_fedora 36 | fits_fedora_license 37 | has_license_in_source_file 38 | has_version_in_each_file 39 | has_version_in_each_file 40 | uses_test_nowarnings 41 | ); 42 | 43 | done_testing (); 44 | -------------------------------------------------------------------------------- /cpanfile: -------------------------------------------------------------------------------- 1 | requires "Archive::Zip"; 2 | requires "DBI"; 3 | requires "Data::Dumper"; 4 | requires "Getopt::Long"; 5 | requires "JSON::PP"; 6 | requires "LWP::Simple"; 7 | requires "List::Util"; 8 | requires "Math::Trig"; 9 | requires "Net::CIDR"; 10 | requires "Pod::Text"; 11 | requires "Socket"; 12 | requires "Text::CSV_XS" => "1.39"; 13 | 14 | recommends "Archive::Zip" => "1.68"; 15 | recommends "DBI" => "1.648"; 16 | recommends "Data::Dumper" => "2.189"; 17 | recommends "Getopt::Long" => "2.58"; 18 | recommends "JSON::PP" => "4.16"; 19 | recommends "LWP::Simple" => "6.78"; 20 | recommends "Math::Trig" => "1.62"; 21 | recommends "Net::CIDR" => "0.23"; 22 | recommends "Pod::Usage" => "2.03"; 23 | recommends "Socket" => "2.038"; 24 | recommends "Text::CSV_XS" => "1.60"; 25 | 26 | on "configure" => sub { 27 | requires "ExtUtils::MakeMaker"; 28 | 29 | recommends "ExtUtils::MakeMaker" => "7.22"; 30 | 31 | suggests "ExtUtils::MakeMaker" => "7.72"; 32 | }; 33 | 34 | on "build" => sub { 35 | requires "Config"; 36 | }; 37 | 38 | on "test" => sub { 39 | requires "Test::More"; 40 | }; 41 | -------------------------------------------------------------------------------- /ChangeLog: -------------------------------------------------------------------------------- 1 | 0.19 - 2025-03-17, H.Merijn Brand 2 | * 3 | 4 | 0.18 - 2025-01-13, H.Merijn Brand 5 | * Work around groff-1.24 6 | * It is 2024 7 | * Tested with perl-5.40 8 | * It is 2025 9 | * Add SECURITY.md 10 | 11 | 0.17 - 2023-01-06, H.Merijn Brand 12 | * It is 2023 13 | 14 | 0.16 - 2022-01-02, H.Merijn Brand 15 | * Add IP::Geolocation::MMDB to SEE ALSO 16 | 17 | 0.15 - 2022-01-01, H.Merijn Brand 18 | * It is 2021 19 | * Use $GEOIP_HOST as default for IP/Host 20 | * It is 2022 21 | 22 | 0.14 - 2020-12-23, H.Merijn Brand 23 | * geological -> geographical (Shlomi Fish) 24 | * Use Pod::Text 25 | * Give more diagnostics if a database connection fails 26 | * Fix META issue for bugtracker 27 | 28 | 0.13 - 2020-04-09, H.Merijn Brand 29 | * Make 5.14.0 explicit in Makefile.PL 30 | 31 | 0.12 - 2020-04-09, H.Merijn Brand 32 | * Add option to select CIDR's for country 33 | 34 | 0.11 - 2020-01-21, H.Merijn Brand 35 | * Release! 36 | 37 | 0.10 - 2020-01-16, H.Merijn Brand 38 | * Support download using Maxmind license key 39 | * Prepare for CPAN 40 | 41 | 0.09 - 2019-08-12, H.Merijn Brand 42 | * Support whois (-w / --whois) 43 | * Support JSON (-j / --json, -J --json-pretty) 44 | * Support fixed local location (-l / --local) 45 | * Support alternate database (-D / --DB) 46 | * Full manual 47 | * Support configuration file(s) 48 | 49 | 0.07 - 2019-03-09, H.Merijn Brand 50 | * Use Data::Peek for diagnoses or Data::Dumper if not installed 51 | * Use alternatives to determine own location 52 | 53 | 0.06 - 2019-04-11, H.Merijn Brand 54 | * Add -s/--short 55 | * Use GIS::Distance if available 56 | * Add alternative geolocation url 57 | 58 | 0.05 - 2019-01-31, H.Merijn Brand 59 | * Add ChangeLog 60 | * Add --dist option 61 | * Add support for SQLite 62 | 63 | 0.04 - 2018-11-26, H.Merijn Brand 64 | * Initial release to github 65 | * README updates 66 | * Progress on DB loading 67 | * Error handling on bad queries 68 | * Off-line use (no DNS) 69 | * Usage 70 | * Add --fetch and --no-update 71 | * Add OpenStreetMap URL 72 | * No warnings on first fetch 73 | -------------------------------------------------------------------------------- /sandbox/genMETA.pl: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use Getopt::Long qw(:config bundling nopermute); 7 | GetOptions ( 8 | "c|check" => \ my $check, 9 | "u|update!" => \ my $update, 10 | "v|verbose:1" => \(my $opt_v = 0), 11 | ) or die "usage: $0 [--check]\n"; 12 | 13 | use lib "sandbox"; 14 | use genMETA; 15 | my $meta = genMETA->new ( 16 | from => "lib/App/geoip.pm", 17 | verbose => $opt_v, 18 | ); 19 | 20 | $meta->from_data (); 21 | $meta->security_md ($update); 22 | $meta->gen_cpanfile (); 23 | 24 | if ($check) { 25 | $meta->check_encoding (); 26 | $meta->check_required (); 27 | $meta->check_minimum ("5.14", [ "geoip" ]); 28 | $meta->done_testing (); 29 | } 30 | elsif ($opt_v) { 31 | $meta->print_yaml (); 32 | } 33 | else { 34 | $meta->fix_meta (); 35 | } 36 | 37 | __END__ 38 | --- #YAML:1.0 39 | name: App-geoip 40 | version: VERSION 41 | abstract: Show geographical data based on hostname or IP address(es) 42 | license: perl 43 | author: 44 | - H.Merijn Brand 45 | generated_by: Author 46 | distribution_type: module 47 | provides: 48 | App::geoip: 49 | file: lib/App/geoip.pm 50 | version: VERSION 51 | requires: 52 | perl: 5.014 53 | Archive::Zip: 0 54 | Data::Dumper: 0 55 | DBI: 0 56 | Getopt::Long: 0 57 | JSON::PP: 0 58 | LWP::Simple: 0 59 | Math::Trig: 0 60 | Net::CIDR: 0 61 | Pod::Text: 0 62 | List::Util: 0 63 | Socket: 0 64 | Text::CSV_XS: 1.39 65 | recommends: 66 | Archive::Zip: 1.68 67 | Data::Dumper: 2.189 68 | DBI: 1.648 69 | Getopt::Long: 2.58 70 | JSON::PP: 4.16 71 | LWP::Simple: 6.78 72 | Math::Trig: 1.62 73 | Net::CIDR: 0.23 74 | Pod::Usage: 2.03 75 | Socket: 2.038 76 | Text::CSV_XS: 1.60 77 | configure_requires: 78 | ExtUtils::MakeMaker: 0 79 | configure_recommends: 80 | ExtUtils::MakeMaker: 7.22 81 | configure_suggests: 82 | ExtUtils::MakeMaker: 7.72 83 | build_requires: 84 | Config: 0 85 | test_requires: 86 | Test::More: 0 87 | resources: 88 | license: http://dev.perl.org/licenses/ 89 | homepage: https://metacpan.org/pod/App::geoip 90 | repository: https://github.com/Tux/GeoIP2 91 | bugtracker: https://github.com/Tux/GeoIP2/issues 92 | IRC: irc://irc.perl.org/#csv 93 | meta-spec: 94 | version: 1.4 95 | url: http://module-build.sourceforge.net/META-spec-v1.4.html 96 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | use 5.014000; 2 | use warnings; 3 | 4 | use ExtUtils::MakeMaker; 5 | 6 | -f "lib/App/geoip.pm" or system $^X, "./2lib"; 7 | 8 | my $VERSION; 9 | open my $fh, "<", "geoip"; 10 | while (<$fh>) { 11 | m/VERSION\s*=\s*["']?([0-9.]+)/ or next; 12 | $VERSION = $1; 13 | last; 14 | } 15 | close $fh; 16 | 17 | my %wmf = ( 18 | NAME => "App::geoip", 19 | DISTNAME => "App-geoip", 20 | ABSTRACT => "Show geographical data based on hostname or IP address(es)", 21 | AUTHOR => "H.Merijn Brand", 22 | EXE_FILES => [ "geoip" ], 23 | VERSION => $VERSION, 24 | MIN_PERL_VERSION => "5.14.0", 25 | PREREQ_PM => { 26 | "DBI" => 0, 27 | "Socket" => 0, 28 | "Net::CIDR" => 0, 29 | "Data::Dumper" => 0, 30 | "Math::Trig" => 0, 31 | "LWP::Simple" => 0, 32 | "Archive::Zip" => 0, 33 | "Text::CSV_XS" => "1.39", 34 | "JSON::PP" => 0, 35 | "Pod::Text" => 0, 36 | "List::Util" => 0, 37 | "Getopt::Long" => 0, 38 | }, 39 | LICENSE => "artistic_2", 40 | CONFIGURE_REQUIRES => { "ExtUtils::MakeMaker" => 0 }, 41 | TEST_REQUIRES => { "Test::More" => 0 }, 42 | macro => { TARFLAGS => "--format=ustar -c -v -f", }, 43 | 44 | META_MERGE => { 45 | "meta-spec" => { version => 2 }, 46 | licence => "artistic_2", 47 | resources => { 48 | type => "git", 49 | url => "git://github.com/Tux/GeoIP2.git", 50 | web => "https://github.com/Tux/GeoIP2", 51 | IRC => "irc://irc.perl.org/#csv", 52 | }, 53 | provides => { 54 | "App::geoip" => { 55 | file => "geoip", 56 | version => $VERSION, 57 | }, 58 | }, 59 | }, 60 | ); 61 | 62 | eval { ExtUtils::MakeMaker->VERSION (6.63_03) } or 63 | delete $wmf{TEST_REQUIRES}; 64 | 65 | my $rv = WriteMakefile (%wmf); 66 | 67 | # perlcriticrc uses Config::Tiny, which does not support nesting 68 | -f ".perlcriticrc" && -s "$ENV{HOME}/.perlcriticrc" and eval { 69 | open my $fh, ">", ".perlcriticrc"; 70 | 71 | require Config::Tiny; 72 | my $cnf = Config::Tiny->read ("$ENV{HOME}/.perlcriticrc"); 73 | for ("ControlStructures::ProhibitPostfixControls", # postfix if in diag 74 | "Freenode::PackageMatchesFilename", # XS 75 | "Subroutines::ProhibitBuiltinHomonyms", # eof, say 76 | "ErrorHandling::RequireCarping", # for autodie 77 | "BuiltinFunctions::ProhibitBooleanGrep", 78 | "Variables::RequireLocalizedPunctuationVars", # *_, %_ 79 | ) { 80 | delete $cnf->{$_}; 81 | $cnf->{"-$_"} = {}; 82 | } 83 | $cnf->{"Compatibility::PodMinimumVersion"} 84 | {above_version} = "5.014"; # For L<> and =head3 85 | $cnf->write (".perlcriticrc"); 86 | }; 87 | 88 | 1; 89 | 90 | package MY; 91 | 92 | sub postamble { 93 | my @mpm = (-d ".git" || -x "2lib") 94 | ? ("", "lib/App/geoip.pm: geoip\n\t$^X ./2lib\n") 95 | : (); 96 | -d "xt" && ($ENV{AUTOMATED_TESTING} || 0) != 1 and 97 | push @mpm => 98 | '', 99 | 'test ::', 100 | ' -@env TEST_FILES="xt/*.t" make -e test_dynamic'; 101 | join "\n" => 102 | 'spellcheck:', 103 | ' pod-spell-check --aspell --ispell geoip', 104 | '', 105 | 'META.json META.yml: geoip', 106 | ' -@make metafile', 107 | ' -@mv $(DISTVNAME)/META.* .', 108 | ' -@rm -rf $(DISTVNAME)', 109 | '', 110 | 'checkmeta: spellcheck', 111 | ' perl sandbox/genMETA.pl -c', 112 | '', 113 | 'fixmeta: distmeta', 114 | ' perl sandbox/genMETA.pl', 115 | '', 116 | 'tgzdist: lib/App/geoip.pm checkmeta fixmeta spellcheck doc $(DISTVNAME).tar.gz distcheck', 117 | ' -@mv -f $(DISTVNAME).tar.gz $(DISTVNAME).tgz', 118 | ' -@cpants_lint.pl $(DISTVNAME).tgz', 119 | ' -@rm -f Debian_CPANTS.txt', 120 | '', 121 | 'doc: doc/geoip.md doc/geoip.html doc/geoip.man', 122 | 'doc/geoip.md: geoip', 123 | ' perl doc/make-doc.pl', 124 | @mpm; 125 | } # postamble 126 | 127 | 1; 128 | -------------------------------------------------------------------------------- /SECURITY.md: -------------------------------------------------------------------------------- 1 | # Security Policy for the App::geoip distribution. 2 | 3 | Report issues via email at: H.Merijn Brand . 4 | 5 | 6 | This is the Security Policy for App::geoip. 7 | 8 | The latest version of the Security Policy can be found in the 9 | [git repository for App::geoip](https://github.com/Tux/GeoIP2). 10 | 11 | This text is based on the CPAN Security Group's Guidelines for Adding 12 | a Security Policy to Perl Distributions (version 1.0.0) 13 | https://security.metacpan.org/docs/guides/security-policy-for-authors.html 14 | 15 | # How to Report a Security Vulnerability 16 | 17 | Security vulnerabilities can be reported by e-mail to the current 18 | project maintainers at H.Merijn Brand . 19 | 20 | Please include as many details as possible, including code samples 21 | or test cases, so that we can reproduce the issue. Check that your 22 | report does not expose any sensitive data, such as passwords, 23 | tokens, or personal information. 24 | 25 | If you would like any help with triaging the issue, or if the issue 26 | is being actively exploited, please copy the report to the CPAN 27 | Security Group (CPANSec) at . 28 | 29 | Please *do not* use the public issue reporting system on RT or 30 | GitHub issues for reporting security vulnerabilities. 31 | 32 | Please do not disclose the security vulnerability in public forums 33 | until past any proposed date for public disclosure, or it has been 34 | made public by the maintainers or CPANSec. That includes patches or 35 | pull requests. 36 | 37 | For more information, see 38 | [Report a Security Issue](https://security.metacpan.org/docs/report.html) 39 | on the CPANSec website. 40 | 41 | ## Response to Reports 42 | 43 | The maintainer(s) aim to acknowledge your security report as soon as 44 | possible. However, this project is maintained by a single person in 45 | their spare time, and they cannot guarantee a rapid response. If you 46 | have not received a response from them within 10 days, then 47 | please send a reminder to them and copy the report to CPANSec at 48 | . 49 | 50 | Please note that the initial response to your report will be an 51 | acknowledgement, with a possible query for more information. It 52 | will not necessarily include any fixes for the issue. 53 | 54 | The project maintainer(s) may forward this issue to the security 55 | contacts for other projects where we believe it is relevant. This 56 | may include embedded libraries, system libraries, prerequisite 57 | modules or downstream software that uses this software. 58 | 59 | They may also forward this issue to CPANSec. 60 | 61 | # Which Software This Policy Applies To 62 | 63 | Any security vulnerabilities in App::geoip are covered by this policy. 64 | 65 | Security vulnerabilities are considered anything that allows users 66 | to execute unauthorised code, access unauthorised resources, or to 67 | have an adverse impact on accessibility or performance of a system. 68 | 69 | Security vulnerabilities in upstream software (embedded libraries, 70 | prerequisite modules or system libraries, or in Perl), are not 71 | covered by this policy unless they affect App::geoip, or App::geoip can 72 | be used to exploit vulnerabilities in them. 73 | 74 | Security vulnerabilities in downstream software (any software that 75 | uses App::geoip, or plugins to it that are not included with the 76 | App::geoip distribution) are not covered by this policy. 77 | 78 | ## Supported Versions of App::geoip 79 | 80 | The maintainer(s) will only commit to releasing security fixes for 81 | the latest version of App::geoip. 82 | 83 | Note that the App::geoip project only supports major versions of Perl 84 | released in the past 5 years, even though App::geoip will run on 85 | older versions of Perl. If a security fix requires us to increase 86 | the minimum version of Perl that is supported, then we may do so. 87 | 88 | # Installation and Usage Issues 89 | 90 | The distribution metadata specifies minimum versions of 91 | prerequisites that are required for App::geoip to work. However, some 92 | of these prerequisites may have security vulnerabilities, and you 93 | should ensure that you are using up-to-date versions of these 94 | prerequisites. 95 | 96 | Where security vulnerabilities are known, the metadata may indicate 97 | newer versions as recommended. 98 | 99 | ## Usage 100 | 101 | Please see the software documentation for further information. 102 | -------------------------------------------------------------------------------- /doc/make-doc.pl: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | use 5.038002; 4 | use warnings; 5 | 6 | our $VERSION = "0.05 - 20250116"; 7 | our $CMD = $0 =~ s{.*/}{}r; 8 | 9 | sub usage { 10 | my $err = shift and select STDERR; 11 | say "usage: $CMD [-v[#]] [--pod]"; 12 | exit $err; 13 | } # usage 14 | 15 | use Cwd; 16 | use Pod::Text; 17 | use File::Find; 18 | use List::Util qw( first ); 19 | use Encode qw( encode decode ); 20 | use Getopt::Long qw(:config bundling); 21 | GetOptions ( 22 | "help|?" => sub { usage (0); }, 23 | "V|version" => sub { say "$CMD [$VERSION]"; exit 0; }, 24 | 25 | "p|pod!" => \ my $pod, 26 | 27 | "v|verbose:1" => \(my $opt_v = 0), 28 | ) or usage (1); 29 | 30 | -d "doc" or mkdir "doc", 0775; 31 | 32 | my @pm; # Do *NOT* scan t/ 33 | -d "lib" and find (sub { m/\.pm$/ and push @pm => $File::Find::name }, "lib"); 34 | @pm or @pm = sort glob "*.pm"; 35 | if (@pm == 0 and open my $fh, "<", "Makefile.PL") { 36 | my @mpl = <$fh>; 37 | close $fh; 38 | if (my @vf = grep m/\bVERSION_FROM\s*=>\s*(.*)/) { 39 | push @pm => $vf[0] =~ s/["']//gr; 40 | last; 41 | } 42 | if (my @ef = grep m/\bEXE_FILES\s*=>\s*\[(.*)\]/) { 43 | push @pm => eval qq{($1)}; 44 | last; 45 | } 46 | } 47 | 48 | push @pm => @ARGV; 49 | @pm = sort grep { ! -l $_ } @pm; 50 | @pm or die "No documentation source files found\n"; 51 | 52 | if ($opt_v) { 53 | say "Using these sources for static documentation:"; 54 | say " $_" for @pm; 55 | } 56 | 57 | sub dext { 58 | my ($pm, $ext) = @_; 59 | my $fn = $pm =~ s{^lib/}{}r 60 | =~ s{^(?:App|scripts|examples)/}{}r 61 | =~ s{/}{-}gr 62 | =~ s{(?:\.pm)?$}{.$ext}r # examples, scripts 63 | =~ s{^(?=CSV_XS\.)}{Text-}r 64 | =~ s{^(?=Peek\.)} {Data-}r 65 | =~ s{^(?=Read\.)} {Spreadsheet-}r 66 | =~ s{^(SpeedTest)} {\L$1}ri 67 | =~ s{^}{doc/}r; 68 | getcwd =~ m/Config-Perl/ and 69 | $fn =~ s{doc/\K}{Config-Perl-}; 70 | $fn; 71 | } # dext 72 | 73 | my %enc; 74 | my %pod; 75 | { # Check if file had pod at all 76 | foreach my $pm (@pm) { 77 | open my $fh, ">", \$pod{$pm}; 78 | Pod::Text->new->parse_from_file ($pm, $fh); 79 | close $fh; 80 | 81 | $pod && $pod{$pm} and link $pm => dext ($pm, "pod"); 82 | } 83 | } 84 | 85 | eval { require Pod::Checker; }; 86 | if ($@) { 87 | warn "Cannot convert pod to markdown: $@\n"; 88 | } 89 | else { 90 | my $fail = 0; 91 | my %ignore_empty = ( 92 | "lib/DBI/ProfileData.pm" => 7, 93 | "Peek.pm" => 4, 94 | "Read.pm" => 5, 95 | ); 96 | foreach my $pm (@pm) { 97 | open my $eh, ">", \my $err; 98 | my $pc = Pod::Checker->new (); 99 | my $ok = $pc->parse_from_file ($pm, $eh); 100 | close $eh; 101 | $enc{$pm} = $pc->{encoding}; 102 | $err && $err =~ m/\S/ or next; 103 | # Ignore warnings here on empty previous paragraphs as it 104 | # uses =head2 for all possible invocation alternatives 105 | if (my $ni = $ignore_empty{$pm}) { 106 | my $pat = qr{ WARNING: empty section }; 107 | my @err = split m/\n+/ => $err; 108 | my @wrn = grep m/$pat/ => @err; 109 | @wrn == $ni and $err = join "\n" => grep !m/$pat/ => @err; 110 | $err =~ m/\S/ or next; 111 | } 112 | say $pm; 113 | say $err; 114 | $err =~ m/ ERROR:/ and $fail++; 115 | } 116 | $fail and die "POD has errors. Fix them first!\n"; 117 | } 118 | 119 | eval { require Pod::Markdown; }; 120 | if ($@) { 121 | warn "Cannot convert pod to markdown: $@\n"; 122 | } 123 | else { 124 | foreach my $pm (@pm) { 125 | my $md = dext ($pm, "md"); 126 | my $enc = $enc{$pm} ? "encoding($enc{$pm})" : "bytes"; 127 | printf STDERR "%-43s <- %s (%s)\n", $md, $pm, $enc if $opt_v; 128 | open my $ph, "<:$enc", $pm; 129 | my $p = Pod::Markdown->new (); 130 | $p->output_string (\my $m); 131 | $p->parse_file ($ph); 132 | close $ph; 133 | 134 | $m && $m =~ m/\S/ or next; 135 | if (open my $old, "<:encoding(utf-8)", $md) { 136 | local $/; 137 | $m eq scalar <$old> and next; 138 | } 139 | $opt_v and say "Writing $md (", length $m, ")"; 140 | open my $oh, ">:encoding(utf-8)", $md or die "$md: $!\n"; 141 | print $oh $m; 142 | close $oh; 143 | } 144 | } 145 | 146 | eval { require Pod::Html; }; 147 | if ($@) { 148 | warn "Cannot convert pod to HTML: $@\n"; 149 | } 150 | else { 151 | foreach my $pm (@pm) { 152 | $pod{$pm} or next; # Skip HTML for files without pod 153 | my $html = dext ($pm, "html"); 154 | printf STDERR "%-43s <- %s (%s)\n", $html, $pm, $enc{$pm} // "-" if $opt_v; 155 | my $tf = "x_$$.html"; 156 | unlink $tf if -e $tf; 157 | Pod::Html::pod2html ("--infile=$pm", "--outfile=$tf", "--quiet"); 158 | my $h = do { local (@ARGV, $/) = ($tf); <> } =~ s/[\r\n\s]+\z/\n/r; 159 | unlink $tf if -e $tf; 160 | $h && $h =~ m/\S/ or next; 161 | if (open my $old, "<:encoding(utf-8)", $html) { 162 | local $/; 163 | $h eq scalar <$old> and next; 164 | } 165 | $opt_v and say "Writing $html (", length $h, ")"; 166 | open my $oh, ">:encoding(utf-8)", $html or die "$html: $!\n"; 167 | print $oh $h; 168 | close $oh; 169 | } 170 | unlink "pod2htmd.tmp"; 171 | } 172 | 173 | eval { require Pod::Man; }; 174 | if ($@) { 175 | warn "Cannot convert pod to man: $@\n"; 176 | } 177 | else { 178 | my $nrf = first { -x } 179 | map { "$_/nroff" } 180 | grep { length and -d } 181 | split m/:+/ => $ENV{PATH}; 182 | $opt_v and say $nrf; 183 | foreach my $pm (@pm) { 184 | my $man = dext ($pm, "3"); 185 | printf STDERR "%-43s <- %s\n", $man, $pm if $opt_v; 186 | open my $fh, ">", \my $p; 187 | Pod::Man->new (section => 3)->parse_from_file ($pm, $fh); 188 | close $fh; 189 | $p && $p =~ m/\S/ or next; 190 | $p = decode ("utf-8", $p); 191 | if (open my $old, "<:encoding(utf-8)", $man) { 192 | local $/; 193 | $p eq scalar <$old> and next; 194 | } 195 | $opt_v and say "Writing $man (", length $p, ")"; 196 | open my $oh, ">:encoding(utf-8)", $man or die "$man: $!\n"; 197 | print $oh $p; 198 | close $oh; 199 | $nrf or next; 200 | if (open my $fh, "-|", $nrf, "-mandoc", "-T", "utf8", $man) { 201 | local $/; 202 | $p = <$fh>; 203 | close $fh; 204 | $p = decode ("utf-8", $p 205 | =~ s{(?:\x{02dc}|\xcb\x9c )}{~}grx # ~ 206 | =~ s{(?:\x{02c6}|\xcb\x86 )}{^}grx # ^ 207 | =~ s{(?:\x{2018}|\xe2\x80\x98 208 | |\x{2019}|\xe2\x80\x99 )}{'}grx # ' 209 | =~ s{(?:\x{201c}|\xe2\x80\x9c 210 | |\x{201d}|\xe2\x80\x9d )}{"}grx # " 211 | =~ s{(?:\x{2212}|\xe2\x88\x92 212 | |\x{2010}|\xe2\x80\x90 )}{-}grx # - 213 | =~ s{(?:\x{2022}|\xe2\x80\xa2 )}{*}grx # BULLET 214 | =~ s{(?:\e\[|\x9b)[0-9;]*m} {}grx); # colors 215 | } 216 | 217 | my $mfn = $man =~ s/3$/man/r; 218 | if (open my $mh, "<:encoding(utf-8)", $mfn) { 219 | local $/; 220 | $p eq <$mh> and next; 221 | } 222 | $opt_v and say "Writing $mfn (", length $p, ")"; 223 | open $oh, ">:encoding(utf-8)", $mfn or die "$mfn: $!\n"; 224 | # nroff / troff / grotty cause double-encoding 225 | print $oh encode ("iso-8859-1", decode ("utf-8", $p)); 226 | close $oh; 227 | } 228 | } 229 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## GeoIP2 2 | 3 | Based on [PerlMonks](https://www.perlmonks.org/) posts 4 | [1226112](https://www.perlmonks.org/?node_id=1226112) and 5 | [1226223](https://www.perlmonks.org/?node_id=1226223) by 6 | [cavac](https://www.perlmonks.org/?node_id=890813), this is my attempt in 7 | opening the GeoIP2 data from [MAXMIND](https://dev/maxmind.com) 8 | available [here](https://dev.maxmind.com/geoip/geoip2/geolite2/) 9 | 10 | The [download section](https://dev.maxmind.com/geoip/geoip2/geolite2/#Downloads) 11 | has three CSV databases available: 12 | 13 | - [Country](http://geolite.maxmind.com/download/geoip/database/GeoLite2-Country-CSV.zip) 14 | - [Provider](http://geolite.maxmind.com/download/geoip/database/GeoLite2-ASN-CSV.zip) 15 | - [City](http://geolite.maxmind.com/download/geoip/database/GeoLite2-City-CSV.zip) 16 | 17 | If you download all three, and create a postgres database `geoip`, then 18 | [geoip](geoip) will convert all CSV data to database tables. 19 | 20 | ## Use 21 | 22 | ``` sh 23 | $ perl geoip 24 | $ perl geoip 66.39.54.27 209.197.123.153 216.92.34.251 25 | $ perl geoip perlmonks.org 26 | ``` 27 | 28 | Once the database is filled, the last call might return something like 29 | 30 | ``` 31 | GeoIP data for 66.39.54.27 - www.perlmonks.com: 32 | CIDR : 66.39.0.0/16 33 | IP range : 66.39.0.0 - 66.39.255.255 34 | Provider : pair Networks 35 | City : Pittsburgh, 508, 15203 36 | Country : US United States 37 | Continent : North America 38 | Location : 40.4254 / -79.9799 (1000) 40°25'31.44" / -79°58'47.64" 39 | https://www.openstreetmap.org/#map=10/40.4254/-79.9799 40 | https://www.google.com/maps/place/@40.4254,-79.9799,10z 41 | Timezone : America/New_York 42 | EU member : No 43 | Satellite : No 44 | Anon Proxy: No 45 | ``` 46 | 47 | and, when you also use the `--dist` option 48 | ``` 49 | Using GeoIP to determine own location 50 | GeoIP data for 66.39.54.27 - www.perlmonks.com: 51 | CIDR : 66.39.0.0/16 52 | IP range : 66.39.0.0 - 66.39.255.255 53 | Provider : pair Networks 54 | City : Pittsburgh, 508, 15203 55 | Country : US United States 56 | Continent : North America 57 | Location : 40.4254 / -79.9799 (1000) 40°25'31.44" / -79°58'47.64" 58 | https://www.openstreetmap.org/#map=10/40.4254/-79.9799 59 | https://www.google.com/maps/place/@40.4254,-79.9799,10z 60 | Location : 52.3824 / 4.8995 52°22'56.64" / 4°53'58.20" 61 | Distance : ± 6258.19km 62 | Timezone : America/New_York 63 | EU member : No 64 | Satellite : No 65 | Anon Proxy: No 66 | ``` 67 | 68 | ## PREREQUISITES 69 | 70 | - perl-5.14.0 71 | - Socket (CORE since per-5.000) 72 | - [Archive::Zip](https://metacpan.org/release/Archive-Zip) 73 | - [Text::CSV_XS](https://metacpan.org/release/Text-CSV_XS)-1.35 74 | - [Net::CIDR](https://metacpan.org/release/Net-CIDR) 75 | 76 | For use of the `--dist` option, two additional modules are required. 77 | This functionality is optional, `geoip` will work perfectly fine 78 | without these. 79 | 80 | - [LWP::UserAgent](https://metacpan.org/release/LWP-UserAgent) 81 | - [HTML::TreeBuilder](https://metacpan.org/release/HTML-TreeBuilder) 82 | 83 | ## INSTALLATION 84 | 85 | Using PostgreSQL: 86 | ``` 87 | $ echo "create database geoip;" | psql -f - 88 | $ perl ./geoip --fetch 89 | $ ln geoip ~/bin/ 90 | ``` 91 | 92 | Using SQLite (database will be close to 500 Mb): 93 | ``` 94 | $ perl ./geoip --fetch --DB=dbi:SQLite:dbname=geoip.db 95 | ``` 96 | or 97 | ``` 98 | $ export GEOIP_DBI_DSN=dbi:SQLite:dbname=/my/databases/geoip.db 99 | $ perl ./geoip --fetch 100 | ``` 101 | 102 | Depending on the amount of memory you have, this might take a while. 103 | 104 | You can also fetch the files yourself 105 | 106 | ``` 107 | $ wget -m -L -nd -np -nH \ 108 | http://geolite.maxmind.com/download/geoip/database/GeoLite2-ASN-CSV.zip \ 109 | http://geolite.maxmind.com/download/geoip/database/GeoLite2-City-CSV.zip \ 110 | http://geolite.maxmind.com/download/geoip/database/GeoLite2-Country-CSV.zip 111 | ``` 112 | 113 | ## TODO 114 | 115 | - IPv6. The current version only implements the IPv4 part. The CSV files however 116 | also the IPv6 data, so it should not be too hard to add. 117 | 118 | ## SEE ALSO 119 | 120 | This tool uses the following modules from CORE and CPAN: 121 | 122 | - [Archive::Zip](https://metacpan.org/release/Archive-Zip) 123 | - [Data::Dumper](https://metacpan.org/release/Data-Dumper) (core) 124 | - [Data::Peek](https://metacpan.org/release/Data-Peek) (optional) 125 | - [Getopt::Long](https://metacpan.org/release/Getopt-Long) (core) 126 | - [GIS::Distance](https://metacpan.org/release/GIS-Distance) (optional) 127 | - [HTML::TreeBuilder](https://metacpan.org/release/HTML-TreeBuilder) (optional) 128 | - [LWP::Simple](https://metacpan.org/release/LWP-Simple) 129 | - [LWP::UserAgent](https://metacpan.org/release/LWP-UserAgent) (optional) 130 | - [Math::Trig](https://metacpan.org/release/Math-Complex) (core) 131 | - [Net::CIDR](https://metacpan.org/release/Net-CIDR) 132 | - [Socket](https://metacpan.org/release/Socket) (core) 133 | - [Text::CSV_XS](https://metacpan.org/release/Text-CSV_XS) 134 | 135 | Modules on CPAN with similar and/or related functionality: 136 | 137 | - [Geo::Coder::HostIP](https://metacpan.org/release/Geo-Coder-HostIP) 138 | - [Geo::IP](https://metacpan.org/release/Geo-IP) - from maxmind 139 | - [Geo::IP2Location](https://metacpan.org/release/Geo-IP2Location) 140 | - [Geo::IP2Proxy](https://metacpan.org/release/Geo-IP2Proxy) 141 | - [Geo::IP6](https://metacpan.org/release/Geo-IP6) 142 | - [Geo::IPfree](https://metacpan.org/release/Geo-IPfree) - using [software77](http://software77.net/geo-ip/) database 143 | - [Geo::IP::RU::IpGeoBase](https://metacpan.org/release/Geo-IP-RU-IpGeoBase) 144 | - [IP::Country](https://metacpan.org/release/IP-Country) 145 | - [IP::Country::DB_File](https://metacpan.org/release/IP-Country-DB_File) 146 | - [IP::Country::DNSBL](https://metacpan.org/release/IP-Country-DNSBL) 147 | - [IP::Info](https://metacpan.org/release/IP-Info) 148 | - [IP::Location](https://metacpan.org/release/IP-Location) 149 | - [IP::QQWry](https://metacpan.org/release/IP-QQWry) 150 | - [IP::World](https://metacpan.org/release/IP-World) 151 | - [Metabrik::Lookup::Iplocation](https://metacpan.org/release/Metabrik-Lookup-Iplocation) 152 | - [Pcore::GeoIP](https://metacpan.org/release/Pcore-GeoIP) 153 | 154 | Check [CPAN](https://metacpan.org/search?q=geoip) for more 155 | 156 | ## THANKS 157 | 158 | Thanks to cavac for the inspiration 159 | 160 | ## AUTHOR 161 | 162 | H.Merijn Brand 163 | 164 | ## COPYRIGHT AND LICENSE 165 | 166 | The GeoLite2 end-user license agreement, which incorporates components of the 167 | Creative Commons Attribution-ShareAlike 4.0 International License 1) can be found 168 | [here](https://www.maxmind.com/en/geolite2/eula) 2). The attribution requirement 169 | may be met by including the following in all advertising and documentation 170 | mentioning features of or use of this database. 171 | 172 | This tool uses, but does not include, the GeoLite2 data created by MaxMind, 173 | available from [http://www.maxmind.com](http://www.maxmind.com). 174 | 175 | Copyright (C) 2018-2025 H.Merijn Brand. All rights reserved. 176 | 177 | This library is free software; you can redistribute and/or modify it under 178 | the same terms as Perl itself. 179 | See [here](https://opensource.org/licenses/Artistic-2.0) 3). 180 | 181 | 1) [https://creativecommons.org/licenses/by-sa/4.0/](https://creativecommons.org/licenses/by-sa/4.0/) 182 | 2) [https://www.maxmind.com/en/geolite2/eula](https://www.maxmind.com/en/geolite2/eula) 183 | 3) [https://opensource.org/licenses/Artistic-2.0](https://opensource.org/licenses/Artistic-2.0) 184 | -------------------------------------------------------------------------------- /doc/geoip.man: -------------------------------------------------------------------------------- 1 | App::geoip(3) User Contributed Perl Documentation App::geoip(3) 2 | 3 | NAME 4 | geoip - a tool to show geographical data based on hostname or IP 5 | address(es) 6 | 7 | SYNOPSIS 8 | geoip --help 9 | 10 | geoip --fetch [--no-update] 11 | 12 | geoip [options] [host|IP ...] 13 | 14 | DESCRIPTION 15 | This tool uses a database to use the (pre-fetched) GeoIP2 data from 16 | MaxMind to show related geographical information for IP addresses. This 17 | information can optionally be extended with information from online 18 | WHOIS services and or derived data, like distance to the location of 19 | the server this tool runs on or a configured local location. 20 | 21 | The output is plain text or JSON. JSON may be short or formatted. 22 | 23 | Configuration 24 | The tool allows the use of configuration files. It tests for existence 25 | of the files listed here. All existing files is read (in this order) if 26 | it is only writable by the author (mode 0640 should do). 27 | 28 | $home/geoip.rc 29 | $home/.geoiprc 30 | $home/.config/geoip 31 | 32 | where $home is either of $HOME, $USERPROFILE, or $HOMEPATH. 33 | 34 | The format of the file is 35 | 36 | # Comment 37 | ; Comment 38 | option : value 39 | option = value 40 | 41 | where the ":" and "=" are equal and whitespace around them is optional 42 | and ignored. The values "False" and "No" (case insensitive) are the 43 | same as 0 and the values "True" and "Yes" are equal to 1. For 44 | readability you can prefix "use_" to most options (it is ignored). The 45 | use of "-" in option names is allowed and will be translated to "_". 46 | 47 | The recognized options and the command line equivalences are 48 | 49 | fetch 50 | command line option : "-f" or "--fetch" 51 | 52 | default value : False 53 | 54 | Fetch new databases from the MaxMind site. 55 | 56 | update 57 | command line option : "-u" or "--update" 58 | 59 | default value : True 60 | 61 | Only in effect when used with "--fetch": when new data files from 62 | MaxMind have successfully been fetched and any of these is newer that 63 | what the database contains, update the database with the new data. 64 | 65 | distance 66 | command line option : "-d" or "--distance" 67 | 68 | default value : False 69 | 70 | If both the location of the tool and the location of the requested IP 71 | are known, calculate the distance between them. The default is to 72 | show the distance in kilometers. Choosing a configuration of "miles" 73 | instead of "True", "Yes", or 1 will show the distance in miles. There 74 | is no command line option for miles. 75 | 76 | The location of the tool is either locally stored in your 77 | configuration (see "--local-location") or fetched using the result of 78 | the urls "iplocation.com" or "geoiptool" 79 | . This will - of course - not work if there is 80 | no network connection or outside traffic is not allowed. 81 | 82 | whois 83 | command line option : "-w" or "--whois" 84 | 85 | default value : False 86 | 87 | If Net::Whois::IP is installed, and this option is true, this module 88 | will be used to retrieve the "whois" information. This will not work 89 | if there is no network connection or outside traffic is not allowed. 90 | 91 | short 92 | command line option : "-s" or "--short" 93 | 94 | default value : False 95 | 96 | This option will disable the output of less-informative information 97 | like location, EU-membership, satellite and proxy. This option, if 98 | True, will also implicitly disable the "distance" and "whois" 99 | information. 100 | 101 | dsn 102 | command line option : "-Ddsn" or "--DB=dsn" 103 | 104 | default value : $ENV{EOIP_DBI_DSN} or "dbi:Pg:geoip" 105 | 106 | See "DATABASE" for the (documented) list of supported database types. 107 | 108 | If the connection works, the tables used by this tool will be created 109 | if not yet present. 110 | 111 | The order of usage is: 112 | 113 | 1. 114 | Command line argument ("--DB=dsn") 115 | 116 | 2. 117 | The "GEOIP_DBI_DSN" environment variable 118 | 119 | 3. 120 | The value for "dsn" in the configuration file(s) 121 | 122 | 4. 123 | "dbi:Pg:dbname=geoip" 124 | 125 | json 126 | command line option : "-j" or "--json" 127 | 128 | default value : False 129 | 130 | The default output for the information is plain text. With this 131 | option, the output will be in JSON format. The default is not 132 | prettified. 133 | 134 | json-pretty 135 | command line option : "-J" or "--json-pretty" 136 | 137 | default value : False 138 | 139 | If set from the command-line, this implies the "--json" option. 140 | 141 | With this option, JSON output is done pretty (indented). 142 | 143 | local-location 144 | command line option : "-l lat/lon" or "--local=lat/lon" 145 | 146 | default value : Undefined 147 | 148 | Sets the local location coordinates for use with distances. 149 | 150 | When running the tool from a different location than where the IP 151 | access is to be analyzed for or when the network connection will not 152 | report a location that would make sense (like working from a cloud or 153 | running over one or more VPN connections), one can set the location 154 | of the base in decimal notation. (degree-minute-second-notation is 155 | not yet supported). 156 | 157 | This is also useful when there is no outbound connection possible or 158 | when you do not move location and you want to restrict network 159 | requests. 160 | 161 | The notation is decimal (with a ".", no localization support) where 162 | latitude and longitude are separated by a "/" or a ",", like "-l 163 | 12.345678/-9.876543" or "--local=12,3456,45,6789". 164 | 165 | maxmind-account 166 | command line option : none 167 | 168 | default value : Undefined 169 | 170 | Currently not (yet) used. Documentation only. 171 | 172 | license-id 173 | command line option : none 174 | 175 | default value : Undefined 176 | 177 | Currently not (yet) used. Documentation only. 178 | 179 | license-key 180 | command line option : none 181 | 182 | default value : Undefined 183 | 184 | As downloads are only allowed/possible using a valid MaxMind account, 185 | you need to provide a valid license key in your configuration file. 186 | If you do not have an account, you can sign up here 187 | . 188 | 189 | DATABASE 190 | Currently PostgreSQL and SQLite have been tested, but others may (or 191 | may not) work just as well. YMMV. Note that the database need to know 192 | the "CIDR" field type and is able to put a primary key on it. 193 | 194 | MariaDB and MySQL are not supported, as they do not support the concept 195 | of CIDR type fields. 196 | 197 | The advantage of PostgreSQL over SQLite is that you can use it with 198 | multiple users at the same time, and that you can share the database 199 | with other hosts on the same network behind a firewall. 200 | 201 | The advantage of SQLite over PostgreSQL is that it is a single file 202 | that you can copy or move to your liking. This file will be somewhere 203 | around 500 Mb. 204 | 205 | EXAMPLES 206 | Configuration 207 | $ cat ~/.config/geoip 208 | use_distance : True 209 | json-pretty : yes 210 | 211 | Basic use 212 | $ geoip --short 1.2.3.4 213 | 214 | For automation 215 | $ geoip --json --no-json-pretty 1.2.3.4 216 | 217 | $ env GEOIP_HOST=1.2.3.4 geoip 218 | 219 | Full report 220 | $ geoip --dist --whois 1.2.3.4 221 | 222 | Selecting CIDR's for countries 223 | List all CIDR's for Vatican City 224 | 225 | $ geoip --country=Vatican > vatican-city.cidr 226 | 227 | Statistics 228 | 229 | If you enable verbosity, the selected statistics will be presented at 230 | the end of the CIDR-list: number of CIDR's, number of enclosed IP's, 231 | name of the country and the continent. As the country name is just a 232 | perl regex, you can select all countries with ".", or all countries 233 | that start with a "V": 234 | 235 | $ geoip --country=^V -v >/dev/null 236 | Selected CIDR's 237 | # CIDR # IP Country Continent 238 | ------ ---------- --------------------- --------------- 239 | 21 18176 Vanuatu Oceania 240 | 321 13056 Vatican City Europe 241 | 272 6798500 Venezuela South America 242 | 612 16014080 Vietnam Asia 243 | 244 | TODO 245 | IPv6 246 | The ZIP files also contain IPv6 information, but it is not (yet) 247 | converted to the database, nor supported in analysis. 248 | 249 | Modularization 250 | Split up the different parts of the script to modules: fetch, 251 | extract, check, database, external tools, reporting. 252 | 253 | CPAN 254 | Turn this into something like App::geoip, complete with Makefile.PL 255 | 256 | SEE ALSO 257 | DBI, Net::CIDR, Math::Trig, LWP::Simple, Archive::ZIP, Text::CSV_XS, 258 | JSON::PP, GIS::Distance, Net::Whois::IP, HTML::TreeBuilder, 259 | Data::Dumper, Data::Peek, Socket 260 | 261 | Geo::Coder::HostIP, Geo::IP, Geo::IP2Location, Geo::IP2Proxy, Geo::IP6, 262 | Geo::IPfree, Geo::IP::RU::IpGeoBase, IP::Country, IP::Country::DB_File, 263 | IP::Country::DNSBL, IP::Info, IP::Location, IP::QQWry, IP::World, 264 | Metabrik::Lookup::Iplocation, Pcore::GeoIP 265 | 266 | IP::Geolocation::MMDB 267 | 268 | Check CPAN for more. 269 | 270 | THANKS 271 | Thanks to cavac for the inspiration 272 | 273 | AUTHOR 274 | H.Merijn Brand , aka Tux. 275 | 276 | COPYRIGHT AND LICENSE 277 | The GeoLite2 end-user license agreement, which incorporates components 278 | of the Creative Commons Attribution-ShareAlike 4.0 International 279 | License 1) can be found here 280 | 2). The attribution requirement may be met by including the following 281 | in all advertising and documentation mentioning features of or use of 282 | this database. 283 | 284 | This tool uses, but does not include, the GeoLite2 data created by 285 | MaxMind, available from 286 | [http://www.maxmind.com](http://www.maxmind.com). 287 | 288 | Copyright (C) 2018-2023 H.Merijn Brand. All rights reserved. 289 | 290 | This library is free software; you can redistribute and/or modify it 291 | under the same terms as Perl itself. See here 292 | 3). 293 | 294 | 1) https://creativecommons.org/licenses/by-sa/4.0/ 295 | 2) https://www.maxmind.com/en/geolite2/eula 296 | 3) https://opensource.org/licenses/Artistic-2.0 297 | 298 | perl v5.40.1 2025-03-14 App::geoip(3) 299 | -------------------------------------------------------------------------------- /doc/geoip.md: -------------------------------------------------------------------------------- 1 | # NAME 2 | 3 | geoip - a tool to show geographical data based on hostname or IP address(es) 4 | 5 | # SYNOPSIS 6 | 7 | geoip --help 8 | 9 | geoip --fetch [--no-update] 10 | 11 | geoip [options] [host|IP ...] 12 | 13 | # DESCRIPTION 14 | 15 | This tool uses a database to use the (pre-fetched) GeoIP2 data from MaxMind 16 | to show related geographical information for IP addresses. This information 17 | can optionally be extended with information from online WHOIS services and 18 | or derived data, like distance to the location of the server this tool runs 19 | on or a configured local location. 20 | 21 | The output is plain text or JSON. JSON may be short or formatted. 22 | 23 | ## Configuration 24 | 25 | The tool allows the use of configuration files. It tests for existence of 26 | the files listed here. All existing files is read (in this order) if it is 27 | only writable by the author (mode `0640` should do). 28 | 29 | $home/geoip.rc 30 | $home/.geoiprc 31 | $home/.config/geoip 32 | 33 | where `$home` is either of `$HOME`, `$USERPROFILE`, or `$HOMEPATH`. 34 | 35 | The format of the file is 36 | 37 | # Comment 38 | ; Comment 39 | option : value 40 | option = value 41 | 42 | where the `:` and `=` are equal and whitespace around them is optional 43 | and ignored. The values `False` and `No` (case insensitive) are the same 44 | as `0` and the values `True` and `Yes` are equal to `1`. For readability 45 | you can prefix `use_` to most options (it is ignored). The use of `-` in 46 | option names is allowed and will be translated to `_`. 47 | 48 | The recognized options and the command line equivalences are 49 | 50 | - fetch 51 | 52 | command line option : `-f` or `--fetch` 53 | 54 | default value : False 55 | 56 | Fetch new databases from the MaxMind site. 57 | 58 | - update 59 | 60 | command line option : `-u` or `--update` 61 | 62 | default value : True 63 | 64 | Only in effect when used with `--fetch`: when new data files from MaxMind 65 | have successfully been fetched and any of these is newer that what the 66 | database contains, update the database with the new data. 67 | 68 | - distance 69 | 70 | command line option : `-d` or `--distance` 71 | 72 | default value : False 73 | 74 | If both the location of the tool _and_ the location of the requested IP 75 | are known, calculate the distance between them. The default is to show 76 | the distance in kilometers. Choosing a configuration of `miles` instead 77 | of `True`, `Yes`, or `1` will show the distance in miles. There is no 78 | command line option for miles. 79 | 80 | The location of the tool is either locally stored in your configuration 81 | (see `--local-location`) or fetched using the result of the urls 82 | [`iplocation.com`](https://iplocation.com) or 83 | [`geoiptool`](https://geoiptool.com). This will - of course - not work 84 | if there is no network connection or outside traffic is not allowed. 85 | 86 | - whois 87 | 88 | command line option : `-w` or `--whois` 89 | 90 | default value : False 91 | 92 | If [Net::Whois::IP](https://metacpan.org/pod/Net%3A%3AWhois%3A%3AIP) is installed, and this option is true, this module 93 | will be used to retrieve the `whois` information. This will not work if 94 | there is no network connection or outside traffic is not allowed. 95 | 96 | - short 97 | 98 | command line option : `-s` or `--short` 99 | 100 | default value : False 101 | 102 | This option will disable the output of less-informative information like 103 | location, EU-membership, satellite and proxy. This option, if True, will 104 | also implicitly disable the `distance` and `whois` information. 105 | 106 | - dsn 107 | 108 | command line option : `-Ddsn` or `--DB=dsn` 109 | 110 | default value : `$ENV{EOIP_DBI_DSN}` or `dbi:Pg:geoip` 111 | 112 | See ["DATABASE"](#database) for the (documented) list of supported database types. 113 | 114 | If the connection works, the tables used by this tool will be created if 115 | not yet present. 116 | 117 | The order of usage is: 118 | 119 | 1. Command line argument (`--DB=dsn`) 120 | 2. The `GEOIP_DBI_DSN` environment variable 121 | 3. The value for `dsn` in the configuration file(s) 122 | 4. `dbi:Pg:dbname=geoip` 123 | 124 | - json 125 | 126 | command line option : `-j` or `--json` 127 | 128 | default value : False 129 | 130 | The default output for the information is plain text. With this option, 131 | the output will be in JSON format. The default is not prettified. 132 | 133 | - json-pretty 134 | 135 | command line option : `-J` or `--json-pretty` 136 | 137 | default value : False 138 | 139 | If set from the command-line, this implies the `--json` option. 140 | 141 | With this option, JSON output is done _pretty_ (indented). 142 | 143 | - local-location 144 | 145 | command line option : `-l lat/lon` or `--local=lat/lon` 146 | 147 | default value : Undefined 148 | 149 | Sets the local location coordinates for use with distances. 150 | 151 | When running the tool from a different location than where the IP access is 152 | to be analyzed for or when the network connection will not report a location 153 | that would make sense (like working from a cloud or running over one or more 154 | VPN connections), one can set the location of the base in decimal notation. 155 | (degree-minute-second-notation is not yet supported). 156 | 157 | This is also useful when there is no outbound connection possible or when you 158 | do not move location and you want to restrict network requests. 159 | 160 | The notation is decimal (with a `.`, no localization support) where latitude 161 | and longitude are separated by a `/` or a `,`, like `-l 12.345678/-9.876543` 162 | or `--local=12,3456,45,6789`. 163 | 164 | - maxmind-account 165 | 166 | command line option : none 167 | 168 | default value : Undefined 169 | 170 | Currently not (yet) used. Documentation only. 171 | 172 | - license-id 173 | 174 | command line option : none 175 | 176 | default value : Undefined 177 | 178 | Currently not (yet) used. Documentation only. 179 | 180 | - license-key 181 | 182 | command line option : none 183 | 184 | default value : Undefined 185 | 186 | As downloads are only allowed/possible using a valid MaxMind account, you need 187 | to provide a valid license key in your configuration file. If you do not have 188 | an account, you can sign up [here](https://www.maxmind.com/en/geolite2/signup). 189 | 190 | # DATABASE 191 | 192 | Currently PostgreSQL and SQLite have been tested, but others may (or may not) 193 | work just as well. YMMV. Note that the database need to know the `CIDR` 194 | field type and is able to put a primary key on it. 195 | 196 | MariaDB and MySQL are not supported, as they do not support the concept of 197 | CIDR type fields. 198 | 199 | The advantage of PostgreSQL over SQLite is that you can use it with multiple 200 | users at the same time, and that you can share the database with other hosts 201 | on the same network behind a firewall. 202 | 203 | The advantage of SQLite over PostgreSQL is that it is a single file that you 204 | can copy or move to your liking. This file will be somewhere around 500 Mb. 205 | 206 | # EXAMPLES 207 | 208 | ## Configuration 209 | 210 | $ cat ~/.config/geoip 211 | use_distance : True 212 | json-pretty : yes 213 | 214 | ## Basic use 215 | 216 | $ geoip --short 1.2.3.4 217 | 218 | ## For automation 219 | 220 | $ geoip --json --no-json-pretty 1.2.3.4 221 | 222 | $ env GEOIP_HOST=1.2.3.4 geoip 223 | 224 | ## Full report 225 | 226 | $ geoip --dist --whois 1.2.3.4 227 | 228 | ## Selecting CIDR's for countries 229 | 230 | ### List all CIDR's for Vatican City 231 | 232 | $ geoip --country=Vatican > vatican-city.cidr 233 | 234 | ### Statistics 235 | 236 | If you enable verbosity, the selected statistics will be presented at the 237 | end of the CIDR-list: number of CIDR's, number of enclosed IP's, name of 238 | the country and the continent. As the country name is just a perl regex, 239 | you can select all countries with `.`, or all countries that start with 240 | a `V`: 241 | 242 | $ geoip --country=^V -v >/dev/null 243 | Selected CIDR's 244 | # CIDR # IP Country Continent 245 | ------ ---------- --------------------- --------------- 246 | 21 18176 Vanuatu Oceania 247 | 321 13056 Vatican City Europe 248 | 272 6798500 Venezuela South America 249 | 612 16014080 Vietnam Asia 250 | 251 | # TODO 252 | 253 | - IPv6 254 | 255 | The ZIP files also contain IPv6 information, but it is not (yet) converted 256 | to the database, nor supported in analysis. 257 | 258 | - Modularization 259 | 260 | Split up the different parts of the script to modules: fetch, extract, 261 | check, database, external tools, reporting. 262 | 263 | - CPAN 264 | 265 | Turn this into something like App::geoip, complete with Makefile.PL 266 | 267 | # SEE ALSO 268 | 269 | [DBI](https://metacpan.org/pod/DBI), [Net::CIDR](https://metacpan.org/pod/Net%3A%3ACIDR), [Math::Trig](https://metacpan.org/pod/Math%3A%3ATrig), [LWP::Simple](https://metacpan.org/pod/LWP%3A%3ASimple), [Archive::ZIP](https://metacpan.org/pod/Archive%3A%3AZIP), 270 | [Text::CSV\_XS](https://metacpan.org/pod/Text%3A%3ACSV_XS), [JSON::PP](https://metacpan.org/pod/JSON%3A%3APP), [GIS::Distance](https://metacpan.org/pod/GIS%3A%3ADistance), [Net::Whois::IP](https://metacpan.org/pod/Net%3A%3AWhois%3A%3AIP), 271 | [HTML::TreeBuilder](https://metacpan.org/pod/HTML%3A%3ATreeBuilder), [Data::Dumper](https://metacpan.org/pod/Data%3A%3ADumper), [Data::Peek](https://metacpan.org/pod/Data%3A%3APeek), [Socket](https://metacpan.org/pod/Socket) 272 | 273 | [Geo::Coder::HostIP](https://metacpan.org/pod/Geo%3A%3ACoder%3A%3AHostIP), [Geo::IP](https://metacpan.org/pod/Geo%3A%3AIP), [Geo::IP2Location](https://metacpan.org/pod/Geo%3A%3AIP2Location), [Geo::IP2Proxy](https://metacpan.org/pod/Geo%3A%3AIP2Proxy), 274 | [Geo::IP6](https://metacpan.org/pod/Geo%3A%3AIP6), [Geo::IPfree](https://metacpan.org/pod/Geo%3A%3AIPfree), [Geo::IP::RU::IpGeoBase](https://metacpan.org/pod/Geo%3A%3AIP%3A%3ARU%3A%3AIpGeoBase), [IP::Country](https://metacpan.org/pod/IP%3A%3ACountry), 275 | [IP::Country::DB\_File](https://metacpan.org/pod/IP%3A%3ACountry%3A%3ADB_File), [IP::Country::DNSBL](https://metacpan.org/pod/IP%3A%3ACountry%3A%3ADNSBL), [IP::Info](https://metacpan.org/pod/IP%3A%3AInfo), [IP::Location](https://metacpan.org/pod/IP%3A%3ALocation), 276 | [IP::QQWry](https://metacpan.org/pod/IP%3A%3AQQWry), [IP::World](https://metacpan.org/pod/IP%3A%3AWorld), [Metabrik::Lookup::Iplocation](https://metacpan.org/pod/Metabrik%3A%3ALookup%3A%3AIplocation), [Pcore::GeoIP](https://metacpan.org/pod/Pcore%3A%3AGeoIP) 277 | 278 | [IP::Geolocation::MMDB](https://metacpan.org/pod/IP%3A%3AGeolocation%3A%3AMMDB) 279 | 280 | Check [CPAN](https://metacpan.org/search?q=geoip) for more. 281 | 282 | # THANKS 283 | 284 | Thanks to cavac for the inspiration 285 | 286 | # AUTHOR 287 | 288 | H.Merijn Brand ``, aka Tux. 289 | 290 | # COPYRIGHT AND LICENSE 291 | 292 | The GeoLite2 end-user license agreement, which incorporates components of the 293 | Creative Commons Attribution-ShareAlike 4.0 International License 1) can be found 294 | [here](https://www.maxmind.com/en/geolite2/eula) 2). The attribution requirement 295 | may be met by including the following in all advertising and documentation 296 | mentioning features of or use of this database. 297 | 298 | This tool uses, but does not include, the GeoLite2 data created by MaxMind, 299 | available from \[http://www.maxmind.com\](http://www.maxmind.com). 300 | 301 | Copyright (C) 2018-2023 H.Merijn Brand. All rights reserved. 302 | 303 | This library is free software; you can redistribute and/or modify it under 304 | the same terms as Perl itself. 305 | See [here](https://opensource.org/licenses/Artistic-2.0) 3). 306 | 307 | 1) https://creativecommons.org/licenses/by-sa/4.0/ 308 | 2) https://www.maxmind.com/en/geolite2/eula 309 | 3) https://opensource.org/licenses/Artistic-2.0 310 | -------------------------------------------------------------------------------- /doc/geoip.3: -------------------------------------------------------------------------------- 1 | .\" -*- mode: troff; coding: utf-8 -*- 2 | .\" Automatically generated by Pod::Man v6.0.2 (Pod::Simple 3.45) 3 | .\" 4 | .\" Standard preamble: 5 | .\" ======================================================================== 6 | .de Sp \" Vertical space (when we can't use .PP) 7 | .if t .sp .5v 8 | .if n .sp 9 | .. 10 | .de Vb \" Begin verbatim text 11 | .ft CW 12 | .nf 13 | .ne \\$1 14 | .. 15 | .de Ve \" End verbatim text 16 | .ft R 17 | .fi 18 | .. 19 | .\" \*(C` and \*(C' are quotes in nroff, nothing in troff, for use with C<>. 20 | .ie n \{\ 21 | . ds C` "" 22 | . ds C' "" 23 | 'br\} 24 | .el\{\ 25 | . ds C` 26 | . ds C' 27 | 'br\} 28 | .\" 29 | .\" Escape single quotes in literal strings from groff's Unicode transform. 30 | .ie \n(.g .ds Aq \(aq 31 | .el .ds Aq ' 32 | .\" 33 | .\" If the F register is >0, we'll generate index entries on stderr for 34 | .\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index 35 | .\" entries marked with X<> in POD. Of course, you'll have to process the 36 | .\" output yourself in some meaningful fashion. 37 | .\" 38 | .\" Avoid warning from groff about undefined register 'F'. 39 | .de IX 40 | .. 41 | .nr rF 0 42 | .if \n(.g .if rF .nr rF 1 43 | .if (\n(rF:(\n(.g==0)) \{\ 44 | . if \nF \{\ 45 | . de IX 46 | . tm Index:\\$1\t\\n%\t"\\$2" 47 | .. 48 | . if !\nF==2 \{\ 49 | . nr % 0 50 | . nr F 2 51 | . \} 52 | . \} 53 | .\} 54 | .rr rF 55 | .\" 56 | .\" Required to disable full justification in groff 1.23.0. 57 | .if n .ds AD l 58 | .\" ======================================================================== 59 | .\" 60 | .IX Title "App::geoip 3" 61 | .TH App::geoip 3 2025-03-14 "perl v5.40.1" "User Contributed Perl Documentation" 62 | .\" For nroff, turn off justification. Always turn off hyphenation; it makes 63 | .\" way too many mistakes in technical documents. 64 | .if n .ad l 65 | .nh 66 | .SH NAME 67 | geoip \- a tool to show geographical data based on hostname or IP address(es) 68 | .SH SYNOPSIS 69 | .IX Header "SYNOPSIS" 70 | .Vb 1 71 | \& geoip \-\-help 72 | \& 73 | \& geoip \-\-fetch [\-\-no\-update] 74 | \& 75 | \& geoip [options] [host|IP ...] 76 | .Ve 77 | .SH DESCRIPTION 78 | .IX Header "DESCRIPTION" 79 | This tool uses a database to use the (pre\-fetched) GeoIP2 data from MaxMind 80 | to show related geographical information for IP addresses. This information 81 | can optionally be extended with information from online WHOIS services and 82 | or derived data, like distance to the location of the server this tool runs 83 | on or a configured local location. 84 | .PP 85 | The output is plain text or JSON. JSON may be short or formatted. 86 | .SS Configuration 87 | .IX Subsection "Configuration" 88 | The tool allows the use of configuration files. It tests for existence of 89 | the files listed here. All existing files is read (in this order) if it is 90 | only writable by the author (mode \f(CW0640\fR should do). 91 | .PP 92 | .Vb 3 93 | \& $home/geoip.rc 94 | \& $home/.geoiprc 95 | \& $home/.config/geoip 96 | .Ve 97 | .PP 98 | where \f(CW$home\fR is either of \f(CW$HOME\fR, \f(CW$USERPROFILE\fR, or \f(CW$HOMEPATH\fR. 99 | .PP 100 | The format of the file is 101 | .PP 102 | .Vb 4 103 | \& # Comment 104 | \& ; Comment 105 | \& option : value 106 | \& option = value 107 | .Ve 108 | .PP 109 | where the \f(CW\*(C`:\*(C'\fR and \f(CW\*(C`=\*(C'\fR are equal and whitespace around them is optional 110 | and ignored. The values \f(CW\*(C`False\*(C'\fR and \f(CW\*(C`No\*(C'\fR (case insensitive) are the same 111 | as \f(CW0\fR and the values \f(CW\*(C`True\*(C'\fR and \f(CW\*(C`Yes\*(C'\fR are equal to \f(CW1\fR. For readability 112 | you can prefix \f(CW\*(C`use_\*(C'\fR to most options (it is ignored). The use of \f(CW\*(C`\-\*(C'\fR in 113 | option names is allowed and will be translated to \f(CW\*(C`_\*(C'\fR. 114 | .PP 115 | The recognized options and the command line equivalences are 116 | .IP fetch 2 117 | .IX Item "fetch" 118 | command line option : \f(CW\*(C`\-f\*(C'\fR or \f(CW\*(C`\-\-fetch\*(C'\fR 119 | .Sp 120 | default value : False 121 | .Sp 122 | Fetch new databases from the MaxMind site. 123 | .IP update 2 124 | .IX Item "update" 125 | command line option : \f(CW\*(C`\-u\*(C'\fR or \f(CW\*(C`\-\-update\*(C'\fR 126 | .Sp 127 | default value : True 128 | .Sp 129 | Only in effect when used with \f(CW\*(C`\-\-fetch\*(C'\fR: when new data files from MaxMind 130 | have successfully been fetched and any of these is newer that what the 131 | database contains, update the database with the new data. 132 | .IP distance 2 133 | .IX Item "distance" 134 | command line option : \f(CW\*(C`\-d\*(C'\fR or \f(CW\*(C`\-\-distance\*(C'\fR 135 | .Sp 136 | default value : False 137 | .Sp 138 | If both the location of the tool \fIand\fR the location of the requested IP 139 | are known, calculate the distance between them. The default is to show 140 | the distance in kilometers. Choosing a configuration of \f(CW\*(C`miles\*(C'\fR instead 141 | of \f(CW\*(C`True\*(C'\fR, \f(CW\*(C`Yes\*(C'\fR, or \f(CW1\fR will show the distance in miles. There is no 142 | command line option for miles. 143 | .Sp 144 | The location of the tool is either locally stored in your configuration 145 | (see \f(CW\*(C`\-\-local\-location\*(C'\fR) or fetched using the result of the urls 146 | \&\f(CW\*(C`iplocation.com\*(C'\fR or 147 | \&\f(CW\*(C`geoiptool\*(C'\fR . This will \- of course \- not work 148 | if there is no network connection or outside traffic is not allowed. 149 | .IP whois 2 150 | .IX Item "whois" 151 | command line option : \f(CW\*(C`\-w\*(C'\fR or \f(CW\*(C`\-\-whois\*(C'\fR 152 | .Sp 153 | default value : False 154 | .Sp 155 | If Net::Whois::IP is installed, and this option is true, this module 156 | will be used to retrieve the \f(CW\*(C`whois\*(C'\fR information. This will not work if 157 | there is no network connection or outside traffic is not allowed. 158 | .IP short 2 159 | .IX Item "short" 160 | command line option : \f(CW\*(C`\-s\*(C'\fR or \f(CW\*(C`\-\-short\*(C'\fR 161 | .Sp 162 | default value : False 163 | .Sp 164 | This option will disable the output of less\-informative information like 165 | location, EU\-membership, satellite and proxy. This option, if True, will 166 | also implicitly disable the \f(CW\*(C`distance\*(C'\fR and \f(CW\*(C`whois\*(C'\fR information. 167 | .IP dsn 2 168 | .IX Item "dsn" 169 | command line option : \f(CW\*(C`\-Ddsn\*(C'\fR or \f(CW\*(C`\-\-DB=dsn\*(C'\fR 170 | .Sp 171 | default value : \f(CW$ENV{EOIP_DBI_DSN}\fR or \f(CW\*(C`dbi:Pg:geoip\*(C'\fR 172 | .Sp 173 | See "DATABASE" for the (documented) list of supported database types. 174 | .Sp 175 | If the connection works, the tables used by this tool will be created if 176 | not yet present. 177 | .Sp 178 | The order of usage is: 179 | .RS 2 180 | .IP 1. 2 181 | Command line argument (\f(CW\*(C`\-\-DB=dsn\*(C'\fR) 182 | .IP 2. 2 183 | The \f(CW\*(C`GEOIP_DBI_DSN\*(C'\fR environment variable 184 | .IP 3. 2 185 | The value for \f(CW\*(C`dsn\*(C'\fR in the configuration file(s) 186 | .IP 4. 2 187 | \&\f(CW\*(C`dbi:Pg:dbname=geoip\*(C'\fR 188 | .RE 189 | .RS 2 190 | .RE 191 | .IP json 2 192 | .IX Item "json" 193 | command line option : \f(CW\*(C`\-j\*(C'\fR or \f(CW\*(C`\-\-json\*(C'\fR 194 | .Sp 195 | default value : False 196 | .Sp 197 | The default output for the information is plain text. With this option, 198 | the output will be in JSON format. The default is not prettified. 199 | .IP json\-pretty 2 200 | .IX Item "json-pretty" 201 | command line option : \f(CW\*(C`\-J\*(C'\fR or \f(CW\*(C`\-\-json\-pretty\*(C'\fR 202 | .Sp 203 | default value : False 204 | .Sp 205 | If set from the command\-line, this implies the \f(CW\*(C`\-\-json\*(C'\fR option. 206 | .Sp 207 | With this option, JSON output is done \fIpretty\fR (indented). 208 | .IP local\-location 2 209 | .IX Item "local-location" 210 | command line option : \f(CW\*(C`\-l lat/lon\*(C'\fR or \f(CW\*(C`\-\-local=lat/lon\*(C'\fR 211 | .Sp 212 | default value : Undefined 213 | .Sp 214 | Sets the local location coordinates for use with distances. 215 | .Sp 216 | When running the tool from a different location than where the IP access is 217 | to be analyzed for or when the network connection will not report a location 218 | that would make sense (like working from a cloud or running over one or more 219 | VPN connections), one can set the location of the base in decimal notation. 220 | (degree\-minute\-second\-notation is not yet supported). 221 | .Sp 222 | This is also useful when there is no outbound connection possible or when you 223 | do not move location and you want to restrict network requests. 224 | .Sp 225 | The notation is decimal (with a \f(CW\*(C`.\*(C'\fR, no localization support) where latitude 226 | and longitude are separated by a \f(CW\*(C`/\*(C'\fR or a \f(CW\*(C`,\*(C'\fR, like \f(CW\*(C`\-l 12.345678/\-9.876543\*(C'\fR 227 | or \f(CW\*(C`\-\-local=12,3456,45,6789\*(C'\fR. 228 | .IP maxmind\-account 2 229 | .IX Item "maxmind-account" 230 | command line option : none 231 | .Sp 232 | default value : Undefined 233 | .Sp 234 | Currently not (yet) used. Documentation only. 235 | .IP license\-id 2 236 | .IX Item "license-id" 237 | command line option : none 238 | .Sp 239 | default value : Undefined 240 | .Sp 241 | Currently not (yet) used. Documentation only. 242 | .IP license\-key 2 243 | .IX Item "license-key" 244 | command line option : none 245 | .Sp 246 | default value : Undefined 247 | .Sp 248 | As downloads are only allowed/possible using a valid MaxMind account, you need 249 | to provide a valid license key in your configuration file. If you do not have 250 | an account, you can sign up here . 251 | .SH DATABASE 252 | .IX Header "DATABASE" 253 | Currently PostgreSQL and SQLite have been tested, but others may (or may not) 254 | work just as well. YMMV. Note that the database need to know the \f(CW\*(C`CIDR\*(C'\fR 255 | field type and is able to put a primary key on it. 256 | .PP 257 | MariaDB and MySQL are not supported, as they do not support the concept of 258 | CIDR type fields. 259 | .PP 260 | The advantage of PostgreSQL over SQLite is that you can use it with multiple 261 | users at the same time, and that you can share the database with other hosts 262 | on the same network behind a firewall. 263 | .PP 264 | The advantage of SQLite over PostgreSQL is that it is a single file that you 265 | can copy or move to your liking. This file will be somewhere around 500 Mb. 266 | .SH EXAMPLES 267 | .IX Header "EXAMPLES" 268 | .SS Configuration 269 | .IX Subsection "Configuration" 270 | .Vb 3 271 | \& $ cat ~/.config/geoip 272 | \& use_distance : True 273 | \& json\-pretty : yes 274 | .Ve 275 | .SS "Basic use" 276 | .IX Subsection "Basic use" 277 | .Vb 1 278 | \& $ geoip \-\-short 1.2.3.4 279 | .Ve 280 | .SS "For automation" 281 | .IX Subsection "For automation" 282 | .Vb 1 283 | \& $ geoip \-\-json \-\-no\-json\-pretty 1.2.3.4 284 | \& 285 | \& $ env GEOIP_HOST=1.2.3.4 geoip 286 | .Ve 287 | .SS "Full report" 288 | .IX Subsection "Full report" 289 | .Vb 1 290 | \& $ geoip \-\-dist \-\-whois 1.2.3.4 291 | .Ve 292 | .SS "Selecting CIDR\*(Aqs for countries" 293 | .IX Subsection "Selecting CIDR's for countries" 294 | \fIList all CIDR\*(Aqs for Vatican City\fR 295 | .IX Subsection "List all CIDR's for Vatican City" 296 | .PP 297 | .Vb 1 298 | \& $ geoip \-\-country=Vatican > vatican\-city.cidr 299 | .Ve 300 | .PP 301 | \fIStatistics\fR 302 | .IX Subsection "Statistics" 303 | .PP 304 | If you enable verbosity, the selected statistics will be presented at the 305 | end of the CIDR\-list: number of CIDR\*(Aqs, number of enclosed IP\*(Aqs, name of 306 | the country and the continent. As the country name is just a perl regex, 307 | you can select all countries with \f(CW\*(C`.\*(C'\fR, or all countries that start with 308 | a \f(CW\*(C`V\*(C'\fR: 309 | .PP 310 | .Vb 8 311 | \& $ geoip \-\-country=^V \-v >/dev/null 312 | \& Selected CIDR\*(Aqs 313 | \& # CIDR # IP Country Continent 314 | \& \-\-\-\-\-\- \-\-\-\-\-\-\-\-\-\- \-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\- \-\-\-\-\-\-\-\-\-\-\-\-\-\-\- 315 | \& 21 18176 Vanuatu Oceania 316 | \& 321 13056 Vatican City Europe 317 | \& 272 6798500 Venezuela South America 318 | \& 612 16014080 Vietnam Asia 319 | .Ve 320 | .SH TODO 321 | .IX Header "TODO" 322 | .IP IPv6 2 323 | .IX Item "IPv6" 324 | The ZIP files also contain IPv6 information, but it is not (yet) converted 325 | to the database, nor supported in analysis. 326 | .IP Modularization 2 327 | .IX Item "Modularization" 328 | Split up the different parts of the script to modules: fetch, extract, 329 | check, database, external tools, reporting. 330 | .IP CPAN 2 331 | .IX Item "CPAN" 332 | Turn this into something like App::geoip, complete with Makefile.PL 333 | .SH "SEE ALSO" 334 | .IX Header "SEE ALSO" 335 | DBI, Net::CIDR, Math::Trig, LWP::Simple, Archive::ZIP, 336 | Text::CSV_XS, JSON::PP, GIS::Distance, Net::Whois::IP, 337 | HTML::TreeBuilder, Data::Dumper, Data::Peek, Socket 338 | .PP 339 | Geo::Coder::HostIP, Geo::IP, Geo::IP2Location, Geo::IP2Proxy, 340 | Geo::IP6, Geo::IPfree, Geo::IP::RU::IpGeoBase, IP::Country, 341 | IP::Country::DB_File, IP::Country::DNSBL, IP::Info, IP::Location, 342 | IP::QQWry, IP::World, Metabrik::Lookup::Iplocation, Pcore::GeoIP 343 | .PP 344 | IP::Geolocation::MMDB 345 | .PP 346 | Check CPAN for more. 347 | .SH THANKS 348 | .IX Header "THANKS" 349 | Thanks to cavac for the inspiration 350 | .SH AUTHOR 351 | .IX Header "AUTHOR" 352 | H.Merijn Brand \fI\fR, aka Tux. 353 | .SH "COPYRIGHT AND LICENSE" 354 | .IX Header "COPYRIGHT AND LICENSE" 355 | The GeoLite2 end\-user license agreement, which incorporates components of the 356 | Creative Commons Attribution\-ShareAlike 4.0 International License 1) can be found 357 | here 2). The attribution requirement 358 | may be met by including the following in all advertising and documentation 359 | mentioning features of or use of this database. 360 | .PP 361 | This tool uses, but does not include, the GeoLite2 data created by MaxMind, 362 | available from [http://www.maxmind.com](http://www.maxmind.com). 363 | .PP 364 | .Vb 1 365 | \& Copyright (C) 2018\-2023 H.Merijn Brand. All rights reserved. 366 | .Ve 367 | .PP 368 | This library is free software; you can redistribute and/or modify it under 369 | the same terms as Perl itself. 370 | See here 3). 371 | .PP 372 | .Vb 3 373 | \& 1) https://creativecommons.org/licenses/by\-sa/4.0/ 374 | \& 2) https://www.maxmind.com/en/geolite2/eula 375 | \& 3) https://opensource.org/licenses/Artistic\-2.0 376 | .Ve 377 | -------------------------------------------------------------------------------- /doc/geoip.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | geoip - a tool to show geographical data based on hostname or IP address(es) 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 43 | 44 |

NAME

45 | 46 |

geoip - a tool to show geographical data based on hostname or IP address(es)

47 | 48 |

SYNOPSIS

49 | 50 | 
geoip --help
 51 | 
 52 | geoip --fetch [--no-update]
 53 | 
 54 | geoip [options] [host|IP ...]
55 | 56 |

DESCRIPTION

57 | 58 |

This tool uses a database to use the (pre-fetched) GeoIP2 data from MaxMind to show related geographical information for IP addresses. This information can optionally be extended with information from online WHOIS services and or derived data, like distance to the location of the server this tool runs on or a configured local location.

59 | 60 |

The output is plain text or JSON. JSON may be short or formatted.

61 | 62 |

Configuration

63 | 64 |

The tool allows the use of configuration files. It tests for existence of the files listed here. All existing files is read (in this order) if it is only writable by the author (mode 0640 should do).

65 | 66 | 
$home/geoip.rc
 67 | $home/.geoiprc
 68 | $home/.config/geoip
69 | 70 |

where $home is either of $HOME, $USERPROFILE, or $HOMEPATH.

71 | 72 |

The format of the file is

73 | 74 | 
# Comment
 75 | ; Comment
 76 | option : value
 77 | option = value
78 | 79 |

where the : and = are equal and whitespace around them is optional and ignored. The values False and No (case insensitive) are the same as 0 and the values True and Yes are equal to 1. For readability you can prefix use_ to most options (it is ignored). The use of - in option names is allowed and will be translated to _.

80 | 81 |

The recognized options and the command line equivalences are

82 | 83 |
84 | 85 |
fetch
86 |
87 | 88 |

command line option : -f or --fetch

89 | 90 |

default value : False

91 | 92 |

Fetch new databases from the MaxMind site.

93 | 94 |
95 |
update
96 |
97 | 98 |

command line option : -u or --update

99 | 100 |

default value : True

101 | 102 |

Only in effect when used with --fetch: when new data files from MaxMind have successfully been fetched and any of these is newer that what the database contains, update the database with the new data.

103 | 104 |
105 |
distance
106 |
107 | 108 |

command line option : -d or --distance

109 | 110 |

default value : False

111 | 112 |

If both the location of the tool and the location of the requested IP are known, calculate the distance between them. The default is to show the distance in kilometers. Choosing a configuration of miles instead of True, Yes, or 1 will show the distance in miles. There is no command line option for miles.

113 | 114 |

The location of the tool is either locally stored in your configuration (see --local-location) or fetched using the result of the urls iplocation.com or geoiptool. This will - of course - not work if there is no network connection or outside traffic is not allowed.

115 | 116 |
117 |
whois
118 |
119 | 120 |

command line option : -w or --whois

121 | 122 |

default value : False

123 | 124 |

If Net::Whois::IP is installed, and this option is true, this module will be used to retrieve the whois information. This will not work if there is no network connection or outside traffic is not allowed.

125 | 126 |
127 |
short
128 |
129 | 130 |

command line option : -s or --short

131 | 132 |

default value : False

133 | 134 |

This option will disable the output of less-informative information like location, EU-membership, satellite and proxy. This option, if True, will also implicitly disable the distance and whois information.

135 | 136 |
137 |
dsn
138 |
139 | 140 |

command line option : -Ddsn or --DB=dsn

141 | 142 |

default value : $ENV{EOIP_DBI_DSN} or dbi:Pg:geoip

143 | 144 |

See "DATABASE" for the (documented) list of supported database types.

145 | 146 |

If the connection works, the tables used by this tool will be created if not yet present.

147 | 148 |

The order of usage is:

149 | 150 |
    151 | 152 |

  1. Command line argument (--DB=dsn)

    153 | 154 |
    2. 155 |

  2. The GEOIP_DBI_DSN environment variable

    156 | 157 |
    3. 158 |

  3. The value for dsn in the configuration file(s)

    159 | 160 |
    4. 161 |

  4. dbi:Pg:dbname=geoip

    162 | 163 |
    5. 164 |
165 | 166 |
167 |
json
168 |
169 | 170 |

command line option : -j or --json

171 | 172 |

default value : False

173 | 174 |

The default output for the information is plain text. With this option, the output will be in JSON format. The default is not prettified.

175 | 176 |
177 |
json-pretty
178 |
179 | 180 |

command line option : -J or --json-pretty

181 | 182 |

default value : False

183 | 184 |

If set from the command-line, this implies the --json option.

185 | 186 |

With this option, JSON output is done pretty (indented).

187 | 188 |
189 |
local-location
190 |
191 | 192 |

command line option : -l lat/lon or --local=lat/lon

193 | 194 |

default value : Undefined

195 | 196 |

Sets the local location coordinates for use with distances.

197 | 198 |

When running the tool from a different location than where the IP access is to be analyzed for or when the network connection will not report a location that would make sense (like working from a cloud or running over one or more VPN connections), one can set the location of the base in decimal notation. (degree-minute-second-notation is not yet supported).

199 | 200 |

This is also useful when there is no outbound connection possible or when you do not move location and you want to restrict network requests.

201 | 202 |

The notation is decimal (with a ., no localization support) where latitude and longitude are separated by a / or a ,, like -l 12.345678/-9.876543 or --local=12,3456,45,6789.

203 | 204 |
205 |
maxmind-account
206 |
207 | 208 |

command line option : none

209 | 210 |

default value : Undefined

211 | 212 |

Currently not (yet) used. Documentation only.

213 | 214 |
215 |
license-id
216 |
217 | 218 |

command line option : none

219 | 220 |

default value : Undefined

221 | 222 |

Currently not (yet) used. Documentation only.

223 | 224 |
225 |
license-key
226 |
227 | 228 |

command line option : none

229 | 230 |

default value : Undefined

231 | 232 |

As downloads are only allowed/possible using a valid MaxMind account, you need to provide a valid license key in your configuration file. If you do not have an account, you can sign up here.

233 | 234 |
235 |
236 | 237 |

DATABASE

238 | 239 |

Currently PostgreSQL and SQLite have been tested, but others may (or may not) work just as well. YMMV. Note that the database need to know the CIDR field type and is able to put a primary key on it.

240 | 241 |

MariaDB and MySQL are not supported, as they do not support the concept of CIDR type fields.

242 | 243 |

The advantage of PostgreSQL over SQLite is that you can use it with multiple users at the same time, and that you can share the database with other hosts on the same network behind a firewall.

244 | 245 |

The advantage of SQLite over PostgreSQL is that it is a single file that you can copy or move to your liking. This file will be somewhere around 500 Mb.

246 | 247 |

EXAMPLES

248 | 249 |

Configuration

250 | 251 | 
$ cat ~/.config/geoip
252 | use_distance    : True
253 | json-pretty     : yes
254 | 255 |

Basic use

256 | 257 | 
$ geoip --short 1.2.3.4
258 | 259 |

For automation

260 | 261 | 
$ geoip --json --no-json-pretty 1.2.3.4
262 | 
263 | $ env GEOIP_HOST=1.2.3.4 geoip
264 | 265 |

Full report

266 | 267 | 
$ geoip --dist --whois 1.2.3.4
268 | 269 |

Selecting CIDR's for countries

270 | 271 |

List all CIDR's for Vatican City

272 | 273 | 
$ geoip --country=Vatican > vatican-city.cidr
274 | 275 |

Statistics

276 | 277 |

If you enable verbosity, the selected statistics will be presented at the end of the CIDR-list: number of CIDR's, number of enclosed IP's, name of the country and the continent. As the country name is just a perl regex, you can select all countries with ., or all countries that start with a V:

278 | 279 | 
$ geoip --country=^V -v >/dev/null
280 | Selected CIDR's
281 | # CIDR       # IP Country               Continent
282 | ------ ---------- --------------------- ---------------
283 |     21      18176 Vanuatu               Oceania
284 |    321      13056 Vatican City          Europe
285 |    272    6798500 Venezuela             South America
286 |    612   16014080 Vietnam               Asia
287 | 288 |

TODO

289 | 290 |
291 | 292 |
IPv6
293 |
294 | 295 |

The ZIP files also contain IPv6 information, but it is not (yet) converted to the database, nor supported in analysis.

296 | 297 |
298 |
Modularization
299 |
300 | 301 |

Split up the different parts of the script to modules: fetch, extract, check, database, external tools, reporting.

302 | 303 |
304 |
CPAN
305 |
306 | 307 |

Turn this into something like App::geoip, complete with Makefile.PL

308 | 309 |
310 |
311 | 312 |

SEE ALSO

313 | 314 |

DBI, Net::CIDR, Math::Trig, LWP::Simple, Archive::ZIP, Text::CSV_XS, JSON::PP, GIS::Distance, Net::Whois::IP, HTML::TreeBuilder, Data::Dumper, Data::Peek, Socket

315 | 316 |

Geo::Coder::HostIP, Geo::IP, Geo::IP2Location, Geo::IP2Proxy, Geo::IP6, Geo::IPfree, Geo::IP::RU::IpGeoBase, IP::Country, IP::Country::DB_File, IP::Country::DNSBL, IP::Info, IP::Location, IP::QQWry, IP::World, Metabrik::Lookup::Iplocation, Pcore::GeoIP

317 | 318 |

IP::Geolocation::MMDB

319 | 320 |

Check CPAN for more.

321 | 322 |

THANKS

323 | 324 |

Thanks to cavac for the inspiration

325 | 326 |

AUTHOR

327 | 328 |

H.Merijn Brand <hmbrand@cpan.org>, aka Tux.

329 | 330 |

COPYRIGHT AND LICENSE

331 | 332 |

The GeoLite2 end-user license agreement, which incorporates components of the Creative Commons Attribution-ShareAlike 4.0 International License 1) can be found here 2). The attribution requirement may be met by including the following in all advertising and documentation mentioning features of or use of this database.

333 | 334 |

This tool uses, but does not include, the GeoLite2 data created by MaxMind, available from [http://www.maxmind.com](http://www.maxmind.com).

335 | 336 | 
Copyright (C) 2018-2023 H.Merijn Brand.  All rights reserved.
337 | 338 |

This library is free software; you can redistribute and/or modify it under the same terms as Perl itself. See here 3).

339 | 340 | 
1) https://creativecommons.org/licenses/by-sa/4.0/
341 | 2) https://www.maxmind.com/en/geolite2/eula
342 | 3) https://opensource.org/licenses/Artistic-2.0
343 | 344 | 345 | 346 | 347 | 348 | -------------------------------------------------------------------------------- /sandbox/genMETA.pm: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | package genMETA; 4 | 5 | our $VERSION = "1.18-20250113"; 6 | 7 | use 5.014001; 8 | use warnings; 9 | use Carp; 10 | 11 | use CPAN::Meta::Converter; 12 | use CPAN::Meta::Validator; 13 | use Data::Peek; 14 | use Date::Calc qw( Delta_Days ); 15 | use Encode qw( encode decode ); 16 | use File::Find; 17 | use JSON::PP; 18 | use List::Util qw( first ); 19 | use Parse::CPAN::Meta; 20 | use Software::Security::Policy::Individual; 21 | use Term::ANSIColor qw(:constants); 22 | use Test::CPAN::Meta::YAML::Version; 23 | use Test::More (); 24 | use Text::Diff; 25 | use YAML::Syck; 26 | 27 | sub new { 28 | my $package = shift; 29 | return bless { @_ }, $package; 30 | } # new 31 | 32 | sub extract_version { 33 | my $fh = shift; 34 | my @vsn; 35 | while (<$fh>) { 36 | m/\$VERSION\b/ and push @vsn => $_; 37 | m{^(?:our\s+)? # declaration 38 | \$VERSION \s*=\s* # variable 39 | ["']? ([0-9._]+) # version 40 | (?:\s* - \s* [0-9]{4}-?[0-9]{2}-?[0-9]{2} \s*)? # date "0.01 - 20230412" 41 | ['"]? 42 | \s*;\s* 43 | (?:\x23 \s* [0-9]{4}-?[0-9]{2}-?[0-9]{2} \s*)? # date "0.01"; # 20230502 44 | $}x or next; 45 | return $1; 46 | } 47 | # No match on first scan, try without date 48 | for (@vsn) { 49 | m{^(?:our\s+)? # declaration 50 | \$VERSION \s*=\s* # variable 51 | ([""'']) ([0-9._]+) \1 # version 52 | \s*; 53 | }x or next; 54 | return $2; 55 | } 56 | } # extract_version 57 | 58 | sub version_from { 59 | my ($self, $src) = @_; 60 | 61 | $self->{mfpr} = {}; 62 | if (open my $mh, "<", "Makefile.PL") { 63 | my $mf = do { local $/; <$mh> }; 64 | 65 | if ($mf =~ m{\b NAME \s*=>\s* ["'] (\S+) ['"]}x) { 66 | $self->{name} = $1; 67 | $self->{name} =~ m/-/ and 68 | warn RED, "NAME in Makefile.PL contains a -", RESET, "\n"; 69 | $self->{name} =~ s/::/-/g; 70 | } 71 | if ($mf =~ m{\b DISTNAME \s*=>\s* ["'] (\S+) ['"]}x) { 72 | $self->{name} = $1; 73 | } 74 | 75 | if ($mf =~ m{\b VERSION_FROM \s*=>\s* ["'] (\S+) ['"]}x) { 76 | my $from = $1; 77 | -f $from or 78 | croak RED, "Makefile wants version from nonexisten $from", RESET, "\n"; 79 | $self->{from} //= $from; 80 | $from eq $self->{from} or 81 | croak RED, "VERSION_FROM mismatch Makefile.PL ($from) / YAML ($self->{from})", RESET, "\n"; 82 | } 83 | 84 | if ($mf =~ m[\b PREREQ_PM \s*=>\s* \{ ( [^}]+ ) \}]x) { 85 | my @pr = split m/\n/ => $1; 86 | $self->{mfpr} = { map { (m{ \b ["']? (\S+?) ['"]? \s*=>\s* ["']? ([-0-9._]+) ['"]? }x) } grep !m/^\s*#/ => @pr }; 87 | } 88 | 89 | $mf =~ m{--format=ustar} or 90 | warn RED, "TARFLAGS macro is missing", RESET, "\n"; 91 | } 92 | 93 | $src //= $self->{from} or croak "No file to extract version from"; 94 | 95 | open my $pm, "<", $src or croak "Cannot read $src"; 96 | my $version = extract_version ($pm) or croak "Cannot extract VERSION from $src\n"; 97 | close $pm; 98 | $self->{version} = $version; 99 | return $version 100 | } # version_from 101 | 102 | sub from_data { 103 | my ($self, @data) = @_; 104 | $self->{version} or $self->version_from (); 105 | s/VERSION/$self->{version}/g for @data; 106 | my ($dsct, $dmod); 107 | for (@data) { 108 | s/[ \t]+$//; 109 | m/^\s*(\w+):$/ and $dsct = $1; 110 | m/^\s*(\w(?:[\w:]+\w)?):\s+\d/ and $dmod = $1; 111 | s/\s+#\s*ignore\b\s*[:=]?\s*(\S+)$//i or next; 112 | $self->{cve_ignore}{$dsct}{$dmod} = $1; 113 | } 114 | $self->{yml} = \@data; 115 | $self->check_yaml (); 116 | $self->check_provides (); 117 | #DDumper $self->{cve_ignore}; 118 | return @data; 119 | } # from_data 120 | 121 | sub check_encoding { 122 | my $self = shift; 123 | my @tf = grep m{^(?: change | readme | .*\.pod )}ix => glob "*"; 124 | (my $tf = join ", " => @tf) =~ s/.*\K, / and /; 125 | 126 | print "Check if $tf are still valid UTF8 ...\n"; 127 | foreach my $tf (@tf) { 128 | open my $fh, "<", $tf or croak "$tf: $!\n"; 129 | my @c = <$fh>; 130 | my $c = join "" => @c; 131 | my @e; 132 | my $s = decode ("utf-8", $c, sub { push @e, shift; }); 133 | if (@e) { 134 | my @l; 135 | my $n = 0; 136 | for (@c) { 137 | $n++; 138 | eval { decode ("utf-8", $_, 1) }; 139 | $@ or next; 140 | $@ =~ s{ at /\S+ line \d+.*}{}; 141 | print BLUE, "$tf:$n\t$_\t$@", RESET; 142 | } 143 | croak "$tf is not valid UTF-8\n"; 144 | } 145 | my $u = encode ("utf-8", $s); 146 | $c eq $u and next; 147 | 148 | my $n; 149 | $n = 1; $c =~ s/^/$n++ . "\t"/gem; 150 | $n = 1; $u =~ s/^/$n++ . "\t"/gem; 151 | croak "$tf: recode makes content differ\n". diff \$c, \$u; 152 | } 153 | } # check_encoding 154 | 155 | sub check_required { 156 | my $self = shift; 157 | 158 | my $yml = $self->{h} or croak "No YAML to check"; 159 | 160 | warn "Check required and recommended module versions ...\n"; 161 | BEGIN { $V::NO_EXIT = $V::NO_EXIT = 1 } require V; 162 | my %req = map { %{$yml->{$_}} } grep m/requires/ => keys %{$yml}; 163 | my %rec = map { %{$yml->{$_}} } grep m/recommends/ => keys %{$yml}; 164 | my %sug = map { %{$yml->{$_}} } grep m/suggests/ => keys %{$yml}; 165 | if (my $of = $yml->{optional_features}) { 166 | foreach my $f (values %{$of}) { 167 | my %q = map { %{$f->{$_}} } grep m/requires/ => keys %{$f}; 168 | my %c = map { %{$f->{$_}} } grep m/recommends/ => keys %{$f}; 169 | my %s = map { %{$f->{$_}} } grep m/suggests/ => keys %{$f}; 170 | @req{keys %q} = values %q; 171 | @rec{keys %c} = values %c; 172 | @sug{keys %s} = values %s; 173 | } 174 | } 175 | if (my $of = $yml->{prereqs}) { 176 | foreach my $f (values %{$of}) { 177 | my %q = map { %{$f->{$_}} } grep m/requires/ => keys %{$f}; 178 | my %c = map { %{$f->{$_}} } grep m/recommends/ => keys %{$f}; 179 | my %s = map { %{$f->{$_}} } grep m/suggests/ => keys %{$f}; 180 | @req{keys %q} = values %q; 181 | @rec{keys %c} = values %c; 182 | @sug{keys %s} = values %s; 183 | } 184 | } 185 | my %vsn = ( %req, %rec, %sug ); 186 | delete @vsn{qw( perl version )}; 187 | for (sort keys %vsn) { 188 | if (my $mfv = delete $self->{mfpr}{$_}) { 189 | $req{$_} eq $mfv or 190 | croak RED, "PREREQ mismatch for $_ Makefile.PL ($mfv) / YAML ($req{$_})", RESET, "\n"; 191 | } 192 | $vsn{$_} eq "0" and next; 193 | my $v = V::get_version ($_); 194 | $v eq $vsn{$_} and next; 195 | printf STDERR "%s%-35s %-6s => %s%s%s\n", BLUE, $_, $vsn{$_}, GREEN, $v, RESET; 196 | } 197 | if (my @mfpr = grep { $_ ne "version" } sort keys %{$self->{mfpr}}) { 198 | croak RED, "Makefile.PL requires @mfpr, YAML does not", RESET, "\n"; 199 | } 200 | 201 | find (sub { 202 | $File::Find::dir =~ m{^blib\b} and return; 203 | $File::Find::name =~ m{(?:^|/)Bundle/.*\.pm} or return; 204 | if (open my $bh, "<", $_) { 205 | warn "Check bundle module versions $File::Find::name ...\n"; 206 | while (<$bh>) { 207 | my ($m, $dv) = m/^([A-Za-z_:]+)\s+([0-9.]+)\s*$/ or next; 208 | my $v = $m eq $self->{name} ? $self->{version} : V::get_version ($m); 209 | $v eq $dv and next; 210 | printf STDERR "%s%-35s %-6s => %s%s%s\n", BLUE, $m, $dv, GREEN, $v, RESET; 211 | } 212 | } 213 | }, glob "*"); 214 | } # check_required 215 | 216 | sub check_yaml { 217 | my $self = shift; 218 | 219 | my @yml = @{$self->{yml}} or croak "No YAML to check"; 220 | 221 | warn "Checking generated YAML ...\n" unless $self->{quiet}; 222 | my $h; 223 | my $yml = join "", @yml; 224 | eval { $h = Load ($yml) }; 225 | $@ and croak "$@\n"; 226 | $self->{name} //= $h->{name}; 227 | $self->{name} eq $h->{name} or 228 | croak RED, "NAME mismatch Makefile.PL / YAML", RESET, "\n"; 229 | $self->{name} =~ s/-/::/g; 230 | warn "Checking for $self->{name}-$self->{version}\n" unless $self->{quiet}; 231 | 232 | $self->{verbose} and print Dump $h; 233 | 234 | my $t = Test::CPAN::Meta::YAML::Version->new (data => $h); 235 | $t->parse () and 236 | croak join "\n", "Test::CPAN::Meta::YAML reported failure:", $t->errors, ""; 237 | 238 | eval { Parse::CPAN::Meta::Load ($yml) }; 239 | $@ and croak "$@\n"; 240 | 241 | $self->{h} = $h; 242 | $self->{yaml} = $yml; 243 | } # check_yaml 244 | 245 | sub check_minimum { 246 | my $self = shift; 247 | my $reqv = $self->{h}{requires}{perl} || $self->{h}{prereqs}{runtime}{requires}{perl}; 248 | my $locs; 249 | 250 | for (@_) { 251 | if (ref $_ eq "ARRAY") { 252 | $locs = { paths => $_ }; 253 | } 254 | elsif (ref $_ eq "HASH") { 255 | $locs = $_; 256 | } 257 | else { 258 | $reqv = $_; 259 | } 260 | } 261 | my $paths = (join ", " => @{($locs // {})->{paths} // []}) || "default paths"; 262 | 263 | $reqv or croak "No minimal required version for perl"; 264 | my $tmv = 0; 265 | $reqv > 5.009 and eval "use Test::MinimumVersion::Fast; \$tmv = 1"; 266 | $tmv or eval "use Test::MinimumVersion;"; 267 | print "Checking if $reqv is still OK as minimal version for $paths\n"; 268 | # All other minimum version checks done in xt 269 | Test::More::subtest "Minimum perl version $reqv" => sub { 270 | all_minimum_version_ok ($reqv, $locs); 271 | } or warn RED, "\n### Use 'perlver --blame' on the failing file(s)\n\n", RESET; 272 | } # check_minimum 273 | 274 | sub check_provides { 275 | my $self = shift; 276 | my $prov = $self->{h}{provides}; 277 | 278 | print "Check distribution module versions ...\n"; 279 | 280 | $prov or croak RED, "META does not contain a provides section", RESET, "\n"; 281 | 282 | ref $prov eq "HASH" or 283 | croak RED, "The provides section in META is not a HASH", RESET, "\n"; 284 | 285 | my $fail = 0; 286 | foreach my $m (sort keys %{$prov}) { 287 | my ($file, $pvsn) = @{$prov->{$m}}{qw( file version )}; 288 | unless ($file) { 289 | $fail++; 290 | say RED, " provided $m does not refer to a file", RESET; 291 | next; 292 | } 293 | unless ($pvsn) { 294 | $fail++; 295 | say RED, " provided $m does not declare a version", RESET; 296 | next; 297 | } 298 | 299 | printf " Expect %5s for %-32s ", $pvsn, $m; 300 | open my $fh, "<", $file; 301 | unless ($fh) { 302 | $fail++; 303 | say RED, "$file: $!\n", RESET; 304 | next; 305 | } 306 | 307 | my $version = extract_version ($fh); 308 | close $fh; 309 | unless ($version) { 310 | $fail++; 311 | say RED, "$file does not contain a VERSION", RESET; 312 | next; 313 | } 314 | 315 | if ($version ne $pvsn) { 316 | $fail++; 317 | say RED, "mismatch: $version", RESET; 318 | next; 319 | } 320 | say "ok"; 321 | } 322 | 323 | $fail and exit 1; 324 | } # check_provides 325 | 326 | sub check_changelog { 327 | # Check if the first date has been updated ... 328 | my @td = grep m/^Change(?:s|Log)$/i => glob "[Cc]*"; 329 | unless (@td) { 330 | warn "No ChangeLog to check\n"; 331 | return; 332 | } 333 | my %mnt = qw( jan 1 feb 2 mar 3 apr 4 may 5 jun 6 jul 7 aug 8 sep 9 oct 10 nov 11 dec 12 ); 334 | open my $fh, "<", $td[0] or croak "$td[0]: $!\n"; 335 | while (<$fh>) { 336 | s/\b([0-9]{4}) (?:[- ]) 337 | ([0-9]{1,2}) (?:[- ]) 338 | ([0-9]{1,2})\b/$3-$2-$1/x; # 2015-01-15 => 15-01-2015 339 | m/\b([0-9]{1,2}) (?:[- ]) 340 | ([0-9]{1,2}|[ADFJMNOSadfjmnos][acekopu][abcgilnprtvy]) (?:[- ]) 341 | ([0-9]{4})\b/x or next; 342 | my ($d, $m, $y) = ($1 + 0, ($mnt{lc $2} || $2) + 0, $3 + 0); 343 | printf STDERR "Most recent ChangeLog entry is dated %02d-%02d-%04d\n", $d, $m, $y; 344 | unless ($ENV{SKIP_CHANGELOG_DATE}) { 345 | my @t = localtime; 346 | my $D = Delta_Days ($y, $m , $d, $t[5] + 1900, $t[4] + 1, $t[3]); 347 | $D < 0 and croak RED, "Last entry in $td[0] is in the future!", RESET, "\n"; 348 | $D > 2 and croak RED, "Last entry in $td[0] is not up to date ($D days ago)", RESET, "\n"; 349 | $D > 0 and warn YELLOW, "Last entry in $td[0] is not today", RESET, "\n"; 350 | } 351 | last; 352 | } 353 | close $fh; 354 | } # check_changelog 355 | 356 | sub done_testing { 357 | check_changelog (); 358 | Test::More::done_testing (); 359 | } # done_testing 360 | 361 | sub quiet { 362 | my $self = shift; 363 | @_ and $self->{quiet} = defined $_[0]; 364 | $self->{quiet}; 365 | } # quiet 366 | 367 | sub print_json { 368 | my $self = shift; 369 | my $jsn = $self->{jsn} || $self->add_json (); 370 | print JSON::PP->new->utf8 (1)->pretty (1)->encode ($jsn); 371 | } # print_json 372 | 373 | sub print_yaml { 374 | my $self = shift; 375 | print @{$self->{yml}}; 376 | } # print_yaml 377 | 378 | sub write_yaml { 379 | my ($self, $out) = @_; 380 | $out ||= "META.yml"; 381 | $out =~ s/\.jso?n$/.yml/; 382 | open my $fh, ">", $out or croak "$out: $!\n"; 383 | print $fh @{$self->{yml}}; 384 | close $fh; 385 | $self->fix_meta ($out); 386 | } # print_yaml 387 | 388 | sub add_json { 389 | my $self = shift; 390 | # Convert to meta-spec version 2 391 | # licenses are lists now 392 | my $jsn = $self->{h}; 393 | $jsn->{"meta-spec"} = { 394 | version => "2", 395 | url => "https://metacpan.org/module/CPAN::Meta::Spec?#meta-spec", 396 | }; 397 | exists $jsn->{resources}{license} and 398 | $jsn->{resources}{license} = [ $jsn->{resources}{license} ]; 399 | delete $jsn->{distribution_type}; 400 | if (exists $jsn->{license}) { 401 | if (ref $jsn->{license} eq "ARRAY") { 402 | $jsn->{license}[0] =~ s/^perl$/perl_5/i; 403 | } 404 | else { 405 | $jsn->{license} =~ s/^perl$/perl_5/i; 406 | $jsn->{license} = [ $jsn->{license} ]; 407 | } 408 | } 409 | if (exists $jsn->{resources}{bugtracker}) { 410 | my $url = $jsn->{resources}{bugtracker}; 411 | $jsn->{resources}{bugtracker} = { 412 | web => $url, 413 | }; 414 | } 415 | if (exists $jsn->{resources}{repository}) { 416 | my $url = $jsn->{resources}{repository}; 417 | my $web = $url; 418 | $url =~ s{repo.or.cz/w/}{repo.or.cz/r/}; 419 | $web =~ s{repo.or.cz/r/}{repo.or.cz/w/}; 420 | $jsn->{resources}{repository} = { 421 | type => "git", 422 | web => $web, 423 | url => $url, 424 | }; 425 | } 426 | foreach my $sct ("", "configure_", "build_", "test_") { 427 | (my $x = $sct || "runtime") =~ s/_$//; 428 | for (qw( requires recommends suggests )) { 429 | exists $jsn->{"$sct$_"} and 430 | $jsn->{prereqs}{$x}{$_} = delete $jsn->{"$sct$_"}; 431 | } 432 | } 433 | 434 | # optional features do not yet know about requires and/or recommends diirectly 435 | if (my $of = $jsn->{optional_features}) { 436 | foreach my $f (keys %$of) { 437 | if (my $r = delete $of->{$f}{requires}) { 438 | #$jsn->{prereqs}{runtime}{recommends}{$_} //= $r->{$_} for keys %$r; 439 | $of->{$f}{prereqs}{runtime}{requires} = $r; 440 | } 441 | if (my $r = delete $of->{$f}{recommends}) { 442 | #$jsn->{prereqs}{runtime}{recommends}{$_} //= $r->{$_} for keys %$r; 443 | $of->{$f}{prereqs}{runtime}{recommends} = $r; 444 | } 445 | if (my $r = delete $of->{$f}{suggests}) { 446 | #$jsn->{prereqs}{runtime}{suggests}{$_} //= $r->{$_} for keys %$r; 447 | $of->{$f}{prereqs}{runtime}{suggests} = $r; 448 | } 449 | } 450 | } 451 | 452 | $jsn = CPAN::Meta::Converter->new ($jsn)->convert (version => "2"); 453 | $jsn->{generated_by} = "Author"; 454 | $self->{jsn} = $jsn; 455 | } # add_json 456 | 457 | sub fix_meta { 458 | my ($self, $yf) = @_; 459 | 460 | my $jsn = $self->add_json (); 461 | 462 | my $cmv = CPAN::Meta::Validator->new ($jsn); 463 | $cmv->is_valid or 464 | croak join "\n" => RED, "META Validator found fail:\n", $cmv->errors, RESET, ""; 465 | 466 | unless ($yf) { 467 | my @my = grep { -s } glob ("*/META.yml"), "META.yml" or croak "No META files"; 468 | $yf = $my[0]; 469 | } 470 | my $jf = $yf =~ s/yml$/json/r; 471 | open my $jh, ">", $jf or croak "Cannot update $jf: $!\n"; 472 | print $jh JSON::PP->new->utf8 (1)->pretty (1)->encode ($jsn); 473 | close $jh; 474 | 475 | # Now that 2.0 JSON is corrrect, create a 1.4 YAML back from the modified stuff 476 | my $yml = $jsn; 477 | # 1.4 does not know about test_*, move them to * 478 | if (my $tp = delete $yml->{prereqs}{test}) { 479 | foreach my $phase (keys %{$tp}) { 480 | my $p = $tp->{$phase}; 481 | #DDumper { $phase => $p }; 482 | $yml->{prereqs}{runtime}{$phase}{$_} //= $p->{$_} for keys %{$p}; 483 | } 484 | } 485 | 486 | # Optional features in 1.4 knows requires, but not recommends. 487 | # The Lancaster Consensus moves 2.0 optional recommends promote to 488 | # requires in 1.4 489 | if (my $of = $yml->{optional_features}) { 490 | foreach my $f (keys %$of) { 491 | if (my $r = delete $of->{$f}{prereqs}{runtime}{recommends}) { 492 | $of->{$f}{requires} = $r; 493 | } 494 | if (my $r = delete $of->{$f}{prereqs}{runtime}{suggests}) { 495 | $of->{$f}{suggests} = $r; 496 | } 497 | } 498 | } 499 | # runtime and test_requires are unknown as top-level in 1.4 500 | foreach my $phase (qw( xuntime test_requires )) { 501 | if (my $p = delete $yml->{$phase}) { 502 | foreach my $f (keys %$p) { 503 | $yml->{$f}{$_} ||= $p->{$f}{$_} for keys %{$p->{$f}}; 504 | } 505 | } 506 | } 507 | 508 | #DDumper $yml; 509 | # This does NOT create a correct YAML id the source does not comply! 510 | $yml = CPAN::Meta::Converter->new ($yml)->convert (version => "1.4"); 511 | $yml->{requires}{perl} //= $jsn->{prereqs}{runtime}{requires}{perl} 512 | // $self->{h}{requires}{perl} 513 | // ""; 514 | $yml->{build_requires} && !keys %{$yml->{build_requires}} and 515 | delete $yml->{build_requires}; 516 | #DDumper $yml; 517 | #exit; 518 | 519 | open my $my, ">", $yf or croak "Cannot update $yf: $!\n"; 520 | print $my Dump $yml; # @{$self->{yml}}; 521 | close $my; 522 | 523 | chmod 0644, glob "*/META.*"; 524 | unlink glob "MYMETA*"; 525 | } # fix_meta 526 | 527 | sub _cpfd { 528 | my ($self, $jsn, $sct, $f) = @_; 529 | 530 | open my $sh, ">", \my $b; 531 | my $sep = ""; 532 | for (qw( requires recommends suggests )) { 533 | my $x = "$sct$_"; 534 | my $s = $jsn->{$x} or next; 535 | print $sh $sep; 536 | foreach my $m (sort keys %$s) { 537 | $m eq "perl" and next; 538 | my $v = $s->{$m}; 539 | printf $sh qq{%-10s "%s"}, $_, $m; 540 | my $aw = (24 - length $m); $aw < 0 and $aw = 0; 541 | printf $sh qq{%s => "%s"}, " " x $aw, $v if $v; 542 | print $sh ";"; 543 | if (my $i = $self->{cve_ignore}{$x}{$m}) { 544 | print $sh " # ignore : $i"; 545 | } 546 | say $sh ""; 547 | } 548 | $sep = "\n"; 549 | } 550 | close $sh; 551 | $sct || $f and $b and $b .= "};"; 552 | return $b; 553 | } # _cpfd 554 | 555 | sub gen_cpanfile { 556 | my $self = shift; 557 | 558 | warn "Generating cpanfile ...\n"; 559 | open my $fh, ">", "cpanfile"; 560 | 561 | my $jsn = $self->{h}; 562 | foreach my $sct_ ("", "configure_", "build_", "test_", "runtime_") { 563 | 564 | my $sct = $sct_ =~ s/_$//r; 565 | 566 | my $b = _cpfd ($self, $jsn, $sct_, 0) or next; 567 | 568 | if ($sct) { 569 | say $fh qq/\non "$sct" => sub {/; 570 | say $fh $b =~ s/^(?=\S)/ /gmr; 571 | } 572 | else { 573 | print $fh $b; 574 | } 575 | } 576 | 577 | if (my $of = $jsn->{optional_features}) { 578 | foreach my $f (sort keys %$of) { 579 | my $fs = $of->{$f}; 580 | say $fh qq/\nfeature "$f", "$fs->{description}" => sub {/;#} 581 | say $fh _cpfd ($self, $fs, "", 1) =~ s/^(?=\S)/ /gmr; 582 | } 583 | } 584 | 585 | close $fh; 586 | 587 | warn "Check CVE's ...\n"; 588 | if (system "cpan-cve.pl", "-d", ".") { 589 | warn "### CVE WARNING\n"; 590 | warn "#\n"; 591 | warn "# The current release would have recommended versions\n"; 592 | warn "# with known CVE's that are not (yet) ignored\n"; 593 | sleep (5); 594 | } 595 | } # gen_cpanfile 596 | 597 | sub security_md { 598 | my ($self, $update) = @_; 599 | 600 | my $sfn = "SECURITY.md"; 601 | my $policy = Software::Security::Policy::Individual->new ({ 602 | maintainer => $self->{h}{author}[0], 603 | program => $self->{name}, 604 | timeframe => "10 days", 605 | url => $self->{h}{resources}{repository}, 606 | perl_support_years => 5, 607 | }); 608 | 609 | my $smd = $policy->fulltext; 610 | 611 | unless (-s $sfn) { 612 | open my $fh, ">:encoding(utf-8)", $sfn or die "$sfn: $! \n"; 613 | print $fh $smd; 614 | close $fh; 615 | 616 | if (open $fh, "<", "MANIFEST") { 617 | my @m = <$fh>; 618 | close $fh; 619 | unless (grep m/^$sfn(?:\s|$)/ => @m) { 620 | open $fh, ">>", "MANIFEST" or die "MANIFEST: $!\n"; 621 | say $fh "$sfn\t\tGuide for reporting security issues"; 622 | close $fh; 623 | } 624 | } 625 | say "$sfn added"; 626 | } 627 | 628 | open my $fh, "<:encoding(utf-8)", $sfn or die "$sfn: $!\n"; 629 | my $old = do { local $/; <$fh> }; 630 | close $fh; 631 | 632 | $old eq $smd and return; 633 | 634 | if ($update) { 635 | open my $fh, ">:encoding(utf-8)", $sfn or die "$sfn: $!\n"; 636 | print $fh $smd; 637 | close $fh; 638 | say "$sfn updated"; 639 | } 640 | else { 641 | say "$sfn required updates:"; 642 | say diff \$old, \$smd; 643 | say "to apply, use $0 --check --update"; 644 | } 645 | } # gen_security 646 | 647 | 1; 648 | -------------------------------------------------------------------------------- /geoip: -------------------------------------------------------------------------------- 1 | #!/pro/bin/perl 2 | 3 | use 5.014000; 4 | use warnings; 5 | 6 | our $VERSION = "0.19 - 20250113"; 7 | our $CMD = $0 =~ s{.*/}{}r; 8 | 9 | sub usage { 10 | my $err = shift and select STDERR; 11 | say "usage: $CMD [--fetch] [--no-update] [--dist] [--whois] [ip|host ...]"; 12 | say " -f --fetch Fetch new ZIP sources"; 13 | say " --no-update Do not update the database on new data"; 14 | say " -s --short Skip location and flags"; 15 | say " -d --dist Show distance in KM between here and there"; 16 | say " will only work if LWP::UserAgent and"; 17 | say " HTML::TreeBuilder are installed"; 18 | say " -w --whois Show whois information"; 19 | say " will only work if Net::Whois::IP is installed"; 20 | say " -j --json Output information in JSON"; 21 | say " -J --json-pretty Output information in JSON"; 22 | say " -lL --local=L Specify local location LAT/LON"; 23 | say " -D --DB=dsn Specify geoip database DSN default: dbi:Pg:geoip"; 24 | say " may be specified in \$GEOIP_DBI_DSN"; 25 | say " --country=c Find CIDR's for country c"; 26 | say "$CMD --man will show the full manual"; 27 | say "\$GEOIP_HOST will be used if no IP or host is given"; 28 | exit $err; 29 | } # usage 30 | 31 | # Required modules 32 | use DBI; 33 | use Socket; 34 | use Net::CIDR; 35 | use Data::Dumper; 36 | use Math::Trig; 37 | use LWP::Simple; 38 | use Archive::Zip; 39 | use JSON::PP; 40 | use Text::CSV_XS qw( csv ); 41 | use List::Util qw( first sum ); 42 | use Getopt::Long qw(:config bundling); 43 | 44 | # Optional modules 45 | my $gis = eval { 46 | require GIS::Distance; 47 | GIS::Distance->new; 48 | }; 49 | my $use_data_peek = eval { 50 | require Data::Peek; 51 | 1; 52 | }; 53 | my $whois = eval { 54 | require Net::Whois::IP; 55 | \&Net::Whois::IP::whoisip_query; 56 | }; 57 | 58 | my %conf = ( 59 | update => 1, 60 | distance => 0, 61 | whois => 0, 62 | short => 0, 63 | json => 0, 64 | json_pretty => 0, 65 | local_location => undef, 66 | dsn => $ENV{GEOIP_DBI_DSN} || "dbi:Pg:dbname=geoip", 67 | ); 68 | getconf (); 69 | 70 | GetOptions ( 71 | "help|?" => sub { usage (0); }, 72 | "V|version" => sub { say "$CMD [$VERSION]"; exit 0; }, 73 | "man" => sub { pod_nroff (); }, 74 | "info" => sub { pod_text (); }, 75 | 76 | "u|update!" => \$conf{update}, 77 | "f|fetch!" => \$conf{fetch}, 78 | "d|dist|distance!" => \$conf{distance}, 79 | "w|whois!" => \$conf{whois}, 80 | "s|short!" => \$conf{short}, 81 | "j|json!" => \$conf{json}, 82 | "J|json-pretty!" => \ my $opt_J, 83 | "l|local=s" => \$conf{local_location}, 84 | 85 | "D|DB=s" => \$conf{dsn}, 86 | 87 | # Queries 88 | "country=s" => \ my $query_c, 89 | 90 | "v|verbose:1" => \(my $opt_v = 0), 91 | ) or usage (1); 92 | 93 | sub pod_text { 94 | require Pod::Text::Color; 95 | my $m = $ENV{NO_COLOR} ? "Pod::Text" : "Pod::Text::Color"; 96 | my $p = $m->new (); 97 | open my $fh, ">", \my $out; 98 | $p->parse_from_file ($0, $fh); 99 | close $fh; 100 | print $out; 101 | exit 0; 102 | } # pod_text 103 | 104 | sub pod_nroff { 105 | first { -x "$_/nroff" } grep { -d } split m/:+/ => $ENV{PATH} or pod_text (); 106 | 107 | require Pod::Man; 108 | my $p = Pod::Man->new (); 109 | open my $fh, "|-", "nroff", "-man"; 110 | $p->parse_from_file ($0, $fh); 111 | close $fh; 112 | exit 0; 113 | } # pod_nroff 114 | 115 | $opt_v >= 7 and _dump ("Configuration", \%conf); 116 | 117 | if (defined $opt_J) { 118 | if ($opt_J) { 119 | $conf{json_pretty}++; 120 | $conf{json}++; 121 | } 122 | else { 123 | $conf{json_pretty} = 0; 124 | } 125 | } 126 | $conf{json} and $opt_J = $conf{json_pretty}; 127 | 128 | if (@ARGV == 0 and my $eh = $ENV{GEOIP_HOST}) { 129 | $eh =~ s{[\s\r\n]+\z}{}; 130 | # No IPv6 support yet 131 | if ($eh =~ m{^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$} and 132 | $1 > 0 && $1 < 256 && $2 < 256 && $3 < 256 && $4 < 256) { 133 | # Simplistic IPv4 134 | push @ARGV => $eh; 135 | } 136 | elsif ($eh =~ m/^\w[-.\w]{0,252}\z/) { # Skip invalid clipboard content 137 | # https://en.wikipedia.org/wiki/Hostname#Syntax 138 | for (split m/\./ => $eh) { 139 | m/^\w[-\w]{0,62}$/ or die "$eh is not a valid hostname or IPv4\n"; 140 | } 141 | push @ARGV => $eh; 142 | } 143 | } 144 | 145 | my $dbh = do { 146 | my $dsn = $conf{dsn} =~ s{^b=(?=\w+:)}{}ir; # catch -DB=.. instead of --DB= 147 | my $help = $dsn =~ m/^dbi:(\w+):/i 148 | ? "Did you forget to install DBD::$1?" 149 | : "Maybe the matching DBD for $dsn is not installed"; 150 | eval { 151 | my %seen; 152 | my $fail = sub { 153 | my $e = DBI->errstr or return; 154 | !$seen{$e}++ and warn "$e\n"; 155 | }; 156 | local $SIG{__WARN__} = $fail; 157 | local $SIG{__DIE__} = $fail; 158 | DBI->connect ($conf{dsn}, undef, undef, { 159 | AutoCommit => 0, 160 | RaiseError => 1, 161 | PrintError => 1, 162 | ShowErrorStatement => 1, 163 | }); 164 | } or die "Cannot continue without a working database\n$help\n"; 165 | }; 166 | 167 | sub _dump { 168 | my ($label, $ref) = @_; 169 | print STDERR $use_data_peek 170 | ? Data::Peek::DDumper ({ $label => $ref }) 171 | : Data::Dumper->Dump ([$ref], [$label]); 172 | } # _dump 173 | 174 | # Based on GeoIP2 CSV databases 175 | # City: http://geolite.maxmind.com/download/geoip/database/GeoLite2-City-CSV.zip 176 | # Country http://geolite.maxmind.com/download/geoip/database/GeoLite2-Country-CSV.zip 177 | # ASN http://geolite.maxmind.com/download/geoip/database/GeoLite2-ASN-CSV.zip 178 | 179 | my $idx_type = $conf{dsn} =~ m/:Pg/ ? "using btree" : ""; 180 | my $truncate = $conf{dsn} =~ m/:SQLite/ ? "delete from" : "truncate table"; 181 | 182 | unless (grep m/\b country \b/ix => $dbh->tables (undef, undef, undef, undef)) { 183 | say "Create table stamps"; 184 | $dbh->do (qq; create table stamps ( 185 | name text not null primary key, 186 | stamp bigint); 187 | ); 188 | say "Create table continent"; 189 | $dbh->do (qq; create table continent ( 190 | id char (4) not null primary key, 191 | name text); 192 | ); 193 | say "Create table country"; 194 | $dbh->do (qq; create table country ( 195 | id bigint not null primary key, 196 | name text not null, 197 | iso text, 198 | continent char (4), 199 | eu smallint); 200 | ); 201 | say "Create table ipv4"; # Country based 202 | $dbh->do (qq; create table ipv4 ( 203 | cidr cidr not null primary key, 204 | id bigint, 205 | ip_from text not null, 206 | ip_to text not null, 207 | ip_from_n bigint not null, 208 | ip_to_n bigint not null, 209 | reg_country_id bigint, 210 | rep_country_id bigint, 211 | anon_proxy smallint, 212 | satellite smallint); 213 | ); 214 | $dbh->do (qq; create index i_ipv4_ip on ipv4 $idx_type (ip_from_n, ip_to_n);); 215 | say "Create table provider"; 216 | $dbh->do (qq; create table provider ( 217 | cidr cidr not null primary key, 218 | id bigint, 219 | name text, 220 | ip_from text, 221 | ip_to text, 222 | ip_from_n bigint, 223 | ip_to_n bigint); 224 | ); 225 | $dbh->do (qq; create index i_provider_ip on provider $idx_type (ip_from_n, ip_to_n);); 226 | say "Create table city"; 227 | $dbh->do (qq; create table city ( 228 | id bigint not null primary key, 229 | name text, 230 | country_id bigint, 231 | metro_code text, 232 | tz text, 233 | eu smallint); 234 | ); 235 | say "Create table ipc4"; # City based 236 | $dbh->do (qq; create table ipc4 ( 237 | cidr cidr not null primary key, 238 | id bigint, 239 | ip_from text not null, 240 | ip_to text not null, 241 | ip_from_n bigint not null, 242 | ip_to_n bigint not null, 243 | reg_country_id bigint, 244 | rep_country_id bigint, 245 | anon_proxy smallint, 246 | satellite smallint, 247 | postal_code text, 248 | latitude text, 249 | longitude text, 250 | accuracy text ); 251 | ); 252 | $dbh->do (qq; create index i_ipc4_ip on ipv4 $idx_type (ip_from_n, ip_to_n);); 253 | $dbh->commit; 254 | 255 | # grant connect on database geoip to other_user; 256 | # grant select on all tables in schema public to other_user; 257 | } 258 | 259 | my %cont; # Continents 260 | 261 | my %stmp; 262 | { my $sth = $dbh->prepare ("select name, stamp from stamps"); 263 | $sth->execute; 264 | while (my @s = $sth->fetchrow_array) { 265 | $stmp{$s[0]} = $s[1]; 266 | } 267 | } 268 | 269 | sub dtsz { 270 | my $f = shift; 271 | -f $f or return "-"; 272 | my @s = stat $f; 273 | my @d = localtime $s[9]; 274 | sprintf "%4d-%02d-%02d %02d:%02d:%02d %9d", 275 | $d[5] + 1900, ++$d[4], @d[3,2,1,0], $s[7]; 276 | } # dtsz 277 | 278 | if ($conf{fetch}) { 279 | my $key = $conf{license_key} or die "No license key in config file\n"; 280 | my $base = "https://download.maxmind.com/app/geoip_download?edition_id="; 281 | foreach my $db (qw( GeoLite2-ASN-CSV 282 | GeoLite2-Country-CSV 283 | GeoLite2-City-CSV 284 | )) { 285 | my $f = "$db.zip"; 286 | printf STDERR "%34s %s\n", dtsz ($f), $f; 287 | my $url = join "&" => "$base$db", "license_key=$key", "suffix=zip"; 288 | $opt_v > 5 and warn "Fetching $url ...\n"; 289 | my $c = mirror ($url, $f); 290 | printf STDERR "%4d %29s %s\n", $c, dtsz ($f), $f; 291 | } 292 | } 293 | 294 | my $zcfn = "GeoLite2-Country-CSV.zip"; 295 | if ($conf{update} && -s $zcfn and ($stmp{$zcfn} // -1) < (stat $zcfn)[9]) { 296 | my $zip = Archive::Zip->new; 297 | $zip->read ($zcfn) and die "Cannot unzip $zcfn\n"; 298 | my @cmn = $zip->memberNames or die "$zcfn hasd no members\n"; 299 | 300 | say "Reading Country info ..."; 301 | my %ctry; 302 | $dbh->do ("$truncate continent"); 303 | foreach my $cnm (grep m{\bGeoLite2-Country-Locations-en.csv$}i => @cmn) { 304 | my $m = $zip->memberNamed ($cnm) or next; 305 | my $c = $m->contents or next; 306 | # geoname_id,locale_code,continent_code,continent_name,country_iso_code,country_name,is_in_european_union 307 | # 49518,en,AF,Africa,RW,Rwanda,0 308 | csv (in => \$c, headers => "auto", out => undef, on_in => sub { 309 | $cont{$_{continent_code}} ||= $_{continent_name}; 310 | my $id = $_{geoname_id} or return; 311 | my $ctry = { 312 | id => $id, 313 | name => $_{country_name}, 314 | iso => $_{country_iso_code}, 315 | continent => $_{continent_code}, 316 | eu => $_{is_in_european_union}, 317 | }; 318 | $ctry{$id} //= $ctry; 319 | #$ctry{$_{country_iso_code}} //= $ctry; 320 | }); 321 | } 322 | { $dbh->do ("$truncate continent"); 323 | $dbh->commit; 324 | my $sti = $dbh->prepare ("insert into continent values (?, ?)"); 325 | $sti->execute ($_, $cont{$_}) for keys %cont; 326 | $sti->finish; 327 | $dbh->commit; 328 | } 329 | { $dbh->do ("$truncate country"); 330 | $dbh->commit; 331 | my $sti = $dbh->prepare ("insert into country values (?, ?, ?, ?, ?)"); 332 | $sti->execute (@{$_}{qw( id name iso continent eu )}) for values %ctry; 333 | $sti->finish; 334 | $dbh->commit; 335 | } 336 | 337 | say "Reading Country IPv4 info ..."; 338 | foreach my $cnm (grep m{\bGeoLite2-Country-Blocks-IPv4.csv$}i => @cmn) { 339 | my $m = $zip->memberNamed ($cnm) or next; 340 | my $c = $m->contents or next; 341 | # network,geoname_id,registered_country_geoname_id,represented_country_geoname_id,is_anonymous_proxy,is_satellite_provider 342 | # 1.0.0.0/24,2077456,2077456,,0,0 343 | $dbh->do ("$truncate ipv4"); 344 | $dbh->commit; 345 | my $n; 346 | my $sti = $dbh->prepare ("insert into ipv4 values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"); 347 | csv (in => \$c, headers => "auto", out => undef, on_in => sub { 348 | ++$n % 1000 or print STDERR " $n\r"; 349 | my $cidr = $_{network}; 350 | my @rng = Net::CIDR::cidr2range ($cidr); 351 | my ($f, $t) = split m/\s*-\s*/ => $rng[0]; 352 | my ($F, $T) = map { unpack "L>", inet_aton $_ } $f, $t; 353 | my $rec = { 354 | cidr => $cidr, 355 | id => $_{geoname_id} || undef, 356 | ip_from => $f, 357 | ip_to => $t, 358 | ip_from_n => $F, 359 | ip_to_n => $T, 360 | reg_country_id => $_{registered_country_geoname_id} || undef, 361 | rep_country_id => $_{represented_country_geoname_id} || undef, 362 | anon_proxy => $_{is_anonymous_proxy}, 363 | satellite => $_{is_satellite_provider}, 364 | }; 365 | $sti->execute (@{$rec}{qw( cidr id ip_from ip_to ip_from_n ip_to_n 366 | reg_country_id rep_country_id anon_proxy satellite )}); 367 | }); 368 | $sti->finish; 369 | $dbh->commit; 370 | } 371 | my $t = (stat $zcfn)[9]; 372 | if ($stmp{$zcfn}) { 373 | $dbh->do ("update stamps set stamp = $t where name = '$zcfn'"); 374 | } 375 | else { 376 | $dbh->do ("insert into stamps values ('$zcfn', $t)"); 377 | } 378 | $dbh->commit; 379 | } 380 | else { 381 | my $sth = $dbh->prepare ("select * from continent"); 382 | $sth->execute; 383 | while (my $r = $sth->fetch) { 384 | $cont{$r->[0]} = $r->[1]; 385 | } 386 | } 387 | 388 | $zcfn = "GeoLite2-ASN-CSV.zip"; 389 | if ($conf{update} && -s $zcfn and ($stmp{$zcfn} // -1) < (stat $zcfn)[9]) { 390 | my $zip = Archive::Zip->new; 391 | $zip->read ($zcfn) and die "Cannot unzip $zcfn\n"; 392 | my @cmn = $zip->memberNames or die "$zcfn hasd no members\n"; 393 | 394 | say "Reading Provider IPv4 info ..."; 395 | foreach my $cnm (grep m{\bGeoLite2-ASN-Blocks-IPv4.csv$}i => @cmn) { 396 | my $m = $zip->memberNamed ($cnm) or next; 397 | my $c = $m->contents or next; 398 | # network,autonomous_system_number,autonomous_system_organization 399 | # 1.0.0.0/24,13335,"Cloudflare, Inc." 400 | $dbh->do ("$truncate provider"); 401 | $dbh->commit; 402 | my $n; 403 | my $sti = $dbh->prepare ("insert into provider values (?, ?, ?, ?, ?, ?, ?)"); 404 | csv (in => \$c, headers => "auto", out => undef, on_in => sub { 405 | ++$n % 1000 or print STDERR " $n\r"; 406 | my $cidr = $_{network}; 407 | my @rng = Net::CIDR::cidr2range ($cidr); 408 | my ($f, $t) = split m/\s*-\s*/ => $rng[0]; 409 | my ($F, $T) = map { unpack "L>", inet_aton $_ } $f, $t; 410 | my $rec = { 411 | cidr => $cidr, 412 | id => $_{autonomous_system_number} || undef, # All NULL 413 | name => $_{autonomous_system_organization}, 414 | ip_from => $f, 415 | ip_to => $t, 416 | ip_from_n => $F, 417 | ip_to_n => $T, 418 | }; 419 | $sti->execute (@{$rec}{qw( cidr id name ip_from ip_to ip_from_n ip_to_n )}); 420 | }); 421 | $sti->finish; 422 | $dbh->commit; 423 | } 424 | my $t = (stat $zcfn)[9]; 425 | if ($stmp{$zcfn}) { 426 | $dbh->do ("update stamps set stamp = $t where name = '$zcfn'"); 427 | } 428 | else { 429 | $dbh->do ("insert into stamps values ('$zcfn', $t)"); 430 | } 431 | $dbh->commit; 432 | } 433 | 434 | $zcfn = "GeoLite2-City-CSV.zip"; 435 | if ($conf{update} && -s $zcfn and ($stmp{$zcfn} // -1) < (stat $zcfn)[9]) { 436 | my $zip = Archive::Zip->new; 437 | $zip->read ($zcfn) and die "Cannot unzip $zcfn\n"; 438 | my @cmn = $zip->memberNames or die "$zcfn hasd no members\n"; 439 | 440 | say "Reading City info ..."; 441 | my (%country, %city); 442 | { my $sth = $dbh->prepare ("select id, name from country"); 443 | $sth->execute; 444 | while (my $r = $sth->fetch) { $country{$r->[1]} = $r->[0] } 445 | } 446 | foreach my $cnm (grep m{\bGeoLite2-City-Locations-en.csv$}i => @cmn) { 447 | my $m = $zip->memberNamed ($cnm) or next; 448 | my $c = $m->contents or next; 449 | # geoname_id,locale_code,continent_code,continent_name,country_iso_code, 450 | # country_name,subdivision_1_iso_code,subdivision_1_name, 451 | # subdivision_2_iso_code,subdivision_2_name,city_name,metro_code, 452 | # time_zone,is_in_european_union 453 | # 5819,en,EU,Europe,CY,Cyprus,02,Limassol,,,Souni,,Asia/Nicosia,1 454 | $dbh->do ("$truncate city"); 455 | $dbh->commit; 456 | my $n; 457 | my $sti = $dbh->prepare ("insert into city values (?, ?, ?, ?, ?, ?)"); 458 | csv (in => \$c, headers => "auto", out => undef, on_in => sub { 459 | ++$n % 1000 or print STDERR " $n\r"; 460 | my $rec = { 461 | id => $_{geoname_id}, 462 | name => $_{city_name}, 463 | country_id => $country{$_{country_name}}, 464 | metro_code => $_{metro_code}, 465 | tz => $_{time_zone}, 466 | eu => $_{is_in_european_union}, 467 | }; 468 | # Subdivisions to store? 469 | $sti->execute (@{$rec}{qw( id name country_id metro_code tz eu )}); 470 | }); 471 | $sti->finish; 472 | $dbh->commit; 473 | } 474 | say "Reading City IPv4 info ..."; 475 | foreach my $cnm (grep m{\bGeoLite2-City-Blocks-IPv4.csv$}i => @cmn) { 476 | my $m = $zip->memberNamed ($cnm) or next; 477 | my $c = $m->contents or next; 478 | # network,geoname_id,registered_country_geoname_id, 479 | # represented_country_geoname_id,is_anonymous_proxy, 480 | # is_satellite_provider,postal_code,latitude,longitude,accuracy_radius 481 | # 1.0.0.0/24,2062391,2077456,,0,0,5412,-34.1551,138.7482,1000 482 | $dbh->do ("$truncate ipc4"); 483 | $dbh->commit; 484 | my $n; 485 | my $sti = $dbh->prepare ("insert into ipc4 values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"); 486 | csv (in => \$c, headers => "auto", out => undef, on_in => sub { 487 | ++$n % 1000 or print STDERR " $n\r"; 488 | my $cidr = $_{network}; 489 | my @rng = Net::CIDR::cidr2range ($cidr); 490 | my ($f, $t) = split m/\s*-\s*/ => $rng[0]; 491 | my ($F, $T) = map { unpack "L>", inet_aton $_ } $f, $t; 492 | my $rec = { 493 | cidr => $cidr, 494 | id => $_{geoname_id} || undef, 495 | ip_from => $f, 496 | ip_to => $t, 497 | ip_from_n => $F, 498 | ip_to_n => $T, 499 | reg_country_id => $_{registered_country_geoname_id} || undef, 500 | rep_country_id => $_{represented_country_geoname_id} || undef, 501 | anon_proxy => $_{is_anonymous_proxy}, 502 | satellite => $_{is_satellite_provider}, 503 | postal_code => $_{postal_code}, 504 | latitude => $_{latitude}, 505 | longitude => $_{longitude}, 506 | accuracy => $_{accuracy_radius}, 507 | }; 508 | $sti->execute (@{$rec}{qw( cidr id ip_from ip_to ip_from_n ip_to_n 509 | reg_country_id rep_country_id anon_proxy satellite postal_code 510 | latitude longitude accuracy )}); 511 | }); 512 | $sti->finish; 513 | $dbh->commit; 514 | } 515 | my $t = (stat $zcfn)[9]; 516 | if ($stmp{$zcfn}) { 517 | $dbh->do ("update stamps set stamp = $t where name = '$zcfn'"); 518 | } 519 | else { 520 | $dbh->do ("insert into stamps values ('$zcfn', $t)"); 521 | } 522 | $dbh->commit; 523 | } 524 | 525 | binmode STDERR, ":encoding(utf-8)"; 526 | binmode STDOUT, ":encoding(utf-8)"; 527 | 528 | if ($query_c) { 529 | @ARGV = (); 530 | my %ctry; 531 | my $sth = $dbh->prepare ("select id, name, continent from country"); 532 | $sth->execute; 533 | $sth->bind_columns (\my ($id, $name, $cont)); 534 | while ($sth->fetch) { 535 | $name =~ m/^ $query_c $/ix and $ctry{full}{$id} = [ $name, $cont, 0, 0 ]; 536 | $name =~ m/ $query_c /ix and $ctry{part}{$id} = [ $name, $cont, 0, 0 ]; 537 | } 538 | $sth->finish; 539 | if (keys %{$ctry{full}}) { 540 | %ctry = %{$ctry{full}}; 541 | } 542 | elsif (keys %{$ctry{part}}) { 543 | %ctry = %{$ctry{part}}; 544 | } 545 | else { 546 | $dbh->rollback; 547 | die "No matching country found for $query_c\n"; 548 | } 549 | 550 | $sth = $dbh->prepare (join " " => 551 | "select cidr, reg_country_id, ip_from_n, ip_to_n", 552 | "from ipv4", 553 | "order by reg_country_id, cidr"); 554 | $sth->execute; 555 | $sth->bind_columns (\my $cidr, \$id, \my $from, \my $to); 556 | while ($sth->fetch) { 557 | defined $id or next; 558 | my $c = $ctry{$id} or next; 559 | say $cidr; 560 | $c->[2]++; 561 | $c->[3] += $to - $from + 1; 562 | } 563 | $sth->finish; 564 | $dbh->rollback; 565 | 566 | if ($opt_v) { 567 | my @w = (6, 10, 40, 15); 568 | printf STDERR "%s\n%$w[0]s %$w[1]s %-$w[2]s %s\n%s %s %s %s\n", 569 | "Selected CIDR's", "# CIDR", "# IP", "Country", "Continent", 570 | map { "-" x $_ } @w; 571 | printf STDERR "%$w[0]d %$w[1]d %-$w[2].$w[2]s %s\n", 572 | @{$_}[2, 3, 0], $cont{$_->[1]} for 573 | sort { $a->[0] cmp $b->[0] } values %ctry; 574 | } 575 | 576 | exit 0; 577 | } 578 | 579 | my %seen; 580 | my %found; 581 | while (@ARGV) { 582 | my $ip = shift or next; 583 | 584 | my $host; 585 | if ($ip =~ m/^\d{1,3}(?:\.\d{1,3}){3}$/ and my $n = inet_aton ($ip)) { 586 | $seen{$ip}++; 587 | # We might not have DNS when working off-line 588 | $host = gethostbyaddr ($n, AF_INET) and $seen{$host}++; 589 | } 590 | else { 591 | my ($name, $aliases, $type, $len, @addr) = gethostbyname ($ip); 592 | unless (@addr) { 593 | warn "Cannot get the IP for $ip\n"; 594 | next; 595 | } 596 | $host = $name; 597 | $ip = inet_ntoa (shift @addr); 598 | $seen{$ip}++; 599 | $seen{$host}++; 600 | push @ARGV, grep { $_ && !$seen{$_}++ } 601 | (map { inet_ntoa $_ } @addr), 602 | split m/\s+/ => $aliases; 603 | } 604 | 605 | $found{$ip} and next; 606 | 607 | my $in = unpack "L>" => inet_aton ($ip); 608 | #say "Look up $ip ($in) ..."; 609 | 610 | my $sth = $dbh->prepare ("select * from ipv4 where ip_from_n <= $in and ip_to_n >= $in"); 611 | my $stc = $dbh->prepare ("select * from country where id = ?"); 612 | my $stC = $dbh->prepare ("select * from city where id = ?"); 613 | my $prov = do { 614 | my $stp = $dbh->prepare ("select name from provider where ip_from_n <= $in and ip_to_n >= $in"); 615 | $stp->execute; 616 | my @p; while (my $p = $stp->fetch) { push @p, $p->[0]; } 617 | join " \x{2227} " => @p; 618 | }; 619 | my $st4 = $dbh->prepare ("select * from ipc4 where ip_from_n <= $in and ip_to_n >= $in"); 620 | $sth->execute; 621 | while (my $i = $sth->fetchrow_hashref) { 622 | $i->{provider} = $prov; 623 | $i->{ip} = $ip; 624 | $i->{ip_n} = $in; 625 | $i->{hostname} = $host // "(hostname not found)"; 626 | foreach my $tp ("reg", "rep") { 627 | if (my $cid = delete $i->{"${tp}_country_id"}) { 628 | $stc->execute ($cid); 629 | my $c = $stc->fetchrow_hashref or next; 630 | $i->{"${tp}_ctry_$_"} = $c->{$_} for keys %$c; 631 | delete $i->{"${tp}_ctry_id"}; 632 | } 633 | else { 634 | $i->{"${tp}_ctry_$_"} = "" for qw( iso name continent ); 635 | } 636 | $i->{"${tp}_continent"} = $cont{delete $i->{"${tp}_ctry_continent"}} || ""; 637 | } 638 | $st4->execute; 639 | if (my $c = $st4->fetchrow_hashref) { 640 | $stc->execute (delete $c->{reg_country_id}); 641 | if (my $ctry = $stc->fetchrow_hashref) { 642 | $c->{country} = $ctry->{name}; 643 | } 644 | $i->{$_} = $c->{$_} for qw( postal_code latitude longitude accuracy ); 645 | $stC->execute (delete $c->{id}); 646 | if (my $city = $stC->fetchrow_hashref) { 647 | $i->{"city_$_"} = $city->{$_} for qw( name tz metro_code ); 648 | } 649 | $stC->finish; 650 | } 651 | $st4->finish; 652 | $found{$ip} //= $i; 653 | } 654 | $stc->finish; 655 | } 656 | 657 | my $here; 658 | if (($conf{local_location} // "") =~ m{^(-?\d+\.\d+)\s*[,/]\s*(-?\d+\.\d+)\s*$}) { 659 | $here = { Latitude => $1, Longitude => $2 }; 660 | } 661 | elsif ($conf{distance} and eval { require LWP::UserAgent; require HTML::TreeBuilder; }) { 662 | my $ua = LWP::UserAgent->new ( 663 | max_redirect => 2, 664 | agent => "geoip/$VERSION", 665 | parse_head => 0, 666 | timeout => 10, 667 | cookie_jar => {}, 668 | ); 669 | $ua->env_proxy; 670 | warn "Using GeoIP to determine own location\n"; 671 | $here = {}; 672 | my %cls = ( 673 | lat => "Latitude", 674 | lng => "Longitude", 675 | ip => "IP", 676 | city => "City", 677 | company => "Provider", 678 | ); 679 | foreach my $url (qw( https://iplocation.com https://geoiptool.com )) { 680 | my $rsp = $ua->request (HTTP::Request->new (GET => $url)); 681 | if ($rsp->is_success) { 682 | $opt_v > 1 and warn "$url: OK\n"; 683 | my $tree = HTML::TreeBuilder->new (); 684 | if ($tree->parse_content ($rsp->content)) { 685 | foreach my $e ($tree->look_down (_tag => "div", class => "data-item")) { 686 | my $di = $e->as_text or next; 687 | $di =~ m/^\s*(\S[^:]+?)\s*:\s*(.*?)\s*$/ and $here->{$1} //= $2; 688 | } 689 | foreach my $e ($tree->look_down (_tag => "td", 690 | class => qr{^(?:lat|lng|ip|city|company)$})) { 691 | my $di = $e->as_text =~ s/^\s+//r =~ s/\s+$//r or next; 692 | my $cl = $cls{$e->attr ("class")} or next; 693 | $here->{$cl} //= $di; 694 | } 695 | } 696 | } 697 | elsif ($opt_v) { 698 | printf STDERR "%-25s : %s\n", $url, $rsp->status_line; 699 | } 700 | defined $here->{Longitude} and last; 701 | } 702 | unless (exists $here->{Longitude}) { 703 | # If I did not get info, use the database: 704 | # 1: dig -4 a +short myip.opendns.com @resolver1.opendns.com 705 | # 2: https://tools.tracemyip.org - only returns IP, no coordinates 706 | #
1.2.3.4
707 | } 708 | defined $here->{Longitude} or $here = undef; 709 | $opt_v > 4 and _dump ("Here", $here); 710 | } 711 | 712 | my @json; 713 | for (sort { $a->{ip_from_n} <=> $b->{ip_to_n} || 714 | $a->{ip_n} <=> $b->{ip_n} 715 | } values %found) { 716 | $opt_v > 6 and _dump ("Processing", $_); 717 | my ($lat, $lon, $acc) = ($_->{latitude}, $_->{longitude}, $_->{accuracy}); 718 | $_->{city} = join ", " => grep m/\S/ => map { $_ || "" } 719 | $_->{city_name}, $_->{city_metro_code}, $_->{postal_code}; 720 | $_->{city_tz} ||= ""; 721 | my %json = %$_; 722 | 723 | unless ($conf{json}) { 724 | say "GeoIP data for $_->{ip} - $_->{hostname}:"; 725 | say " CIDR : $_->{cidr}"; 726 | say " IP range : $_->{ip_from} - $_->{ip_to}"; 727 | say " Provider : $_->{provider}"; 728 | say " City : $_->{city}"; 729 | say " Country : $_->{reg_ctry_iso} $_->{reg_ctry_name}"; 730 | say " Continent : $_->{reg_continent}"; 731 | say " Timezone : $_->{city_tz}"; 732 | } 733 | 734 | if (!$conf{short} && ($lat || $lon)) { 735 | my ($lat_dms, $lon_dms) = map { dec2dms ($_) } $lat, $lon; 736 | @json{qw( latitude_dms longitude_dms )} = ($lat_dms, $lon_dms); 737 | $conf{json} or printf " Location : %9.4f / %9.4f %-6s %14s / %14s\n", 738 | $lat, $lon, "($acc)", $lat_dms, $lon_dms; 739 | # OSM max zoom = 19, Google Maps max zoom = 21 740 | my $z = 16 - int log $acc; 741 | my @map = ( 742 | "https://www.openstreetmap.org/#map=$z/$lat/$lon", 743 | "https://www.google.com/maps/place/\@$lat,$lon,${z}z", 744 | ); 745 | $json{map_urls} = \@map; 746 | $conf{json} or say " $_" for @map; 747 | 748 | if ($here) { 749 | my ($llat, $llon) = ($here->{Latitude}, $here->{Longitude}); 750 | my ($llat_dms, $llon_dms) = map { dec2dms ($_) } $llat, $llon; 751 | my ($dist, $unit) = (distance ($lat, $lon, $llat, $llon), "km"); 752 | ($conf{distance} || "km") eq "miles" and 753 | ($dist, $unit) = ($dist * 0.62137119, "mile"); 754 | @json{qw( local_latitude local_longitude 755 | local_latidue_dms local_longitude_dms 756 | distance distance_unit )} = 757 | ($llat, $llon, $llat_dms, $llon_dms, $dist, $unit); 758 | $conf{json} or printf " Location : %9.4f / %9.4f %-6s %14s / %14s\n", 759 | $llat, $llon, "", $llat_dms, $llon_dms; 760 | $conf{json} or printf " Distance : \x{00b1} %.2f%s\n", $dist, $unit; 761 | } 762 | } 763 | if ($conf{whois} && $whois and my $wi = $whois->($_->{ip})) { 764 | my $address = join " " => grep { length } map { $wi->{$_} } qw( 765 | Address PostalCode StateProv Country address ); 766 | my %w = ( 767 | ID => $wi->{OrgId} || $wi->{"admin-c"}, 768 | Name => $wi->{OrgNOCName} || $wi->{OrgName} || $wi->{descr}, 769 | Phone => $wi->{OrgNOCPhone} || $wi->{OrgTechPhone} || $wi->{phone}, 770 | EMail => $wi->{OrgTechEmail} || $wi->{OrgNOCEmail} || $wi->{"e-mail"}, 771 | Abuse => $wi->{OrgAbuseEmail} || $wi->{"abuse-mailbox"}, 772 | Address => $address, 773 | ); 774 | 775 | $opt_v > 8 and _dump ("WhoIs", { wi => $wi, w => \%w }); 776 | my @wi = map { sprintf " %-7s : %s", $_, $w{$_} } 777 | grep { length $w{$_} } qw( Name ID Phone EMail Abuse Address ); 778 | $json{whois} = \%w; 779 | !$conf{json} && @wi and say for " Whois information:", @wi; 780 | } 781 | if ($conf{json}) { 782 | push @json, \%json; 783 | } 784 | elsif (!$conf{short}) { 785 | say " EU member : ", $_->{reg_ctry_eu} ? "Yes" : "No"; 786 | say " Satellite : ", $_->{satellite} ? "Yes" : "No"; 787 | say " Anon Proxy: ", $_->{anon_proxy} ? "Yes" : "No"; 788 | } 789 | } 790 | 791 | $dbh->rollback; 792 | $dbh->disconnect; 793 | 794 | if ($conf{json}) { 795 | say $opt_J 796 | ? JSON::PP->new->pretty->allow_nonref->encode (\@json) 797 | : JSON::PP->new->ascii ->allow_nonref->encode (\@json); 798 | } 799 | 800 | sub dec2dms { 801 | my $dec = shift or return ""; 802 | 803 | my $deg = int $dec; 804 | my $dm = abs ($dec - $deg) * 60; 805 | my $min = int $dm; 806 | my $sec = ($dm - $min) * 60; 807 | sprintf "%d\x{00b0}%02d'%05.2f\"", $deg, $min, $sec; 808 | } # dec2dms 809 | 810 | sub distance { 811 | my ($lat_c, $lon_c, $lat_s, $lon_s) = @_; 812 | 813 | $gis and 814 | return $gis->distance ($lat_c, $lon_c, $lat_s, $lon_s)->meters / 1000.; 815 | 816 | my $rad = 6371; # km 817 | 818 | # Convert angles from degrees to radians 819 | my $dlat = deg2rad ($lat_s - $lat_c); 820 | my $dlon = deg2rad ($lon_s - $lon_c); 821 | 822 | my $x = sin ($dlat / 2) * sin ($dlat / 2) + 823 | cos (deg2rad ($lat_c)) * cos (deg2rad ($lat_s)) * 824 | sin ($dlon / 2) * sin ($dlon / 2); 825 | 826 | return $rad * 2 * atan2 (sqrt ($x), sqrt (1 - $x)); # km 827 | } # distance 828 | 829 | sub getconf { 830 | my $home = $ENV{HOME} || $ENV{USERPROFILE} || $ENV{HOMEPATH}; 831 | foreach my $rcf (grep { -s } 832 | "$home/geoip.rc", "$home/.geoiprc", "$home/.config/geoip") { 833 | my $mode = (stat $rcf)[2]; 834 | $mode & 022 and next; 835 | open my $fh, "<", $rcf or next; 836 | while (<$fh>) { 837 | m/^\s*[;#]/ and next; 838 | my ($k, $v) = (m/^\s*([-\w]+)\s*[:=]\s*(.*\S)/) or next; 839 | $conf{ lc $k 840 | =~ s{-}{_}gr 841 | =~ s{^use_}{}ir 842 | =~ s{^(json_)?(?:unicode|utf-?8?)$}{utf8}ir 843 | =~ s{^dist$}{distance}ir 844 | } = $v 845 | =~ s{(?:U\+?|\\[Uu])([0-9A-Fa-f]{2,7})}{chr hex $1}ger 846 | =~ s{^(?:no|false)$}{0}ir 847 | =~ s{^(?:yes|true)$}{1}ir; 848 | } 849 | } 850 | } # getconf 851 | 852 | 1; 853 | 854 | __END__ 855 | 856 | =encoding utf-8 857 | 858 | =head1 NAME 859 | 860 | geoip - a tool to show geographical data based on hostname or IP address(es) 861 | 862 | =head1 SYNOPSIS 863 | 864 | geoip --help 865 | 866 | geoip --fetch [--no-update] 867 | 868 | geoip [options] [host|IP ...] 869 | 870 | =head1 DESCRIPTION 871 | 872 | This tool uses a database to use the (pre-fetched) GeoIP2 data from MaxMind 873 | to show related geographical information for IP addresses. This information 874 | can optionally be extended with information from online WHOIS services and 875 | or derived data, like distance to the location of the server this tool runs 876 | on or a configured local location. 877 | 878 | The output is plain text or JSON. JSON may be short or formatted. 879 | 880 | =head2 Configuration 881 | 882 | The tool allows the use of configuration files. It tests for existence of 883 | the files listed here. All existing files is read (in this order) if it is 884 | only writable by the author (mode C<0640> should do). 885 | 886 | $home/geoip.rc 887 | $home/.geoiprc 888 | $home/.config/geoip 889 | 890 | where C<$home> is either of C<$HOME>, C<$USERPROFILE>, or C<$HOMEPATH>. 891 | 892 | The format of the file is 893 | 894 | # Comment 895 | ; Comment 896 | option : value 897 | option = value 898 | 899 | where the C<:> and C<=> are equal and whitespace around them is optional 900 | and ignored. The values C and C (case insensitive) are the same 901 | as C<0> and the values C and C are equal to C<1>. For readability 902 | you can prefix C to most options (it is ignored). The use of C<-> in 903 | option names is allowed and will be translated to C<_>. 904 | 905 | The recognized options and the command line equivalences are 906 | 907 | =over 2 908 | 909 | =item fetch 910 | 911 | command line option : C<-f> or C<--fetch> 912 | 913 | default value : False 914 | 915 | Fetch new databases from the MaxMind site. 916 | 917 | =item update 918 | 919 | command line option : C<-u> or C<--update> 920 | 921 | default value : True 922 | 923 | Only in effect when used with C<--fetch>: when new data files from MaxMind 924 | have successfully been fetched and any of these is newer that what the 925 | database contains, update the database with the new data. 926 | 927 | =item distance 928 | 929 | command line option : C<-d> or C<--distance> 930 | 931 | default value : False 932 | 933 | If both the location of the tool I the location of the requested IP 934 | are known, calculate the distance between them. The default is to show 935 | the distance in kilometers. Choosing a configuration of C instead 936 | of C, C, or C<1> will show the distance in miles. There is no 937 | command line option for miles. 938 | 939 | The location of the tool is either locally stored in your configuration 940 | (see C<--local-location>) or fetched using the result of the urls 941 | L|https://iplocation.com> or 942 | L|https://geoiptool.com>. This will - of course - not work 943 | if there is no network connection or outside traffic is not allowed. 944 | 945 | =item whois 946 | 947 | command line option : C<-w> or C<--whois> 948 | 949 | default value : False 950 | 951 | If L is installed, and this option is true, this module 952 | will be used to retrieve the C information. This will not work if 953 | there is no network connection or outside traffic is not allowed. 954 | 955 | =item short 956 | 957 | command line option : C<-s> or C<--short> 958 | 959 | default value : False 960 | 961 | This option will disable the output of less-informative information like 962 | location, EU-membership, satellite and proxy. This option, if True, will 963 | also implicitly disable the C and C information. 964 | 965 | =item dsn 966 | 967 | command line option : C<-Ddsn> or C<--DB=dsn> 968 | 969 | default value : C<$ENV{EOIP_DBI_DSN}> or C 970 | 971 | See L for the (documented) list of supported database types. 972 | 973 | If the connection works, the tables used by this tool will be created if 974 | not yet present. 975 | 976 | The order of usage is: 977 | 978 | =over 2 979 | 980 | =item 1 981 | 982 | Command line argument (C<--DB=dsn>) 983 | 984 | =item 2 985 | 986 | The C environment variable 987 | 988 | =item 3 989 | 990 | The value for C in the configuration file(s) 991 | 992 | =item 4 993 | 994 | C 995 | 996 | =back 997 | 998 | =item json 999 | 1000 | command line option : C<-j> or C<--json> 1001 | 1002 | default value : False 1003 | 1004 | The default output for the information is plain text. With this option, 1005 | the output will be in JSON format. The default is not prettified. 1006 | 1007 | =item json-pretty 1008 | 1009 | command line option : C<-J> or C<--json-pretty> 1010 | 1011 | default value : False 1012 | 1013 | If set from the command-line, this implies the C<--json> option. 1014 | 1015 | With this option, JSON output is done I (indented). 1016 | 1017 | =item local-location 1018 | 1019 | command line option : C<-l lat/lon> or C<--local=lat/lon> 1020 | 1021 | default value : Undefined 1022 | 1023 | Sets the local location coordinates for use with distances. 1024 | 1025 | When running the tool from a different location than where the IP access is 1026 | to be analyzed for or when the network connection will not report a location 1027 | that would make sense (like working from a cloud or running over one or more 1028 | VPN connections), one can set the location of the base in decimal notation. 1029 | (degree-minute-second-notation is not yet supported). 1030 | 1031 | This is also useful when there is no outbound connection possible or when you 1032 | do not move location and you want to restrict network requests. 1033 | 1034 | The notation is decimal (with a C<.>, no localization support) where latitude 1035 | and longitude are separated by a C or a C<,>, like C<-l 12.345678/-9.876543> 1036 | or C<--local=12,3456,45,6789>. 1037 | 1038 | =item maxmind-account 1039 | 1040 | command line option : none 1041 | 1042 | default value : Undefined 1043 | 1044 | Currently not (yet) used. Documentation only. 1045 | 1046 | =item license-id 1047 | 1048 | command line option : none 1049 | 1050 | default value : Undefined 1051 | 1052 | Currently not (yet) used. Documentation only. 1053 | 1054 | =item license-key 1055 | 1056 | command line option : none 1057 | 1058 | default value : Undefined 1059 | 1060 | As downloads are only allowed/possible using a valid MaxMind account, you need 1061 | to provide a valid license key in your configuration file. If you do not have 1062 | an account, you can sign up L. 1063 | 1064 | =back 1065 | 1066 | =head1 DATABASE 1067 | 1068 | Currently PostgreSQL and SQLite have been tested, but others may (or may not) 1069 | work just as well. YMMV. Note that the database need to know the C 1070 | field type and is able to put a primary key on it. 1071 | 1072 | MariaDB and MySQL are not supported, as they do not support the concept of 1073 | CIDR type fields. 1074 | 1075 | The advantage of PostgreSQL over SQLite is that you can use it with multiple 1076 | users at the same time, and that you can share the database with other hosts 1077 | on the same network behind a firewall. 1078 | 1079 | The advantage of SQLite over PostgreSQL is that it is a single file that you 1080 | can copy or move to your liking. This file will be somewhere around 500 Mb. 1081 | 1082 | =head1 EXAMPLES 1083 | 1084 | =head2 Configuration 1085 | 1086 | $ cat ~/.config/geoip 1087 | use_distance : True 1088 | json-pretty : yes 1089 | 1090 | =head2 Basic use 1091 | 1092 | $ geoip --short 1.2.3.4 1093 | 1094 | =head2 For automation 1095 | 1096 | $ geoip --json --no-json-pretty 1.2.3.4 1097 | 1098 | $ env GEOIP_HOST=1.2.3.4 geoip 1099 | 1100 | =head2 Full report 1101 | 1102 | $ geoip --dist --whois 1.2.3.4 1103 | 1104 | =head2 Selecting CIDR's for countries 1105 | 1106 | =head3 List all CIDR's for Vatican City 1107 | 1108 | $ geoip --country=Vatican > vatican-city.cidr 1109 | 1110 | =head3 Statistics 1111 | 1112 | If you enable verbosity, the selected statistics will be presented at the 1113 | end of the CIDR-list: number of CIDR's, number of enclosed IP's, name of 1114 | the country and the continent. As the country name is just a perl regex, 1115 | you can select all countries with C<.>, or all countries that start with 1116 | a C: 1117 | 1118 | $ geoip --country=^V -v >/dev/null 1119 | Selected CIDR's 1120 | # CIDR # IP Country Continent 1121 | ------ ---------- --------------------- --------------- 1122 | 21 18176 Vanuatu Oceania 1123 | 321 13056 Vatican City Europe 1124 | 272 6798500 Venezuela South America 1125 | 612 16014080 Vietnam Asia 1126 | 1127 | =head1 TODO 1128 | 1129 | =over 2 1130 | 1131 | =item IPv6 1132 | 1133 | The ZIP files also contain IPv6 information, but it is not (yet) converted 1134 | to the database, nor supported in analysis. 1135 | 1136 | =item Modularization 1137 | 1138 | Split up the different parts of the script to modules: fetch, extract, 1139 | check, database, external tools, reporting. 1140 | 1141 | =item CPAN 1142 | 1143 | Turn this into something like App::geoip, complete with Makefile.PL 1144 | 1145 | =back 1146 | 1147 | =head1 SEE ALSO 1148 | 1149 | L, L, L, L, L, 1150 | L, L, L, L, 1151 | L, L, L, L 1152 | 1153 | L, L, L, L, 1154 | L, L, L, L, 1155 | L, L, L, L, 1156 | L, L, L, L 1157 | 1158 | L 1159 | 1160 | Check L for more. 1161 | 1162 | =head1 THANKS 1163 | 1164 | Thanks to cavac for the inspiration 1165 | 1166 | =head1 AUTHOR 1167 | 1168 | H.Merijn Brand Fhmbrand@cpan.orgE>, aka Tux. 1169 | 1170 | =head1 COPYRIGHT AND LICENSE 1171 | 1172 | The GeoLite2 end-user license agreement, which incorporates components of the 1173 | Creative Commons Attribution-ShareAlike 4.0 International License 1) can be found 1174 | L 2). The attribution requirement 1175 | may be met by including the following in all advertising and documentation 1176 | mentioning features of or use of this database. 1177 | 1178 | This tool uses, but does not include, the GeoLite2 data created by MaxMind, 1179 | available from [http://www.maxmind.com](http://www.maxmind.com). 1180 | 1181 | Copyright (C) 2018-2023 H.Merijn Brand. All rights reserved. 1182 | 1183 | This library is free software; you can redistribute and/or modify it under 1184 | the same terms as Perl itself. 1185 | See L 3). 1186 | 1187 | 1) https://creativecommons.org/licenses/by-sa/4.0/ 1188 | 2) https://www.maxmind.com/en/geolite2/eula 1189 | 3) https://opensource.org/licenses/Artistic-2.0 1190 | 1191 | =for elvis 1192 | :ex:se gw=75|color guide #ff0000: 1193 | 1194 | =cut 1195 | --------------------------------------------------------------------------------