[ID 20000426.002] perl PATCH for CGI.pm: Fh package file name bug

[ The first time I sent this to perlbug - without "perl" in the subject - it
  seems to have disappeared, though "perl" was in the body. :-( ]

There is a bug in CGI that causes problems when uploading files with
unusual characters in their names, such as a single quote, or a new-
line.  This shows the problem

  perl -MCGI -e '$f = Fh->new("foo'\''bar\npop", "/tmp/foobar", 0); print $f'

which outputs

  foo::bar\
  pop

With the patch below, the correct output is

  foo'bar
  pop

In other words, the input file name should always be returned.  I'm pretty
sure that only single quotes and double colons are special to perl when
they appear in variable names, hence the patches only "escape" them.

The first patch below is for the latest CGI version, 2.66.  The second is
for CGI 2.56 in perl 5.6.0.

John.
--

*** CGI.pm.orig	Wed Apr 12 14:01:33 2000
--- CGI.pm	Wed Apr 26 11:13:02 2000
***************
*** 2895,2901 ****
      my $self = shift;
      # get rid of package name
      (my $i = $$self) =~ s/^\*(\w+::fh\d{5})+//; 
!     $i =~ s/\\(.)/$1/g;
      return $i;
  # BEGIN DEAD CODE
  # This was an extremely clever patch that allowed "use strict refs".
--- 2895,2901 ----
      my $self = shift;
      # get rid of package name
      (my $i = $$self) =~ s/^\*(\w+::fh\d{5})+//; 
!     $i =~ s/%(..)/ chr(hex($1)) /eg;
      return $i;
  # BEGIN DEAD CODE
  # This was an extremely clever patch that allowed "use strict refs".
***************
*** 2920,2926 ****
  sub new {
      my($pack,$name,$file,$delete) = @_;
      require Fcntl unless defined &Fcntl::O_RDWR;
!     my $fv = ('Fh::' .  ++$FH . quotemeta($name));
      warn unless *{$fv};
      my $ref = \*{$fv};
      sysopen($ref,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return;
--- 2920,2927 ----
  sub new {
      my($pack,$name,$file,$delete) = @_;
      require Fcntl unless defined &Fcntl::O_RDWR;
!     (my $safename = $name) =~ s/([':%])/ sprintf '%%%02X', ord $1 /eg;
!     my $fv = ('Fh::' .  ++$FH . $safename);
      warn unless *{$fv};
      my $ref = \*{$fv};
      sysopen($ref,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return;

***
*** Second patch for Perl 5.6.0
***

*** CGI.pm.orig	Thu Mar 16 21:51:27 2000
--- CGI.pm	Wed Apr 26 11:29:36 2000
***************
*** 2985,2991 ****
      my $self = shift;
      # get rid of package name
      (my $i = $$self) =~ s/^\*(\w+::fh\d{5})+//; 
!     $i =~ s/\\(.)/$1/g;
      return $i;
  # BEGIN DEAD CODE
  # This was an extremely clever patch that allowed "use strict refs".
--- 2985,2991 ----
      my $self = shift;
      # get rid of package name
      (my $i = $$self) =~ s/^\*(\w+::fh\d{5})+//; 
!     $i =~ s/%(..)/ chr(hex($1)) /eg;
      return $i;
  # BEGIN DEAD CODE
  # This was an extremely clever patch that allowed "use strict refs".
***************
*** 3010,3016 ****
  sub new {
      my($pack,$name,$file,$delete) = @_;
      require Fcntl unless defined &Fcntl::O_RDWR;
!     my $ref = \*{'Fh::' .  ++$FH . quotemeta($name)};
      sysopen($ref,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return;
      unlink($file) if $delete;
      CORE::delete $Fh::{$FH};
--- 3010,3017 ----
  sub new {
      my($pack,$name,$file,$delete) = @_;
      require Fcntl unless defined &Fcntl::O_RDWR;
!     (my $safename = $name) =~ s/([':%])/ sprintf '%%%02X', ord $1 /eg;
!     my $ref = \*{'Fh::' .  ++$FH . $safename};
      sysopen($ref,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return;
      unlink($file) if $delete;
      CORE::delete $Fh::{$FH};

• [ID 20000426.002] perl PATCH for CGI.pm: Fh package file name bug by John L. Allen