And here's the patch.
Tod Sandman
Sr. Systems Administrator
Middleware Development & Integration
Rice University
--- configure.pl.orig 2012-10-08 01:37:12.000000000 -0500
+++ configure.pl 2012-12-03 08:29:14.611409303 -0600
@@ -34,6 +34,10 @@
$CONFIG{'WEB_ROOT'} = ""; # URL location of included htdocs/ files
+## Define CGI_LOG if you want to enable CGI logging:
+$CONFIG{'DSPAM_LOGDIR'} = "/var/log/dspam";
+$CONFIG{'CGI_LOG'} = "$CONFIG{'DSPAM_LOGDIR'}/cgi.log";
+
# Default DSPAM display
#$CONFIG{'DATE_FORMAT'} = "%d.%m.%Y %H:%M"; # Date format in strftime
style
# if undefined use default DSPAM
display format
--- dspam.cgi.orig 2012-04-11 14:05:44.000000000 -0500
+++ dspam.cgi 2012-12-07 12:34:36.150392124 -0600
@@ -18,7 +18,8 @@
# along with this program. If not, see <http://www.gnu.org/licenses/>.
use strict;
-use POSIX qw(strftime ctime);
+use Fcntl;
+use POSIX qw(strftime ctime :unistd_h :errno_h);
use Time::Local;
use vars qw { %CONFIG %DATA %FORM %LANG $MAILBOX $CURRENT_USER $USER $TMPFILE
$USERSELECT };
use vars qw { $CURRENT_STORE $LANGUAGE };
@@ -949,14 +950,17 @@
sub Quarantine_ManyNotSpam {
my(@buffer, @errors);
- open(FILE, "<$MAILBOX");
+ (-f $MAILBOX) or return;
+ DspamLockFile (*FILE, $MAILBOX) or return;
+
while(<FILE>) {
s/\r?\n$//;
push(@buffer, $_);
}
- close(FILE);
- open(FILE, ">$MAILBOX") || &error($!);
+ seek(FILE, 0, 0);
+ truncate(FILE, 0);
+
open(RETRAIN, ">>$USER.retrain.log");
while($#buffer>=0) {
@@ -1071,6 +1075,10 @@
sub Quarantine_DeleteSpam {
my(@buffer);
+
+ (-f $MAILBOX) or return;
+ DspamLockFile (*FILE, $MAILBOX) or return;
+
if ($FORM{'deleteAll'} ne "") {
my($sz);
@@ -1078,17 +1086,18 @@
$atime,$mtime,$ctime,$blksize,$blocks)
= stat("$USER.mbox");
- open(FILE, "<$USER.mbox.size");
- $sz = <FILE>;
- close(FILE);
+ open(SIZE, "<$USER.mbox.size");
+ $sz = <SIZE>;
+ close(SIZE);
chomp($sz);
if ($sz == $size) {
- open(FILE, ">$MAILBOX");
+ truncate(FILE, 0);
close(FILE);
unlink("$USER.mbox.size");
unlink("$USER.mboxwarn");
} else {
+ close(FILE);
return;
}
@@ -1097,15 +1106,13 @@
redirect("$CONFIG{'ME'}?user=$FORM{'user'}&template=$FORM{'template'}&language=$LANGUAGE");
return;
}
- open(FILE, "<$MAILBOX");
while(<FILE>) {
s/\r?\n//;
push(@buffer, $_);
}
- close(FILE);
-
- open(FILE, ">$MAILBOX");
+ seek(FILE, 0, 0);
+ truncate(FILE, 0);
while($#buffer>=0) {
my($buff, $mode, @temp, %head);
@@ -1726,7 +1733,8 @@
}
sub error {
- my($error) = @_;
+ my($error) = join "<BR> ", @_;
+ Log (@_);
$FORM{'template'} = "error";
$DATA{'MESSAGE'} = <<_end;
$CONFIG{'LANG'}->{$LANGUAGE}->{'error_message_part1'}
@@ -1868,3 +1876,235 @@
}
return %PREFS
}
+
+
+
+###################################################################
+# Open the DSPAM quarantine for reading and writing, and lock it.
+# We ran into rare occasions of users losing their quarantines
+# without first being able to view the messages. This may have
+# been linked to obsessively large quarantine boxes or impatient
+# users double-clicking. Regardless, it should be done.
+###################################################################
+
+sub DspamLockFile
+{
+ my ($fh, $filename) = @_;
+ my $fcntl_return = undef;
+
+ ($fh && $filename) or &error ("DspamLockFile: bad call!");
+ unless (open ($fh, "+<$filename")) {
+ &error("DspamLockFile: failure opening $filename:", "$!");
+ }
+
+ ## First attempt to get a lock without waiting. Not really
+ ## neccessary, but good for looking for signs of trouble.
+ unless ($fcntl_return = GetFileLock ($fh, $filename, 1)) {
+ close($fh) or Log ("DspamLockFile: failure closing $filename");
+ unless (open ($fh, "+<$filename")) {
+ &error("DspamLockFile: failure opening $filename:", "$!");
+ }
+ ## Log a message about having to wait, and then wait for a lock.
+ Log ("DspamLockFile: waiting for lock on $filename ...");
+ unless (defined ($fcntl_return = GetFileLock ($fh, $filename))) {
+ Log ("DspamLockFile: FAILURE getting lock on $filename");
+ close($fh) or Log ("DspamLockFile: failure closing $filename");;
+ &error ("resource busy: failure getting lock on your quarantine box");
+ }
+ }
+ return $fcntl_return;
+}
+
+
+###################################################################
+# File locking with fcntl, which is also used by the DSPAM binary.
+# Nearly cut&pasted from the O'Reilly "Perl Cookbook", Ch 7.22.
+###################################################################
+
+# GetFileLock($handle,$filename,$nowait) - get an fcntl lock
+sub GetFileLock
+{
+ my ($fh, $filename, $nowait) = @_;
+ my $lock = struct_flock (F_WRLCK, SEEK_SET, 0, 0, 0);
+ my $fcntl_return = undef;
+ my $command = $nowait ? F_SETLK : F_SETLKW;
+ my $lock_desc = $nowait ? "lock (nowait)" : "lock (wait)";
+ unless ($fcntl_return = fcntl ($fh, $command, $lock)) {
+ Log ("GetFileLock: failure getting $lock_desc on $filename:", "$!");
+ }
+ return $fcntl_return;
+}
+
+# FreeFileLock($handle,$filename) - free an fcntl lock
+sub FreeFileLock
+{
+ my ($fh, $filename) = @_;
+ my $lock = struct_flock (F_UNLCK, SEEK_SET, 0, 0, 0);
+ my $fcntl_return = undef;
+ unless ($fcntl_return = fcntl ($fh, F_SETLK, $lock)) {
+ Log ("FreeFileLock: failure releasing lock on $filename:", "$!");
+ }
+ return $fcntl_return;
+}
+
+
+# OS-dependent flock structures
+
+# Linux struct flock - 32 bit
+# short l_type;
+# short l_whence;
+# off_t l_start;
+# off_t l_len;
+# pid_t l_pid;
+BEGIN {
+ # c2ph says: typedef='s2 l2 i', sizeof=16
+ my $FLOCK_STRUCT = 's s l l i';
+
+ sub linux32_flock {
+ if (wantarray) {
+ my ($type, $whence, $start, $len, $pid) =
+ unpack($FLOCK_STRUCT, $_[0]);
+ return ($type, $whence, $start, $len, $pid);
+ } else {
+ my ($type, $whence, $start, $len, $pid) = @_;
+ return pack($FLOCK_STRUCT,
+ $type, $whence, $start, $len, $pid);
+ }
+ }
+
+}
+
+# Linux struct flock - 64 bit
+# short l_type;
+# short l_whence;
+# off64_t l_start;
+# off64_t l_len;
+# pid_t l_pid;
+BEGIN {
+ # c2ph says: typedef='s2 l2 i', sizeof=16
+ my $FLOCK_STRUCT = 's s l! l! i';
+
+ sub linux64_flock {
+ if (wantarray) {
+ my ($type, $whence, $start, $len, $pid) =
+ unpack($FLOCK_STRUCT, $_[0]);
+ return ($type, $whence, $start, $len, $pid);
+ } else {
+ my ($type, $whence, $start, $len, $pid) = @_;
+ return pack($FLOCK_STRUCT,
+ $type, $whence, $start, $len, $pid);
+ }
+ }
+
+}
+
+BEGIN {
+ # Solaris 8 (32)
+ my $FLOCK_STRUCT = 's s l l l l';
+
+ sub solaris32_flock {
+ if (wantarray) {
+ my ($type, $whence, $start, $len, $sysid, $pid) =
+ unpack($FLOCK_STRUCT, $_[0]);
+ return ($type, $whence, $start, $len, $pid);
+ } else {
+ my ($type, $whence, $start, $len, $sysid, $pid) = @_;
+ return pack($FLOCK_STRUCT,
+ $type, $whence, $start, $len, $sysid, $pid);
+ }
+ }
+}
+
+
+# SunOS struct flock:
+# short l_type; /* F_RDLCK, F_WRLCK, or F_UNLCK */
+# short l_whence; /* flag to choose starting offset */
+# long l_start; /* relative offset, in bytes */
+# long l_len; /* length, in bytes; 0 means lock to EOF */
+# short l_pid; /* returned with F_GETLK */
+# short l_xxx; /* reserved for future use */
+BEGIN {
+ # c2ph says: typedef='s2 l2 s2', sizeof=16
+ my $FLOCK_STRUCT = 's s l l s s';
+
+ sub sunos_flock {
+ if (wantarray) {
+ my ($type, $whence, $start, $len, $pid, $xxx) =
+ unpack($FLOCK_STRUCT, $_[0]);
+ return ($type, $whence, $start, $len, $pid);
+ } else {
+ my ($type, $whence, $start, $len, $pid) = @_;
+ return pack($FLOCK_STRUCT,
+ $type, $whence, $start, $len, $pid, 0);
+ }
+ }
+
+}
+
+# (Free)BSD struct flock:
+# off_t l_start; /* starting offset */
+# off_t l_len; /* len = 0 means until end of file */
+# pid_t l_pid; /* lock owner */
+# short l_type; * lock type: read/write, etc. */
+# short l_whence; /* type of l_start */
+BEGIN {
+ # c2ph says: typedef="q2 i s2", size=24
+ my $FLOCK_STRUCT = 'll ll i s s'; # XXX: q is ll
+
+ sub bsd_flock {
+ if (wantarray) {
+ my ($xxstart, $start, $xxlen, $len, $pid, $type, $whence) =
+ unpack($FLOCK_STRUCT, $_[0]);
+ return ($type, $whence, $start, $len, $pid);
+ } else {
+ my ($type, $whence, $start, $len, $pid) = @_;
+ my ($xxstart, $xxlen) = (0,0);
+ return pack($FLOCK_STRUCT,
+ $xxstart, $start, $xxlen, $len, $pid, $type, $whence);
+ }
+ }
+}
+
+# alias the fcntl structure at compile time
+BEGIN {
+ for ($^O) {
+ *struct_flock = do {
+
+ /bsd/ && \&bsd_flock
+ ||
+ /linux/ && \&linux32_flock
+ ||
+ /solaris/ && \&solaris32_flock
+ ||
+ /sunos/ && \&sunos_flock
+ ||
+ die "unknown operating system $^O, bailing out";
+ };
+ }
+ if ($^O =~ /linux/) {
+ my $x86_64 = `/bin/uname -r | grep x86_64`;
+ (*struct_flock = \&linux64_flock) if ($x86_64);
+ }
+}
+
+
+###################################################################
+# Simple logfile utility.
+###################################################################
+
+sub Log
+{
+ my ($filename, $fh, $time);
+ unless ($filename = $CONFIG{'CGI_LOG'}) { return 1; };
+ unless (open ($fh, ">> $filename")) { return 0; };
+ ($time = localtime (time)) =~ s/ \d\d\d\d$//;
+ print $fh "${time} [$$]:", shift, "\n";
+
+ foreach my $line (@_) {
+ if (! defined $line) { print $fh " UNDEF\n"; }
+ elsif ($line =~ /\012$/) { print $fh " $line"; }
+ else { print $fh " $line\n"; }
+ }
+ close ($fh);
+}
+
------------------------------------------------------------------------------
LogMeIn Rescue: Anywhere, Anytime Remote support for IT. Free Trial
Remotely access PCs and mobile devices and provide instant support
Improve your efficiency, and focus on delivering more value-add services
Discover what IT Professionals Know. Rescue delivers
http://p.sf.net/sfu/logmein_12329d2d
_______________________________________________
Dspam-devel mailing list
Dspam-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/dspam-devel
