FS/FS/Mason/Request.pm

   1 package FS::Mason::Request;
   2
   3 use strict;
   4 use warnings;
   5 use vars qw( $FSURL $QUERY_STRING );
   6 use base 'HTML::Mason::Request';
   7 use FS::Trace;
   8 use FS::access_user_log;
   9
  10 $FSURL = 'http://Set/FS_Mason_Request_FSURL/in_standalone_mode/';
  11 $QUERY_STRING = '';
  12
  13 sub new {
  14     my $class = shift;
  15
  16     FS::Trace->log('creating new FS::Mason::Request object');
  17
  18     my $superclass = $HTML::Mason::ApacheHandler::VERSION ?
  19                      'HTML::Mason::Request::ApacheHandler' :
  20                      $HTML::Mason::CGIHandler::VERSION ?
  21                      'HTML::Mason::Request::CGI' :
  22                      'HTML::Mason::Request';
  23
  24     FS::Trace->log('  altering superclass');
  25     $class->alter_superclass( $superclass );
  26
  27     FS::Trace->log('  setting valid params');
  28     #huh... shouldn't alter_superclass take care of this for us?
  29     __PACKAGE__->valid_params( %{ $superclass->valid_params() } );
  30
  31     FS::Trace->log('  freeside_setup');
  32     my %opt = @_;
  33     my $mode = $superclass =~ /Apache/i ? 'apache' : 'standalone';
  34     $class->freeside_setup($opt{'comp'}, $mode);
  35
  36     FS::Trace->log('  SUPER::new');
  37     $class->SUPER::new(@_);
  38
  39 }
  40
  41 #override alter_superclass ala RT::Interface::Web::Request ??
  42 # for Mason 1.39 vs. Perl 5.10.0
  43
  44 my $protect_fds;
  45
  46 sub freeside_setup {
  47     my( $class, $filename, $mode ) = @_;
  48
  49     FS::Trace->log('    protecting fds');
  50
  51     #from rt/bin/webmux.pl(.in)
  52     if ( !$protect_fds && $ENV{'MOD_PERL'} && exists $ENV{'MOD_PERL_API_VERSION'}
  53         && $ENV{'MOD_PERL_API_VERSION'} >= 2
  54     ) {
  55         # under mod_perl2, STDIN and STDOUT get closed and re-opened,
  56         # however they are not on FD 0 and 1.  In this case, the next
  57         # socket that gets opened will occupy one of these FDs, and make
  58         # all system() and open "|-" calls dangerous; for example, the
  59         # DBI handle can get this FD, which later system() calls will
  60         # close by putting garbage into the socket.
  61         $protect_fds = [];
  62         push @{$protect_fds}, IO::Handle->new_from_fd(0, "r")
  63             if fileno(STDIN) != 0;
  64         push @{$protect_fds}, IO::Handle->new_from_fd(1, "w")
  65             if fileno(STDOUT) != 1;
  66     }
  67
  68     if ( $HTML::Mason::Commands::r ) {
  69       FS::Trace->log('    adding headers');
  70       #frame-ancestors not supported by all the major browsers yet
  71       $HTML::Mason::Commands::r->header_out( 'X-Frame-Options', 'SAMEORIGIN' );
  72     }
  73
  74     if ( $filename =~ qr(/REST/\d+\.\d+/NoAuth/) ) {
  75
  76       FS::Trace->log('    handling RT REST/NoAuth file');
  77
  78       package HTML::Mason::Commands; #?
  79       use FS::UID qw( adminsuidsetup );
  80
  81       #need to log somebody in for the mail gw
  82
  83       ##old installs w/fs_selfs or selfserv??
  84       #&adminsuidsetup('fs_selfservice');
  85
  86       FS::Trace->log('    adminsuidsetup fs_queue');
  87       &adminsuidsetup('fs_queue');
  88
  89     } else {
  90
  91       FS::Trace->log('    handling regular file');
  92
  93       package HTML::Mason::Commands;
  94       use vars qw( $cgi $p $fsurl ); # $lh ); #not using /mt
  95       use Encode;
  96       use FS::UID qw( cgisuidsetup );
  97       use FS::CGI qw( popurl rooturl );
  98
  99       if ( $mode eq 'apache' ) {
 100         $cgi = new CGI;
 101         FS::Trace->log('    cgisuidsetup');
 102         &cgisuidsetup($cgi);
 103         #&cgisuidsetup($r);
 104         $fsurl = rooturl();
 105         $p = popurl(2);
 106       } elsif ( $mode eq 'standalone' ) {
 107         $cgi = new CGI $FS::Mason::Request::QUERY_STRING; #better keep setting
 108                                                           #if you set it once
 109         $FS::UID::cgi = $cgi;
 110         $fsurl = $FS::Mason::Request::FSURL; #kludgy, but what the hell
 111         $p = popurl(2, "$fsurl$filename");
 112       } else {
 113         die "unknown mode $mode";
 114       }
 115
 116     FS::Trace->log('    UTF-8-decoding form data');
 117     #
 118     foreach my $param ( $cgi->param ) {
 119
 120       #we can't switch to multi_param until we're done supporting deb 7
 121       local($CGI::LIST_CONTEXT_WARN) = 0;
 122
 123       my @values = $cgi->param($param);
 124       next if $cgi->uploadInfo($values[0]);
 125       #warn $param;
 126       @values = map decode(utf8=>$_), @values;
 127       $cgi->param($param, @values);
 128     }
 129
 130   }
 131
 132   FS::access_user_log->insert_new_path( $filename );
 133
 134   FS::Trace->log('    done');
 135
 136 }
 137
 138 sub callback {
 139   RT::Interface::Web::Request::callback(@_);
 140 }
 141
 142 sub request_path {
 143   RT::Interface::Web::Request::request_path(@_);
 144 }
 145
 146 1;