[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