X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=htetc%2Fhandler.pl;h=2fe5d376e5aa809386bab34302a7ab4c20290e69;hp=2272e260352c83cd38750bbb45d405e5e234f505;hb=949a80c148a8bbeeeec54c5a0be5d73b292423a5;hpb=a0ddcb6b2ac38076c48e8f0b69e0758d5283303a diff --git a/htetc/handler.pl b/htetc/handler.pl index 2272e2603..2fe5d376e 100644 --- a/htetc/handler.pl +++ b/htetc/handler.pl @@ -1,73 +1,57 @@ #!/usr/bin/perl -# -# This is a basic, fairly fuctional Mason handler.pl. -# -# For something a little more involved, check out session_handler.pl package HTML::Mason; -# Bring in main Mason package. -use HTML::Mason 1.1; +use strict; +use warnings; +use FS::Mason qw( mason_interps ); +use FS::Trace; +use FS::access_user_log; +use FS::Conf; -# Bring in ApacheHandler, necessary for mod_perl integration. -# Uncomment the second line (and comment the first) to use -# Apache::Request instead of CGI.pm to parse arguments. -use HTML::Mason::ApacheHandler; -# use HTML::Mason::ApacheHandler (args_method=>'mod_perl'); +$FS::Conf::conf_cache_enabled = 1; # enable FS::Conf caching for performance -# Uncomment the next line if you plan to use the Mason previewer. -#use HTML::Mason::Preview; +# Preload to share in mod_perl parent for performance +use FS::UID qw(load_schema); +load_schema(); +use FS::Record qw(fk_methods_init); +fk_methods_init; -use strict; +if ( %%%RT_ENABLED%%% ) { -###use Module::Refresh;### + require RT; -# List of modules that you want to use from components (see Admin -# manual for details) -#{ package HTML::Mason::Commands; -# use CGI; -#} + $> = scalar(getpwnam('freeside')); -# Create Mason objects -# + RT::LoadConfig(); + RT::Init(); + + # disconnect DB before fork: + # (avoid 'prepared statement "dbdpg_p\d+_\d+" already exists' errors?) + $RT::Handle->dbh(undef); + undef $RT::Handle; -#my $parser = new HTML::Mason::Parser; -#my $interp = new HTML::Mason::Interp (parser=>$parser, -# comp_root=>'/var/www/masondocs', -# data_dir=>'/usr/local/etc/freeside/masondata', -# out_mode=>'stream', -# ); + $> = $<; +} -use vars qw($r); +#use vars qw($r); -if ( %%%RT_ENABLED%%% ) { - eval ' - use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" ); - use RT; - use vars qw($Nobody $SystemUser); - RT::LoadConfig(); - '; - die $@ if $@; +# Bring in ApacheHandler, necessary for mod_perl integration. +# Uncomment the second line (and comment the first) to use +# Apache::Request instead of CGI.pm to parse arguments. +use HTML::Mason::ApacheHandler; +# use HTML::Mason::ApacheHandler (args_method=>'mod_perl'); +###use Module::Refresh;### -} +# Create Mason objects +my( $fs_interp, $rt_interp ) = mason_interps('apache'); my $ah = new HTML::Mason::ApacheHandler ( - #interp => $interp, - #auto_send_headers => 0, - comp_root=> [ - [ 'freeside' => '%%%FREESIDE_DOCUMENT_ROOT%%%' ], - [ 'rt' => '%%%FREESIDE_DOCUMENT_ROOT%%%/rt' ], - ], - data_dir=>'%%%MASONDATA%%%', - #out_mode=>'stream', - - #RT - args_method => 'CGI', - default_escape_flags => 'h', - allow_globals => [qw(%session)], - #autoflush => 1, + interp => $fs_interp, + request_class => 'FS::Mason::Request', + args_method => 'CGI', #(and FS too) ); # Activate the following if running httpd as root (the normal case). @@ -75,9 +59,33 @@ my $ah = new HTML::Mason::ApacheHandler ( # #chown (Apache->server->uid, Apache->server->gid, $interp->files_written); +my $protect_fds; + sub handler { - ($r) = @_; + #($r) = @_; + my $r = shift; + + my $start_time = time; + + FS::Trace->log('protecting fds'); + + #from rt/bin/webmux.pl(.in) + if ( !$protect_fds && $ENV{'MOD_PERL'} && exists $ENV{'MOD_PERL_API_VERSION'} + && $ENV{'MOD_PERL_API_VERSION'} >= 2 + ) { + # under mod_perl2, STDIN and STDOUT get closed and re-opened, + # however they are not on FD 0 and 1. In this case, the next + # socket that gets opened will occupy one of these FDs, and make + # all system() and open "|-" calls dangerous; for example, the + # DBI handle can get this FD, which later system() calls will + # close by putting garbage into the socket. + $protect_fds = []; + push @{$protect_fds}, IO::Handle->new_from_fd(0, "r") + if fileno(STDIN) != 0; + push @{$protect_fds}, IO::Handle->new_from_fd(1, "w") + if fileno(STDOUT) != 1; + } # If you plan to intermix images in the same directory as # components, activate the following to prevent Mason from @@ -85,225 +93,12 @@ sub handler # #return -1 if $r->content_type && $r->content_type !~ m|^text/|i; - #rar - { package HTML::Mason::Commands; - use strict; - use vars qw( $cgi $p $fsurl); - use vars qw( %session ); - use CGI 2.47 qw(-private_tempfiles); - #use CGI::Carp qw(fatalsToBrowser); - use List::Util qw( max min ); - use Date::Format; - use Date::Parse; - use Time::Local; - use Time::Duration; - use DateTime; - use DateTime::Format::Strptime; - use Lingua::EN::Inflect qw(PL); - use Tie::IxHash; - use URI::Escape; - use HTML::Entities; - use JSON; - use IO::Handle; - use IO::File; - use IO::Scalar; - use Net::Whois::Raw qw(whois); - if ( $] < 5.006 ) { - eval "use Net::Whois::Raw 0.32 qw(whois)"; - die $@ if $@; - } - use Text::CSV_XS; - use Spreadsheet::WriteExcel; - use Business::CreditCard 0.30; #for mask-aware cardtype() - use String::Approx qw(amatch); - use Chart::LinesPoints; - use Chart::Mountain; - use Color::Scheme; - use HTML::Widgets::SelectLayers 0.06; - use Locale::Country; - use FS; - use FS::UID qw(cgisuidsetup dbh getotaker datasrc driver_name); - use FS::Record qw(qsearch qsearchs fields dbdef); - use FS::Conf; - use FS::CGI qw(header menubar popurl rooturl table itable ntable idiot - eidiot small_custview myexit http_header); - use FS::UI::Web; - use FS::Msgcat qw(gettext geterror); - use FS::Misc qw( send_email send_fax states_hash state_label ); - use FS::Report::Table::Monthly; - use FS::TicketSystem; - - use FS::agent; - use FS::agent_type; - use FS::domain_record; - use FS::cust_bill; - use FS::cust_bill_pay; - use FS::cust_credit; - use FS::cust_credit_bill; - use FS::cust_main qw(smart_search); - use FS::cust_main_county; - use FS::cust_pay; - use FS::cust_pkg; - use FS::cust_pkg_reason; - use FS::cust_refund; - use FS::cust_svc; - use FS::nas; - use FS::part_bill_event; - use FS::part_pkg; - use FS::part_referral; - use FS::part_svc; - use FS::part_svc_router; - use FS::part_virtual_field; - use FS::pay_batch; - use FS::pkg_svc; - use FS::port; - use FS::queue qw(joblisting); - use FS::raddb; - use FS::session; - use FS::svc_acct; - use FS::svc_acct_pop qw(popselector); - use FS::svc_domain; - use FS::svc_forward; - use FS::svc_www; - use FS::router; - use FS::addr_block; - use FS::svc_broadband; - use FS::svc_external; - use FS::type_pkgs; - use FS::part_export; - use FS::part_export_option; - use FS::export_svc; - use FS::msgcat; - use FS::rate; - use FS::rate_region; - use FS::rate_prefix; - use FS::payment_gateway; - use FS::agent_payment_gateway; - use FS::XMLRPC; - use FS::payby; - use FS::cdr; - use FS::inventory_class; - use FS::inventory_item; - use FS::pkg_class; - use FS::access_user; - use FS::access_group; - use FS::access_usergroup; - use FS::access_groupagent; - use FS::access_right; - use FS::AccessRight; - use FS::svc_phone; - use FS::reason_type; - use FS::reason; - use FS::cust_main_note; - - if ( %%%RT_ENABLED%%% ) { - eval ' - use RT::Tickets; - use RT::Transactions; - use RT::Users; - use RT::CurrentUser; - use RT::Templates; - use RT::Queues; - use RT::ScripActions; - use RT::ScripConditions; - use RT::Scrips; - use RT::Groups; - use RT::GroupMembers; - use RT::CustomFields; - use RT::CustomFieldValues; - use RT::ObjectCustomFieldValues; - - use RT::Interface::Web; - use MIME::Entity; - use Text::Wrapper; - use CGI::Cookie; - use Time::ParseDate; - use HTML::Scrubber; - use Text::Quoted; - '; - die $@ if $@; - } - - *CGI::redirect = sub { - my( $self, $location ) = @_; - use vars qw($m); - - # false laziness w/below - if ( defined(@DBIx::Profile::ISA) ) { #profiling redirect - - my $page = - qq!Redirect to $location!. - '

'.
-              ( UNIVERSAL::can(dbh, 'sprintProfile')
-                  ? encode_entities(dbh->sprintProfile())
-                  : 'DBIx::Profile missing sprintProfile method;'.
-                    'unpatched or too old?'                        ).
-            #"\n\n". &sprintAutoProfile().  '
'. - "\n\n". ''. - ''; - dbh->{'private_profile'} = {}; - return $page; - - } else { #normal redirect - - $m->redirect($location); - ''; - - } - - }; - - unless ( $HTML::Mason::r->filename =~ /\/rt\/.*NoAuth/ ) { #RT - $cgi = new CGI; - &cgisuidsetup($cgi); - #&cgisuidsetup($r); - $p = popurl(2); - $fsurl = rooturl(); - } - - sub include { - use vars qw($m); - $m->scomp(@_); - } - - sub redirect { - my( $location ) = @_; - use vars qw($m); - $m->clear_buffer; - #false laziness w/above - if ( defined(@DBIx::Profile::ISA) ) { #profiling redirect - - $m->print( - qq!Redirect to $location!. - '

'.
-              ( UNIVERSAL::can(dbh, 'sprintProfile')
-                  ? encode_entities(dbh->sprintProfile())
-                  : 'DBIx::Profile missing sprintProfile method;'.
-                    'unpatched or too old?'                        ).
-            #"\n\n". &sprintAutoProfile().  '
'. - "\n\n". ''. - '' - ); - dbh->{'private_profile'} = {}; - - #whew. removing this is all that's needed to fix the annoying - #blank-page-instead-of-profiling-redirect-when-called-from-an-include - #bug triggered by mason 1.32 - #my $rv = $m->abort(200); - - } else { #normal redirect - - $m->redirect($location); - - } - - } - - } # end package HTML::Mason::Commands; - ###Module::Refresh->refresh;### - $r->content_type('text/html'); + FS::Trace->log('setting content_type / headers'); + + $r->content_type('text/html; charset=utf-8'); + #$r->content_type('text/html; charset=iso-8859-1'); #eorar my $headers = $r->headers_out; @@ -313,28 +108,46 @@ sub handler # $r->send_http_header; - #$ah->interp->remove_escape('h'); - if ( $r->filename =~ /\/rt\// ) { #RT - #warn "processing RT file". $r->filename. "; escaping for RT\n"; - # MasonX::Request::ExtendedCompRoot - #$ah->interp->comp_root( '/rt'. $ah->interp->comp_root() ); + FS::Trace->log('handling RT file'); - $ah->interp->set_escape( h => \&RT::Interface::Web::EscapeUTF8 ); + # We don't need to handle non-text, non-xml items + return -1 if defined( $r->content_type ) + && $r->content_type !~ m!(^text/|\bxml\b)!io; local $SIG{__WARN__}; local $SIG{__DIE__}; - RT::Init(); + FS::Trace->log('initializing RT'); + my_rt_init(); - # We don't need to handle non-text, non-xml items - return -1 if defined( $r->content_type ) && $r->content_type !~ m!(^text/|\bxml\b)!io; + FS::Trace->log('setting RT interpreter'); + $ah->interp($rt_interp); } else { - $ah->interp->set_escape( 'h' => sub { ${$_[0]}; } ); + + FS::Trace->log('handling Freeside file'); + + local $SIG{__WARN__}; + local $SIG{__DIE__}; + + FS::Trace->log('initializing RT'); + my_rt_init(); + + #we don't want the RT error handlers under FS + { + no warnings 'uninitialized'; + undef($SIG{__WARN__}) if defined($SIG{__WARN__}); + undef($SIG{__DIE__}) if defined($SIG{__DIE__} ); + } + + FS::Trace->log('setting Freeside interpreter'); + $ah->interp($fs_interp); + } + FS::Trace->log('handling request'); my %session; my $status; eval { $status = $ah->handle_request($r); }; @@ -342,6 +155,7 @@ sub handler # if ( $@ ) { # $RT::Logger->crit($@); # } + warn $@ if $@; undef %session; @@ -353,7 +167,24 @@ sub handler # ); # } + FS::access_user_log->insert_new_path( $r->filename, time-$start_time ); + + FS::Trace->log('done'); + + FS::Trace->dumpfile( "%%%FREESIDE_EXPORT%%%/profile/$$.".time, + FS::Trace->total. ' '. $r->filename + ) + if FS::Trace->total > 5; #10? + + FS::Trace->reset; + $status; } +sub my_rt_init { + return unless $RT::VERSION; + RT::ConnectToDatabase(); + RT::InitSignalHandlers(); +} + 1;