Verified Commit 37354581 authored by Luc Didry's avatar Luc Didry

Fix #44 - Add option to store IP address of URL creator

This commit is dedicated to Schoumi, who is supporting me on Tipeee.
Many thanks :-)
parent 016db305
Revision history for Perl application Lstu
0.18-0 2018-??-??
- Add option to store IP address of URL creator
- Add command to search URL with the IP address of its creator
- Add option to blacklist IP address
0.17-3 2018-08-20
- Fix missing default db_path
......
......@@ -21,6 +21,7 @@ sub startup {
theme => 'default',
ban_min_strike => 3,
ban_whitelist => [],
ban_blacklist => [],
minion => {
enabled => 0,
db_path => 'minion.db'
......@@ -34,6 +35,7 @@ sub startup {
x_frame_options => 'DENY',
x_content_type_options => 'nosniff',
x_xss_protection => '1; mode=block',
log_creator_ip => 0,
}
});
......
......@@ -32,6 +32,7 @@ sub run {
theme => 'default',
ban_min_strike => 3,
ban_whitelist => [],
ban_blacklist => [],
minion => {
enabled => 0,
db_path => 'minion.db'
......@@ -45,6 +46,7 @@ sub run {
x_frame_options => 'DENY',
x_content_type_options => 'nosniff',
x_xss_protection => '1; mode=block',
log_creator_ip => 0,
}
});
......@@ -63,6 +65,7 @@ sub run {
'i|info=s' => \my $info,
'r|remove=s' => \my $remove,
's|search=s' => \my $search,
'ip=s' => \my $ip,
'y|yes' => \my $yes;
if ($info) {
......@@ -75,7 +78,7 @@ sub run {
print_infos($u->to_hash);
my $confirm = ($yes) ? 'yes' : undef;
unless (defined $confirm) {
say 'Are you sure you want to remove this URL? [N/y]';
print 'Are you sure you want to remove this URL? [N/y] ';
$confirm = <STDIN>;
chomp $confirm;
}
......@@ -101,6 +104,14 @@ sub run {
});
say sprintf('%d matching URLs', $u->size);
}
if ($ip) {
my $u = Lstu::DB::URL->new(app => $c->app)->search_creator($ip);
$u->each(sub {
my ($e, $num) = @_;
print_infos($e);
});
say sprintf('%d matching URLs', $u->size);
}
}
sub get_short {
......@@ -146,6 +157,7 @@ Lstu::Command::url - Manage URL in Lstu's database
carton exec script/lstu url --remove <short> [--yes] Remove URL (ask for confirmation unless --yes is given)
Will print infos about URL before confirmation
carton exec script/lstu url --search <url> Search URL by its true URL (LIKE match)
carton exec script/lstu url --ip <ip address> Search URL by the IP address of its creator (exact match)
=cut
......
......@@ -14,14 +14,18 @@ sub add {
$c->cleaning;
# Is the user allowed to create a short URL?
if ((!defined($c->config('ldap')) && !defined($c->config('htpasswd'))) || $c->is_user_authenticated) {
my $ip = $c->ip;
# Check banning
my $banned = Lstu::DB::Ban->new(
app => $c,
ip => $c->ip
ip => $ip
)->is_banned($c->config('ban_min_strike'));
if (defined $banned) {
# Increase ban delay if necessary
my $penalty = 3600;
if ($banned->strike >= 2 * $c->config('ban_min_strike')) {
$penalty = 3600 * 24 * 30; # 30 days of banishing
......@@ -49,44 +53,55 @@ sub add {
$custom_url = undef if (defined($custom_url) && $custom_url eq '');
my ($msg, $short);
if (defined($custom_url) && ($custom_url =~ m#^(a|d|cookie|stats|fullstats|login|logout|api)$# ||
$custom_url =~ m/\.json$/ || $custom_url !~ m/^[-a-zA-Z0-9_]+$/))
{
if (defined($custom_url) &&
(
$custom_url =~ m#^(a|d|cookie|stats|fullstats|login|logout|api)$# ||
$custom_url =~ m/\.json$/ || $custom_url !~ m/^[-a-zA-Z0-9_]+$/
)) {
$msg = $c->l('The shortened text can contain only numbers, letters and the - and _ character, can\'t be "a", "api", "d" or "stats" or end with ".json". Your URL to shorten: %1', $url);
} elsif (defined($custom_url) && Lstu::DB::URL->new(app => $c)->exist($custom_url) > 0) {
$msg = $c->l('The shortened text (%1) is already used. Please choose another one.', $custom_url);
} elsif (is_http_uri($url->to_string) || is_https_uri($url->to_string) || (defined($url->host) && $url->host =~ m/\.onion$/)) {
my $res = ($url->host =~ m/\.onion$/) ? {} : $c->is_spam($url, 0);
# Check if spam
if ($res->{is_spam}) {
$msg = $res->{msg};
} else {
my $db_url = Lstu::DB::URL->new(
app => $c,
url => $url
);
# Not spam, let's go
Lstu::DB::Ban->new(
app => $c,
ip => $ip
)->increment_ban_delay(1);
my $db_url = Lstu::DB::URL->new(
app => $c,
url => $url
);
if ($db_url->short && !defined($custom_url)) {
# Already got this URL
$short = $db_url->short;
} else {
if (defined($custom_url)) {
Lstu::DB::URL->new(
app => $c,
short => $custom_url,
url => $url,
timestamp => time()
app => $c,
short => $custom_url,
url => $url,
timestamp => time(),
created_by => ($c->config('log_creator_ip')) ? $ip : undef
)->write;
$short = $custom_url;
} else {
$db_url = Lstu::DB::URL->new(app => $c)->choose_empty;
if (defined $db_url) {
$db_url->url($url)->timestamp(time)->write;
$db_url->url($url)->timestamp(time);
$db_url->created_by($ip) if $c->config('log_creator_ip');
$db_url->write;
$short = $db_url->short;
} else {
......@@ -112,11 +127,14 @@ sub add {
} else {
# Get URLs from cookie
my $u = (defined($c->cookie('url'))) ? decode_json $c->cookie('url') : [];
# Add the new URL
push @{$u}, $short;
# Make the array contain only unique URLs
my %k = map { $_, 1 } @{$u};
@{$u} = keys %k;
# And set the cookie
my $cookie = to_json($u);
$c->cookie(
......@@ -145,6 +163,7 @@ sub add {
}
}
} else {
# Not authorized
$c->redirect_to('login');
}
}
......
......@@ -104,7 +104,30 @@ sub is_whitelisted {
my $c = shift;
my $ip = $c->ip;
return scalar(grep {/$ip/} @{$c->app->config('ban_whitelist')});
return scalar(grep(sub { $_ eq $ip }, @{$c->app->config('ban_whitelist')}));
}
=head2 is_blacklisted
=over 1
=item B<Usage> : C<$c-E<gt>is_blacklisted>
=item B<Arguments> : none
=item B<Purpose> : tells you if the current object is in the configured blacklisted IPs
=item B<Returns> : boolean
=back
=cut
sub is_blacklisted {
my $c = shift;
my $ip = $c->ip;
return scalar(grep(sub { $_ eq $ip }, @{$c->app->config('ban_blacklist')}));
}
=head2 is_banned
......
......@@ -20,6 +20,12 @@ sub is_banned {
return undef if $c->is_whitelisted;
if ($c->is_blacklisted) {
$c->until(time + 3600);
$c->strike(1 + $c->app->config('ban_min_strike'));
return $c;
}
my $h = $c->app->mysql->db->query('SELECT * FROM ban WHERE ip = ? AND until > ? AND strike >= ?', $c->ip, time, $ban_min_strike)->hashes;
if ($h->size) {
......
......@@ -20,6 +20,12 @@ sub is_banned {
return undef if $c->is_whitelisted;
if ($c->is_blacklisted) {
$c->until(time + 3600);
$c->strike(1 + $c->app->config('ban_min_strike'));
return $c;
}
my $h = $c->app->pg->db->query('SELECT * FROM ban WHERE ip = ? AND until > ? AND strike >= ?', $c->ip, time, $ban_min_strike)->hashes;
if ($h->size) {
......
......@@ -20,6 +20,12 @@ sub is_banned {
return undef if $c->is_whitelisted;
if ($c->is_blacklisted) {
$c->until(time + 3600);
$c->strike(1 + $c->app->config('ban_min_strike'));
return $c;
}
my $h = $c->app->sqlite->db->query('SELECT * FROM ban WHERE ip = ? AND until > ? AND strike >= ?', $c->ip, time, $ban_min_strike)->hashes;
if ($h->size) {
......
......@@ -6,6 +6,7 @@ has 'short';
has 'url';
has 'counter' => 0;
has 'timestamp';
has 'created_by';
has 'app';
=head1 NAME
......@@ -23,15 +24,17 @@ Have a look at Lstu::DB::URL::SQLite's code: it's simple and may be more underst
=over 1
=item B<short> : random string
=item B<short> : random string
=item B<url> : string, valid URL
=item B<url> : string, valid URL
=item B<counter> : integer
=item B<counter> : integer
=item B<timestamp> : unix timestamp
=item B<timestamp> : unix timestamp
=item B<app> : a mojolicious object
=item B<created_by> : the IP address of the creator
=item B<app> : a mojolicious object
=back
......@@ -81,10 +84,11 @@ sub to_hash {
my $c = shift;
return {
short => $c->short,
url => $c->url,
counter => $c->counter,
timestamp => $c->timestamp
short => $c->short,
url => $c->url,
counter => $c->counter,
timestamp => $c->timestamp,
created_by => $c->created_by
};
}
......@@ -258,6 +262,19 @@ eg: C<COUNT(short) WHERE url IS NOT NULL>
=back
=head2 search_creator
=over 1
=item B<Usage> : C<$c-E<gt>search_creator($string)>
=item B<Arguments> : string, IP address to search
=item B<Purpose> : search records which creator's IP address matches the given string
=item B<Returns> : a Mojo::Collection containing hashes of the matching records
=back
=cut
......
......@@ -28,9 +28,9 @@ sub write {
my $c = shift;
if ($c->record) {
$c->app->mysql->db->query('UPDATE lstu SET url = ?, counter = ?, timestamp = ? WHERE short = ?', $c->url, $c->counter, $c->timestamp, $c->short);
$c->app->mysql->db->query('UPDATE lstu SET url = ?, counter = ?, timestamp = ?, created_by = ? WHERE short = ?', $c->url, $c->counter, $c->timestamp, $c->created_by, $c->short);
} else {
$c->app->mysql->db->query('INSERT INTO lstu (short, url, counter, timestamp) VALUES (?, ?, ?, ?)', $c->short, $c->url, $c->counter, $c->timestamp);
$c->app->mysql->db->query('INSERT INTO lstu (short, url, counter, timestamp, created_by) VALUES (?, ?, ?, ?, ?)', $c->short, $c->url, $c->counter, $c->timestamp, $c->created_by);
$c->record(1);
}
......@@ -120,6 +120,13 @@ sub search_url {
$c->app->mysql->db->select('lstu', undef, { url => {-like => '%'.$s.'%'}})->hashes;
}
sub search_creator {
my $c = shift;
my $s = shift;
$c->app->mysql->db->select('lstu', undef, { created_by => $s })->hashes;
}
sub _slurp {
my $c = shift;
......@@ -134,6 +141,7 @@ sub _slurp {
$c->short($h->first->{short});
$c->counter($h->first->{counter});
$c->timestamp($h->first->{timestamp});
$c->created_by($h->first->{created_by});
$c->record(1);
}
......
......@@ -27,9 +27,9 @@ sub write {
my $c = shift;
if ($c->record) {
$c->app->pg->db->query('UPDATE lstu SET url = ?, counter = ?, timestamp = ? WHERE short = ?', $c->url, $c->counter, $c->timestamp, $c->short);
$c->app->pg->db->query('UPDATE lstu SET url = ?, counter = ?, timestamp = ?, created_by = ? WHERE short = ?', $c->url, $c->counter, $c->timestamp, $c->created_by, $c->short);
} else {
$c->app->pg->db->query('INSERT INTO lstu (short, url, counter, timestamp) VALUES (?, ?, ?, ?)', $c->short, $c->url, $c->counter, $c->timestamp);
$c->app->pg->db->query('INSERT INTO lstu (short, url, counter, timestamp, created_by) VALUES (?, ?, ?, ?, ?)', $c->short, $c->url, $c->counter, $c->timestamp, $c->created_by);
$c->record(1);
}
......@@ -118,6 +118,13 @@ sub search_url {
$c->app->pg->db->select('lstu', undef, { url => {-like => '%'.$s.'%'}})->hashes;
}
sub search_creator {
my $c = shift;
my $s = shift;
$c->app->pg->db->select('lstu', undef, { created_by => $s })->hashes;
}
sub _slurp {
my $c = shift;
......@@ -132,6 +139,7 @@ sub _slurp {
$c->short($h->first->{short});
$c->counter($h->first->{counter});
$c->timestamp($h->first->{timestamp});
$c->created_by($h->first->{created_by});
$c->record(1);
}
......
......@@ -28,9 +28,9 @@ sub write {
my $c = shift;
if ($c->record) {
$c->app->sqlite->db->query('UPDATE lstu SET url = ?, counter = ?, timestamp = ? WHERE short = ?', $c->url, $c->counter, $c->timestamp, $c->short);
$c->app->sqlite->db->query('UPDATE lstu SET url = ?, counter = ?, timestamp = ?, created_by = ? WHERE short = ?', $c->url, $c->counter, $c->timestamp, $c->created_by, $c->short);
} else {
$c->app->sqlite->db->query('INSERT INTO lstu (short, url, counter, timestamp) VALUES (?, ?, ?, ?)', $c->short, $c->url, $c->counter, $c->timestamp);
$c->app->sqlite->db->query('INSERT INTO lstu (short, url, counter, timestamp, created_by) VALUES (?, ?, ?, ?, ?)', $c->short, $c->url, $c->counter, $c->timestamp, $c->created_by);
$c->record(1);
}
......@@ -120,6 +120,13 @@ sub search_url {
$c->app->sqlite->db->select('lstu', undef, { url => {-like => '%'.$s.'%'}})->hashes;
}
sub search_creator {
my $c = shift;
my $s = shift;
$c->app->sqlite->db->select('lstu', undef, { created_by => $s })->hashes;
}
sub _slurp {
my $c = shift;
......@@ -134,6 +141,7 @@ sub _slurp {
$c->short($h->first->{short});
$c->counter($h->first->{counter});
$c->timestamp($h->first->{timestamp});
$c->created_by($h->first->{created_by});
$c->record(1);
}
......
......@@ -24,9 +24,9 @@ sub register {
my $sql = Mojo::SQLite->new('sqlite:'.$app->config('db_path'));
my $migrations = $sql->migrations;
if ($app->mode eq 'development' && $ENV{LSTU_DEBUG}) {
$migrations->from_file('utilities/migrations/sqlite.sql')->migrate(0)->migrate(1);
$migrations->from_file('utilities/migrations/sqlite.sql')->migrate(0)->migrate(2);
} else {
$migrations->from_file('utilities/migrations/sqlite.sql')->migrate(1);
$migrations->from_file('utilities/migrations/sqlite.sql')->migrate(2);
}
} elsif ($app->config('dbtype') eq 'postgresql') {
require Mojo::Pg;
......@@ -35,9 +35,9 @@ sub register {
# Database migration
my $migrations = Mojo::Pg::Migrations->new(pg => $app->pg);
if ($app->mode eq 'development' && $ENV{LSTU_DEBUG}) {
$migrations->from_file('utilities/migrations/postgresql.sql')->migrate(0)->migrate(2);
$migrations->from_file('utilities/migrations/postgresql.sql')->migrate(0)->migrate(3);
} else {
$migrations->from_file('utilities/migrations/postgresql.sql')->migrate(2);
$migrations->from_file('utilities/migrations/postgresql.sql')->migrate(3);
}
} elsif ($app->config('dbtype') eq 'mysql') {
require Mojo::mysql;
......@@ -46,19 +46,19 @@ sub register {
# Database migration
my $migrations = Mojo::mysql::Migrations->new(mysql => $app->mysql);
if ($app->mode eq 'development' && $ENV{LSTU_DEBUG}) {
$migrations->from_file('utilities/migrations/mysql.sql')->migrate(0)->migrate(1);
$migrations->from_file('utilities/migrations/mysql.sql')->migrate(0)->migrate(2);
} else {
$migrations->from_file('utilities/migrations/mysql.sql')->migrate(1);
$migrations->from_file('utilities/migrations/mysql.sql')->migrate(2);
}
}
# Helpers
$app->helper(ip => \&_ip);
$app->helper(ip => \&_ip);
$app->helper(provisioning => \&_provisioning);
$app->helper(prefix => \&_prefix);
$app->helper(shortener => \&_shortener);
$app->helper(is_spam => \&_is_spam);
$app->helper(cleaning => \&_cleaning);
$app->helper(prefix => \&_prefix);
$app->helper(shortener => \&_shortener);
$app->helper(is_spam => \&_is_spam);
$app->helper(cleaning => \&_cleaning);
}
sub _sqlite {
......
......@@ -30,6 +30,7 @@ sub startup {
theme => 'default',
ban_min_strike => 3,
ban_whitelist => [],
ban_blacklist => [],
minion => {
enabled => 0,
db_path => 'minion.db'
......@@ -43,6 +44,7 @@ sub startup {
x_frame_options => 'DENY',
x_content_type_options => 'nosniff',
x_xss_protection => '1; mode=block',
log_creator_ip => 0,
}
}
);
......
......@@ -122,6 +122,14 @@
# optional, default is an empty array
#ban_whitelist => [],
# Ban blacklist
# You can blacklist IP addresses to always ban those IP addresses
# Be careful, the IP addresses are compared as string, not as IP addresses
# a network range will not work
# Example of valid input: ban_blacklist => ['198.51.100.42', '2001:0DB8::42'],¬
# optional, default is an empty array
#ban_blacklist => [],
# define an URL to the Piwik instance and the ID of a website to track
# set if you want to track views in Piwik
# optional, Piwik tracking is disabled by default
......@@ -243,4 +251,9 @@
# Set to '' to disable X-XSS-Protection header
# optional, default is '1; mode=block'
#x_xss_protection => '1; mode=block',
# Log creator's IP address
# Set to 1 if you want to register the IP addresses of URL creators
# optional, default is 0
#log_creator_ip => 0,
};
......@@ -16,7 +16,7 @@ msgstr ""
"Content-Transfer-Encoding: 8bit\n"
#. ($url)
#: lib/Lstu/Controller/URL.pm:100
#: lib/Lstu/Controller/URL.pm:115
msgid "%1 is not a valid URL."
msgstr ""
......@@ -154,7 +154,7 @@ msgid "Next"
msgstr ""
#. ($c->config('contact')
#: lib/Lstu/Controller/URL.pm:94
#: lib/Lstu/Controller/URL.pm:109
msgid "No shortened URL available. Please retry or contact the administrator at %1. Your URL to shorten: %2"
msgstr ""
......@@ -226,17 +226,17 @@ msgid "The URL you want to shorten comes from a domain (%1) that is blacklisted
msgstr ""
#. ($c->url_for('/')
#: lib/Lstu/Controller/Admin.pm:134 lib/Lstu/Controller/Stats.pm:184 lib/Lstu/Controller/URL.pm:204
#: lib/Lstu/Controller/Admin.pm:134 lib/Lstu/Controller/Stats.pm:184 lib/Lstu/Controller/URL.pm:223
msgid "The shortened URL %1 doesn't exist."
msgstr ""
#. ($custom_url)
#: lib/Lstu/Controller/URL.pm:57
#: lib/Lstu/Controller/URL.pm:63
msgid "The shortened text (%1) is already used. Please choose another one."
msgstr ""
#. ($url)
#: lib/Lstu/Controller/URL.pm:55
#: lib/Lstu/Controller/URL.pm:61
msgid "The shortened text can contain only numbers, letters and the - and _ character, can't be \"a\", \"api\", \"d\" or \"stats\" or end with \".json\". Your URL to shorten: %1"
msgstr ""
......@@ -261,7 +261,7 @@ msgid "URL to shorten"
msgstr ""
#. ($penalty/3600)
#: lib/Lstu/Controller/URL.pm:31
#: lib/Lstu/Controller/URL.pm:35
msgid "You asked to shorten too many URLs too quickly. You're banned for %1 hour(s)."
msgstr ""
......
......@@ -18,3 +18,7 @@ CREATE TABLE IF NOT EXISTS ban (
DROP TABLE ban;
DROP TABLE sessions;
DROP TABLE lstu;
-- 2 up
ALTER TABLE lstu ADD created_by text;
-- 2 down
ALTER TABLE lstu DROP COLUMN created_by;
......@@ -22,3 +22,7 @@ DROP TABLE lstu;
CREATE INDEX IF NOT EXISTS empty_short_idx ON lstu (short) WHERE url IS NULL;
-- 2 down
DROP INDEX empty_short_idx;
-- 3 up
ALTER TABLE lstu ADD COLUMN created_by text;
-- 3 down
ALTER TABLE lstu DROP COLUMN created_by;
......@@ -20,3 +20,17 @@ DROP TABLE lstu;
DROP TABLE sessions;
DROP TABLE ban;
DROP INDEX empty_short_idx;
-- 2 up
ALTER TABLE lstu ADD COLUMN created_by TEXT;
-- 2 down
BEGIN TRANSACTION;
CREATE TABLE lstu_backup(
short TEXT PRIMARY KEY,
url TEXT,
counter INTEGER,
timestamp INTEGER
);
INSERT INTO lstu_backup SELECT short, url, counter, timestamp FROM lstu;
DROP TABLE lstu;
ALTER TABLE lstu_backup RENAME TO lstu;
COMMIT;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment