Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | ##---------------------------------------------------------------------------## |
2 | ## File: | |
3 | ## $Id: mhlock.pl,v 1.3 2001/09/17 16:10:40 ehood Exp $ | |
4 | ## Author: | |
5 | ## Earl Hood mhonarc@mhonarc.org | |
6 | ## Description: | |
7 | ## Lock functions for MHonArc. | |
8 | ##---------------------------------------------------------------------------## | |
9 | ## MHonArc -- Internet mail-to-HTML converter | |
10 | ## Copyright (C) 1997-1999 Earl Hood, mhonarc@mhonarc.org | |
11 | ## | |
12 | ## This program is free software; you can redistribute it and/or modify | |
13 | ## it under the terms of the GNU General Public License as published by | |
14 | ## the Free Software Foundation; either version 2 of the License, or | |
15 | ## (at your option) any later version. | |
16 | ## | |
17 | ## This program is distributed in the hope that it will be useful, | |
18 | ## but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ## GNU General Public License for more details. | |
21 | ## | |
22 | ## You should have received a copy of the GNU General Public License | |
23 | ## along with this program; if not, write to the Free Software | |
24 | ## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
25 | ## 02111-1307, USA | |
26 | ##---------------------------------------------------------------------------## | |
27 | ||
28 | package mhonarc; | |
29 | ||
30 | ############################################################################# | |
31 | ## Constants | |
32 | ############################################################################# | |
33 | ||
34 | sub MHA_LOCK_MODE_DIR () { 0; } | |
35 | ## -- Directory method: Works on all platforms, but lock dir can be | |
36 | ## left around if abnormal termination. | |
37 | sub MHA_LOCK_MODE_FLOCK () { 1; } | |
38 | ## -- flock() method: Works on select platforms. Can have problems | |
39 | ## if writing to an NFS mount depending on how perl is built. | |
40 | ## If available, and not writing to NFS (or reliable over NFS) | |
41 | ## this method is better than directory method. | |
42 | ||
43 | ||
44 | ############################################################################# | |
45 | ## Variables | |
46 | ############################################################################# | |
47 | ||
48 | my $_lock_file = undef; | |
49 | my $_flock_fh = undef; | |
50 | ||
51 | $LockFunc = undef; | |
52 | $UnlockFunc = undef; | |
53 | ||
54 | ############################################################################# | |
55 | ## Functions | |
56 | ############################################################################# | |
57 | ||
58 | ##--------------------------------------------------------------------------- | |
59 | ## set_lock_mode(): Set locking method used by MHonArc. | |
60 | ## | |
61 | sub set_lock_mode { | |
62 | my $mode = shift; | |
63 | if ($mode =~ /\D/) { | |
64 | STR2NUM: { | |
65 | if ($mode =~ /^\s*flock/) { | |
66 | $mode = &MHA_LOCK_MODE_FLOCK; | |
67 | last STR2NUM; | |
68 | } | |
69 | $mode = &MHA_LOCK_MODE_DIR; | |
70 | last STR2NUM; | |
71 | } | |
72 | } | |
73 | if ($mode == &MHA_LOCK_MODE_FLOCK) { | |
74 | $LockFunc = \&flock_file; | |
75 | $UnlockFunc = \&unflock_file; | |
76 | return ; | |
77 | } | |
78 | $mode = &MHA_LOCK_MODE_DIR; | |
79 | $LockFunc = \&create_lock_dir; | |
80 | $UnlockFunc = \&remove_lock_dir; | |
81 | ||
82 | $mode; | |
83 | } | |
84 | ||
85 | ############################################################################# | |
86 | ## Directory Method of Locking Functions | |
87 | ############################################################################# | |
88 | ||
89 | ##--------------------------------------------------------------------------- | |
90 | ## create_lock_dir() creates a directory to act as a lock. | |
91 | ## | |
92 | sub create_lock_dir { | |
93 | my($file, $tries, $sleep, $force) = @_; | |
94 | my $prtry = 0; | |
95 | my $ret = 0; | |
96 | $_lock_file = $file; | |
97 | while ($tries > 0) { | |
98 | if (mkdir($file, 0777)) { $ISLOCK = 1; $ret = 1; last; } | |
99 | sleep($sleep) if $sleep > 0; | |
100 | $tries--; | |
101 | if (!$prtry && ($tries > 0)) { | |
102 | print STDOUT qq/Trying to create lock ...\n/ unless $QUIET; | |
103 | $prtry = 1; | |
104 | } | |
105 | } | |
106 | if ($force) { $ISLOCK = 1; $ret = 1; } | |
107 | $ret; | |
108 | } | |
109 | ||
110 | ##--------------------------------------------------------------------------- | |
111 | ## remove_lock_dir removes the lock directory | |
112 | ## | |
113 | sub remove_lock_dir { | |
114 | if ($ISLOCK) { | |
115 | if (!rmdir($_lock_file)) { | |
116 | warn "Warning: Unable to remove $LOCKFILE: $!\n"; | |
117 | return 0; | |
118 | } | |
119 | $ISLOCK = 0; | |
120 | } | |
121 | 1; | |
122 | } | |
123 | ||
124 | ############################################################################# | |
125 | ## Flock Functions | |
126 | ############################################################################# | |
127 | ||
128 | ##--------------------------------------------------------------------------- | |
129 | ## flock_file(): Create archive lock using flock(2). | |
130 | ## | |
131 | sub flock_file { | |
132 | my($file, $tries, $sleep, $force) = @_; | |
133 | ||
134 | eval { | |
135 | require Symbol; | |
136 | require Fcntl; | |
137 | Fcntl->import(':DEFAULT', ':flock'); | |
138 | }; | |
139 | if ($@) { | |
140 | warn qq/Warning: Unable to require modules for flock() lock method: /, | |
141 | qq/$@\n/, | |
142 | qq/\tFalling back to directory method.\n/; | |
143 | set_lock_mode(MHA_LOCK_MODE_DIR); | |
144 | return &$LockFunc(@_); | |
145 | } | |
146 | ||
147 | $_lock_file = $file; | |
148 | $_flock_fh = Symbol::gensym; | |
149 | ||
150 | if (!sysopen($_flock_fh, $file, (&O_WRONLY|&O_CREAT), 0666)) { | |
151 | warn(qq/ERROR: Unable to create "$file": $!\n/); | |
152 | return 0; | |
153 | } | |
154 | ||
155 | my $prtry = 0; | |
156 | my $ret = 0; | |
157 | while ($tries > 0) { | |
158 | if (flock($_flock_fh, &LOCK_EX|&LOCK_NB)) { | |
159 | $ISLOCK = 1; $ret = 1; last; | |
160 | } | |
161 | sleep($sleep) if $sleep > 0; | |
162 | $tries--; | |
163 | if (!$prtry && ($tries > 0)) { | |
164 | print STDOUT qq/Trying to create lock ...\n/ unless $QUIET; | |
165 | $prtry = 1; | |
166 | } | |
167 | } | |
168 | if (!$ISLOCK && $force) { $_flock_fh = undef; $ISLOCK = 1; $ret = 1; } | |
169 | ||
170 | $ret; | |
171 | } | |
172 | ||
173 | ##--------------------------------------------------------------------------- | |
174 | ||
175 | sub unflock_file { | |
176 | if (defined($_flock_fh)) { | |
177 | flock($_flock_fh, &LOCK_UN); | |
178 | close($_flock_fh); | |
179 | $_flock_fh = undef; | |
180 | } | |
181 | $ISLOCK = 0; | |
182 | } | |
183 | ||
184 | ||
185 | ##--------------------------------------------------------------------------- | |
186 | ||
187 | ############################################################################# | |
188 | ||
189 | BEGIN { | |
190 | set_lock_mode(MHA_LOCK_MODE_DIR); | |
191 | } | |
192 | ||
193 | 1; |