[Popcon-commits] cvs commit to popularity-contest by ballombe
popcon-commits@lists.alioth.debian.org
popcon-commits@lists.alioth.debian.org
Sun, 01 Feb 2004 17:21:21 +0100
Update of /cvsroot/popcon/popularity-contest
In directory quantz:/tmp/cvs-serv4506
Added Files:
prepop.pl
Log Message:
Rewrite prepop.py in perl.
Do proper sanity/security checking at all stage.
Run in tainted mode (-T).
--- NEW FILE: prepop.pl ---
#!/usr/bin/perl -wT
# Accept popularity-contest entries on stdin and drop them into a
# subdirectory with a name based on their MD5 ID.
#
# Only the most recent entry with a given MD5 ID is kept.
#
$dirname = 'popcon-entries';
$now = time;
$state='initial'; # one of ('initial','accept','reject')
my($file,$mtime);
while(<>)
{
$state eq 'initial' and do
{
/^POPULARITY-CONTEST-0/ or next;
my @line=split(/ +/);
my %field;
for (@line)
{
my ($key, $value) = split(':', $_, 2);
$field{$key}=$value;
};
$id=$field{'ID'};
if (!defined($id) || $id !~ /^([a-f0-9]{32})$/)
{
print STDERR "Bad hostid: $id\n";
$state='reject'; next;
}
$id=$1; #untaint $id
$mtime=$field{'TIME'};
if (!defined($mtime) || $mtime!~/^([0-9]+)$/)
{
print STDERR "Bad mtime $mtime\n";
$state='reject'; next;
}
$mtime=int $1; #untaint $mtime;
$mtime=$now if ($mtime > $now);
my $dir=substr($id,0,2);
$file="$dirname/$dir/$id";
open REPORT, ">",$file or do {$state='reject';next;};
print REPORT $_;
$state='accept'; next;
};
$state eq 'reject' and do
{
/^From/ or next;
$state='initial';next;
};
$state eq 'accept' and do
{
/^From/ and do
{
close REPORT;
unlink $file;
print STDERR "Bad report $file";
$state='initial';
next;
};
print REPORT $_; #accept line.
/^END-POPULARITY-CONTEST-0/ and do
{
close REPORT;
utime $mtime, $mtime, $file;
$state='initial';
next;
};
};
}
if ($state eq 'accept')
{
close REPORT;
unlink $file; #Reject
print STDERR "Bad report $file";
}