[interchange-cvs] interchange - jon modified 4 files

interchange-core@interchange.redhat.com interchange-core@interchange.redhat.com
Thu Jun 27 15:00:01 2002


User:      jon
Date:      2002-06-27 18:59:36 GMT
Modified:  .        MANIFEST
Modified:  lib/Vend Server.pm
Added:     lib/Vend ModPerl.pm
Added:     scripts  ic_mod_perl.PL
Log:
Add entirely new way to run Interchange: inside Apache/mod_perl, with no
separate Interchange daemon and no link program. Still experimental and
under development, but does work with a few exceptions.

POD documentation in scripts/ic_mod_perl.PL should be enough to get you
started if you want to try it, and details some of my rationale and the
pros and cons of doing this.

A key feature is that the exact same Interchange installation can be set
up to work either with the standalone IC daemon, or inside mod_perl, and
you can switch back and forth between the two with no code or config
changes.

Revision  Changes    Path
2.43      +3 -0      interchange/MANIFEST


rev 2.43, prev_rev 2.42
Index: MANIFEST
===================================================================
RCS file: /var/cvs/interchange/MANIFEST,v
retrieving revision 2.42
retrieving revision 2.43
diff -u -u -r2.42 -r2.43
--- MANIFEST	20 Jun 2002 14:41:54 -0000	2.42
+++ MANIFEST	27 Jun 2002 18:59:36 -0000	2.43
@@ -909,6 +909,7 @@
 lib/Vend/Imagemap.pm
 lib/Vend/Interpolate.pm
 lib/Vend/MakeCat.pm
+lib/Vend/ModPerl.pm
 lib/Vend/Order.pm
 lib/Vend/Page.pm
 lib/Vend/Parse.pm
@@ -945,12 +946,14 @@
 lib/Vend/UserDB.pm
 lib/Vend/Util.pm
 perl/Interchange.pm
+relocate.pl
 scripts/compile_link.PL
 scripts/config_prog.PL
 scripts/configdump.PL
 scripts/dump.PL
 scripts/expire.PL
 scripts/expireall.PL
+scripts/ic_mod_perl.PL
 scripts/interchange.PL
 scripts/localize.PL
 scripts/makecat.PL



2.7       +85 -62    interchange/lib/Vend/Server.pm


rev 2.7, prev_rev 2.6
Index: Server.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Server.pm,v
retrieving revision 2.6
retrieving revision 2.7
diff -u -u -r2.6 -r2.7
--- Server.pm	17 Jun 2002 22:24:08 -0000	2.6
+++ Server.pm	27 Jun 2002 18:59:36 -0000	2.7
@@ -1,6 +1,6 @@
 # Vend::Server - Listen for Interchange CGI requests as a background server
 #
-# $Id: Server.pm,v 2.6 2002/06/17 22:24:08 jon Exp $
+# $Id: Server.pm,v 2.7 2002/06/27 18:59:36 jon Exp $
 #
 # Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -25,7 +25,7 @@
 package Vend::Server;
 
 use vars qw($VERSION);
-$VERSION = substr(q$Revision: 2.6 $, 10);
+$VERSION = substr(q$Revision: 2.7 $, 10);
 
 use POSIX qw(setsid strftime);
 use Vend::Util;
@@ -186,6 +186,9 @@
 			? ($g->{IV}, $g->{VN}, $g->{IgnoreMultiple})
 			: ($Global::IV, $Global::VN, $Global::IgnoreMultiple);
 
+	# Vend::ModPerl has already handled GET/POST parsing
+	return if $Global::mod_perl;
+
 #::logDebug("CGI::query_string=" . $CGI::query_string);
 #::logDebug("entity=" . ${$h->{entity}});
 	undef %CGI::values;
@@ -557,9 +560,7 @@
 
 my $HTTP_enabled;
 my $Remote_addr;
-my $Remote_host;
 my %CGImap;
-my %CGIspecial;
 
 BEGIN {
 	eval {
@@ -598,7 +599,6 @@
 
 					/
 		);
-		%CGIspecial = ();
 	};
 										 
 }                                    
@@ -734,10 +734,6 @@
 			if(defined $CGImap{$header}) {
 				$$env{$CGImap{$header}} = $block;
 			}
-			elsif(defined $CGIspecial{$header}) {
-				&{$CGIspecial{$header}}($env, $block);
-			}
-			# else { throw_away() }
 			next;
 		}
 		else {
@@ -1260,8 +1256,10 @@
 	push (@types, 'INET') if $Global::Inet_Mode;
 	push (@types, 'UNIX') if $Global::Unix_Mode;
 	push (@types, 'SOAP') if $Global::SOAP;
+	push (@types, 'mod_perl') if $Global::mod_perl;
 	my $server_type = join(" and ", @types);
-	my @args = $reverse ? ($server_type, $$) : ($$, $server_type);
+	my $pid = read_pidfile();
+	my @args = $reverse ? ($server_type, $pid) : ($pid, $server_type);
 	return ::errmsg ($fmt , @args );
 }
 
@@ -1502,26 +1500,7 @@
 		}
 		elsif (! $pid) {
 			unless( $pid = fork ) {
-				close(STDOUT);
-				close(STDERR);
-				close(STDIN);
-				if ($Global::DebugFile) {
-					open(Vend::DEBUG, ">>$Global::DebugFile.soap");
-					select Vend::DEBUG;
-					$| =1;
-					print "Start DEBUG at " . localtime() . "\n";
-				}
-				elsif (!$Global::DEBUG) {
-					# May as well turn warnings off, not going anywhere
-					$^W = 0;
-					open (Vend::DEBUG, ">/dev/null") unless $Global::Windows;
-				}
-
-				open(STDOUT, ">&Vend::DEBUG");
-				select(STDOUT);
-				$| = 1;
-				open(STDERR, ">&Vend::DEBUG");
-				select(STDERR); $| = 1; select(STDOUT);
+				setup_debug_log();
 
 				$Global::Foreground = 1;
 
@@ -1926,12 +1905,40 @@
 	close SOCK;
 }
 
+sub setup_debug_log {
+	if ($Global::DebugFile) {
+		open(Vend::DEBUG, ">>$Global::DebugFile");
+		select Vend::DEBUG;
+		$| = 1;
+		print "Start DEBUG at " . localtime() . "\n";
+	}
+	elsif (!$Global::DEBUG) {
+		# May as well turn warnings off, not going anywhere
+		$^W = 0;
+		open (Vend::DEBUG, ">/dev/null") unless $Global::Windows;
+	}
+
+	close(STDIN);
+	close(STDOUT);
+	close(STDERR);
+
+	open(STDOUT, ">&Vend::DEBUG");
+	select(STDOUT);
+	$| = 1;
+
+	open(STDERR, ">&Vend::DEBUG");
+	select(STDERR);
+	$| = 1;
+}
+
 # The servers for both are now combined
 # Can have both INET and UNIX on same system
 sub server_both {
     my ($socket_filename) = @_;
     my ($n, $rin, $rout, $pid);
 
+	::logGlobal({ level => 'info' }, server_start_message());
+
 	$Vend::MasterProcess = $$;
 
 	$tick        = $Global::HouseKeeping || 60;
@@ -1956,7 +1963,6 @@
 		$ipc_socket{$ipc} = $ipc;
 		$unix_socket{$ipc} = $ipc;
 		$ipc_vector = $vector;
-		
 	}
 
 	# Make UNIX-domain sockets if applicable. The sockets are mapped into the
@@ -2084,27 +2090,7 @@
 		::logGlobal({ level => 'info' }, "Running in foreground, OS=$^O, debug=$Global::DEBUG\n");
 	}
 	else {
-		close(STDIN);
-		close(STDOUT);
-		close(STDERR);
-
-		if ($Global::DebugFile) {
-			open(Vend::DEBUG, ">>$Global::DebugFile");
-			select Vend::DEBUG;
-			$| =1;
-			print "Start DEBUG at " . localtime() . "\n";
-		}
-		elsif (!$Global::DEBUG) {
-			# May as well turn warnings off, not going anywhere
-			$^W = 0;
-			open (Vend::DEBUG, ">/dev/null") unless $Global::Windows;
-		}
-
-		open(STDOUT, ">&Vend::DEBUG");
-		select(STDOUT);
-		$| = 1;
-		open(STDERR, ">&Vend::DEBUG");
-		select(STDERR); $| = 1; select(STDOUT);
+		setup_debug_log();
 #::logDebug("s_vector=" . unpack('b*', $s_vector));
 		if($s_vector) {
 			start_soap(1);
@@ -2343,12 +2329,10 @@
         no strict 'subs';
         truncate($fh, 0) or die "Couldn't truncate pid file: $!\n";
     }
-    print $fh $$, "\n";
+    print $fh ($Global::mod_perl ? getppid : $$), "\n";
     return 0;
 }
 
-
-
 sub open_pid {
 	my $fn = shift || $Global::PIDfile;
 	my $fh = gensym();
@@ -2361,34 +2345,73 @@
 	return $fh;
 }
 
+sub read_pidfile {
+	my $fn = shift || $Global::PIDfile;
+	my $fh = gensym();
+	open $fh, "<$fn" or return;
+	chomp (my $pid = <$fh>);
+	close $fh;
+	return $pid;
+}
+
 sub run_server {
     my $next;
 	
     my $pidh = open_pid($Global::PIDfile);
 
-	unless($Global::Inet_Mode || $Global::Unix_Mode || $Global::Windows) {
-		$Global::Inet_Mode = $Global::Unix_Mode = 1;
+	if ($Global::mod_perl) {
+		undef $Global::Unix_Mode;
+		undef $Global::Inet_Mode;
+		undef $Global::StartServers;
+		undef $Global::PreFork;
+		undef $Global::SOAP;
+		undef $Global::IPCsocket;
 	}
 	elsif ( $Global::Windows ) {
 		$Global::Inet_Mode = 1;
 	}
+	elsif (! $Global::Inet_Mode and ! $Global::Unix_Mode) {
+		$Global::Inet_Mode = $Global::Unix_Mode = 1;
+	}
 
-	::logGlobal({ level => 'info' }, server_start_message());
-
-	if($Global::PreFork || $Global::DEBUG || $Global::Windows) {
+	if($Global::mod_perl || $Global::PreFork || $Global::DEBUG || $Global::Windows) {
 		eval {
 			require Tie::ShadowHash;
 		};
 		if($@) {
 			my $reason;
-			if($Global::PreFork)	{ $reason = 'in PreFork mode' }
+			if($Global::mod_perl)	{ $reason = 'under mod_perl' }
+			elsif($Global::PreFork)	{ $reason = 'in PreFork mode' }
 			elsif($Global::DEBUG)	{ $reason = 'in DEBUG mode' }
 			elsif($Global::Windows)	{ $reason = 'under Windows' }
 			die ::errmsg("Running $reason requires Tie::ShadowHash module.") . "\n";
 		}
 	}
 
-    if ($Global::Windows || $Global::DEBUG) {
+	if ($Global::mod_perl) {
+		my $running = grab_pid($pidh);
+		if ($running) {
+			print errmsg(
+				"The Interchange server is already running (process id %s)\n",
+				$running,
+			);
+			undef $Global::mod_perl;
+			return;
+		}
+		# throw away pidfile -- Apache hasn't forked yet, so pid is wrong
+		unlockfile($pidh);
+		unlink $Global::PIDfile;
+		print server_start_message("Interchange server started (%s)\n", 1);
+		::logGlobal(
+			{ level => 'info' },
+			Vend::Server::server_start_message('START server (%s)', 1),
+		);
+		setup_debug_log();
+		# all done; now wait for Apache to call Vend::ModPerl::handler
+		return;
+	}
+
+	if ($Global::Windows || $Global::DEBUG) {
         my $running = grab_pid($pidh);
         if ($running) {
 			print errmsg(



2.1                  interchange/lib/Vend/ModPerl.pm


rev 2.1, prev_rev 2.0



1.1                  interchange/scripts/ic_mod_perl.PL


rev 1.1, prev_rev 1.0
Index: ic_mod_perl.PL
===================================================================
#!/usr/bin/perl
##!~_~perlpath~_~


=head1 NAME

ic_mod_perl -- Run Interchange entirely inside Apache/mod_perl


=head1 SYNOPSIS

  # Add to Apache httpd.conf:
  PerlRequire /usr/lib/interchange/bin/ic_mod_perl
  PerlChildInitHandler Vend::ModPerl::child_start
  PerlChildExitHandler Vend::ModPerl::child_end
  <Location /ic>
      SetHandler perl-script
      PerlHandler Vend::ModPerl
      PerlSendHeader Off
      PerlSetupEnv On
  </Location>


=head1 DESCRIPTION


=head2 Benefits

=item *

Possibly better stability, especially on non-Linux platforms where
Perl signals are often buggy.

=item *

Use less memory total; don't have preforked Apache I<and> Interchange
daemons. Adds about 8 MB more to a typical Apache/mod_perl child process,
for a total of, say, 32 MB per Apache child process. But standalone
Interchange usually has 3 processes: an Interchange child process (~24
MB), an httpd child (~24 MB), I<and> a link CGI (~1 MB), so it's
actually a decent savings in total memory used.

=item *

Speed (ranging from slightly faster to the same on heavy pages,
to 10 hits/sec. faster on empty pages).

=item *

Debugging -- delve into bowels with Apache::Status.

=item *

Easier coexistence with other mod_perl code and libraries.

=item *

Can coexist with standalone Interchange codebase without problems.

=item *

Administrative ease (for sysadmins who know Apache but not Interchange).


=head2 Drawbacks

=item *

Interchange runs as web server user, which in a standard system is usually
apache or www, so you wouldn't want to share that Apache installation
with untrusted user CGIs, PHP, etc. as they could read any Interchange
files, including DSNs, userdb, etc.

=item *

Apache needs to be dedicated, or very closely watched because all
mod_perl stuff runs in the same interpreter, and lots of mod_perl code
doesn't use Safe.

=item *

How do you scale to multiple app servers in this configuration?

=over 4

=item *

Hardware or software port redirector

=item *

Tux CGI front-end redirector like tlink

=item *

Separate lightweight Apache (no modules) that proxies /ic requests

=back


=head2 Ideal system setup

Use Tux to serve images & static content, and a dedicated Apache for
Interchange running under the 'interch' user and with no UserDir, CGI,
PHP, etc. enabled and an empty DocRoot.


=head1 CAVEATS

=item *

Watch out for differing Storable versions in sessions when switching
between standalone and mod_perl runs!


=head1 BUGS

=item *

Haven't yet implemented form/multipart submissions.

=item *

Don't yet handle TolerateGet.

=item *

Don't yet handle MiniVend 3 style GETs (mv_session_id;mv_arg;mv_pc)

=item *

URIs must follow format C</ic/catalogname/page...>, where /ic is
customizable but must only be one "directory" deep (i.e., no
slashes).


=head1 AUTHOR

Jon Jensen <jon@redhat.com>, March 2002

=cut


die <<EOF unless $ENV{MOD_PERL};

ic_mod_perl is meant to run only inside of Apache/mod_perl.
Please see the POD documentation for details:

perldoc $0

EOF


$Global::mod_perl = 1;

package main;
require '/home/jon/xfxf/bin/interchange';
#require '~_~INSTALLARCHLIB~_~/bin/interchange';


1;