Difference between revisions of "Server.pl"

From Organic Design wiki
(remove server loop - moving into wikid.pl's main loop)
(put back to old wikid state, and mark as {{legacy}})
Line 1: Line 1:
−
# Server.pl is a component of wikid.pl - MediaWiki Wiki-Daemon Extension{{perl}}{{#security:*|dev}}{{#security:view|*}}
+
{{legacy}}
−
# - See http://www.mediawiki.org/wiki/Extension:WikiDaemon for installation and usage details
+
<perl>
−
# - Licenced under LGPL (http://www.gnu.org/copyleft/lesser.html)
 
−
# - Author: http://www.organicdesign.co.nz/nad
 
−
# - Source: http://www.organicdesign.co.nz/server.pl
 
−
 
−
# UNDER CONSTRUCTION - this code is being restructured for WikiD II - started 2007-04-26
 
−
 
 
 
use IO::Socket;
 
use IO::Socket;
 
use IO::Select;
 
use IO::Select;
 
use MIME::Base64;
 
use MIME::Base64;
  
−
sub serverInitialise {
+
sub server {
  
 
%::streams = ();
 
%::streams = ();
−
$::port = shift or 1729;
+
$::port = shift or 80;
 
$0 = "$::daemon: $::peer (http$::port)";
 
$0 = "$::daemon: $::peer (http$::port)";
 
my $subname = $::subname;
 
my $subname = $::subname;
Line 31: Line 25:
 
logAdd "Listening on port $::port";
 
logAdd "Listening on port $::port";
  
 +
# HTML interface environment
 +
$::template = readFile 'peer.html';
 +
$::template =~ s/<!-- daemon -->/$::title ($::daemon)/g;
 +
$::template =~ s/<!-- peer -->/$::peer/g;
 +
$::deny = readFile "$::peer.401";
 +
my $views = '';
 +
$views .= "*[[$_]]\n" for ( 'Update', 'Filter', 'Events', 'Edit' );
 +
$::template =~ s/<!-- views -->/ wikiParse($views) /e;
 +
my $nav = "*[[$peer|Gir Home]]\n*[http://www.organicdesign.co.nz/User:$peer 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/<!-- navigation -->/ 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
 
# Process an incoming HTTP message
−
sub serverProcessMessage {
+
sub processMessage {
 
my ( $stream, $msg ) = @_;
 
my ( $stream, $msg ) = @_;
 
my $handle = $::streams{$stream}{handle};
 
my $handle = $::streams{$stream}{handle};
Line 57: Line 114:
 
}
 
}
  
 +
# 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
 
# If still non processed, treat request as local filename to return
Line 84: Line 205:
 
}
 
}
 
}
 
}
 +
</perl>

Revision as of 11:20, 2 May 2007

Legacy.svg 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, now this page is for historic record only.

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

} } }

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

Retrieved from "https://organicdesign.nz/wiki/index.php?title=Server.pl&oldid=69213"