Commit ac6000f4 authored by Luc Didry's avatar Luc Didry

Add a database abstraction layer.

Related to #9
parent d2d445c6
Pipeline #10684 passed with stage
in 5 minutes and 26 seconds
......@@ -30,6 +30,32 @@ DISTRIBUTIONS
ExtUtils::MakeMaker 6.42
Test::More 0
perl 5.005
CPAN-Meta-2.150010
pathname: D/DA/DAGOLDEN/CPAN-Meta-2.150010.tar.gz
provides:
CPAN::Meta 2.150010
CPAN::Meta::Converter 2.150010
CPAN::Meta::Feature 2.150010
CPAN::Meta::History 2.150010
CPAN::Meta::Merge 2.150010
CPAN::Meta::Prereqs 2.150010
CPAN::Meta::Spec 2.150010
CPAN::Meta::Validator 2.150010
Parse::CPAN::Meta 2.150010
requirements:
CPAN::Meta::Requirements 2.121
CPAN::Meta::YAML 0.011
Carp 0
Encode 0
Exporter 0
ExtUtils::MakeMaker 6.17
File::Spec 0.80
JSON::PP 2.27300
Scalar::Util 0
perl 5.008001
strict 0
version 0.88
warnings 0
Convert-ASN1-0.27
pathname: G/GB/GBARR/Convert-ASN1-0.27.tar.gz
provides:
......@@ -381,37 +407,28 @@ DISTRIBUTIONS
Encode 2.10
Exporter 5.57
ExtUtils::MakeMaker 6.30
IO-Socket-INET6-2.72
pathname: S/SH/SHLOMIF/IO-Socket-INET6-2.72.tar.gz
IO-Socket-IP-0.38
pathname: P/PE/PEVANS/IO-Socket-IP-0.38.tar.gz
provides:
IO::Socket::INET6 2.72
IO::Socket::IP 0.38
requirements:
Carp 0
Errno 0
Exporter 0
IO::Socket 0
Module::Build 0.36
Socket 0
Socket6 0.12
Test::More 0
perl 5.008
strict 0
warnings 0
IO-Socket-SSL-2.040
pathname: S/SU/SULLR/IO-Socket-SSL-2.040.tar.gz
Socket 1.97
Test::More 0.88
IO-Socket-SSL-2.043
pathname: S/SU/SULLR/IO-Socket-SSL-2.043.tar.gz
provides:
IO::Socket::SSL 2.040
IO::Socket::SSL 2.043
IO::Socket::SSL::Intercept 2.014
IO::Socket::SSL::OCSP_Cache 2.040
IO::Socket::SSL::OCSP_Resolver 2.040
IO::Socket::SSL::OCSP_Cache 2.043
IO::Socket::SSL::OCSP_Resolver 2.043
IO::Socket::SSL::PublicSuffix undef
IO::Socket::SSL::SSL_Context 2.040
IO::Socket::SSL::SSL_HANDLE 2.040
IO::Socket::SSL::Session_Cache 2.040
IO::Socket::SSL::SSL_Context 2.043
IO::Socket::SSL::SSL_HANDLE 2.043
IO::Socket::SSL::Session_Cache 2.043
IO::Socket::SSL::Utils 2.014
requirements:
ExtUtils::MakeMaker 0
Mozilla::CA 0
Net::SSLeay 1.46
Scalar::Util 0
IPC-Run3-0.048
......@@ -431,6 +448,15 @@ DISTRIBUTIONS
requirements:
ExtUtils::MakeMaker 0
Test::More 0
JSON-PP-2.27400
pathname: M/MA/MAKAMAKA/JSON-PP-2.27400.tar.gz
provides:
JSON::PP 2.27400
JSON::PP::Boolean 2.27400
JSON::PP::IncrParser 2.27400
requirements:
ExtUtils::MakeMaker 0
Test::More 0
LWP-MediaTypes-6.02
pathname: G/GA/GAAS/LWP-MediaTypes-6.02.tar.gz
provides:
......@@ -481,7 +507,6 @@ DISTRIBUTIONS
requirements:
ExtUtils::MakeMaker 0
Mojolicious 6.0
perl 5.010001
Minion-Backend-SQLite-0.009
pathname: D/DB/DBOOK/Minion-Backend-SQLite-0.009.tar.gz
provides:
......@@ -591,8 +616,8 @@ DISTRIBUTIONS
URI::db 0.15
URI::file 4.21
perl 5.010001
Mojolicious-7.13
pathname: S/SR/SRI/Mojolicious-7.13.tar.gz
Mojolicious-7.18
pathname: S/SR/SRI/Mojolicious-7.18.tar.gz
provides:
Mojo undef
Mojo::Asset undef
......@@ -614,6 +639,7 @@ DISTRIBUTIONS
Mojo::Date undef
Mojo::EventEmitter undef
Mojo::Exception undef
Mojo::File undef
Mojo::Headers undef
Mojo::HelloWorld undef
Mojo::Home undef
......@@ -656,7 +682,7 @@ DISTRIBUTIONS
Mojo::UserAgent::Transactor undef
Mojo::Util undef
Mojo::WebSocket undef
Mojolicious 7.13
Mojolicious 7.18
Mojolicious::Command undef
Mojolicious::Command::cgi undef
Mojolicious::Command::cpanify undef
......@@ -707,7 +733,6 @@ DISTRIBUTIONS
JSON::PP 2.27103
Pod::Simple 3.09
Time::Local 1.2
perl 5.010001
Mojolicious-Plugin-Authentication-1.29
pathname: M/MA/MADCAT/Mojolicious-Plugin-Authentication-1.29.tar.gz
provides:
......@@ -743,14 +768,6 @@ DISTRIBUTIONS
Mojolicious 4.88
Test::More 0
perl 5.010001
Mozilla-CA-20160104
pathname: A/AB/ABH/Mozilla-CA-20160104.tar.gz
provides:
Mozilla::CA 20160104
requirements:
ExtUtils::MakeMaker 0
Test 0
perl 5.006
Net-Abuse-Utils-Spamhaus-0.09
pathname: S/SA/SAXJAZMAN/net/Net-Abuse-Utils-Spamhaus-0.09.tar.gz
provides:
......@@ -856,7 +873,6 @@ DISTRIBUTIONS
File::Spec 0.86
IO::Socket 1.16
IO::Socket::INET 1.25
IO::Socket::INET6 2.01
IO::Socket::IP 0.29
MIME::Base64 2.11
Test::More 0.52
......@@ -948,12 +964,6 @@ DISTRIBUTIONS
ExtUtils::MakeMaker 6.30
File::Spec 0
strict 0
Socket6-0.28
pathname: U/UM/UMEMOTO/Socket6-0.28.tar.gz
provides:
Socket6 0.28
requirements:
ExtUtils::MakeMaker 0
Test-Script-1.10
pathname: P/PL/PLICEASE/Test-Script-1.10.tar.gz
provides:
......@@ -1105,6 +1115,15 @@ DISTRIBUTIONS
Fcntl 0
URI 1.10
perl 5.008001
XML-SAX-Base-1.08
pathname: G/GR/GRANTM/XML-SAX-Base-1.08.tar.gz
provides:
XML::SAX::Base 1.08
XML::SAX::Base::NoHandler 1.08
XML::SAX::Exception 1.08
requirements:
ExtUtils::MakeMaker 6.31
Test::More 0.88
libwww-perl-6.15
pathname: E/ET/ETHER/libwww-perl-6.15.tar.gz
provides:
......@@ -1233,7 +1252,6 @@ DISTRIBUTIONS
HTTP::Response 0
HTTP::Status 0
IO::File 0
IO::Socket::INET6 0
IO::Socket::SSL 1.26
JSON 0
LWP 0
......@@ -1244,4 +1262,5 @@ DISTRIBUTIONS
Text::Soundex 0
Time::Local 0
URI::ldap 1.1
XML::SAX::Base 0
perl 5.008001
# vim:set sw=4 ts=4 sts=4 ft=perl expandtab:
package Lstu;
use Mojo::Base 'Mojolicious';
use LstuModel;
use Data::Validate::URI qw(is_http_uri is_https_uri);
use Mojo::JSON qw(to_json decode_json);
use Mojo::URL;
use Net::Abuse::Utils::Spamhaus qw(check_fqdn);
use Net::LDAP;
use Apache::Htpasswd;
use Lstu::DB::URL;
use Lstu::DB::Ban;
use Lstu::DB::Session;
$ENV{MOJO_REVERSE_PROXY} = 1;
......@@ -29,6 +31,7 @@ sub startup {
db_path => 'minion.db'
},
session_duration => 3600,
dbtype => 'sqlite',
}
});
......@@ -40,15 +43,15 @@ sub startup {
shift @{$self->renderer->paths};
shift @{$self->static->paths};
if ($config->{theme} ne 'default') {
my $theme = $self->home->rel_dir('themes/'.$config->{theme});
my $theme = $self->home->rel_file('themes/'.$config->{theme});
push @{$self->renderer->paths}, $theme.'/templates' if -d $theme.'/templates';
push @{$self->static->paths}, $theme.'/public' if -d $theme.'/public';
}
push @{$self->renderer->paths}, $self->home->rel_dir('themes/default/templates');
push @{$self->static->paths}, $self->home->rel_dir('themes/default/public');
push @{$self->renderer->paths}, $self->home->rel_file('themes/default/templates');
push @{$self->static->paths}, $self->home->rel_file('themes/default/public');
# Internationalization
my $lib = $self->home->rel_dir('themes/'.$config->{theme}.'/lib');
my $lib = $self->home->rel_file('themes/'.$config->{theme}.'/lib');
eval qq(use lib "$lib");
$self->plugin('I18N');
......@@ -128,10 +131,7 @@ sub startup {
$self->plugin('Minion' => { SQLite => 'sqlite:'.$config->{minion}->{db_path} });
}
# Schema updates
LstuModel->do('CREATE TABLE IF NOT EXISTS sessions (token TEXT PRIMARY KEY, until INTEGER)');
LstuModel->do('CREATE TABLE IF NOT EXISTS ban (ip TEXT PRIMARY KEY, until INTEGER, strike INTEGER)');
# Secrets
$self->secrets($config->{secret});
# Helpers
......@@ -168,19 +168,15 @@ sub startup {
my $c = shift;
# Create some short patterns for provisioning
if (LstuModel::Lstu->count('WHERE url IS NULL') < $c->config('provisioning')) {
my $db_url = Lstu::DB::URL->new(dbtype => $c->config('dbtype'));
if ($db_url->count_empty < $c->config('provisioning')) {
for (my $i = 0; $i < $c->config('provis_step'); $i++) {
if (LstuModel->begin) {
my $short;
do {
$short= $c->shortener($c->config('length'));
} while (LstuModel::Lstu->count('WHERE short = ?', $short));
LstuModel::Lstu->create(
short => $short
);
LstuModel->commit;
}
my $short;
do {
$short= $c->shortener($c->config('length'));
} while ($db_url->exist($short));
$db_url->short($short)->write;
}
}
}
......@@ -248,9 +244,9 @@ sub startup {
my $c = shift;
# Delete old sessions
LstuModel::Sessions->delete_where('until < ?', time);
Lstu::DB::Session->new(dbtype => $c->config('dbtype'))->clear();
# Delete old bans
LstuModel::Ban->delete_where('until < ?', time);
Lstu::DB::Ban->new(dbtype => $c->config('dbtype'))->clear();
}
);
......@@ -294,10 +290,10 @@ sub startup {
my $short = shift;
my $url = shift;
my @urls = LstuModel::Lstu->select('WHERE short = ?', $short);
if (scalar(@urls)) {
$urls[0]->update(counter => $urls[0]->counter + 1);
}
my $db_url = Lstu::DB::URL->new(
dbtype => $job->app->config('dbtype'),
short => $short
)->increment_counter;
my $piwik = $job->app->config('piwik');
if (defined($piwik) && $piwik->{idsite} && $piwik->{url}) {
......
......@@ -2,7 +2,9 @@
package Lstu::Controller::Admin;
use Digest::SHA qw(sha256_hex);
use Mojo::Base 'Mojolicious::Controller';
use LstuModel;
use Lstu::DB::URL;
use Lstu::DB::Ban;
use Lstu::DB::Session;
sub login {
my $c = shift;
......@@ -13,16 +15,17 @@ sub login {
my $ip = $c->ip;
my @banned = LstuModel::Ban->select('WHERE ip = ? AND until > ? AND strike >= ?', $ip, time, $c->config('ban_min_strike'));
if (scalar @banned) {
my $banned = Lstu::DB::Ban->new(
dbtype => $c->config('dbtype'),
ip => $ip
)->is_banned($c->config('ban_min_strike'));
if (defined $banned) {
my $penalty = 3600;
if ($banned[0]->strike >= 2 * $c->config('ban_min_strike')) {
if ($banned->strike >= 2 * $c->config('ban_min_strike')) {
$penalty = 3600 * 24 * 30; # 30 days of banishing
}
$banned[0]->update(
strike => $banned[0]->strike + 1,
until => time + $penalty
);
$banned->increment_ban_delay($penalty);
$c->flash('msg' => $c->l('Too many bad passwords. You\'re banned.'));
$c->flash('banned' => 1);
$c->redirect_to('stats');
......@@ -33,31 +36,27 @@ sub login {
) {
my $token = $c->shortener(32);
LstuModel::Sessions->create(
token => $token,
until => time + 3600
);
Lstu::DB::Session->new(
dbtype => $c->config('dbtype'),
token => $token,
until => time + 3600
)->write;
$c->session('token' => $token);
$c->redirect_to('stats');
} elsif (defined($act) && $act eq 'logout') {
LstuModel::Sessions->delete_where('token = ?', $c->session->{token});
Lstu::DB::Session->new(
dbtype => $c->config('dbtype'),
token => $c->session('token')
)->delete;
delete $c->session->{token};
$c->redirect_to('stats');
} else {
my @bans = LstuModel::Ban->select('WHERE ip = ?', $ip);
Lstu::DB::Ban->new(
dbtype => $c->config('dbtype'),
ip => $ip
)->increment_ban_delay(3600);
if (scalar @bans) {
$bans[0]->update(
strike => $bans[0]->strike + 1,
until => time + 3600
);
} else {
LstuModel::Ban->create(
ip => $ip,
strike => 1,
until => time + 3600
);
}
$c->flash('msg' => $c->l('Bad password'));
$c->redirect_to('stats');
}
......@@ -65,13 +64,20 @@ sub login {
}
sub delete {
my $c = shift;
my $c = shift;
my $short = $c->param('short');
if (defined($c->session('token')) && LstuModel::Sessions->count('WHERE token = ?', $c->session('token'))) {
my @urls = LstuModel::Lstu->select('WHERE short = ?', $short);
if (scalar(@urls)) {
my $deleted = LstuModel::Lstu->delete_where('short = ?', $short);
my $db_session = Lstu::DB::Session->new(
dbtype => $c->config('dbtype'),
token => $c->session('token')
);
if (defined($c->session('token')) && $db_session->is_valid) {
my $db_url = Lstu::DB::URL->new(
dbtype => $c->config('dbtype'),
short => $short
);
if ($db_url->url) {
my $deleted = $db_url->delete;
$c->respond_to(
json => { json => { success => Mojo::JSON->true, deleted => $deleted } },
any => sub {
......
# vim:set sw=4 ts=4 sts=4 ft=perl expandtab:
package Lstu::Controller::Lstu;
use Mojo::Base 'Mojolicious::Controller';
use LstuModel;
use Lstu::DB::URL;
use Lstu::DB::Ban;
use Lstu::DB::Session;
use Data::Validate::URI qw(is_http_uri is_https_uri);
use Mojo::JSON qw(to_json decode_json);
use Mojo::URL;
......@@ -14,16 +16,17 @@ sub add {
if ((!defined($c->config('ldap')) && !defined($c->config('htpasswd'))) || $c->is_user_authenticated) {
my $ip = $c->ip;
my @banned = LstuModel::Ban->select('WHERE ip = ? AND until > ? AND strike >= ?', $ip, time, $c->config('ban_min_strike'));
if (scalar @banned) {
my $banned = Lstu::DB::Ban->new(
dbtype => $c->config('dbtype'),
ip => $c->ip
)->is_banned($c->config('ban_min_strike'));
if (defined $banned) {
my $penalty = 3600;
if ($banned[0]->strike >= 2 * $c->config('ban_min_strike')) {
if ($banned->strike >= 2 * $c->config('ban_min_strike')) {
$penalty = 3600 * 24 * 30; # 30 days of banishing
}
$banned[0]->update(
strike => $banned[0]->strike + 1,
until => time + $penalty
);
$banned->increment_ban_delay($penalty);
my $msg = $c->l('You asked to shorten too many URLs too quickly. You\'re banned for %1 hour(s).', $penalty/3600);
$c->respond_to(
json => { json => { success => Mojo::JSON->false, msg => $msg } },
......@@ -49,59 +52,45 @@ sub add {
$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) && LstuModel::Lstu->count('WHERE short = ?', $custom_url) > 0) {
} elsif (defined($custom_url) && Lstu::DB::URL->new()->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)) {
my $res = $c->is_spam($url, 0);
if ($res->{is_spam}) {
$msg = $res->{msg};
} else {
my @records = LstuModel::Lstu->select('WHERE url = ?', $url);
my $db_url = Lstu::DB::URL->new(
dbtype => $c->config('dbtype'),
url => $url
);
my @bans = LstuModel::Ban->select('WHERE ip = ?', $ip);
if (scalar @bans) {
$bans[0]->update(
strike => $bans[0]->strike + 1,
until => time + 1
);
} else {
LstuModel::Ban->create(
ip => $ip,
strike => 1,
until => time + 1
);
}
Lstu::DB::Ban->new(
dbtype => $c->config('dbtype'),
ip => $ip
)->increment_ban_delay(1);
if (scalar(@records) && !defined($custom_url)) {
if ($db_url->short && !defined($custom_url)) {
# Already got this URL
$short = $records[0]->short;
$short = $db_url->short;
} else {
if(LstuModel->begin) {
if (defined($custom_url)) {
LstuModel::Lstu->create(
short => $custom_url,
url => $url,
counter => 0,
timestamp => time()
);
if (defined($custom_url)) {
Lstu::DB::URL->new(
short => $custom_url,
url => $url,
timestamp => time()
)->write;
$short = $custom_url;
} else {
@records = LstuModel::Lstu->select('WHERE url IS NULL LIMIT 1');
if (scalar(@records)) {
$records[0]->update(
url => $url,
counter => 0,
timestamp => time()
);
$short = $custom_url;
} else {
$db_url = Lstu::DB::URL->new(dbtype => $c->config('dbtype'))->choose_empty;
if (defined $db_url) {
$db_url->url($url)->timestamp(time)->write;
$short = $records[0]->short;
} else {
# Houston, we have a problem
$msg = $c->l('No shortened URL available. Please retry or contact the administrator at %1. Your URL to shorten: [_2]', $c->config('contact'), $url);
}
$short = $db_url->short;
} else {
# Houston, we have a problem
$msg = $c->l('No shortened URL available. Please retry or contact the administrator at %1. Your URL to shorten: [_2]', $c->config('contact'), $url);
}
LstuModel->commit;
}
}
}
......@@ -152,15 +141,21 @@ sub add {
sub stats {
my $c = shift;
if ((!defined($c->config('ldap')) && !defined($c->config('htpasswd'))) || $c->is_user_authenticated) {
if (defined($c->session('token')) && LstuModel::Sessions->count('WHERE token = ?', $c->session('token'))) {
my $total = LstuModel::Lstu->count("WHERE url IS NOT NULL");
my $db_session = Lstu::DB::Session->new(
dbtype => $c->config('dbtype'),
token => $c->session('token')
);
if (defined($c->session('token')) && $db_session->is_valid) {
my $total = Lstu::DB::URL->new(dbtype => $c->config('dbtype'))->total;
my $page = $c->param('page') || 0;
$page = 0 if ($page < 0);
$page = $page - 1 if ($page * $c->config('page_offset') > $total);
my ($first, $last) = (!$page, ($page * $c->config('page_offset') <= $total && $total < ($page + 1) * $c->config('page_offset')));
my @urls = LstuModel::Lstu->select("WHERE url IS NOT NULL ORDER BY counter DESC LIMIT ? offset ?", $c->config('page_offset'), $page * $c->config('page_offset'));
my @urls = Lstu::DB::URL->new(
dbtype => $c->config('dbtype'),
)->paginate($page, $c->config('page_offset'));
$c->respond_to(
json => sub {
my $c = shift;
......@@ -193,8 +188,9 @@ sub stats {
} else {
my $u = (defined($c->cookie('url'))) ? decode_json $c->cookie('url') : [];
my $p = join ",", (('?') x @{$u});
my @urls = LstuModel::Lstu->select("WHERE short IN ($p) ORDER BY counter DESC", @{$u});
my @urls = Lstu::DB::URL->new(
dbtype => $c->config('dbtype'),
)->get_a_lot($u);
my $prefix = $c->prefix;
......@@ -229,14 +225,15 @@ sub get {
my $c = shift;
my $short = $c->param('short');
my ($url, @urls);
my ($url, $db_url);
if (defined $c->cache->{$short}) {
$url = $c->cache->{$short}->{url};
} else {
@urls = LstuModel::Lstu->select('WHERE short = ?', $short);
if (scalar(@urls)) {
$url = $urls[0]->url;
}
$db_url = Lstu::DB::URL->new(
dbtype => $c->config('dbtype'),
short => $short
);
$url = $db_url->url;
}
if ($url) {
$c->respond_to(
......@@ -249,7 +246,6 @@ sub get {
);
# Update counter
$c->on(finish => sub {
@urls = LstuModel::Lstu->select('WHERE short = ?', $short) if (defined $c->cache->{$short});
$c->cache->{$short} = {
last_used => time,
url => $url
......@@ -258,8 +254,12 @@ sub get {
if ($c->config('minion')->{enabled} && $c->config('minion')->{db_path}) {
$c->app->minion->enqueue(increase_counter => [$short, $c->{url}]);
} else {
my $counter = $urls[0]->counter + 1;
$urls[0]->update(counter => $counter);
$db_url = Lstu::DB::URL->new(
dbtype => $c->config('dbtype'),
short => $short
) if (defined $c->cache->{$short});
$db_url->increment_counter;
my $piwik = $c->config('piwik');
if (defined($piwik) && $piwik->{idsite} && $piwik->{url}) {
......
# vim:set sw=4 ts=4 sts=4 ft=perl expandtab:
package Lstu::DB::Ban;
use Mojo::Base -base;
has 'ip';
has 'until';
has 'strike' => 0;
has 'dbtype';
sub new {
my $c = shift;
$c = $c->SUPER::new(@_);
if (ref($c) eq 'Lstu::DB::Ban') {
if ($c->dbtype eq 'sqlite') {
use Lstu::DB::Ban::SQLite;
$c = Lstu::DB::Ban::SQLite->new(@_);
}
}
return $c;
}
sub to_hash {
my $c = shift;
return {
ip => $c->ip,
until => $c->until,
strike => $c->strike
};
}
1;
# vim:set sw=4 ts=4 sts=4 ft=perl expandtab:
package Lstu::DB::Ban::SQLite;
use Mojo::Base 'Lstu::DB::Ban';
use Lstu::DB::SQLite;
has 'record';
sub new {
my $c = shift;
$c = $c->SUPER::new(@_);
$c = $c->_slurp if ($c->ip);
return $c;
}
sub clear {
my $c = shift;
Lstu::DB::SQLite::Ban->delete_where('until < ?', time);
}
sub delete_all {
my $c = shift;
# Rotten syntax, but prevents "Static Lstu::DB::SQLite->delete has been deprecated"
Lstu::DB::SQLite::Ban->delete_where('1 = 1');
}
sub is_banned {
my $c = shift;
my $ban_min_strike = shift;
my @banned = Lstu::DB::SQLite::Ban->select('WHERE ip = ? AND until > ? AND strike >= ?', $c->ip, time, $ban_min_strike);
if (scalar @banned) {
$c->record($banned[0]);
$c->until($banned[0]->until);
$c->strike($banned[0]->strike);
return $c;
} else {
return undef;
}
}
sub increment_ban_delay {
my $c = shift;
my $penalty = shift;
my $until = time + $penalty;
if (defined $c->record) {
$c->record->update(
strike => $c->strike + 1,
until => $until
);
} else {
my $record = Lstu::DB::SQLite::Ban->create(
ip => $c->ip,
strike => 1,
until => $until
);
$c->record($record);
}
$c->strike($c->strike + 1);
$c->until($until);