Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Merge remote branch 'remotes/yanick/psgi_support' into psgi_support

Conflicts:
	lib/CGI.pm
  • Loading branch information...
commit b03599f53c89b551ff2ad723c23e0ff563af2996 2 parents 9813925 + 421a707
@markstos authored
View
25 Changes
@@ -1,6 +1,26 @@
+ [NEW FEATURES]
+ - A new option to set $CGI::Carp::TO_BROWSER = 0, allows you to explicitly
+ exclude a particular scope from triggering printing to the browser when
+ fatatlsToBrowser is set. (RT#62783, Thanks to papowell)
+
[BUG FIXES]
- Setting charset() now works for all content types, not just "text/*".
- (RT#57945, Thanks to Yanick and Gerv.
+ (RT#57945, Thanks to Yanick and Gerv.)
+ - support for user temporary directories ($HOME/tmp) was commented out
+ in 2.61 but the documentation wasn't updated (Peter Gervai, Niko Tyni)
+ - setting $CGITempFile::TMPDIRECTORY before loading CGI.pm has been
+ working but undocumented since 3.12 (which listed it in Changes as
+ $CGI::TMPDIRECTORY) (Peter Gervai, Niko Tyni)
+ - unfortunately the previous change broke the runtime check for looking
+ for a new temporary directory if the current one suddenly became
+ unwritable (Peter Gervai, Niko Tyni)
+ - A bug was fixed in CGI::Carp triggered by certain death cases in
+ the BEGIN phase of parent classes.
+ (RT#57224, Thanks to UNERA, Yanick Champoux, Mark Stosberg)
+
+ [SECURITY]
+ - Further improvements have been made to guard against newline injections
+ in headers. (Thanks to Max Kanat-Alexander, Yanick Champoux, Mark Stosberg)
[PERFORMANCE]
- Make EBCDIC a compile-time constant so there's zero overhead (and less
@@ -11,6 +31,9 @@
- typo and whitespace fixes (RT#62785, thanks to scop@cpan.org)
- The -dtd argument to start_html() is now documented
(RT#60473, Thanks to giecrilj and steve@fisharerojo.org)
+ - CGI::Carp doc are updated to reflect that it can work with mod_perl 2.0.
+ - when creating a temporary file in the directory fails, the error message
+ could indicate the root of the problem better (Peter Gervai, Niko Tyni)
[INTERNALS]
- Re-fixing https test in http.t. (RT#54768, thanks to SPROUT)
View
3  MANIFEST
@@ -48,12 +48,14 @@ t/fast.t
t/form.t
t/function.t
t/gen-tests/gen-start-end-tags.pl
+t/headers.t
t/hidden.t
t/html.t
t/http.t
t/init.t
t/init_test.txt
t/no_tabindex.t
+t/param_fetch.t
t/popup_menu.t
t/pretty.t
t/push.t
@@ -64,6 +66,7 @@ t/start_end_asterisk.t
t/start_end_end.t
t/start_end_start.t
t/switch.t
+t/tmpfile.t
t/unescapeHTML.t
t/upload.t
t/upload_post_text.txt
View
52 README
@@ -1,7 +1,6 @@
WHAT IS THIS?
-This is CGI.pm, an easy-to-use Perl5 library for writing World
-Wide Web CGI scripts.
+This is CGI.pm, an easy-to-use Perl5 library for writing CGI scripts.
HOW DO I INSTALL IT?
@@ -13,62 +12,31 @@ file and type the following:
make test
make install
-If this doesn't work for you, try:
-
- cp lib/CGI.pm /usr/local/lib/perl5
-
-If you have trouble installing CGI.pm because you have insufficient
-access privileges to add to the perl library directory, you can still
-use CGI.pm. See the docs for details.
-
WHAT SYSTEMS DOES IT WORK WITH?
-This module works with NT, Windows, Macintosh, OS/2 and VMS servers,
-although it hasn't been tested as extensively as it should be. See
-the docs for notes on your particular platform.
+This module works with Linux, Windows, OSX, FreeBSD, VMS and other platforms.
WHERE IS THE DOCUMENTATION?
Documentation is found in POD (plain old documentation) form in CGI.pm
-itself. When you install CGI, the MakeMaker program will
-automatically install the manual pages for you (on Unix systems, type
-"man CGI").
+itself. When you install CGI, manaul pages will automatically be installed.
+on Unix systems, type "man CGI" or "perldoc CGI").
WHERE ARE THE EXAMPLES?
-A collection of examples demonstrating various CGI features and
-techniques are in the directory "examples".
+A collection of examples demonstrating various CGI features and techniques are
+in the directory "examples". These are now rather old examples of Perl code and
+should not be considered as best practices.
WHERE IS THE ONLINE DOCUMENTATION?
Online documentation of for CGI.pm, and notifications of new versions
can be found at:
- http://search.cpan.org/~lds/
+ http://search.cpan.org/dist/CGI.pm/
WHERE CAN I LEARN MORE?
-I have written a book about CGI.pm called "The Official Guide to
+Lincoln Stein wrote a book about CGI.pm called "The Official Guide to
Programming with CGI.pm" which was published by John Wiley & Sons in
-May 1998. If you like CGI.pm, you'll love this book.
-
-IMPORTANT NOTES:
-
-Version 2.69 emits XHTML by default. To get the old behavior, use the
--no_xhtml pragma.
-
-Versions 2.44-2.46 introduce two API changes that will affect
-users of previous versions:
-
-1) The accept() function has been renamed Accept() to avoid conflicting with
-Perl's built-in function of the same name.
-
-2) The sub() function has been renamed Sub() for similar reasons.
-
-My apologies for these changes, but they were necessary in order for
-CGI to pass the perl5.005 regression tests!
-
-Have fun, and let me know how it turns out!
-
-Lincoln D. Stein
-lstein@cshl.org
+May 1998.
View
253 cgi-lib_porting.html
@@ -1,253 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html> <head>
-<title>Porting cgi-lib.pl Scripts to CGI.pm</title>
-</head>
-
-<body>
-<h1>Porting cgi-lib.pl Scripts to CGI.pm</h1>
-
-Steve Brenner, author of cgi-lib.pl, recently asked me to prepare a
-document that compares <a
-href="http://www.bio.cam.ac.uk/web/form.html">cgi-lib.pl</a> to <a
-href="cgi_docs.html">CGI.pm</a> and to give some advice for people
-wishing to port scripts from one to the other.
-
-<p>
-
-I heartily endorse cgi-lib.pl for people who have good reasons for
-sticking with Perl version 4. However, sites that use Perl 5.001 and
-higher should seriously consider switching to CGI.pm or to the CGI::*
-modules. Here are some reasons why.
-
-<h2>Why use CGI.pm instead of cgi-lib.pl?</h2>
-
-At their core, both cgi-lib.pl and CGI.pm provide convenient ways to
-get at CGI query strings. There are a number of reasons to use CGI.pm
-in preference to cgi-lib.pl.
-
-<dl>
- <dt>CGI.pm provides better support for multi-valued parameters.
- <dd>Named parameters that correspond to checkboxes and selection
- lists are frequently multi-valued. With cgi-lib.pl, you must
- manually split the components with split() or (in version 2.0)
- with SplitParam():
- <blockquote><pre>
- @players=split("\0",$in{'players'});
- </pre></blockquote>
- With CGI.pm, you retrieve single or multi-valued parameters
- with the same syntax:
- <blockquote><pre>
- @players=param('players');
- </pre></blockquote>
- <p>
- <dt>CGI.pm provides a more elegant interface to file uploads.
- <dd>In cgi-lib.pl you have to anticipate in advance how large
- Netscape file uploads may be and select whether the file is to
- be read into main memory or spooled to disk. CGI.pm
- provides you with a variable that you can treat as a scalar to
- recover the original file name, or as a file handle that you can
- read from just as if you were reading the original file. You
- don't have to worry about spooling issues:
- <blockquote><pre>
- $in_file = param('file_to_upload');
- while (<$in_file>) {
- $lineCount++;
- }
- </pre></blockquote>
- <p>
- <dt>CGI.pm gives you lots of HTML and HTTP shortcuts.
- <dd>CGI.pm includes methods that generate HTTP headers,
- redirection requests, and HTML tags (including
- the Netscape extensions). These features are not included in
- cgi-lib.pl
- <p>
- <dt>CGI.pm provides a simple way of creating "sticky" forms and
- maintaining state.
- <dd>Among the HTML tag-generating shortcuts are methods for
- generating the elements of fill-out forms. By default, these
- methods use the current query string to initialize the form
- element contents. This gives you a simple mechanism for saving
- the state of a session, and has the nice side effect that the
- form doesn't revert back to its initial state every time you
- regenerate it. Other methods in CGI.pm allow you to save
- state in URLs, write the state out to a file, or even store the
- session state in an external database.
- <p>
- <dt>CGI.pm gives you access to advanced HTTP and HTML features.
- <dd>Support for persistent cookies, Netscape frames and JavaScript
- is built into the module, along with some of the more esoteric
- HTTP features such as content negotiation.
-</dl>
-
-<h2>Reasons not to migrate to CGI.pm</h2>
-
-The main difference is performance. On a Pentium 90 system running
-Linux, cgi-lib.pl takes 0.11 seconds to load. CGI.pm takes 0.21
-seconds. If that tenth of a second matters to you, then you should
-continue to use cgi-lib.pl.
-
-<h2>How do I migrate from cgi-lib.pl to CGI.pm?</h2>
-
-A compatability mode allows you to port most scripts that use
-cgi-lib.pl to CGI.pm without making extensive source code changes.
-Most of the functions defined in cgi-lib.pl version 2.10 are available
-for your use. Missing functions are easy to work around. Follow this
-model:
-
-<h3>Old Script</h3>
-<blockquote>
-<pre>
-require "cgi-lib.pl";
-&ReadParse;
-print "The price of your purchase is $in{price}.\n";
-</pre>
-</blockquote>
-
-<h3>New Script</h3>
-<blockquote>
-<pre>
-use CGI qw(:cgi-lib);
-&ReadParse;
-print "The price of your purchase is $in{price}.\n";
-</pre>
-</blockquote>
-
-In most cases the only change you'll need to make is the
-<cite>require</cite> line. The line
-
-<blockquote><pre>
-use CGI qw(:cgi-lib);
-</pre></blockquote>
-
-instructs Perl to read in CGI.pm and to import into your script's name
-space the cgi-lib.pl compatability routines. (In case you've never
-run into this syntax before, the colon in front of
-<code>cgi-lib</code> indicates that we're importing a family of
-routines identified by the tag <cite>cgi-lib</cite> rather than a
-single routine.) The main routine that is imported is
-<cite>ReadParse</cite>, which behaves in exactly the same way as
-cgi-lib.pl's. You can call it without any parameters, in which case
-it will place the query string in the associative array
-<code>%in</code>, or pass it the name of the associative array that
-you want to use:
-
-<blockquote>
-<pre>
-ReadParse(*Query);
-@partners = split("\0",$Query{'golf_partners'});
-</pre>
-</blockquote>
-
-CGI.pm is object-oriented, meaning that the parsed query string is
-stored inside a "CGI" object. When you use ReadParse(), a default CGI
-object is created: behind the scenes access to the <code>%in</code>
-associative array is actually reading and writing its values to the
-CGI object. You can get direct access to the underlying object by
-using the special key 'CGI':
-
-<blockquote>
-<pre>
-&ReadParse;
-print "The price of your purchase is $in{price}.\n";
-$q = $in{CGI};
-print $q->textfield(-name=&gt;'price',
- -default=&gt;'$1.99');
-</pre>
-</blockquote>
-
-This allows you to start taking advantage of the CGI.pm features
-without scouring your code for all the places where you used the
-cgi-lib.pl <code>%in</code> variable. An even simpler way to mix
-cgi-lib calls with CGI.pm calls is to import both the
-<cite>:cgi-lib</cite> and <cite>:standard</cite> method:
-
-<blockquote>
-<pre>
-use CGI qw(:cgi-lib :standard);
-&ReadParse;
-print "The price of your purchase is $in{price}.\n";
-print textfield(-name=&gt;'price',
- -default=&gt;'$1.99');
-</pre>
-</blockquote>
-
-<h2>Cgi-lib functions that are available in CGI.pm</h2>
-
-In compatability mode, the following cgi-lib.pl functions are
-available for your use:
-
-<ol>
- <li>ReadParse()
- <li>PrintHeader()
- <li>HtmlTop()
- <li>HtmlBot()
- <li>SplitParam()
- <li>MethGet()
- <li>MethPost()
-</ol>
-
-<h2>Cgi-lib functions that are not available in CGI.pm</h2>
-
-<dl>
- <dt>Extended form of ReadParse()
- <dd>The extended form of ReadParse() that provides for file upload
- spooling, is not available. However you can read the contents
- of the file directly from %in as follows:
- <blockquote><pre>
- print "The name of the file is $in{uploaded_file};
- while (<$in{uploaded_file}>) {
- print "Next line = $_";
- }
- </pre></blockquote>
- <p>
- <dt>MyBaseURL()
- <dd>This function is not available. Use CGI.pm's url() method instead.
- <p>
- <dt>MyFullURL()
- <dd>This function is not available. Use CGI.pm's self_url() method
- instead.
- <p>
- <dt>CgiError(), CgiDie()
- <dd>These functions are not supported. Look at CGI::Carp for the way I
- prefer to handle error messages.
- <p>
- <dt>PrintVariables()
- <dd>This function is not available. To achieve the same effect,
- just print out the CGI object:
- <blockquote><pre>
- use CGI qw(:standard);
- $q = new CGI;
- print h1("The Variables Are"),$q;
- </pre></blockquote>
- <p>
- <dt>PrintEnv()
- <dd>This function is not available. You'll have to roll your own if
- you really need it.
- <p>
- <dt>@in not supported
- <dd>The original ReadParse() stores the individual elements of the
- query string in an array named <code>@in</code>. This rarely-
- used feature is not supported. To retrieve the keywords from an
- oldstyle &lt;ISINDEX&gt; search, fetch the special array key
- <cite>keywords</cite>:
- <blockquote><pre>
- @keywords = SplitParam($in{'keywords'});
- </pre></blockquote>
-</dl>
-
-<h2>Caveats</h2>
-
-The compatability routines are a recent feature (added in CGI.pm
-version 2.20, released on May 22, 1996) and may contain bugs.
-<strong>Caveat emptor!</strong>
-<hr>
-
-<a href="cgi_docs.html">CGI.pm Documentation</a>
-
-<hr>
-<address>Lincoln D. Stein, lstein@genome.wi.mit.edu<br>
-<a href="/">Whitehead Institute/MIT Center for Genome Research</a></address>
-<!-- hhmts start -->
-Last modified: Wed May 22 23:33:25 EDT 1996
-<!-- hhmts end -->
-</body> </html>
View
106 lib/CGI.pm
@@ -1563,7 +1563,7 @@ sub header {
$header =~ s/$CRLF(\s)/$1/g;
# All other uses of newlines are invalid input.
- if ($header =~ m/$CRLF/) {
+ if ($header =~ m/$CRLF|\015|\012/) {
# shorten very long values in the diagnostic
$header = substr($header,0,72).'...' if (length $header > 72);
die "Invalid header value contains a newline not followed by whitespace: $header";
@@ -1870,20 +1870,20 @@ sub _script {
my (@scripts) = ref($script) eq 'ARRAY' ? @$script : ($script);
for $script (@scripts) {
- my($src,$code,$language);
- if (ref($script)) { # script is a hash
- ($src,$code,$type) =
- rearrange(['SRC','CODE',['LANGUAGE','TYPE']],
- '-foo'=>'bar', # a trick to allow the '-' to be omitted
- ref($script) eq 'ARRAY' ? @$script : %$script);
+ my($src,$code,$language,$charset);
+ if (ref($script)) { # script is a hash
+ ($src,$code,$type,$charset) =
+ rearrange(['SRC','CODE',['LANGUAGE','TYPE'],'CHARSET'],
+ '-foo'=>'bar', # a trick to allow the '-' to be omitted
+ ref($script) eq 'ARRAY' ? @$script : %$script);
$type ||= 'text/javascript';
unless ($type =~ m!\w+/\w+!) {
$type =~ s/[\d.]+$//;
$type = "text/$type";
}
- } else {
- ($src,$code,$type) = ('',$script, 'text/javascript');
- }
+ } else {
+ ($src,$code,$type,$charset) = ('',$script, 'text/javascript', '');
+ }
my $comment = '//'; # javascript by default
$comment = '#' if $type=~/perl|tcl/i;
@@ -1901,6 +1901,7 @@ sub _script {
my(@satts);
push(@satts,'src'=>$src) if $src;
push(@satts,'type'=>$type);
+ push(@satts,'charset'=>$charset) if ($src && $charset);
$code = $cdata_start . $code . $cdata_end if defined $code;
push(@result,$self->script({@satts},$code || ''));
}
@@ -3647,7 +3648,7 @@ sub read_multipart {
last if defined($filehandle = Fh->new($filename,$tmp,$PRIVATE_TEMPFILES));
$seqno += int rand(100);
}
- die "CGI open of tmpfile: $!\n" unless defined $filehandle;
+ die "CGI.pm open of tmpfile $tmp/$filename failed: $!\n" unless defined $filehandle;
$CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode
&& defined fileno($filehandle);
@@ -4282,7 +4283,10 @@ $AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
sub new {
my($package,$sequence) = @_;
my $filename;
- find_tempdir() unless -w $TMPDIRECTORY;
+ unless (-w $TMPDIRECTORY) {
+ $TMPDIRECTORY = undef;
+ find_tempdir();
+ }
for (my $i = 0; $i < $MAXTRIES; $i++) {
last if ! -f ($filename = sprintf("\%s${SL}CGItemp%d", $TMPDIRECTORY, $sequence++));
}
@@ -5140,8 +5144,7 @@ file is created with mode 0600 (neither world nor group readable).
The temporary directory is selected using the following algorithm:
- 1. if the current user (e.g. "nobody") has a directory named
- "tmp" in its home directory, use that (Unix systems only).
+ 1. if $CGITempFile::TMPDIRECTORY is already set, use that
2. if the environment variable TMPDIR exists, use the location
indicated.
@@ -5509,12 +5512,10 @@ Use the B<-noScript> parameter to pass some HTML text that will be displayed on
browsers that do not have JavaScript (or browsers where JavaScript is turned
off).
-The <script> tag, has several attributes including "type" and src.
-The latter is particularly interesting, as it allows you to keep the
-JavaScript code in a file or CGI script rather than cluttering up each
-page with the source. To use these attributes pass a HASH reference
-in the B<-script> parameter containing one or more of -type, -src, or
--code:
+The <script> tag, has several attributes including "type", "charset" and "src".
+"src" allows you to keep JavaScript code in an external file. To use these
+attributes pass a HASH reference in the B<-script> parameter containing one or
+more of -type, -src, or -code:
print $q->start_html(-title=>'The Riddle of the Sphinx',
-script=>{-type=>'JAVASCRIPT',
@@ -5695,14 +5696,8 @@ method, the results will not be what you expect.
=head1 CREATING STANDARD HTML ELEMENTS:
-CGI.pm defines general HTML shortcut methods for most, if not all of
-the HTML 3 and HTML 4 tags. HTML shortcuts are named after a single
-HTML element and return a fragment of HTML text that you can then
-print or manipulate as you like. Each shortcut returns a fragment of
-HTML code that you can append to a string, save to a file, or, most
-commonly, print out so that it displays in the browser window.
-
-This example shows how to use the HTML methods:
+CGI.pm defines general HTML shortcut methods for many HTML tags. HTML shortcuts are named after a single
+HTML element and return a fragment of HTML text. Example:
print $q->blockquote(
"Many years ago on the island of",
@@ -7948,19 +7943,68 @@ NEW VERSION
CGI.pm's ReadParse() routine creates a tied variable named %in,
which can be accessed to obtain the query variables. Like
ReadParse, you can also provide your own variable. Infrequently
-used features of ReadParse, such as the creation of @in and $in
+used features of ReadParse, such as the creation of @in and $in
variables, are not supported.
Once you use ReadParse, you can retrieve the query object itself
this way:
$q = $in{CGI};
- print textfield(-name=>'wow',
- -value=>'does this really work?');
+ print $q->textfield(-name=>'wow',
+ -value=>'does this really work?');
This allows you to start using the more interesting features
of CGI.pm without rewriting your old scripts from scratch.
+An even simpler way to mix cgi-lib calls with CGI.pm calls is to import both the
+C<:cgi-lib> and C<:standard> method:
+
+ use CGI qw(:cgi-lib :standard);
+ &ReadParse;
+ print "The price of your purchase is $in{price}.\n";
+ print textfield(-name=>'price', -default=>'$1.99');
+
+=head2 Cgi-lib functions that are available in CGI.pm
+
+In compatability mode, the following cgi-lib.pl functions are
+available for your use:
+
+ ReadParse()
+ PrintHeader()
+ HtmlTop()
+ HtmlBot()
+ SplitParam()
+ MethGet()
+ MethPost()
+
+=head2 Cgi-lib functions that are not available in CGI.pm
+
+ * Extended form of ReadParse()
+ The extended form of ReadParse() that provides for file upload
+ spooling, is not available.
+
+ * MyBaseURL()
+ This function is not available. Use CGI.pm's url() method instead.
+
+ * MyFullURL()
+ This function is not available. Use CGI.pm's self_url() method
+ instead.
+
+ * CgiError(), CgiDie()
+ These functions are not supported. Look at CGI::Carp for the way I
+ prefer to handle error messages.
+
+ * PrintVariables()
+ This function is not available. To achieve the same effect,
+ just print out the CGI object:
+
+ use CGI qw(:standard);
+ $q = CGI->new;
+ print h1("The Variables Are"),$q;
+
+ * PrintEnv()
+ This function is not available. You'll have to roll your own if you really need it.
+
=head1 AUTHOR INFORMATION
The CGI.pm distribution is copyright 1995-2007, Lincoln D. Stein. It is
View
41 lib/CGI/Carp.pm
@@ -116,7 +116,7 @@ occur in the early compile phase will be seen.
Nonfatal errors will still be directed to the log file only (unless redirected
with carpout).
-Note that fatalsToBrowser does B<not> work with mod_perl version 2.0
+Note that fatalsToBrowser may B<not> work well with mod_perl version 2.0
and higher.
=head2 Changing the default message
@@ -183,6 +183,28 @@ attempting to set SIG{__DIE__} yourself, you may interfere with
this module's functionality, or this module may interfere with
your module's functionality.
+=head2 SUPPRESSING PERL ERRORS APPEARING IN THE BROWSER WINDOW
+
+A problem sometimes encountered when using fatalsToBrowser is
+when a C<die()> is done inside an C<eval> body or expression.
+Even though the
+fatalsToBrower support takes precautions to avoid this,
+you still may get the error message printed to STDOUT.
+This may have some undesireable effects when the purpose of doing the
+eval is to determine which of several algorithms is to be used.
+
+By setting C<$CGI::Carp::TO_BROWSER> to 0 you can suppress printing the C<die> messages
+but without all of the complexity of using C<set_die_handler>.
+You can localize this effect to inside C<eval> bodies if this is desireable:
+For example:
+
+ eval {
+ local $CGI::Carp::TO_BROWSER = 0;
+ die "Fatal error messages not sent browser"
+ }
+ # $@ will contain error message
+
+
=head1 MAKING WARNINGS APPEAR AS HTML COMMENTS
It is now also possible to make non-fatal errors appear as HTML
@@ -245,6 +267,8 @@ non-overridden program name
=head1 CHANGE LOG
+3.51 Added $CGI::Carp::TO_BROWSER
+
1.29 Patch from Peter Whaite to fix the unfixable problem of CGI::Carp
not behaving correctly in an eval() context.
@@ -321,9 +345,10 @@ use File::Spec;
$main::SIG{__WARN__}=\&CGI::Carp::warn;
-$CGI::Carp::VERSION = '3.45';
+$CGI::Carp::VERSION = '3.51';
$CGI::Carp::CUSTOM_MSG = undef;
$CGI::Carp::DIE_HANDLER = undef;
+$CGI::Carp::TO_BROWSER = 1;
# fancy import routine detects and handles 'errorWrap' specially.
@@ -421,23 +446,27 @@ sub ineval {
}
sub die {
- my ($arg,@rest) = @_;
+ # if no argument is passed, propagate $@ like
+ # the real die
+ my ($arg,@rest) = @_ ? @_
+ : $@ ? "$@\t...propagated"
+ : "Died"
+ ;
&$DIE_HANDLER($arg,@rest) if $DIE_HANDLER;
+ # the "$arg" is done on purpose!
# if called as die( $object, 'string' ),
# all is stringified, just like with
# the real 'die'
$arg = join '' => "$arg", @rest if @rest;
- $arg ||= 'Died';
-
my($file,$line,$id) = id(1);
$arg .= " at $file line $line.\n" unless ref $arg or $arg=~/\n$/;
realdie $arg if ineval();
- &fatalsToBrowser($arg) if $WRAP;
+ &fatalsToBrowser($arg) if ($WRAP and $CGI::Carp::TO_BROWSER);
$arg=~s/^/ stamp() /gme if $arg =~ /\n$/ or not exists $ENV{MOD_PERL};
View
31 t/carp.t
@@ -1,12 +1,12 @@
# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 2 -*-
-#!/usr/local/bin/perl -w
+#!perl -w
use strict;
-use Test::More tests => 59;
+use Test::More tests => 61;
use IO::Handle;
-BEGIN { use_ok('CGI::Carp') };
+use CGI::Carp;
#-----------------------------------------------------------------------------
# Test id
@@ -337,9 +337,14 @@ ok(!defined buffer("WIBBLE"), '"WIBBLE" doesn\'t returns proper filehandle'
CGI::Carp::die( My::Stringified::Object->new );
$result{string_object} .= $_ while <STDOUT>;
+ undef $@;
CGI::Carp::die();
$result{no_args} .= $_ while <STDOUT>;
+ $@ = "I think I caught a virus";
+ CGI::Carp::die();
+ $result{propagated} .= $_ while <STDOUT>;
+
untie *STDOUT;
like $result{string} => qr/regular string/, 'regular string, wrapped';
@@ -352,6 +357,9 @@ ok(!defined buffer("WIBBLE"), '"WIBBLE" doesn\'t returns proper filehandle'
'stringified object, wrapped';
like $result{no_args} => qr/Died at/, 'no args, wrapped';
+ like $result{propagated} => qr/I think I caught a virus\t\.{3}propagated/,
+ 'propagating $@ if no argument';
+
}
{
@@ -371,3 +379,20 @@ ok(!defined buffer("WIBBLE"), '"WIBBLE" doesn\'t returns proper filehandle'
return bless {}, shift;
}
}
+
+
+@result = ();
+tie *STDOUT, 'StoreStuff' or die "Can't tie STDOUT";
+ {
+ eval {
+ $CGI::Carp::TO_BROWSER = 0;
+ die 'Message ToBrowser = 0';
+ };
+ $result[0] = $@;
+ $result[1] .= $_ while (<STDOUT>);
+ }
+untie *STDOUT;
+
+ like $result[0] => qr/Message ToBrowser/, 'die message for ToBrowser = 0 is OK';
+ ok !$result[1], 'No output for ToBrowser = 0';
+
View
27 t/headers.t
@@ -16,29 +16,32 @@ my $cgi = CGI->new;
like $cgi->header( -type => "text/html" ),
qr#Type: text/html#, 'known header, basic case: type => "text/html"';
-eval { like $cgi->header( -type => "text/html".$CGI::CRLF."evil: stuff" ),
- qr#Type: text/html evil: stuff#, 'known header'; };
+eval { $cgi->header( -type => "text/html".$CGI::CRLF."evil: stuff" ) };
like($@,qr/contains a newline/,'invalid header blows up');
like $cgi->header( -type => "text/html".$CGI::CRLF." evil: stuff " ),
qr#Content-Type: text/html evil: stuff#, 'known header, with leading and trailing whitespace on the continuation line';
-eval { like $cgi->header( -foobar => "text/html".$CGI::CRLF."evil: stuff" ),
- qr#Foobar: text/htmlevil: stuff#, 'unknown header'; };
+eval { $cgi->header( -foobar => "text/html".$CGI::CRLF."evil: stuff" ) };
like($@,qr/contains a newline/,'unknown header with CRLF embedded blows up');
-like $cgi->header( -foobar => "Content-type: evil/header" ),
- qr#^Foobar: Content-type: evil/header#m, 'unknown header with leading newlines';
+eval { $cgi->header( -foobar => $CGI::CRLF."Content-type: evil/header" ) };
+like($@,qr/contains a newline/, 'unknown header with leading newlines blows up');
-eval { like $cgi->redirect( -type => "text/html".$CGI::CRLF."evil: stuff" ),
- qr#Type: text/htmlevil: stuff#, 'redirect w/ known header'; };
+eval { $cgi->redirect( -type => "text/html".$CGI::CRLF."evil: stuff" ) };
like($@,qr/contains a newline/,'redirect with known header with CRLF embedded blows up');
-eval { like $cgi->redirect( -foobar => "text/html".$CGI::CRLF."evil: stuff" ),
- qr#Foobar: text/htmlevil: stuff#, 'redirect w/ unknown header'; };
+eval { $cgi->redirect( -foobar => "text/html".$CGI::CRLF."evil: stuff" ) };
like($@,qr/contains a newline/,'redirect with unknown header with CRLF embedded blows up');
-eval { like $cgi->redirect( $CGI::CRLF.$CGI::CRLF."Content-Type: text/html"),
- qr#Location: Content-Type#, 'redirect w/ leading newline '; };
+eval { $cgi->redirect( $CGI::CRLF.$CGI::CRLF."Content-Type: text/html") };
like($@,qr/contains a newline/,'redirect with leading newlines blows up');
+{
+ my $cgi = CGI->new('t=bogus%0A%0A<html>');
+ my $out;
+ eval { $out = $cgi->redirect( $cgi->param('t') ) };
+ like($@,qr/contains a newline/, "redirect does not allow double-newline injection");
+}
+
+
View
6 t/html.t
@@ -88,13 +88,17 @@ is start_html(), <<END, "start_html()";
<body>
END
-is start_html( -Title => 'The world of foo' ), <<END, "start_html()";
+is start_html(
+ -Title => 'The world of foo' ,
+ -Script => [ {-src=> 'foo.js', -charset=>'utf-8'} ],
+ ), <<END, "start_html()";
<!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
<head>
<title>The world of foo</title>
+<script src="foo.js" charset="utf-8" type="text/javascript"></script>
<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
</head>
<body>

0 comments on commit b03599f

Please sign in to comment.
Something went wrong with that request. Please try again.