'use strict', cleanup everywhere
Florian Schlichting
fschlich at CIS.FU-Berlin.DE
Fri Jul 1 13:29:40 UTC 2011
Hi Julien,
after my first patches for inncheck were so well received, I leisurely
got to work on the other perl scripts that didn't use 'use strict' yet,
and also cleaned out some perl4-ish features. Given what you told be
about your schedule, I thought I might just dump the results on you
right before I leave for my summer holiday... Even though I noticed just
today that procbatch, scanspool and signcontrol don't have manpages yet,
so if you won't, I might write some pod when I find the time...
Florian
---
backends/mod-active.in | 86 +++++++++++----------
control/signcontrol.in | 114 +++++++++++++--------------
frontends/cnfsheadconf.in | 122 +++++++++++++++--------------
frontends/cnfsstat.in | 187 ++++++++++++++++++++++-----------------------
frontends/scanspool.in | 181 +++++++++++++++++++++----------------------
innfeed/procbatch.in | 110 +++++++++++++-------------
scripts/innmail.in | 56 +++++++-------
7 files changed, 424 insertions(+), 432 deletions(-)
diff --git a/backends/mod-active.in b/backends/mod-active.in
index 48440bd..d6b9d89 100644
--- a/backends/mod-active.in
+++ b/backends/mod-active.in
@@ -9,21 +9,22 @@
# is output by docheckgroups and actsync, and efficiently handles them all at
# once. Input can come from command-line files or stdin, a la awk/sed.
-$oldact = $INN::Config::active; # active file location
-$newact = "$oldact.new$$"; # temporary name for new active file
-$actime = $INN::Config::activetimes; # active.times file
-$pausemsg = 'batch active update, ok'; # message to be used for pausing?
-$diff_flags = ''; # flags for diff(1); default chosen if null
-$changes = 0; # number of changes to do
+use strict;
+my $oldact = $INN::Config::active; # active file location
+my $newact = "$oldact.new$$"; # temporary name for new active file
+my $actime = $INN::Config::activetimes; # active.times file
+my $pausemsg = 'batch active update, ok'; # message to be used for pausing?
+my $diff_flags = ''; # flags for diff(1); default chosen if null
+my $changes = 0; # number of changes to do
$0 =~ s#^.*/##;
die "$0: must run as $INN::Config::newsuser user"
unless $> == (getpwnam($INN::Config::newsuser))[2];
-$debug = -t STDOUT ? 1 : 0;
+my $debug = -t STDOUT ? 1 : 0;
-$| = 1; # show output as it happens (for an rsh/ssh pipe)
+local $| = 1; # show output as it happens (for an rsh/ssh pipe)
# Guess at best flags for a condensed diff listing. The
# checks for alternative operating systems is incomplete.
@@ -41,28 +42,20 @@ unless ($diff_flags) {
print "reading list of groups to update\n" if $debug;
-$eval = "while (<OLDACT>) {\n";
-$eval .= " \$group = (split)[0];\n";
-
+my (%toadd, %todelete, %tochange);
while (<>) {
if (/^\s*\S*ctlinnd newgroup (\S+) (\S+)/) {
$toadd{$1} = $2;
$changes++;
} elsif (/^\s*\S*ctlinnd rmgroup (\S+)/) {
- $eval .= " next if \$group eq '$1';\n";
+ $todelete{$1} = 1;
$changes++;
} elsif (/^\s*\S*ctlinnd changegroup (\S+) (\S+)/) {
- $eval .= " s/ \\S+\$/ $2/ if \$group eq '$1';\n";
+ $tochange{$1} = $2;
$changes++;
}
}
-$eval .= " delete \$toadd{\$group};\n";
-$eval .= " if (!print(NEWACT \$_)) {\n";
-$eval .= " die \"\$0: writing \$newact failed (\$!), aborting\\n\";\n";
-$eval .= " }\n";
-$eval .= "}\n";
-
if ($changes == 0) {
print "active file not changed\n" if $debug;
exit 0;
@@ -70,43 +63,54 @@ if ($changes == 0) {
print "$changes change(s) to do\n" if $debug;
-&ctlinnd("pause $pausemsg");
+ctlinnd("pause $pausemsg");
-open(OLDACT, "< $oldact") || die "$0: open $oldact: $!\n";
-open(NEWACT, "> $newact") || die "$0: open $newact: $!\n";
+open my $OLDACT, '<', $oldact || die "$0: open $oldact: $!\n";
+open my $NEWACT, '>', $newact || die "$0: open $newact: $!\n";
print "rewriting active file\n" if $debug;
-eval $eval;
+
+while (<$OLDACT>) {
+ my $group = (split)[0];
+ next if exists $todelete{$group};
+ s/ \S+$/ $tochange{$group}/ if exists $tochange{$group};
+ delete $toadd{$group};
+ if (!print $NEWACT $_) {
+ ctlinnd("go $pausemsg");
+ die "$0: writing $newact failed ($!), aborting\n";
+ }
+}
+
for (sort keys %toadd) {
- $add = "$_ 0000000000 0000000001 $toadd{$_}\n";
- if (!print(NEWACT $add)) {
- &ctlinnd("go $pausemsg");
+ my $add = "$_ 0000000000 0000000001 $toadd{$_}\n";
+ if (!print $NEWACT $add) {
+ ctlinnd("go $pausemsg");
die "$0: writing $newact failed ($!), aborting\n";
}
}
-close(OLDACT) || warn "$0: close $oldact: $!\n";
-close(NEWACT) || warn "$0: close $newact: $!\n";
+close $OLDACT || warn "$0: close $oldact: $!\n";
+close $NEWACT || warn "$0: close $newact: $!\n";
-if (!rename("$oldact", "$oldact.old")) {
+if (!rename "$oldact", "$oldact.old") {
warn "$0: rename $oldact $oldact.old: $!\n";
}
-if (!rename("$newact", "$oldact")) {
+if (!rename "$newact", "$oldact") {
die "$0: rename $newact $oldact: $!\n";
}
-&ctlinnd("reload active 'updated from checkgroups'");
-system("diff $diff_flags $oldact.old $oldact");
-&ctlinnd("go $pausemsg");
+ctlinnd("reload active 'updated from checkgroups'");
+system "diff $diff_flags $oldact.old $oldact";
+ctlinnd("go $pausemsg");
print "updating $actime\n" if $debug;
-if (open(TIMES, ">> $actime")) {
- $time = time;
+if (open my $TIMES, '>>', $actime) {
+ my $time = time;
for (sort keys %toadd) {
- print TIMES "$_ $time checkgroups-update\n" || last;
+ print $TIMES "$_ $time checkgroups-update\n" || last;
}
- close(TIMES) || warn "$0: close $actime: $!\n";
+ close $TIMES || warn "$0: close $actime: $!\n";
} else {
warn "$0: $actime not updated: $!\n";
}
@@ -118,13 +122,11 @@ if (! chmod 0664, $oldact, "$oldact.old", $actime) {
exit 0;
-sub
-ctlinnd
-{
- local($command) = @_;
+sub ctlinnd {
+ my ($command) = @_;
print "ctlinnd $command\n" if $debug;
- if (system("$INN::Config::newsbin/ctlinnd -s $command")) {
+ if (system "$INN::Config::newsbin/ctlinnd -s $command") {
die "$0: \"$command\" failed, aborting\n";
}
}
diff --git a/control/signcontrol.in b/control/signcontrol.in
index 88974b5..0b81b99 100644
--- a/control/signcontrol.in
+++ b/control/signcontrol.in
@@ -1,4 +1,5 @@
#! /usr/bin/perl -w
+use strict;
# written April 1996, <tale at isc.org> (David C Lawrence)
# Currently maintained by Russ Allbery <rra at stanford.edu>
# Version 1.8, 2003-07-06
@@ -59,11 +60,11 @@
# work to lock against other instances of signcontrol, not all pgp uses.
# $pgplock is not used if $pgp ends in 'gpg' since GnuPG doesn't need
# this.
-$pgpsigner = 'INSERT_YOUR_PGP_USERID';
-$pgppassfile = ''; # file with pass phrase for $pgpsigner
-$pgp = "/usr/local/bin/pgp";
-$pgpheader = "X-PGP-Sig";
-$pgplock = (getpwuid($<))[7] . '/.pgp/config.txt';
+my $pgpsigner = 'INSERT_YOUR_PGP_USERID';
+my $pgppassfile = ''; # file with pass phrase for $pgpsigner
+my $pgp = "/usr/local/bin/pgp";
+my $pgpheader = "X-PGP-Sig";
+my $pgplock = (getpwuid($<))[7] . '/.pgp/config.txt';
# this program is strict about always wanting to be consistent about what
# headers appear in the control messages. the defaults for the
@@ -74,6 +75,7 @@ $pgplock = (getpwuid($<))[7] . '/.pgp/config.txt';
# Subject: is forced to be the Control header prepending by "cmsg". also,
# Newsgroups: is forced to be just the group being added/removed.
# (but is taken as-is for checkgroups)
+my %force;
$force{'Path'} = 'bounce-back';
$force{'From'} = 'YOUR_ADDRESS_AND_NAME';
$force{'Approved'} = 'ADDRESS_FOR_Approved_HEADER';
@@ -85,7 +87,7 @@ $force{'X-Info'}='ftp://ftp.isc.org/pub/pgpcontrol/README.html'
# created with the given value. None are enabled by default, because they
# should not be necessary. Setting one to a null string will pass through
# any instance of it found in the input, but not generate one if it is
-# missing. If you set any $default{} variables, you must also put it in
+# missing. If you set any $use_or_add{} variables, you must also put it in
# @orderheaders below.
#
# Note that Distribution nearly never works correctly, so use it only if
@@ -93,13 +95,14 @@ $force{'X-Info'}='ftp://ftp.isc.org/pub/pgpcontrol/README.html'
# you intend. This normally means that you control all servers the
# distribution will go to with an iron fist.
#
+my %use_or_add;
# $use_or_add{'Reply-To'} = 'YOUR_REPLY_ADDRESS';
# $use_or_add{'Oranization'} = 'YOUR_ORGANIZATION';
# $use_or_add{'Distribution'} = 'MESSAGE_DISTRIBUTION';
# host for message-id; this could be determined automatically based on
# where it is run, but consistency is the goal here
-$id_host = 'FULL_HOST_NAME';
+my $id_host = 'FULL_HOST_NAME';
# headers to sign. Sender is included because non-PGP authentication uses
# it. The following should always be signed:
@@ -109,12 +112,12 @@ $id_host = 'FULL_HOST_NAME';
# Date -- guards against replay attacks.
# From -- used by news systems as part of authenticating the message.
# Sender -- used by news systems as part of authenticating the message.
- at signheaders = ('Subject', 'Control', 'Message-ID', 'Date', 'From', 'Sender');
+my @signheaders = ('Subject', 'Control', 'Message-ID', 'Date', 'From', 'Sender');
# headers to remove from real headers of final message.
# If it is a signed header, it is signed with an empty value.
# set to () if you do not want any headers removed.
- at ignoreheaders = ('Sender');
+my @ignoreheaders = ('Sender');
# headers that will appear in final message, and their order of
# appearance. all _must_ be set, either in input or via the $force{} and
@@ -130,7 +133,7 @@ $id_host = 'FULL_HOST_NAME';
# any non-null header in the input but not in @orderheaders or @ignoreheaders
# is an error.
# null headers are silently dropped.
- at orderheaders =
+my @orderheaders =
('Path', 'From', 'Newsgroups', 'Subject', 'Control', 'Approved',
'Message-ID', 'Date', 'Lines', 'X-Info', $pgpheader);
@@ -141,7 +144,7 @@ $id_host = 'FULL_HOST_NAME';
# set to match only hierarchies you will use it on
# include no '|' for a single hierarchy (eg, "$hierarchies = 'uk';").
-$hierarchies = 'HIERARCHIES';
+my $hierarchies = 'HIERARCHIES';
# the draft news article format standard says:
# "subsequent components SHOULD begin with a letter"
@@ -157,11 +160,11 @@ $hierarchies = 'HIERARCHIES';
# newsgroups that have name components that begin with a letter, like
# news.announce.newgroups does with comp.sys.3b1 and 17 other groups.
-$start_component_with_letter = 'MUST';
+my $start_component_with_letter = 'MUST';
## END CONFIGURATION
-use Fcntl qw(F_SETFD);
+use Fcntl qw(F_SETFD LOCK_EX);
use FileHandle;
use IPC::Open3 qw(open3);
use POSIX qw(setlocale strftime LC_TIME);
@@ -171,18 +174,19 @@ $0 =~ s#^.*/##;
die "Usage: $0 < message\n" if @ARGV > 0;
+my $LOCK;
umask(0022); # flock needs a writable file, if we create it
if ($pgp !~ /gpg$/) {
- open(LOCK, ">>$pgplock") || die "$0: open $pgplock: $!, exiting\n";
- flock(LOCK, 2); # block until locked
+ open $LOCK, '>>', $pgplock || die "$0: open $pgplock: $!, exiting\n";
+ flock $LOCK, LOCK_EX; # block until locked
}
-&setgrouppat;
+my ($die, $group, $action, $grouppat, %header, $moderated, $body, @ERROR);
-$die = '';
+setgrouppat();
-&readhead;
-&readbody;
+readhead();
+readbody();
if ($die) {
if ($group) {
@@ -196,20 +200,18 @@ if ($die) {
}
}
-&signit;
+signit();
if ($pgp !~ /gpg$/) {
- close(LOCK) || warn "$0: close $pgplock: $!\n";
+ close $LOCK || warn "$0: close $pgplock: $!\n";
}
exit 0;
-sub
-setgrouppat
-{
- my ($hierarchy, $plain_component, $no_component);
+
+sub setgrouppat {
+ my ($plain_component, $no_component);
my ($must_start_letter, $should_start_letter);
- my ($eval);
# newsgroup name checks based on RFC 1036bis (not including encodings) rules:
# "component MUST contain at least one letter"
@@ -238,29 +240,25 @@ setgrouppat
die "$0: unknown value configured for \$start_component_with_letter\n";
}
- foreach $hierarchy (split(/\|/, $hierarchies)) {
+ foreach my $hierarchy (split /\|/, $hierarchies) {
die "$0: hierarchy name $hierarchy not standards-compliant\n"
if $hierarchy !~ /^$plain_component$/o;
}
- $eval = "\$_ = 'test'; /$grouppat/;";
- eval $eval;
+ eval { 'test' =~ /$grouppat/ };
die "$0: bad regexp for matching group names:\n $@" if $@;
+ return;
}
-sub
-readhead
-
-{
- my($head, $label, $value);
- local($_, $/);
+sub readhead {
+ my ($head, $label, $value);
- $/ = "";
+ local $/ = "";
$head = <STDIN>; # get the whole news header
$die .= "$0: continuation lines in headers not allowed\n"
if $head =~ s/\n[ \t]+/ /g; # rejoin continued lines
- for (split(/\n/, $head)) {
+ foreach (split /\n/, $head) {
if (/^(\S+): (.*)/) {
$label = $1;
$value = $2;
@@ -317,17 +315,14 @@ readhead
} else {
$die .= "$0: can't verify message content; missing Control header\n";
}
+ return;
}
-sub
-readbody
+sub readbody {
+ my ($status, $ngline, $fixline, $used, $desc, $mods);
-{
- local($_, $/);
- local($status, $ngline, $fixline, $used, $desc, $mods);
-
- undef $/;
- $body = $_ = <STDIN>;
+ local $/ = undef;
+ $body = <STDIN>; # slurp the rest of the article
$header{'Lines'} = $body =~ tr/\n/\n/ if $body;
# the following tests are based on the structure of a
@@ -373,7 +368,7 @@ readbody
# checkgroups have structured bodies
if ($action eq 'check') {
- for (split(/\n/, $body)) {
+ for (split /\n/, $body) {
my ($group, $description) = /^(\S+)\t+(.+)/;
$die .= "$0: no group:\n $_\n" unless $group;
$die .= "$0: no description:\n $_\n" unless $description;
@@ -383,6 +378,7 @@ readbody
$die .= "$0: $group line too long\n" if length(expand($_)) > 80;
}
}
+ return;
}
# Create a detached signature for the given data. The first argument
@@ -497,22 +493,19 @@ sub pgp_sign {
}
shift @signature;
pop @signature;
- $signature = join ('', @signature);
+ $signature = join '', @signature;
chomp $signature;
undef @ERROR;
return wantarray ? ($signature, $version) : $signature;
}
-sub
-signit
-
-{
- my($head, $header, $signheaders, $pgpflags, $pgpbegin, $pgpend);
+sub signit {
+ my ($head, $signheaders);
# Form the message to be signed.
- $signheaders = join(",", @signheaders);
+ $signheaders = join ",", @signheaders;
$head = "X-Signed-Headers: $signheaders\n";
- foreach $header (@signheaders) {
+ foreach my $header (@signheaders) {
$head .= "$header: $header{$header}\n";
}
my $message = "$head\n$body";
@@ -521,15 +514,15 @@ signit
my $passphrase;
if ($pgppassfile && -f $pgppassfile) {
$pgppassfile =~ s%^(\s)%./$1%;
- if (open (PGPPASS, "< $pgppassfile\0")) {
- $passphrase = <PGPPASS>;
- close PGPPASS;
+ if (open my $PGPPASS, '<', $pgppassfile) {
+ $passphrase = <$PGPPASS>;
+ close $PGPPASS;
chomp $passphrase;
}
}
# Sign the message, getting the signature and PGP version number.
- my ($signature, $version) = pgp_sign ($pgpsigner, $passphrase, $message);
+ my ($signature, $version) = pgp_sign($pgpsigner, $passphrase, $message);
unless ($signature) {
die "@ERROR\n$0: could not generate signature\n";
}
@@ -547,18 +540,19 @@ signit
}
$head = '';
- foreach $header (@orderheaders) {
+ foreach my $header (@orderheaders) {
$head .= "$header: $header{$header}\n" if $header{$header};
delete $header{$header};
}
- foreach $header (keys %header) {
+ foreach my $header (keys %header) {
die "$0: unexpected header $header left in header array\n";
}
print STDOUT $head;
print STDOUT "\n";
print STDOUT $body;
+ return;
}
# Our lawyer told me to include the following. The upshot of it is that
diff --git a/frontends/cnfsheadconf.in b/frontends/cnfsheadconf.in
index bcfecc7..266a760 100644
--- a/frontends/cnfsheadconf.in
+++ b/frontends/cnfsheadconf.in
@@ -17,15 +17,15 @@
# cnfsheadconf is originally from cnfsstat 1999
# <kondou at nec.co.jp>
-use vars qw($opt_h $opt_w);
+use strict;
use Getopt::Long;
# Required for >32bit integers.
use Math::BigInt;
use Math::BigFloat;
-my($conffile) = "$INN::Config::pathetc/cycbuff.conf";
-my($storageconf) = "$INN::Config::pathetc/storage.conf";
+my $conffile = "$INN::Config::pathetc/cycbuff.conf";
+my $storageconf = "$INN::Config::pathetc/storage.conf";
# Hex to bigint conversion routine.
# bhex(HEXSTRING) returns BIGINT (with leading + chopped off).
@@ -80,7 +80,7 @@ sub bint2hex {
}
sub usage {
- print <<_end_;
+ print <<"_end_";
Summary tool for cycbuff header manipulation
Usage:
@@ -94,45 +94,46 @@ _end_
exit(1);
}
-my(@line, %class, %metamode, %buff, %stor, $c, @buffers, $cycbuff);
+my (%buff, $cycbuff, $opt_w);
-my($gr, $cl, $min, $max, @storsort, $header_printed);
+GetOptions(
+ 'c=s' => \$cycbuff,
+ 'w' => \$opt_w,
+ 'h|help' => sub { usage() },
+);
-GetOptions("-c=s", \$cycbuff, "-w", "-h");
-
-&usage if $opt_h;
-
-unless (&read_cycbuffconf) {
+unless (read_cycbuffconf()) {
print STDERR "Cannot open CycBuff Conffile $conffile ...\n";
exit (1);
}
-unless (&read_storageconf) {
+unless (read_storageconf()) {
print STDERR "No valid $storageconf.\n";
exit (1);
}
sub read_cycbuffconf {
- return 0 unless open (CONFFILE, $conffile);
+ my (@line, %class, %metamode);
+ return 0 unless open my $CONFFILE, '<', $conffile;
- while(<CONFFILE>) {
+ while (<$CONFFILE>) {
$_ =~ s/^\s*(.*?)\s*$/$1/;
# Read continuation lines.
while(/\\$/) {
chop;
- chop($next = <CONFFILE>);
+ chop (my $next = <$CONFFILE>);
$next =~ s/^\s*(.*?)\s*$/$1/;
$_ .= $next;
}
# \x23 below is #. Emacs perl-mode gets confused by the "comment".
- next if($_ =~ /^\s*$/ || $_ =~ /^\x23/);
- next if($_ =~ /^cycbuffupdate:/ || $_ =~ /^refreshinterval:/);
+ next if ($_ =~ /^\s*$/ || $_ =~ /^\x23/);
+ next if ($_ =~ /^cycbuffupdate:/ || $_ =~ /^refreshinterval:/);
if($_ =~ /^metacycbuff:/) {
@line = split(/:/, $_);
- if($class{$line[1]}) {
+ if ($class{$line[1]}) {
print STDERR "Class $line[1] more than one time in CycBuff Conffile $conffile ...\n";
return 0;
}
@@ -148,7 +149,7 @@ sub read_cycbuffconf {
if ($_ =~ /^cycbuff/) {
@line = split(/:/, $_);
- if($buff{$line[1]}) {
+ if ($buff{$line[1]}) {
print STDERR "Buff $line[1] more than one time in CycBuff Conffile $conffile ...\n";
return 1;
}
@@ -158,24 +159,25 @@ sub read_cycbuffconf {
print STDERR "Unknown config line \"$_\" in CycBuff Conffile $conffile ...\n";
}
- close(CONFFILE);
+ close $CONFFILE;
return 1;
}
sub read_storageconf {
my $line = 0;
- return 0 unless open (STOR, $storageconf);
+ my %stor;
+ return 0 unless open my $STOR, '<', $storageconf;
- while (<STOR>) {
+ while (<$STOR>) {
++$line;
next if /^\s*#/;
# defaults
- %key = ("NEWSGROUPS" => "*",
- "SIZE" => "0,0");
+ my %key = ("NEWSGROUPS" => "*",
+ "SIZE" => "0,0");
if (/method\s+cnfs\s+\{/) {
- while (<STOR>) {
+ while (<$STOR>) {
++$line;
next if /^\s*#/;
last if /\}/;
@@ -198,10 +200,10 @@ sub read_storageconf {
} else {
$stor{$key{'OPTIONS'}} = "$key{'NEWSGROUPS'}:$key{'CLASS'}:" .
"$key{'SIZE'}:$key{'OPTIONS'}";
- push(@storsort, $key{'OPTIONS'});
}
}
}
+ close $STOR;
return 1;
}
@@ -210,7 +212,7 @@ START:
# If no cycbuff is specified, we check all of them and exit.
if (not defined $cycbuff) {
foreach (sort keys %buff) {
- &print_cycbuff_head($buff{$_});
+ print_cycbuff_head($buff{$_});
}
exit(0);
}
@@ -220,7 +222,7 @@ if (not defined $buff{$cycbuff}) {
exit(1);
}
-&print_cycbuff_head($buff{$cycbuff});
+print_cycbuff_head($buff{$cycbuff});
sub make_time {
my ($t) = @_;
@@ -242,67 +244,66 @@ sub make_time {
}
sub print_cycbuff_head {
- my($buffpath) = $_[0];
- my($CNFSMASIZ)=8;
- my($CNFSNASIZ)=16;
- my($CNFSPASIZ)=64;
- my($CNFSLASIZ)=16;
- my($headerlength) = 2 * $CNFSMASIZ + 2 * $CNFSNASIZ + $CNFSPASIZ + (6 * $CNFSLASIZ);
- my($buff, @entries, $e);
- my($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname, $orderinmetaa, $currentbuff, $blksza);
+ my ($buffpath) = @_;
+ my $CNFSMASIZ = 8;
+ my $CNFSNASIZ = 16;
+ my $CNFSPASIZ = 64;
+ my $CNFSLASIZ = 16;
+ my $headerlength = 2 * $CNFSMASIZ + 2 * $CNFSNASIZ + $CNFSPASIZ + (6 * $CNFSLASIZ);
+ my ($BUFF, $buff);
if ($opt_w) {
- if(! open(BUFF, "+< $buffpath") ) {
+ if ( !open $BUFF, '+<', $buffpath ) {
print STDERR "Cannot open Cycbuff $buffpath ...\n";
exit(1);
}
} else {
- if(! open(BUFF, "< $buffpath") ) {
+ if ( !open $BUFF, '<', $buffpath ) {
print STDERR "Cannot open Cycbuff $buffpath ...\n";
exit(1);
}
}
$buff = "";
- if(! read(BUFF, $buff, $headerlength) ) {
+ if ( !read $BUFF, $buff, $headerlength ) {
print STDERR "Cannot read $headerlength bytes from file $buffpath...\n";
exit(1);
}
- ($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname, $orderinmetaa, $currentbuff, $blksza) = unpack("a8 a16 a64 a16 a16 a16 a16 a16 a16 a8 a16", $buff);
+ my ($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname, $orderinmetaa, $currentbuff, $blksza) = unpack("a8 a16 a64 a16 a16 a16 a16 a16 a16 a8 a16", $buff);
- if(!$magic) {
+ if (!$magic) {
print STDERR "Error while unpacking header ...\n";
exit(1);
}
- my($len) = bhex($lena);
- my($free) = bhex($freea);
- my($update) = hex($updatea);
- my($cyclenum) = hex($cyclenuma) - 1;
- my($orderinmeta) = hex($orderinmetaa);
- my($blksz) = ($magic =~ m/^CBuf4/) ? hex($blksza) : 512;
+ my $len = bhex($lena);
+ my $free = bhex($freea);
+ my $update = hex($updatea);
+ my $cyclenum = hex($cyclenuma) - 1;
+ my $orderinmeta = hex($orderinmetaa);
+ my $blksz = ($magic =~ m/^CBuf4/) ? hex($blksza) : 512;
- my ($nupdate_str, $nago_str) = &make_time ($update);
+ my ($nupdate_str, $nago_str) = make_time($update);
$name =~ s/\0//g;
print " Buffer $name, len: ";
- printf("%.2f", Math::BigFloat->new($len) / (1024 * 1024));
+ printf "%.2f", Math::BigFloat->new($len) / (1024 * 1024);
print " Mbytes, used: ";
- printf("%.2f Mbytes", Math::BigFloat->new($free) / (1024 * 1024));
- printf(" (%4.1f%%) %3d cycles\n",
+ printf "%.2f Mbytes", Math::BigFloat->new($free) / (1024 * 1024);
+ printf " (%4.1f%%) %3d cycles\n",
100 * Math::BigFloat->new($free) / Math::BigFloat->new($len),
- $cyclenum);
- print(" Meta $metaname, order: ");
- printf("%d", $orderinmeta);
- print(", current: $currentbuff");
- print(", blocksize: $blksz");
+ $cyclenum;
+ print " Meta $metaname, order: ";
+ printf "%d", $orderinmeta;
+ print ", current: $currentbuff";
+ print ", blocksize: $blksz";
print "\n Newest: $nupdate_str, $nago_str ago\n";
if ($opt_w) {
print "\nBuffer [$name] => ";
- $in = <>;
+ my $in = <>;
chop $in;
if ($in ne "") {
$name = sprintf("%0.9s\0", $in);
@@ -348,11 +349,12 @@ sub print_cycbuff_head {
}
$buff = pack("a8 a16 a64 a16 a16 a16 a16 a16 a16 a8", $magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname, $orderinmetaa, $currentbuff);
$buff .= pack("a16", $blksza) if ($magic =~ m/^CBuf4/);
- seek(BUFF, 0, 0);
- if(! syswrite(BUFF, $buff, $headerlength) ) {
+ seek $BUFF, 0, 0;
+ if(! syswrite $BUFF, $buff, $headerlength ) {
print STDERR "Cannot write $headerlength bytes to file $buffpath...\n";
exit(1);
}
}
- close(BUFF);
+ close $BUFF;
+ return;
}
diff --git a/frontends/cnfsstat.in b/frontends/cnfsstat.in
index 864cf45..ecabf81 100644
--- a/frontends/cnfsstat.in
+++ b/frontends/cnfsstat.in
@@ -14,17 +14,17 @@
#
# bigint support added by Duane Currie (sandman at hub.org) 1998
-use vars qw($opt_a $opt_h $opt_l $opt_p $opt_P $opt_s $opt_v);
+use strict;
use Getopt::Long;
use Math::BigInt;
use Math::BigFloat;
use English;
-my($conffile) = "$INN::Config::pathetc/cycbuff.conf";
-my($storageconf) = "$INN::Config::pathetc/storage.conf";
+my $conffile = "$INN::Config::pathetc/cycbuff.conf";
+my $storageconf = "$INN::Config::pathetc/storage.conf";
sub usage {
- print <<_end_;
+ print <<"_end_";
Summary tool for CNFS
Usage:
@@ -44,18 +44,19 @@ _end_
exit(1);
}
-my(@line, %class, %buff, %stor, $c, @buffers);
-
-my($gr, $cl, $min, $max, @storsort, $oclass, $header_printed);
-my $use_syslog = 0;
+my (%class, %buff, %stor, @storsort, @buffers);
+my ($oclass, $obuffer);
+my %opt = (c=>\$oclass, m=>\$obuffer);
Getopt::Long::config('no_ignore_case');
-GetOptions("-a", "-c=s", \$oclass, "-h", "-l:i", "-m=s", \$obuffer,
+GetOptions(\%opt,
+ "-a", "-c=s", "-h", "-l:i", "-m=s",
"-p", "-P", "-s", "-v");
-&usage if $opt_h;
+usage() if $opt{'h'};
-if ($opt_s) {
+my $use_syslog = 0;
+if ($opt{'s'}) {
eval { require Sys::Syslog; import Sys::Syslog; $use_syslog = 1 };
if ($use_syslog) {
if ($Sys::Syslog::VERSION < 0.15) {
@@ -68,40 +69,35 @@ if ($opt_s) {
}
}
-if ($opt_P) {
- open(FILE, ">$INN::Config::pathrun/cnfsstat.pid") && do {
- print FILE "$$\n";
- close FILE;
+if ($opt{'P'}) {
+ if (open my $FILE, '>', "$INN::Config::pathrun/cnfsstat.pid") {
+ print $FILE "$$\n";
+ close $FILE;
};
}
-my($sleeptime) = (defined($opt_l) && $opt_l > 0) ? $opt_l : 600;
+my $sleeptime = (defined($opt{'l'}) && $opt{'l'} > 0) ? $opt{'l'} : 600;
-unless (&read_cycbuffconf) {
+unless (read_cycbuffconf()) {
print STDERR "Cannot open CycBuff Conffile $conffile ...\n";
exit (1);
}
-unless (&read_storageconf) {
+unless (read_storageconf()) {
print STDERR "No valid $storageconf.\n";
exit (1);
}
-&mrtg($obuffer) if $obuffer;
-&mrtg_config if $opt_p;
+mrtg($obuffer) if $obuffer;
+mrtg_config() if $opt{'p'};
-#foreach $c (keys(%class)) {
-# print "Class: $c, definition: $class{$c}\n";
-#}
-#foreach $c (keys(%buff)) {
-# print "Buff: $c, definition: $buff{$c}\n";
-#}
-# exit(0);
START:
-undef($logline);
+my $logline;
+my $header_printed = 0;
+my ($gr, $cl, $min, $max);
if ($oclass) {
if ($class{$oclass}) {
if (!$header_printed) {
@@ -133,19 +129,19 @@ if ($oclass) {
next;
}
- foreach $b (@buffers) {
+ foreach my $b (@buffers) {
if (! $buff{$b} ) {
print STDERR "No buffer definition for buffer $b ...\n";
next;
}
- &print_cycbuff_head($buff{$b});
+ print_cycbuff_head($buff{$b});
}
} else {
print STDERR "Class $oclass not found ...\n";
}
} else { # Print all Classes
- foreach $c (@storsort) {
+ foreach my $c (@storsort) {
($gr, $cl, $min, $max) = split(/:/, $stor{$c});
if ($use_syslog) {
if ($min || $max) {
@@ -167,12 +163,12 @@ if ($oclass) {
next;
}
- foreach $b (@buffers) {
+ foreach my $b (@buffers) {
if(! $buff{$b} ) {
print STDERR "No buffer definition for buffer $b ...\n";
next;
}
- &print_cycbuff_head($buff{$b});
+ print_cycbuff_head($buff{$b});
}
if (!$use_syslog) {
print STDOUT "\n";
@@ -180,7 +176,7 @@ if ($oclass) {
}
}
-if(defined($opt_l)) {
+if(defined($opt{'l'})) {
sleep($sleeptime);
if (!$use_syslog) {
print STDOUT "$sleeptime seconds later:\n";
@@ -189,24 +185,25 @@ if(defined($opt_l)) {
}
sub read_cycbuffconf {
- return 0 unless open (CONFFILE, $conffile);
+ my @line;
+ return 0 unless open my $CONFFILE, '<', $conffile;
- while(<CONFFILE>) {
+ while(<$CONFFILE>) {
$_ =~ s/^\s*(.*?)\s*$/$1/;
# Here we handle continuation lines
while (m/\\$/) {
- $contline = <CONFFILE>;
+ my $contline = <$CONFFILE>;
$contline =~ s/^\s*(.*?)\s*$/$1/;
chop;
$_ .= $contline;
}
# \x23 below is #. Emacs perl-mode gets confused by the "comment"
- next if($_ =~ /^\s*$/ || $_ =~ /^\x23/);
- next if($_ =~ /^cycbuffupdate:/ || $_ =~ /^refreshinterval:/);
+ next if ($_ =~ /^\s*$/ || $_ =~ /^\x23/);
+ next if ($_ =~ /^cycbuffupdate:/ || $_ =~ /^refreshinterval:/);
if($_ =~ /^metacycbuff:/) {
@line = split(/:/, $_);
- if($class{$line[1]}) {
+ if ($class{$line[1]}) {
print STDERR "Class $line[1] more than one time in CycBuff Conffile $conffile ...\n";
return 0;
}
@@ -217,7 +214,7 @@ sub read_cycbuffconf {
if ($_ =~ /^cycbuff/) {
@line = split(/:/, $_);
- if($buff{$line[1]}) {
+ if ($buff{$line[1]}) {
print STDERR "Buff $line[1] more than one time in CycBuff Conffile $conffile ...\n";
return 1;
}
@@ -227,24 +224,24 @@ sub read_cycbuffconf {
print STDERR "Unknown config line \"$_\" in CycBuff Conffile $conffile ...\n";
}
- close(CONFFILE);
+ close $CONFFILE;
return 1;
}
sub read_storageconf {
my $line = 0;
- return 0 unless open (STOR, $storageconf);
+ return 0 unless open my $STOR, '<', $storageconf;
- while (<STOR>) {
+ while (<$STOR>) {
++$line;
next if /^\s*#/;
# defaults
- %key = ("NEWSGROUPS" => "*",
- "SIZE" => "0,0");
+ my %key = ("NEWSGROUPS" => "*",
+ "SIZE" => "0,0");
if (/method\s+cnfs\s+\{/) {
- while (<STOR>) {
+ while (<$STOR>) {
++$line;
next if /^\s*#/;
last if /\}/;
@@ -272,9 +269,9 @@ sub read_storageconf {
}
sub print_cycbuff_head {
- my ($buffpath) = $_[0];
+ my ($buffpath) = @_;
my ($name, $len, $free, $update, $cyclenum, $oldart) =
- &get_cycbuff_info($buffpath);
+ get_cycbuff_info($buffpath);
if ($use_syslog) {
($name) = split(/\s/, $name);
@@ -287,27 +284,28 @@ sub print_cycbuff_head {
}
$name =~ s/\0//g;
- print " Buffer $name, size: ", &human_readable($len, 4);
- print ", position: ", &human_readable($free, 4);
- printf(" %.2f cycles\n", $cyclenum + Math::BigFloat->new($free) / Math::BigFloat->new($len));
+ print " Buffer $name, size: ", human_readable($len, 4);
+ print ", position: ", human_readable($free, 4);
+ printf " %.2f cycles\n", $cyclenum + Math::BigFloat->new($free) / Math::BigFloat->new($len);
# The CNFS buffer may not have been initialized yet or received an article.
# Take it into account because $oldart may be undefined.
- my ($when, $ago) = &make_time($update);
- if (defined $oldart || not $opt_a) {
+ my ($when, $ago) = make_time($update);
+ if (defined $oldart || not $opt{'a'}) {
print " Newest: $when, $ago ago\n";
} else {
print " Created: $when, $ago ago\n";
}
- if ($opt_a) {
+ if ($opt{'a'}) {
if (defined $oldart) {
- my ($when, $ago) = &make_time($oldart);
+ my ($when, $ago) = make_time($oldart);
print " Oldest: $when, $ago ago\n";
} else {
print " No oldest article\n";
}
}
+ return;
}
sub make_time {
@@ -357,7 +355,7 @@ sub human_readable {
sub mrtg {
my $buffer = shift;
# print "Buffer = $buff{$buffer}\n";
- @info = &get_cycbuff_info($buff{$buffer});
+ my @info = get_cycbuff_info($buff{$buffer});
print "$info[1]\n";
print "$info[2]\n";
print "$info[4]\n";
@@ -367,10 +365,10 @@ sub mrtg {
sub mrtg_config {
print "Sub MRTG-CONFIG\n";
- foreach $class (sort(keys(%class))) {
+ foreach my $class (sort(keys(%class))) {
print "##\n## Class : $class\n## Wildmat: $stor{$class}\n##\n\n";
- foreach $buffer (split /\,/,$class{$class}) {
- &mrtg_buffer($class,$buffer);
+ foreach my $buffer (split /\,/,$class{$class}) {
+ mrtg_buffer($class,$buffer);
}
}
exit(0);
@@ -379,10 +377,10 @@ sub mrtg_config {
sub mrtg_buffer {
my ($class,$buffer) = @_;
#my ($name, $num, $buff, $size) = @_;
- $tag = 'cnfs-' . $buffer;
+ my $tag = 'cnfs-' . $buffer;
print 'Target[', $tag, ']: `', "$INN::Config::pathbin/cnfsstat -m ", $buffer, '`', "\n";
- print 'MaxBytes[', $tag, ']: ', (&get_cycbuff_info($buff{$buffer}))[1], "\n";
+ print 'MaxBytes[', $tag, ']: ', (get_cycbuff_info($buff{$buffer}))[1], "\n";
print 'Title[', $tag, ']: ', "${buffer} Usage\n";
print 'Options[', $tag, ']: growright gauge', "\n";
print 'YLegend[', $tag, ']: ', "${buffer}\n";
@@ -390,23 +388,23 @@ sub mrtg_buffer {
print 'PageTop[', $tag, ']: ', "<H1>Usage of ${buffer}</H1>\n";
print "<BR><TT>$stor{$class}</TT>\n";
print "\n";
- 1;
+ return 1;
}
sub bigsysseek {
- my($handle, $offset) = @_;
+ my ($handle, $offset) = @_;
# $offset may be a bigint; and have a value that doesn't fit in a signed long.
# Even with largefiles enabled, perl will still truncate the argument to lseek64
# to 32 bits. So we seek multiple times, <2G at a time.
- if($offset > 2147483647) {
+ if ($offset > 2147483647) {
# Since perl truncates the return value of lseek64 to 32 bits, it might
# see a successful return value as negative, and return FALSE (undef).
# So we must ignore the return value of sysseek and assume that it worked.
seek($handle, 0, 0);
- while($offset > 2000000000) {
+ while ($offset > 2000000000) {
sysseek($handle, 2000000000, 1) || return 0;
$offset -= 2000000000;
}
@@ -425,46 +423,44 @@ sub check_read_return {
}
sub get_cycbuff_info {
- my($buffpath) = $_[0];
+ my ($buffpath) = @_;
my $oldart;
- my($CNFSMASIZ)=8;
- my($CNFSNASIZ)=16;
- my($CNFSPASIZ)=64;
- my($CNFSLASIZ)=16;
- my($headerlength) = 2 * $CNFSMASIZ + 2 * $CNFSNASIZ + $CNFSPASIZ + (6 * $CNFSLASIZ);
+ my $CNFSMASIZ = 8;
+ my $CNFSNASIZ = 16;
+ my $CNFSPASIZ = 64;
+ my $CNFSLASIZ = 16;
+ my $headerlength = 2 * $CNFSMASIZ + 2 * $CNFSNASIZ + $CNFSPASIZ + (6 * $CNFSLASIZ);
- my($buff, @entries, $e);
- my($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma);
+ my ($BUFF, $buff);
- if(! open(BUFF, "< $buffpath") ) {
+ if ( !open $BUFF, '<', $buffpath ) {
print STDERR "Cannot open Cycbuff $buffpath ...\n";
exit(1);
}
$buff = "";
- if(! read(BUFF, $buff, $headerlength) ) {
+ if ( !read $BUFF, $buff, $headerlength ) {
print STDERR "Cannot read $headerlength bytes from file $buffpath...\n";
exit(1);
}
- use vars qw($metaname $orderinmeta $currentbuff);
- ($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname,
+ my ($magic, $name, $path, $lena, $freea, $updatea, $cyclenuma, $metaname,
$orderinmeta, $currentbuff, $blksza) =
unpack("a8 a16 a64 a16 a16 a16 a16 a16 a16 a8 a16", $buff);
- if(!$magic) {
+ if (!$magic) {
print STDERR "Error while unpacking header ...\n";
exit(1);
}
- my($len) = bhex($lena);
- my($free) = bhex($freea);
- my($update) = hex($updatea);
- my($cyclenum) = hex($cyclenuma) - 1;
- my($blksz) = ($magic =~ m/^CBuf4/) ? hex($blksza) : 512;
+ my $len = bhex($lena);
+ my $free = bhex($freea);
+ my $update = hex($updatea);
+ my $cyclenum = hex($cyclenuma) - 1;
+ my $blksz = ($magic =~ m/^CBuf4/) ? hex($blksza) : 512;
- if ($opt_a) {
+ if ($opt{'a'}) {
my $pagesize = 16384;
my $minartoffset = int($len / ($blksz * 8)) + 512;
@@ -480,15 +476,16 @@ sub get_cycbuff_info {
my $sentinel = $cyclenum == 0 ? $free : $len;
my $offset = $cyclenum == 0 ? $minartoffset : $free + $pagesize;
- bigsysseek (BUFF, $offset) || die "sysseek: $!\n";
- check_read_return (sysread (BUFF, $buff, $pagesize));
+ bigsysseek($BUFF, $offset) || die "sysseek: $!\n";
+ check_read_return (sysread ($BUFF, $buff, $pagesize));
do {
- check_read_return (sysread (BUFF, $chunk, $pagesize));
+ my $chunk;
+ check_read_return (sysread ($BUFF, $chunk, $pagesize));
$buff .= $chunk;
while ($buff =~ /^message-id:\s+(<.*?>)/mi) {
$buff = $POSTMATCH;
- $oldart = &lookup_age ($1);
+ $oldart = lookup_age($1);
next unless $oldart;
# Is the article newer than the last update of the cycbuff?
@@ -506,19 +503,19 @@ sub get_cycbuff_info {
}
done:
- close(BUFF);
+ close $BUFF;
return($name,$len,$free,$update,$cyclenum,$oldart);
}
sub lookup_age {
my ($msgid) = @_;
- my $history = &safe_run("$INN::Config::newsbin/grephistory", "-l", $msgid);
+ my $history = safe_run("$INN::Config::newsbin/grephistory", "-l", $msgid);
if ($history =~ /\t(\d+)~/) {
return $1;
}
- if ($opt_v) {
+ if ($opt{'v'}) {
print " (Missing $msgid)\n";
}
@@ -528,13 +525,13 @@ sub lookup_age {
sub safe_run {
my $output = "";
- my $pid = open(KID_TO_READ, "-|");
+ my $pid = open my $KID_TO_READ, "-|";
die "fork: $!\n" unless defined $pid;
if ($pid) {
- while (<KID_TO_READ>) {
+ while (<$KID_TO_READ>) {
$output .= $_;
}
- close(KID_TO_READ);
+ close $KID_TO_READ;
} else {
exec(@_) || die "can't exec $_[0]: $!";
# NOTREACHED
diff --git a/frontends/scanspool.in b/frontends/scanspool.in
index 08bd0da..42e6354 100644
--- a/frontends/scanspool.in
+++ b/frontends/scanspool.in
@@ -1,5 +1,6 @@
#! /usr/bin/perl -w
# fixscript will replace this line with code to load INN::Config
+use strict;
# @(#)scanspool.pl 1.20 4/6/92 00:47:35
#
@@ -72,21 +73,25 @@
# Data structures
#
+my %gname2type;
# $gname2type{$name}
# $name - newsgroup name in foo.dot.form
# produces => 4th active field (y, n, x, ...)
# alias type is "=", not "=foo.bar"
#
+my %realgname;
# $realgname{$name}
# $name - newsgroup name in foo.dot.form
# produces => newsgroup name in foo.dot.form
# if type is =, this will be a.b, not $name
#
+my %lowart;
# $lowart{$name}
# $name - newsgroup name in foo.dot.form
# produces => lowest article allowed in the group
# if type is =, this is not valid
#
+my %highart;
# $highart{$name}
# $name - newsgroup name in foo.dot.form
# produces => highest article allowed in the group
@@ -98,46 +103,38 @@
#
use Getopt::Std;
-use vars qw($opt_c);
-
-# setup non-buffered stdout and stderr
-#
-select(STDERR);
-$|=1;
-select(STDOUT);
-$|=1;
-
# global constants
#
-$prog = $0; # our name
-$spool = "$INN::Config::patharticles";
-$active = "$INN::Config::active";
-$ctlinnd = "$INN::Config::pathbin/ctlinnd";
-$reason = "running scanspool"; # throttle reason
+my $prog = $0; # our name
+my $spool = "$INN::Config::patharticles";
+my $active = "$INN::Config::active";
+my $ctlinnd = "$INN::Config::pathbin/ctlinnd";
+my $reason = "running scanspool"; # throttle reason
# parse args
#
-getopts("a:s:vcn");
-$active = $opt_a if (defined($opt_a));
-$spool = $opt_s if (defined($opt_s));
+my %opt;
+getopts("a:s:vcn", \%opt);
+$active = $opt{'a'} if defined $opt{'a'};
+$spool = $opt{'s'} if defined $opt{'s'};
# throttle innd unless -n
#
-if (! defined($opt_n)) {
+if (! defined $opt{'n'}) {
system("$ctlinnd throttle '$reason' >/dev/null 2>&1");
}
# process the active file
#
-&parse_active($active);
+parse_active($active);
# check the spool directory
#
-&check_spool($spool);
+check_spool($spool);
# unthrottle innd unless -n
#
-if (! defined($opt_n)) {
+if (! defined $opt{'n'}) {
system("$ctlinnd go '$reason' >/dev/null 2>&1");
}
@@ -147,47 +144,47 @@ exit(0);
# parse_active - parse the active file
#
-# From the active file, fill out the @gname2type (type of newsgroup)
-# and @realgname (real/non-aliased name of group), @lowart & @highart
+# From the active file, fill out the %gname2type (type of newsgroup)
+# and %realgname (real/non-aliased name of group), %lowart & %highart
# (low and high article numbers). This routine will also check for
# aliases to missing groups or groups that are also aliases.
#
sub parse_active
{
- local ($active) = $_[0]; # the name of the active file to use
- local (*ACTIVE); # active file handle
- local ($line); # active file line
- local ($name); # name of newsgroup
- local ($low); # low article number
- local ($high); # high article number
- local ($type); # type of newsgroup (4th active field)
- local ($dir); # directory path of group from $spool
- local ($alias); # realname of an aliased group
- local ($linenum); # active file line number
+ my ($active) = @_; # the name of the active file to use
+ my $ACTIVE; # active file handle
+ my $line; # active file line
+ my $name; # name of newsgroup
+ my $low; # low article number
+ my $high; # high article number
+ my $type; # type of newsgroup (4th active field)
+ my $dir; # directory path of group from $spool
+ my $alias; # realname of an aliased group
+ my $linenum; # active file line number
# if verbose (-v), say what we are doing
- print "\tscanning $active\n" if defined($opt_v);
+ print "\tscanning $active\n" if defined $opt{'v'};
# open the active file
- open (ACTIVE, $active) || &fatal(1, "cannot open $active");
+ open $ACTIVE, '<', $active || fatal(1, "cannot open $active");
# parse each line
$linenum = 0;
- while ($line = <ACTIVE>) {
+ while ($line = <$ACTIVE>) {
# count the line
++$linenum;
# verify that we have a correct number of tokens
if ($line !~ /^\S+ 0*(\d+) 0*(\d+) \S+$/o) {
- &problem("WARNING: active line is mal-formed at line $linenum");
+ problem("WARNING: active line is mal-formed at line $linenum");
next;
}
($name, $high, $low, $type) = $line =~ /^(\S+) 0*(\d+) 0*(\d+) (\S+)$/o;
# watch for duplicate entries
- if (defined($realgname{$name})) {
- &problem("WARNING: ignoring dup group: $name, at line $linenum");
+ if (defined $realgname{$name}) {
+ problem("WARNING: ignoring dup group: $name, at line $linenum");
next;
}
@@ -215,27 +212,28 @@ sub parse_active
}
# close the active file
- close (ACTIVE);
+ close $ACTIVE;
# be sure that any alias type is aliased to a real group
- foreach $name (keys %realgname) {
+ foreach my $name (keys %realgname) {
# skip if not an alias type
next if $gname2type{$name} ne "=";
# be sure that the alias exists
$alias = $realgname{$name};
- if (! defined($realgname{$alias})) {
- &problem("WARNING: alias for $name: $alias, is not a group");
+ if (! defined $realgname{$alias}) {
+ problem("WARNING: alias for $name: $alias, is not a group");
next;
}
# be sure that the alias is not an alias of something else
if ($gname2type{$alias} eq "=") {
- &problem("WARNING: alias for $name: $alias, is also an alias");
+ problem("WARNING: alias for $name: $alias, is also an alias");
next;
}
}
+ return;
}
@@ -245,15 +243,14 @@ sub parse_active
# A final newline is appended to it.
#
# usage:
-# &problem(arg, arg2, ...)
+# problem(arg, arg2, ...)
#
sub problem
{
- local ($line); # the line to write
-
# print the line with the header and newline
- $line = join(" ", @_);
+ my $line = join(" ", @_);
print STDERR $line, "\n";
+ return;
}
@@ -264,11 +261,11 @@ sub problem
# to it. This function exists with the code of exitval.
#
# usage:
-# &fatal(exitval, arg, arg2, ...)
+# fatal(exitval, arg, arg2, ...)
#
sub fatal
{
- local ($exitval) = $_[0]; # what to exit with
+ my ($exitval, @args) = @_;
# firewall
if ($#_ < 1) {
@@ -279,18 +276,17 @@ sub fatal
}
# print the error message
- shift(@_);
- $line = join(" ", @_);
+ my $line = join(" ", @args);
print STDERR "$prog: ", $line, "\n";
# unthrottle innd unless -n
#
- if (! defined($opt_n)) {
+ if (! defined $opt{'n'}) {
system("$ctlinnd go '$reason' >/dev/null 2>&1");
}
# exit
- exit($exitval);
+ exit $exitval;
}
@@ -306,38 +302,38 @@ sub fatal
#
sub check_spool
{
- local ($spooldir) = $_[0]; # top of article tree
- local ($filename); # article pathname under $spool
- local ($artgrp); # group of an article
- local ($artnum); # article number in a group
- local ($prevgrp); # previous different value of $artgrp
- local ($preverrgrp); # previous non-active $artgrp
- local (*ARTICLE); # article handle
- local ($aline); # header line from an article
- local (@group); # array of groups from the Newsgroup header
- local ($j);
+ my ($spooldir) = @_; # top of article tree
+ my $filename; # article pathname under $spool
+ my $artgrp; # group of an article
+ my $artnum; # article number in a group
+ my $prevgrp; # previous different value of $artgrp
+ my $preverrgrp; # previous non-active $artgrp
+ my $ARTICLE; # article handle
+ my $aline; # header line from an article
+ my @group; # array of groups from the Newsgroup header
+ my $FINDFILE; # find command pipe handle
# if verbose, say what we are doing
- print "\tfinding articles under $spooldir\n" if defined($opt_v);
+ print "\tfinding articles under $spooldir\n" if defined $opt{'v'};
# move to the $spool directory
- chdir $spooldir || &fatal(2, "cannot chdir to $spool");
+ chdir $spooldir || fatal(2, "cannot chdir to $spool");
# start finding files
#
- if (!open (FINDFILE,
- "find . \\( -type f -o -type l \\) -name '[0-9]*' -print 2>&1 |")) {
- &fatal(3, "cannot start find in $spool");
+ if (!open $FINDFILE, '-|',
+ "find . \\( -type f -o -type l \\) -name '[0-9]*' -print 2>&1") {
+ fatal(3, "cannot start find in $spool");
}
# process each history line
#
- while ($filename = <FINDFILE>) {
+ while ($filename = <$FINDFILE>) {
# if the line contains find:, assume it is a find error and print it
chop($filename);
if ($filename =~ /find:\s/o) {
- &problem("WARNING:", $filename);
+ problem("WARNING:", $filename);
next;
}
@@ -359,7 +355,7 @@ sub check_spool
$artgrp =~ s#/#.#go;
# if verbose (-v), then note if our group changed
- if (defined($opt_v) && $artgrp ne $prevgrp) {
+ if (defined $opt{'v'} && $artgrp ne $prevgrp) {
print "\t$artgrp\n";
$prevgrp = $artgrp;
}
@@ -370,13 +366,13 @@ sub check_spool
# If we complained about this dgroup before, don't complain again.
# If verbose, note files that could be removed.
#
- if (!defined($gname2type{$artgrp}) || $gname2type{$artgrp} =~ /[=jx]/o){
+ if (!defined $gname2type{$artgrp} || $gname2type{$artgrp} =~ /[=jx]/o){
if ($preverrgrp ne $artgrp) {
- &problem("$artgrp: not an active group directory");
+ problem("$artgrp: not an active group directory");
$preverrgrp = $artgrp;
}
- if (defined($opt_v)) {
- &problem("$filename: article found in non-active directory");
+ if (defined $opt{'v'}) {
+ problem("$filename: article found in non-active directory");
}
next;
}
@@ -385,35 +381,35 @@ sub check_spool
$artnum = $filename;
$artnum =~ s#^.+/##o;
if ($artnum =~ m/^0/o) {
- &problem("$filename: article basename starts with a 0");
+ problem("$filename: article basename starts with a 0");
}
- if (defined($gname2type{$artgrp})) {
+ if (defined $gname2type{$artgrp}) {
if ($lowart{$artgrp} > $highart{$artgrp}) {
- &problem("$filename: active indicates group should be empty");
+ problem("$filename: active indicates group should be empty");
} elsif ($artnum < $lowart{$artgrp}) {
- &problem("$filename: article number is too low");
+ problem("$filename: article number is too low");
} elsif ($artnum > $highart{$artgrp}) {
- &problem("$filename: article number is too high");
+ problem("$filename: article number is too high");
}
}
# if check filenames only (-c), then do nothing else with the file
- next if (defined($opt_c));
+ next if (defined $opt{'c'});
# don't open a control or junk, they can be from anywhere
next if ($artgrp eq "control" || $artgrp eq "junk");
# try open the file
- if (!open(ARTICLE, $filename)) {
+ if (!open $ARTICLE, '<', $filename) {
# the find is now gone (expired?), give up on it
- &problem("WARNING: cannot open $filename");
+ problem("WARNING: cannot open $filename");
next;
}
# read until the Newsgroup header line is found
AREADLINE:
- while ($aline = <ARTICLE>) {
+ while ($aline = <$ARTICLE>) {
# catch the newsgroup: header
if ($aline =~ /^Newsgroups:\w*\W/io) {
@@ -426,7 +422,7 @@ sub check_spool
@group = split(",", $aline);
# see if any groups in the Newsgroup list are our group
- for ($j=0; $j <= $#group; ++$j) {
+ for (my $j=0; $j <= $#group; ++$j) {
# look at the group
if ($realgname{$group[$j]} eq $artgrp) {
@@ -436,25 +432,26 @@ sub check_spool
}
# no group or group alias was found
- &problem("$filename: does not belong in $artgrp");
+ problem("$filename: does not belong in $artgrp");
last;
# else watch for the end of the header
} elsif ($aline =~ /^\s*$/o) {
# no Newsgroup: header found
- &problem("WARNING: $filename: no Newsgroup header");
+ problem("WARNING: $filename: no Newsgroup header");
last;
}
- if (eof(ARTICLE)) {
- &problem("WARNING: $filename: EOF found while reading header");
+ if (eof $ARTICLE) {
+ problem("WARNING: $filename: EOF found while reading header");
}
}
# close the article
- close(ARTICLE);
+ close $ARTICLE;
}
# all done with the find
- close(FINDFILE);
+ close $FINDFILE;
+ return;
}
diff --git a/innfeed/procbatch.in b/innfeed/procbatch.in
index c86a404..0664e26 100644
--- a/innfeed/procbatch.in
+++ b/innfeed/procbatch.in
@@ -18,20 +18,21 @@
# Hmm, perhaps we should try to read "backlog-directory"
# from innfeed.conf. Oh well.
#
-$tapeDir = $INN::Config::pathspool . "/innfeed";
-$destDir = $INN::Config::spooltemp ;
-$spoolArts = $INN::Config::patharticles ;
-$outGoing = $INN::Config::pathoutgoing;
+use strict;
+my $tapeDir = $INN::Config::pathspool . "/innfeed";
+my $destDir = $INN::Config::spooltemp;
+my $spoolArts = $INN::Config::patharticles;
+my $outGoing = $INN::Config::pathoutgoing;
##
## Everything below here should probably be left alone.
##
-$0 =~ s!.*/!! ;
+$0 =~ s!.*/!!;
use Getopt::Std;
-$usage = "$0 [ -q ][ -v ][ -u ][ -e host ][ -d dir ][ -c [ -s dir ]][ -m [-t dir ]] inn-batchfile\n
+my $usage = "$0 [ -q ][ -v ][ -u ][ -e host ][ -d dir ][ -c [ -s dir ]][ -m [-t dir ]] inn-batchfile\n
-e host to process on entries for only that host
-d dir to put the output file(s) in that directory ($destDir)
-c to check pathnames of articles before storing them
@@ -58,50 +59,50 @@ that is the same as innfeed's backlog file format. Simply rename these files
to peer1 peer2 peer3 in a running innfeed's backlog directory and they will be
picked up automatically and processed by innfeed. Use the '-m' flag and
they'll be moved automatically.
-" ;
+";
-$opt_u = $opt_h = ""; # shut up, perl -w
-$missing = 0;
-getopts ("he:t:s:d:cvumq") || die $usage ;
+my (%opt, %hosts);
+my $missing = 0;
+getopts ("he:t:s:d:cvumq", \%opt) || die $usage;
-die $usage if ( $opt_h ) ;
-die "Cannot specify both -q and -v\n\n" . $usage if ($opt_q && $opt_v);
+die $usage if $opt{'h'};
+die "Cannot specify both -q and -v\n\n" . $usage if ($opt{'q'} && $opt{'v'});
-$spoolArts = $opt_s if $opt_s ;
-$destDir = $opt_d if $opt_d ;
-$tapeDir = $opt_t if $opt_t ;
-$inputFile = shift ;
+$spoolArts = $opt{'s'} if $opt{'s'};
+$destDir = $opt{'d'} if $opt{'d'};
+$tapeDir = $opt{'t'} if $opt{'t'};
+my $inputFile = shift;
-die $usage if !$inputFile ;
+die $usage if !$inputFile;
unless (-f $inputFile) {
- exit if $opt_q;
+ exit if $opt{'q'};
die "No such file: $inputFile\n\n" . $usage;
}
-die "No such directory: $spoolArts\n\n" . $usage if ( ! -d $spoolArts && $opt_c ) ;
-die "No such directory: $destDir\n\n" . $usage if ( ! -d $destDir ) ;
-die "No such directory: $tapeDir\n\n" . $usage if ( ! -d $tapeDir && $opt_m ) ;
+die "No such directory: $spoolArts\n\n" . $usage if ( ! -d $spoolArts && $opt{'c'} );
+die "No such directory: $destDir\n\n" . $usage if ( ! -d $destDir );
+die "No such directory: $tapeDir\n\n" . $usage if ( ! -d $tapeDir && $opt{'m'} );
-print "Using $inputFile\n" if $opt_v ;
-open (INPUT,"<$inputFile") || die "$0: open ($inputFile): $!\n" ;
+print "Using $inputFile\n" if $opt{'v'};
+open my $INPUT, '<', $inputFile || die "$0: open ($inputFile): $!\n";
-while (<INPUT>) {
- chop ;
- @F = split ;
+while (<$INPUT>) {
+ chop;
+ my @F = split;
# Check the format of the line vigorously
- next unless (m!^\S+/\d+ <.+ at .+> \S+! || m!^@[0-9A-F]+@ <.+ at .+> \S+!) ;
+ next unless (m!^\S+/\d+ <.+ at .+> \S+! || m!^@[0-9A-F]+@ <.+ at .+> \S+!);
- if ( $opt_c ) {
+ if ( $opt{'c'} ) {
if ( ! -f "$spoolArts/$F[0]" ) {
- $missing++ ;
- print "Dropping file: $spoolArts/$F[0]\n" if $opt_v ;
- next ;
+ $missing++;
+ print "Dropping file: $spoolArts/$F[0]\n" if $opt{'v'};
+ next;
}
}
- for ($i = 2 ; $i <= $#F ; $i++) {
- $host = $F[$i] ;
- next if ($opt_e && $opt_e ne $host) ;
+ for (my $i = 2 ; $i <= $#F ; $i++) {
+ my $host = $F[$i];
+ next if ($opt{'e'} && $opt{'e'} ne $host);
# Keep out host names with any funny characters (from
# corrupted files)
@@ -113,35 +114,34 @@ while (<INPUT>) {
if ($hosts{$host}) {
print {$hosts{$host}} "$F[0] $F[1]\n";
} else {
- $outputFile = "$destDir/$host.tmp" ;
- print "Starting $host\n" if ($opt_v);
- $hosts{$host}=$host;
- open ($hosts{$host},">>$outputFile") ||
- die "open >>$outputFile: $!\n" ;
+ my $outputFile = "$destDir/$host.tmp";
+ print "Starting $host\n" if ($opt{'v'});
+ open $hosts{$host}, '>>', $outputFile
+ or die "open >>$outputFile: $!\n";
print {$hosts{$host}} "$F[0] $F[1]\n";
}
}
}
-close (INPUT) ;
-
-foreach $host (keys %hosts) {
- close($hosts{$host});
- $outputFile = "$destDir/$host.tmp" ;
- $tmpTape = "$tapeDir/$host.tmp" ;
- $tapeFile = "$tapeDir/$host" ;
- if ( $opt_m ) {
+close $INPUT;
+
+foreach my $host (keys %hosts) {
+ close $hosts{$host};
+ my $outputFile = "$destDir/$host.tmp";
+ my $tmpTape = "$tapeDir/$host.tmp";
+ my $tapeFile = "$tapeDir/$host";
+ if ( $opt{'m'} ) {
if ($outputFile ne $tmpTape) {
- $cmd = "mv $outputFile $tmpTape" ;
- system ($cmd) ;
- die "$0: $cmd: failed\n" unless ($? == 0) ;
+ my $cmd = "mv $outputFile $tmpTape";
+ system $cmd;
+ die "$0: $cmd: failed\n" unless ($? == 0);
}
- $cmd = "cat $tmpTape | $INN::Config::sort -u >> $tapeFile && rm -f $tmpTape" ;
- system ($cmd) ;
- die "$0: $cmd: failed\n" unless ($? == 0) ;
+ my $cmd = "cat $tmpTape | $INN::Config::sort -u >> $tapeFile && rm -f $tmpTape";
+ system $cmd;
+ die "$0: $cmd: failed\n" unless ($? == 0);
}
}
-unlink($inputFile) if ($opt_u);
+unlink $inputFile if $opt{'u'};
-print "$missing articles dropped\n" if ( $opt_v && $missing > 0 ) ;
+print "$missing articles dropped\n" if ( $opt{'v'} && $missing > 0 );
diff --git a/scripts/innmail.in b/scripts/innmail.in
index 696da30..8683272 100644
--- a/scripts/innmail.in
+++ b/scripts/innmail.in
@@ -10,41 +10,41 @@
# problems.
#
-$0 =~ s!.*/!! ;
-
-require 5.001 ;
+use strict;
use Getopt::Std;
-use vars qw($opt_h);
+
+$0 =~ s!.*/!!;
die "$0: No \$INN::Config::mta variable defined.\n"
if ! defined ($INN::Config::mta);
-$sm = $INN::Config::mta ;
+my $sm = $INN::Config::mta;
-die "$0: MTA path is not absolute\n" unless ($sm =~ m!^/!) ;
+die "$0: MTA path is not absolute\n" unless ($sm =~ m!^/!);
-$usage = "usage: $0 -s subject addresses\n\n" .
- "Reads stdin for message body\n" ;
+my $usage = "usage: $0 -s subject addresses\n\n" .
+ "Reads stdin for message body\n";
-getopts ("s:h") || die $usage ;
+my (%opt, @addrs);
+getopts ("s:h", \%opt) || die $usage;
-die $usage if $opt_h ;
+die $usage if $opt{'h'};
-if ( !defined($opt_s) ) {
- warn "No subject given. Hope that's OK.\n" ;
- $opt_s = "NO SUBJECT" ;
+if ( !defined($opt{'s'}) ) {
+ warn "No subject given. Hope that's OK.\n";
+ $opt{'s'} = "NO SUBJECT";
} else {
- $opt_s =~ s/\n+\Z//;
+ $opt{'s'} =~ s/\n+\Z//;
}
# Fix up any addresses.
foreach ( @ARGV ) {
- s![^-a-zA-Z0-9+_.@%]!!g ;
+ s![^-a-zA-Z0-9+_.@%]!!g;
- push (@addrs,$_) if ($_ ne "") ;
+ push (@addrs,$_) if ($_ ne "");
}
-die "$0: No addresses specified\n\n$usage" unless @addrs ;
+die "$0: No addresses specified\n\n$usage" unless @addrs;
if ($sm =~ m!%s!) {
$sm = sprintf $sm, join (' ', @addrs);
@@ -52,9 +52,9 @@ if ($sm =~ m!%s!) {
$sm .= " " . join(' ', @addrs);
}
- at smarr = split(/\s+/,$sm);
+my @smarr = split(/\s+/,$sm);
-($t = $INN::Config::mta) =~ s!\s.*!!;
+(my $t = $INN::Config::mta) =~ s!\s.*!!;
die "$0: MTA variable definition is changed after substitution\n"
if ($t ne $smarr[0]);
@@ -62,18 +62,18 @@ die "$0: MTA excutable doesn't appear to exist: $smarr[0]\n"
if ! -x $smarr[0];
# Startup MTA without using the shell.
-$pid = open (MTA,"|-") ;
+my $pid = open my $MTA, '|-';
if ($pid == 0) {
- exec (@smarr) || die "$0: exec of $sm failed: $!\n" ;
+ exec (@smarr) || die "$0: exec of $sm failed: $!\n";
} elsif ($pid < 0) {
- die "$0: Fork failed: $!\n" ;
+ die "$0: Fork failed: $!\n";
}
-print MTA "To: ", join (",\n\t", @addrs), "\n" ;
-print MTA "Subject: $opt_s\n" ;
-print MTA "\n" ;
+print $MTA "To: ", join (",\n\t", @addrs), "\n";
+print $MTA "Subject: $opt{'s'}\n";
+print $MTA "\n";
while (<STDIN>) {
- print MTA $_ ;
+ print $MTA $_;
}
-close (MTA) ;
-exit ;
+close $MTA;
+exit;
--
1.7.3.1
-------------- next part --------------
A non-text attachment was scrubbed...
Name: smime.p7s
Type: application/x-pkcs7-signature
Size: 5557 bytes
Desc: not available
URL: <https://lists.isc.org/pipermail/inn-workers/attachments/20110701/45144aa9/attachment.bin>
More information about the inn-workers
mailing list