zlax/ljr
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

init

Browse Source
This commit is contained in:
ivan
2019-02-06 00:49:12 +03:00
commit 8dbb1bb605
4796 changed files with 506072 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

363
wcmtools/ddlockd/api/perl/DDLockClient.pm Executable file
View File

@@ -0,0 +1,363 @@
#!/usr/bin/perl
###########################################################################
=head1 NAME
DDLockClient - Client library for distributed lock daemon
=head1 SYNOPSIS
use DDLockClient ();
my $cl = new DDLockClient (
servers => ['locks.localnet:7004', 'locks2.localnet:7002', 'localhost']
);
# Do something that requires locking
if ( my $lock = $cl->trylock("foo") ) {
...do some 'foo'-synchronized stuff...
} else {
die "Failed to lock 'foo': $!";
}
# You can either just let $lock go out of scope or explicitly release it:
$lock->release;
=head1 DESCRIPTION
This is a client library for ddlockd, a distributed lock daemon not entirely
unlike a very simplified version of the CPAN module IPC::Locker.
=head1 REQUIRES
L<Socket>
=head1 EXPORTS
Nothing.
=head1 AUTHOR
Brad Fitzpatrick <brad@danga.com>
Copyright (c) 2004 Danga Interactive, Inc.
=cut
###########################################################################
#####################################################################
### D D L O C K C L A S S
#####################################################################
package DDLock;
BEGIN {
use Socket qw{:DEFAULT :crlf};
use IO::Socket::INET ();
use constant DEFAULT_PORT => 7002;
use fields qw( name sockets pid );
}
### (CONSTRUCTOR) METHOD: new( $name, @sockets )
### Create a new lock object that corresponds to the specified I<name> and is
### held by the given I<sockets>.
sub new {
my DDLock $self = shift;
$self = fields::new( $self ) unless ref $self;
$self->{pid} = $$;
$self->{name} = shift;
$self->{sockets} = $self->getlocks( $self->{name}, @_ );
return $self;
}
### (PROTECTED) METHOD: getlocks( $lockname, @servers )
### Try to obtain locks with the specified I<lockname> from one or more of the
### given I<servers>.
sub getlocks {
my DDLock $self = shift;
my $lockname = shift;
my @servers = @_;
my (
@sockets,
$sock,
$res,
);
# First create connected sockets to all the lock hosts
@sockets = ();
SERVER: foreach my $server ( @servers ) {
my ( $host, $port ) = split /:/, $server;
$port ||= DEFAULT_PORT;
my $sock = new IO::Socket::INET (
PeerAddr => $host,
PeerPort => $port,
Proto => "tcp",
Type => SOCK_STREAM,
ReuseAddr => 1,
Blocking => 1,
) or next SERVER;
$sock->printf( "trylock lock=%s%s", eurl($lockname), CRLF );
chomp( $res = <$sock> );
die "$server: '$lockname' $res\n" unless $res =~ m{^ok\b}i;
push @sockets, $sock;
}
die "No available lock hosts" unless @sockets;
return \@sockets;
}
### METHOD: release()
### Release the lock held by the lock object. Returns the number of sockets that
### were released on success, and dies with an error on failure.
sub release {
my DDLock $self = shift;
my (
$count,
$res,
$sock,
);
# lock server might have gone away, but we don't really care.
local $SIG{'PIPE'} = "IGNORE";
$count = 0;
while (( $sock = shift @{$self->{sockets}} )) {
$sock->printf( "releaselock lock=%s%s", eurl($self->{name}), CRLF );
chomp( $res = <$sock> );
if ( $res && $res !~ m{^ok\b}i ) {
my $port = $sock->peerport;
my $addr = $sock->peerhost;
die "releaselock ($addr): $res\n";
}
$count++;
}
return $count;
}
### FUNCTION: eurl( $arg )
### URL-encode the given I<arg> and return it.
sub eurl
{
my $a = $_[0];
$a =~ s/([^a-zA-Z0-9_,.\\: -])/uc sprintf("%%%02x",ord($1))/eg;
$a =~ tr/ /+/;
return $a;
}
#####################################################################
### D D F I L E L O C K C L A S S
#####################################################################
package DDFileLock;
BEGIN {
use Fcntl qw{:DEFAULT :flock};
use File::Spec qw{};
use File::Path qw{mkpath};
use IO::File qw{};
use fields qw{name path tmpfile pid};
}
our $TmpDir = File::Spec->tmpdir;
### (CONSTRUCTOR) METHOD: new( $lockname )
### Createa a new file-based lock with the specified I<lockname>.
sub new {
my DDFileLock $self = shift;
$self = fields::new( $self ) unless ref $self;
my ( $name, $lockdir ) = @_;
$self->{pid} = $$;
$lockdir ||= $TmpDir;
if ( ! -d $lockdir ) {
# Croaks if it fails, so no need for error-checking
mkpath $lockdir;
}
my $lockfile = File::Spec->catfile( $lockdir, eurl($name) );
# First open a temp file
my $tmpfile = "$lockfile.$$.tmp";
if ( -e $tmpfile ) {
unlink $tmpfile or die "unlink: $tmpfile: $!";
}
my $fh = new IO::File $tmpfile, O_WRONLY|O_CREAT|O_EXCL
or die "open: $tmpfile: $!";
$fh->close;
undef $fh;
# Now try to make a hard link to it
link( $tmpfile, $lockfile )
or die "link: $tmpfile -> $lockfile: $!";
unlink $tmpfile or die "unlink: $tempfile: $!";
$self->{path} = $lockfile;
$self->{tmpfile} = $tmpfile;
return $self;
}
### METHOD: release()
### Release the lock held by the object.
sub release {
my DDFileLock $self = shift;
return unless $self->{path};
unlink $self->{path} or die "unlink: $self->{path}: $!";
unlink $self->{tmpfile};
}
### FUNCTION: eurl( $arg )
### URL-encode the given I<arg> and return it.
sub eurl
{
my $a = $_[0];
$a =~ s/([^a-zA-Z0-9_,.\\: -])/sprintf("%%%02X",ord($1))/eg;
$a =~ tr/ /+/;
return $a;
}
DESTROY {
my $self = shift;
$self->release if $$ == $self->{pid};
}
#####################################################################
### D D L O C K C L I E N T C L A S S
#####################################################################
package DDLockClient;
use strict;
BEGIN {
use fields qw( servers lockdir );
use vars qw{$Error};
}
$Error = undef;
our $Debug = 0;
### (CLASS) METHOD: DebugLevel( $level )
sub DebugLevel {
my $class = shift;
if ( @_ ) {
$Debug = shift;
if ( $Debug ) {
*DebugMsg = *RealDebugMsg;
} else {
*DebugMsg = sub {};
}
}
return $Debug;
}
sub DebugMsg {}
### (CLASS) METHOD: DebugMsg( $level, $format, @args )
### Output a debugging messages formed sprintf-style with I<format> and I<args>
### if I<level> is greater than or equal to the current debugging level.
sub RealDebugMsg {
my ( $class, $level, $fmt, @args ) = @_;
return unless $Debug >= $level;
chomp $fmt;
printf STDERR ">>> $fmt\n", @args;
}
### (CONSTRUCTOR) METHOD: new( %args )
### Create a new DDLockClient
sub new {
my DDLockClient $self = shift;
my %args = @_;
$self = fields::new( $self ) unless ref $self;
die "Servers argument must be an arrayref if specified"
unless !exists $args{servers} || ref $args{servers} eq 'ARRAY';
$self->{servers} = $args{servers} || [];
$self->{lockdir} = $args{lockdir} || '';
return $self;
}
### METHOD: trylock( $name )
### Try to get a lock from the lock daemons with the specified I<name>. Returns
### a DDLock object on success, and undef on failure.
sub trylock {
my DDLockClient $self = shift;
my $lockname = shift;
my $lock;
# If there are servers to connect to, use a network lock
if ( @{$self->{servers}} ) {
$self->DebugMsg( 2, "Creating a new DDLock object." );
$lock = eval { DDLock->new($lockname, @{$self->{servers}}) };
}
# Otherwise use a file lock
else {
$self->DebugMsg( 2, "No servers configured: Creating a new DDFileLock object." );
$lock = eval { DDFileLock->new($lockname, $self->{lockdir}) };
}
# If no lock was acquired, fail and put the reason in $Error.
unless ( $lock ) {
return $self->lock_fail( $@ ) if $@;
return $self->lock_fail( "Unknown failure." );
}
return $lock;
}
### (PROTECTED) METHOD: lock_fail( $msg )
### Set C<$!> to the specified message and return undef.
sub lock_fail {
my DDLockClient $self = shift;
my $msg = shift;
$Error = $msg;
return undef;
}
1;
# Local Variables:
# mode: perl
# c-basic-indent: 4
# indent-tabs-mode: nil
# End:

5
wcmtools/ddlockd/api/perl/MANIFEST Executable file
View File

@@ -0,0 +1,5 @@
DDLockClient.pm
Makefile.PL
MANIFEST
t/00_require.t
testlock.pl

11
wcmtools/ddlockd/api/perl/MANIFEST.SKIP Executable file
View File

@@ -0,0 +1,11 @@
^#
\bCVS\b
^MANIFEST\.
^Makefile$
~$
\.html$
\.old$
^blib/
_blib$
^MakeMaker-\d
^\.exists

33
wcmtools/ddlockd/api/perl/Makefile.PL Executable file
View File

@@ -0,0 +1,33 @@
#!/usr/bin/perl
#
# Perl Makefile for DDLockClient/DDLock
# $Id: Makefile.PL,v 1.2 2004/05/27 22:08:51 deveiant Exp $
#
# Invoke with 'perl Makefile.PL'
#
# See ExtUtils::MakeMaker (3) for more information on how to influence
# the contents of the Makefile that is written
#
use ExtUtils::MakeMaker;
my $version = do { my @r = (q$Revision: 1.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
my %config = (
NAME => 'DDLockClient',
VERSION => "0." . $version,
AUTHOR => 'Brad Fitzpatrick <brad@danga.com>',
ABSTRACT => 'A lock client for the distributed lock daemon ddlockd',
PREREQ_PM => {
Socket => 0,
},
dist => {
CI => "cvs commit",
RCS_LABEL => 'cvs tag r$(VERSION_SYM)',
SUFFIX => ".bz2",
DIST_DEFAULT => 'all tardist',
COMPRESS => "bzip2",
},
);
WriteMakefile( %config );

57
wcmtools/ddlockd/api/perl/stresslock.pl Executable file
View File

@@ -0,0 +1,57 @@
#!/usr/bin/perl -w
use Fcntl;
use lib "blib/lib";
use DDLockClient ();
use Data::Dumper ();
$Data::Dumper::Terse = 1;
$Data::Dumper::Indent = 1;
$| = 1;
my $DDServers = [
# 'localhost:7003',
# 'localhost:7004',
'localhost:7002',
];
foreach my $servers ( $DDServers, [] ) {
print "Creating client (@$servers)...";
my $cl = new DDLockClient ( servers => $servers )
or die $DDLockClient::Error;
print "done:\n";
for ( my $i = 0; $i < 10; $i++ ) {
if ( my $pid = fork ) {
print "Created child: $pid\n";
} else {
for ( my $ct = 0; $ct < 150; $ct++ ) {
my $rand = int(rand(10));
#print "Trying to create lock 'lock$rand' lock in process $$...\n";
if ( my $lock = $cl->trylock("lock$rand") ) {
my $file = ".stressfile-$rand";
my $fh = new IO::File $file, O_WRONLY|O_EXCL|O_CREAT;
die "Couldn't create file $file: $!" unless $fh;
$fh->close;
unlink $file;
}
}
exit 0;
}
}
while ((my $pid = wait) != -1) {
if ($? == 0) {
print "$pid is done, okay.\n";
} else {
die "$pid FAILED\n";
}
}
print "done.\n\n";
}

12
wcmtools/ddlockd/api/perl/t/00_require.t Executable file
View File

@@ -0,0 +1,12 @@
#!/usr/bin/perl -w
use strict;
use Test;
BEGIN { plan tests => 3 }
ok( eval { require DDLockClient; 1 } );
ok( exists $::{"DDLockClient::"} );
ok( exists $::{"DDLock::"} );

46
wcmtools/ddlockd/api/perl/testlock.pl Executable file
View File

@@ -0,0 +1,46 @@
#!/usr/bin/perl -w
use lib "blib/lib";
use DDLockClient ();
use Data::Dumper ();
$Data::Dumper::Terse = 1;
$Data::Dumper::Indent = 1;
$| = 1;
my $DDServers = [
'localhost:7003',
'localhost:7004',
'localhost',
];
foreach my $servers ( $DDServers, [] ) {
print "Creating client...";
my $cl = new DDLockClient ( servers => $servers )
or die $DDLockClient::Error;
print "done:\n";
print "Creating a 'foo' lock...";
my $lock = $cl->trylock( "foo" )
or print "Error: $DDLockClient::Error\n";
print "done.\n";
if ( my $pid = fork ) {
waitpid( $pid, 0 );
} else {
print "Trying to create a 'foo' lock in process $$...";
my $lock2 = $cl->trylock( "foo" )
or print "Error: $DDLockClient::Error\n";
print "done:\n";
exit;
}
print "Releasing the 'foo' lock...";
$lock->release or die;
print "done.\n\n";
}