version 1.325, 2006/05/11 17:53:22
|
version 1.329, 2006/05/18 17:55:49
|
Line 37 use LONCAPA::Configuration;
|
Line 37 use LONCAPA::Configuration;
|
use IO::Socket; |
use IO::Socket; |
use IO::File; |
use IO::File; |
#use Apache::File; |
#use Apache::File; |
use Symbol; |
|
use POSIX; |
use POSIX; |
use Crypt::IDEA; |
use Crypt::IDEA; |
use LWP::UserAgent(); |
use LWP::UserAgent(); |
Line 54 use LONCAPA::ConfigFileEdit;
|
Line 53 use LONCAPA::ConfigFileEdit;
|
use LONCAPA::lonlocal; |
use LONCAPA::lonlocal; |
use LONCAPA::lonssl; |
use LONCAPA::lonssl; |
use Fcntl qw(:flock); |
use Fcntl qw(:flock); |
use Symbol; |
|
|
|
my $DEBUG = 0; # Non zero to enable debug log entries. |
my $DEBUG = 0; # Non zero to enable debug log entries. |
|
|
Line 1050 sub _do_hash_untie {
|
Line 1048 sub _do_hash_untie {
|
|
|
sub _locking_hash_tie { |
sub _locking_hash_tie { |
my ($file_prefix,$namespace,$how,$loghead,$what) = @_; |
my ($file_prefix,$namespace,$how,$loghead,$what) = @_; |
|
my $lock_type=LOCK_SH; |
|
# Are we reading or writing? |
|
if ($how eq &GDBM_READER()) { |
|
# We are reading |
|
if (!open($sym,"$file_prefix.db.lock")) { |
|
# We don't have a lock file. This could mean |
|
# - that there is no such db-file |
|
# - that it does not have a lock file yet |
|
if ((! -e "$file_prefix.db") && (! -e "$file_prefix.db.gz")) { |
|
# No such file. Forget it. |
|
$! = 2; |
|
return undef; |
|
} |
|
# Apparently just no lock file yet. Make one |
|
open($sym,">>$file_prefix.db.lock"); |
|
} |
|
# Do a shared lock |
|
if (!&flock_sym(LOCK_SH)) { return undef; } |
|
# If this is compressed, we will actually need an exclusive lock |
|
if (-e "$file_prefix.db.gz") { |
|
if (!&flock_sym(LOCK_EX)) { return undef; } |
|
} |
|
} elsif ($how eq &GDBM_WRCREAT()) { |
|
# We are writing |
|
open($sym,">>$file_prefix.db.lock"); |
|
# Writing needs exclusive lock |
|
if (!&flock_sym(LOCK_EX)) { return undef; } |
|
} else { |
|
&logthis("Unknown method $how for $file_prefix"); |
|
die(); |
|
} |
|
# The file is ours! |
|
# If it is archived, un-archive it now |
|
if (-e "$file_prefix.db.gz") { |
|
system("gunzip $file_prefix.db.gz"); |
|
if (-e "$file_prefix.hist.gz") { |
|
system("gunzip $file_prefix.hist.gz"); |
|
} |
|
} |
|
# Change access mode to non-blocking |
|
$how=$how|&GDBM_NOLOCK(); |
|
# Go ahead and tie the hash |
|
return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what); |
|
} |
|
|
my ($lock); |
sub flock_sym { |
|
my ($lock_type)=@_; |
if ($how eq &GDBM_READER()) { |
|
$lock=LOCK_SH; |
|
$how=$how|&GDBM_NOLOCK(); |
|
#if the db doesn't exist we can't read from it |
|
if (! -e "$file_prefix.db") { |
|
$! = 2; |
|
return undef; |
|
} |
|
} elsif ($how eq &GDBM_WRCREAT()) { |
|
$lock=LOCK_EX; |
|
$how=$how|&GDBM_NOLOCK(); |
|
if (! -e "$file_prefix.db") { |
|
# doesn't exist but we need it to in order to successfully |
|
# lock it so bring it into existance |
|
open(TOUCH,">>$file_prefix.db"); |
|
close(TOUCH); |
|
} |
|
} else { |
|
&logthis("Unknown method $how for $file_prefix"); |
|
die(); |
|
} |
|
|
|
$sym=&Symbol::gensym(); |
|
open($sym,"$file_prefix.db"); |
|
my $failed=0; |
my $failed=0; |
eval { |
eval { |
local $SIG{__DIE__}='DEFAULT'; |
local $SIG{__DIE__}='DEFAULT'; |
local $SIG{ALRM}=sub { |
local $SIG{ALRM}=sub { |
$failed=1; |
$failed=1; |
die("failed lock"); |
die("failed lock"); |
}; |
}; |
alarm($lond_max_wait_time); |
alarm($lond_max_wait_time); |
flock($sym,$lock); |
flock($sym,$lock_type); |
alarm(0); |
alarm(0); |
}; |
}; |
if ($failed) { |
if ($failed) { |
$! = 100; # throwing error # 100 |
$! = 100; # throwing error # 100 |
return undef; |
return undef; |
|
} else { |
|
return 1; |
} |
} |
return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what); |
|
} |
} |
|
|
sub _locking_hash_untie { |
sub _locking_hash_untie { |
Line 6633 to the client, and the connection is clo
|
Line 6652 to the client, and the connection is clo
|
IO::Socket |
IO::Socket |
IO::File |
IO::File |
Apache::File |
Apache::File |
Symbol |
|
POSIX |
POSIX |
Crypt::IDEA |
Crypt::IDEA |
LWP::UserAgent() |
LWP::UserAgent() |