Adding geoip tracking.

This commit is contained in:
sergiotarxz 2023-08-08 19:39:13 +02:00
parent 6595b56726
commit fb75027c3e
5 changed files with 123 additions and 36 deletions

View File

@ -20,6 +20,7 @@ my $build = Module::Build->new(
'SVG' => 0, 'SVG' => 0,
'XML::Twig' => 0, 'XML::Twig' => 0,
'JSON' => 0, 'JSON' => 0,
'IP::Geolocation::MMDB' => 0,
}, },
); );
$build->create_build_script; $build->create_build_script;

View File

@ -5,6 +5,7 @@
"database": "example" "database": "example"
}, },
"base_url": "https://burguillos.info", "base_url": "https://burguillos.info",
"geoip_database": "/usr/share/GeoLite2-City_20230804/GeoLite2-City.mmdb",
"onion_base_url": "http://example.onion"; "onion_base_url": "http://example.onion";
"listen": "https:localhost:3555" "listen": "https:localhost:3555"
} }

View File

@ -12,8 +12,9 @@ use BurguillosInfo::DB::Migrations;
use Data::Dumper; use Data::Dumper;
my $dbh; my $dbh;
sub connect { sub connect {
if (defined $dbh) { if ( defined $dbh ) {
return $dbh; return $dbh;
} }
my $class = shift; my $class = shift;
@ -22,12 +23,17 @@ sub connect {
my $database = $config->{db}{database}; my $database = $config->{db}{database};
$dbh = DBI->connect( $dbh = DBI->connect(
"dbi:Pg:dbname=$database", "dbi:Pg:dbname=$database",
, undef, undef, { RaiseError => 1, Callbacks => { ,
undef, undef,
{
RaiseError => 1,
Callbacks => {
connected => sub { connected => sub {
shift->do('set timezone = UTC'); shift->do('set timezone = UTC');
return; return;
} }
}}, }
},
); );
$class->_migrate($dbh); $class->_migrate($dbh);
return $dbh; return $dbh;
@ -46,7 +52,7 @@ sub _migrate {
say STDERR "Migrations already applied."; say STDERR "Migrations already applied.";
return; return;
} }
$class->_apply_migrations($dbh, \@migrations); $class->_apply_migrations( $dbh, \@migrations );
} }
sub _apply_migrations { sub _apply_migrations {
@ -54,7 +60,7 @@ sub _apply_migrations {
my $dbh = shift; my $dbh = shift;
my $migrations = shift; my $migrations = shift;
for ( for (
my $i = $class->get_current_migration($dbh); my $i = $class->get_current_migration($dbh) ;
$i < @$migrations ; $i < @$migrations ;
$i++ $i++
) )
@ -62,7 +68,7 @@ sub _apply_migrations {
local $dbh->{RaiseError} = 1; local $dbh->{RaiseError} = 1;
my $current_migration = $migrations->[$i]; my $current_migration = $migrations->[$i];
my $migration_number = $i + 1; my $migration_number = $i + 1;
$class->_apply_migration($dbh, $current_migration, $migration_number); $class->_apply_migration( $dbh, $current_migration, $migration_number );
} }
} }
@ -71,8 +77,14 @@ sub _apply_migration {
my $dbh = shift; my $dbh = shift;
my $current_migration = shift; my $current_migration = shift;
my $migration_number = shift; my $migration_number = shift;
{
if (ref $current_migration eq 'CODE') {
$current_migration->($dbh);
next;
}
$dbh->do($current_migration); $dbh->do($current_migration);
$dbh->do(<<'EOF', undef, 'current_migration', $migration_number); }
$dbh->do( <<'EOF', undef, 'current_migration', $migration_number );
INSERT INTO options INSERT INTO options
VALUES ($1, $2) VALUES ($1, $2)
ON CONFLICT (name) DO ON CONFLICT (name) DO

View File

@ -4,6 +4,9 @@ use v5.34.1;
use strict; use strict;
use warnings; use warnings;
use utf8;
use feature 'signatures';
sub MIGRATIONS { sub MIGRATIONS {
return ( return (
@ -31,6 +34,26 @@ sub MIGRATIONS {
'CREATE INDEX request_extra_index on requests (date, path);', 'CREATE INDEX request_extra_index on requests (date, path);',
'ALTER TABLE requests ADD column referer text;', 'ALTER TABLE requests ADD column referer text;',
'CREATE INDEX request_referer_index on requests (referer);', 'CREATE INDEX request_referer_index on requests (referer);',
'ALTER TABLE requests ADD COLUMN country TEXT;',
'CREATE INDEX request_country_index on requests (country);',
'ALTER TABLE requests ADD COLUMN subdivision TEXT;',
'CREATE INDEX request_subdivision_index on requests (subdivision);',
\&_populate_locations,
); );
} }
sub _populate_locations($dbh) {
require BurguillosInfo;
require BurguillosInfo::Tracking;
my $tracking = BurguillosInfo::Tracking->new(BurguillosInfo->new);
my $data = $dbh->selectall_arrayref(<<'EOF', {Slice => {}});
SELECT uuid, remote_address
FROM requests
WHERE date > NOW() - interval '2 months';
EOF
for my $request (@$data) {
my ($uuid, $remote_address) = $request->@{'uuid', 'remote_address'};
$tracking->update_country_and_subdivision($dbh, $uuid, $remote_address);
}
}
1; 1;

View File

@ -54,13 +54,63 @@ sub _register_request_query ( $self, $remote_address, $user_agent,
$params_json, $path, $referer ) $params_json, $path, $referer )
{ {
my $dbh = BurguillosInfo::DB->connect($app); my $dbh = BurguillosInfo::DB->connect($app);
my $country = $self->_get_country('185.244.231.157');
my $subdivision = $self->_get_subdivision('185.244.231.157');
$dbh->do( $dbh->do(
<<'EOF', undef, $remote_address, $user_agent, $params_json, $path, $referer ); <<'EOF', undef, $remote_address, $user_agent, $params_json, $path, $referer, $country, $subdivision );
INSERT INTO requests(remote_address, user_agent, params, path, referer) INSERT INTO requests(remote_address,
VALUES (?, ?, ?, ?, ?); user_agent, params, path,
referer, country, subdivision)
VALUES (?, ?, ?, ?, ?, ?, ?);
EOF EOF
} }
sub update_country_and_subdivision($self, $dbh, $uuid, $remote_address) {
my $country = $self->_get_country($remote_address);
my $subdivision = $self->_get_subdivision($remote_address);
$dbh->do(<<'EOF', undef, $country, $subdivision, $uuid);
UPDATE requests
SET country=?,
subdivision=?
WHERE uuid=?;
EOF
}
sub _get_country($self, $remote_address) {
my $geoip = $self->_geoip;
if (!defined $geoip) {
return;
}
my $data = $geoip->record_for_address($remote_address);
return $data->{country}{names}{es};
}
sub _get_subdivision($self, $remote_address) {
my $geoip = $self->_geoip;
if (!defined $geoip) {
return;
}
my $data = $geoip->record_for_address($remote_address);
return $data->{subdivisions}[0]{names}{es};
}
sub _geoip($self) {
require IP::Geolocation::MMDB;
my $path = $self->_geoip_path;
if (!defined $path) {
return;
}
return IP::Geolocation::MMDB->new(file => $path);
}
sub _geoip_path($self) {
require BurguillosInfo;
my $app = BurguillosInfo->new;
my $config = $app->config->{geoip_database};
return $config;
}
sub register_request { sub register_request {
my $self = shift; my $self = shift;
my $c = shift; my $c = shift;