[interchange-cvs] interchange - heins modified 3 files
interchange-cvs at icdevgroup.org
interchange-cvs at icdevgroup.org
Sun Jun 6 23:44:20 EDT 2004
User: heins
Date: 2004-06-07 03:44:20 GMT
Modified: lib/Vend CounterFile.pm Session.pm SessionDB.pm
Log:
* Completely change SessionDB.pm, using direct calls to DBI to reduce
typical queries per transaction from 9 to 4.
Cache the lock value on first request, to preserve existing API.
Typical sequence:
1. Check for lock by doing an INSERT. This will typically succeed,
making for the first query. If it fails, then a SELECT must be
done; but that should be infrequent.
2. Next query is the session read. On the first session, this will
require an insert, but typically just a SELECT. Second query.
3. Next query is the session UPDATE.
4. Final query is the lock delete.
The previous protocol required up to 5 selects and 4 updates.
This has the side-effect of eliminating the never-used capability
for GDBM/DB_File database-based sessions.
* Fix bad bug whereby session robot-IP-issuance counter was never set
higher than one -- file would always be deleted because the -M compare
could never succeed. Also could cause "file not found" errors for
ab(1) runs, as preforked servers would willy-nilly remove the file
without checking lock.
* Close slight deadlock possiblity in counters.
Revision Changes Path
1.5 +37 -17 interchange/lib/Vend/CounterFile.pm
rev 1.5, prev_rev 1.4
Index: CounterFile.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/CounterFile.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- CounterFile.pm 19 Sep 2003 03:27:59 -0000 1.4
+++ CounterFile.pm 7 Jun 2004 03:44:19 -0000 1.5
@@ -1,6 +1,6 @@
# This -*-perl -*- module implements a persistent counter class.
#
-# $Id: CounterFile.pm,v 1.4 2003/09/19 03:27:59 mheins Exp $
+# $Id: CounterFile.pm,v 1.5 2004/06/07 03:44:19 mheins Exp $
#
package Vend::CounterFile;
@@ -98,7 +98,7 @@
};
sub Version { $VERSION; }
-$VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/);
# first line in counter file, regex to match good value
$MAGIC = "#COUNTER-1.0\n"; # first line in standard counter files
@@ -135,13 +135,8 @@
my $magic_value;
local($/, $\) = ("\n", undef);
- my $value;
- if (-e $file) {
- croak "Specified file is a directory" if -d _;
- open(F, $file) or croak "Can't open $file: $!";
- my $first_line = <F>;
- $value = <F>;
- close(F);
+ my ($fh, $first_line, $value) = get_initial_fh($file);
+ if (! $fh) {
if($first_line eq $MAGIC) {
# do nothing
}
@@ -158,30 +153,29 @@
}
chomp($value);
} else {
- open(F, ">$file") or croak "Can't create $file: $!";
if($date) {
my $ivalue;
if($date eq 'gmt') {
$magic_value = $MAGIC_GMT . "-$initial\n";
- print F $magic_value;
+ print $fh $magic_value;
$ivalue = strftime('%Y%m%d', gmtime()) . $initial;
- print F "$ivalue\n";
+ print $fh "$ivalue\n";
$gmt = 1;
}
else {
$magic_value = $MAGIC_DATE . "-$initial\n";
- print F $magic_value;
+ print $fh $magic_value;
$ivalue = strftime('%Y%m%d', localtime()) . $initial;
- print F "$ivalue\n";
+ print $fh "$ivalue\n";
}
$value = $ivalue;
}
else {
- print F $MAGIC;
- print F "$initial\n";
+ print $fh $MAGIC;
+ print $fh "$initial\n";
$value = $initial;
}
- close(F);
+ close($fh);
}
my $s = { file => $file, # the filename for the counter
@@ -197,6 +191,32 @@
};
#::logDebug("counter object created: " . ::uneval($s));
return bless $s;
+}
+
+sub get_initial_fh {
+ my $file = shift;
+
+ my $created;
+ my $fh = gensym();
+
+ ( open $fh, "+<$file" or
+ (++$created and open $fh, ">>$file" and open $fh, "+<$file" )
+ ) or croak "Can't open $file: $!";
+
+ Vend::Util::lockfile($fh, 1, 1)
+ or croak "Can't lock $file: $!";
+
+ seek $fh, 0, 0;
+
+ local($/) = "\n";
+ my $magic = <$fh>;
+ my $value = <$fh>;
+
+ unless($created) {
+ close $fh;
+ undef $fh;
+ }
+ return ($fh, $magic, $value);
}
sub inc_value {
2.17 +18 -7 interchange/lib/Vend/Session.pm
rev 2.17, prev_rev 2.16
Index: Session.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Session.pm,v
retrieving revision 2.16
retrieving revision 2.17
diff -u -r2.16 -r2.17
--- Session.pm 24 Feb 2004 20:53:58 -0000 2.16
+++ Session.pm 7 Jun 2004 03:44:19 -0000 2.17
@@ -1,6 +1,6 @@
# Vend::Session - Interchange session routines
#
-# $Id: Session.pm,v 2.16 2004/02/24 20:53:58 mheins Exp $
+# $Id: Session.pm,v 2.17 2004/06/07 03:44:19 mheins Exp $
#
# Copyright (C) 2002-2003 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -27,7 +27,7 @@
require Exporter;
use vars qw($VERSION);
-$VERSION = substr(q$Revision: 2.16 $, 10);
+$VERSION = substr(q$Revision: 2.17 $, 10);
@ISA = qw(Exporter);
@@ -202,8 +202,12 @@
mkdir $dir, 0777 unless -d $dir;
my $fn = Vend::Util::get_filename($ip, 2, 1, $dir);
if(-f $fn) {
- my $grace = time() - ($Global::Variable->{MV_ROBOT_EXPIRE} || 86400);
- unlink $fn if -M $fn < $grace;
+ my $grace = $Vend::Cfg->{Limit}{robot_expire} || 1;
+ my $mtime = -M _;
+ if($mtime > $grace) {
+ ::logDebug("ip $ip allowed back in due to '$mtime' < '$grace'");
+ unlink $fn;
+ }
}
return Vend::CounterFile->new($fn)->inc() if $inc;
return Vend::CounterFile->new($fn)->value();
@@ -247,7 +251,9 @@
}
$name = session_name();
unless ($File_sessions) {
+ lock_session($name);
last unless defined $Vend::SessionDBM{$name};
+ unlock_session($name);
}
else {
last unless exists $Vend::SessionDBM{$name};
@@ -319,20 +325,25 @@
sub unlock_session {
#::logDebug ("unlock session id=$Vend::SessionID name=$Vend::SessionName\n");
+ my $name = shift;
+ $name ||= $Vend::SessionName;
delete $Vend::SessionDBM{'LOCK_' . $Vend::SessionName}
unless $File_sessions;
}
sub lock_session {
return 1 if $File_sessions;
+ my $name = shift;
+ $name ||= $Vend::SessionName;
#::logDebug ("lock session id=$Vend::SessionID name=$Vend::SessionName\n");
- my $lockname = 'LOCK_' . $Vend::SessionName;
+ my $lockname = "LOCK_$name";
my ($tried, $locktime, $sleepleft, $pid, $now, $left);
$tried = 0;
LOCKLOOP: {
- if (defined $Vend::SessionDBM{$lockname}) {
- ($locktime, $pid) = split /:/, $Vend::SessionDBM{$lockname}, 2;
+ my $lv;
+ if (defined ($lv = $Vend::SessionDBM{$lockname}) ) {
+ ($locktime, $pid) = split /:/, $lv, 2;
}
$now = time;
if(defined $locktime and $locktime) {
2.4 +101 -36 interchange/lib/Vend/SessionDB.pm
rev 2.4, prev_rev 2.3
Index: SessionDB.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/SessionDB.pm,v
retrieving revision 2.3
retrieving revision 2.4
diff -u -r2.3 -r2.4
--- SessionDB.pm 13 Nov 2003 16:07:26 -0000 2.3
+++ SessionDB.pm 7 Jun 2004 03:44:19 -0000 2.4
@@ -1,6 +1,6 @@
# Vend::SessionDB - Stores Interchange session information in files
#
-# $Id: SessionDB.pm,v 2.3 2003/11/13 16:07:26 mheins Exp $
+# $Id: SessionDB.pm,v 2.4 2004/06/07 03:44:19 mheins Exp $
#
# Copyright (C) 2002-2003 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -28,29 +28,89 @@
use Vend::Util;
use vars qw($VERSION);
-$VERSION = substr(q$Revision: 2.3 $, 10);
+$VERSION = substr(q$Revision: 2.4 $, 10);
sub TIEHASH {
- my($self, $db) = @_;
- $db = Vend::Data::database_exists_ref($db);
- $db = $db->ref();
-#::logDebug("$self: tied");
- die "Vend::SessionDB: bad database\n"
- unless $db;
-
- bless { DB => $db }, $self;
+ my($class, $db) = @_;
+ $db = Vend::Data::database_exists_ref($db)
+ or die "Vend::SessionDB: bad database $db\n";
+ my $self = {
+ DB => $db,
+ DBH => $db->dbh(),
+ TABLE => $db->name(),
+ LOCK_VALUE => {},
+ };
+
+ bless $self, $class;
+}
+
+sub UNTIE {
+ my $self = shift;
+ %$self = ();
}
sub FETCH {
my($self, $key) = @_;
-#::logDebug("$self fetch: $key");
- return undef unless $self->{DB}->record_exists($key);
-#::logDebug("$self exists: $key");
- return $self->{DB}->field($key, 'sessionlock') if $key =~ s/^LOCK_//;
-#::logDebug("$self complex fetch: $key");
- my $data = $self->{DB}->field($key, 'session');
- return undef unless $data;
- return $data;
+#::logDebug("$self fetch: $key (pid=$$)");
+ my $rc;
+
+ if($key =~ /^LOCK_/) {
+
+ return $self->{LOCK_VALUE}{$key}
+ if $self->{LOCK_VALUE}{$key};
+
+ my $val = time() . ":$$";
+
+ $self->{DOLOCK} ||=
+ $self->{DBH}->prepare(
+ "insert (code,sessionlock) into $self->{TABLE} values(?,?)",
+ );
+
+ eval {
+ $rc = $self->{DOLOCK}->execute($key, $val);
+ };
+ if($@ or $rc < 1) {
+ ## Session exists
+ my $sth =
+ $self->{FETCHLOCK} ||=
+ $self->{DBH}->prepare(
+ "select code,sessionlock from $self->{TABLE} where code = ?",
+ );
+ $sth->execute($key)
+ or do {
+ logError("DBI query error when fetching session lock $key");
+ return undef;
+ };
+ my $ary = $sth->fetchrow_arrayref
+ or return undef;
+ return $ary->[0];
+ }
+ else {
+ ## No session there already
+ $self->{LOCK_VALUE}{$key} = $val;
+ return undef;
+ }
+ }
+ else {
+ return $self->{SESSION_VALUE}{$key}
+ if $self->{SESSION_VALUE}{$key};
+ my $sth = $self->{FETCH} ||= $self->{DBH}->prepare(
+ "select session from $self->{TABLE} where code = ?"
+ );
+ eval {
+ $rc = $sth->execute($key);
+ };
+
+ if($@) {
+ ## Session fetch error
+ logError("DBI error fetching session $key");
+ return undef;
+ }
+
+ my $ary = $sth->fetchrow_arrayref
+ or return undef;
+ return $self->{SESSION_VALUE}{$key} = $ary->[0];
+ }
}
sub FIRSTKEY {
@@ -60,21 +120,25 @@
$self->{DB}->config('DELIMITER');
};
push @{$self->{DB}}, $tmp if $@;
- return $self->{DB}->each_record();
+ my @pair = $self->{DB}->each_record();
+ while($pair[0] =~ /^LOCK_/) {
+ @pair = $self->{DB}->each_record();
+ }
+ return @pair;
}
sub NEXTKEY {
- return $_[0]->{DB}->each_record();
+ my $self = shift;
+ my @pair = $self->{DB}->each_record();
+ while($pair[0] =~ /^LOCK_/) {
+ @pair = $self->{DB}->each_record();
+ }
+ return @pair;
}
sub EXISTS {
my($self,$key) = @_;
#::logDebug("$self EXISTS check: $key");
- if ($key =~ s/^LOCK_//) {
- return undef unless $self->{DB}->record_exists($key);
- return undef unless $self->{DB}->field($key, 'sessionlock');
- return 1;
- }
return undef unless $self->{DB}->record_exists($key);
1;
}
@@ -82,21 +146,22 @@
sub DELETE {
my($self,$key) = @_;
#::logDebug("$self delete: $key");
- if($key =~ s/^LOCK_// ) {
- return undef unless $self->{DB}->record_exists($key);
- $self->{DB}->set_field($key,'sessionlock','');
- return 1;
- }
- $self->{DB}->delete_record($key);
+ $self->{DELHANDLE} ||= $self->{DBH}->prepare(
+ "delete from $self->{TABLE} where code = ?",
+ );
+ $self->{DELHANDLE}->execute($key);
}
sub STORE {
my($self, $key, $val) = @_;
- my $locking = $key =~ s/^LOCK_//;
- $self->{DB}->set_row($key) unless $self->{DB}->record_exists($key);
- return $self->{DB}->set_field($key, 'sessionlock', $val) if $locking;
- $self->{DB}->set_field( $key, 'session', $val);
- return 1;
+ if( $key =~ s/^LOCK_//) {
+ return $self->{LOCK_VALUE}{$key};
+ }
+ else {
+ $self->{DB}->set_field( $key, 'session', $val);
+ undef $self->{SESSION_VALUE}{$key};
+ return 1;
+ }
}
1;
More information about the interchange-cvs
mailing list