selfforum-cgi/shared/Lock.pm

   1 # Lock.pm
   2
   3 # ====================================================
   4 # Autor: n.d.p. / 2001-01-04
   5 # lm   : n.d.p. / 2000-01-05
   6 # ====================================================
   7 # Funktion:
   8 #      Sperren einer Datei
   9 # ====================================================
  10
  11 use strict;
  12
  13 package Lock;
  14
  15 use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS $Timeout $violentTimeout $masterTimeout $iAmMaster);
  16
  17 # ====================================================
  18 # Funktionsexport
  19 # ====================================================
  20
  21 require Exporter;
  22 @ISA         = qw(Exporter);
  23
  24 @EXPORT_OK   = qw(lock_file unlock_file write_lock_file write_unlock_file
  25                   violent_unlock_file set_master_lock release_file);
  26
  27 %EXPORT_TAGS = (READ  => [qw(lock_file unlock_file violent_unlock_file)],
  28                 WRITE => [qw(write_lock_file write_unlock_file violent_unlock_file)],
  29                 ALL   => [qw(lock_file unlock_file write_lock_file write_unlock_file
  30                              violent_unlock_file set_master_lock release_file)]);
  31
  32 # ====================================================
  33 # Windows section (no symlinks)
  34 # ====================================================
  35
  36 ################################
  37 # sub w_lock_file
  38 #
  39 # Schreibsperre setzen
  40 ################################
  41
  42 sub w_lock_file ($;$) {
  43   my $filename=shift;
  44   my ($timeout)=(shift (@_) or $Timeout);
  45   my $i;
  46
  47   if (-f &masterlockfile($filename)) {
  48
  49     for ($i=0 ; $i<=$timeout ; $i++) {
  50       # Referenzzaehler um eins erhoehen
  51       &set_ref($filename,1,$timeout) and return 1;
  52       sleep (1);}}
  53
  54   else {
  55     # Mastersperre
  56     return undef;}
  57
  58   0; # Mist
  59 }
  60
  61 ################################
  62 # sub w_unlock_file
  63 #
  64 # Schreibsperre aufheben
  65 ################################
  66
  67 sub w_unlock_file ($;$) {
  68   my $filename=shift;
  69   my ($timeout)=(shift (@_) or $Timeout);
  70
  71   if (-f &masterlockfile($filename)) {
  72     # Referenzzaehler um eins erniedrigen
  73     &set_ref($filename,-1,$timeout) and return 1;}
  74
  75   0; # Mist
  76 }
  77
  78 ################################
  79 # sub w_write_lock_file
  80 #
  81 # Lese- und Schreibsperre
  82 # setzen
  83 ################################
  84
  85 sub w_write_lock_file ($;$) {
  86   my $filename=shift;
  87   my ($timeout)=(shift (@_) or $Timeout);
  88
  89   if (-f &masterlockfile($filename) or $iAmMaster) {
  90     # bevorstehenden Schreibzugriff anmelden
  91     &simple_lock ($filename,$timeout) or return 0;
  92
  93     my $i;
  94     for ($i=0 ; $i<=$timeout ; $i++) {
  95       # Referenzdatei sperren
  96       &simple_lock (&reffile($filename),$timeout) or (return &simple_unlock($filename,$timeout) and 0);
  97
  98       # Referenzzaehler = 0 ? => okay
  99       return 1 if (&get_ref ($filename) == 0);
 100
 101       # Referenzdatei wieder freigeben
 102       &simple_unlock (&reffile($filename),$timeout) or (return &simple_unlock($filename,$timeout) and 0);
 103       sleep(1);}
 104
 105     &simple_unlock ($filename);}
 106
 107   else {
 108     # Mastersperre gesetzt
 109     return undef;}
 110
 111   0; # Mist
 112 }
 113
 114 ################################
 115 # sub w_write_unlock_file
 116 #
 117 # Lese- und Schreibsperre
 118 # aufheben
 119 ################################
 120
 121 sub w_write_unlock_file ($;$) {
 122   my $filename=shift;
 123   my ($timeout)=(shift (@_) or $Timeout);
 124
 125   if (-f &masterlockfile($filename) or $iAmMaster) {
 126     &simple_unlock (&reffile($filename),$timeout) or return 0; # Referenzdatei freigeben
 127     &simple_unlock ($filename,$timeout) or return 0;}          # Lesesperre aufheben
 128
 129   1; # jawoll!
 130 }
 131
 132 ################################
 133 # sub w_violent_unlock_file
 134 #
 135 # Sperre brutal aufheben
 136 ################################
 137
 138 sub w_violent_unlock_file ($) {
 139   my $filename=shift;
 140
 141   if (-f &masterlockfile($filename)) {
 142
 143     # Zeit der letzten Modifikation feststellen
 144     # und abbrechen, wenn meine Zeit noch nicht gekommen ist
 145     my $reffile;
 146     if (-f ($reffile = $filename) or -f ($reffile = &lockfile($filename))) {
 147       my $time = (stat $reffile)[9];
 148       return if ((time - $time) < $violentTimeout);}
 149
 150     write_lock_file ($filename,1);       # letzter Versuch, exklusiven Zugriff zu bekommen
 151     unlink (&reffile($filename));        # Referenzzaehler auf null
 152     simple_unlock (&reffile($filename)); # Referenzdatei freigeben
 153     simple_unlock ($filename);}          # Datei freigeben (Lesesperre aufheben)
 154 }
 155
 156 ################################
 157 # sub w_set_master_lock
 158 #
 159 # Mastersperre setzen
 160 ################################
 161
 162 sub w_set_master_lock ($;$) {
 163   my $filename=shift;
 164   my $timeout=(shift @_ or $masterTimeout);
 165
 166   # exklusiven Zugriff erlangen...oder abbrechen
 167   return 0 unless (&write_lock_file ($filename,$timeout));
 168
 169   # Mastersperre setzen und Erfolg melden
 170   unlink &masterlockfile($filename) and return 1;
 171
 172   0; # Mist
 173 }
 174
 175 ################################
 176 # sub w_release_file
 177 #
 178 # Alle Sperren inkl. Master-
 179 # sperre aufheben
 180 ################################
 181
 182 sub w_release_file ($) {
 183   my $filename=shift;
 184
 185   unlink (&reffile($filename));                              # Referenzzaehler auf null
 186   return 0 if (-f &reffile($filename));                      # wirklich?
 187   return 0 unless (simple_unlock (&reffile($filename)));     # Referenzzaehler freigeben
 188   return 0 unless (&simple_unlock ($filename));              # Datei selbst freigeben (Lesesperre)
 189   return 0 unless (&simple_unlock (&masterfile($filename))); # Mastersperre aufheben
 190
 191   1; # jup
 192 }
 193
 194 # ====================================================
 195 # *n*x section (symlinks possible)
 196 # ====================================================
 197
 198 ################################
 199 # sub x_lock_file
 200 #
 201 # Schreibsperre setzen
 202 ################################
 203
 204 sub x_lock_file ($;$) {
 205   my $filename=shift;
 206   my ($timeout)=(shift (@_) or $Timeout);
 207   my $i;
 208
 209   unless (-l &masterlockfile($filename)) {
 210
 211     for ($i=0 ; $i<=$timeout ; $i++) {
 212       # Referenzzaehler um eins erhoehen
 213       &set_ref($filename,1,$timeout) and return 1;
 214       sleep (1);}}
 215
 216   else {
 217     # Mastersperre
 218     return undef;}
 219
 220   0; # Mist
 221 }
 222
 223 ################################
 224 # sub x_unlock_file
 225 #
 226 # Schreibsperre aufheben
 227 ################################
 228
 229 sub x_unlock_file ($;$) {
 230   my $filename=shift;
 231   my ($timeout)=(shift (@_) or $Timeout);
 232
 233   unless (-l &masterlockfile($filename)) {
 234     # Referenzzaehler um eins erniedrigen
 235     &set_ref($filename,-1,$timeout) and return 1;}
 236
 237   0; # Mist
 238 }
 239
 240 ################################
 241 # sub x_write_lock_file
 242 #
 243 # Lese- und Schreibsperre
 244 # setzen
 245 ################################
 246
 247 sub x_write_lock_file ($;$) {
 248   my $filename=shift;
 249   my ($timeout)=(shift (@_) or $Timeout);
 250
 251   unless (-l &masterlockfile($filename) and not $iAmMaster) {
 252     # bevorstehenden Schreibzugriff anmelden
 253     &simple_lock ($filename,$timeout) or return 0;
 254
 255     my $i;
 256     for ($i=0 ; $i<=$timeout ; $i++) {
 257       # Referenzdatei sperren
 258       &simple_lock (&reffile($filename),$timeout) or (return &simple_unlock($filename,$timeout) and 0);
 259
 260       # Referenzzaehler = 0 ? => okay
 261       return 1 if (&get_ref ($filename) == 0);
 262
 263       # Referenzdatei wieder freigeben
 264       &simple_unlock (&reffile($filename),$timeout) or (return &simple_unlock($filename,$timeout) and 0);
 265       sleep(1);}
 266
 267     &simple_unlock ($filename);}
 268
 269   else {
 270     # Mastersperre gesetzt
 271     return undef;}
 272
 273   0; # Mist
 274 }
 275
 276 ################################
 277 # sub x_write_unlock_file
 278 #
 279 # Lese- und Schreibsperre
 280 # aufheben
 281 ################################
 282
 283 sub x_write_unlock_file ($;$) {
 284   my $filename=shift;
 285   my ($timeout)=(shift (@_) or $Timeout);
 286
 287   unless (-l &masterlockfile($filename) and not $iAmMaster) {
 288     &simple_unlock (&reffile($filename),$timeout) or return 0; # Referenzdatei freigeben
 289     &simple_unlock ($filename,$timeout) or return 0;}          # Lesesperre aufheben
 290
 291   1; # jawoll!
 292 }
 293
 294 ################################
 295 # sub x_violent_unlock_file
 296 #
 297 # Sperre brutal aufheben
 298 ################################
 299
 300 sub x_violent_unlock_file ($) {
 301   my $filename=shift;
 302
 303   unless (-l &masterlockfile($filename)) {
 304
 305     # Zeit der letzten Modifikation feststellen
 306     # und abbrechen, wenn meine Zeit noch nicht gekommen ist
 307     my ($reffile,$time);
 308
 309     if (-f ($reffile = $filename)) {
 310       $time = (stat $reffile)[9];}
 311
 312     elsif (-l ($reffile = &lockfile($filename))) {
 313       $time = (lstat $reffile)[9];}
 314
 315     if ($reffile) {
 316       return if ((time - $time) < $violentTimeout);}
 317
 318     write_lock_file ($filename,1);       # letzter Versuch, exklusiven Zugriff zu bekommen
 319     unlink (&reffile($filename));        # Referenzzaehler auf null
 320     simple_unlock (&reffile($filename)); # Referenzdatei freigeben
 321     simple_unlock ($filename);}          # Datei freigeben (Lesesperre aufheben)
 322 }
 323
 324 ################################
 325 # sub x_set_master_lock
 326 #
 327 # Mastersperre setzen
 328 ################################
 329
 330 sub x_set_master_lock ($;$) {
 331   my $filename=shift;
 332   my $timeout=(shift @_ or $masterTimeout);
 333
 334   # exklusiven Zugriff erlangen...oder abbrechen
 335   return 0 unless (&write_lock_file ($filename,$timeout));
 336
 337   # Mastersperre setzen und Erfolg melden
 338   symlink $filename, &masterlockfile($filename) and return 1;
 339
 340   0; # Mist
 341 }
 342
 343 ################################
 344 # sub x_release_file
 345 #
 346 # Alle Sperren inkl. Master-
 347 # sperre aufheben
 348 ################################
 349
 350 sub x_release_file ($) {
 351   my $filename=shift;
 352
 353   unlink (&reffile($filename));                              # Referenzzaehler auf null
 354   return 0 if (-f &reffile($filename));                      # wirklich?
 355   return 0 unless (simple_unlock (&reffile($filename)));     # Referenzzaehler freigeben
 356   return 0 unless (&simple_unlock ($filename));              # Datei selbst freigeben (Lesesperre)
 357   return 0 unless (&simple_unlock (&masterfile($filename))); # Mastersperre aufheben
 358
 359   1; # jup
 360 }
 361
 362 # ====================================================
 363 # private subs
 364 # ====================================================
 365
 366 ################################
 367 # Dateinamen
 368 ################################
 369
 370 sub reffile ($) {
 371   "$_[0].lock.ref";
 372 }
 373 sub lockfile ($) {
 374   "$_[0].lock";
 375 }
 376 sub masterlockfile ($) {
 377   &lockfile(&masterfile($_[0]));
 378 }
 379 sub masterfile ($) {
 380   "$_[0].master";
 381 }
 382
 383 ################################
 384 # einfaches Sperren/Entsperren
 385 # Windows
 386 #
 387 # (Lockdatei loeschen)
 388 ################################
 389
 390 sub w_simple_lock ($;$) {
 391   my $filename=shift;
 392   my ($timeout)=(shift (@_) or $Timeout);
 393   my $lockfile=&lockfile($filename);
 394
 395   my $i;
 396   for ($i=$timeout; $i>=0; $i--) {
 397     unlink("$lockfile") and return 1;
 398     sleep(1);}
 399
 400   0; # Mist
 401 }
 402
 403 sub w_simple_unlock ($) {
 404   my $filename=shift;
 405   my $lockfile=&lockfile($filename);
 406   my $flag=1;
 407   local *LF;
 408
 409   open(LF, ">$lockfile") or $flag=0;
 410   close(LF) or $flag=0;
 411
 412   # Rueckgabe
 413   $flag;
 414 }
 415
 416 ################################
 417 # einfaches Sperren/Entsperren
 418 # *n*x
 419 #
 420 # (symlink setzen)
 421 ################################
 422
 423 sub x_simple_lock ($;$) {
 424   my $filename=shift;
 425   my ($timeout)=(shift (@_) or $Timeout);
 426   my $lockfile=&lockfile($filename);
 427
 428   my $i;
 429   for ($i=$timeout; $i>=0; $i--) {
 430     symlink $filename,$lockfile and return 1;
 431     sleep(1);}
 432
 433   0; # Mist
 434 }
 435
 436 sub x_simple_unlock ($) {
 437   my $filename=shift;
 438
 439   unlink (&lockfile($filename)) and return 1;
 440
 441   0; # hmmm...
 442 }
 443
 444 ################################
 445 # sub w_set_ref
 446 # Windows
 447 #
 448 # Referenzzaehler um $_[1]
 449 # erhoehen
 450 # (kann auch negativ sein...)
 451 ################################
 452
 453 sub w_set_ref ($$$) {
 454   my ($filename,$z)=@_;
 455   my $timeout=(shift @_ or $Timeout);
 456   my $old;
 457   my $reffile=&reffile($filename);
 458   local *REF;
 459
 460
 461   # runterzaehlen - ja, neue Leseversuche - nein
 462   if ($z > 0) {
 463     return 0 unless(-e &lockfile($filename));}
 464
 465   # Referenzdatei locken
 466   return 0 unless(&simple_lock ($reffile,$timeout));
 467
 468   # Referenzdatei auslesen
 469   unless (open REF,"<$reffile") {
 470     $old=0;}
 471   else {
 472     $old=<REF>;
 473     chomp $old;
 474     close REF or return 0;}
 475
 476   # Neuen Referenzwert schreiben
 477   $old+=$z;
 478   $old=0 if ($old < 0);
 479   open REF,">$reffile" or return 0;
 480   print REF $old;
 481   close REF or return 0;
 482
 483   # wieder entsperren
 484   return 0 unless(&simple_unlock($reffile));
 485
 486   1;
 487 }
 488
 489 ################################
 490 # sub x_set_ref
 491 # *n*x
 492 #
 493 # Referenzzaehler um $_[1]
 494 # erhoehen
 495 # (kann auch negativ sein...)
 496 ################################
 497
 498 sub x_set_ref ($$$) {
 499   my ($filename,$z)=@_;
 500   my $timeout=(shift @_ or $Timeout);
 501   my $old;
 502   my $reffile=&reffile($filename);
 503   local *REF;
 504
 505
 506   # runterzaehlen - ja, neue Leseversuche - nein
 507   if ($z > 0) {
 508     return 0 if(-l &lockfile($filename));}
 509
 510   # Referenzdatei locken
 511   return 0 unless(&simple_lock ($reffile,$timeout));
 512
 513   # Referenzdatei auslesen
 514   unless (open REF,"<$reffile") {
 515     $old=0;}
 516   else {
 517     $old=<REF>;
 518     chomp $old;
 519     close REF or return 0;}
 520
 521   # Neuen Referenzwert schreiben
 522   $old += $z;
 523   $old = 0 if ($old < 0);
 524   open REF,">$reffile" or return 0;
 525   print REF $old;
 526   close REF or return 0;
 527
 528   # wieder entsperren
 529   return 0 unless(&simple_unlock($reffile));
 530
 531   1;
 532 }
 533
 534 ################################
 535 # sub get_ref
 536 #
 537 # Referenzzaehler auslesen
 538 #
 539 # Das Locking muss an
 540 # anderer Stelle ausgefuehrt
 541 # werden!
 542 ################################
 543
 544 sub get_ref ($$) {
 545   my $filename=shift;
 546   my $reffile=&reffile($filename);
 547   my $old;
 548   local *REF;
 549
 550   unless (open REF,"<$reffile") {
 551     $old=0;}
 552   else {
 553     $old=<REF>;
 554     chomp $old;
 555     close REF or return 0;}
 556
 557   # Rueckgabe
 558   $old;
 559 }
 560
 561 # ====================================================
 562 # Modulinitialisierung
 563 # ====================================================
 564
 565 BEGIN {
 566   # Globale Variablen (Zeiten in Sekunden)
 567   $Timeout        =  10; # normaler Timeout
 568   $violentTimeout = 600; # zum gewaltsamen Entsperren (10 Minuten)
 569   $masterTimeout  =  20; # fuer die Mastersperre
 570
 571   $iAmMaster = 0;        # erstmal bin ich kein Master :-)
 572
 573   # wirkliche Funktionen ihren Bezeichnern zuweisen
 574   # (perldoc -f symlink)
 575
 576   if ( eval {local $SIG{__DIE__}; symlink('',''); 1 } ) {
 577     *lock_file           = \&x_lock_file;
 578     *unlock_file         = \&x_unlock_file;
 579     *write_lock_file     = \&x_write_lock_file;
 580     *write_unlock_file   = \&x_write_unlock_file;
 581     *violent_unlock_file = \&x_violent_unlock_file;
 582     *set_master_lock     = \&x_set_master_lock;
 583     *release_file        = \&x_release_file;
 584
 585     *simple_lock         = \&x_simple_lock;
 586     *simple_unlock       = \&x_simple_unlock;
 587     *set_ref             = \&x_set_ref;}
 588
 589   else {
 590     *lock_file           = \&w_lock_file;
 591     *unlock_file         = \&w_unlock_file;
 592     *write_lock_file     = \&w_write_lock_file;
 593     *write_unlock_file   = \&w_write_unlock_file;
 594     *violent_unlock_file = \&w_violent_unlock_file;
 595     *set_master_lock     = \&w_set_master_lock;
 596     *release_file        = \&w_release_file;
 597
 598     *simple_lock         = \&w_simple_lock;
 599     *simple_unlock       = \&w_simple_unlock;
 600     *set_ref             = \&w_set_ref;}
 601 }
 602
 603 # making require happy
 604 1;
 605
 606 # ====================================================
 607 # end of Lock
 608 # ====================================================