Personal tools

Livelets.pl

From OrganicDesign Wiki

Jump to: navigation, search
#!/usr/bin/perl
# LiveWiki Extension
# - See http://www.mediawiki.org/wiki/Extension:LiveWiki for installation and usage details
# - Licenced under LGPL (http://www.gnu.org/copyleft/lesser.html)
 
use IO::Socket;
use IO::Select;
use MIME::Base64;
 
# Daemonise
open STDIN, '/dev/null';
open STDOUT, ">>../$::peer.log";
open STDERR, ">>../$::peer.log";
defined ( my $pid = fork ) or die "Can't fork: $!";
exit if $pid;
setsid or die "Can't start a new session: $!";
umask 0;
 
# ----------------------------------------------------------------------------------------------------------- #
# SOCKET SERVER
%::streams = ();
$::port = shift or 80;
$0 = "$::daemon: $::peer (http$::port)";
my $subname = $::subname;
 
# Initialise server listening on our port
do { unless ( $::server = new IO::Socket::INET
		Listen => 1,
		LocalPort => $::port,
		Proto => 'tcp',
		ReuseAddr => 1 ) {
			logAdd "Failed to bind to Port$::port, waiting 10 seconds...";
			sleep(10);
			}
	} until ( $::server );
$::select = new IO::Select $::server;
logAdd "Listening on port $::port";
 
# Main server loop
while(1) {
	for my $handle ( $::select->can_read(1) ) {
		my $stream = fileno $handle;
		$::subname = "$subname/stream$stream";
 
		# Handle is the server, set up a new stream
		if ( $handle == $::server ) {
			my $newhandle = $::server->accept;
			$stream = fileno $newhandle;
			$::select->add( $newhandle );
			$::streams{$stream}{buffer} = '';
			$::streams{$stream}{handle} = $newhandle;
			logAdd "New connection: Stream$stream", 'main/new';
			}
 
		# Handle is an existing stream with data to read
		# NOTE: we should disconnect after certain size limit
		# - Process (and remove) all complete messages from this peer's buffer
		elsif ( sysread $handle, my $input, 10000 ) {
			$::streams{$stream}{buffer} .= $input;
			if ( $::streams{$stream}{buffer} =~ s/^(.*\r?\n\r?\n\x00?)//s ) {
				processMessage( $stream, $_ ) for split /\r?\n\r?\n\x00?/, $1;
				}
			}
 
		# Handle is an existing stream with no more data to read
		else {
			$::select->remove( $handle );
			delete $::streams{$stream};
			$handle->close();
			logAdd "Stream$stream disconnected.";
			}
 
		}
	}
}
 
# ----------------------------------------------------------------------------------------------------------- #
# PROCESS INCOMING MESSAGE
sub processMessage {
my ( $stream, $msg ) = @_;
my $handle = $::streams{$stream}{handle};
my $headers = '';
my $http = '200 OK';
my $respond = 1;
my $date = strftime "%a, %d %b %Y %H:%M:%S %Z", localtime;
my $article = $::deny;
 
# Extract info from the HTTP GET request
my ( $title, $ct, $ver ) =
	$msg =~ /GET\s+\/+(.*?)(\/(.+))?\s+(HTTP\/[0-9.]+)/ ? ( $1, $3, $4 ) : ( $peer, '', 'HTTP/1.1' );
 
# If request authenticates service it, else return 401
if ( $ct =~ /^cmd/ ? ( $msg =~ /Authorization: Basic (\w+)/ and decode_base64($1) eq "$::peer:$::pwd1" ) : 1 ) {
 
	# Process a command
	if ( $ct =~ /^cmd(.*)/ ) {
		logAdd "Executing $title command.";
		$article = '
'.command($title).'
';

		$ct = '' if $1 ne '/raw';
		}
 
	# Process request from other peer or peer-related process
	# - doesn't return an HTTP response
	elsif ( $ct =~ /^peer\/(.*)/ ) {
		my $type = $1;
		logAdd "PEER command \"$title\" received from an instance of \"$type\"";
 
		# peerd-child is doing initial connection, keep handle in global scope
		# - peerd could talk back here over this stream, but doesn't currently
		if ( $title eq 'connect' and $type eq 'peerd' ) {
			$::peerdHandle = $handle;
			}
 
		# Forward any commands from XmlWiki to peerd unchanged
		elsif ( $type eq 'notify-peer.php' ) {
			print $::peerdHandle "$title/$type\x00" if defined $::peerdHandle;
			}
 
		# SWF initiating connection, ask peerd to connect back on a new stream for a session
		elsif ( $title eq 'connect' and $type eq 'interface' ) {
			# Send stream-id of swf, so we know which one is wanted by the connection back from peerd
			print $::peerdHandle "connect-request/stream$stream\x00" if defined $::peerdHandle;
			# Remove the handle from this (server.pl) context, but don't close it
			# - also keep our local %stream info to give to session-handler
			$::select->remove( $handle );
			}
 
		# peerd is connecting back from session request, so we can now spawn the session-handler
		elsif ( $title eq 'session' and $type =~ /^peerd\/stream([0-9]+)/ ) {
			# Spawn a new session-handler child and pass the peerd and peer.swf stream-handles
			spawn 'sessionHandler', $handle, $::streams{$1}{handle};
			# We can remove the interface from %streams now too
			delete $::streams{$1};
			}
 
		# These peer requests don't want HTTP returned currently
		$respond = 0;
		}
 
	# Process request for raw SWF
	elsif ( $ct eq 'application/x-shockwave-flash' ) {
		$headers .= "Content-Disposition: inline;filename=$::peer.swf\r\n";
		logAdd "SWF movie \"$title\" requested";
		$article = readFile $title;
		}
 
	# Process request for SWF embedded in HTML
	elsif ( $ct eq 'swf' ) {
		my $width = 640;
		my $height = 480;
		my $file = "/$::peer.swf/application/x-shockwave-flash";
		$article = "<object classid=\"clsid:D27CDB6E-AE6D-11cf-96B8-444553540000\"
codebase=\"http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,0,0\"
width=\"$width\" height=\"$height\" id=\"$file\" align=\"\"
type=\"application/x-shockwave-flash\" data=\"$file\">
<param name=\"movie\" value=\"$file\">
<param name=\"quality\" value=\"high\">
<param name=\"bgcolor\" value=\"cccccc\">
<embed src=\"$file\" quality=\"high\" bgcolor=\"cccccc\"
	width=\"$width\" height=\"$height\" align=\"\"
	name=\"$file\" type=\"application/x-shockwave-flash\"
	pluginspage=\"http://www.macromedia.com/go/getflashplayer\" />
</object>";
		$ct = '';
		}
 
	# If still non processed, treat request as local filename to return
	else {
		logAdd "$title($ct) requested";
		$article = readFile $title;
		}
 
	# Render article
	unless ( $ct ) {
		$ct = 'text/html';
		my $tmp = $::template;
		$tmp =~ s//$title/g;
		$tmp =~ s// wikiParse $article /e;
		$article = $tmp;
		}
	}
else { $http = "401 Authorization Required\r\nWWW-Authenticate: Basic realm=\"private\"" }
 
# Send response back to requestor
if ( $respond ) {
	$headers = "$ver $http\r\nDate: $date\r\nServer: $::daemon\r\n$headers";
	$headers .= "Content-Type: $ct\r\n";
	$headers .= "Connection: close\r\n";
	$headers .= "Content-Length: ".(length $article)."\r\n";
	print $handle "$headers\r\n$article";
	}
 
# ----------------------------------------------------------------------------------------------------------- #
# STREAM THREAD
# - this is the single peerd-server loop running in its own thread
# - nodal reduction can be in here instead of each session handler
# - only stream message construct/extract needs to be in the individual session-handler threads
sub peerd {
 
	my $port = shift;
 
	# On startup, notify server.pl who'll preserve our handle in global scope
	my $server;
	do {
		$server = new IO::Socket::INET PeerAddr => 'localhost', PeerPort => $port, Proto => 'tcp';
		unless ( $server ) {
			logAdd "Couldn't establish connection to parent, retrying in 10 seconds.";
			sleep(10);
			}
		} until ( $server );
	print $server "GET /connect/peer/peerd HTTP/1.1\r\n\r\n";
 
	# Initialise streams
	my $select = IO::Select->new( $server );
	my %streams = ();
	$streams{fileno $server}{handle} = $server;
	$streams{fileno $server}{buffer} = '';
 
	# Main server loop (listening to server.pl and session-handlers)
	while(1) {
 
		# Loop through readable streams
		for my $handle ( $select->can_read(1) ) {
			my $stream = fileno $handle;
 
			# There is data to read on this stream, accumulate in this streams input buffer
			if ( sysread $handle, my $input, 10000 ) {
				$streams{$stream}{buffer} .= $input;
 
				# At least one complete message has accumulated
				if ( $streams{$stream}{buffer} =~ s/^(.*\x00)//s ) {
 
					# Remove each complete message from buffer and process
					for my $msg ( split /\x00/, $1 ) {
 
						# Message is from server.pl:
						if ( $handle == $server ) {
							logAdd "Message from server.pl: \"$msg\"";
 
							# Msg is a connect-request, so establish new stream back to server.pl
							# - the new stream-handle will be given to a newly spawned session-handler
							if ( $msg =~ /connect-request\/(stream[0-9]+)$/ ) {
								if ( my $ph = new IO::Socket::INET PeerAddr => 'localhost', PeerPort => $port, Proto => 'tcp' ) {
									print $ph "GET /session/peer/peerd/$1 HTTP/1.1\r\n\r\n";
									my $pstream = fileno $ph;
									$streams{$pstream}{handle} = $ph;
									$streams{$pstream}{buffer} = '';
									$streams{$pstream}{interface} = 1;
									logAdd "Connecting back to server on stream$pstream";
									}
								else { logAdd "Failed to establish new connection with server.pl!" }
								}
 
							# Not connect-request, so propagate msg to session-handlers
							else {
								logAdd "Forwarding msg to session-handlers...";
								for ( keys %streams ) {
									my $sh = $streams{$_}{handle};
									print $sh "$msg\x00" if exists $streams{$_}{interface};
									logAdd "Forwarded to stream$_" if exists $streams{$_}{interface};
									}
								}
							}
 
						# Message is not from server.pl, must be from a session-handler
						else {
							logAdd "Message from a session-handler: \"$msg\"";
							}
						}
					}
				}
 
			# There is no more data to read on this stream, so close it
			else {
				$::select->remove( $handle );
				delete $streams{$stream};
				$handle->close();
				logAdd "Stream$stream disconnected.";
				}
 
			}
		}
	}
 
# ----------------------------------------------------------------------------------------------------------- #
# SESSION-HANDLER
# - A separate interfaceHandler function is spawned for each peer.swf connect request
# - a session-handler is a dedicated thread sitting between nodal-wikid.pl and a peer.swf
# - todo: this is spawned by server.pl, but that should be moved into here
sub sessionHandler {
 
	my( $peerd, $interface ) = @_;
	$::subname .= "/$$";
	my $pstream = fileno $peerd;
	my $istream = fileno $interface;
	logAdd "Session-handler( peerd/stream$pstream, interface/stream$istream )";
 
	# Set up a new listener for interface and parent
	my $select = IO::Select->new( $peerd, $interface );
 
	# Introduce ourselves to the interface we've been assigned to handle
	print $interface "Hello, I'm your session-handler, my PID is $$.\x00";
 
	# Server loop (listening to parent and interface streams)
	my %buffers = {};
	while(1) {
		for my $handle ( $select->can_read(1) ) {
 
			# One of our streams has data to read
			if ( sysread $handle, my $input, 10000 ) {
				my $stream = fileno $handle;
				$buffers{$stream} .= $input;
				if ( $buffers{$stream} =~ s/^(.*\x00)//s ) {
					for ( split /\x00/, $1 ) {
						logAdd "Msg received on stream$stream: \"$_\"";
						# Forward all data from peerd to interface
						print $interface "$_\x00" if $handle == $peerd;
						}
					}
				}
 
			# If either connection close, close stream-handle and die
			else {
				$peerd->close();
				$interface->close();
				logAdd 'Handles closed, Exit.';
				exit;
				}
 
			}
		}


	}
Retrieved from "http://www.organicdesign.co.nz/Livelets.pl"

The GNU Project Debian Linux Ubuntu Linux Wikipedia Affiliate Button MediaWiki