Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

PATCH for CGI.pm - Fh package file name bug #1895

Closed
p5pRT opened this issue Apr 26, 2000 · 1 comment
Closed

PATCH for CGI.pm - Fh package file name bug #1895

p5pRT opened this issue Apr 26, 2000 · 1 comment

Comments

@p5pRT
Copy link

p5pRT commented Apr 26, 2000

Migrated from rt.perl.org#3164 (status was 'resolved')

Searchable as RT3164$

@p5pRT
Copy link
Author

p5pRT commented Apr 26, 2000

From allen@grumman.com

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};

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant