#!/usr/bin/perl -w
# dqrm          --crb3 17nov03
#
# undo a qrm/sprobe wrongful classification.
# takes one arg, a mailfile. if the mailfile has a path,
# uses that, else uses cwd.
# if cwd is /new,
#   - copies to ../qrm
#   - moves to //sp2m//qrm
# elsif cwd is /qrm
#   - copies to ../new
#   - moves to //sp2m//new
# either way, logs the correction. the log infers filter accuracy.
# the tool is something a normal user can use to fix things.
# eventually the tool should sweep through /var/log/maillog, find
# the event-report where the false verdict was made, and put that in
# the log too. some real suid needed for that.
#
# --crb3 12feb04: chown the moved mailfile so user can actually read it
#
$safety=0;              # test mode: don't do it, just pretend loudly.

$dqrmlog="/var/local/qrm/dqrm.log";

$timestamp=`date -u`;
chomp $timestamp;

$ins=($safety ? "echo" : "");

die "dqrm mailfile\n" unless defined ($mf=$ARGV[0]);

($ownd,$grpd)=(stat($mf))[4,5];         # get uid,gid

$mf =~ s/\s+$//;
$mf =~ s/^\s+//;
unless(index($mf,'/') >-1){
  $cwd=`pwd`;                   # make sure we're dealing with explicit
  chomp $cwd;                   # path, for uniformity of handling
  $mf = "$cwd/$mf";
}
#
# array offsets seem skewed, but that's because of the empty array
# element that was to the left of the first slash. we need it to put
# that left slash back on, so... just go along with "OPTION BASE 1" :)
#
(@bits)=split('/',$mf);

if($safety){                    # and, by inference, debug too
  print "BITS:";
  foreach $bit (@bits){
    print "\t$bit\n";
  }
  print "---\n\n";
}

if(index($mf,"/qrm/") >-1){
  $logway="NEW";
  $bits[4]="new";
}else{
  $logway="QRM";
  $bits[4]="qrm";
}
$mv=join('/',@bits);

system("$ins cp $mf $mv");      # copy into correct user-dir

chown($ownd,$grpd,$mv);         # set new image to same uid,gid as old

$bits[2]="sp2m";
$mv=join('/',@bits);
system("$ins mv $mf $mv");      # move to sp2m for sprobe_learn to find

`echo [$timestamp] $logway $mv >>$dqrmlog`;

 Grab a
gzipped
copy
here
 
Syntax highlighting using Syntax::Highlight::Engine::Kate