Skip Menu |
 

This queue is for tickets about the mod_perl CPAN distribution.

Report information
The Basics
Id: 31974
Status: open
Priority: 0/
Queue: mod_perl

People
Owner: Nobody in particular
Requestors: CHLIGE [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: 2.0.1
Fixed in: (no value)



Subject: Apache2::RequestRec misparses URI
Download (untitled) / with headers
text/plain 3.2k
I'm using mod_perl v2.0.1 (from FC4 rpm) and using the Apache2::RequestRec->uri truncates the URI for /nmr/admin and only for /nmr/admin (i.e. /nmr/admi and /nmr/admin2 are fine). I have gone through my Apache configuration files and I cannot find a redirector or URL rewriting statement. Attached is the code for the modules involved. [gchlip2@anabaena Apps]$ perl -v This is perl, v5.8.6 built for i386-linux-thread-multi Copyright 1987-2004, Larry Wall Perl may be copied only under the terms of either the Artistic License or the GNU General Public License, which may be found in the Perl 5 source kit. Complete documentation for Perl, including FAQ lists, should be found on this system using `man perl' or `perldoc perl'. If you have access to the Internet, point your browser at http://www.perl.org/, the Perl Home Page. [gchlip2@anabaena Apps]$ uname -a Linux anabaena 2.6.13-1.1526_FC4 #1 Wed Sep 28 19:15:10 EDT 2005 i686 i686 i386 GNU/Linux [root@anabaena httpd]# httpd -v Server version: Apache/2.0.54 Server built: Sep 2 2005 11:54:18 From httpd/error_log [Fri Dec 28 15:17:09 2007] [notice] Apache/2.0.54 (Fedora) configured -- resuming normal operations Rec Object: Apache2::RequestRec Got URI: /nmr/main For location: /nmr Unparsed URI: /nmr/main at /usr/local/http-apps/perl/Apps/Reserve.pm line 38. Rec Object: Apache2::RequestRec Got URI: /nmr/main For location: /nmr Unparsed URI: /nmr/main at /usr/local/http-apps/perl/Apps/Reserve.pm line 38. Rec Object: Apache2::RequestRec Got URI: /admin For location: /nmr Unparsed URI: /nmr/admin at /usr/local/http-apps/perl/Apps/Reserve.pm line 38. Rec Object: Apache2::RequestRec Got URI: /nmr/selfadmin For location: /nmr Unparsed URI: /nmr/selfadmin at /usr/local/http-apps/perl/Apps/Reserve.pm line 38. Rec Object: Apache2::RequestRec Got URI: /nmr/selfadmin For location: /nmr Unparsed URI: /nmr/selfadmin at /usr/local/http-apps/perl/Apps/Reserve.pm line 38. Rec Object: Apache2::RequestRec Got URI: /nmr/mydata For location: /nmr Unparsed URI: /nmr/mydata at /usr/local/http-apps/perl/Apps/Reserve.pm line 38. Rec Object: Apache2::RequestRec Got URI: /nmr/mydata For location: /nmr Unparsed URI: /nmr/mydata at /usr/local/http-apps/perl/Apps/Reserve.pm line 38. Rec Object: Apache2::RequestRec Got URI: /nmr/logout For location: /nmr Unparsed URI: /nmr/logout at /usr/local/http-apps/perl/Apps/Reserve.pm line 38. Rec Object: Apache2::RequestRec Got URI: /nmr/logout For location: /nmr Unparsed URI: /nmr/logout at /usr/local/http-apps/perl/Apps/Reserve.pm line 38. Rec Object: Apache2::RequestRec Got URI: /nmr/admin2 For location: /nmr Unparsed URI: /nmr/admin2 at /usr/local/http-apps/perl/Apps/Reserve.pm line 38. Rec Object: Apache2::RequestRec Got URI: /nmr/admi For location: /nmr Unparsed URI: /nmr/admi at /usr/local/http-apps/perl/Apps/Reserve.pm line 38. [gchlip2@anabaena conf]$ ls htpasswd httpd.conf httpd.conf.bak httpd.conf.default httpd.conf.old httpd-lab.conf magic ssl.crt ssl.key workers.properties [gchlip2@anabaena conf]$ pwd /etc/httpd/conf [gchlip2@anabaena conf]$ grep Rewrite * grep: ssl.crt: Permission denied grep: ssl.key: Permission denied [gchlip2@anabaena conf]$ cd ../conf.d [gchlip2@anabaena conf.d]$ grep Rewrite * grep: README: Permission denied grep: ssl.conf.rpmnew: Permission denied [gchlip2@anabaena conf.d]$
Subject: Form.pm
Download Form.pm
text/x-perl 3.8k
package Apps::Reserve::Form; our @ISA = qw(Apps::Object); use strict vars; use Apps::Reserve::User; use Apache2::Const qw(:common); use Apps::Reserve::Form::main; use Apps::Reserve::Form::selfadmin; use Apps::Reserve::Form::mydata; use Apps::Reserve::Form::logout; use Apps::Reserve::Form::admin; sub new { my $self = {}; my $class = shift; if ( $class eq 'Apps::Reserve::Form' ) { if ( $_[0]->getMod ne '') { $class .= '::' . lc($_[0]->getMod); } else { $class .= '::main'; } } bless $self, $class; $self->_init(@_); return $self; } sub _init { my $self = shift; $self->app(shift); return; } sub user { my $self = shift; return $self->app->user; } sub login { my $self = shift; my $cgi = $self->cgi; my $user = Apps::Reserve::User->new($self->dbh, $cgi->param('username')); if ( $user->checkPassword($cgi->param('passwd')) > 0 ) { $self->session->param('user',$user->id); $self->req->user($user->id); $self->req->headers_out->set('Location' => $self->req->location); return REDIRECT; } else { my $message; if ( $cgi->param('username') ne '' ) { $message = $cgi->font({-color=>'red'}, $cgi->b('Login Failed')); } $self->req->print($self->header); $self->req->print($cgi->start_form(), $cgi->table({-align=>'center'}, $cgi->Tr([ $cgi->td({-colspan=>2, -align=>'center'}, $message), $cgi->td(['Email Address: ', $cgi->textfield(-name=>'username', -value=>$cgi->param('username'))]), $cgi->td(['Password: ', $cgi->password_field(-name=>'passwd', -value=>'')]), $cgi->td({-colspan=>2, -align=>'center'},$cgi->submit(-name=>'action', -value=>'Login')), $cgi->td({-colspan=>2, -align=>'center'},'<A HREF="selfadmin?form=reset">Reset Password</A>') ])), $cgi->end_form); $self->req->print( $self->footer ); return OK; } } sub header { my $self = shift; my $cgi = $self->cgi; my $title = ( @_ ? shift : 'Reservation system'); my @output; open HEADER, $self->config('header'); my $menu = $self->menu; while (<HEADER> ) { $_ =~ s/__RESERVE__/$menu/; push @output, $_; } close HEADER; return $cgi->start_html(-title => $title . '- Department of Medicinal Chemistry & Pharmacognosy - UIC', -encoding=>'utf-8', -style=>{'src'=>[ '/_styles/global.css', '/_styles/style_nmr.css'] }, -meta=>{'keywords' => 'NMR, UIC, College of of Pharmacy, Chicago', 'description' => 'Reservation System - Department of Medicinal Chemistry & Pharmacognosy - UIC'}), @output, $cgi->h2({-class=>'boxTitle'},$cgi->b($title)); } sub footer { my $self = shift; open FOOTER, $self->config('footer'); my @output = <FOOTER>; close FOOTER; return @output, '</HTML>'; } sub menu { my $self = shift; my $cgi = $self->cgi; my @items = ( '<LI><A HREF="main">Reservation System</A></LI>' ); if ( $self->user ) { my $user = $self->user; push @items, '<LI><A HREF="selfadmin">Update My Account</A></LI>'; if ( $user->hasRole('admin') ) { push @items, '<LI><A HREF="admin">Admin Page</A></LI>'; } push @items, '<LI><A HREF="logout">Logout</A></LI>'; } return $cgi->ul( @items ) } sub app { my $self = shift; if (ref $_[0]) { $self->{'_app'} = shift; } return $self->{'_app'}; } sub cgi { my $self = shift; return $self->app->cgi(@_); } sub dbh { my $self = shift; return $self->app->dbh(@_); } sub session { my $self = shift; return $self->app->session(@_); } sub req { my $self = shift; return $self->app->req(@_); } sub config { my $self = shift; return $self->req->dir_config(@_); } 1;
Subject: Reserve.pm
Download Reserve.pm
text/x-perl 4.6k
package Apps::Reserve; use strict vars; use Apache2::Const qw(:common); use CGI; use CGI::Cookie; use CGI::Session; use DBI; use Apps::Session; use Apps::Reserve::Form; use Apps::Reserve::User; our $VERSION = '0.5'; sub handler { my $r = shift; if ( $r->location eq $r->uri ) { $r->headers_out->set('Location' => $r->location . '/'); return REDIRECT; } my $self = Apps::Reserve->new($r); return OK if $self->error; my $form = Apps::Reserve::Form->new($self); if ( $form ) { return $form->printForm; } else { $self->req->content_type('text/plain'); return; } } sub getMod { my $self = shift; warn 'Rec Object: ', ref($self->req), ' Got URI: ', $self->req->uri, ' For location: ', $self->req->location, ' Unparsed URI: ', $self->req->unparsed_uri; my $pos = index( $self->req->uri, $self->req->location); if ( $pos < 0 ) { return; } else { my $len = length($self->req->location); my $module = $self->req->uri; substr($module, $pos, $len) = ''; $module =~ s/^\///; $module =~ s/\?.+$//; return $module; } } sub new { my $self = {}; bless $self, shift; $self->_init(@_); return $self; } sub _init { my $self = shift; $self->req(shift); $self->cgi(shift); $self->dbh(shift); $self->session()->param('last_req' => $self->req->the_request); return; } sub req { my $self = shift; if ( ref $_[0] ) { $self->{'_req'} = shift; } return $self->{'_req'}; } sub cgi { my $self = shift; if ( ref $_[0] ) { $self->{'_cgi'} = shift; } if ( exists $self->{'_cgi'} ) { return $self->{'_cgi'}; } else { $self->{'_cgi'} = CGI->new($self->req); if ( $self->req->unparsed_uri =~ /\?/ ) { use URI; use URI::QueryParam; my $uri = URI->new('http://localhost' . $self->req->unparsed_uri); my $cgi = $self->{'_cgi'}; foreach my $key ( $uri->query_param ) { $cgi->param($key, $uri->query_param($key)) if $cgi->param($key) eq ''; } } return $self->{'_cgi'}; } return; } sub dbh { my $self = shift; if ( ref $_[0] ) { $self->{'_dbh'} = shift; } if ( exists $self->{'_dbh'} ) { return $self->{'_dbh'}; } else { my $dbh = DBI->connect($self->config('DBI-URL'), $self->config('DBI-User'), $self->config('DBI-Pwd')) || $self->add_err("Connection failed: ", DBI->errstr); $self->{'_dbh'} = $dbh; return $dbh; } } sub add_err { my $self = shift; warn (@_); if ( exists $self->{'_error'} ) { push @{$self->{'_error'}}, join(' ',@_); } else { $self->{'_error'} = [ join(' ',@_) ]; } return; } sub error { my $self = shift; if ( exists $self->{'_error'} ) { my $r = $self->req; $r->content_type('text/plain'); $r->print(join("\n",@{$self->{'_error'}}), "\n"); return 1; } else { return; } } sub session { my $self = shift; my $req = $self->req; my %cookie = CGI::Cookie->parse($req->headers_in->{'Cookie'}); if ( ref $_[0] ) { $self->{'_session'} = shift; } if ( exists $self->{'_session'} ) { return $self->{'_session'}; } else { if ( exists $cookie{'SESSIONID'} ) { $self->{'_session'} = CGI::Session->new('driver:MySQL', $cookie{'SESSIONID'}->value, {Handle => $self->dbh}); } else { $self->{'_session'} = CGI::Session->new('driver:MySQL', undef, {Handle => $self->dbh}); $self->{'_session'}->expires('+1d'); my $cookie = CGI::Cookie->new('SESSIONID' => $self->{'_session'}->id); $self->req->headers_out->add('Set-Cookie' => $cookie); } if ( $self->{'_session'}->param('user') ) { $self->req->user($self->{'_session'}->param('user')); } return $self->{'_session'}; } } sub login { my $self = shift; return; } sub rc { my $self = shift; if ( @_ ) { $self->{'_rc'} = shift; } if ( exists $self->{'_rc'} ) { return $self->{'_rc'}; } else { return OK; } } sub user { my $self = shift; my $dbh = $self->dbh; if ( exists $self->{'_user'} ) { return $self->{'_user'}; } elsif ( $self->req->user ) { $self->{'_user'} = Apps::Reserve::User->new($dbh, $self->req->user); return $self->{'_user'}; } else { return; } return; } sub user_list { my $self = shift; return unless $self->user->has_role('admin'); my @users; my $sql = 'SELECT user FROM users'; foreach my $id ( @{$self->dbh->selectcol_arrayref($sql)} ) { push @users, Apps::Reserve::User->new($self->dbh, $id); } return @users; } sub session_list { my $self = shift; return unless $self->user->has_role('admin'); my @sess; my $sql = 'SELECT id FROM sessions ORDER BY id'; foreach my $id ( @{$self->dbh->selectcol_arrayref($sql)} ) { push @sess, Apps::Session->new($self->dbh, $id); } return @sess; } sub app { my $self = shift; return $self; } sub config { my $self = shift; return $self->req->dir_config(@_); } 1;
From: CHLIGE [...] cpan.org
Download (untitled) / with headers
text/plain 3.8k
Further analysis of the problem show that the URI is truncated when the CGI module is created. warn $r->unparsed_uri, ' ', $r->uri; $self->{'_cgi'} = CGI->new($self->req); warn $r->unparsed_uri, ' ', $r->uri; In error_log /nmr/admin /nmr/admin at /usr/local/http-apps/perl/Apps/Reserve.pm line 87. /nmr/admin /admin at /usr/local/http-apps/perl/Apps/Reserve.pm line 89. On Fri Dec 28 16:43:50 2007, CHLIGE wrote: Show quoted text
> I'm using mod_perl v2.0.1 (from FC4 rpm) and using the > Apache2::RequestRec->uri truncates the URI for /nmr/admin and only for > /nmr/admin (i.e. /nmr/admi and /nmr/admin2 are fine). > > I have gone through my Apache configuration files and I cannot find a > redirector or URL rewriting statement. Attached is the code for the > modules involved. > > [gchlip2@anabaena Apps]$ perl -v > > This is perl, v5.8.6 built for i386-linux-thread-multi > > Copyright 1987-2004, Larry Wall > > Perl may be copied only under the terms of either the Artistic License > or the > GNU General Public License, which may be found in the Perl 5 source kit. > > Complete documentation for Perl, including FAQ lists, should be found on > this system using `man perl' or `perldoc perl'. If you have access to the > Internet, point your browser at http://www.perl.org/, the Perl Home Page. > > [gchlip2@anabaena Apps]$ uname -a > Linux anabaena 2.6.13-1.1526_FC4 #1 Wed Sep 28 19:15:10 EDT 2005 i686 > i686 i386 GNU/Linux > [root@anabaena httpd]# httpd -v > Server version: Apache/2.0.54 > Server built: Sep 2 2005 11:54:18 > > From httpd/error_log > > [Fri Dec 28 15:17:09 2007] [notice] Apache/2.0.54 (Fedora) configured -- > resuming normal operations > Rec Object: Apache2::RequestRec Got URI: /nmr/main For location: /nmr > Unparsed URI: /nmr/main at /usr/local/http-apps/perl/Apps/Reserve.pm > line 38. > Rec Object: Apache2::RequestRec Got URI: /nmr/main For location: /nmr > Unparsed URI: /nmr/main at /usr/local/http-apps/perl/Apps/Reserve.pm > line 38. > Rec Object: Apache2::RequestRec Got URI: /admin For location: /nmr > Unparsed URI: /nmr/admin at /usr/local/http-apps/perl/Apps/Reserve.pm > line 38. > Rec Object: Apache2::RequestRec Got URI: /nmr/selfadmin For location: > /nmr Unparsed URI: /nmr/selfadmin at > /usr/local/http-apps/perl/Apps/Reserve.pm line 38. > Rec Object: Apache2::RequestRec Got URI: /nmr/selfadmin For location: > /nmr Unparsed URI: /nmr/selfadmin at > /usr/local/http-apps/perl/Apps/Reserve.pm line 38. > Rec Object: Apache2::RequestRec Got URI: /nmr/mydata For location: /nmr > Unparsed URI: /nmr/mydata at /usr/local/http-apps/perl/Apps/Reserve.pm > line 38. > Rec Object: Apache2::RequestRec Got URI: /nmr/mydata For location: /nmr > Unparsed URI: /nmr/mydata at /usr/local/http-apps/perl/Apps/Reserve.pm > line 38. > Rec Object: Apache2::RequestRec Got URI: /nmr/logout For location: /nmr > Unparsed URI: /nmr/logout at /usr/local/http-apps/perl/Apps/Reserve.pm > line 38. > Rec Object: Apache2::RequestRec Got URI: /nmr/logout For location: /nmr > Unparsed URI: /nmr/logout at /usr/local/http-apps/perl/Apps/Reserve.pm > line 38. > Rec Object: Apache2::RequestRec Got URI: /nmr/admin2 For location: /nmr > Unparsed URI: /nmr/admin2 at /usr/local/http-apps/perl/Apps/Reserve.pm > line 38. > Rec Object: Apache2::RequestRec Got URI: /nmr/admi For location: /nmr > Unparsed URI: /nmr/admi at /usr/local/http-apps/perl/Apps/Reserve.pm > line 38. > > > [gchlip2@anabaena conf]$ ls > htpasswd httpd.conf httpd.conf.bak httpd.conf.default httpd.conf.old > httpd-lab.conf magic ssl.crt ssl.key workers.properties > [gchlip2@anabaena conf]$ pwd > /etc/httpd/conf > [gchlip2@anabaena conf]$ grep Rewrite * > grep: ssl.crt: Permission denied > grep: ssl.key: Permission denied > [gchlip2@anabaena conf]$ cd ../conf.d > [gchlip2@anabaena conf.d]$ grep Rewrite * > grep: README: Permission denied > grep: ssl.conf.rpmnew: Permission denied > [gchlip2@anabaena conf.d]$ >
Can you try this with 2.04, or the 2.05 release candidate in svn?


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.