[devel] Re: perl и squid
Alexey Tourbin
=?iso-8859-1?q?at_=CE=C1_altlinux=2Eru?=
Пт Мар 25 19:04:54 MSK 2005
On Wed, Mar 23, 2005 at 11:44:18AM +0200, Andrei Bulava wrote:
> $ locate shellwords.pl
> /usr/lib/perl5/shellwords.pl
> $ rpm -qf /usr/lib/perl5/shellwords.pl
> perl4-compat-5.8.6-alt3.1
Имеется drop-in replacement: вместо
require "shellwords.pl";
или
do "shellwords.pl";
нужно написать
use Text::ParseWords qw(shellwords);
или
use Text::ParseWords qw(old_shellwords);
Последний вариант наиболее близко mimics старый код из shellwords.pl,
который больше не поддерживается. Собственно, наличие некоторого
количества такого кода + генерат h2ph навело меня на мысль поместить
всё это в отдельный пакет perl4-compat. Наличие этого пакета в систем
может означать также наличие в системе перлового кода, написанного
10 или более лет назад (и с тех пор по существу не перерабатывавшегося).
Правда, я сделал маленькое послабление для autoconf_2.13.
Кстати, при моем участии в новой версии перла...
(неподдерживаемого кода в shellwords.pl не останется)
Change 23838 by rgs на grubert on 2005/01/20 18:21:36
Subject: Re: [perl #33173] shellwords.pl and tainting
From: Alexey Tourbin <at на altlinux.ru>
Date: Tue, 28 Dec 2004 22:29:37 +0300
Message-ID: <20041228192937.GB7824 на solemn.turbinal.org>
Affected files ...
... //depot/perl/MANIFEST#1210 edit
... //depot/perl/lib/Text/ParseWords.pm#21 edit
... //depot/perl/lib/Text/ParseWords/taint.t#1 add
... //depot/perl/lib/shellwords.pl#8 edit
Differences ...
==== //depot/perl/MANIFEST#1210 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#1209~23836~ Thu Jan 20 05:21:14 2005
+++ perl/MANIFEST Thu Jan 20 10:21:36 2005
@@ -1865,6 +1865,7 @@
lib/Text/Balanced/t/gentag.t See if Text::Balanced works
lib/Text/ParseWords.pm Perl module to split words on arbitrary delimiter
lib/Text/ParseWords.t See if Text::ParseWords works
+lib/Text/ParseWords/taint.t See if Text::ParseWords works with tainting
lib/Text/Soundex.pm Perl module to implement Soundex
lib/Text/Soundex.t See if Soundex works
lib/Text/Tabs.pm Do expand and unexpand
==== //depot/perl/lib/Text/ParseWords.pm#21 (text) ====
Index: perl/lib/Text/ParseWords.pm
--- perl/lib/Text/ParseWords.pm#20~23060~ Tue Jul 6 14:43:05 2004
+++ perl/lib/Text/ParseWords.pm Thu Jan 20 10:21:36 2005
@@ -12,7 +12,7 @@
sub shellwords {
- local(@lines) = @_;
+ my(@lines) = @_;
$lines[$#lines] =~ s/\s+$//;
return(quotewords('\s+', 0, @lines));
}
@@ -22,7 +22,6 @@
sub quotewords {
my($delim, $keep, @lines) = @_;
my($line, @words, @allwords);
-
foreach $line (@lines) {
@words = parse_line($delim, $keep, $line);
@@ -37,7 +36,7 @@
sub nested_quotewords {
my($delim, $keep, @lines) = @_;
my($i, @allwords);
-
+
for ($i = 0; $i < @lines; $i++) {
@{$allwords[$i]} = parse_line($delim, $keep, $lines[$i]);
return() unless (@{$allwords[$i]} || !length($lines[$i]));
@@ -48,13 +47,11 @@
sub parse_line {
- # We will be testing undef strings
- no warnings;
- use re 'taint'; # if it's tainted, leave it as such
-
my($delimiter, $keep, $line) = @_;
my($word, @pieces);
+ no warnings 'uninitialized'; # we will be testing undef strings
+
while (length($line)) {
$line =~ s/^(["']) # a $quote
((?:\\.|(?!\1)[^\\])*) # and $quoted text
@@ -77,6 +74,7 @@
$quoted =~ s/\\([\\'])/$1/g if ( $PERL_SINGLE_QUOTE && $quote eq "'");
}
}
+ $word .= substr($line, 0, 0); # leave results tainted
$word .= defined $quote ? $quoted : $unquoted;
if (length($delim)) {
@@ -100,41 +98,48 @@
# @words = old_shellwords($line);
# or
# @words = old_shellwords(@lines);
+ # or
+ # @words = old_shellwords(); # defaults to $_ (and clobbers it)
- local($_) = join('', @_);
- my(@words,$snippet,$field);
+ no warnings 'uninitialized'; # we will be testing undef strings
+ local *_ = \join('', @_) if @_;
+ my (@words, $snippet);
- s/^\s+//;
+ s/\A\s+//;
while ($_ ne '') {
- $field = '';
+ my $field = substr($_, 0, 0); # leave results tainted
for (;;) {
- if (s/^"(([^"\\]|\\.)*)"//) {
- ($snippet = $1) =~ s#\\(.)#$1#g;
+ if (s/\A"(([^"\\]|\\.)*)"//s) {
+ ($snippet = $1) =~ s#\\(.)#$1#sg;
}
- elsif (/^"/) {
+ elsif (/\A"/) {
+ require Carp;
+ Carp::carp("Unmatched double quote: $_");
return();
}
- elsif (s/^'(([^'\\]|\\.)*)'//) {
- ($snippet = $1) =~ s#\\(.)#$1#g;
+ elsif (s/\A'(([^'\\]|\\.)*)'//s) {
+ ($snippet = $1) =~ s#\\(.)#$1#sg;
}
- elsif (/^'/) {
+ elsif (/\A'/) {
+ require Carp;
+ Carp::carp("Unmatched single quote: $_");
return();
}
- elsif (s/^\\(.)//) {
+ elsif (s/\A\\(.)//s) {
$snippet = $1;
}
- elsif (s/^([^\s\\'"]+)//) {
+ elsif (s/\A([^\s\\'"]+)//) {
$snippet = $1;
}
else {
- s/^\s+//;
+ s/\A\s+//;
last;
}
$field .= $snippet;
}
push(@words, $field);
}
- @words;
+ return @words;
}
1;
==== //depot/perl/lib/Text/ParseWords/taint.t#1 (text) ====
Index: perl/lib/Text/ParseWords/taint.t
--- /dev/null Tue May 5 13:32:27 1998
+++ perl/lib/Text/ParseWords/taint.t Thu Jan 20 10:21:36 2005
@@ -0,0 +1,23 @@
+#!./perl -Tw
+# [perl #33173] shellwords.pl and tainting
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require Config;
+ if ($Config::Config{extensions} !~ /\bList\/Util\b/) {
+ print "1..0 # Skip: Scalar::Util was not built\n";
+ exit 0;
+ }
+}
+
+use Text::ParseWords qw(shellwords old_shellwords);
+use Scalar::Util qw(tainted);
+
+print "1..2\n";
+
+print "not " if grep { not tainted($_) } shellwords("$0$^X");
+print "ok 1\n";
+
+print "not " if grep { not tainted($_) } old_shellwords("$0$^X");
+print "ok 2\n";
==== //depot/perl/lib/shellwords.pl#8 (text) ====
Index: perl/lib/shellwords.pl
--- perl/lib/shellwords.pl#7~23681~ Fri Dec 24 05:51:59 2004
+++ perl/lib/shellwords.pl Thu Jan 20 10:21:36 2005
@@ -8,40 +8,7 @@
;# or
;# @words = shellwords(); # defaults to $_ (and clobbers it)
-sub shellwords {
- local *_ = \join('', @_) if @_;
- my (@words, $snippet);
+require Text::ParseWords;
+*shellwords = \&Text::ParseWords::old_shellwords;
- s/\A\s+//;
- while ($_ ne '') {
- my $field = substr($_, 0, 0); # leave results tainted
- for (;;) {
- if (s/\A"(([^"\\]|\\.)*)"//s) {
- ($snippet = $1) =~ s#\\(.)#$1#sg;
- }
- elsif (/\A"/) {
- die "Unmatched double quote: $_\n";
- }
- elsif (s/\A'(([^'\\]|\\.)*)'//s) {
- ($snippet = $1) =~ s#\\(.)#$1#sg;
- }
- elsif (/\A'/) {
- die "Unmatched single quote: $_\n";
- }
- elsif (s/\A\\(.)//s) {
- $snippet = $1;
- }
- elsif (s/\A([^\s\\'"]+)//) {
- $snippet = $1;
- }
- else {
- s/\A\s+//;
- last;
- }
- $field .= $snippet;
- }
- push(@words, $field);
- }
- return @words;
-}
1;
End of Patch.
> --
> // AB1002-UANIC
----------- следующая часть -----------
Было удалено вложение не в текстовом формате...
Имя : =?iso-8859-1?q?=CF=D4=D3=D5=D4=D3=D4=D7=D5=C5=D4?=
Тип : application/pgp-signature
Размер : 189 байтов
Описание: =?iso-8859-1?q?=CF=D4=D3=D5=D4=D3=D4=D7=D5=C5=D4?=
Url : <http://lists.altlinux.org/pipermail/devel/attachments/20050325/5ca5176d/attachment-0001.bin>
Подробная информация о списке рассылки Devel