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