зеркало из https://github.com/mozilla/pjs.git
255 строки
6.0 KiB
Perl
255 строки
6.0 KiB
Perl
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
|
#
|
|
# The contents of this file are subject to the Mozilla Public
|
|
# License Version 1.1 (the "License"); you may not use this file
|
|
# except in compliance with the License. You may obtain a copy of
|
|
# the License at http://www.mozilla.org/MPL/
|
|
#
|
|
# Software distributed under the License is distributed on an "AS
|
|
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
|
|
# implied. See the License for the specific language governing
|
|
# rights and limitations under the License.
|
|
#
|
|
# The Original Code is the Bugzilla Bug Tracking System.
|
|
#
|
|
# The Initial Developer of the Original Code is Netscape Communications
|
|
# Corporation. Portions created by Netscape are
|
|
# Copyright (C) 1998 Netscape Communications Corporation. All
|
|
# Rights Reserved.
|
|
#
|
|
# Contributor(s): Terry Weissman <terry@mozilla.org>
|
|
# Dan Mosedale <dmose@mozilla.org>
|
|
# Jacob Steenhagen <jake@bugzilla.org>
|
|
# Bradley Baetz <bbaetz@student.usyd.edu.au>
|
|
# Christopher Aillon <christopher@aillon.com>
|
|
|
|
package Bugzilla::Util;
|
|
|
|
use base qw(Exporter);
|
|
@Bugzilla::Util::EXPORT = qw(is_tainted trick_taint detaint_natural
|
|
html_quote url_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;
|
|
}
|
|
|
|
# This orignally came from CGI.pm, by Lincoln D. Stein
|
|
sub url_quote {
|
|
my ($toencode) = (@_);
|
|
$toencode =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
|
|
return $toencode;
|
|
}
|
|
|
|
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
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Bugzilla::Util;
|
|
|
|
# Functions for dealing with variable tainting
|
|
$rv = is_tainted($var);
|
|
trick_taint($var);
|
|
detaint_natural($var);
|
|
|
|
# Functions for quoting
|
|
html_quote($var);
|
|
url_quote($var);
|
|
value_quote($var);
|
|
|
|
# Functions for searching
|
|
$loc = lsearch(\@arr, $val);
|
|
$val = max($a, $b, $c);
|
|
$val = min($a, $b, $c);
|
|
|
|
# Functions for trimming variables
|
|
$val = trim(" abc ");
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This package contains various utility functions which do not belong anywhere
|
|
else.
|
|
|
|
B<It is not intended as a general dumping group for something which
|
|
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.
|
|
|
|
=head1 FUNCTIONS
|
|
|
|
This package provides several types of routines:
|
|
|
|
=head2 Tainting
|
|
|
|
Several functions are available to deal with tainted variables. B<Use these
|
|
with care> to avoid security holes.
|
|
|
|
=over 4
|
|
|
|
=item C<is_tainted>
|
|
|
|
Determines whether a particular variable is tainted
|
|
|
|
=item C<trick_taint($val)>
|
|
|
|
Tricks perl into untainting a particular variable.
|
|
|
|
Use trick_taint() when you know that there is no way that the data
|
|
in a scalar can be tainted, but taint mode still bails on it.
|
|
|
|
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.>
|
|
|
|
=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.
|
|
|
|
=back
|
|
|
|
=head2 Quoting
|
|
|
|
Some values may need to be quoted from perl. However, this should in general
|
|
be done in the template where possible.
|
|
|
|
=over 4
|
|
|
|
=item C<html_quote($val)>
|
|
|
|
Returns a value quoted for use in HTML, with &, E<lt>, E<gt>, and E<34> being
|
|
replaced with their appropriate HTML entities.
|
|
|
|
=item C<url_quote($val)>
|
|
|
|
Quotes characters so that they may be included as part of a url.
|
|
|
|
=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.
|
|
|
|
=back
|
|
|
|
=head2 Searching
|
|
|
|
Functions for searching within a set of values.
|
|
|
|
=over 4
|
|
|
|
=item C<lsearch($list, $item)>
|
|
|
|
Returns the position of C<$item> in C<$list>. C<$list> must be a list
|
|
reference.
|
|
|
|
If the item is not in the list, returns -1.
|
|
|
|
=item C<max($a, $b, ...)>
|
|
|
|
Returns the maximum from a set of values.
|
|
|
|
=item C<min($a, $b, ...)>
|
|
|
|
Returns the minimum from a set of values.
|
|
|
|
=back
|
|
|
|
=head2 Trimming
|
|
|
|
=over 4
|
|
|
|
=item C<trim($str)>
|
|
|
|
Removes any leading or trailing whitespace from a string. This routine does not
|
|
modify the existing string.
|
|
|
|
=back
|