Livelets.pl

Legacy: This article describes a concept that has been superseded in the course of ongoing development on the Organic Design wiki. Please do not develop this any further or base work on this concept, this is only useful for a historic record of work done. You may find a link to the currently used concept or function in this article, if not you can contact the author to find out what has taken the place of this legacy item.

#!/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 = '<pre>'.command($title).'</pre>';
		$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 -->/$title/g;
		$tmp =~ s/<!-- content -->/ 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;
				}

			}
		}
	}