Permalink
Browse files

fixed inappropriate escaping of tag attributes

  • Loading branch information...
1 parent 82af56f commit e2bb0a75f5de2377f9dcaeba04330e8981a5ac96 lstein committed Feb 10, 2003
Showing with 75 additions and 26 deletions.
  1. +30 −16 CGI.pm
  2. +13 −7 CGI/Carp.pm
  3. +25 −2 cgi_docs.html
  4. +7 −1 t/html.t
View
@@ -18,7 +18,7 @@ use Carp 'croak';
# The most recent version and complete docs are available at:
# http://stein.cshl.org/WWW/software/CGI/
-$CGI::revision = '$Id: CGI.pm,v 1.85 2002-12-14 14:03:42 lstein Exp $';
+$CGI::revision = '$Id: CGI.pm,v 1.86 2003-02-10 22:48:11 lstein Exp $';
$CGI::VERSION='2.90';
# HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
@@ -177,9 +177,9 @@ if (exists $ENV{'GATEWAY_INTERFACE'}
$| = 1;
require mod_perl;
if ($mod_perl::VERSION >= 1.99) {
- require Apache::compat;
+ eval "require Apache::compat";
} else {
- require Apache;
+ eval "require Apache";
}
}
@@ -611,15 +611,14 @@ sub _make_tag_func {
my ($self,$tagname) = @_;
my $func = qq(
sub $tagname {
- shift if \$_[0] &&
- (ref(\$_[0]) &&
- (substr(ref(\$_[0]),0,3) eq 'CGI' ||
- UNIVERSAL::isa(\$_[0],'CGI')));
- my(\$attr) = '';
- if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') {
- my(\@attr) = make_attributes(shift()||undef,1);
- \$attr = " \@attr" if \@attr;
- }
+ my (\$q,\$a,\@rest) = self_or_default(\@_);
+ my(\$attr) = '';
+ if (ref(\$a) && ref(\$a) eq 'HASH') {
+ my(\@attr) = make_attributes(\$a,\$q->{'escape'});
+ \$attr = " \@attr" if \@attr;
+ } else {
+ unshift \@rest,\$a;
+ }
);
if ($tagname=~/start_(\w+)/i) {
$func .= qq! return "<\L$1\E\$attr>";} !;
@@ -630,7 +629,7 @@ sub _make_tag_func {
return \$XHTML ? "\L<$tagname\E\$attr />" : "\L<$tagname\E\$attr>" unless \@_;
my(\$tag,\$untag) = ("\L<$tagname\E\$attr>","\L</$tagname>\E");
my \@result = map { "\$tag\$_\$untag" }
- (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
+ (ref(\$rest[0]) eq 'ARRAY') ? \@{\$rest[0]} : "\@rest";
return "\@result";
}#;
}
@@ -1246,11 +1245,11 @@ sub header {
return undef if $self->{'.header_printed'}++ and $HEADERS_ONCE;
- my($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,@other) =
+ my($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) =
rearrange([['TYPE','CONTENT_TYPE','CONTENT-TYPE'],
'STATUS',['COOKIE','COOKIES'],'TARGET',
'EXPIRES','NPH','CHARSET',
- 'ATTACHMENT'],@p);
+ 'ATTACHMENT','P3P'],@p);
$nph ||= $NPH;
if (defined $charset) {
@@ -1276,6 +1275,10 @@ sub header {
push(@header,"Status: $status") if $status;
push(@header,"Window-Target: $target") if $target;
+ if ($p3p) {
+ $p3p = join ' ',@$p3p if ref($p3p) eq 'ARRAY';
+ push(@header,qq(P3P: policyref="/w3c/p3p.xml" CP="$p3p"));
+ }
# push all the cookies -- there may be several
if ($cookie) {
my(@cookie) = ref($cookie) && ref($cookie) eq 'ARRAY' ? @{$cookie} : $cookie;
@@ -1340,7 +1343,7 @@ sub redirect {
unshift(@o,'-Target'=>$target) if $target;
unshift(@o,'-Cookie'=>$cookie) if $cookie;
unshift(@o,'-Type'=>'');
- return $self->header(@o);
+ return $self->header(map {$self->unescapeHTML($_)} @o);
}
END_OF_FUNC
@@ -4533,6 +4536,17 @@ the user to save it to disk. The value of the argument is the
suggested name for the saved file. In order for this to work, you may
have to set the B<-type> to "application/octet-stream".
+The B<-p3p> parameter will add a P3P tag to the outgoing header. The
+parameter can be an arrayref or a space-delimited string of P3P tags.
+For example:
+
+ print header(-p3p=>[qw(CAO DSP LAW CURa)]);
+ print header(-p3p=>'CAO DSP LAW CURa');
+
+In either case, the outgoing header will be formatted as:
+
+ P3P: policyref="/w3c/p3p.xml" cp="CAO DSP LAW CURa"
+
=head2 GENERATING A REDIRECTION HEADER
print $query->redirect('http://somewhere.else/in/movie/land');
View
@@ -353,10 +353,6 @@ sub _warn {
}
}
-sub ineval {
- (exists $ENV{MOD_PERL} ? 0 : $^S) || _longmess() =~ /eval [\{\']/m
-}
-
# The mod_perl package Apache::Registry loads CGI programs by calling
# eval. These evals don't count when looking at the stack backtrace.
@@ -367,15 +363,25 @@ sub _longmess {
return $message;
}
+sub ineval {
+ (exists $ENV{MOD_PERL} ? 0 : $^S) || _longmess() =~ /eval [\{\']/m
+}
+
sub die {
+ my ($arg) = @_;
realdie @_ if ineval;
if (!ref($arg)) {
- my $time = scalar(localtime);
+ $arg = join("", @_);
my($file,$line,$id) = id(1);
$arg .= " at $file line $line." unless $arg=~/\n$/;
&fatalsToBrowser($arg) if $WRAP;
- my $stamp = stamp;
- $arg=~s/^/$stamp/gm;
+ if (($arg =~ /\n$/) || !exists($ENV{MOD_PERL})) {
+ my $stamp = stamp;
+ $arg=~s/^/$stamp/gm;
+ }
+ if ($arg !~ /\n$/) {
+ $arg .= "\n";
+ }
}
realdie $arg;
}
View
@@ -7,7 +7,7 @@
<BODY bgcolor="#FFFFFF">
<H1><IMG SRC="examples/dna.small.gif" ALT="[logo]">
CGI.pm - a Perl5 CGI Library</H1>
-Version 2.90, 11/??/2002, L. Stein
+Version 2.91, ??/??/2002, L. Stein
<p>
<H2>Abstract</H2> This perl 5 library uses objects to create Web
@@ -953,6 +953,23 @@
suggested name for the saved file. In order for this to work, you may
have to set the <b>-type</b> to "application/octet-stream".
+<h4>-p3p</h4>
+
+The <b>-p3p</b> parameter will add a P3P tag to the outgoing header. The
+parameter can be an arrayref or a space-delimited string of P3P tags.
+For example:
+
+<blockquote><pre>
+print header(-p3p=&gt;[qw(CAO DSP LAW CURa)]);
+print header(-p3p=&gt;'CAO DSP LAW CURa');
+</pre></blockquote>
+
+In either case, the outgoing header will be formatted as:
+
+<blockquote><pre>
+P3P: policyref="/w3c/p3p.xml" cp="CAO DSP LAW CURa"
+</pre></blockquote>
+
<h4>Other header fields</h4>
Any other parameters that you pass to <strong>header()</strong> will be turned
@@ -4726,8 +4743,14 @@
<HR>
<H2><A NAME="new">Revision History</A></H2>
+<h3>Version 2.91</h3>
+<ol>
+ <li>Attribute generation now correctly respects the value of autoEscape().
+</ol>
<h3>Version 2.90</h3>
<ol>
+ <li>Fixed bug in redirect header handling.
+ <li>Added P3P option to header().
<li>Patches from Alexey Mahotkin to make CGI::Carp work correctly with object-oriented exceptions.
<li>Removed inaccurate description of how to set multiple cookies from CGI::Cookie pod file.
<li>Patch from Kevin Mahony to prevent running out of filehandles when uploading lots of files.
@@ -5751,6 +5774,6 @@
<a href="http://www.cshl.org/">Cold Spring Harbor Laboratory</a></ADDRESS>
<P>
<!-- hhmts start -->
-Last modified: Sat Dec 14 09:02:27 EST 2002
+Last modified: Mon Feb 10 17:46:56 EST 2003
<!-- hhmts end -->
</BODY> </HTML>
View
@@ -10,7 +10,7 @@ $loaded = 1;
print "ok 1\n";
BEGIN {
- $| = 1; print "1..24\n";
+ $| = 1; print "1..27\n";
if( $] > 5.006 ) {
# no utf8
require utf8; # we contain Latin-1
@@ -96,3 +96,9 @@ test(22,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<h1>this is &lt;not&gt
test(23,i(p('hello there')) eq '<i><p>hello there</p></i>');
my $q = new CGI;
test(24,$q->h1('hi') eq '<h1>hi</h1>');
+
+$q->autoEscape(1);
+test(25,$q->p({title=>"hello world&egrave;"},'hello &aacute;') eq '<p title="hello world&amp;egrave;">hello &aacute;</p>');
+$q->autoEscape(0);
+test(26,$q->p({title=>"hello world&egrave;"},'hello &aacute;') eq '<p title="hello world&egrave;">hello &aacute;</p>');
+test(27,p({title=>"hello world&egrave;"},'hello &aacute;') eq '<p title="hello world&amp;egrave;">hello &aacute;</p>');

0 comments on commit e2bb0a7

Please sign in to comment.