r23879 - in /branches/upstream/libcgi-pm-perl/current: CGI.pm CGI/Fast.pm Changes META.yml Makefile.PL t/request.t

ansgar-guest at users.alioth.debian.org ansgar-guest at users.alioth.debian.org
Thu Aug 7 11:10:34 UTC 2008


Author: ansgar-guest
Date: Thu Aug  7 11:10:32 2008
New Revision: 23879

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=23879
Log:
[svn-upgrade] Integrating new upstream version, libcgi-pm-perl (3.40)

Modified:
    branches/upstream/libcgi-pm-perl/current/CGI.pm
    branches/upstream/libcgi-pm-perl/current/CGI/Fast.pm
    branches/upstream/libcgi-pm-perl/current/Changes
    branches/upstream/libcgi-pm-perl/current/META.yml
    branches/upstream/libcgi-pm-perl/current/Makefile.PL
    branches/upstream/libcgi-pm-perl/current/t/request.t

Modified: branches/upstream/libcgi-pm-perl/current/CGI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/CGI.pm?rev=23879&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/CGI.pm (original)
+++ branches/upstream/libcgi-pm-perl/current/CGI.pm Thu Aug  7 11:10:32 2008
@@ -18,8 +18,8 @@
 # The most recent version and complete docs are available at:
 #   http://stein.cshl.org/WWW/software/CGI/
 
-$CGI::revision = '$Id: CGI.pm,v 1.254 2008/06/25 14:52:19 lstein Exp $';
-$CGI::VERSION='3.38';
+$CGI::revision = '$Id: CGI.pm,v 1.257 2008/08/06 14:01:06 lstein Exp $';
+$CGI::VERSION='3.40';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -1176,7 +1176,7 @@
 
 'EXISTS' => <<'END_OF_FUNC',
 sub EXISTS {
-    exists $_[0]->{$_[1]};
+    exists $_[0]->{param}{$_[1]};
 }
 END_OF_FUNC
 
@@ -2849,30 +2849,58 @@
 }
 END_OF_FUNC
 
-# WE USE THIS TO COMPENSATE FOR A BUG IN APACHE 2 PRESENT AT LEAST UP THROUGH 2.0.54
+# This function returns a potentially modified version of SCRIPT_NAME
+# and PATH_INFO. Some HTTP servers do sanitise the paths in those
+# variables. It is the case of at least Apache 2. If for instance the
+# user requests: /path/./to/script.cgi/x//y/z/../x?y, Apache will set:
+# REQUEST_URI=/path/./to/script.cgi/x//y/z/../x?y
+# SCRIPT_NAME=/path/to/env.cgi
+# PATH_INFO=/x/y/x
+#
+# This is all fine except that some bogus CGI scripts expect
+# PATH_INFO=/http://foo when the user requests
+# http://xxx/script.cgi/http://foo
+#
+# Old versions of this module used to accomodate with those scripts, so
+# this is why we do this here to keep those scripts backward compatible.
+# Basically, we accomodate with those scripts but within limits, that is
+# we only try to preserve the number of / that were provided by the user
+# if $REQUEST_URI and "$SCRIPT_NAME$PATH_INFO" only differ by the number
+# of consecutive /.
+#
+# So for instance, in: http://foo/x//y/script.cgi/a//b, we'll return a
+# script_name of /x//y/script.cgi and a path_info of /a//b, but in:
+# http://foo/./x//z/script.cgi/a/../b//c, we'll return the versions
+# possibly sanitised by the HTTP server, so in the case of Apache 2:
+# script_name == /foo/x/z/script.cgi and path_info == /b/c.
+#
+# Future versions of this module may no longer do that, so one should
+# avoid relying on the browser, proxy, server, and CGI.pm preserving the
+# number of consecutive slashes as no guarantee can be made there.
 '_name_and_path_from_env' => <<'END_OF_FUNC',
 sub _name_and_path_from_env {
-   my $self = shift;
-   my $raw_script_name = $ENV{SCRIPT_NAME} || '';
-   my $raw_path_info   = $ENV{PATH_INFO}   || '';
-   my $uri             = unescape($self->request_uri) || '';
-
-   my $protected    = quotemeta($raw_path_info);
-   $raw_script_name =~ s/$protected$//;
-
-   my @uri_double_slashes  = $uri =~ m^(/{2,}?)^g;
-   my @path_double_slashes = "$raw_script_name $raw_path_info" =~ m^(/{2,}?)^g;
-
-   my $apache_bug      = @uri_double_slashes != @path_double_slashes;
-   return ($raw_script_name,$raw_path_info) unless $apache_bug;
-
-   my $path_info_search = quotemeta($raw_path_info);
-   $path_info_search    =~ s!/!/+!g;
-   if ($uri =~ m/^(.+)($path_info_search)/) {
-       return ($1,$2);
-   } else {
-       return ($raw_script_name,$raw_path_info);
-   }
+    my $self = shift;
+    my $script_name = $ENV{SCRIPT_NAME}  || '';
+    my $path_info   = $ENV{PATH_INFO}    || '';
+    my $uri         = $self->request_uri || '';
+
+    $uri =~ s/\?.*//s;
+    $uri = unescape($uri);
+
+    if ($uri ne "$script_name$path_info") {
+        my $script_name_pattern = quotemeta($script_name);
+        my $path_info_pattern = quotemeta($path_info);
+        $script_name_pattern =~ s{(?:\\/)+}{/+}g;
+        $path_info_pattern =~ s{(?:\\/)+}{/+}g;
+
+        if ($uri =~ /^($script_name_pattern)($path_info_pattern)$/s) {
+            # REQUEST_URI and SCRIPT_NAME . PATH_INFO only differ by the
+            # numer of consecutive slashes, so we can extract the info from
+            # REQUEST_URI:
+            ($script_name, $path_info) = ($1, $2);
+        }
+    }
+    return ($script_name,$path_info);
 }
 END_OF_FUNC
 

Modified: branches/upstream/libcgi-pm-perl/current/CGI/Fast.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/CGI/Fast.pm?rev=23879&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/CGI/Fast.pm (original)
+++ branches/upstream/libcgi-pm-perl/current/CGI/Fast.pm Thu Aug  7 11:10:32 2008
@@ -82,18 +82,17 @@
 
 =head1 DESCRIPTION
 
-CGI::Fast is a subclass of the CGI object created by
-CGI.pm.  It is specialized to work well with the Open Market
-FastCGI standard, which greatly speeds up CGI scripts by
-turning them into persistently running server processes.  Scripts
-that perform time-consuming initialization processes, such as
-loading large modules or opening persistent database connections,
-will see large performance improvements.
+CGI::Fast is a subclass of the CGI object created by CGI.pm.  It is
+specialized to work well FCGI module, which greatly speeds up CGI
+scripts by turning them into persistently running server processes.
+Scripts that perform time-consuming initialization processes, such as
+loading large modules or opening persistent database connections, will
+see large performance improvements.
 
 =head1 OTHER PIECES OF THE PUZZLE
 
-In order to use CGI::Fast you'll need a FastCGI-enabled Web
-server. See http://www.fastcgi.com/ for details.
+In order to use CGI::Fast you'll need the FCGI module.  See
+http://www.cpan.org/ for details.
 
 =head1 WRITING FASTCGI PERL SCRIPTS
 
@@ -106,7 +105,7 @@
 
 A typical FastCGI script will look like this:
 
-    #!/usr/local/bin/perl    # must be a FastCGI version of perl!
+    #!/usr/bin/perl
     use CGI::Fast;
     &do_some_initialization();
     while ($q = new CGI::Fast) {

Modified: branches/upstream/libcgi-pm-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/Changes?rev=23879&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/Changes (original)
+++ branches/upstream/libcgi-pm-perl/current/Changes Thu Aug  7 11:10:32 2008
@@ -1,3 +1,12 @@
+  Version 3.40
+  1. Fixed CGI::Fast docs to eliminate references to a "special"
+  version of Perl.
+  2. Makefile.PL now depends on FCGI so that CGI::Fast installs properly.
+  3. Fix script_name() call from Stephane Chazelas.
+
+  Version 3.39
+  1. Fixed regression in "exists" function when using tied interface to CGI via $q->Vars.
+
   Version 3.38
   1. Fix annoying warning in http://rt.cpan.org/Ticket/Display.html?id=34551
   2. Added nobr() function http://rt.cpan.org/Ticket/Display.html?id=35377

Modified: branches/upstream/libcgi-pm-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/META.yml?rev=23879&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/META.yml (original)
+++ branches/upstream/libcgi-pm-perl/current/META.yml Thu Aug  7 11:10:32 2008
@@ -1,12 +1,13 @@
 --- #YAML:1.0
 name:                CGI.pm
-version:             3.38
+version:             3.40
 abstract:            ~
 license:             ~
 author:              ~
 generated_by:        ExtUtils::MakeMaker version 6.44
 distribution_type:   module
 requires:     
+    FCGI:                          0.67
     File::Spec:                    0.82
 meta-spec:
     url:     http://module-build.sourceforge.net/META-spec-v1.3.html

Modified: branches/upstream/libcgi-pm-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/Makefile.PL?rev=23879&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/Makefile.PL (original)
+++ branches/upstream/libcgi-pm-perl/current/Makefile.PL Thu Aug  7 11:10:32 2008
@@ -12,6 +12,7 @@
     'VERSION_FROM'   => 'CGI.pm',
      'PREREQ_PM' => {
        'File::Spec'  => .82,
+       'FCGI'        => 0.67,
     },
     'linkext'   => { LINKTYPE=>'' },	# no link needed
     'dist'      => {'COMPRESS'=>'gzip -9f', 'SUFFIX' => 'gz',

Modified: branches/upstream/libcgi-pm-perl/current/t/request.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-pm-perl/current/t/request.t?rev=23879&op=diff
==============================================================================
--- branches/upstream/libcgi-pm-perl/current/t/request.t (original)
+++ branches/upstream/libcgi-pm-perl/current/t/request.t Thu Aug  7 11:10:32 2008
@@ -4,7 +4,7 @@
 ######################### We start with some black magic to print on failure.
 use lib '.','../blib/lib','../blib/arch';
 
-BEGIN {$| = 1; print "1..33\n"; }
+BEGIN {$| = 1; print "1..34\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use CGI ();
 use Config;
@@ -74,6 +74,7 @@
 test(29,$p->{bar} eq 'froz',"tied interface fetch");
 $p->{bar} = join("\0",qw(foo bar baz));
 test(30,join(' ',$q->param('bar')) eq 'foo bar baz','tied interface store');
+test(31,exists $p->{bar});
 
 # test posting
 $q->_reset_globals;
@@ -88,11 +89,11 @@
     exit 0;
   }
   # at this point, we're in a new (child) process
-  test(31,$q=new CGI,"CGI::new() from POST");
-  test(32,$q->param('weather') eq 'nice',"CGI::param() from POST");
-  test(33,$q->url_param('big_balls') eq 'basketball',"CGI::url_param()");
+  test(32,$q=new CGI,"CGI::new() from POST");
+  test(33,$q->param('weather') eq 'nice',"CGI::param() from POST");
+  test(34,$q->url_param('big_balls') eq 'basketball',"CGI::url_param()");
 } else {
-  print "ok 31 # Skip\n";
   print "ok 32 # Skip\n";
   print "ok 33 # Skip\n";
+  print "ok 34 # Skip\n";
 }




More information about the Pkg-perl-cvs-commits mailing list