[interchange-cvs] interchange - heins modified 11 files
interchange-cvs at icdevgroup.org
interchange-cvs at icdevgroup.org
Wed Apr 5 10:42:20 EDT 2006
User: heins
Date: 2006-04-05 14:42:20 GMT
Modified: lib/Vend Cart.pm Data.pm Dispatch.pm Error.pm File.pm
Modified: Interpolate.pm Session.pm Ship.pm
Modified: lib/Vend/Table DB_File.pm GDBM.pm SDBM.pm
Log:
* Add lockout to list of SpecialSub routines allowed.
* If user-configured lockout routine returns true, it replaces the
current routine completely. If it returns false, the normal one
is run as well.
* Move the logging out of Vend::Dispatch to the do_lockout routine, so
that you can avoid the log entry if your user-configured routine handles
the lockout.
* Make the number of seconds for robot reset adjustable from its
current hardcoded 30:
Limit lockout_reset_seconds
Maybe that should be robot_reset_seconds, I don't know.
* Change use of $Vend::Cfg->{Limit}{member} to $::Limit->{member}. As
Limit is used in iterative routines like chain_cost, this should
improve performance.
Revision Changes Path
2.14 +5 -5 interchange/lib/Vend/Cart.pm
rev 2.14, prev_rev 2.13
Index: Cart.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Cart.pm,v
retrieving revision 2.13
retrieving revision 2.14
diff -u -r2.13 -r2.14
--- Cart.pm 8 Nov 2005 18:14:44 -0000 2.13
+++ Cart.pm 5 Apr 2006 14:42:19 -0000 2.14
@@ -1,6 +1,6 @@
# Vend::Cart - Interchange shopping cart management routines
#
-# $Id: Cart.pm,v 2.13 2005/11/08 18:14:44 jon Exp $
+# $Id: Cart.pm,v 2.14 2006/04/05 14:42:19 mheins Exp $
#
# Copyright (C) 2002-2005 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -25,7 +25,7 @@
package Vend::Cart;
-$VERSION = substr(q$Revision: 2.13 $, 10);
+$VERSION = substr(q$Revision: 2.14 $, 10);
use strict;
@@ -265,11 +265,11 @@
}
}
- next unless $Vend::Cfg->{Limit}{cart_quantity_per_line}
- and $item->{quantity} > $Vend::Cfg->{Limit}{cart_quantity_per_line};
+ next unless $::Limit->{cart_quantity_per_line}
+ and $item->{quantity} > $::Limit->{cart_quantity_per_line};
$old_item = { %$item } if $quantity_raise_event;
- $item->{quantity} = $Vend::Cfg->{Limit}{cart_quantity_per_line};
+ $item->{quantity} = $::Limit->{cart_quantity_per_line};
trigger_update( $s, $item, $old_item, $event_cartname )
if $quantity_raise_event;
}
2.56 +3 -3 interchange/lib/Vend/Data.pm
rev 2.56, prev_rev 2.55
Index: Data.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Data.pm,v
retrieving revision 2.55
retrieving revision 2.56
diff -u -r2.55 -r2.56
--- Data.pm 30 Jan 2006 17:33:55 -0000 2.55
+++ Data.pm 5 Apr 2006 14:42:19 -0000 2.56
@@ -1,6 +1,6 @@
# Vend::Data - Interchange databases
#
-# $Id: Data.pm,v 2.55 2006/01/30 17:33:55 jon Exp $
+# $Id: Data.pm,v 2.56 2006/04/05 14:42:19 mheins Exp $
#
# Copyright (C) 2002-2006 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -1404,7 +1404,7 @@
else {
@p = Text::ParseWords::shellwords($raw);
}
- if(scalar @p > ($Vend::Cfg->{Limit}{chained_cost_levels} || 64)) {
+ if(scalar @p > ($::Limit->{chained_cost_levels} || 64)) {
logError('Too many chained cost levels for item ' . uneval($item) );
return undef;
}
@@ -1416,7 +1416,7 @@
CHAIN:
foreach $price (@p) {
next if ! length($price);
- if($its++ > ($Vend::Cfg->{Limit}{chained_cost_levels} || 64)) {
+ if($its++ > ($::Limit->{chained_cost_levels} || 64)) {
logError('Too many chained cost levels for item ' . uneval($item) );
last CHAIN;
}
1.67 +6 -9 interchange/lib/Vend/Dispatch.pm
rev 1.67, prev_rev 1.66
Index: Dispatch.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Dispatch.pm,v
retrieving revision 1.66
retrieving revision 1.67
diff -u -r1.66 -r1.67
--- Dispatch.pm 3 Apr 2006 19:19:21 -0000 1.66
+++ Dispatch.pm 5 Apr 2006 14:42:19 -0000 1.67
@@ -1,6 +1,6 @@
# Vend::Dispatch - Handle Interchange page requests
#
-# $Id: Dispatch.pm,v 1.66 2006/04/03 19:19:21 jon Exp $
+# $Id: Dispatch.pm,v 1.67 2006/04/05 14:42:19 mheins Exp $
#
# Copyright (C) 2002-2006 Interchange Development Group
# Copyright (C) 2002 Mike Heins <mike at perusion.net>
@@ -26,7 +26,7 @@
package Vend::Dispatch;
use vars qw($VERSION);
-$VERSION = substr(q$Revision: 1.66 $, 10);
+$VERSION = substr(q$Revision: 1.67 $, 10);
use POSIX qw(strftime);
use Vend::Util;
@@ -1122,6 +1122,8 @@
$Vend::Xquote = '';
}
+ $::Limit = $Vend::Cfg->{Limit} || {};
+
chdir $Vend::Cfg->{VendRoot}
or die "Couldn't change to $Vend::Cfg->{VendRoot}: $!\n";
POSIX::setlocale(POSIX::LC_ALL, $Vend::Cfg->{ExecutionLocale});
@@ -1333,7 +1335,7 @@
last RESOLVEID;
}
elsif($Vend::Cfg->{RobotLimit}) {
- if ($now - $Vend::Session->{'time'} > 30) {
+ if ($now - $Vend::Session->{'time'} > ($::Limit->{lockout_reset_seconds} || 30) ) {
$Vend::Session->{accesses} = 0;
}
else {
@@ -1343,11 +1345,6 @@
and ! $Vend::admin
)
{
- my $msg = errmsg(
- "WARNING: POSSIBLE BAD ROBOT. %s accesses with no 30 second pause.",
- $Vend::Session->{accesses},
- );
- ::logError($msg);
do_lockout();
}
}
@@ -1358,7 +1355,7 @@
if (Vend::Session::count_ip() > $Vend::Cfg->{RobotLimit}) {
my $msg;
# Here they can get it back if they pass expiration time
- my $wait = $Vend::Cfg->{Limit}{robot_expire} || 1;
+ my $wait = $::Limit->{robot_expire} || 1;
$wait *= 24;
$msg = errmsg(<<EOF, $wait);
Too many new ID assignments for this IP address. Please wait at least %d hours
2.11 +31 -2 interchange/lib/Vend/Error.pm
rev 2.11, prev_rev 2.10
Index: Error.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Error.pm,v
retrieving revision 2.10
retrieving revision 2.11
diff -u -r2.10 -r2.11
--- Error.pm 8 Nov 2005 18:14:45 -0000 2.10
+++ Error.pm 5 Apr 2006 14:42:19 -0000 2.11
@@ -1,6 +1,6 @@
# Vend::Error - Handle Interchange error pages and messages
#
-# $Id: Error.pm,v 2.10 2005/11/08 18:14:45 jon Exp $
+# $Id: Error.pm,v 2.11 2006/04/05 14:42:19 mheins Exp $
#
# Copyright (C) 2002-2005 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -38,7 +38,7 @@
use vars qw/$VERSION/;
-$VERSION = substr(q$Revision: 2.10 $, 10);
+$VERSION = substr(q$Revision: 2.11 $, 10);
sub get_locale_message {
my ($code, $message, @arg) = @_;
@@ -156,6 +156,35 @@
sub do_lockout {
my ($cmd);
my $msg = '';
+
+ # If the lockout SpecialSub exists, it is run. If it returns
+ # true, we return now. If it returns false, we run the lockout
+ # as normal.
+ if (my $subname = $Vend::Cfg->{SpecialSub}{lockout}) {
+ ::logDebug(errmsg("running subroutine '%s' for lockout", $subname));
+ my $sub = $Vend::Cfg->{Sub}{$subname} || $Global::GlobalSub->{$subname};
+ my $status;
+ eval {
+ $status = $sub->();
+ };
+
+ if($@) {
+ ::logError("Error running lockout subroutine %s: %s", $subname, $@);
+ }
+
+ return if $status;
+ }
+
+ # Now we log the error after custom lockout routine gets chance
+ # to bypass
+ my $pause = $::Limit->{lockout_reset_seconds} || 30;
+ my $msg = errmsg(
+ "WARNING: POSSIBLE BAD ROBOT. %s accesses with no %d second pause.",
+ $Vend::Session->{accesses},
+ $pause,
+ );
+ ::logError($msg);
+
if($cmd = $Global::LockoutCommand) {
my $host = $CGI::remote_addr;
$cmd =~ s/%s/$host/ or $cmd .= " $host";
2.22 +3 -3 interchange/lib/Vend/File.pm
rev 2.22, prev_rev 2.21
Index: File.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/File.pm,v
retrieving revision 2.21
retrieving revision 2.22
diff -u -r2.21 -r2.22
--- File.pm 8 Nov 2005 18:14:45 -0000 2.21
+++ File.pm 5 Apr 2006 14:42:19 -0000 2.22
@@ -1,6 +1,6 @@
# Vend::File - Interchange file functions
#
-# $Id: File.pm,v 2.21 2005/11/08 18:14:45 jon Exp $
+# $Id: File.pm,v 2.22 2006/04/05 14:42:19 mheins Exp $
#
# Copyright (C) 2002-2005 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -55,7 +55,7 @@
use File::Copy;
use subs qw(logError logGlobal);
use vars qw($VERSION @EXPORT @EXPORT_OK $errstr);
-$VERSION = substr(q$Revision: 2.21 $, 10);
+$VERSION = substr(q$Revision: 2.22 $, 10);
sub writefile {
my($file, $data, $opt) = @_;
@@ -233,7 +233,7 @@
my $flag = $excl ? $flock_LOCK_EX : $flock_LOCK_SH;
if ($wait) {
- my $trylimit = $Vend::Cfg->{Limit}{file_lock_retries} || 5;
+ my $trylimit = $::Limit->{file_lock_retries} || 5;
my $failedcount = 0;
while (
! flock($fh, $flag)
2.270 +5 -5 interchange/lib/Vend/Interpolate.pm
rev 2.270, prev_rev 2.269
Index: Interpolate.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Interpolate.pm,v
retrieving revision 2.269
retrieving revision 2.270
diff -u -r2.269 -r2.270
--- Interpolate.pm 3 Apr 2006 23:30:59 -0000 2.269
+++ Interpolate.pm 5 Apr 2006 14:42:19 -0000 2.270
@@ -1,6 +1,6 @@
# Vend::Interpolate - Interpret Interchange tags
#
-# $Id: Interpolate.pm,v 2.269 2006/04/03 23:30:59 docelic Exp $
+# $Id: Interpolate.pm,v 2.270 2006/04/05 14:42:19 mheins Exp $
#
# Copyright (C) 2002-2006 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -28,7 +28,7 @@
require Exporter;
@ISA = qw(Exporter);
-$VERSION = substr(q$Revision: 2.269 $, 10);
+$VERSION = substr(q$Revision: 2.270 $, 10);
@EXPORT = qw (
@@ -1446,7 +1446,7 @@
sub produce_range {
my ($ary, $max) = @_;
- $max = $Vend::Cfg->{Limit}{option_list} if ! $max;
+ $max = $::Limit->{option_list} if ! $max;
my @do;
for (my $i = 0; $i < scalar(@$ary); $i++) {
$ary->[$i] =~ /^\s* ([a-zA-Z0-9]+) \s* \.\.+ \s* ([a-zA-Z0-9]+) \s* $/x
@@ -4020,12 +4020,12 @@
undef $Row;
my $lim;
- if($lim = $Vend::Cfg->{Limit}{list_text_size} and length($text) > $lim) {
+ if($lim = $::Limit->{list_text_size} and length($text) > $lim) {
my $len = length($text);
my $caller = join "|", caller();
my $msg = "Large list text encountered, length=$len, caller=$caller";
logError($msg);
- return undef if $Vend::Cfg->{Limit}{list_text_overflow} eq 'abort';
+ return undef if $::Limit->{list_text_overflow} eq 'abort';
}
# Optimize for no-match, on-match, etc
2.24 +3 -3 interchange/lib/Vend/Session.pm
rev 2.24, prev_rev 2.23
Index: Session.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Session.pm,v
retrieving revision 2.23
retrieving revision 2.24
diff -u -r2.23 -r2.24
--- Session.pm 18 Apr 2005 18:57:32 -0000 2.23
+++ Session.pm 5 Apr 2006 14:42:19 -0000 2.24
@@ -1,6 +1,6 @@
# Vend::Session - Interchange session routines
#
-# $Id: Session.pm,v 2.23 2005/04/18 18:57:32 mheins Exp $
+# $Id: Session.pm,v 2.24 2006/04/05 14:42: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.23 $, 10);
+$VERSION = substr(q$Revision: 2.24 $, 10);
@ISA = qw(Exporter);
@@ -202,7 +202,7 @@
mkdir $dir, 0777 unless -d $dir;
my $fn = Vend::Util::get_filename($ip, 2, 1, $dir);
if(-f $fn) {
- my $grace = $Vend::Cfg->{Limit}{robot_expire} || 1;
+ my $grace = $::Limit->{robot_expire} || 1;
my @st = stat(_);
my $mtime = (time() - $st[9]) / 86400;
if($mtime > $grace) {
2.18 +2 -2 interchange/lib/Vend/Ship.pm
rev 2.18, prev_rev 2.17
Index: Ship.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Ship.pm,v
retrieving revision 2.17
retrieving revision 2.18
diff -u -r2.17 -r2.18
--- Ship.pm 3 Feb 2006 16:42:48 -0000 2.17
+++ Ship.pm 5 Apr 2006 14:42:19 -0000 2.18
@@ -1,6 +1,6 @@
# Vend::Ship - Interchange shipping code
#
-# $Id: Ship.pm,v 2.17 2006/02/03 16:42:48 ton Exp $
+# $Id: Ship.pm,v 2.18 2006/04/05 14:42:19 mheins Exp $
#
# Copyright (C) 2002-2005 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -68,7 +68,7 @@
sub do_error {
my $msg = errmsg(@_);
Vend::Tags->error({ name => 'shipping', set => $msg });
- unless ($Vend::Cfg->{Limit}{no_ship_message}) {
+ unless ($::Limit->{no_ship_message}) {
$Vend::Session->{ship_message} ||= '';
$Vend::Session->{ship_message} .= $msg . ($msg =~ / $/ ? '' : ' ');
}
2.12 +3 -3 interchange/lib/Vend/Table/DB_File.pm
rev 2.12, prev_rev 2.11
Index: DB_File.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/DB_File.pm,v
retrieving revision 2.11
retrieving revision 2.12
diff -u -r2.11 -r2.12
--- DB_File.pm 8 Nov 2005 18:14:47 -0000 2.11
+++ DB_File.pm 5 Apr 2006 14:42:19 -0000 2.12
@@ -1,6 +1,6 @@
# Vend::Table::DB_File - Access an Interchange table stored in a DB file hash
#
-# $Id: DB_File.pm,v 2.11 2005/11/08 18:14:47 jon Exp $
+# $Id: DB_File.pm,v 2.12 2006/04/05 14:42:19 mheins Exp $
#
# Copyright (C) 2002-2005 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -31,7 +31,7 @@
use Vend::Table::Common;
@ISA = qw(Vend::Table::Common);
-$VERSION = substr(q$Revision: 2.11 $, 10);
+$VERSION = substr(q$Revision: 2.12 $, 10);
sub create {
my ($class, $config, $columns, $filename) = @_;
@@ -99,7 +99,7 @@
my $dbm;
my $failed = 0;
- my $retry = $Vend::Cfg->{Limit}{dbm_open_retries} || 10;
+ my $retry = $::Limit->{dbm_open_retries} || 10;
while( $failed < $retry ) {
$dbm = tie(%$tie, 'DB_File', $filename, $flags, 0600)
2.14 +3 -3 interchange/lib/Vend/Table/GDBM.pm
rev 2.14, prev_rev 2.13
Index: GDBM.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/GDBM.pm,v
retrieving revision 2.13
retrieving revision 2.14
diff -u -r2.13 -r2.14
--- GDBM.pm 8 Nov 2005 18:14:47 -0000 2.13
+++ GDBM.pm 5 Apr 2006 14:42:20 -0000 2.14
@@ -1,6 +1,6 @@
# Vend::Table::GDBM - Access an Interchange table stored in a GDBM file
#
-# $Id: GDBM.pm,v 2.13 2005/11/08 18:14:47 jon Exp $
+# $Id: GDBM.pm,v 2.14 2006/04/05 14:42:20 mheins Exp $
#
# Copyright (C) 2002-2005 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -30,7 +30,7 @@
use Vend::Table::Common;
@ISA = qw(Vend::Table::Common);
-$VERSION = substr(q$Revision: 2.13 $, 10);
+$VERSION = substr(q$Revision: 2.14 $, 10);
sub new {
my ($class, $obj) = @_;
@@ -102,7 +102,7 @@
my $dbm;
my $failed = 0;
- my $retry = $Vend::Cfg->{Limit}{dbm_open_retries} || 10;
+ my $retry = $::Limit->{dbm_open_retries} || 10;
while( $failed < $retry ) {
$dbm = tie(%$tie, 'GDBM_File', $filename, $flags, 0777)
2.13 +3 -3 interchange/lib/Vend/Table/SDBM.pm
rev 2.13, prev_rev 2.12
Index: SDBM.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Table/SDBM.pm,v
retrieving revision 2.12
retrieving revision 2.13
diff -u -r2.12 -r2.13
--- SDBM.pm 8 Nov 2005 18:14:48 -0000 2.12
+++ SDBM.pm 5 Apr 2006 14:42:20 -0000 2.13
@@ -1,6 +1,6 @@
# Vend::Table::SDBM - Access an Interchange table stored in Perl's internal SDBM
#
-# $Id: SDBM.pm,v 2.12 2005/11/08 18:14:48 jon Exp $
+# $Id: SDBM.pm,v 2.13 2006/04/05 14:42:20 mheins Exp $
#
# Copyright (C) 2002-2005 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -31,7 +31,7 @@
use Vend::Table::Common;
@ISA = qw(Vend::Table::Common);
-$VERSION = substr(q$Revision: 2.12 $, 10);
+$VERSION = substr(q$Revision: 2.13 $, 10);
sub create {
my ($class, $config, $columns, $filename) = @_;
@@ -51,7 +51,7 @@
my $dbm;
my $failed = 0;
- my $retry = $Vend::Cfg->{Limit}{dbm_open_retries} || 10;
+ my $retry = $::Limit->{dbm_open_retries} || 10;
while( $failed < $retry ) {
$dbm = tie(%$tie, 'SDBM_File', $filename, $flags, $File_permission_mode)
More information about the interchange-cvs
mailing list