зеркало из https://github.com/mozilla/pjs.git
Bug 174524 - Tidy up Bugzilla::{Util,Config}, and lazily-load unneeded modules
r=joel x2
This commit is contained in:
Родитель
1385a9de13
Коммит
5744ff0a32
|
@ -28,39 +28,6 @@
|
|||
|
||||
package Bugzilla::Config;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Bugzilla::Config - Configuration parameters for Bugzilla
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
# Getting parameters
|
||||
use Bugzilla::Config;
|
||||
|
||||
my $fooSetting = Param('foo');
|
||||
|
||||
# Administration functions
|
||||
use Bugzilla::Config qw(:admin);
|
||||
|
||||
my @valid_params = GetParamList();
|
||||
my @removed_params = UpgradeParams();
|
||||
SetParam($param, $value);
|
||||
WriteParams();
|
||||
|
||||
# Localconfig variables may also be imported
|
||||
use Bugzilla::Config qw(:db);
|
||||
print "Connecting to $db_name as $db_user with $db_pass\n";
|
||||
|
||||
# This variable does not belong in localconfig, and needs to go
|
||||
# somewhere better
|
||||
use Bugzilla::Config($contenttypes)
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package contains ways to access Bugzilla configuration parameters.
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
|
||||
use base qw(Exporter);
|
||||
|
@ -86,16 +53,20 @@ Exporter::export_ok_tags('admin', 'db');
|
|||
# Bugzilla version
|
||||
$Bugzilla::Config::VERSION = "2.17";
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
# This only has an affect for Data::Dumper >= 2.12 (ie perl >= 5.8.0)
|
||||
# Its just cosmetic, though, so that doesn't matter
|
||||
$Data::Dumper::Sortkeys = 1;
|
||||
|
||||
use File::Temp;
|
||||
use Safe;
|
||||
|
||||
use vars qw(@param_list);
|
||||
|
||||
# Data::Dumper is required as needed, below. The problem is that then when
|
||||
# the code locally sets $Data::Dumper::Foo, this triggers 'used only once'
|
||||
# warnings.
|
||||
# We can't predeclare another package's vars, though, so just use them
|
||||
{
|
||||
local $Data::Dumper::Sortkeys;
|
||||
local $Data::Dumper::Terse;
|
||||
local $Data::Dumper::Indent;
|
||||
}
|
||||
|
||||
my %param;
|
||||
|
||||
# INITIALISATION CODE
|
||||
|
@ -146,21 +117,6 @@ foreach my $item (@param_list) {
|
|||
|
||||
# Subroutines go here
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
=head2 Parameters
|
||||
|
||||
Parameters can be set, retrieved, and updated.
|
||||
|
||||
=over 4
|
||||
|
||||
=item C<Param($name)>
|
||||
|
||||
Returns the Param with the specified name. Either a string, or, in the case
|
||||
of multiple-choice parameters, an array reference.
|
||||
|
||||
=cut
|
||||
|
||||
sub Param {
|
||||
my ($param) = @_;
|
||||
|
||||
|
@ -170,26 +126,10 @@ sub Param {
|
|||
return $param{$param};
|
||||
}
|
||||
|
||||
=item C<GetParamList()>
|
||||
|
||||
Returns the list of known parameter types, from defparams.pl. Users should not
|
||||
rely on this method; it is intended for editparams/doeditparams only
|
||||
|
||||
The format for the list is specified in defparams.pl
|
||||
|
||||
=cut
|
||||
|
||||
sub GetParamList {
|
||||
return @param_list;
|
||||
}
|
||||
|
||||
=item C<SetParam($name, $value)>
|
||||
|
||||
Sets the param named $name to $value. Values are checked using the checker
|
||||
function for the given param if one exists.
|
||||
|
||||
=cut
|
||||
|
||||
sub SetParam {
|
||||
my ($name, $value) = @_;
|
||||
|
||||
|
@ -206,18 +146,6 @@ sub SetParam {
|
|||
$param{$name} = $value;
|
||||
}
|
||||
|
||||
=item C<UpdateParams()>
|
||||
|
||||
Updates the parameters, by transitioning old params to new formats, setting
|
||||
defaults for new params, and removing obsolete ones.
|
||||
|
||||
Any removed params are returned in a list, with elements [$item, $oldvalue]
|
||||
where $item is the entry in the param list.
|
||||
|
||||
This change is not flushed to disk, use L<C<WriteParams()>> for that.
|
||||
|
||||
=cut
|
||||
|
||||
sub UpdateParams {
|
||||
# --- PARAM CONVERSION CODE ---
|
||||
|
||||
|
@ -249,6 +177,8 @@ sub UpdateParams {
|
|||
# Remove any old params
|
||||
foreach my $item (keys %param) {
|
||||
if (!grep($_ eq $item, map ($_->{'name'}, @param_list))) {
|
||||
require Data::Dumper;
|
||||
|
||||
local $Data::Dumper::Terse = 1;
|
||||
local $Data::Dumper::Indent = 0;
|
||||
push (@oldparams, [$item, Data::Dumper->Dump([$param{$item}])]);
|
||||
|
@ -259,13 +189,14 @@ sub UpdateParams {
|
|||
return @oldparams;
|
||||
}
|
||||
|
||||
=item C<WriteParams()>
|
||||
|
||||
Writes the parameters to disk.
|
||||
|
||||
=cut
|
||||
|
||||
sub WriteParams {
|
||||
require Data::Dumper;
|
||||
|
||||
# This only has an affect for Data::Dumper >= 2.12 (ie perl >= 5.8.0)
|
||||
# Its just cosmetic, though, so that doesn't matter
|
||||
local $Data::Dumper::Sortkeys = 1;
|
||||
|
||||
require File::Temp;
|
||||
my ($fh, $tmpname) = File::Temp::tempfile('params.XXXXX',
|
||||
DIR => 'data' );
|
||||
|
||||
|
@ -296,6 +227,117 @@ sub ChmodDataFile {
|
|||
chmod $perm,$file;
|
||||
}
|
||||
|
||||
sub check_multi {
|
||||
my ($value, $param) = (@_);
|
||||
|
||||
if ($param->{'type'} eq "s") {
|
||||
unless (lsearch($param->{'choices'}, $value) >= 0) {
|
||||
return "Invalid choice '$value' for single-select list param '$param'";
|
||||
}
|
||||
|
||||
return "";
|
||||
}
|
||||
elsif ($param->{'type'} eq "m") {
|
||||
foreach my $chkParam (@$value) {
|
||||
unless (lsearch($param->{'choices'}, $chkParam) >= 0) {
|
||||
return "Invalid choice '$chkParam' for multi-select list param '$param'";
|
||||
}
|
||||
}
|
||||
|
||||
return "";
|
||||
}
|
||||
else {
|
||||
return "Invalid param type '$param->{'type'}' for check_multi(); " .
|
||||
"contact your Bugzilla administrator";
|
||||
}
|
||||
}
|
||||
|
||||
sub check_numeric {
|
||||
my ($value) = (@_);
|
||||
if ($value !~ /^[0-9]+$/) {
|
||||
return "must be a numeric value";
|
||||
}
|
||||
return "";
|
||||
}
|
||||
|
||||
sub check_regexp {
|
||||
my ($value) = (@_);
|
||||
eval { qr/$value/ };
|
||||
return $@;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Bugzilla::Config - Configuration parameters for Bugzilla
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
# Getting parameters
|
||||
use Bugzilla::Config;
|
||||
|
||||
my $fooSetting = Param('foo');
|
||||
|
||||
# Administration functions
|
||||
use Bugzilla::Config qw(:admin);
|
||||
|
||||
my @valid_params = GetParamList();
|
||||
my @removed_params = UpgradeParams();
|
||||
SetParam($param, $value);
|
||||
WriteParams();
|
||||
|
||||
# Localconfig variables may also be imported
|
||||
use Bugzilla::Config qw(:db);
|
||||
print "Connecting to $db_name as $db_user with $db_pass\n";
|
||||
|
||||
# This variable does not belong in localconfig, and needs to go
|
||||
# somewhere better
|
||||
use Bugzilla::Config($contenttypes)
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This package contains ways to access Bugzilla configuration parameters.
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
=head2 Parameters
|
||||
|
||||
Parameters can be set, retrieved, and updated.
|
||||
|
||||
=over 4
|
||||
|
||||
=item C<Param($name)>
|
||||
|
||||
Returns the Param with the specified name. Either a string, or, in the case
|
||||
of multiple-choice parameters, an array reference.
|
||||
|
||||
=item C<GetParamList()>
|
||||
|
||||
Returns the list of known parameter types, from defparams.pl. Users should not
|
||||
rely on this method; it is intended for editparams/doeditparams only
|
||||
|
||||
The format for the list is specified in defparams.pl
|
||||
|
||||
=item C<SetParam($name, $value)>
|
||||
|
||||
Sets the param named $name to $value. Values are checked using the checker
|
||||
function for the given param if one exists.
|
||||
|
||||
=item C<UpdateParams()>
|
||||
|
||||
Updates the parameters, by transitioning old params to new formats, setting
|
||||
defaults for new params, and removing obsolete ones.
|
||||
|
||||
Any removed params are returned in a list, with elements [$item, $oldvalue]
|
||||
where $item is the entry in the param list.
|
||||
|
||||
=item C<WriteParams()>
|
||||
|
||||
Writes the parameters to disk.
|
||||
|
||||
=back
|
||||
|
||||
=head2 Parameter checking functions
|
||||
|
@ -323,61 +365,13 @@ Functions should return error text, or the empty string if there was no error.
|
|||
Checks that a multi-valued parameter (ie type C<s> or type C<m>) satisfies
|
||||
its contraints.
|
||||
|
||||
=cut
|
||||
|
||||
sub check_multi {
|
||||
my ($value, $param) = (@_);
|
||||
|
||||
if ($param->{'type'} eq "s") {
|
||||
unless (lsearch($param->{'choices'}, $value) >= 0) {
|
||||
return "Invalid choice '$value' for single-select list param '$param'";
|
||||
}
|
||||
|
||||
return "";
|
||||
}
|
||||
elsif ($param->{'type'} eq "m") {
|
||||
foreach my $chkParam (@$value) {
|
||||
unless (lsearch($param->{'choices'}, $chkParam) >= 0) {
|
||||
return "Invalid choice '$chkParam' for multi-select list param '$param'";
|
||||
}
|
||||
}
|
||||
|
||||
return "";
|
||||
}
|
||||
else {
|
||||
return "Invalid param type '$param->{'type'}' for check_multi(); " .
|
||||
"contact your Bugzilla administrator";
|
||||
}
|
||||
}
|
||||
|
||||
=item C<check_numeric>
|
||||
|
||||
Checks that the value is a valid number
|
||||
|
||||
=cut
|
||||
|
||||
sub check_numeric {
|
||||
my ($value) = (@_);
|
||||
if ($value !~ /^[0-9]+$/) {
|
||||
return "must be a numeric value";
|
||||
}
|
||||
return "";
|
||||
}
|
||||
|
||||
=item C<check_regexp>
|
||||
|
||||
Checks that the value is a valid regexp
|
||||
|
||||
=cut
|
||||
|
||||
sub check_regexp {
|
||||
my ($value) = (@_);
|
||||
eval { qr/$value/ };
|
||||
return $@;
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
1;
|
||||
|
|
|
@ -25,6 +25,100 @@
|
|||
|
||||
package Bugzilla::Util;
|
||||
|
||||
use base qw(Exporter);
|
||||
@Bugzilla::Util::EXPORT = qw(is_tainted trick_taint detaint_natural
|
||||
html_quote value_quote
|
||||
lsearch max min
|
||||
trim);
|
||||
|
||||
use strict;
|
||||
|
||||
# This is from the perlsec page, slightly modifed to remove a warning
|
||||
# From that page:
|
||||
# This function makes use of the fact that the presence of
|
||||
# tainted data anywhere within an expression renders the
|
||||
# entire expression tainted.
|
||||
# Don't ask me how it works...
|
||||
sub is_tainted {
|
||||
return not eval { my $foo = join('',@_), kill 0; 1; };
|
||||
}
|
||||
|
||||
sub trick_taint {
|
||||
$_[0] =~ /^(.*)$/s;
|
||||
$_[0] = $1;
|
||||
return (defined($_[0]));
|
||||
}
|
||||
|
||||
sub detaint_natural {
|
||||
$_[0] =~ /^(\d+)$/;
|
||||
$_[0] = $1;
|
||||
return (defined($_[0]));
|
||||
}
|
||||
|
||||
sub html_quote {
|
||||
my ($var) = (@_);
|
||||
$var =~ s/\&/\&/g;
|
||||
$var =~ s/</\</g;
|
||||
$var =~ s/>/\>/g;
|
||||
$var =~ s/\"/\"/g;
|
||||
return $var;
|
||||
}
|
||||
|
||||
sub value_quote {
|
||||
my ($var) = (@_);
|
||||
$var =~ s/\&/\&/g;
|
||||
$var =~ s/</\</g;
|
||||
$var =~ s/>/\>/g;
|
||||
$var =~ s/\"/\"/g;
|
||||
# See bug http://bugzilla.mozilla.org/show_bug.cgi?id=4928 for
|
||||
# explanaion of why bugzilla does this linebreak substitution.
|
||||
# This caused form submission problems in mozilla (bug 22983, 32000).
|
||||
$var =~ s/\r\n/\
/g;
|
||||
$var =~ s/\n\r/\
/g;
|
||||
$var =~ s/\r/\
/g;
|
||||
$var =~ s/\n/\
/g;
|
||||
return $var;
|
||||
}
|
||||
|
||||
sub lsearch {
|
||||
my ($list,$item) = (@_);
|
||||
my $count = 0;
|
||||
foreach my $i (@$list) {
|
||||
if ($i eq $item) {
|
||||
return $count;
|
||||
}
|
||||
$count++;
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
|
||||
sub max {
|
||||
my $max = shift(@_);
|
||||
foreach my $val (@_) {
|
||||
$max = $val if $val > $max;
|
||||
}
|
||||
return $max;
|
||||
}
|
||||
|
||||
sub min {
|
||||
my $min = shift(@_);
|
||||
foreach my $val (@_) {
|
||||
$min = $val if $val < $min;
|
||||
}
|
||||
return $min;
|
||||
}
|
||||
|
||||
sub trim {
|
||||
my ($str) = @_;
|
||||
$str =~ s/^\s+//g;
|
||||
$str =~ s/\s+$//g;
|
||||
return $str;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Bugzilla::Util - Generic utility functions for bugzilla
|
||||
|
@ -60,16 +154,6 @@ people feel might be useful somewhere, someday>. Do not add methods to this
|
|||
package unless it is intended to be used for a significant number of files,
|
||||
and it does not belong anywhere else.
|
||||
|
||||
=cut
|
||||
|
||||
use base qw(Exporter);
|
||||
@Bugzilla::Util::EXPORT = qw(is_tainted trick_taint detaint_natural
|
||||
html_quote value_quote
|
||||
lsearch max min
|
||||
trim);
|
||||
|
||||
use strict;
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
This package provides several types of routines:
|
||||
|
@ -85,18 +169,6 @@ with care> to avoid security holes.
|
|||
|
||||
Determines whether a particular variable is tainted
|
||||
|
||||
=cut
|
||||
|
||||
# This is from the perlsec page, slightly modifed to remove a warning
|
||||
# From that page:
|
||||
# This function makes use of the fact that the presence of
|
||||
# tainted data anywhere within an expression renders the
|
||||
# entire expression tainted.
|
||||
# Don't ask me how it works...
|
||||
sub is_tainted {
|
||||
return not eval { my $foo = join('',@_), kill 0; 1; };
|
||||
}
|
||||
|
||||
=item C<trick_taint($val)>
|
||||
|
||||
Tricks perl into untainting a particular variable.
|
||||
|
@ -108,28 +180,12 @@ B<WARNING!! Using this routine on data that really could be tainted defeats
|
|||
the purpose of taint mode. It should only be used on variables that have been
|
||||
sanity checked in some way and have been determined to be OK.>
|
||||
|
||||
=cut
|
||||
|
||||
sub trick_taint {
|
||||
$_[0] =~ /^(.*)$/s;
|
||||
$_[0] = $1;
|
||||
return (defined($_[0]));
|
||||
}
|
||||
|
||||
=item C<detaint_natural($num)>
|
||||
|
||||
This routine detaints a natural number. It returns a true value if the
|
||||
value passed in was a valid natural number, else it returns false. You
|
||||
B<MUST> check the result of this routine to avoid security holes.
|
||||
|
||||
=cut
|
||||
|
||||
sub detaint_natural {
|
||||
$_[0] =~ /^(\d+)$/;
|
||||
$_[0] = $1;
|
||||
return (defined($_[0]));
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=head2 Quoting
|
||||
|
@ -144,40 +200,11 @@ be done in the template where possible.
|
|||
Returns a value quoted for use in HTML, with &, E<lt>, E<gt>, and E<34> being
|
||||
replaced with their appropriate HTML entities.
|
||||
|
||||
=cut
|
||||
|
||||
sub html_quote {
|
||||
my ($var) = (@_);
|
||||
$var =~ s/\&/\&/g;
|
||||
$var =~ s/</\</g;
|
||||
$var =~ s/>/\>/g;
|
||||
$var =~ s/\"/\"/g;
|
||||
return $var;
|
||||
}
|
||||
|
||||
=item C<value_quote($val)>
|
||||
|
||||
As well as escaping html like C<html_quote>, this routine converts newlines
|
||||
into 
, suitable for use in html attributes.
|
||||
|
||||
=cut
|
||||
|
||||
sub value_quote {
|
||||
my ($var) = (@_);
|
||||
$var =~ s/\&/\&/g;
|
||||
$var =~ s/</\</g;
|
||||
$var =~ s/>/\>/g;
|
||||
$var =~ s/\"/\"/g;
|
||||
# See bug http://bugzilla.mozilla.org/show_bug.cgi?id=4928 for
|
||||
# explanaion of why bugzilla does this linebreak substitution.
|
||||
# This caused form submission problems in mozilla (bug 22983, 32000).
|
||||
$var =~ s/\r\n/\
/g;
|
||||
$var =~ s/\n\r/\
/g;
|
||||
$var =~ s/\r/\
/g;
|
||||
$var =~ s/\n/\
/g;
|
||||
return $var;
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=head2 Searching
|
||||
|
@ -193,48 +220,14 @@ reference.
|
|||
|
||||
If the item is not in the list, returns -1.
|
||||
|
||||
=cut
|
||||
|
||||
sub lsearch {
|
||||
my ($list,$item) = (@_);
|
||||
my $count = 0;
|
||||
foreach my $i (@$list) {
|
||||
if ($i eq $item) {
|
||||
return $count;
|
||||
}
|
||||
$count++;
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
|
||||
=item C<max($a, $b, ...)>
|
||||
|
||||
Returns the maximum from a set of values.
|
||||
|
||||
=cut
|
||||
|
||||
sub max {
|
||||
my $max = shift(@_);
|
||||
foreach my $val (@_) {
|
||||
$max = $val if $val > $max;
|
||||
}
|
||||
return $max;
|
||||
}
|
||||
|
||||
=item C<min($a, $b, ...)>
|
||||
|
||||
Returns the minimum from a set of values.
|
||||
|
||||
=cut
|
||||
|
||||
sub min {
|
||||
my $min = shift(@_);
|
||||
foreach my $val (@_) {
|
||||
$min = $val if $val < $min;
|
||||
}
|
||||
return $min;
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=head2 Trimming
|
||||
|
@ -246,17 +239,4 @@ sub min {
|
|||
Removes any leading or trailing whitespace from a string. This routine does not
|
||||
modify the existing string.
|
||||
|
||||
=cut
|
||||
|
||||
sub trim {
|
||||
my ($str) = @_;
|
||||
$str =~ s/^\s+//g;
|
||||
$str =~ s/\s+$//g;
|
||||
return $str;
|
||||
}
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
1;
|
||||
|
|
|
@ -81,7 +81,7 @@ use RelationSet;
|
|||
use File::Spec;
|
||||
|
||||
# Some environment variables are not taint safe
|
||||
delete @::ENV{'PATH', 'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
|
||||
#delete @::ENV{'PATH', 'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
|
||||
|
||||
# Cwd.pm in perl 5.6.1 gives a warning if $::ENV{'PATH'} isn't defined
|
||||
# Set this to '' so that we don't get warnings cluttering the logs on every
|
||||
|
@ -433,7 +433,7 @@ sub GenerateVersionTable {
|
|||
print FID "# Any changes you make will be overwritten.\n";
|
||||
print FID "#\n";
|
||||
|
||||
use Data::Dumper;
|
||||
require Data::Dumper;
|
||||
print FID Data::Dumper->Dump([\@::log_columns, \%::versions],
|
||||
['*::log_columns', '*::versions']);
|
||||
|
||||
|
|
Загрузка…
Ссылка в новой задаче