Server.pl
<perl> use IO::Socket; use IO::Select; use MIME::Base64;
sub 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";
# HTML interface environment $::template = readFile 'peer.html'; $::template =~ s//$::title ($::daemon)/g; $::template =~ s//$::peer/g; $::deny = readFile "$::peer.401"; my $views = ; $views .= "*$_\n" for ( 'Update', 'Filter', 'Events', 'Edit' ); $::template =~ s// wikiParse($views) /e; my $nav = "*Gir Home\n*User:$peer\n"; $nav .= "*$_\n" for ( "env/cmd|Environment Info", "peerlog/cmd|Peer Log", "syslog/cmd|Syslog", "restart/cmd|Restart $::peer", "stop/cmd|Stop $::peer", "reboot/cmd|Restart this server", "fileSync/cmd|Manual fileSync", "wikiSync/cmd|Manual wikiSync", "swfCompile/cmd|Manual swfCompile", "serverBackup/cmd|Backup server now", "wikiBackup/cmd|Backup wiki now", "peerBackup/cmd|Backup peer now", "scpBackups/cmd|SCP Backup now", "Yi|Hexagrams" ); $::template =~ s// wikiParse($nav) /e;
# Simple HTTP 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 an incoming HTTP 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"; } } </perl>