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