I'm using Apache2::Cookie (i.e. Apache2 with mod_perl) to parse cookies.
my %cookies = Apache2::Cookie->fetch;
do_something($cookies{"cookie1"});
This code has been running in production for years without any problems. I just learned that a cookie with particular formatting causes this to throw an exception Expected token not present. The cookie in question is generated by client-side JavaScript:
document.cookie = "val=a,b"
Apache2::Cookie appears to not like the comma.
I can catch this error with eval, but the cookie retrieval is done in lots of places in the code (yes, it could have been factored out, but frankly the code is so simple there was no need). In any case, it's there now and I have to track down and catch the exception for this cookie that I didn't set and I don't need.
Is there an easier way to get rid of this exception than refactoring dozens of calls to Apache2::Cookie->fetch? Either by redefining Apache2::Cookie::fetch, or by setting a global flag for libapreq to not puke on this (there isn't any I could find), or some other bright idea I'm missing.
(yes, it could have been factored out, but frankly the code is so simple there was no need).
I would take this opportunity to fix this oversight, instead of making another
If you insist, you could learn something from CGI::Cookie
sub fetch {
my $class = shift;
my $raw_cookie = get_raw_cookie(#_) or return;
return $class->parse($raw_cookie);
}
sub get_raw_cookie {
my $r = shift;
$r ||= eval { $MOD_PERL == 2 ?
Apache2::RequestUtil->request() :
Apache->request } if $MOD_PERL;
return $r->headers_in->{'Cookie'} if $r;
die "Run $r->subprocess_env; before calling fetch()"
if $MOD_PERL and !exists $ENV{REQUEST_METHOD};
return $ENV{HTTP_COOKIE} || $ENV{COOKIE};
}
I faced the same issue and you can find the solution here :
“Expected token not present” error in my Apache log
Related
When you run perl -e "Bla->new", you get this well-known error:
Can't locate object method "new" via package "Bla"
(perhaps you forgot to load "Bla"?)
Happened in a Perl server process the other day due to an oversight of mine. There are multiple scripts, and most of them have the proper use statements in place. But there was one script that was doing Bla->new in sub blub at line 123 but missing a use Bla at the top, and when it was hit by a click without any of the other scripts using Bla having been loaded by the server process before, then bang!
Testing the script in isolation would be the obvious way to safeguard against this particular mistake, but alas the code is dependent upon a humungous environment. Do you know of another way to safeguard against this oversight?
Here's one example how PPI (despite its merits) is limited in its view on Perl:
use strict;
use HTTP::Request::Common;
my $req = GET 'http://www.example.com';
$req->headers->push_header( Bla => time );
my $au=Auweia->new;
__END__
PPI::Token::Symbol '$req'
PPI::Token::Operator '->'
PPI::Token::Word 'headers'
PPI::Token::Operator '->'
PPI::Token::Word 'push_header'
PPI::Token::Symbol '$au'
PPI::Token::Operator '='
PPI::Token::Word 'Auweia'
PPI::Token::Operator '->'
PPI::Token::Word 'new'
Setting the header and assigning the Auweia->new parse the same. So I'm not sure how you can build upon such a shaky foundation. I think the problem is that Auweia could also be a subroutine; perl.exe cannot tell until runtime.
Further Update
Okay, from #Schwern's instructive comments below I learnt that PPI is just a tokenizer, and you can build upon it if you accept its limitations.
Testing is the only answer worth the effort. If the code contains mistakes like forgetting to load a class, it probably contains other mistakes. Whatever the obstacles, make it testable. Otherwise you're patching a sieve.
That said, you have two options. You can use Class::Autouse which will try to load a module if it isn't already loaded. It's handy, but because it affects the entire process it can have unintended effects.
Or you can use PPI to scan your code and find all the class method calls. PPI::Dumper is very handy to understand how PPI sees Perl.
use strict;
use warnings;
use PPI;
use PPI::Dumper;
my $file = shift;
my $doc = PPI::Document->new($file);
# How PPI sees a class method call.
# PPI::Token::Word 'Class'
# PPI::Token::Operator '->'
# PPI::Token::Word 'method'
$doc->find( sub {
my($node, $class) = #_;
# First we want a word
return 0 unless $class->isa("PPI::Token::Word");
# It's not a class, it's actually a method call.
return 0 if $class->method_call;
my $class_name = $class->literal;
# Next to it is a -> operator
my $op = $class->snext_sibling or return 0;
return 0 unless $op->isa("PPI::Token::Operator") and $op->content eq '->';
# And then another word which PPI identifies as a method call.
my $method = $op->snext_sibling or return 0;
return 0 unless $method->isa("PPI::Token::Word") and $method->method_call;
my $method_name = $method->literal;
printf "$class->$method_name seen at %s line %d.\n", $file, $class->line_number;
});
You don't say what server enviroment you're running under, but from what you say it sounds like you could do with preloading all your modules in advance before executing any individual pages. Not only would this prevent the problems you're describing (where every script has to remember to load all the modules it uses) but it would also save you memory.
In pre-forking servers (as is commonly used with mod_perl and Apache) you really want to load as much of your code before your server forks for the first time so that the code is stored once in copy-on-write shared memory rather than mulitple times in each child process when it is loaded on demand.
For information on pre-loading in Apache, see the section of Practical mod_perl
I have a Catalyst application and would like to redirect based on a conditional statement. I am having trouble with this and I'm wondering if anyone might have insight into why this seemingly easy task is proving difficult.
In my Root.pm module I have a sub begin and can redirect to another website, e.g. www.perl.org, but I am unable to redirect to a page within my application. Any thoughts on how to do a conditional redirect?
sub begin : Private {
my ( $self, $c ) = #_;
$c->stash->{client_id} = somenumber; # I'm setting this manually for testing
$c->res->redirect('http://www.perl.org/') unless $c->stash->{client_id};
$c->res->redirect('http://www.mysite.com/success') if $c->stash->{client_id}; #does not
}
Maybe you're getting stuck in an infinite loop, in which your begin sub redirects the user to another page in your Catalyst application; once "the controller that will run has been identified, but before any URL-matching actions are called" (from the Catalyst::Manual::Intro man page), begin will be called again, causing another redirect and so on.
Try moving this code out of begin entirely; perhaps, as Htbaa suggested, auto might be what you're looking for. The standard $c->detach case (in controller controller) is:
sub check_login :Local {
# do something
$c->detach('controller/login_successful') if($success);
# display error message
}
sub login_successful :Local {
# do something with the logged in user.
}
In this case, doing a $c->res->redirect('http://example.com/login_successful') should work perfectly as well. Hope that helps!
Thanks to everyone in advance.
I've been doing some research on error handling and I don't feel like I'm getting a solid understanding of what I should do.
Preamble: My code is living in Apache and executed in the browser, my goals don't include command line execution.
I'd like to have the behavior of CGI::Carp (fatalsToBrowser) with the ability to capture the output and be able to throw it in my own templated page, email it etc... I did notice that fatalsToBrowser doesn't work with mod_perl. Does anyone know why? How is Apache/mod_perl getting in the way?
First Goal: I'd like to put something together that works if the code is being executed with mod_perl or mod_cgi.
Second Goal: I'd like to have a high-level method(s) that catches all the errors similar to .NET's Application_Error (in global.asax) and PHP's set_exception_handler() and set_error_handler() methods. These allow you to take control when an error is raised, without wrapping code in messy/gross try-catch statements.
Things I've read/reviewed:
1.) OO Exception Handling in Perl, but wasn't what I was looking for. Most of the stuff I want to catch is die()ing. The next link also says that this article is out of date and deprecated.
2.) Perl: $SIG{__DIE__}, eval { } and stack trace, but I didn't get much from this related to my goals.
3.) Practical Mode Perl (O'Reilly), Chapter 21 "Error Handling and Debugging". Thankfully all my perl code uses strict and warnings are enabled, and most important things mentioned in Chapter 6 "Coding with mod_perl in Mind" are already done.
4.) I've dug through the tables of contents in "Learning Perl", "Perl Cookbook", "Programming Perl" and "Higher Order Perl" and didn't see anything that stuck out at me. If you think I missed something there please let me know. :)
I don't remember where (maybe in "Practical mod_perl", but I've read that you should not mess with $SIG{__DIE__}.
Have you read the mod_perl website's bit on Alternative Exception Handling Techniques? It discusses about how you can catch uncaught exceptions though the use of overriding the global die() function instead of using $SIG{__DIE__}. A much cleaner method but not perfect.
What type of errors are you trying to catch? Are custom error pages not sufficient for your purposes?
My CGI scripts are short (OK, this is really bare bones — and untested):
#!/usr/bin/perl
use strict;
use warnings;
use My::App;
use My::ErrorReporter qw( error_to_html );
run();
sub run {
my $app = eval {
My::App->new(
'some_param',
'another_param',
)
};
unless ( $app ) {
print error_to_html( $# );
return;
}
eval {
$app->handle_request;
} and return;
print error_to_html( $# );
return;
}
__END__
Now, fatalsToBrowser is not for your users. That is a development aid for you. The error messages users see should not convey information about the program. So, for example, in a routine that opens and reads a configuration file, you should do something like:
sub read_my_config {
my $self = shift;
open my $config_h, '<', $self->config_file;
unless ( $config_h ) {
# This goes to the Apache error log where you can read it
warn sprintf(
"Cannot open '%s': %s",
$self->config_file, $!
);
# This is for web site visitors to see
die "Cannot open configuration file";
}
# rest of the code
}
When I try to read an XML file with XML::Simple, sometimes I get this error message:
Couldn't create file parser context for file ...
After some googling, it seems to be a problem with libxml-libxml-perl and is supposed to be fixed in the version I use (1.59-2).
Any ideas?
Edit: (code)
sub Read
{
my ($file, $no_option) = #_;
my %XML_INPUT_OPTIONS = ( KeyAttr => [], ForceArray => 1 );
if ((defined $file) && (-f $file))
{
my #stats = stat($file);
if ((defined $XML_CACHE{$file})
&& ($stats[9] == $XML_CACHE{$file}{modif_time}))
{
return ($XML_CACHE{$file}{xml});
}
else
{
my $xml = eval { XMLin($file,
(defined $no_option ? () : %XML_INPUT_OPTIONS)) };
AAT::Syslog("AAT::XML", "XML_READ_ERROR", $#) if ($#);
$XML_CACHE{$file}{modif_time} = $stats[9];
$XML_CACHE{$file}{xml} = $xml;
return ($xml);
}
}
return (undef);
}
And yes, I should & will use XML::Simple cache feature...
Does the error continue "No such file or directory at..."? If so, then I think that the problem is that (for whatever reason) when you get to that point in the script, whatever you are passing to XML::Simple has no xml file in it. Long story short, the script you are using may be passing a bad variable (blank? empty?) to XML::Simple at which point the module chokes. To debug, add a check on whatever you hand to XML::Simple before you pass it along. (See the next paragraph for a concrete example explaining why I think this may be your problem.)
A few months ago, I had a similar problem with Weather::Google. In a nutshell, the weather module was trying to get data from Google via LWP::Simple without a user agent. Google began (apparently) to reject requests without a user agent. I had to backtrack through the modules because the error appeared to come from XML::Simple. In fact, it was caused by what was done in LWP::Simple and Weather::Google. Or rather, the error was a result of Weather::Google not checking the data that was in an object created via LWP::Simple. In a case like this, it can be hard at first to see what's going wrong and where.
I'm trying to get some code called after each request completes using Catalyst. Basically, I want to run some code as part of finalize. Supposedly Catalyst::Plugin::Observe will do this, but it appears completely broken (just loading the plugin breaks Catalyst).
I'm trying to fix the Observe plugin, but that's proving stubborn.
So, is there a better way to do get some cleanup code called at the end of each request?
(Note: This is in a model, not a controller, so I can't just use sub end { ... })
You can actually just add the code directly to your "MyApp" class:
package MyApp;
use Catalyst ...;
...
sub finalize {
my $c = shift;
$c->NEXT::finalize(#_);
# do your thing
}
This is how all plugins work; they are just methods that become part of your app.
I do agree that making "finalize" generate an event to observe is cleaner... but this is what we have to work with for now :) Join #catalyst on irc.perl.org, and we can discuss further. (I am jrockway, as you may guess.)
Edited to reply to:
(Note: This is in a model, not a controller, so I can't just use sub end { ... })
You do know that you have $c in end, right?
package Your::Model;
sub cleanup {
my $self = shift;
...
}
package Your::Controller;
sub end :Private {
my ($self, $c) = #_;
$c->model('Your::Model')->cleanup( ... )
}
Or you can do it from MyApp::finalize, as I suggested above.
The real question is, why does your model need to know about the request cycle? That sounds like awfully tight coupling.