]> git.p6c8.net - selfforum.git/blob - selfforum-cgi/shared/Lock.pm
copyright holders modified
[selfforum.git] / selfforum-cgi / shared / Lock.pm
1 package Lock;
2
3 ################################################################################
4 # #
5 # File: shared/Lock.pm #
6 # #
7 # Authors: Andre Malo <nd@o3media.de>, 2001-04-01 #
8 # #
9 # Description: file locking #
10 # #
11 ################################################################################
12
13 use strict;
14 use vars qw(
15 @EXPORT_OK
16 %EXPORT_TAGS
17 %LOCKED
18 $Timeout
19 $violentTimeout
20 $masterTimeout
21 $iAmMaster
22 );
23
24 use Carp;
25 use Fcntl;
26
27 ################################################################################
28 #
29 # Export
30 #
31 use base qw(Exporter);
32
33 @EXPORT_OK = qw(
34 lock_file
35 unlock_file
36 write_lock_file
37 write_unlock_file
38 violent_unlock_file
39 set_master_lock
40 release_file
41 file_removed
42 );
43
44 %EXPORT_TAGS = (
45 READ => [qw(
46 lock_file
47 unlock_file
48 violent_unlock_file
49 )],
50 WRITE => [qw(
51 write_lock_file
52 write_unlock_file
53 violent_unlock_file
54 )],
55 ALL => \@EXPORT_OK
56 );
57
58 ### sub ~file ($) ##############################################################
59 #
60 # create lock file names
61 #
62 sub reffile ($) {
63 return $_[0].'.lock.ref';
64 }
65 sub lockfile ($) {
66 return $_[0].'.lock';
67 }
68 sub masterfile ($) {
69 return $_[0].'.master';
70 }
71 sub masterlockfile ($) {
72 return lockfile(masterfile $_[0]);
73 }
74
75 ################################################################################
76 #
77 # Windows section (no symlinks)
78 #
79
80 ### sub w_lock_file ($;$) ######################################################
81 #
82 # set read lock (shared lock)
83 # (for no-symlink-systems)
84 #
85 # Params: $filename - file to lock
86 # $timeout - Lock Timeout (sec.)
87 #
88 # Return: Status Code (Bool)
89 #
90 sub w_lock_file ($;$) {
91 my $filename = shift;
92 my $timeout = +shift || $Timeout;
93
94 unless ($LOCKED{$filename}) {
95 if (-f masterlockfile($filename)) {
96 for (1..$timeout) {
97
98 # try to increment the reference counter
99 #
100 if (set_ref($filename,1,$timeout)) {
101 $LOCKED{$filename}=1;
102 return 1;
103 }
104 sleep (1);
105 }
106 }
107 else {
108 # master lock is set or file has not been released yet
109 return;
110 }
111 }
112
113 # time out
114 # maybe the system is occupied
115 0;
116 }
117
118 ### sub w_unlock_file ($;$) ####################################################
119 #
120 # remove read lock (shared lock)
121 # (for no-symlink-systems)
122 #
123 # Params: $filename - locked file
124 # $timeout - timeout (sec.)
125 #
126 # Return: Status Code (Bool)
127 #
128 sub w_unlock_file ($;$) {
129 my $filename = shift;
130 my $timeout = shift || $Timeout;
131
132 if ($LOCKED{$filename}) {
133 if ($LOCKED{$filename} == 3) {
134 return unless write_unlock_file($filename, $timeout);
135 $LOCKED{$filename} = 1;
136 }
137 if ($LOCKED{$filename} == 1) {
138 if (-f masterlockfile($filename)) {
139
140 # try do decrement the reference counter
141 #
142 if (set_ref($filename, -1, $timeout)) {
143 delete $LOCKED{$filename};
144 return 1;
145 }
146 }
147 }
148 }
149
150 # time out
151 return;
152 }
153
154 ### sub w_write_lock_file ($;$) ################################################
155 #
156 # set write lock (exclusive lock)
157 # (for no-symlink-systems)
158 #
159 # Params: $filename - file to lock
160 # $timeout - timeout (sec.)
161 #
162 # Return: Status Code (Bool)
163 #
164 sub w_write_lock_file ($;$) {
165 my $filename=shift;
166 my $timeout= shift || $Timeout;
167 my $rest = ($LOCKED{$filename} and $LOCKED{$filename} == 1) ? 1 : 0;
168
169 if (-f masterlockfile($filename) or $iAmMaster) {
170
171 # announce the write lock
172 # and wait $timeout seconds for
173 # references == 0 (no shared locks set)
174 #
175 simple_lock ($filename,$timeout) or return 0;
176 for (1..$timeout) {
177 # lock reference counter
178 # or fail
179 #
180 unless (simple_lock (reffile($filename),$timeout)) {
181 simple_unlock($filename,$timeout);
182 return 0;
183 }
184
185 # ready if we have no shared locks
186 #
187 if (get_ref ($filename) == $rest) {
188 $LOCKED{$filename} = 2 | ($rest ? 1 : 0);
189 return 1;
190 };
191
192 # release reference counter
193 # shared locks get the chance to be removed
194 #
195 unless (simple_unlock (reffile($filename),$timeout)) {
196 simple_unlock($filename,$timeout);
197 return 0;
198 }
199 sleep(1);
200 }
201
202 # write lock failed
203 # remove the announcement
204 #
205 simple_unlock ($filename);
206 }
207
208 else {
209 # master lock is set or file has not been released yet
210 return;
211 }
212
213 # time out
214 0;
215 }
216
217 ### sub w_write_unlock_file ($;$) ##############################################
218 #
219 # remove write lock (exclusive lock)
220 # (for no-symlink-systems)
221 #
222 # Params: $filename - locked file
223 # $timeout - timeout (sec.)
224 #
225 # Return: Status Code (Bool)
226 #
227 sub w_write_unlock_file ($;$) {
228 my $filename = shift;
229 my $timeout = shift || $Timeout;
230
231 if (-f masterlockfile($filename) or $iAmMaster) {
232
233 # remove reference counter lock
234 #
235 simple_unlock (reffile($filename),$timeout) or return;
236
237 # remove the write lock announce
238 #
239 simple_unlock ($filename,$timeout) or return;
240 }
241
242 # done
243 delete $LOCKED{$filename};
244 1;
245 }
246
247 ### sub w_violent_unlock_file ($) ##############################################
248 #
249 # remove any lock violent (excl. master lock)
250 # (for no-symlink-systems)
251 #
252 # Params: $filename - locked file
253 #
254 # Return: -none- (the success is not defined)
255 #
256 sub w_violent_unlock_file ($) {
257 my $filename = shift;
258
259 if (-f masterlockfile($filename)) {
260
261 # find out last modification time
262 # and do nothing unless 'violent-timout' is over
263 #
264 my $reffile;
265 if (-f ($reffile = $filename) or -f ($reffile = lockfile($filename))) {
266 my $time = (stat $reffile)[9];
267 (time - $time) >= $violentTimeout or return;
268 }
269
270 write_lock_file ($filename,1); # last try, to set an exclusive lock on $filename
271 unlink (reffile($filename)); # reference counter = 0
272 simple_unlock (reffile($filename)); # release reference counter file
273 simple_unlock ($filename);} # release file
274 delete $LOCKED{$filename};
275
276 return;
277 }
278
279 ### sub w_set_master_lock ($;$) ################################################
280 #
281 # set master lock
282 # (for no-symlink-systems)
283 #
284 # Params: $filename - file to lock
285 # $timeout - timeout (sec.)
286 #
287 # Return: Status Code (Bool)
288 #
289 sub w_set_master_lock ($;$) {
290 my $filename = shift;
291 my $timeout = shift || $masterTimeout;
292
293 # set exclusive lock or fail
294 #
295 return unless (write_lock_file ($filename,$timeout));
296
297 # set master lock
298 #
299 unlink masterlockfile($filename) and return 1;
300
301 # no chance (occupied?, master lock set yet?)
302 return;
303 }
304
305 ### sub w_release_file ($) #####################################################
306 #
307 # remove any locks (incl. master lock)
308 # (for no-symlink-systems)
309 #
310 # Params: $filename - file to lock
311 # $timeout - timeout (sec.)
312 #
313 # Return: Status Code (Bool)
314 #
315 sub w_release_file ($) {
316 my $filename=shift;
317
318 unlink (reffile($filename)); # reference counter = 0
319 return if (-f reffile($filename)); # really?
320 return unless (simple_unlock (reffile($filename))); # release reference counter
321 return unless (simple_unlock ($filename)); # remove any write lock announce
322 return unless (simple_unlock (masterfile($filename))); # remove master lock
323 delete $LOCKED{$filename};
324
325 # done
326 1;
327 }
328
329 sub w_file_removed ($) {
330 my $filename = shift;
331
332 unlink reffile($filename);
333 unlink lockfile($filename);
334 unlink lockfile(reffile($filename));
335 unlink masterlockfile($filename);
336 }
337
338 ################################################################################
339 #
340 # *n*x section (symlinks possible)
341 #
342
343 ### sub x_lock_file ($;$) ######################################################
344 #
345 # set read lock (shared lock)
346 # (symlinks possible)
347 #
348 # Params: $filename - file to lock
349 # $timeout - Lock Timeout (sec.)
350 #
351 # Return: Status Code (Bool)
352 #
353 sub x_lock_file ($;$) {
354 my $filename = shift;
355 my $timeout = shift || $Timeout;
356
357 unless ($LOCKED{$filename}) {
358 unless (-l masterlockfile($filename)) {
359 for (1..$timeout) {
360
361 # try to increment the reference counter
362 #
363 if (set_ref($filename,1,$timeout)) {
364 $LOCKED{$filename} = 1;
365 return 1;
366 }
367 sleep (1);
368 }
369 }
370
371 else {
372 # master lock is set or file has not been realeased yet
373 return;
374 }
375 }
376
377 # time out
378 0;
379 }
380
381 ### sub x_unlock_file ($;$) ####################################################
382 #
383 # remove read lock (shared lock)
384 # (symlinks possible)
385 #
386 # Params: $filename - locked file
387 # $timeout - timeout (sec.)
388 #
389 # Return: Status Code (Bool)
390 #
391 sub x_unlock_file ($;$) {
392 my $filename=shift;
393 my ($timeout)=(shift (@_) or $Timeout);
394
395 if ($LOCKED{$filename}) {
396 if ($LOCKED{$filename} == 3) {
397 return unless write_unlock_file($filename, $timeout);
398 $LOCKED{$filename} = 1;
399 }
400 if ($LOCKED{$filename} == 1) {
401 unless (-l masterlockfile($filename)) {
402 # try to decrement the reference counter
403 #
404 set_ref($filename,-1,$timeout) and do {
405 delete $LOCKED{$filename};
406 return 1;
407 }
408 }
409
410 # time out
411 return;
412 }
413 }
414 }
415
416 ### sub x_write_lock_file ($;$) ################################################
417 #
418 # set write lock (exclusive lock)
419 # (symlinks possible)
420 #
421 # Params: $filename - file to lock
422 # $timeout - timeout (sec.)
423 #
424 # Return: Status Code (Bool)
425 #
426 sub x_write_lock_file ($;$) {
427 my $filename = shift;
428 my $timeout = shift || $Timeout;
429 my $rest = ($LOCKED{$filename} and $LOCKED{$filename} == 1) ? 1 : 0;
430
431 unless (-l masterlockfile($filename) and not $iAmMaster) {
432 # announce the write lock
433 # and wait $timeout seconds for
434 # references == 0 (no shared locks set)
435 #
436 simple_lock ($filename,$timeout) or return 0;
437 for (1..$timeout) {
438
439 # lock reference counter
440 # or fail
441 #
442 unless (simple_lock (&reffile($filename),$timeout)) {
443 simple_unlock($filename,$timeout);
444 return 0;
445 }
446
447 # ready if we have no shared locks
448 #
449 if (get_ref ($filename) == $rest) {
450 $LOCKED{$filename} = 2 | ($rest ? 1 : 0);
451 return 1;
452 };
453
454 # release reference counter
455 # shared locks get the chance to be removed
456 #
457 unless (simple_unlock (&reffile($filename),$timeout)) {
458 simple_unlock($filename,$timeout);
459 return 0;
460 }
461 sleep(1);
462 }
463
464 # write lock failed
465 # remove the announcement
466 #
467 simple_unlock ($filename);
468 }
469
470 else {
471 # master lock is set
472 # or file has not been released yet
473 #
474 return;
475 }
476
477 # time out
478 # maybe the system is occupied
479 #
480 0;
481 }
482
483 ### sub x_write_unlock_file ($;$) ##############################################
484 #
485 # remove write lock (exclusive lock)
486 # (symlinks possible)
487 #
488 # Params: $filename - locked file
489 # $timeout - timeout (sec.)
490 #
491 # Return: Status Code (Bool)
492 #
493 sub x_write_unlock_file ($;$) {
494 my $filename = shift;
495 my $timeout = shift || $Timeout;
496
497 unless (-l &masterlockfile($filename) and not $iAmMaster) {
498 # remove reference counter lock
499 #
500 simple_unlock (reffile($filename),$timeout) or return;
501
502 # remove the write lock announce
503 #
504 simple_unlock ($filename,$timeout) or return;
505 }
506
507 # done
508 delete $LOCKED{$filename};
509 1;
510 }
511
512 ### sub x_violent_unlock_file ($) ##############################################
513 #
514 # remove any lock violent (excl. master lock)
515 # (symlinks possible)
516 #
517 # Params: $filename - locked file
518 #
519 # Return: -none- (the success is not defined)
520 #
521 sub x_violent_unlock_file ($) {
522 my $filename=shift;
523
524 unless (-l &masterlockfile($filename)) {
525
526 # find out last modification time
527 # and do nothing unless 'violent-timout' is over
528 #
529 my ($reffile,$time);
530
531 if (-f ($reffile = $filename)) {
532 $time = (stat $reffile)[9];}
533
534 elsif (-l ($reffile = lockfile($filename))) {
535 $time = (lstat $reffile)[9];}
536
537 if ($reffile) {
538 return if ((time - $time) < $violentTimeout);}
539
540 write_lock_file ($filename,1); # last try, to set an exclusive lock on $filename
541 unlink (reffile($filename)); # reference counter = 0
542 simple_unlock (reffile($filename)); # release reference counter file
543 simple_unlock ($filename);} # release file
544 delete $LOCKED{$filename};
545 }
546
547 ### sub x_set_master_lock ($;$) ################################################
548 #
549 # set master lock
550 # (symlinks possible)
551 #
552 # Params: $filename - file to lock
553 # $timeout - timeout (sec.)
554 #
555 # Return: Status Code (Bool)
556 #
557 sub x_set_master_lock ($;$) {
558 my $filename = shift;
559 my $timeout = shift || $masterTimeout;
560
561 # set exclusive lock or fail
562 #
563 return unless (write_lock_file ($filename,$timeout));
564
565 # set master lock
566 #
567 symlink $filename, masterlockfile($filename) and return 1;
568
569 # no chance (occupied?, master lock set yet?)
570 return;
571 }
572
573 ### sub x_release_file ($) #####################################################
574 #
575 # remove any locks (incl. master lock)
576 # (symlinks possible)
577 #
578 # Params: $filename - file to lock
579 # $timeout - timeout (sec.)
580 #
581 # Return: Status Code (Bool)
582 #
583 sub x_release_file ($) {
584 my $filename=shift;
585
586 unlink (reffile($filename)); # reference counter = 0
587 return if (-f reffile($filename)); # really?
588 return unless (simple_unlock (reffile($filename))); # release reference counter
589 return unless (simple_unlock ($filename)); # remove any write lock announce
590 return unless (simple_unlock (masterfile($filename))); # remove master lock
591 delete $LOCKED{$filename};
592
593 # done
594 1;
595 }
596
597 sub x_file_removed ($) {
598 release_file (shift);
599 }
600
601 ### sub w_simple_lock ($;$) ####################################################
602 ### sub w_simple_unlock ($) ####################################################
603 #
604 # simple file lock/unlock
605 # (for no-symlink-systems: kill/create lockfile)
606 #
607 # Params: $filename - file to lock
608 # [ $timeout - Lock time out (sec.) ]
609 #
610 # Return: Status Code (Bool)
611 #
612 sub w_simple_lock ($;$) {
613 my $filename = shift;
614 my $timeout = shift || $Timeout;
615 my $lockfile = lockfile $filename;
616
617 for (0..$timeout) {
618 unlink $lockfile and return 1;
619 sleep(1);
620 }
621
622 # timeout
623 # occupied?
624 return;
625 }
626
627 sub w_simple_unlock ($) {
628 my $filename = shift;
629 my $lockfile = lockfile $filename;
630 local *LF;
631
632 if (sysopen(LF, $lockfile, O_WRONLY|O_CREAT|O_TRUNC)) {
633 return 1 if close (LF);
634 }
635
636 # not able to create lockfile, hmmm...
637 #
638 return;
639 }
640
641 ### sub x_simple_lock ($;$) ####################################################
642 ### sub x_simple_unlock ($) ####################################################
643 #
644 # simple file lock/unlock
645 # (symlinks possible: create/unlink symlink)
646 #
647 # Params: $filename - file to lock
648 # [ $timeout - Lock time out (sec.) ]
649 #
650 # Return: Status Code (Bool)
651 #
652 sub x_simple_lock ($;$) {
653 my $filename = shift;
654 my $timeout = shift || $Timeout;
655 my $lockfile = lockfile $filename;
656
657 for (0..$timeout) {
658 symlink $filename,$lockfile and return 1;
659 sleep(1);
660 }
661
662 # time out
663 return;
664 }
665
666 sub x_simple_unlock ($) {
667 my $filename=shift;
668
669 unlink (lockfile $filename) and return 1;
670
671 # not able to unlink symlink, hmmm...
672 #
673 return;
674 }
675
676 ### sub w_set_ref ($$$) ########################################################
677 #
678 # add $_[1] to reference counter
679 # (may be negative...)
680 # (for no-symlink-systems)
681 #
682 # Params: $filename - file, reference counter belongs to
683 # $z - value, added to reference counter
684 # $timeout - lock time out
685 #
686 # Return: Status Code (Bool)
687 #
688 sub w_set_ref ($$$) {
689 my $filename = shift;
690 my $z = shift;
691 my $timeout = shift || $Timeout;
692 my $reffile = reffile $filename;
693 local *REF;
694
695 # if write lock announced, only count down allowed
696 #
697 ($z < 0 or -f lockfile ($filename)) or return;
698
699 # lock reference counter file
700 #
701 simple_lock ($reffile,$timeout) or return;
702
703 # load reference counter
704 #
705 my $old = get_ref ($filename);
706
707 # compute and write new ref. counter
708 #
709 $old += $z;
710 $old = 0 if ($old < 0);
711
712 # kill reference counter file
713 # if ref. counter == 0
714 #
715 if ($old == 0) {
716 unlink $reffile or return;
717 }
718 else {
719 local $\;
720 sysopen (REF, $reffile, O_WRONLY | O_TRUNC | O_CREAT) or return;
721 print REF $old or do {
722 close REF;
723 return
724 };
725 close REF or return;
726 }
727
728 # release ref. counter file
729 #
730 simple_unlock($reffile) or return;
731
732 # done
733 1;
734 }
735
736 ### sub x_set_ref ($$$) ########################################################
737 #
738 # add $_[1] to reference counter
739 # (may be negative...)
740 # (symlinks possible)
741 #
742 # Params: $filename - file, reference counter belongs to
743 # $z - value, added to reference counter
744 # $timeout - lock time out
745 #
746 # Return: Status Code (Bool)
747 #
748 sub x_set_ref ($$$) {
749 my $filename = shift;
750 my $z = shift;
751 my $timeout = shift || $Timeout;
752 my $reffile = reffile $filename;
753 local *REF;
754
755 # if write lock announced, only count down allowed
756 #
757 if ($z > 0) {
758 return if(-l lockfile($filename));
759 }
760
761 # lock reference counter file
762 #
763 return unless(simple_lock ($reffile,$timeout));
764
765 # load reference counter
766 #
767 my $old = get_ref ($filename);
768
769 # compute and write new ref. counter
770 #
771 $old += $z;
772 $old = 0 if ($old < 0);
773
774 if ($old == 0) {
775 unlink $reffile or return;
776 }
777 else {
778 local $\;
779 sysopen (REF, $reffile, O_WRONLY | O_TRUNC | O_CREAT) or return;
780 print REF $old or do {
781 close REF;
782 return
783 };
784 close REF or return;
785 }
786
787 # release ref. counter file
788 #
789 simple_unlock($reffile) or return;
790
791 # done
792 1;
793 }
794
795 ### sub get_ref ($) ############################################################
796 #
797 # read out the reference counter
798 # (system independant)
799 # no locking here!
800 #
801 # Params: $filename - file, the ref. counter belongs to
802 #
803 # Return: reference counter
804 #
805 sub get_ref ($) {
806 my $filename = shift;
807 my $reffile = reffile $filename;
808 my $old;
809 local *REF;
810 local $/;
811
812 sysopen (REF, $reffile, O_RDONLY) or return 0;
813 $old = <REF>;
814 close REF;
815
816 # return value
817 $old;
818 }
819
820 ################################################################################
821 #
822 # initializing the module
823 #
824 BEGIN {
825 # global variables (time in seconds)
826 #
827 $Timeout = 10; # normal timeout
828 $violentTimeout = 600; # violent timeout (10 minutes)
829 $masterTimeout = 20; # master timeout
830
831 $iAmMaster = 0; # default: I am nobody
832
833 %LOCKED = ();
834
835 # assign the aliases to the needed functions
836 # (perldoc -f symlink)
837
838 if ( eval {local $SIG{__DIE__}; symlink('',''); 1 } ) {
839 *lock_file = \&x_lock_file;
840 *unlock_file = \&x_unlock_file;
841 *write_lock_file = \&x_write_lock_file;
842 *write_unlock_file = \&x_write_unlock_file;
843 *violent_unlock_file = \&x_violent_unlock_file;
844 *set_master_lock = \&x_set_master_lock;
845 *release_file = \&x_release_file;
846 *file_removed = \&x_file_removed;
847
848 *simple_lock = \&x_simple_lock;
849 *simple_unlock = \&x_simple_unlock;
850 *set_ref = \&x_set_ref;
851 }
852
853 else {
854 *lock_file = \&w_lock_file;
855 *unlock_file = \&w_unlock_file;
856 *write_lock_file = \&w_write_lock_file;
857 *write_unlock_file = \&w_write_unlock_file;
858 *violent_unlock_file = \&w_violent_unlock_file;
859 *set_master_lock = \&w_set_master_lock;
860 *release_file = \&w_release_file;
861 *file_removed = \&w_file_removed;
862
863 *simple_lock = \&w_simple_lock;
864 *simple_unlock = \&w_simple_unlock;
865 *set_ref = \&w_set_ref;
866 }
867 }
868
869 # keeping require happy
870 1;
871
872 #
873 #
874 ### end of Lock ################################################################

patrick-canterino.de