#
# MailScanner - SMTP E-Mail Virus Scanner
# Copyright (C) 2002 Julian Field
#
# $Id: Lock.pm 3638 2006-06-17 20:28:07Z sysjkf $
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# The author, Julian Field, can be contacted by email at
# Jules@JulianField.net
# or by paper mail at
# Julian Field
# Dept of Electronics & Computer Science
# University of Southampton
# Southampton
# SO17 1BJ
# United Kingdom
#
# Provide functions to deal with opening + locking spool files
package MailScanner::Lock;
use strict;
use Fcntl qw(:DEFAULT :flock);
use POSIX qw(:unistd_h :errno_h);
#use MailScanner::Log;
use vars qw($FLOCK_STRUCT);
my $have_module;
my $LockType;
sub ReportLockType {
return $LockType;
}
# Run-time initialisation
sub initialise {
eval {
require MailScanner::Fcntl;
import MailScanner::Fcntl (@MailScanner::Fcntl::EXPORT,
@MailScanner::Fcntl::EXPORT_OK);
1;
};
$have_module = ($@ eq ""?1:0);
# Determine locktype to use
$LockType = (MailScanner::Config::Value('locktype'))?
MailScanner::Config::Value('locktype') : $global::MS->{mta}->{LockType};
#print STDERR "Debug = " . MailScanner::Config::Value('debug') . "\n";
#print STDERR "Config Value = " . MailScanner::Config::Value('locktype') . "\n";
#print STDERR "Global = " . $global::MS->{mta}->{LockType} . "\n";
#print STDERR "Lock Type = $LockType\n";
MailScanner::Log::DebugLog("lock.pl sees Config LockType = " .
$LockType);
#MailScanner::Log::DebugLog("lock.pl sees MTA::LockType = ".$MTA::LockType);
MailScanner::Log::DebugLog("lock.pl sees have_module = ".$have_module);
# module has bugs
$LockType =~ /posix/ and $have_module and $LockType = "module";
MailScanner::Log::InfoLog("Using locktype = " . $LockType);
# Note that in IEEE Std 1003.1-2001,
# "The interaction between fcntl() and lockf() locks is unspecified."
#
# (bother)
#
# And we shouldn't really call these "posix" locks, as although they are
# specified in POSIX, there are two possible types, which may or may not
# be the same. DOH!
# Determine correct struct_flock to use at include time
# HORRIBLY HARDWIRED
# would like to "use File::lockf" but that would make
# installation harder. And lockf isn't guaranteed to
# do the same thing as fcntl :(
#
# CPAN File::Lock also appears to be broken (doesn't build, then when
# built, doesn't pass it's own tests - including segfaulting)
#
# So I'll do it myself.
if ($LockType =~ /posix/i) {
for ($^O) {
# $^O returns:
# Linux: "linux"
# OpenBSD: "openbsd"
# Solaris: "solaris"
# SunOS4: "sunos"
# AIX: "aix"
# IRIX: "irix"
#
if (/bsd/) {
MailScanner::Log::InfoLog("Creating hardcoded struct_flock subroutine for $^O (BSD-type)");
# from "man fcntl" and /usr/include/sys/fcntl.h on OBSD 2.7:
# 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 */
# };
#
# FreeBSD exim.tulsaconnect.com 4.5-RELEASE FreeBSD 4.5-RELEASE #0: Sun May
# 19 23:53:40 CDT 2002
#
# from /usr/include/sys/fcntl.h:
#
# /*
# * Advisory file segment locking data type -
# * information passed to system by user
# */
# 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 */
# };
#
# FreeBSD off_t is typedef'd to _BSD_OFF_T_ which is in turn __int64_t
#
eval <<'__EOD';
# XXX: should be Q not LL but
# "Quads are available only if your system supports 64-bit
# integer values _and_ if Perl has been compiled to support those.
# Causes a fatal error otherwise."
#
$FLOCK_STRUCT = 'LL LL L l s';
sub struct_flock {
my ($xxstart, $start, $xxlen, $len, $pid, $type, $whence);
if (wantarray) {
($xxstart, $start, $xxlen, $len, $pid, $type, $whence) =
unpack($FLOCK_STRUCT, $_[0]);
return ($type, $whence, $start, $len, $pid);
} else {
($type, $whence, $start, $len, $pid) = @_;
($xxstart, $xxlen) = (0,0);
return pack($FLOCK_STRUCT, $xxstart, $start, $xxlen, $len, $pid, $type, $whence);
}
}
__EOD
if ($@ ne "") {
MailScanner::Log::DieLog("Unable to create struct_flock subroutine: $@");
}
next;
}
if ($_ eq 'linux') {
MailScanner::Log::InfoLog("Creating hardcoded struct_flock subroutine for $^O (Linux-type)");
# from linux 2.2 /usr/include/asm/fcntl.h:
# struct flock {
# short l_type;
# short l_whence;
# off_t l_start;
# off_t l_len;
# pid_t l_pid;
# };
#
# size of off_t appears to depend on whether we've got large file support etc. ugh.
#
# was previously using ssx32 to pack and sslls to unpack
#
eval <<'__EOD';
$FLOCK_STRUCT = 's s LL LL I';
sub struct_flock {
my ($start, $len, $pid, $type, $whence);
if (wantarray) {
# Interpreting a returned struct
($type, $whence, $start, $len, $pid) =
unpack($FLOCK_STRUCT, $_[0]);
return ($type, $whence, $start, $len, $pid);
} else {
# Building a struct
($type, $whence, $start, $len, $pid) = @_;
return pack($FLOCK_STRUCT, $type, $whence, $start, $len, $pid);
}
}
__EOD
if ($@ ne "") {
MailScanner::Log::DieLog("Unable to create struct_flock subroutine: $@");
}
next;
}
if (/solaris|irix|aix/) {
MailScanner::Log::InfoLog("Creating hardcoded struct_flock subroutine for $^O (misc-type)");
# from solaris 2.7 /usr/include/sys/fcntl.h:
# /* regular version, for both small and large file compilation environment */
# typedef struct flock {
# short l_type;
# short l_whence;
# off_t l_start;
# off_t l_len; /* len == 0 means until end of file */
# int l_sysid;
# pid_t l_pid;
# long l_pad[4]; /* reserve area */
# } flock_t;
#
# and:
# /* transitional large file interface version */
#
# #if defined(_LARGEFILE64_SOURCE)
#
# typedef struct flock64 {
# short l_type;
# short l_whence;
# off64_t l_start;
# off64_t l_len; /* len == 0 means until end of file */
# int l_sysid;
# pid_t l_pid;
# long l_pad[4]; /* reserve area */
# } flock64_t;
#
# and:
# /* SVr3 flock type; needed for rfs across the wire compatibility */
# typedef struct o_flock {
# int16_t l_type;
# int16_t l_whence;
# int32_t l_start;
# int32_t l_len; /* len == 0 means until end of file */
# int16_t l_sysid;
# int16_t l_pid;
# } o_flock_t;
#
# so even thought that one's not used in solaris any more, I guess there'll
# be systems "out there" that use it.
#
#
# From IRIX 5.3 man pages:
# The structure flock describes a file lock. It includes the following
# members:
#
# short l_type; /* Type of lock */
# short l_whence; /* Flag for starting offset */
# off_t l_start; /* Relative offset in bytes */
# off_t l_len; /* Size; if 0 then until EOF */
# long l_sysid; /* Returned with F_GETLK */
# pid_t l_pid; /* Returned with F_GETLK */
#
#
# The structure flock64 describes a file lock for use on large files. It
# includes the following members:
#
# short l_type; /* Type of lock */
# short l_whence; /* Flag for starting offset */
# off64_t l_start; /* Relative offset in bytes */
# off64_t l_len; /* Size; if 0 then until EOF */
# long l_sysid; /* Returned with F_GETLK */
# pid_t l_pid; /* Returned with F_GETLK */
#
# Apparently the 64-bit version is used with a different fcntl command
# (F_SETLK64 as opposed to F_SETLK).
#
#
# It seems that under AIX, a struct flock is:
# l_type, l_whence, l_start, l_len, l_sysid, l_pid, l_vfs
# Again, things vary depending on whether large file support is being
# used.
#
eval <<'__EOD';
# TEST THIS!
$FLOCK_STRUCT = 's s L L I I'; # ignore solaris' pad on the end
sub struct_flock {
my ($type, $whence, $start, $len, $sysid, $pid);
if (wantarray) {
($type, $whence, $start, $len, $sysid, $pid) =
unpack($FLOCK_STRUCT, $_[0]);
return ($type, $whence, $start, $len, $pid);
} else {
($type, $whence, $start, $len, $pid) = @_;
$sysid = 0;
return pack($FLOCK_STRUCT, $type, $whence, $start, $len, $sysid, $pid);
}
}
__EOD
if ($@ ne "") {
MailScanner::Log::DieLog("Unable to create struct_flock subroutine: $@");
}
next;
}
MailScanner::Log::DieLog("1\n2\n3\n4\n5\nDon't know how to do fcntl locking on '$^O'\nPlease contact mailscanner authors.5\n4\n3\n2\n1");
}
}
}
# Open and lock a file.
#
# Pass in a filehandle, a filespec (including ">", "<", or
# whatever on the front), and (optionally) the type of lock
# you want - "r" or "s" for shared/read lock, or pretty much
# anything else (but "w" or "x" really) for exclusive/write
# lock.
#
# Lock type used (flock or fcntl/lockf/posix) depends on
# config. If you're using posix locks, then don't try asking
# for a write-lock on a file opened for reading - it'll fail
# with EBADF (Bad file descriptor).
#
# If $quiet is true, then don't print any warning.
#
sub openlock {
my ($fh, $fn, $rw, $quiet) = @_;
my ($struct_flock);
defined $rw or $rw = ((substr($fn,0,1) eq '>')?"w":"r");
$rw =~ /^[rs]/i or $rw = 'w';
# Set umask every time as SpamAssassin might have reset it
#umask 0077; # Now cleared up after SpamAssassin runs
unless (open($fh, $fn)) {
MailScanner::Log::NoticeLog("Could not open file $fn: %s", $!)
unless $quiet;
return 0;
}
if ($LockType =~ /module/i) {
#MailScanner::Log::DebugLog("Using module to lock $fn");
MailScanner::Fcntl::setlk($fh, ($rw eq 'w' ? F_WRLCK : F_RDLCK)) == 0 and return 1;
}
elsif ($LockType =~ /posix/i) {
# Added 3 zeroes for 'start, length, + pid',
# otherwise pack was being called with undefined values -- nwp
#MailScanner::Log::DebugLog("Using fcntl() to lock $fn");
$struct_flock = struct_flock(($rw eq 'w' ? F_WRLCK : F_RDLCK),0,0,0,0);
fcntl($fh, F_SETLK, $struct_flock) and return 1;
}
elsif ($LockType =~ /flock/i) {
#MailScanner::Log::DebugLog("Using flock() to lock $fn");
flock($fh, ($rw eq 'w' ? LOCK_EX : LOCK_SH) + LOCK_NB) and return 1;
}
else {
MailScanner::Log::DebugLog("Not locking spool file $fn");
return 1;
}
close ($fh);
if (($! == POSIX::EAGAIN) || ($! == POSIX::EACCES)) {
MailScanner::Log::DebugLog("Failed to lock $fn: %s", $!)
unless $quiet;
}
else {
MailScanner::Log::NoticeLog("Failed to lock $fn with unexpected error: %s", $!);
}
return 0;
}
sub unlockclose {
my ($fh) = @_;
if ($LockType =~ /module/i) {
MailScanner::Fcntl::setlk($fh, F_UNLCK);
}
elsif ($LockType =~ /posix/i) {
fcntl($fh, F_SETLK, struct_flock(F_UNLCK,0,0,0,0));
}
elsif ($LockType =~ /flock/i) {
flock($fh, LOCK_UN);
}
# else {
# default - do nothing, as we didn't lock it in the first place
# }
close ($fh);
return 1;
}
1;
syntax highlighted by Code2HTML, v. 0.9.1