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

Merge branch 'development'

parents 01a7e2ae d4829d7d
......@@ -35,7 +35,7 @@ variables:
services:
- name: rroemhild/test-openldap
alias: rroemhild-test-openldap
coverage: '/Total .*(\d+\.\d+)$/'
coverage: '/Total.* (\d+\.\d+)$/'
.pg_template: &pg_definition
stage: tests
retry: 2
......@@ -104,19 +104,16 @@ carton_mysql:
sqlite1:
<<: *sqlite_definition
script:
- carton install --deployment --without=postgresql --without=mysql
- MOJO_CONFIG=t/sqlite1.conf make test
- MOJO_CONFIG=t/sqlite1.conf make cover
sqlite2:
<<: *sqlite_definition
script:
- carton install --deployment --without=postgresql --without=mysql
- MOJO_CONFIG=t/sqlite2.conf make test
- MOJO_CONFIG=t/sqlite2.conf make cover
sqlite3:
<<: *sqlite_definition
script:
- carton install --deployment --without=postgresql --without=mysql
- MOJO_CONFIG=t/sqlite3.conf make minion &
- sleep 5
- MOJO_CONFIG=t/sqlite3.conf make test
......@@ -128,19 +125,16 @@ sqlite3:
postgresql1:
<<: *pg_definition
script:
- carton install --deployment --without=sqlite --without=mysql
- MOJO_CONFIG=t/postgresql1.conf make test
- MOJO_CONFIG=t/postgresql1.conf make cover
postgresql2:
<<: *pg_definition
script:
- carton install --deployment --without=sqlite --without=mysql
- MOJO_CONFIG=t/postgresql2.conf make test
- MOJO_CONFIG=t/postgresql2.conf make cover
postgresql3:
<<: *pg_definition
script:
- carton install --deployment --without=sqlite --without=mysql
- export PGPASSWORD=lstu_pwd; echo 'CREATE DATABASE lstu_minion WITH OWNER lstu;' | psql -h postgres -U lstu lstu_db
- MOJO_CONFIG=t/postgresql3.conf make minion &
- sleep 5
......@@ -153,19 +147,16 @@ postgresql3:
mysql1:
<<: *mysql_definition
script:
- carton install --deployment --without=sqlite --without=postgresql
- MOJO_CONFIG=t/mysql1.conf make test
- MOJO_CONFIG=t/mysql1.conf make cover
mysql2:
<<: *mysql_definition
script:
- carton install --deployment --without=sqlite --without=postgresql
- MOJO_CONFIG=t/mysql2.conf make test
- MOJO_CONFIG=t/mysql2.conf make cover
mysql3:
<<: *mysql_definition
script:
- carton install --deployment --without=sqlite --without=postgresql
- echo "CREATE DATABASE lstu_minion; GRANT ALL ON lstu_minion.* TO lstu@'%'; FLUSH PRIVILEGES;" | mysql -h mariadb -u root -proot
- MOJO_CONFIG=t/mysql3.conf make minion &
- sleep 5
......
Revision history for Perl application Lstu
0.21-0 2018-??-??
- Allow to delete URLs and ban IPs from safebrowsingcheck
- Add ban CLI tool for banning and unbanning IP addresses
0.20-2 2018-10-07
- Handle very long URLs
......
......@@ -24,18 +24,18 @@ stats-locales:
zanata-cli -q stats
podcheck:
podchecker lib/Lstu/DB/Ban.pm lib/Lstu/DB/Session.pm lib/Lstu/DB/URL.pm
podchecker lib/Lstu/DB/*pm lib/Lstu/Command/*pm
cover:
PERL5OPT='-Ilib/' HARNESS_PERL_SWITCHES='-MDevel::Cover' $(CARTON) cover --ignore_re '^local'
test:
@PERL5OPT='-Ilib/' HARNESS_PERL_SWITCHES='-MDevel::Cover' $(CARTON) $(REAL_LSTU) test
@PERL5OPT='-Ilib/' HARNESS_PERL_SWITCHES='-MDevel::Cover' $(CARTON) prove -l -f -o
test-sqlite:
@rm -rf test1.db test1.db-journal cover_db/
@echo 'MOJO_CONFIG=t/sqlite1.conf'
@PERL5OPT='-Ilib/' HARNESS_PERL_SWITCHES='-MDevel::Cover' MOJO_CONFIG=t/sqlite1.conf $(CARTON) $(REAL_LSTU) test
@PERL5OPT='-Ilib/' HARNESS_PERL_SWITCHES='-MDevel::Cover' MOJO_CONFIG=t/sqlite1.conf $(CARTON) prove -l -f -o
@PERL5OPT='-Ilib/' HARNESS_PERL_SWITCHES='-MDevel::Cover' $(CARTON) cover --ignore_re '^local'
dev: minify
......
......@@ -49,6 +49,6 @@ feature 'mysql', 'MySQL support' => sub {
};
feature 'safebrowsing', 'Check URLs against Google safebrowsing database' => sub {
requires 'Net::Google::SafeBrowsing4';
requires 'Net::Google::SafeBrowsing4', '>= 0.8';
requires 'Term::ProgressBar::Quiet';
};
This diff is collapsed.
# vim:set sw=4 ts=4 sts=4 ft=perl expandtab:
package Lstu::Command::ban;
use Mojo::Base 'Mojolicious::Command';
use FindBin qw($Bin);
use File::Spec qw(catfile);
use Mojo::Util qw(getopt);
use Lstu::DB::Ban;
has description => 'Ban IPs addresses for ten years, or unban them';
has usage => sub { shift->extract_usage };
sub run {
my $c = shift;
my @args = @_;
my $cfile = Mojo::File->new($Bin, '..' , 'lstu.conf');
if (defined $ENV{MOJO_CONFIG}) {
$cfile = Mojo::File->new($ENV{MOJO_CONFIG});
unless (-e $cfile->to_abs) {
$cfile = Mojo::File->new($Bin, '..', $ENV{MOJO_CONFIG});
}
}
my $config = $c->app->plugin('Config', {
file => $cfile,
default => {
prefix => '/',
provisioning => 100,
provis_step => 5,
length => 8,
secret => ['hfudsifdsih'],
page_offset => 10,
theme => 'default',
ban_min_strike => 3,
ban_whitelist => [],
ban_blacklist => [],
minion => {
enabled => 0,
db_path => 'minion.db'
},
session_duration => 3600,
dbtype => 'sqlite',
db_path => 'lstu.db',
max_redir => 2,
skip_spamhaus => 0,
safebrowsing_api_key => '',
memcached_servers => [],
x_frame_options => 'DENY',
x_content_type_options => 'nosniff',
x_xss_protection => '1; mode=block',
log_creator_ip => 0,
}
});
$c->app->plugin('Lstu::Plugin::Helpers');
getopt \@args,
'b|ban=s{1,}' => \my @ban_ips,
'u|unban=s{1,}' => \my @unban_ips;
for my $ip (@ban_ips) {
Lstu::DB::Ban->new(
app => $c->app,
ip => $ip
)->ban_ten_years;
}
say sprintf("%d banned IP addresses", scalar(@ban_ips)) if (@ban_ips);
for my $ip (@unban_ips) {
Lstu::DB::Ban->new(
app => $c->app,
ip => $ip
)->unban;
}
say sprintf("%d unbanned IP addresses", scalar(@unban_ips)) if (@unban_ips);
say $c->extract_usage unless (scalar(@ban_ips) || scalar(@unban_ips));
}
=encoding utf8
=head1 NAME
Lstu::Command::ban - Ban IPs addresses for ten years, or unban them
=head1 SYNOPSIS
Usage:
carton exec script/lstu ban -b|--ban <ip> <ip> Ban the space separated IP addresses for ten years
carton exec script/lstu ban -u|--unban <ip> <ip> Unban the space separated IP addresses
Please note that you can pass the --ban and --unban options at the same time.
=cut
1;
......@@ -6,6 +6,8 @@ use File::Spec qw(catfile);
use Term::ProgressBar::Quiet;
use Mojo::Util qw(getopt);
use Mojo::Collection 'c';
use Lstu::DB::URL;
use Lstu::DB::Ban;
has description => 'Checks all URLs in database against Google Safe Browsing database (local copy)';
has usage => sub { shift->extract_usage };
......@@ -56,7 +58,10 @@ sub run {
getopt \@args,
'u|url=s{1,}' => \my @urls_to_check,
's|seconds=i' => \my $delay;
's|seconds=i' => \my $delay,
'r|remove' => \my $remove,
'a|all' => \my $all,
'b|ban' => \my $ban;
if ($c->app->gsb) {
my $urls;
......@@ -77,7 +82,8 @@ sub run {
{ name => 'Scanning '.$urls->size.' URLs', count => $urls->size, ETA => 'linear' }
);
my (@bad, %bad_ips, @bad_from_ips);
my $gsb = $c->app->gsb;
my $gsb = $c->app->gsb;
my $deleted = 0;
$urls->each(sub {
my ($e, $num) = @_;
......@@ -88,23 +94,52 @@ sub run {
if (@matches) {
push @bad, $e->{short};
$bad_ips{$e->{created_by}} = 1 if $e->{created_by};
$deleted += Lstu::DB::URL->new(
app => $c->app,
short => $e->{short}
)->delete if $remove;
}
});
say sprintf('All URLs (%d) have been scanned.', $urls->size);
say sprintf('%d bad URLs detected.', scalar(@bad));
say sprintf("If you want to delete the detected bad URLs, please do:\n carton exec script/lstu url --remove %s", join(' ', @bad)) if @bad;
if ($remove) {
say sprintf('%d bad URLs deleted.', $deleted) if $deleted;
} else {
say sprintf("If you want to delete the detected bad URLs, please do:\n carton exec script/lstu url --remove %s", join(' ', @bad)) if @bad;
}
$deleted = 0;
for my $ip (keys %bad_ips) {
my $u = Lstu::DB::URL->new(app => $c->app)->search_creator($ip);
$u->each(sub {
my ($e, $num) = @_;
push @bad_from_ips, $e->{short};
$deleted += Lstu::DB::URL->new(
app => $c->app,
short => $e->{short}
)->delete if ($remove && $all);
});
}
say sprintf("Bad URLs creators' IP addresses: \n %s", join(", ", keys %bad_ips)) if (keys %bad_ips);
say sprintf("If you want to delete the URLs created by the same IPs than the detected bad URLs, please do:\n carton exec script/lstu url --remove %s", join(' ', @bad_from_ips)) if @bad_from_ips;
my @ips = keys %bad_ips;
say sprintf("Bad URLs creators' IP addresses: \n %s", join(", ", @ips)) if (@ips);
if ($ban) {
for my $ip (@ips) {
Lstu::DB::Ban->new(
app => $c->app,
ip => $ip
)->ban_ten_years;
}
say sprintf("%d banned IP addresses", scalar(@ips)) if (@ips);
}
if ($remove && $all) {
say sprintf('%d URLs from same IPs deleted.', $deleted) if $deleted;
} else {
say sprintf("If you want to delete the URLs created by the same IPs than the detected bad URLs, please do:\n carton exec script/lstu url --remove %s", join(' ', @bad_from_ips)) if @bad_from_ips;
}
} else {
say 'It seems that safebrowsing_api_key isn\'t set. Please, check your configuration';
}
......@@ -140,6 +175,11 @@ Lstu::Command::safebrowsing - Checks all URLs in database against Google Safe Br
carton exec script/lstu safebrowsingcheck -u|--url <short> <short> Checks the space-separated URLs against Google Safe Browsing database
carton exec script/lstu safebrowsingcheck -s|--seconds <xxx> Checks URLs created the last xxx seconds against Google Safe Browsing database
Options (available with all commands):
-r|--remove Remove bad URLs that have been found
-a|--all Remove all URLs created by the same IP addresses that created bad URLs (only in combination with the `-r|--remove` option)
-b|--ban Ban IP addresses that created bad URLs
=cut
1;
......@@ -96,6 +96,7 @@ Lstu::Command::theme - Create new theme skeleton.
Usage: script/lstu theme THEME_NAME
Your new theme will be available in the themes directory.
=cut
1;
......@@ -6,6 +6,7 @@ use Mojo::Collection 'c';
has 'ip';
has 'until';
has 'strike' => 0;
has 'record' => 0;
has 'app';
=head1 NAME
......@@ -191,6 +192,31 @@ Update the database record if one already exists, create one otherwise.
=back
=cut
sub increment_ban_delay {
my $c = shift;
my $penalty = shift;
my $until = time + $penalty;
my $h = {
strike => 1
};
if ($c->record) {
$c->app->dbi->db->query('UPDATE ban SET until = ?, strike = strike + 1 WHERE ip = ?', $until, $c->ip);
$h = $c->app->dbi->db->query('SELECT strike FROM ban WHERE ip = ?', $c->ip)->hashes->first;
} else {
$c->app->dbi->db->query('INSERT INTO ban (ip, until, strike) VALUES (?, ?, 1)', $c->ip, $until);
$c->record(1);
}
$c->strike($h->{strike});
$c->until($until);
return $c;
}
=head2 clear
=over 1
......@@ -215,6 +241,30 @@ sub clear {
$c->app->dbi->db->query('DELETE FROM ban WHERE until < ?', time);
}
=head2 unban
=over 1
=item B<Usage> : C<$c-E<gt>unban>
=item B<Arguments> : none
=item B<Purpose> : unban IP address
=item B<Returns> : the Lstu::DB::Ban object
=back
=cut
sub unban {
my $c = shift;
$c->app->dbi->db->query('DELETE from ban WHERE ip = ?', $c->ip);
return $c;
}
=head2 delete_all
=over 1
......@@ -237,6 +287,44 @@ sub delete_all {
$c->app->dbi->db->query('DELETE FROM ban');
}
=head2 ban_ten_years
=over 1
=item B<Usage> : C<$c-E<gt>ban_ten_years>
=item B<Arguments> : none
=item B<Purpose> : ban an IP address forever
=item B<Returns> : nothing is expected
=back
=cut
sub ban_ten_years {
my $c = shift;
my $until = time + 315360000;
my $h = {
strike => time
};
if ($c->record) {
$c->app->dbi->db->query('UPDATE ban SET until = ?, strike = ? WHERE ip = ?', $until, time, $c->ip);
$h = $c->app->dbi->db->query('SELECT strike FROM ban WHERE ip = ?', $c->ip)->hashes->first;
} else {
$c->app->dbi->db->query('INSERT INTO ban (ip, until, strike) VALUES (?, ?, 1)', $c->ip, $until);
$c->record(1);
}
$c->strike($h->{strike});
$c->until($until);
return $c;
}
=head2 _slurp
=over 1
......
......@@ -2,8 +2,6 @@
package Lstu::DB::Ban::MySQL;
use Mojo::Base 'Lstu::DB::Ban';
has 'record' => 0;
sub new {
my $c = shift;
......@@ -14,27 +12,4 @@ sub new {
return $c;
}
sub increment_ban_delay {
my $c = shift;
my $penalty = shift;
my $until = time + $penalty;
my $h = {
strike => 1
};
if ($c->record) {
$c->app->dbi->db->query('UPDATE ban SET until = ?, strike = strike + 1 WHERE ip = ?', $until, $c->ip);
$h = $c->app->dbi->db->query('SELECT strike FROM ban WHERE ip = ?', $c->ip)->hashes->first;
} else {
$c->app->dbi->db->query('INSERT INTO ban (ip, until, strike) VALUES (?, ?, 1)', $c->ip, $until);
$c->record(1);
}
$c->strike($h->{strike});
$c->until($until);
return $c;
}
1;
......@@ -2,8 +2,6 @@
package Lstu::DB::Ban::Pg;
use Mojo::Base 'Lstu::DB::Ban';
has 'record' => 0;
sub new {
my $c = shift;
......@@ -36,4 +34,25 @@ sub increment_ban_delay {
return $c;
}
sub ban_ten_years {
my $c = shift;
my $until = time + 315360000;
my $h = {
strike => time
};
if ($c->record) {
$h = $c->app->dbi->db->query('UPDATE ban SET until = ?, strike = ? WHERE ip = ? RETURNING strike', $until, time, $c->ip)->hashes->first;
} else {
$c->app->dbi->db->query('INSERT INTO ban (ip, until, strike) VALUES (?, ?, ?)', $c->ip, $until, time);
$c->record(1);
}
$c->strike($h->{strike});
$c->until($until);
return $c;
}
1;
......@@ -2,8 +2,6 @@
package Lstu::DB::Ban::SQLite;
use Mojo::Base 'Lstu::DB::Ban';
has 'record' => 0;
sub new {
my $c = shift;
......@@ -14,27 +12,4 @@ sub new {
return $c;
}
sub increment_ban_delay {
my $c = shift;
my $penalty = shift;
my $until = time + $penalty;
my $h = {
strike => 1
};
if ($c->record) {
$c->app->dbi->db->query('UPDATE ban SET until = ?, strike = strike + 1 WHERE ip = ?', $until, $c->ip)->hashes->first;
$h = $c->app->dbi->db->query('SELECT strike FROM ban WHERE ip = ?', $c->ip)->hashes->first;
} else {
$c->app->dbi->db->query('INSERT INTO ban (ip, until, strike) VALUES (?, ?, 1)', $c->ip, $until);
$c->record(1);
}
$c->strike($h->{strike});
$c->until($until);
return $c;
}
1;
......@@ -4,6 +4,7 @@ use Mojo::Base -base;
has 'token';
has 'until';
has 'record' => 0;
has 'app';
=head1 NAME
......@@ -103,6 +104,21 @@ sub to_hash {
=cut
sub delete {
my $c = shift;
$c->app->dbi->db->query('DELETE FROM sessions WHERE token = ?', $c->token);
my $h = $c->app->dbi->db->query('SELECT * FROM sessions WHERE token = ?', $c->token)->hashes;
if ($h->size) {
# We found the session, it hasn't been deleted
return 0;
} else {
$c = Lstu::DB::Session->new(app => $c->app);
# We didn't found the session, it has been deleted
return 1;
}
}
=head2 write
=over 1
......
......@@ -2,8 +2,6 @@
package Lstu::DB::Session::MySQL;
use Mojo::Base 'Lstu::DB::Session';
has 'record' => 0;
sub new {
my $c = shift;
......@@ -14,19 +12,4 @@ sub new {
return $c;
}
sub delete {
my $c = shift;
$c->app->dbi->db->query('DELETE FROM sessions WHERE token = ?', $c->token);
my $h = $c->app->dbi->db->query('SELECT * FROM sessions WHERE token = ?', $c->token)->hashes;
if ($h->size) {
# We found the session, it hasn't been deleted
return 0;
} else {
$c = Lstu::DB::Session->new(app => $c->app);
# We didn't found the session, it has been deleted
return 1;
}
}
1;
......@@ -2,8 +2,6 @@
package Lstu::DB::Session::Pg;
use Mojo::Base 'Lstu::DB::Session';
has 'record' => 0;
sub new {
my $c = shift;
......
......@@ -2,8 +2,6 @@
package Lstu::DB::Session::SQLite;
use Mojo::Base 'Lstu::DB::Session';
has 'record' => 0;
sub new {
my $c = shift;
......@@ -14,19 +12,4 @@ sub new {
return $c;
}
sub delete {
my $c = shift;
$c->app->dbi->db->query('DELETE FROM sessions WHERE token = ?', $c->token);
my $h = $c->app->dbi->db->query('SELECT * FROM sessions WHERE token = ?', $c->token)->hashes;
if ($h->size) {
# We found the session, it hasn't been deleted
return 0;
} else {
$c = Lstu::DB::Session->new(app => $c->app);
# We didn't found the session, it has been deleted
return 1;
}
}
1;
......@@ -7,6 +7,7 @@ has 'url';
has 'counter' => 0;
has 'timestamp';
has 'created_by';
has 'record' => 0;
has 'app';
=head1 NAME
......@@ -106,6 +107,18 @@ sub to_hash {
=back
=cut
sub increment_counter {
my $c = shift;
$c->app->dbi->db->query('UPDATE lstu SET counter = counter + 1 WHERE short = ?', $c->short);
my $h = $c->app->dbi->db->query('SELECT counter FROM lstu WHERE short = ?', $c->short)->hashes->first;
$c->counter($h->{counter});
return $c;
}
=head2 write
=over 1
......@@ -149,6 +162,23 @@ sub write {
=back
=cut
sub delete {
my $c = shift;
$c->app->dbi->db->query('DELETE FROM lstu WHERE short = ?', $c->short);
my $h = $c->app->dbi->db->query('SELECT * FROM lstu WHERE short = ?', $c->short)->hashes;
if ($h->size) {
# We found the URL, it hasn't been deleted
return 0;
} else {
$c = Lstu::DB::URL->new(app => $c->app);
# We didn't found the URL, it has been deleted
return 1;
}
}
=head2 exist
=over 1
......
......@@ -2,8 +2,6 @@
package Lstu::DB::URL::MySQL;
use Mojo::Base 'Lstu::DB::URL';
has 'record' => 0;
sub new {
my $c = shift;
......@@ -14,29 +12,4 @@ sub new {
return $c;
}
sub increment_counter {
my $c = shift;
$c->app->dbi->db->query('UPDATE lstu SET counter = counter + 1 WHERE short = ?', $c->short);
my $h = $c->app->dbi->db->query('SELECT counter FROM lstu WHERE short = ?', $c->short)->hashes->first;
$c->counter($h->{counter});
return $c;
}
sub delete {
my $c = shift;
$c->app->dbi->db->query('DELETE FROM lstu WHERE short = ?', $c->short);
my $h = $c->app->dbi->db->query('SELECT * FROM lstu WHERE short = ?', $c->short)->hashes;
if ($h->size) {
# We found the URL, it hasn't been deleted
return 0;
} else {
$c = Lstu::DB::URL->new(app => $c->app);
# We didn't found the URL, it has been deleted
return 1;
}
}
1;
......@@ -2,8 +2,6 @@
package Lstu::DB::URL::Pg;
use Mojo::Base 'Lstu::DB::URL';
has 'record' => 0;
sub new {
my $c = shift;
......
......@@ -2,8 +2,6 @@
package Lstu::DB::URL::SQLite;
use Mojo::Base 'Lstu::DB::URL';
has 'record' => 0;