/usr/share/perl5/Mail/SpamAssassin/Locker/Win32.pm is in spamassassin 3.4.1-8build1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 | # <@LICENSE>
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements. See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to you under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at:
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# </@LICENSE>
package Mail::SpamAssassin::Locker::Win32;
use strict;
use warnings;
use bytes;
use re 'taint';
use Fcntl;
use Mail::SpamAssassin;
use Mail::SpamAssassin::Locker;
use Mail::SpamAssassin::Util;
use Mail::SpamAssassin::Logger;
use File::Spec;
use Time::Local;
use vars qw{
@ISA
};
@ISA = qw(Mail::SpamAssassin::Locker);
###########################################################################
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
$self;
}
###########################################################################
use constant LOCK_MAX_AGE => 600; # seconds
sub safe_lock {
my ($self, $path, $max_retries, $mode) = @_;
my @stat;
$max_retries ||= 30;
# $mode is ignored on win32
my $lock_file = "$path.lock";
if (-e $lock_file && -M $lock_file > (LOCK_MAX_AGE / 86400)) {
dbg("locker: safe_lock: breaking stale lock: $lock_file");
unlink($lock_file)
or warn "locker: safe_lock: unlink of lock file $lock_file failed: $!\n";
}
for (my $retries = 0; $retries < $max_retries; $retries++) {
if ($retries > 0) {
sleep(1);
# TODO: $self->jittery_one_second_sleep();?
}
dbg("locker: safe_lock: trying to get lock on $path with $retries retries");
if (!defined sysopen(LOCKFILE, $lock_file, O_RDWR|O_CREAT|O_EXCL)) {
dbg("locker: safe_lock: failed to create lock tmpfile $lock_file: $!");
} else {
dbg("locker: safe_lock: link to $lock_file: sysopen ok");
close(LOCKFILE) or warn "error closing a lock file: $!";
return 1;
}
my @stat = stat($lock_file);
@stat or warn "locker: error accessing $lock_file: $!";
# check age of lockfile ctime
my $age = ($#stat < 11 ? undef : $stat[10]);
if ((!defined($age) && $retries > $max_retries / 2) ||
(defined($age) && (time - $age > LOCK_MAX_AGE)))
{
dbg("locker: safe_lock: breaking stale lock: $lock_file");
unlink($lock_file)
or warn "locker: safe_lock: unlink of lock file $lock_file failed: $!\n";
}
}
return 0;
}
###########################################################################
sub safe_unlock {
my ($self, $path) = @_;
unlink("$path.lock")
or warn "locker: safe_unlock: unlink failed: $path.lock\n";
dbg("locker: safe_unlock: unlink $path.lock");
}
###########################################################################
sub refresh_lock {
my($self, $path) = @_;
return unless $path;
# this could arguably read the lock and make sure the same process
# owns it, but this shouldn't, in theory, be an issue.
utime time, time, "$path.lock";
dbg("locker: refresh_lock: refresh $path.lock");
}
###########################################################################
1;
|