Re: Patches for dspam.cgi

"Tod A. Sandman" <[email protected]> Mon, 10 Dec 2012 15:37:47 -0600
Newsgroups gmane.mail.spam.dspam.devel
Message-ID <[email protected]>
--17pEHd4RhPHOinZp
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

And here's the patch.


Tod Sandman
Sr. Systems Administrator
Middleware Development & Integration
Rice University

--17pEHd4RhPHOinZp
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="patch.fcntl"

--- 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'}&amp;template=$FORM{'template'}&amp;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>&nbsp;&nbsp;&nbsp;&nbsp;", @_;
+  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);
+}
+

--17pEHd4RhPHOinZp
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

------------------------------------------------------------------------------
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
--17pEHd4RhPHOinZp
Content-Type: text/plain; charset="us-ascii"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Content-Disposition: inline

_______________________________________________
Dspam-devel mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/dspam-devel

--17pEHd4RhPHOinZp--