Ganze Verzeichnisse sperren für andere Anwendungen - Flock für Verzeichnisse

Also, wieder mal Grundlagenforschung, die im Übrigen auch aus meinem Cache-Modul stammt:

Wie man per flock einzelne Dateien für Lesen bzw. Schreibzugriffe sperrt, ist glaub ich inzwischen bekannt.

Was aber tun, wenn man ganze Verzeichnisse sperren will?
Eine Möglichkeit wäre, alle Dateien einzeln per flock zu sperren, was aber wohl etwas aufwändig werden würde.

Deswegen ein anderer Ansatz:
Es wird pro zu überwachenden Verzeichnis eine Datei angelegt, anhand der überwacht wird, ob gerade ein Zugriff erlaubt ist.

Also, mal genauer:
Ich will den Ordner "test" überwachen, natürlich auch darin enthaltene Verzeichnisse und Dateien. Ich will, daß immer nur ein Prozeß erlaubt ist, also keine parallelen Zugriffe.
Deswegen lege ich eine Datei namens file.lock an, über die ich dann wiederum das flock ausführe. Es wird also immer nur diese eine Datei geflockt, und wenn man mit der nichts machen darf, darf man auch sonst mit keiner Datei etwas tun.

Langer Rede, kurzer Sinn, ich habe mal ein kleines Modul geschrieben, das das komplette Verzeichnis-Flocking übernimmt:

package LockFolder;
use strict;
=head1 AUTHOR

Peter Baumann

=head1 EXAMPLE

=cut

####################
#
sub new{
my $reffile;
my $type=shift;

use Fcntl qw/:DEFAULT :flock/;

my $field={};
my $directory=shift;

if ($directory eq ''){die "Directory does not exists: $directory";}

my $reffile="$directory/file.lock";

$field->{reffile}=$reffile;
$field->{directory}=$directory;

if (!-e "$reffile"){
open (my $OUT,">",$reffile) || die "Can not create lockfile: $!";
chmod $reffile,0666;
print $OUT "0\n";
close $OUT;
}
open (my $datlock,'<',$reffile);
#my $datlock='';
$field->{datlock}=\$datlock;
bless $field,$type;
return $field;
}

#########################
# lockt Verzeichnis
##################################################
sub LockFolder{
use Fcntl qw/:DEFAULT :flock/;
my $objekt=shift;
my $reffile=$objekt->{reffile};
my $datlock=${$objekt->{datlock}};
my $lock;

open ($datlock,"<",$reffile);
{
redo if (!flock($datlock,LOCK_EX));
}

}

##############################
#unlockt Verzeichnis
#
######################################
sub UnlockFolder{
my $objekt=shift;

my $datlock=${$objekt->{datlock}};
close $datlock;
}

1;

Speichern Sie diesen Code also LockFolder.pm ab und schieben Sie die Datei in ihr cgi-bin-Verzeichnis. Mehr an Installation ist nicht notwendig...

Die Initialisierung ist per
use LockFolder;
$lock=LockFolder->new($Name_des_ordners);

Gelockt wird per
$lock->LockFolder();

Der Lock wieder freigegeben wird per
$lock->UnlockFolder();

Eine Beispielanwendung könnte so aussehen

use LockFolder;
my $lock=LockFolder->new($Name_des_ordners);
$lock->LockFolder();

open (my $out,'>',$Name_des_ordners."/datei.txt");
print $out "Testtext";
close $out;
$lock->UnlockFolder();
# ... weiter im Programm

Aber wozu das alles?
Was würde wohl passieren, wenn 2 Prozesse gleichzeitig in eine Datei schreiben? Richtig, Datensalat!
Was passiert, wenn ein Prozeß erst Daten liest, die ändert, und dann zurückschreibt, während ein zweiter Prozeß die Daten ebenfalls ändert und speichert? Eben, wieder Datensalat!
Deswegen Dateien immer sperren, bevor man sie geändert zurückschreibt.

Und wie geht das nun?
In new() wird das Verzeichnis festgelegt und gespeichert. Danach wird versucht, die Datei lock.file zu erstellen, falls sie noch nicht existiert.
Jetzt kommt der wichtigste Schritt: Die Datei lock.file wird geöffnet und das Dateihandle global gespeichert.

Unter LockFolder wird nun das Dateihandle verwendet und geflockt, und zwar so lange, bis das flock auch erfolgreich war. Das Dateihandle wird abenfalls aktualisiert.

Unter UnlockFolder wird das Dateihandle einfach geschlossen, das flock wird dadurch aufgehoben. Weitere Prozesse können nun zugreifen.

Bingo, einfach, funktioniert... und gefällt hoffentlich auch...

Übrigens
Das Locking funktioniert nur für Prozesse, die ebenfalls dieses Locking verwenden. Die Dateien sind also nicht irgendwie hardwaremäßig oder sonstwie gelockt, sondern nur softwaremäßig über dieses Script.
Andere Prozesse können also durch ein open auf eine bestimmte Datei weiterhin auf diese Dateien zugreifen...

In diesem Sinne

Nachtrag
Da ich vor Kurzem eine Funktion in den Blog eingebaut habe, in der ich Links anzeigen kann, über die Besucher zu mir kamen, bin ich über einen Link gestolpert, der "mein" Flocking von Verzeichnissen diskutiert.

Und was ich da so lesen muß, zum Beispiel "...der Schreiber ist aber vermutlich Anfänger und viele Beispiele und Skripte sind extrem verbesserungswürdig" (womit ich noch leben kann) verwundert mich doch sehr...

Da schlägt jemand vor, "Dann ist der ganze Ablauf seltsam, er legt eine flock Datei an und öffnet sie mit einem flock. Einfacher und sicherer würde es gehen, in einem gegenläufigen Prozess nur auf die Existenz der Datei zu testen und stattdessen die lock Datei am Ende löschen (z.b. in DESTROY)."

Dazu kann ich nur sagen: Auch wenn es "seltsam" ist, was ich da gescripted habe, es hatte schon so seinen Sinn...

Es wird also vorgeschlagen, die Datei lock.file nur anzulegen, und das Flocking anhand der puren Existenz der Datei zu testen. An Ende des Scriptes soll die Datei dann einfach gelöscht werden, das würde reichen.
Natürlich bin ich Kritikfähig und auch gerne lernfähig, und habe das dann auch geprüft, und folgendes Modul gescripted

package LockFolder;
use strict;
=head1 AUTHOR

DONT USE IT!!!

=cut

####################
#
sub new{
my $reffile;
my $type=shift;

use Fcntl qw/:DEFAULT :flock/;

my $field={};
my $directory=shift;

if ($directory eq ''){die "Directory does not exists: $directory";}

my $reffile="$directory/file.lock";

$field->{reffile}=$reffile;
$field->{directory}=$directory;

bless $field,$type;
return $field;
}

#########################
# lockt Verzeichnis
##################################################
sub LockFolder{
use Fcntl qw/:DEFAULT :flock/;
my $objekt=shift;
my $reffile=$objekt->{reffile};

my $lock;

{
redo if (-e $reffile);
last;
}

open (my $out,">",$reffile) || die "can not open $reffile: $!";
close $out;

}

##############################
#unlockt Verzeichnis
#
######################################
sub UnlockFolder{
my $objekt=shift;
my $reffile=$objekt->{reffile};

unlink $reffile;
}

1;

Daraufhin hab ich mir ein kleines Testscript geschrieben, nämlich folgendes:

use LockFolder;

$lock=LockFolder->new("test");

for ($i=0;$i<1000;$i++){
$lock->LockFolder;
open (in,"<test/test.txt");
$cou=<in>;
close in;

$cou++;

open (out,">test/test.txt");
print out $cou;
close out;
$lock->UnlockFolder;
}

print $cou;

Dieses Script öffnet 1000 mal eine Datei, liest einen Zählerstand aus, erhöht ihn um 1 und schreibt ihn zurück.

Am Ende sollte also 1000 in der Datei stehen.

Das Script hab ich dann gestartet, und siehe da: 1000 steht drin.

So weit, so gut... ABER:

Ich habe das Script dann 3mal parallel laufen lassen, und zwar so, daß es Daten auf meinen USB-Stick schreibt. Und siehe da: Am Ende stand dann der Wert 382 oder 380 oder 412 in der Datei... Dieses Flocking hat also NICHT funktioniert!

Übrigens: Ich wußte auch vorher schon, daß es nicht läuft, denn genau deswegen hab ich den ungewöhnlichen Weg genommen...

Im Gegensatz zu meinem Flocking-Script: Da stand brav 3000 in der Datei, bei 10 parallelen Scripten stand dort 10000!

Also bevor man Scripte ungewöhnlich findet, sollte man vielleicht erstmal darüber nachdenken, ob der Autor sich was dabei gedacht hat, bevor man erstmal generell etwas schlechtredet... besonders dann, wenn man gleichzeitig, wie in dem fremden Forum, noch nicht mal selbst eine Lösung anbietet...

In diesem Sinne...

Thema: System Perl Script

Der Beitrag "Ganze Verzeichnisse sperren für andere Anwendungen - Flock für Verzeichnisse" wurde 6258 mal gelesen.

Es wurde 2 x über diesen Beitrag abgestimmt.
Die durchschnittliche Beurteilung liegt bei
1.5 (1 = sehr gut - 6 = grottenschlecht).