[interchange] Reorder and/or cache $@ to prevent accidental alteration before it is used

Jon Jensen interchange-cvs at icdevgroup.org
Thu Nov 2 05:54:15 UTC 2017


commit ca382673e1aec2209bfb9f710150d181481616ea
Author: Jon Jensen <jon at endpoint.com>
Date:   Wed Nov 1 19:10:39 2017 -0600

    Reorder and/or cache $@ to prevent accidental alteration before it is used
    
    It is easy to lose $@ in another function call that may itself have an
    eval, leading to missing or wrong errors being reported.
    
    Some of this is fixing what can be real problems, and some is for
    prevention, to reduce the chance of future changes breaking things.

 code/UI_Tag/file_navigator.coretag |   13 ++++++-------
 lib/Vend/Data.pm                   |   11 ++++++-----
 lib/Vend/Dispatch.pm               |   19 ++++++++++---------
 lib/Vend/Interpolate.pm            |   15 ++++++++++-----
 lib/Vend/Table/DBI.pm              |   12 +++++-------
 lib/Vend/Table/DBI_CompositeKey.pm |   10 ++++++----
 lib/Vend/UserDB.pm                 |    9 +++++----
 lib/Vend/Util.pm                   |    5 +++--
 scripts/makecat.PL                 |    9 ++++-----
 test.pl                            |    7 +++++--
 10 files changed, 60 insertions(+), 50 deletions(-)
---
diff --git a/code/UI_Tag/file_navigator.coretag b/code/UI_Tag/file_navigator.coretag
index 127ff81..055fde7 100644
--- a/code/UI_Tag/file_navigator.coretag
+++ b/code/UI_Tag/file_navigator.coretag
@@ -1,4 +1,4 @@
-# Copyright 2002-2007 Interchange Development Group and others
+# Copyright 2002-2017 Interchange Development Group and others
 # 
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -7,7 +7,7 @@
 
 UserTag file-navigator Order    mask
 UserTag file-navigator addAttr
-UserTag file-navigator Version  $Revision: 1.17 $
+UserTag file-navigator Version  1.18
 UserTag file-navigator Routine  <<EOR
 use vars qw/$CGI $Session $Tag $Scratch/;
 eval {
@@ -85,11 +85,10 @@ sub {
 					}
 					$regex = qr{$string};
 				};
-			}
-
-			if($@ or ! $regex) {
-				push @errors, ::errmsg("%s is not a good search.", $regex);
-				last FINDNAV;
+				if ($@ or ! $regex) {
+					push @errors, ::errmsg("%s is not a good search.", $regex);
+					last FINDNAV;
+				}
 			}
 
 			$full_path = 1;
diff --git a/lib/Vend/Data.pm b/lib/Vend/Data.pm
index 5313f72..7ababc9 100644
--- a/lib/Vend/Data.pm
+++ b/lib/Vend/Data.pm
@@ -1,6 +1,6 @@
 # Vend::Data - Interchange databases
 #
-# Copyright (C) 2002-2016 Interchange Development Group
+# Copyright (C) 2002-2017 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
 #
 # This program was originally based on Vend 0.2 and 0.3
@@ -1001,14 +1001,15 @@ sub import_database {
 
 #::logDebug("db=$db, \$\!='$!' \$\@='$@' (" . length($@) . ")\n") if ! $db;
 		if($@) {
-#::logDebug("Dieing of $@");
-			die $@ unless $no_import;
-			die $@ if $tried_import++;
+			my $err = $@;
+#::logDebug("Dieing of $err");
+			die $err unless $no_import;
+			die $err if $tried_import++;
 			if(! -f $database_dbm) {
 				$Vend::ForceImport{$obj->{name}} = 1;
 				return import_database($obj);
 			}
-			die $@;
+			die $err;
 		}
 		undef $tried_import;
 #::logDebug("Opening $obj->{name}: RO=$obj->{Read_only} WC=$obj->{WRITE_CONTROL} WA=$obj->{WRITE_ALWAYS}");
diff --git a/lib/Vend/Dispatch.pm b/lib/Vend/Dispatch.pm
index eeb463e..ac9bd17 100644
--- a/lib/Vend/Dispatch.pm
+++ b/lib/Vend/Dispatch.pm
@@ -1,6 +1,6 @@
 # Vend::Dispatch - Handle Interchange page requests
 #
-# Copyright (C) 2002-2016 Interchange Development Group
+# Copyright (C) 2002-2017 Interchange Development Group
 # Copyright (C) 2002 Mike Heins <mike at perusion.net>
 #
 # This program was originally based on Vend 0.2 and 0.3
@@ -24,7 +24,7 @@
 package Vend::Dispatch;
 
 use vars qw($VERSION);
-$VERSION = '1.115';
+$VERSION = '1.116';
 
 use POSIX qw(strftime);
 use Vend::Util;
@@ -514,8 +514,6 @@ my %form_action = (
 #::logDebug("selected receipt=$receipt");
 							display_special_page($receipt);
 						};
-						$not_displayed = 0;
-#::logDebug("not_displayed=$not_displayed");
 						if($@) {
 							my $msg = $@;
 							logError( 
@@ -524,6 +522,8 @@ my %form_action = (
 								$msg,
 							);
 						}
+						$not_displayed = 0;
+#::logDebug("not_displayed=$not_displayed");
 					}
 
 					# Do order cleanup
@@ -683,8 +683,8 @@ sub do_process {
 		$status = $sub->($todo);
 	};
 	if($@) {
-		undef $status;
 		my $err = $@;
+		undef $status;
 		my $template = <<EOF;
 Sorry, there was an error in processing this form action. Please 
 report the error or try again later.
@@ -820,12 +820,13 @@ sub run_in_catalog {
 		};
 
 		if ($@) {
+			my $err = $@;
+			$failure = errmsg('Job terminated with an error: %s', $err);
+			logError("Job group=%s pid=%s terminated with an error: %s", $job || 'INTERNAL', $$, $err);
+
 			# job terminated due to an error
 			$errors = 1;
 
-			$failure = errmsg('Job terminated with an error: %s', $@);
-			logError ("Job group=%s pid=%s terminated with an error: %s", $job || 'INTERNAL', $$, $@);
-			
 			# remove flag for this job
 			Vend::Server::flag_job($$, $cat, 'furl');
 		}
@@ -1882,8 +1883,8 @@ EOF
 	(undef $Vend::RedoAction, redo DOACTION) if $Vend::RedoAction;
 
 	if($@) {
-		undef $status;
 		my $err = $@;
+		undef $status;
 		my $template = <<EOF;
 Sorry, there was an error in processing this form action. Please 
 report the error or try again later.
diff --git a/lib/Vend/Interpolate.pm b/lib/Vend/Interpolate.pm
index 13f5893..ece47f9 100644
--- a/lib/Vend/Interpolate.pm
+++ b/lib/Vend/Interpolate.pm
@@ -1,6 +1,6 @@
 # Vend::Interpolate - Interpret Interchange tags
 # 
-# Copyright (C) 2002-2016 Interchange Development Group
+# Copyright (C) 2002-2017 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
 #
 # This program was originally based on Vend 0.2 and 0.3
@@ -26,7 +26,7 @@ package Vend::Interpolate;
 require Exporter;
 @ISA = qw(Exporter);
 
-$VERSION = '2.314';
+$VERSION = '2.315';
 
 @EXPORT = qw (
 
@@ -1717,8 +1717,8 @@ sub tag_perl {
 	undef $MVSAFE::Safe;
 
 	if ($@) {
-#::logDebug("tag_perl failed $@");
 		my $msg = $@;
+#::logDebug("tag_perl failed $msg");
 		if($Vend::Try) {
 			$Vend::Session->{try}{$Vend::Try} .= "\n" 
 				if $Vend::Session->{try}{$Vend::Try};
@@ -4982,6 +4982,10 @@ sub tag_loop_list {
 				@rows = map { [ split /\Q$delim/, $_ ] } split /\Q$splittor/, $list;
 			};
 		}
+		else {
+			# clear errors since we didn't run an eval
+			undef $@;
+		}
 	}
 	elsif($opt->{acclist}) {
 #::logDebug("loop resolve acclist");
@@ -5015,8 +5019,9 @@ sub tag_loop_list {
 	}
 
 	if($@) {
-		logError("bad split delimiter in loop list: $@");
-#::logDebug("loop resolve error $@");
+		my $err = $@;
+		logError("bad split delimiter in loop list: $err");
+#::logDebug("loop resolve error $err");
 	}
 
 	# head_skip pulls rows off the top, and uses the last row to
diff --git a/lib/Vend/Table/DBI.pm b/lib/Vend/Table/DBI.pm
index f86fb22..95f35b1 100644
--- a/lib/Vend/Table/DBI.pm
+++ b/lib/Vend/Table/DBI.pm
@@ -1,6 +1,6 @@
 # Vend::Table::DBI - Access a table stored in an DBI/DBD database
 #
-# Copyright (C) 2002-2016 Interchange Development Group
+# Copyright (C) 2002-2017 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
 #
 # This program is free software; you can redistribute it and/or modify
@@ -1456,8 +1456,6 @@ sub set_slice {
 		}
 	};
 
-#::logDebug("set_slice key: $val");
-
 	if($@) {
 		my $caller = caller();
 		$s->log_error(
@@ -1471,6 +1469,7 @@ sub set_slice {
 		return undef;
 	}
 
+#::logDebug("set_slice key: $val");
 	return $val;
 }
 
@@ -2286,12 +2285,11 @@ sub query {
 		}
 	};
 	if($@) {
+		my $origmsg = $@;
+
 		if(! $sth or ! defined $rc) {
 			# query failed, probably because no table
 
-			## Save the original message
-			my $origmsg = $@;
-
 			# Allow failed query by design, maybe to use multiple key inserts
 			return undef if $opt->{no_requery};
 
@@ -2330,7 +2328,7 @@ sub query {
 			}
 		}
 		else {
-			my $msg = ::errmsg("SQL query failed: %s\nquery was: %s", $@, $query);
+			my $msg = ::errmsg("SQL query failed: %s\nquery was: %s", $origmsg, $query);
 			$s->log_error($msg);
 			Carp::croak($msg) if $Vend::Try;
 			return undef;
diff --git a/lib/Vend/Table/DBI_CompositeKey.pm b/lib/Vend/Table/DBI_CompositeKey.pm
index 2653b80..2c510f3 100644
--- a/lib/Vend/Table/DBI_CompositeKey.pm
+++ b/lib/Vend/Table/DBI_CompositeKey.pm
@@ -1,6 +1,6 @@
 # Vend::Table::DBI - Access a table stored in an DBI/DBD database
 #
-# Copyright (C) 2002-2008 Interchange Development Group
+# Copyright (C) 2002-2017 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
 #
 # This program is free software; you can redistribute it and/or modify
@@ -19,7 +19,7 @@
 # MA  02110-1301  USA.
 
 package Vend::Table::DBI_CompositeKey;
-$VERSION = substr(q$Revision: 1.15 $, 10);
+$VERSION = '1.16';
 
 use strict;
 
@@ -461,12 +461,13 @@ sub set_slice {
 #::logDebug("set_slice key: $val");
 
 	if($@) {
+		my $err = $@;
 		my $caller = caller();
 		$s->log_error(
 			"%s error as called by %s: %s\nquery was:%s\nvalues were:'%s'",
 			'set_slice',
 			$caller,
-			$@,
+			$err,
 			$sql,
 			join("','", @$vary),
 		);
@@ -546,12 +547,13 @@ sub set_row {
 			$s->[$DBI]->do("insert into $s->[$TABLE] ($key_string) VALUES ($val_string)");
 		};
 		if($@) {
+			my $err = $@;
 			my $caller = caller();
 			$s->log_error(
 				"%s error as called by %s: %s\nfields=%s\nvalues=%s",
 				'set_row',
 				$caller,
-				$@,
+				$err,
 				$key_string,
 				$val_string,
 			);
diff --git a/lib/Vend/UserDB.pm b/lib/Vend/UserDB.pm
index 12fc020..941452c 100644
--- a/lib/Vend/UserDB.pm
+++ b/lib/Vend/UserDB.pm
@@ -1,6 +1,6 @@
 # Vend::UserDB - Interchange user database functions
 #
-# Copyright (C) 2002-2015 Interchange Development Group
+# Copyright (C) 2002-2017 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
 #
 # This program is free software; you can redistribute it and/or modify
@@ -2357,15 +2357,16 @@ sub new_account {
 						);
 		}
 	};
+	my $err = $@;
 
 	scrub();
 
-	if($@) {
+	if ($err) {
 		if(defined $self) {
-			$self->{ERROR} = $@;
+			$self->{ERROR} = $err;
 		}
 		else {
-			logError( "Vend::UserDB error: %s\n", $@ );
+			logError("Vend::UserDB error: %s\n", $err);
 		}
 		return undef;
 	}
diff --git a/lib/Vend/Util.pm b/lib/Vend/Util.pm
index 20c6d3a..d3ea439 100644
--- a/lib/Vend/Util.pm
+++ b/lib/Vend/Util.pm
@@ -103,7 +103,7 @@ use Vend::Safe;
 use Vend::File;
 use subs qw(logError logGlobal);
 use vars qw($VERSION @EXPORT @EXPORT_OK);
-$VERSION = '2.129';
+$VERSION = '2.130';
 
 my $Eval_routine;
 my $Eval_routine_file;
@@ -790,13 +790,14 @@ sub logData {
 		close(MVLOGDATA) or die "close\n";
     };
     if ($@) {
+        my $err = $@;
 
 		if($::Limit->{logdata_error_length} > 0) {
 			$msg = substr($msg, 0, $::Limit->{logdata_error_length});
 		}
 
 		logError ("Could not %s log file '%s': %s\nto log this data:\n%s",
-				$@,
+				$err,
 				$file,
 				$!,
 				$msg,
diff --git a/scripts/makecat.PL b/scripts/makecat.PL
index 770aed4..9099788 100644
--- a/scripts/makecat.PL
+++ b/scripts/makecat.PL
@@ -3,7 +3,7 @@
 #
 # Interchange catalog configurator
 #
-# Copyright (C) 2002-2015 Interchange Development Group
+# Copyright (C) 2002-2017 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
 #
 # This program is free software; you can redistribute it and/or modify
@@ -1716,9 +1716,6 @@ DOCOPY: {
 	eval {
 		copy_current_to_dir("$Conf{relocate}$Conf{catroot}");
 	};
-
-	umask(022) unless $Conf{noumask};
-
 	if($@) {
 		die <<EOF . "\n";
 There were errors in copying the demo files.  Cannot
@@ -1729,6 +1726,8 @@ The problem was:
 EOF
 	}
 
+	umask(022) unless $Conf{noumask};
+
 	unless($prog eq 'NONE') {
 		File::Copy::copy( $prog, "$Conf{relocate}$Conf{catroot}/executable")
 			or die "Couldn't copy link program from $prog: $!\n";
@@ -2304,7 +2303,7 @@ makecat [--options] name
 
 =head1 VERSION
 
-2.29
+2017-11-01
 
 =head1 INTRODUCTION
 
diff --git a/test.pl b/test.pl
index db46654..801a8a6 100644
--- a/test.pl
+++ b/test.pl
@@ -1,4 +1,6 @@
-# Copyright (C) 2002-2016 Interchange Development Group
+# test.pl - Interchange test script
+#
+# Copyright (C) 2002-2017 Interchange Development Group
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -204,13 +206,14 @@ eval {
 	close (SOCK)								or die "close: $!\n";
 
 };
+my $err = $@;
 
 if(length($result) > 500 and $result =~ /test succeeded/i) {
 	print "ok $testnum\n";
 }
 else {
 	print "not ok $testnum";
-	print " ($@)" if $@;
+	print " ($err)" if $err;
 	print "\n";
 	print <<EOF;
 



More information about the interchange-cvs mailing list