1# <@LICENSE>
2# Licensed to the Apache Software Foundation (ASF) under one or more
3# contributor license agreements.  See the NOTICE file distributed with
4# this work for additional information regarding copyright ownership.
5# The ASF licenses this file to you under the Apache License, Version 2.0
6# (the "License"); you may not use this file except in compliance with
7# the License.  You may obtain a copy of the License at:
8#
9#     http://www.apache.org/licenses/LICENSE-2.0
10#
11# Unless required by applicable law or agreed to in writing, software
12# distributed under the License is distributed on an "AS IS" BASIS,
13# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14# See the License for the specific language governing permissions and
15# limitations under the License.
16# </@LICENSE>
17
18package Mail::SpamAssassin::Locker::UnixNFSSafe;
19
20use strict;
21use warnings;
22# use bytes;
23use re 'taint';
24
25use Mail::SpamAssassin;
26use Mail::SpamAssassin::Locker;
27use Mail::SpamAssassin::Util;
28use Mail::SpamAssassin::Logger;
29use File::Spec;
30use Time::Local;
31use Fcntl qw(:DEFAULT :flock);
32use Errno qw(EEXIST);
33
34our @ISA = qw(Mail::SpamAssassin::Locker);
35
36###########################################################################
37
38sub new {
39  my $class = shift;
40  my $self = $class->SUPER::new(@_);
41  $self;
42}
43
44###########################################################################
45# NFS-safe locking (I hope!):
46# Attempt to create a file lock, using NFS-safe locking techniques.
47#
48# Locking code adapted from code by Alexis Rosen <alexis@panix.com>
49# by Kelsey Cummings <kgc@sonic.net>, with mods by jm and quinlan
50#
51# A good implementation of Alexis' code, for reference, is here:
52# http://mail-index.netbsd.org/netbsd-bugs/1996/04/17/0002.html
53
54use constant LOCK_MAX_AGE => 600;	# seconds
55
56sub safe_lock {
57  my ($self, $path, $max_retries, $mode) = @_;
58  my $is_locked = 0;
59  my @stat;
60
61  $max_retries ||= 30;
62  $mode ||= "0700";
63  $mode = (oct $mode) & 0666;
64  dbg ("locker: mode is %03o", $mode);
65
66  my $lock_file = "$path.lock";
67  my $hname = Mail::SpamAssassin::Util::fq_hostname();
68  my $lock_tmp = Mail::SpamAssassin::Util::untaint_file_path
69                                      ($path.".lock.".$hname.".".$$);
70
71  # keep this for unlocking
72  $self->{lock_tmp} = $lock_tmp;
73
74  my $umask = umask(~$mode);
75  if (!open(LTMP, ">$lock_tmp")) {
76      umask $umask; # just in case
77      die "locker: safe_lock: cannot create tmp lockfile $lock_tmp for $lock_file: $!\n";
78  }
79  umask $umask;
80  LTMP->autoflush(1);
81  dbg("locker: safe_lock: created $lock_tmp");
82
83  for (my $retries = 0; $retries < $max_retries * 2; $retries++) {
84    if ($retries > 0) { $self->jittery_half_second_sleep(); }
85    print LTMP "$hname.$$\n"  or warn "Error writing to $lock_tmp: $!";
86    dbg("locker: safe_lock: trying to get lock on $path with $retries retries");
87    if (link($lock_tmp, $lock_file)) {
88      dbg("locker: safe_lock: link to $lock_file: link ok");
89      $is_locked = 1;
90      last;
91    }
92    # if lock exists, it's already likely locked, no point complaining here
93    unless ($!{EEXIST}) {
94      warn "locker: creating link $lock_file to $lock_tmp failed: '$!'";
95    }
96    # link _may_ return false even if the link _is_ created
97    @stat = lstat($lock_tmp);
98    @stat  or warn "locker: error accessing $lock_tmp: $!";
99    if (defined $stat[3] && $stat[3] > 1) {
100      dbg("locker: safe_lock: link to $lock_file: stat ok");
101      $is_locked = 1;
102      last;
103    }
104    # check age of lockfile ctime
105    my $now = ($#stat < 11 ? undef : $stat[10]);
106    @stat = lstat($lock_file);
107    @stat  or warn "locker: error accessing $lock_file: $!";
108    my $lock_age = ($#stat < 11 ? undef : $stat[10]);
109    if (defined($lock_age) && defined($now) && ($now - $lock_age) > LOCK_MAX_AGE)
110    {
111      # we got a stale lock, break it
112      dbg("locker: safe_lock: breaking stale $lock_file: age=" .
113	  (defined $lock_age ? $lock_age : "undef") . " now=$now");
114      unlink($lock_file)
115        or warn "locker: safe_lock: unlink of lock file $lock_file failed: $!\n";
116    }
117  }
118
119  close LTMP  or die "error closing $lock_tmp: $!";
120  unlink($lock_tmp)
121    or warn "locker: safe_lock: unlink of temp lock $lock_tmp failed: $!\n";
122
123  # record this for safe unlocking
124  if ($is_locked) {
125    @stat = lstat($lock_file);
126    @stat  or warn "locker: error accessing $lock_file: $!";
127    my $lock_ctime = ($#stat < 11 ? undef : $stat[10]);
128
129    $self->{lock_ctimes} ||= { };
130    $self->{lock_ctimes}->{$path} = $lock_ctime;
131  }
132
133  return $is_locked;
134}
135
136###########################################################################
137
138sub safe_unlock {
139  my ($self, $path) = @_;
140
141  my $lock_file = "$path.lock";
142  my $lock_tmp = $self->{lock_tmp};
143  if (!$lock_tmp) {
144    dbg("locker: safe_unlock: $path.lock never locked");
145    return;
146  }
147
148  # 1. Build a temp file and stat that to get an idea of what the server
149  # thinks the current time is (our_tmp.st_ctime).  note: do not use time()
150  # directly because the server's clock may be out of sync with the client's.
151
152  my @stat_ourtmp;
153  if (!defined sysopen(LTMP, $lock_tmp, O_CREAT|O_WRONLY|O_EXCL, 0700)) {
154    warn "locker: safe_unlock: failed to create lock tmpfile $lock_tmp: $!";
155    return;
156  } else {
157    LTMP->autoflush(1);
158    print LTMP "\n"  or warn "Error writing to $lock_tmp: $!";
159
160    if (!(@stat_ourtmp = stat(LTMP)) || (scalar(@stat_ourtmp) < 11)) {
161      @stat_ourtmp  or warn "locker: error accessing $lock_tmp: $!";
162      warn "locker: safe_unlock: failed to create lock tmpfile $lock_tmp";
163      close LTMP  or die "error closing $lock_tmp: $!";
164      unlink($lock_tmp)
165        or warn "locker: safe_lock: unlink of lock file $lock_tmp failed: $!\n";
166      return;
167    }
168  }
169
170  my $ourtmp_ctime = $stat_ourtmp[10]; # paranoia
171  if (!defined $ourtmp_ctime) {
172    die "locker: safe_unlock: stat failed on $lock_tmp";
173  }
174
175  close LTMP  or die "error closing $lock_tmp: $!";
176  unlink($lock_tmp)
177    or warn "locker: safe_lock: unlink of lock file $lock_tmp failed: $!\n";
178
179  # 2. If the ctime hasn't been modified, unlink the file and return. If the
180  # lock has expired, sleep the usual random interval before returning. If we
181  # didn't sleep, there could be a race if the caller immediately tries to
182  # relock the file.
183
184  my $lock_ctime = $self->{lock_ctimes}->{$path};
185  if (!defined $lock_ctime) {
186    warn "locker: safe_unlock: no ctime recorded for $lock_file";
187    return;
188  }
189
190  my @stat_lock = lstat($lock_file);
191  @stat_lock  or warn "locker: error accessing $lock_file: $!";
192
193  my $now_ctime = $stat_lock[10];
194
195  if (defined $now_ctime && $now_ctime == $lock_ctime)
196  {
197    # things are good: the ctimes match so it was our lock
198    unlink($lock_file)
199      or warn "locker: safe_unlock: unlinking $lock_file failed: $!\n";
200    dbg("locker: safe_unlock: unlink $lock_file");
201
202    if ($ourtmp_ctime >= $lock_ctime + LOCK_MAX_AGE) {
203      # the lock has expired, so sleep a bit; use some randomness
204      # to avoid race conditions.
205      dbg("locker: safe_unlock: lock expired on $lock_file expired safely; sleeping");
206      my $i; for ($i = 0; $i < 5; $i++) {
207        $self->jittery_one_second_sleep();
208      }
209    }
210    return;
211  }
212
213  # 4. Either ctime has been modified, or the entire lock file is missing.
214  # If the lock should still be ours, based on the ctime of the temp
215  # file, warn it was stolen. If not, then our lock is expired and
216  # someone else has grabbed the file, so warn it was lost.
217  if ($ourtmp_ctime < $lock_ctime + LOCK_MAX_AGE) {
218    warn "locker: safe_unlock: lock on $lock_file was stolen";
219  } else {
220    warn "locker: safe_unlock: lock on $lock_file was lost due to expiry";
221  }
222}
223
224###########################################################################
225
226sub refresh_lock {
227  my($self, $path) = @_;
228
229  return unless $path;
230
231  # this could arguably read the lock and make sure the same process
232  # owns it, but this shouldn't, in theory, be an issue.
233  # TODO: in NFS, it definitely may be one :(
234
235  my $lock_file = "$path.lock";
236  utime time, time, $lock_file;
237
238  # update the lock_ctimes entry
239  my @stat = lstat($lock_file);
240  @stat  or warn "locker: error accessing $lock_file: $!";
241
242  my $lock_ctime = ($#stat < 11 ? undef : $stat[10]);
243  $self->{lock_ctimes}->{$path} = $lock_ctime;
244
245  dbg("locker: refresh_lock: refresh $path.lock");
246}
247
248###########################################################################
249
2501;
251