[Summary view] [Print] [Text view]

   1  package CGI::Carp;
   2  
   3  =head1 NAME
   4  
   5  B<CGI::Carp> - CGI routines for writing to the HTTPD (or other) error log
   6  
   7  =head1 SYNOPSIS
   8  
   9      use CGI::Carp;
  10  
  11      croak "We're outta here!";
  12      confess "It was my fault: $!";
  13      carp "It was your fault!";   
  14      warn "I'm confused";
  15      die  "I'm dying.\n";
  16  
  17      use CGI::Carp qw(cluck);
  18      cluck "I wouldn't do that if I were you";
  19  
  20      use CGI::Carp qw(fatalsToBrowser);
  21      die "Fatal error messages are now sent to browser";
  22  
  23  =head1 DESCRIPTION
  24  
  25  CGI scripts have a nasty habit of leaving warning messages in the error
  26  logs that are neither time stamped nor fully identified.  Tracking down
  27  the script that caused the error is a pain.  This fixes that.  Replace
  28  the usual
  29  
  30      use Carp;
  31  
  32  with
  33  
  34      use CGI::Carp
  35  
  36  And the standard warn(), die (), croak(), confess() and carp() calls
  37  will automagically be replaced with functions that write out nicely
  38  time-stamped messages to the HTTP server error log.
  39  
  40  For example:
  41  
  42     [Fri Nov 17 21:40:43 1995] test.pl: I'm confused at test.pl line 3.
  43     [Fri Nov 17 21:40:43 1995] test.pl: Got an error message: Permission denied.
  44     [Fri Nov 17 21:40:43 1995] test.pl: I'm dying.
  45  
  46  =head1 REDIRECTING ERROR MESSAGES
  47  
  48  By default, error messages are sent to STDERR.  Most HTTPD servers
  49  direct STDERR to the server's error log.  Some applications may wish
  50  to keep private error logs, distinct from the server's error log, or
  51  they may wish to direct error messages to STDOUT so that the browser
  52  will receive them.
  53  
  54  The C<carpout()> function is provided for this purpose.  Since
  55  carpout() is not exported by default, you must import it explicitly by
  56  saying
  57  
  58     use CGI::Carp qw(carpout);
  59  
  60  The carpout() function requires one argument, which should be a
  61  reference to an open filehandle for writing errors.  It should be
  62  called in a C<BEGIN> block at the top of the CGI application so that
  63  compiler errors will be caught.  Example:
  64  
  65     BEGIN {
  66       use CGI::Carp qw(carpout);
  67       open(LOG, ">>/usr/local/cgi-logs/mycgi-log") or
  68         die("Unable to open mycgi-log: $!\n");
  69       carpout(LOG);
  70     }
  71  
  72  carpout() does not handle file locking on the log for you at this point.
  73  
  74  The real STDERR is not closed -- it is moved to CGI::Carp::SAVEERR.  Some
  75  servers, when dealing with CGI scripts, close their connection to the
  76  browser when the script closes STDOUT and STDERR.  CGI::Carp::SAVEERR is there to
  77  prevent this from happening prematurely.
  78  
  79  You can pass filehandles to carpout() in a variety of ways.  The "correct"
  80  way according to Tom Christiansen is to pass a reference to a filehandle 
  81  GLOB:
  82  
  83      carpout(\*LOG);
  84  
  85  This looks weird to mere mortals however, so the following syntaxes are
  86  accepted as well:
  87  
  88      carpout(LOG);
  89      carpout(main::LOG);
  90      carpout(main'LOG);
  91      carpout(\LOG);
  92      carpout(\'main::LOG');
  93  
  94      ... and so on
  95  
  96  FileHandle and other objects work as well.
  97  
  98  Use of carpout() is not great for performance, so it is recommended
  99  for debugging purposes or for moderate-use applications.  A future
 100  version of this module may delay redirecting STDERR until one of the
 101  CGI::Carp methods is called to prevent the performance hit.
 102  
 103  =head1 MAKING PERL ERRORS APPEAR IN THE BROWSER WINDOW
 104  
 105  If you want to send fatal (die, confess) errors to the browser, ask to
 106  import the special "fatalsToBrowser" subroutine:
 107  
 108      use CGI::Carp qw(fatalsToBrowser);
 109      die "Bad error here";
 110  
 111  Fatal errors will now be echoed to the browser as well as to the log.  CGI::Carp
 112  arranges to send a minimal HTTP header to the browser so that even errors that
 113  occur in the early compile phase will be seen.
 114  Nonfatal errors will still be directed to the log file only (unless redirected
 115  with carpout).
 116  
 117  Note that fatalsToBrowser does B<not> work with mod_perl version 2.0
 118  and higher.
 119  
 120  =head2 Changing the default message
 121  
 122  By default, the software error message is followed by a note to
 123  contact the Webmaster by e-mail with the time and date of the error.
 124  If this message is not to your liking, you can change it using the
 125  set_message() routine.  This is not imported by default; you should
 126  import it on the use() line:
 127  
 128      use CGI::Carp qw(fatalsToBrowser set_message);
 129      set_message("It's not a bug, it's a feature!");
 130  
 131  You may also pass in a code reference in order to create a custom
 132  error message.  At run time, your code will be called with the text
 133  of the error message that caused the script to die.  Example:
 134  
 135      use CGI::Carp qw(fatalsToBrowser set_message);
 136      BEGIN {
 137         sub handle_errors {
 138            my $msg = shift;
 139            print "<h1>Oh gosh</h1>";
 140            print "<p>Got an error: $msg</p>";
 141        }
 142        set_message(\&handle_errors);
 143      }
 144  
 145  In order to correctly intercept compile-time errors, you should call
 146  set_message() from within a BEGIN{} block.
 147  
 148  =head1 DOING MORE THAN PRINTING A MESSAGE IN THE EVENT OF PERL ERRORS
 149  
 150  If fatalsToBrowser in conjunction with set_message does not provide 
 151  you with all of the functionality you need, you can go one step 
 152  further by specifying a function to be executed any time a script
 153  calls "die", has a syntax error, or dies unexpectedly at runtime
 154  with a line like "undef->explode();". 
 155  
 156      use CGI::Carp qw(set_die_handler);
 157      BEGIN {
 158         sub handle_errors {
 159            my $msg = shift;
 160            print "content-type: text/html\n\n";
 161            print "<h1>Oh gosh</h1>";
 162            print "<p>Got an error: $msg</p>";
 163  
 164            #proceed to send an email to a system administrator,
 165            #write a detailed message to the browser and/or a log,
 166            #etc....
 167        }
 168        set_die_handler(\&handle_errors);
 169      }
 170  
 171  Notice that if you use set_die_handler(), you must handle sending
 172  HTML headers to the browser yourself if you are printing a message.
 173  
 174  If you use set_die_handler(), you will most likely interfere with 
 175  the behavior of fatalsToBrowser, so you must use this or that, not 
 176  both. 
 177  
 178  Using set_die_handler() sets SIG{__DIE__} (as does fatalsToBrowser),
 179  and there is only one SIG{__DIE__}. This means that if you are 
 180  attempting to set SIG{__DIE__} yourself, you may interfere with 
 181  this module's functionality, or this module may interfere with 
 182  your module's functionality.
 183  
 184  =head1 MAKING WARNINGS APPEAR AS HTML COMMENTS
 185  
 186  It is now also possible to make non-fatal errors appear as HTML
 187  comments embedded in the output of your program.  To enable this
 188  feature, export the new "warningsToBrowser" subroutine.  Since sending
 189  warnings to the browser before the HTTP headers have been sent would
 190  cause an error, any warnings are stored in an internal buffer until
 191  you call the warningsToBrowser() subroutine with a true argument:
 192  
 193      use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
 194      use CGI qw(:standard);
 195      print header();
 196      warningsToBrowser(1);
 197  
 198  You may also give a false argument to warningsToBrowser() to prevent
 199  warnings from being sent to the browser while you are printing some
 200  content where HTML comments are not allowed:
 201  
 202      warningsToBrowser(0);    # disable warnings
 203      print "<script type=\"text/javascript\"><!--\n";
 204      print_some_javascript_code();
 205      print "//--></script>\n";
 206      warningsToBrowser(1);    # re-enable warnings
 207  
 208  Note: In this respect warningsToBrowser() differs fundamentally from
 209  fatalsToBrowser(), which you should never call yourself!
 210  
 211  =head1 OVERRIDING THE NAME OF THE PROGRAM
 212  
 213  CGI::Carp includes the name of the program that generated the error or
 214  warning in the messages written to the log and the browser window.
 215  Sometimes, Perl can get confused about what the actual name of the
 216  executed program was.  In these cases, you can override the program
 217  name that CGI::Carp will use for all messages.
 218  
 219  The quick way to do that is to tell CGI::Carp the name of the program
 220  in its use statement.  You can do that by adding
 221  "name=cgi_carp_log_name" to your "use" statement.  For example:
 222  
 223      use CGI::Carp qw(name=cgi_carp_log_name);
 224  
 225  .  If you want to change the program name partway through the program,
 226  you can use the C<set_progname()> function instead.  It is not
 227  exported by default, you must import it explicitly by saying
 228  
 229      use CGI::Carp qw(set_progname);
 230  
 231  Once you've done that, you can change the logged name of the program
 232  at any time by calling
 233  
 234      set_progname(new_program_name);
 235  
 236  You can set the program back to the default by calling
 237  
 238      set_progname(undef);
 239  
 240  Note that this override doesn't happen until after the program has
 241  compiled, so any compile-time errors will still show up with the
 242  non-overridden program name
 243    
 244  =head1 CHANGE LOG
 245  
 246  1.29 Patch from Peter Whaite to fix the unfixable problem of CGI::Carp
 247       not behaving correctly in an eval() context.
 248  
 249  1.05 carpout() added and minor corrections by Marc Hedlund
 250       <hedlund@best.com> on 11/26/95.
 251  
 252  1.06 fatalsToBrowser() no longer aborts for fatal errors within
 253       eval() statements.
 254  
 255  1.08 set_message() added and carpout() expanded to allow for FileHandle
 256       objects.
 257  
 258  1.09 set_message() now allows users to pass a code REFERENCE for 
 259       really custom error messages.  croak and carp are now
 260       exported by default.  Thanks to Gunther Birznieks for the
 261       patches.
 262  
 263  1.10 Patch from Chris Dean (ctdean@cogit.com) to allow 
 264       module to run correctly under mod_perl.
 265  
 266  1.11 Changed order of &gt; and &lt; escapes.
 267  
 268  1.12 Changed die() on line 217 to CORE::die to avoid B<-w> warning.
 269  
 270  1.13 Added cluck() to make the module orthogonal with Carp.
 271       More mod_perl related fixes.
 272  
 273  1.20 Patch from Ilmari Karonen (perl@itz.pp.sci.fi):  Added
 274       warningsToBrowser().  Replaced <CODE> tags with <PRE> in
 275       fatalsToBrowser() output.
 276  
 277  1.23 ineval() now checks both $^S and inspects the message for the "eval" pattern
 278       (hack alert!) in order to accommodate various combinations of Perl and
 279       mod_perl.
 280  
 281  1.24 Patch from Scott Gifford (sgifford@suspectclass.com): Add support
 282       for overriding program name.
 283  
 284  1.26 Replaced CORE::GLOBAL::die with the evil $SIG{__DIE__} because the
 285       former isn't working in some people's hands.  There is no such thing
 286       as reliable exception handling in Perl.
 287  
 288  1.27 Replaced tell STDOUT with bytes=tell STDOUT.
 289  
 290  =head1 AUTHORS
 291  
 292  Copyright 1995-2002, Lincoln D. Stein.  All rights reserved.  
 293  
 294  This library is free software; you can redistribute it and/or modify
 295  it under the same terms as Perl itself.
 296  
 297  Address bug reports and comments to: lstein@cshl.org
 298  
 299  =head1 SEE ALSO
 300  
 301  Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form,
 302  CGI::Response
 303      if (defined($CGI::Carp::PROGNAME)) 
 304      {
 305        $file = $CGI::Carp::PROGNAME;
 306      }
 307  
 308  =cut
 309  
 310  require 5.000;
 311  use Exporter;
 312  #use Carp;
 313  BEGIN { 
 314    require Carp; 
 315    *CORE::GLOBAL::die = \&CGI::Carp::die;
 316  }
 317  
 318  use File::Spec;
 319  
 320  @ISA = qw(Exporter);
 321  @EXPORT = qw(confess croak carp);
 322  @EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap set_message set_die_handler set_progname cluck ^name= die);
 323  
 324  $main::SIG{__WARN__}=\&CGI::Carp::warn;
 325  
 326  $CGI::Carp::VERSION     = '1.29';
 327  $CGI::Carp::CUSTOM_MSG  = undef;
 328  $CGI::Carp::DIE_HANDLER = undef;
 329  
 330  
 331  # fancy import routine detects and handles 'errorWrap' specially.
 332  sub import {
 333      my $pkg = shift;
 334      my(%routines);
 335      my(@name);
 336      if (@name=grep(/^name=/,@_))
 337        {
 338          my($n) = (split(/=/,$name[0]))[1];
 339          set_progname($n);
 340          @_=grep(!/^name=/,@_);
 341        }
 342  
 343      grep($routines{$_}++,@_,@EXPORT);
 344      $WRAP++ if $routines{'fatalsToBrowser'} || $routines{'wrap'};
 345      $WARN++ if $routines{'warningsToBrowser'};
 346      my($oldlevel) = $Exporter::ExportLevel;
 347      $Exporter::ExportLevel = 1;
 348      Exporter::import($pkg,keys %routines);
 349      $Exporter::ExportLevel = $oldlevel;
 350      $main::SIG{__DIE__} =\&CGI::Carp::die if $routines{'fatalsToBrowser'};
 351  #    $pkg->export('CORE::GLOBAL','die');
 352  }
 353  
 354  # These are the originals
 355  sub realwarn { CORE::warn(@_); }
 356  sub realdie { CORE::die(@_); }
 357  
 358  sub id {
 359      my $level = shift;
 360      my($pack,$file,$line,$sub) = caller($level);
 361      my($dev,$dirs,$id) = File::Spec->splitpath($file);
 362      return ($file,$line,$id);
 363  }
 364  
 365  sub stamp {
 366      my $time = scalar(localtime);
 367      my $frame = 0;
 368      my ($id,$pack,$file,$dev,$dirs);
 369      if (defined($CGI::Carp::PROGNAME)) {
 370          $id = $CGI::Carp::PROGNAME;
 371      } else {
 372          do {
 373          $id = $file;
 374        ($pack,$file) = caller($frame++);
 375          } until !$file;
 376      }
 377      ($dev,$dirs,$id) = File::Spec->splitpath($id);
 378      return "[$time] $id: ";
 379  }
 380  
 381  sub set_progname {
 382      $CGI::Carp::PROGNAME = shift;
 383      return $CGI::Carp::PROGNAME;
 384  }
 385  
 386  
 387  sub warn {
 388      my $message = shift;
 389      my($file,$line,$id) = id(1);
 390      $message .= " at $file line $line.\n" unless $message=~/\n$/;
 391      _warn($message) if $WARN;
 392      my $stamp = stamp;
 393      $message=~s/^/$stamp/gm;
 394      realwarn $message;
 395  }
 396  
 397  sub _warn {
 398      my $msg = shift;
 399      if ($EMIT_WARNINGS) {
 400      # We need to mangle the message a bit to make it a valid HTML
 401      # comment.  This is done by substituting similar-looking ISO
 402      # 8859-1 characters for <, > and -.  This is a hack.
 403      $msg =~ tr/<>-/\253\273\255/;
 404      chomp $msg;
 405      print STDOUT "<!-- warning: $msg -->\n";
 406      } else {
 407      push @WARNINGS, $msg;
 408      }
 409  }
 410  
 411  
 412  # The mod_perl package Apache::Registry loads CGI programs by calling
 413  # eval.  These evals don't count when looking at the stack backtrace.
 414  sub _longmess {
 415      my $message = Carp::longmess();
 416      $message =~ s,eval[^\n]+(ModPerl|Apache)/(?:Registry|Dispatch)\w*\.pm.*,,s
 417          if exists $ENV{MOD_PERL};
 418      return $message;
 419  }
 420  
 421  sub ineval {
 422    (exists $ENV{MOD_PERL} ? 0 : $^S) || _longmess() =~ /eval [\{\']/m
 423  }
 424  
 425  sub die {
 426    my ($arg,@rest) = @_;
 427  
 428    if ($DIE_HANDLER) {
 429        &$DIE_HANDLER($arg,@rest);
 430    }
 431  
 432    if ( ineval() )  {
 433      if (!ref($arg)) {
 434        $arg = join("",($arg,@rest)) || "Died";
 435        my($file,$line,$id) = id(1);
 436        $arg .= " at $file line $line.\n" unless $arg=~/\n$/;
 437        realdie($arg);
 438      }
 439      else {
 440        realdie($arg,@rest);
 441      }
 442    }
 443  
 444    if (!ref($arg)) {
 445      $arg = join("", ($arg,@rest));
 446      my($file,$line,$id) = id(1);
 447      $arg .= " at $file line $line." unless $arg=~/\n$/;
 448      &fatalsToBrowser($arg) if $WRAP;
 449      if (($arg =~ /\n$/) || !exists($ENV{MOD_PERL})) {
 450        my $stamp = stamp;
 451        $arg=~s/^/$stamp/gm;
 452      }
 453      if ($arg !~ /\n$/) {
 454        $arg .= "\n";
 455      }
 456    }
 457    realdie $arg;
 458  }
 459  
 460  sub set_message {
 461      $CGI::Carp::CUSTOM_MSG = shift;
 462      return $CGI::Carp::CUSTOM_MSG;
 463  }
 464  
 465  sub set_die_handler {
 466  
 467      my ($handler) = shift;
 468      
 469      #setting SIG{__DIE__} here is necessary to catch runtime
 470      #errors which are not called by literally saying "die",
 471      #such as the line "undef->explode();". however, doing this
 472      #will interfere with fatalsToBrowser, which also sets 
 473      #SIG{__DIE__} in the import() function above (or the 
 474      #import() function above may interfere with this). for
 475      #this reason, you should choose to either set the die
 476      #handler here, or use fatalsToBrowser, not both. 
 477      $main::SIG{__DIE__} = $handler;
 478      
 479      $CGI::Carp::DIE_HANDLER = $handler; 
 480      
 481      return $CGI::Carp::DIE_HANDLER;
 482  }
 483  
 484  sub confess { CGI::Carp::die Carp::longmess @_; }
 485  sub croak   { CGI::Carp::die Carp::shortmess @_; }
 486  sub carp    { CGI::Carp::warn Carp::shortmess @_; }
 487  sub cluck   { CGI::Carp::warn Carp::longmess @_; }
 488  
 489  # We have to be ready to accept a filehandle as a reference
 490  # or a string.
 491  sub carpout {
 492      my($in) = @_;
 493      my($no) = fileno(to_filehandle($in));
 494      realdie("Invalid filehandle $in\n") unless defined $no;
 495      
 496      open(SAVEERR, ">&STDERR");
 497      open(STDERR, ">&$no") or 
 498      ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) );
 499  }
 500  
 501  sub warningsToBrowser {
 502      $EMIT_WARNINGS = @_ ? shift : 1;
 503      _warn(shift @WARNINGS) while $EMIT_WARNINGS and @WARNINGS;
 504  }
 505  
 506  # headers
 507  sub fatalsToBrowser {
 508    my($msg) = @_;
 509    $msg=~s/&/&amp;/g;
 510    $msg=~s/>/&gt;/g;
 511    $msg=~s/</&lt;/g;
 512    $msg=~s/\"/&quot;/g;
 513    my($wm) = $ENV{SERVER_ADMIN} ? 
 514      qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
 515        "this site's webmaster";
 516    my ($outer_message) = <<END;
 517  For help, please send mail to $wm, giving this error message 
 518  and the time and date of the error.
 519  END
 520    ;
 521    my $mod_perl = exists $ENV{MOD_PERL};
 522  
 523    if ($CUSTOM_MSG) {
 524      if (ref($CUSTOM_MSG) eq 'CODE') {
 525        print STDOUT "Content-type: text/html\n\n" 
 526          unless $mod_perl;
 527        &$CUSTOM_MSG($msg); # nicer to perl 5.003 users
 528        return;
 529      } else {
 530        $outer_message = $CUSTOM_MSG;
 531      }
 532    }
 533  
 534    my $mess = <<END;
 535  <h1>Software error:</h1>
 536  <pre>$msg</pre>
 537  <p>
 538  $outer_message
 539  </p>
 540  END
 541    ;
 542  
 543    if ($mod_perl) {
 544      my $r;
 545      if ($ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
 546        $mod_perl = 2;
 547        require Apache2::RequestRec;
 548        require Apache2::RequestIO;
 549        require Apache2::RequestUtil;
 550        require APR::Pool;
 551        require ModPerl::Util;
 552        require Apache2::Response;
 553        $r = Apache2::RequestUtil->request;
 554      }
 555      else {
 556        $r = Apache->request;
 557      }
 558      # If bytes have already been sent, then
 559      # we print the message out directly.
 560      # Otherwise we make a custom error
 561      # handler to produce the doc for us.
 562      if ($r->bytes_sent) {
 563        $r->print($mess);
 564        $mod_perl == 2 ? ModPerl::Util::exit(0) : $r->exit;
 565      } else {
 566        # MSIE won't display a custom 500 response unless it is >512 bytes!
 567        if ($ENV{HTTP_USER_AGENT} =~ /MSIE/) {
 568          $mess = "<!-- " . (' ' x 513) . " -->\n$mess";
 569        }
 570        $r->custom_response(500,$mess);
 571      }
 572    } else {
 573      my $bytes_written = eval{tell STDOUT};
 574      if (defined $bytes_written && $bytes_written > 0) {
 575          print STDOUT $mess;
 576      }
 577      else {
 578          print STDOUT "Content-type: text/html\n\n";
 579          print STDOUT $mess;
 580      }
 581    }
 582  
 583    warningsToBrowser(1);    # emit warnings before dying
 584  }
 585  
 586  # Cut and paste from CGI.pm so that we don't have the overhead of
 587  # always loading the entire CGI module.
 588  sub to_filehandle {
 589      my $thingy = shift;
 590      return undef unless $thingy;
 591      return $thingy if UNIVERSAL::isa($thingy,'GLOB');
 592      return $thingy if UNIVERSAL::isa($thingy,'FileHandle');
 593      if (!ref($thingy)) {
 594      my $caller = 1;
 595      while (my $package = caller($caller++)) {
 596          my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy"; 
 597          return $tmp if defined(fileno($tmp));
 598      }
 599      }
 600      return undef;
 601  }
 602  
 603  1;