mirror of
https://github.com/webmin/webmin.git
synced 2026-02-03 14:13:29 +00:00
660 lines
17 KiB
Perl
660 lines
17 KiB
Perl
# Functions for configuring the fail2ban log analyser
|
|
|
|
BEGIN { push(@INC, ".."); };
|
|
use strict;
|
|
use warnings;
|
|
no warnings 'redefine';
|
|
no warnings 'uninitialized';
|
|
use WebminCore;
|
|
&init_config();
|
|
our ($module_root_directory, %text, %config, %gconfig, $base_remote_user);
|
|
our %access = &get_module_acl();
|
|
our @all_files_for_lock;
|
|
|
|
# check_fail2ban()
|
|
# Returns undef if installed, or an appropriate error message if missing
|
|
sub check_fail2ban
|
|
{
|
|
-d $config{'config_dir'} || return &text('check_edir',
|
|
"<tt>$config{'config_dir'}</tt>");
|
|
-r "$config{'config_dir'}/fail2ban.conf" ||
|
|
return &text('check_econf', "<tt>$config{'config_dir'}</tt>",
|
|
"<tt>fail2ban.conf</tt>");
|
|
&has_command($config{'client_cmd'}) ||
|
|
return &text('check_eclient', "<tt>$config{'client_cmd'}</tt>");
|
|
&has_command($config{'server_cmd'}) ||
|
|
return &text('check_eserver', "<tt>$config{'server_cmd'}</tt>");
|
|
return undef;
|
|
}
|
|
|
|
sub is_fail2ban_running
|
|
{
|
|
my ($pid) = &find_byname($config{'server_cmd'});
|
|
if (!$pid) {
|
|
($pid) = &find_byname("fail2ban-server");
|
|
}
|
|
return $pid;
|
|
}
|
|
|
|
# list_filters()
|
|
# Returns a list of all defined filter files, each of which contains multiple
|
|
# sections like [Definition]
|
|
sub list_filters
|
|
{
|
|
my $dir = "$config{'config_dir'}/filter.d";
|
|
my @rv;
|
|
foreach my $f (glob("$dir/*.conf")) {
|
|
my @conf = &parse_config_file($f);
|
|
my @lconf = &parse_config_file(&make_local_file($f));
|
|
&merge_local_files(\@conf, \@lconf);
|
|
if (@conf) {
|
|
push(@rv, \@conf);
|
|
}
|
|
}
|
|
return @rv;
|
|
}
|
|
|
|
# list_actions()
|
|
# Returns a list of all defined action files, each of which contains multiple
|
|
# sections like [Definition] and [Init]
|
|
sub list_actions
|
|
{
|
|
my $dir = "$config{'config_dir'}/action.d";
|
|
my @rv;
|
|
foreach my $f (glob("$dir/*.conf")) {
|
|
my @conf = &parse_config_file($f);
|
|
my @lconf = &parse_config_file(&make_local_file($f));
|
|
&merge_local_files(\@conf, \@lconf);
|
|
if (@conf) {
|
|
push(@rv, \@conf);
|
|
}
|
|
}
|
|
return @rv;
|
|
}
|
|
|
|
# list_jails()
|
|
# Returns a list of all sections from the jails file
|
|
sub list_jails
|
|
{
|
|
# Read the main config file
|
|
my @rv;
|
|
my $jfile = "$config{'config_dir'}/jail.conf";
|
|
if (-r $jfile) {
|
|
push(@rv, &parse_config_file($jfile));
|
|
}
|
|
|
|
# Read separate config files under jail.d
|
|
my $jdir = "$config{'config_dir'}/jail.d";
|
|
if (-d $jdir) {
|
|
foreach my $f (glob("$jdir/*.conf")) {
|
|
push(@rv, &parse_config_file($f));
|
|
}
|
|
}
|
|
|
|
# Read the main local file, and separate files under jail.d
|
|
my @lrv;
|
|
my $jlfile = &make_local_file($jfile);
|
|
if (-r $jlfile) {
|
|
push(@lrv, &parse_config_file($jlfile));
|
|
}
|
|
if (-d $jdir) {
|
|
foreach my $f (glob("$jdir/*.local")) {
|
|
push(@lrv, &parse_config_file($f));
|
|
}
|
|
}
|
|
|
|
# Use local file entries to override the global config
|
|
&merge_local_files(\@rv, \@lrv);
|
|
|
|
return @rv;
|
|
}
|
|
|
|
# merge_local_files(&rv, &locals)
|
|
# Merges .local file entries in with .conf files
|
|
sub merge_local_files
|
|
{
|
|
my ($rv, $lrv) = @_;
|
|
foreach my $l (@$lrv) {
|
|
my ($r) = grep { $_->{'name'} eq $l->{'name'} } @$rv;
|
|
if ($r) {
|
|
# Section exists in the global config, so put the local
|
|
# directives first
|
|
my $m = { %$l };
|
|
$m->{'local'} = 1;
|
|
$m->{'origfile'} = $r->{'file'};
|
|
push(@{$m->{'members'}}, @{$r->{'members'}});
|
|
$rv->[&indexof($r, @$rv)] = $m;
|
|
}
|
|
else {
|
|
# Section does not exist, so just add it
|
|
push(@$rv, $l);
|
|
}
|
|
}
|
|
}
|
|
|
|
# make_local_file(path)
|
|
sub make_local_file
|
|
{
|
|
my ($f) = @_;
|
|
$f =~ s/\.conf$/\.local/g;
|
|
return $f;
|
|
}
|
|
|
|
# get_config()
|
|
# Returns the global config as an array ref of directives
|
|
sub get_config
|
|
{
|
|
my $file = "$config{'config_dir'}/fail2ban.conf";
|
|
my @conf = &parse_config_file($file);
|
|
my @lconf = &parse_config_file(&make_local_file($file));
|
|
&merge_local_files(\@conf, \@lconf);
|
|
return \@conf;
|
|
}
|
|
|
|
# parse_config_file(file)
|
|
# Parses one file into a list of [] sections, each with multiple directives
|
|
sub parse_config_file
|
|
{
|
|
my ($file) = @_;
|
|
my $lref = &read_file_lines($file, 1);
|
|
my $lnum = 0;
|
|
my $fh = "CONF";
|
|
my $sect;
|
|
my @rv;
|
|
&open_readfile($fh, $file) || return ( );
|
|
while(<$fh>) {
|
|
s/\r|\n//g;
|
|
s/^\s*#.*$//;
|
|
s/^\s;.*$//;
|
|
if (/^\[([^\]]+)\]/) {
|
|
# Start of a section
|
|
$sect = { 'name' => $1,
|
|
'line' => $lnum,
|
|
'eline' => $lnum,
|
|
'file' => $file,
|
|
'members' => [] };
|
|
push(@rv, $sect);
|
|
}
|
|
elsif (/^(\S+)\s*=\s*(.*)/ && $sect) {
|
|
# A directive in a section
|
|
my $dir = { 'name' => $1,
|
|
'value' => $2,
|
|
'line' => $lnum,
|
|
'eline' => $lnum,
|
|
'file' => $file,
|
|
};
|
|
push(@{$sect->{'members'}}, $dir);
|
|
$sect->{'eline'} = $lnum;
|
|
&split_directive_values($dir);
|
|
}
|
|
elsif (/^\s+(\S.*)/ && $sect && @{$sect->{'members'}}) {
|
|
# Continuation of a directive
|
|
my $dir = $sect->{'members'}->[@{$sect->{'members'}} - 1];
|
|
$dir->{'value'} .= "\n".$1;
|
|
$dir->{'eline'} = $lnum;
|
|
$sect->{'eline'} = $lnum;
|
|
&split_directive_values($dir);
|
|
}
|
|
$lnum++;
|
|
}
|
|
close($fh);
|
|
return @rv;
|
|
}
|
|
|
|
# split_directive_values(&dir)
|
|
# Populate the 'values' field by splitting up the 'value' field
|
|
sub split_directive_values
|
|
{
|
|
my ($dir) = @_;
|
|
my @w;
|
|
my $v = $dir->{'value'};
|
|
$v =~ s/\n/ /g;
|
|
while($v =~ /\S/) {
|
|
if ($v =~ /^([^\[]+\[[^\]]+\])\s*(.*)/) {
|
|
push(@w, $1);
|
|
$v = $2;
|
|
}
|
|
elsif ($v =~ /^\s*(\S+)\s*(.*)/) {
|
|
push(@w, $1);
|
|
$v = $2;
|
|
}
|
|
}
|
|
$dir->{'words'} = \@w;
|
|
}
|
|
|
|
# create_section(file, §ion)
|
|
# Add a new section to a file
|
|
sub create_section
|
|
{
|
|
my ($file, $sect) = @_;
|
|
my $lref = &read_file_lines($file);
|
|
$sect->{'file'} = $file;
|
|
$sect->{'line'} = scalar(@$lref);
|
|
push(@$lref, §ion_lines($sect));
|
|
$sect->{'eline'} = scalar(@$lref);
|
|
&flush_file_lines($file);
|
|
}
|
|
|
|
# modify_section(file, §ion)
|
|
# Update the first line (only) for some section
|
|
sub modify_section
|
|
{
|
|
my ($file, $sect) = @_;
|
|
my $lref = &read_file_lines($file);
|
|
my @lines = §ion_lines($sect);
|
|
$lref->[$sect->{'line'}] = $lines[0];
|
|
&flush_file_lines($file);
|
|
}
|
|
|
|
# delete_section(file, §ion, [keep-file])
|
|
# Remove a section and all directives from a file
|
|
sub delete_section
|
|
{
|
|
my ($file, $sect, $keepfile) = @_;
|
|
my $lref = &read_file_lines($file);
|
|
splice(@$lref, $sect->{'line'}, $sect->{'eline'} - $sect->{'line'} + 1);
|
|
my $empty = 1;
|
|
foreach my $l (@$lref) {
|
|
my $ll = $l;
|
|
$ll =~ s/^\s*#.*//;
|
|
$empty = 0 if ($ll =~ /\S/);
|
|
}
|
|
if ($empty && !$keepfile) {
|
|
# File is now empty, so delete it
|
|
&unflush_file_lines($file);
|
|
&unlink_file($file);
|
|
}
|
|
else {
|
|
# Save the file
|
|
&flush_file_lines($file);
|
|
}
|
|
}
|
|
|
|
# section_lines(§ion)
|
|
# Returns all the lines of text for some section plus directives
|
|
sub section_lines
|
|
{
|
|
my ($sect) = @_;
|
|
my @rv;
|
|
push(@rv, "[".$sect->{'name'}."]");
|
|
foreach my $m (@{$sect->{'members'}}) {
|
|
push(@rv, &directive_lines($m));
|
|
}
|
|
return @rv;
|
|
}
|
|
|
|
# directive_lines(&directive)
|
|
# Returns all lines of text for some directive
|
|
sub directive_lines
|
|
{
|
|
my ($dir) = @_;
|
|
my @rv;
|
|
my @v = ref($dir->{'value'}) eq 'ARRAY' ? @{$dir->{'value'}}
|
|
: split(/\n/, $dir->{'value'});
|
|
push(@rv, $dir->{'name'}." = ".shift(@v));
|
|
push(@rv, map { " ".$_ } @v); # Continuation
|
|
return @rv;
|
|
}
|
|
|
|
# save_directive(name, value|&values|&directive, §ion)
|
|
# Updates one directive in a section
|
|
sub save_directive
|
|
{
|
|
my ($name, $v, $sect) = @_;
|
|
my $dir;
|
|
if (ref($v) eq 'HASH') {
|
|
$dir = $v;
|
|
}
|
|
elsif (ref($v) eq 'ARRAY') {
|
|
$dir = { 'name' => $name,
|
|
'value' => $v };
|
|
}
|
|
elsif (defined($v)) {
|
|
$dir = { 'name' => $name,
|
|
'value' => $v };
|
|
}
|
|
else {
|
|
$dir = undef;
|
|
}
|
|
my $old = &find($name, $sect);
|
|
my $oldlen = $old ? $old->{'eline'} - $old->{'line'} + 1 : undef;
|
|
my $oldidx = $old ? &indexof($old, @{$sect->{'members'}}) : -1;
|
|
my $file = $old ? $old->{'file'} : $sect->{'file'};
|
|
my $lref = &read_file_lines($file);
|
|
my @dirlines = defined($dir) ? &directive_lines($dir) : ();
|
|
if ($old && defined($dir) && $old->{'value'} ne $dir->{'value'}) {
|
|
# Update existing
|
|
if ($sect->{'local'} && $old->{'file'} ne $sect->{'file'}) {
|
|
# Section is in a local file, so to override we need to
|
|
# add a new line in the local file
|
|
&unflush_file_lines($file);
|
|
$file = $sect->{'file'};
|
|
$lref = &read_file_lines($file);
|
|
splice(@$lref, $sect->{'eline'}+1, 0, @dirlines);
|
|
$dir->{'line'} = $sect->{'eline'}+1;
|
|
$dir->{'file'} = $sect->{'file'};
|
|
$sect->{'eline'} += scalar(@dirlines);
|
|
$dir->{'eline'} = $sect->{'eline'};
|
|
}
|
|
else {
|
|
# Just update the existing line
|
|
splice(@$lref, $old->{'line'}, $oldlen, @dirlines);
|
|
$dir->{'line'} = $old->{'line'};
|
|
$dir->{'eline'} = $dir->{'line'} + scalar(@dirlines) - 1;
|
|
$dir->{'file'} = $sect->{'file'};
|
|
if ($oldidx >= 0) {
|
|
$sect->{'members'}->[$oldidx] = $dir;
|
|
}
|
|
my $offset = scalar(@dirlines) - $oldlen;
|
|
foreach my $m (@{$sect->{'members'}}) {
|
|
next if ($m eq $dir || $m eq $old);
|
|
if ($m->{'line'} > $old->{'line'}) {
|
|
$m->{'line'} += $offset;
|
|
$m->{'eline'} += $offset;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
elsif (!$old && defined($dir)) {
|
|
# Add new
|
|
if (!$sect->{'local'} && $file =~ /^(.*)\.conf$/) {
|
|
# New directives should go in a .local file. We can assume at
|
|
# this point that it doesn't exist yet, or that there is no
|
|
# section in it. So convert this section object to local.
|
|
my $lfile = $1.".local";
|
|
&unflush_file_lines($file);
|
|
$file = $lfile;
|
|
$lref = &read_file_lines($file);
|
|
$sect->{'line'} = $sect->{'eline'} = scalar(@$lref);
|
|
$sect->{'file'} = $file;
|
|
splice(@$lref, $sect->{'eline'}, 0, "[$sect->{'name'}]");
|
|
splice(@$lref, $sect->{'eline'}+1, 0, @dirlines);
|
|
$dir->{'line'} = $sect->{'eline'}+1;
|
|
$dir->{'file'} = $sect->{'file'};
|
|
$sect->{'eline'} += scalar(@dirlines);
|
|
$dir->{'eline'} = $sect->{'eline'};
|
|
}
|
|
else {
|
|
# Just add to the file the section is in (which will be local)
|
|
splice(@$lref, $sect->{'eline'}+1, 0, @dirlines);
|
|
$dir->{'line'} = $sect->{'eline'}+1;
|
|
$dir->{'file'} = $sect->{'file'};
|
|
$sect->{'eline'} += scalar(@dirlines);
|
|
$dir->{'eline'} = $sect->{'eline'};
|
|
}
|
|
}
|
|
elsif ($old && !defined($dir)) {
|
|
# Remove existing
|
|
splice(@$lref, $old->{'line'}, $oldlen);
|
|
$sect->{'eline'} -= $oldlen;
|
|
if ($oldidx >= 0) {
|
|
splice(@{$sect->{'members'}}, $oldidx, 1);
|
|
}
|
|
foreach my $m (@{$sect->{'members'}}) {
|
|
next if ($m eq $old);
|
|
if ($m->{'line'} > $old->{'line'}) {
|
|
$m->{'eline'} -= $oldlen;
|
|
$m->{'line'} -= $oldlen;
|
|
}
|
|
}
|
|
}
|
|
&flush_file_lines($file);
|
|
}
|
|
|
|
sub find_value
|
|
{
|
|
my ($name, $object) = @_;
|
|
my @rv = map { $_->{'value'} } &find($name, $object);
|
|
return wantarray ? @rv : $rv[0];
|
|
}
|
|
|
|
sub find
|
|
{
|
|
my ($name, $object) = @_;
|
|
my $members = ref($object) eq 'HASH' ? $object->{'members'} : $object;
|
|
my @rv = grep { lc($_->{'name'}) eq $name } @$members;
|
|
return wantarray ? @rv : $rv[0];
|
|
}
|
|
|
|
# filename_to_name(file)
|
|
# Given a filename like /etc/fail2ban/foo.d/bar.conf , return bar
|
|
sub filename_to_name
|
|
{
|
|
my ($file) = @_;
|
|
$file =~ s/^.*\///;
|
|
$file =~ s/\.[^\.]+$//;
|
|
return $file;
|
|
}
|
|
|
|
# find_jail_by_filter(&filter)
|
|
# returns the jail objects using a filter
|
|
sub find_jail_by_filter
|
|
{
|
|
my ($filter) = @_;
|
|
my $fname = &filename_to_name($filter->[0]->{'file'});
|
|
my @rv;
|
|
foreach my $jail (&list_jails()) {
|
|
my $jfilter = &find_value("filter", $jail);
|
|
if ($jfilter eq $fname) {
|
|
push(@rv, $jail);
|
|
}
|
|
}
|
|
return @rv;
|
|
}
|
|
|
|
# find_jail_by_action(&action)
|
|
# returns the jail objects using an action
|
|
sub find_jail_by_action
|
|
{
|
|
my ($action) = @_;
|
|
my $aname = &filename_to_name($action->[0]->{'file'});
|
|
my @rv;
|
|
foreach my $jail (&list_jails()) {
|
|
my $jaction = &find("action", $jail);
|
|
next if (!$jaction);
|
|
my @jactions = map { /^([^\[]+)/; $1 } @{$jaction->{'words'}};
|
|
if (&indexof($aname, @jactions) >= 0) {
|
|
push(@rv, $jail);
|
|
}
|
|
}
|
|
return @rv;
|
|
}
|
|
|
|
# start_fail2ban_server()
|
|
# Attempts to start the server process, returning undef on success or an error message
|
|
# on failure.
|
|
sub start_fail2ban_server
|
|
{
|
|
if ($config{'init_script'}) {
|
|
&foreign_require("init");
|
|
foreach my $init (split(/\s+/, $config{'init_script'})) {
|
|
my ($ok, $out) = &init::start_action($init);
|
|
return $out if (!$ok);
|
|
}
|
|
return undef;
|
|
}
|
|
else {
|
|
my $out = &backquote_logged("$config{'client_cmd'} -x start 2>&1 </dev/null");
|
|
return $? ? $out : undef;
|
|
}
|
|
}
|
|
|
|
# stop_fail2ban_server()
|
|
# Attempts to stop the server process, returning undef on success or an error message
|
|
# on failure.
|
|
sub stop_fail2ban_server
|
|
{
|
|
if ($config{'init_script'}) {
|
|
&foreign_require("init");
|
|
foreach my $init (split(/\s+/, $config{'init_script'})) {
|
|
my ($ok, $out) = &init::stop_action($init);
|
|
return $out if (!$ok);
|
|
}
|
|
return undef;
|
|
}
|
|
else {
|
|
my $out = &backquote_logged("$config{'client_cmd'} stop 2>&1 </dev/null");
|
|
return $? ? $out : undef;
|
|
}
|
|
}
|
|
|
|
# restart_fail2ban_server()
|
|
# Force the fail2ban server to re-read its config
|
|
sub restart_fail2ban_server
|
|
{
|
|
my ($force_restart) = @_;
|
|
my $out;
|
|
$out = &backquote_logged("$config{'client_cmd'} reload 2>&1 </dev/null")
|
|
if (!$force_restart);
|
|
if ($? || $force_restart) {
|
|
&stop_fail2ban_server();
|
|
$out = &start_fail2ban_server();
|
|
}
|
|
return $? ? $out : undef;
|
|
}
|
|
|
|
# list_all_config_files()
|
|
# Returns a list of all Fail2Ban config files
|
|
sub list_all_config_files
|
|
{
|
|
my @rv;
|
|
push(@rv, "$config{'config_dir'}/fail2ban.local");
|
|
push(@rv, "$config{'config_dir'}/fail2ban.conf");
|
|
push(@rv, glob("$config{'config_dir'}/filter.d/*.conf"));
|
|
push(@rv, glob("$config{'config_dir'}/filter.d/*.local"));
|
|
push(@rv, glob("$config{'config_dir'}/action.d/*.conf"));
|
|
push(@rv, glob("$config{'config_dir'}/action.d/*.local"));
|
|
push(@rv, "$config{'config_dir'}/jail.conf");
|
|
push(@rv, "$config{'config_dir'}/jail.local");
|
|
push(@rv, glob("$config{'config_dir'}/jail.d/*.conf"));
|
|
push(@rv, glob("$config{'config_dir'}/jail.d/*.local"));
|
|
return grep { -r $_ || $_ =~ /fail2ban\.local$/ } @rv;
|
|
}
|
|
|
|
sub lock_all_config_files
|
|
{
|
|
@all_files_for_lock = &list_all_config_files();
|
|
foreach my $f (@all_files_for_lock) {
|
|
&lock_file($f);
|
|
}
|
|
}
|
|
|
|
sub unlock_all_config_files
|
|
{
|
|
foreach my $f (reverse(@all_files_for_lock)) {
|
|
&unlock_file($f);
|
|
}
|
|
@all_files_for_lock = ();
|
|
}
|
|
|
|
# get_fail2ban_version()
|
|
# Returns the version number, or undef if it cannot be found
|
|
sub get_fail2ban_version
|
|
{
|
|
my $out = &backquote_command("$config{'client_cmd'} -V 2>/dev/null </dev/null");
|
|
return !$? && $out =~ /v([0-9\.]+)/ ? $1 : undef;
|
|
}
|
|
|
|
# Unblock given IP in given jail
|
|
sub unblock_jailed_ip
|
|
{
|
|
my ($jail, $ip) = @_;
|
|
my $cmd = "$config{'client_cmd'} set ".quotemeta($jail)." unbanip ".quotemeta($ip)." 2>&1 </dev/null";
|
|
my $out = &backquote_logged($cmd);
|
|
if ($?) {
|
|
&error(&text('status_err_unban', &html_escape($ip)) . " : $out");
|
|
}
|
|
}
|
|
|
|
# Unblock all IPs in given jail
|
|
sub unblock_jail
|
|
{
|
|
my ($jail) = @_;
|
|
my $cmd = "$config{'client_cmd'} reload --unban ".quotemeta($jail)." 2>&1 </dev/null";
|
|
my $out = &backquote_logged($cmd);
|
|
if ($?) {
|
|
&error(&text('status_err_unbanjail', &html_escape($jail)) . " : $out");
|
|
}
|
|
}
|
|
|
|
# Convert human readable time to seconds
|
|
sub time_to_seconds
|
|
{
|
|
my ($time) = @_;
|
|
my $seconds;
|
|
my ($number, $unit) = $time =~ /^(\d+)\s*(year|years|month|months|week|weeks|day|days|hour|hours|min|minute|minutes|sec|second|seconds|y|mo|w|d|h|m|s)$/;
|
|
if ($number && $unit) {
|
|
$seconds = $number if ($unit =~ /^s/);
|
|
$seconds = $number * 60 if ($unit =~ /^m$|^min/);
|
|
$seconds = $number * 3600 if ($unit =~ /^h/);
|
|
$seconds = $number * 86400 if ($unit =~ /^d/);
|
|
$seconds = $number * 604800 if ($unit =~ /^w/);
|
|
$seconds = $number * 2629800 if ($unit =~ /^mo/);
|
|
$seconds = $number * 31557600 if ($unit =~ /^y/);
|
|
}
|
|
else {
|
|
$seconds = int($time);
|
|
}
|
|
return $seconds;
|
|
}
|
|
|
|
# Convert seconds to human readable time
|
|
sub seconds_to_time {
|
|
my ($seconds) = @_;
|
|
my ($number, $unit) = $seconds =~ /^(\d+)\s*(year|years|month|months|week|weeks|day|days|hour|hours|min|minute|minutes|sec|second|seconds|y|mo|w|d|h|m|s)$/;
|
|
return $seconds if ($unit);
|
|
my $time;
|
|
if ($seconds >= 31557600) {
|
|
my $years = int($seconds / 31557600);
|
|
$time = $years . " " .
|
|
($years > 1 ? $text{'config_dbpurgeagecusyrs'} :
|
|
$text{'config_dbpurgeagecusyr'});
|
|
} elsif ($seconds >= 2629800) {
|
|
my $months = int($seconds / 2629800);
|
|
$time = $months . " " .
|
|
($months > 1 ? $text{'config_dbpurgeagecusmos'} :
|
|
$text{'config_dbpurgeagecusmo'});
|
|
} elsif ($seconds >= 604800) {
|
|
my $weeks = int($seconds / 604800);
|
|
$time = $weeks . " " .
|
|
($weeks > 1 ? $text{'config_dbpurgeagecuswks'} :
|
|
$text{'config_dbpurgeagecuswk'});
|
|
} elsif ($seconds >= 86400) {
|
|
my $days = int($seconds / 86400);
|
|
$time = $days . " " .
|
|
($days > 1 ? $text{'config_dbpurgeagecusdays'} :
|
|
$text{'config_dbpurgeagecusday'});
|
|
} elsif ($seconds >= 3600) {
|
|
my $hours = int($seconds / 3600);
|
|
$time = $hours . " " .
|
|
($hours > 1 ? $text{'config_dbpurgeagecushrs'} :
|
|
$text{'config_dbpurgeagecushr'});
|
|
} elsif ($seconds >= 60) {
|
|
my $minutes = int($seconds / 60);
|
|
$time = $minutes . " " .
|
|
($minutes > 1 ? $text{'config_dbpurgeagecusmins'} :
|
|
$text{'config_dbpurgeagecusmin'});
|
|
} else {
|
|
$time = $seconds . " " .
|
|
(int($seconds / 60) > 1 ? $text{'config_dbpurgeagecussecs'} :
|
|
$text{'config_dbpurgeagecussec'});
|
|
}
|
|
return $time;
|
|
}
|
|
|
|
# Test if given format is correct
|
|
sub time_to_seconds_error
|
|
{
|
|
my ($time) = @_;
|
|
my ($seconds) = $time =~ /^(\d+)$/;
|
|
return 0 if ($seconds);
|
|
my ($number, $unit) = $time =~ /^(\d+)\s*(year|years|month|months|week|weeks|day|days|hour|hours|min|minute|minutes|sec|second|seconds|y|mo|w|d|h|m|s)$/;
|
|
return 0 if ($number && $unit);
|
|
my ($ewrongunit) = $time =~ /^\d+\s*(\S+)\s*$/;
|
|
return &text('config_ewrongunit', $ewrongunit) if ($ewrongunit);
|
|
return $text{'config_ewrongtime'} if ($time !~ /^(\d+)$/ || $time == 0);
|
|
return 0;
|
|
}
|
|
|
|
1;
|