Livelets.pl

1. !/usr/bin/perl
2. LiveWiki ExtensionOur Perl scripts.Scripts and articles related to Extension:Livelets, see also Wiklets
3. - See http://www.mediawiki.org/wiki/Extension:LiveWiki for installation and usage details
4. - Licenced under LGPL (http://www.gnu.org/copyleft/lesser.html)

use IO::Socket; use IO::Select; use MIME::Base64;

1. 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;

1. ----------------------------------------------------------------------------------------------------------- #
2. SOCKET SERVER

%::streams = (); $::port = shift or 80; $0 = "$::daemon: $::peer (http$::port)"; my $subname = $::subname;

1. 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";

1. 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."; }

} } }

1. ----------------------------------------------------------------------------------------------------------- #
2. 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;

1. 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' );

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\"" }

1. 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"; }

1. ----------------------------------------------------------------------------------------------------------- #
2. STREAM THREAD
3. - this is the single peerd-server loop running in its own thread
4. - nodal reduction can be in here instead of each session handler
5. - 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."; }

} } }

1. ----------------------------------------------------------------------------------------------------------- #
2. SESSION-HANDLER
3. - A separate interfaceHandler function is spawned for each peer.swf connect request
4. - a session-handler is a dedicated thread sitting between nodal-wikid.pl and a peer.swf
5. - 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; }

} } }