Added show-queue dependancy
This commit is contained in:
Deon George
parent
01ab961caa
commit
3b433de0e0
@ -1,3 +1,3 @@
|
|||||||
#!/bin/sh
|
#!/bin/sh
|
||||||
|
|
||||||
/usr/local/tools/lib/showold.pl /etc/ftn/config $@
|
/usr/local/bin/showold.pl /etc/ftn/config $@
|
||||||
|
|||||||
762
tools/showold.pl
Executable file
762
tools/showold.pl
Executable file
@ -0,0 +1,762 @@
|
|||||||
|
#!/usr/bin/perl
|
||||||
|
#
|
||||||
|
# Display outbound summary for every link
|
||||||
|
# for which there is anything in the outbound
|
||||||
|
# Created by Pavel Gulchouck 2:463/68@fidonet
|
||||||
|
# Fixed by Stas Degteff 2:5080/102@fidonet
|
||||||
|
# Modified by Michael Dukelsky 2:5020/1042@fidonet
|
||||||
|
# version 2.1
|
||||||
|
# It is free software and license is the same as for Perl,
|
||||||
|
# see http://dev.perl.org/licenses/
|
||||||
|
#
|
||||||
|
|
||||||
|
##### There is nothing to change below this line #####
|
||||||
|
use File::Spec;
|
||||||
|
use File::Find;
|
||||||
|
use Config;
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
my ($fidoconfig, $OS, $module, $defZone,
|
||||||
|
$defOutbound, @dirs, @boxesDirs, @asoFiles,
|
||||||
|
%minmtime, %netmail, %echomail, %files, $zone);
|
||||||
|
my $commentChar = '#';
|
||||||
|
my $Mb = 1024 * 1024;
|
||||||
|
my $Gb = $Mb * 1024;
|
||||||
|
|
||||||
|
sub usage
|
||||||
|
{
|
||||||
|
print <<USAGE;
|
||||||
|
|
||||||
|
The script showold.pl prints out to STDOUT how much netmail, echomail
|
||||||
|
and files are stored for every link in the outbound and fileboxes and
|
||||||
|
how long they are stored.
|
||||||
|
|
||||||
|
If FIDOCONFIG environment variable is defined, you may use the script
|
||||||
|
without arguments, otherwise you have to supply the path to fidoconfig
|
||||||
|
as an argument.
|
||||||
|
|
||||||
|
Usage:
|
||||||
|
perl showold.pl
|
||||||
|
perl showold.pl <path to fidoconfig>
|
||||||
|
|
||||||
|
Example:
|
||||||
|
perl showold.pl M:\\mail\\Husky\\config\\config
|
||||||
|
USAGE
|
||||||
|
exit 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub nodesort
|
||||||
|
{ my ($az, $an, $af, $ap, $bz, $bn, $bf, $bp);
|
||||||
|
if ($a =~ /(\d+):(\d+)\/(\d+)(?:\.(\d+))?$/)
|
||||||
|
{
|
||||||
|
($az, $an, $af, $ap) = ($1, $2, $3, $4 ? $4 : 0);
|
||||||
|
}
|
||||||
|
if ($b =~ /(\d+):(\d+)\/(\d+)(?:\.(\d+))?$/)
|
||||||
|
{
|
||||||
|
($bz, $bn, $bf, $bp) = ($1, $2, $3, $4 ? $4 : 0);
|
||||||
|
}
|
||||||
|
return ($az<=>$bz) || ($an<=>$bn) || ($af<=>$bf) || ($ap<=>$bp);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub unbso
|
||||||
|
{
|
||||||
|
my ($file, $dir) = @_;
|
||||||
|
my $zone;
|
||||||
|
if($dir =~ /\.([0-9a-f])([0-9a-f])([0-9a-f])$/i)
|
||||||
|
{
|
||||||
|
$zone = hex("$1")*256 + hex($2)*16 + hex($3);
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
$zone = $defZone;
|
||||||
|
}
|
||||||
|
if ($file =~ /([0-9a-f]{4})([0-9a-f]{4})\.pnt\/([0-9a-f]{8})/i)
|
||||||
|
{
|
||||||
|
return sprintf "%u:%u/%d.%d", $zone, hex("$1"), hex("$2"), hex("$3");
|
||||||
|
}
|
||||||
|
elsif ($file =~ /([0-9a-f]{4})([0-9a-f]{4})/i)
|
||||||
|
{
|
||||||
|
return sprintf "%u:%u/%d", $zone, hex("$1"), hex("$2");
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
return "";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub unaso
|
||||||
|
{
|
||||||
|
my ($file) = @_;
|
||||||
|
if($file =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/)
|
||||||
|
{
|
||||||
|
if($4 == 0)
|
||||||
|
{
|
||||||
|
return "$1:$2\/$3";
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
return "$1:$2\/$3\.$4";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
return "";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub unbox
|
||||||
|
{
|
||||||
|
my ($dir) = @_;
|
||||||
|
if($dir =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)(?:\.h)?$/i)
|
||||||
|
{
|
||||||
|
return $4 == 0 ? "$1:$2\/$3" : "$1:$2\/$3\.$4";
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
return "";
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub niceNumber
|
||||||
|
{
|
||||||
|
my ($num) = @_;
|
||||||
|
return ($num < $Mb ? $num : ($num >= $Mb && $num < $Gb ? $num/$Mb : $num/$Gb));
|
||||||
|
}
|
||||||
|
|
||||||
|
sub niceNumberFormat
|
||||||
|
{
|
||||||
|
my ($num) = @_;
|
||||||
|
return "%9u " if ($num < $Mb);
|
||||||
|
|
||||||
|
my $len = length(sprintf "%4.4f", niceNumber($num));
|
||||||
|
return ($len < 9 ? " " x (9 - $len) . "%4.4f" : "%4.4f") .
|
||||||
|
($num < $Gb ? "M" : "G");
|
||||||
|
}
|
||||||
|
|
||||||
|
sub normalize
|
||||||
|
{
|
||||||
|
my ($path) = @_;
|
||||||
|
return $path if($OS eq 'UNIX');
|
||||||
|
my ($vol, $d, $f) = File::Spec->splitpath($path);
|
||||||
|
my @d = File::Spec->splitdir($d);
|
||||||
|
$d = File::Spec->catdir(@d);
|
||||||
|
return File::Spec->catpath($vol, $d, $f);
|
||||||
|
}
|
||||||
|
|
||||||
|
sub selectOutbound
|
||||||
|
{
|
||||||
|
if (-d $File::Find::name && $File::Find::name =~ /\.[0-9a-f]{3}$/i)
|
||||||
|
{
|
||||||
|
push(@dirs, normalize($File::Find::name));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub listOutbounds
|
||||||
|
{
|
||||||
|
my ($dir) = @_;
|
||||||
|
my ($volume, $directories, $file) = File::Spec->splitpath(normalize($dir));
|
||||||
|
if($file eq "")
|
||||||
|
{
|
||||||
|
my @dirs = File::Spec->splitdir($directories);
|
||||||
|
$file = pop @dirs;
|
||||||
|
$directories = File::Spec->catdir(@dirs);
|
||||||
|
}
|
||||||
|
my $updir=File::Spec->catpath($volume, $directories, "");
|
||||||
|
@dirs=($dir);
|
||||||
|
|
||||||
|
find(\&selectOutbound, $updir);
|
||||||
|
return @dirs;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub selectFileInASO
|
||||||
|
{
|
||||||
|
if (-f $File::Find::name && -s $File::Find::name &&
|
||||||
|
($File::Find::name =~ /\d+\.\d+\.\d+\.\d+\.[icdoh]ut$/i ||
|
||||||
|
$File::Find::name =~ /\d+\.\d+\.\d+\.\d+\.(su|mo|tu|we|th|fr|sa)[0-9a-z]$/i))
|
||||||
|
{
|
||||||
|
push(@asoFiles, normalize($File::Find::name));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub listFilesInASO
|
||||||
|
{
|
||||||
|
@asoFiles = ();
|
||||||
|
find(\&selectFileInASO, $defOutbound);
|
||||||
|
return @asoFiles;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub selectFileBoxes
|
||||||
|
{
|
||||||
|
if (-d $File::Find::name && $File::Find::name =~ /\d+\.\d+\.\d+\.\d+(?:\.h)?$/i)
|
||||||
|
{
|
||||||
|
push(@boxesDirs, normalize($File::Find::name));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub listFileBoxes
|
||||||
|
{
|
||||||
|
my ($dir) = @_;
|
||||||
|
find(\&selectFileBoxes, $dir);
|
||||||
|
return @boxesDirs;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub allFilesInBSO
|
||||||
|
{
|
||||||
|
my ($dir) = @_;
|
||||||
|
chdir($dir);
|
||||||
|
my @files = <*.[IiCcDdFfHh][Ll][Oo]>;
|
||||||
|
push @files, <*.[IiCcDdOoHh][Uu][Tt]>;
|
||||||
|
push @files, <*.[Pp][Nn][Tt]/*.[IiCcDdFfHh][Ll][Oo]>;
|
||||||
|
push @files, <*.[Pp][Nn][Tt]/*.[IiCcDdOoHh][Uu][Tt]>;
|
||||||
|
return if(@files == 0);
|
||||||
|
|
||||||
|
foreach my $file (@files)
|
||||||
|
{
|
||||||
|
my $node=unbso($file, $dir);
|
||||||
|
next if($node eq "");
|
||||||
|
my ($size, $mtime) = (stat($file))[7, 9];
|
||||||
|
#printf("allFilesInBSO: %s: %s (%s)\n",$file,$size,$mtime);
|
||||||
|
next if($size == 0);
|
||||||
|
if (!defined($minmtime{$node}) || $mtime < $minmtime{$node})
|
||||||
|
{
|
||||||
|
$minmtime{$node} = $mtime if $mtime;
|
||||||
|
}
|
||||||
|
if ($file =~ /ut$/i)
|
||||||
|
{
|
||||||
|
$netmail{$node} += $size;
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
# unix, read only -> ignore *.bsy
|
||||||
|
next unless open(F, "<$file");
|
||||||
|
while (<F>)
|
||||||
|
{
|
||||||
|
s/\r?\n$//s;
|
||||||
|
s/^[#~^]//;
|
||||||
|
next unless(($size, $mtime) = (stat($_))[7, 9]);
|
||||||
|
next if($size == 0);
|
||||||
|
|
||||||
|
if (/[0-9a-f]{8}\.(su|mo|tu|we|th|fr|sa)[0-9a-z]$/i || /.pkt$/i )
|
||||||
|
{
|
||||||
|
if (!defined($minmtime{$node}) || $mtime < $minmtime{$node})
|
||||||
|
{
|
||||||
|
$minmtime{$node} = $mtime;
|
||||||
|
}
|
||||||
|
$echomail{$node} += $size;
|
||||||
|
}
|
||||||
|
elsif (/\.tic$/i)
|
||||||
|
{
|
||||||
|
if (!defined($minmtime{$node}) || $mtime < $minmtime{$node})
|
||||||
|
{
|
||||||
|
$minmtime{$node} = $mtime;
|
||||||
|
}
|
||||||
|
$files{$node} += $size;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
$files{$node} += $size;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
close(F);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub allFilesInASO
|
||||||
|
{
|
||||||
|
chdir($defOutbound);
|
||||||
|
my @files = listFilesInASO();
|
||||||
|
return if(@files == 0);
|
||||||
|
|
||||||
|
foreach my $file (@files)
|
||||||
|
{
|
||||||
|
my $node=unaso($file);
|
||||||
|
next if($node eq "");
|
||||||
|
my ($size, $mtime) = (stat($file))[7, 9];
|
||||||
|
#printf("allFilesInASO: %s: %s (%s)\n",$file,$size,$mtime);
|
||||||
|
next if($size == 0);
|
||||||
|
if (!defined($minmtime{$node}) || $mtime < $minmtime{$node})
|
||||||
|
{
|
||||||
|
$minmtime{$node} = $mtime if $mtime;
|
||||||
|
}
|
||||||
|
if ($file =~ /ut$/i)
|
||||||
|
{
|
||||||
|
$netmail{$node} += $size;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
$echomail{$node} += $size;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub allFilesInFileBoxes
|
||||||
|
{
|
||||||
|
my ($dir) = @_;
|
||||||
|
my $node = unbox($dir);
|
||||||
|
next if($node eq "");
|
||||||
|
chdir($dir);
|
||||||
|
my @files = <*.[IiCcDdOoHh][Uu][Tt]>;
|
||||||
|
push @files, <*.[Ss][Uu][0-9a-zA-Z]>;
|
||||||
|
push @files, <*.[Mm][Oo][0-9a-zA-Z]>;
|
||||||
|
push @files, <*.[Tt][Uu][0-9a-zA-Z]>;
|
||||||
|
push @files, <*.[Ww][Ee][0-9a-zA-Z]>;
|
||||||
|
push @files, <*.[Tt][Hh][0-9a-zA-Z]>;
|
||||||
|
push @files, <*.[Ff][Rr][0-9a-zA-Z]>;
|
||||||
|
push @files, <*.[Ss][Aa][0-9a-zA-Z]>;
|
||||||
|
return if(@files == 0);
|
||||||
|
|
||||||
|
foreach my $file (@files)
|
||||||
|
{
|
||||||
|
my ($size, $mtime) = (stat($file))[7, 9];
|
||||||
|
next if($size == 0);
|
||||||
|
if (!defined($minmtime{$node}) || $mtime < $minmtime{$node})
|
||||||
|
{
|
||||||
|
$minmtime{$node} = $mtime if $mtime;
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($file =~ /ut$/i)
|
||||||
|
{
|
||||||
|
$netmail{$node} += $size;
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
elsif ($file =~ /\.(su|mo|tu|we|th|fr|sa)[0-9a-z]$/i)
|
||||||
|
{
|
||||||
|
# Both BSO and ASO style echomail bundles are handled here
|
||||||
|
if (!defined($minmtime{$node}) || $mtime < $minmtime{$node})
|
||||||
|
{
|
||||||
|
$minmtime{$node} = $mtime;
|
||||||
|
}
|
||||||
|
$echomail{$node} += $size;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
$files{$node} += $size;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
# stripSpaces(@array) returns the array, every element of which
|
||||||
|
# is stripped of heading and trailing white spaces.
|
||||||
|
sub stripSpaces
|
||||||
|
{
|
||||||
|
my @arr = @_;
|
||||||
|
foreach (@arr)
|
||||||
|
{
|
||||||
|
next unless $_;
|
||||||
|
s/^\s+//;
|
||||||
|
s/\s+$//;
|
||||||
|
}
|
||||||
|
return @arr;
|
||||||
|
}
|
||||||
|
|
||||||
|
# stripQuotes(@array) returns the array, every element of which
|
||||||
|
# is stripped of heading and trailing double quote character.
|
||||||
|
sub stripQuotes
|
||||||
|
{
|
||||||
|
my @arr = @_;
|
||||||
|
foreach (@arr)
|
||||||
|
{
|
||||||
|
next unless $_;
|
||||||
|
s/^\"(.+)\"$/$1/;
|
||||||
|
}
|
||||||
|
return @arr;
|
||||||
|
}
|
||||||
|
|
||||||
|
# expandVars($expression) executes commands in backticks
|
||||||
|
# found in the $expression, substitutes environment
|
||||||
|
# variables by their values and returns the resulting string
|
||||||
|
sub expandVars
|
||||||
|
{
|
||||||
|
my ($expr) = stripSpaces(@_);
|
||||||
|
my ($result, $left, $cmd, $var, $remainder);
|
||||||
|
|
||||||
|
# check whether number of backticks (\x60) is even
|
||||||
|
my $number = $expr =~ tr/\x60//;
|
||||||
|
if (($OS eq 'UNIX' or $OS eq 'OS/2') &&
|
||||||
|
$number != 0 &&
|
||||||
|
int($number / 2) * 2 == $number)
|
||||||
|
{
|
||||||
|
# execute commands in backticks
|
||||||
|
$cmd = 1;
|
||||||
|
$result = "";
|
||||||
|
while ($cmd)
|
||||||
|
{
|
||||||
|
($left, $cmd, $remainder) = split /\x60/, $expr, 3;
|
||||||
|
$left = "" if(!defined($left));
|
||||||
|
$cmd = "" if(!defined($cmd));
|
||||||
|
$remainder = "" if(!defined($remainder));
|
||||||
|
if ($cmd)
|
||||||
|
{
|
||||||
|
$result .= $left . eval('`' . $cmd . '`');
|
||||||
|
$result =~ s/[\r\n]+$//;
|
||||||
|
last unless $remainder;
|
||||||
|
$expr = $remainder;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
$result .= $expr;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
$expr = $result;
|
||||||
|
}
|
||||||
|
|
||||||
|
# substitute environment variables by their values
|
||||||
|
$var = 1;
|
||||||
|
$result = "";
|
||||||
|
while ($var)
|
||||||
|
{
|
||||||
|
($left, $var, $remainder) = split /[\[\]]/, $expr, 3;
|
||||||
|
$left = "" if(!defined($left));
|
||||||
|
$var = "" if(!defined($var));
|
||||||
|
$remainder = "" if(!defined($remainder));
|
||||||
|
if ($var)
|
||||||
|
{
|
||||||
|
$result .=
|
||||||
|
$left
|
||||||
|
. (
|
||||||
|
lc($var) eq "module"
|
||||||
|
? "module"
|
||||||
|
: ($ENV{$var} ? $ENV{$var} : ""));
|
||||||
|
last unless $remainder;
|
||||||
|
$expr = $remainder;
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
$result .= $expr;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return $result;
|
||||||
|
}
|
||||||
|
|
||||||
|
# cmpPattern($string, $pattern) compares $string with $pattern
|
||||||
|
# and returns boolean result of the comparison. The pattern
|
||||||
|
# may contain wildcard caracters '?' and '*'.
|
||||||
|
sub cmpPattern
|
||||||
|
{
|
||||||
|
my ($string, $pattern) = @_;
|
||||||
|
$pattern =~ s/\?/./g;
|
||||||
|
$pattern =~ s/\*/.*/g;
|
||||||
|
return $string =~ /^$pattern$/;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub boolExpr
|
||||||
|
{
|
||||||
|
my ($expr, $ifLevel, $moduleIfLevel) = @_;
|
||||||
|
my ($result, $not, $left, $right);
|
||||||
|
$result = $not = "";
|
||||||
|
|
||||||
|
if ($expr =~ /^not\s+(.+)$/i)
|
||||||
|
{
|
||||||
|
$not = 1;
|
||||||
|
$expr = $1;
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($expr =~ /^(.+)==(.+)$/)
|
||||||
|
{
|
||||||
|
($left, $right) = stripSpaces($1, $2);
|
||||||
|
if (lc($left) eq "module")
|
||||||
|
{
|
||||||
|
if ($result = lc($right) eq "hpt")
|
||||||
|
{
|
||||||
|
$module = "hpt";
|
||||||
|
$moduleIfLevel = $ifLevel;
|
||||||
|
}
|
||||||
|
elsif ($result = lc($right) eq "htick")
|
||||||
|
{
|
||||||
|
$module = "htick";
|
||||||
|
$moduleIfLevel = $ifLevel;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
elsif (lc($right) eq "module")
|
||||||
|
{
|
||||||
|
if ($result = lc($left) eq "hpt")
|
||||||
|
{
|
||||||
|
$module = "hpt";
|
||||||
|
$moduleIfLevel = $ifLevel;
|
||||||
|
}
|
||||||
|
elsif ($result = lc($left) eq "htick")
|
||||||
|
{
|
||||||
|
$module = "htick";
|
||||||
|
$moduleIfLevel = $ifLevel;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
$result = $left eq $right;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
elsif ($expr =~ /^(.+)!=(.+)$/)
|
||||||
|
{
|
||||||
|
($left, $right) = stripSpaces($1, $2);
|
||||||
|
$result = $left ne $right;
|
||||||
|
}
|
||||||
|
elsif ($expr =~ /^(.+)=~(.+)$/)
|
||||||
|
{
|
||||||
|
$result = cmpPattern(stripSpaces($1, $2));
|
||||||
|
}
|
||||||
|
elsif ($expr =~ /^(.+)!~(.+)$/)
|
||||||
|
{
|
||||||
|
$result = not cmpPattern(stripSpaces($1, $2));
|
||||||
|
}
|
||||||
|
|
||||||
|
return $not ? not $result : $result;
|
||||||
|
}
|
||||||
|
|
||||||
|
# stripComment(@lines) strips a comment from @lines and returns the array
|
||||||
|
sub stripComment
|
||||||
|
{
|
||||||
|
my @arr = @_;
|
||||||
|
foreach (@arr)
|
||||||
|
{
|
||||||
|
next unless $_;
|
||||||
|
next if s/^$commentChar.*$//;
|
||||||
|
s/\s+$commentChar\s.*$//;
|
||||||
|
}
|
||||||
|
return @arr;
|
||||||
|
}
|
||||||
|
|
||||||
|
# parseIf($line, \@condition) parses $line for conditional operators
|
||||||
|
# and returns 1 if the line should be skipped else 0.
|
||||||
|
sub parseIf
|
||||||
|
{
|
||||||
|
my ($line, $rCondition, $ifLevel, $moduleIfLevel) = @_;
|
||||||
|
|
||||||
|
return 1 if $line eq "";
|
||||||
|
|
||||||
|
if ($line =~ /^if\s+(.+)$/i)
|
||||||
|
{
|
||||||
|
$ifLevel++;
|
||||||
|
return 1 if @$rCondition and not $$rCondition[-1];
|
||||||
|
push @$rCondition, boolExpr(expandVars($1), $ifLevel, $moduleIfLevel);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
elsif ($line =~ /^ifdef\s+(.+)$/i)
|
||||||
|
{
|
||||||
|
$ifLevel++;
|
||||||
|
return 1 if @$rCondition and not $$rCondition[-1];
|
||||||
|
my $var = expandVars($1);
|
||||||
|
push @$rCondition, ($var ? exists $ENV{$var} : 0);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
elsif ($line =~ /^ifndef\s+(.+)$/i)
|
||||||
|
{
|
||||||
|
$ifLevel++;
|
||||||
|
return 1 if @$rCondition and not $$rCondition[-1];
|
||||||
|
my $var = expandVars($1);
|
||||||
|
push @$rCondition, ($var ? not exists $ENV{$var} : 1);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
elsif ($line =~ /^elseif\s+(.+)$/i or $line =~ /^elif\s+(.+)$/i)
|
||||||
|
{
|
||||||
|
return 1 if @$rCondition != $ifLevel;
|
||||||
|
$moduleIfLevel = 0 if $moduleIfLevel and $moduleIfLevel == $ifLevel;
|
||||||
|
pop @$rCondition;
|
||||||
|
push @$rCondition, boolExpr(expandVars($1), $ifLevel, $moduleIfLevel);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
elsif ($line =~ /^else$/i)
|
||||||
|
{
|
||||||
|
return 1 if @$rCondition != $ifLevel;
|
||||||
|
$moduleIfLevel = 0 if $moduleIfLevel and $moduleIfLevel == $ifLevel;
|
||||||
|
push @$rCondition, not pop(@$rCondition);
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
elsif ($line =~ /^endif$/i)
|
||||||
|
{
|
||||||
|
$moduleIfLevel = 0 if $moduleIfLevel and $moduleIfLevel == $ifLevel;
|
||||||
|
pop @$rCondition if @$rCondition == $ifLevel--;
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1 if $ifLevel and not $$rCondition[-1];
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
# findTokenValue($token, $tokenFile) returns ($value, $tokenFile),
|
||||||
|
# where $value is the value of the $token in husky fidoconfig.
|
||||||
|
# Search of the token is started in the file with the full path
|
||||||
|
# $tokenFile in the argument and in all included files and the returned
|
||||||
|
# $tokenFile is the file where the token was found.
|
||||||
|
# If the token was not found, $value is an empty string,
|
||||||
|
# if the token was found but with empty value, then
|
||||||
|
# a string "on" is returned as $value.
|
||||||
|
sub findTokenValue
|
||||||
|
{
|
||||||
|
my ($token, $tokenFile) = @_;
|
||||||
|
my ($value, @lines, @condition, $ifLevel, $moduleIfLevel);
|
||||||
|
$value = "";
|
||||||
|
$ifLevel = $moduleIfLevel = 0;
|
||||||
|
|
||||||
|
($tokenFile) = stripQuotes(stripSpaces($tokenFile));
|
||||||
|
|
||||||
|
open(FIN, "<", $tokenFile) or die("$tokenFile: $!");
|
||||||
|
@lines = <FIN>;
|
||||||
|
close FIN;
|
||||||
|
|
||||||
|
foreach my $line (stripSpaces(stripComment(@lines)))
|
||||||
|
{
|
||||||
|
next if parseIf($line, \@condition, $ifLevel, $moduleIfLevel);
|
||||||
|
|
||||||
|
$line = expandVars($line);
|
||||||
|
|
||||||
|
if ($line =~ /^$token\s+(.+)$/i)
|
||||||
|
{
|
||||||
|
($value) = stripSpaces($1);
|
||||||
|
last;
|
||||||
|
}
|
||||||
|
elsif ($line =~ /^$token$/i)
|
||||||
|
{
|
||||||
|
$value = "on";
|
||||||
|
last;
|
||||||
|
}
|
||||||
|
elsif ($line =~ /^include\s+(.+)$/i)
|
||||||
|
{
|
||||||
|
my $newTokenFile;
|
||||||
|
($value, $newTokenFile) = findTokenValue($token, $1);
|
||||||
|
if ($value and $newTokenFile)
|
||||||
|
{
|
||||||
|
$tokenFile = $newTokenFile;
|
||||||
|
last;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
elsif ($line =~ /^set\s+(.+)$/i)
|
||||||
|
{
|
||||||
|
my ($var, $val) = stripSpaces(split(/=/, $1));
|
||||||
|
($val) = stripQuotes($val);
|
||||||
|
$val ? ($ENV{$var} = $val) : delete $ENV{$var};
|
||||||
|
}
|
||||||
|
elsif ($line =~ /^commentChar\s+(\S)$/i)
|
||||||
|
{
|
||||||
|
$commentChar = $1;
|
||||||
|
}
|
||||||
|
} ## end foreach my $line (@lines)
|
||||||
|
return ($value, $tokenFile);
|
||||||
|
} ## end sub findTokenValue
|
||||||
|
|
||||||
|
# searchTokenValue($token, $tokenFile)
|
||||||
|
sub searchTokenValue
|
||||||
|
{
|
||||||
|
my ($token, $tokenFile) = @_;
|
||||||
|
$commentChar = '#';
|
||||||
|
return findTokenValue($token, $tokenFile);
|
||||||
|
}
|
||||||
|
|
||||||
|
# isOn($value) returns true if the $value is the string representing "true"
|
||||||
|
# according to husky fidoconfig rules
|
||||||
|
sub isOn
|
||||||
|
{
|
||||||
|
my ($val) = @_;
|
||||||
|
return 1 if($val eq "1" or lc($val) eq "yes" or lc($val) eq "on");
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
###################### The main program starts here ##########################
|
||||||
|
|
||||||
|
$fidoconfig = $ENV{FIDOCONFIG} if defined $ENV{FIDOCONFIG};
|
||||||
|
|
||||||
|
if ((@ARGV == 1 && $ARGV[0] =~ /^(-|--|\/)(h|help|\?)$/i) || (!defined($fidoconfig) && (@ARGV < 1 || @ARGV > 2)))
|
||||||
|
{
|
||||||
|
usage();
|
||||||
|
}
|
||||||
|
|
||||||
|
$fidoconfig = $ARGV[0] if(!defined($fidoconfig));
|
||||||
|
if (!(-f $fidoconfig && -s $fidoconfig))
|
||||||
|
{
|
||||||
|
print "\n\'$fidoconfig\' is not fidoconfig\n";
|
||||||
|
usage();
|
||||||
|
}
|
||||||
|
|
||||||
|
$zone = $ARGV[1] if (defined($ARGV[1]));
|
||||||
|
unless ($OS = $^O)
|
||||||
|
{
|
||||||
|
$OS = $Config::Config{'osname'};
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($OS =~ /^MSWin/i)
|
||||||
|
{
|
||||||
|
$OS = 'WIN';
|
||||||
|
}
|
||||||
|
elsif ($OS =~ /^dos/i)
|
||||||
|
{
|
||||||
|
$OS = 'DOS';
|
||||||
|
}
|
||||||
|
elsif ($OS =~ /^os2/i)
|
||||||
|
{
|
||||||
|
$OS = 'OS/2';
|
||||||
|
}
|
||||||
|
elsif ($OS =~ /^VMS/i or $OS =~ /^MacOS/i or $OS =~ /^epoc/i or $OS =~ /NetWare/i)
|
||||||
|
{
|
||||||
|
die("$OS is not supported\n");
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
$OS = 'UNIX';
|
||||||
|
}
|
||||||
|
$ENV{OS} = $OS;
|
||||||
|
$ENV{$OS} = $OS;
|
||||||
|
|
||||||
|
#### Read fidoconfig ####
|
||||||
|
my ($address, $path, $fileBoxesDir);
|
||||||
|
$fidoconfig = normalize($fidoconfig);
|
||||||
|
|
||||||
|
my $separateBundles;
|
||||||
|
($separateBundles, $path) = searchTokenValue("SeparateBundles", $fidoconfig);
|
||||||
|
die "\nSeparateBundles mode is not supported\n" if(isOn($separateBundles));
|
||||||
|
|
||||||
|
($address, $path) = searchTokenValue("address", $fidoconfig);
|
||||||
|
$defZone = $1 if($address ne "" && $address =~ /^(\d+):\d+\/\d+(?:\.\d+)?(?:@\w+)?$/);
|
||||||
|
defined($defZone) or die "\nYour FTN address is not defined or has a syntax error\n";
|
||||||
|
|
||||||
|
($fileBoxesDir, $path) = searchTokenValue("FileBoxesDir", $fidoconfig);
|
||||||
|
if($fileBoxesDir ne "")
|
||||||
|
{
|
||||||
|
-d $fileBoxesDir or die "\nfileBoxesDir \'$fileBoxesDir\' is not a directory\n";
|
||||||
|
$fileBoxesDir = normalize($fileBoxesDir);
|
||||||
|
}
|
||||||
|
|
||||||
|
($defOutbound, $path) = searchTokenValue("Outbound", $fidoconfig);
|
||||||
|
$defOutbound ne "" or die "\nOutbound is not defined\n";
|
||||||
|
-d $defOutbound or die "\nOutbound \'$defOutbound\' is not a directory\n";
|
||||||
|
$defOutbound = normalize($defOutbound);
|
||||||
|
|
||||||
|
@dirs = listOutbounds($defOutbound);
|
||||||
|
@boxesDirs = listFileBoxes($fileBoxesDir) if($fileBoxesDir ne "");
|
||||||
|
|
||||||
|
allFilesInASO();
|
||||||
|
|
||||||
|
foreach my $dir (@dirs)
|
||||||
|
{
|
||||||
|
allFilesInBSO($dir);
|
||||||
|
}
|
||||||
|
|
||||||
|
foreach my $dir (@boxesDirs)
|
||||||
|
{
|
||||||
|
allFilesInFileBoxes($dir);
|
||||||
|
}
|
||||||
|
|
||||||
|
print <<EOF;
|
||||||
|
+------------------+--------+-----------+-----------+-----------+
|
||||||
|
| Node | Days | NetMail | EchoMail | Files |
|
||||||
|
+------------------+--------+-----------+-----------+-----------+
|
||||||
|
EOF
|
||||||
|
foreach my $node (sort nodesort keys %minmtime)
|
||||||
|
{
|
||||||
|
next if (defined($zone) && ($node !~ /^$zone:/));
|
||||||
|
|
||||||
|
$netmail{$node} = 0 if(!defined $netmail{$node});
|
||||||
|
$echomail{$node} = 0 if(!defined $echomail{$node});
|
||||||
|
$files{$node} = 0 if(!defined $files{$node});
|
||||||
|
my $format = "| %-16s |%7u |" .
|
||||||
|
niceNumberFormat($netmail{$node}) . " |" .
|
||||||
|
niceNumberFormat($echomail{$node}) . " |" .
|
||||||
|
niceNumberFormat($files{$node}) . " |\n";
|
||||||
|
printf $format,
|
||||||
|
$node, (time()-$minmtime{$node})/(24*60*60),
|
||||||
|
niceNumber($netmail{$node}),
|
||||||
|
niceNumber($echomail{$node}),
|
||||||
|
niceNumber($files{$node});
|
||||||
|
}
|
||||||
|
print "+------------------+--------+-----------+-----------+-----------+\n";
|
||||||
|
exit(0);
|
||||||
Reference in New Issue
Block a user