Server.pl

1. Server.pl is a component of wikid.pl - MediaWiki Wiki-Daemon ExtensionOur Perl scripts.{{#security:*|dev}}{{#security:view|*}}
2. - See http://www.mediawiki.org/wiki/Extension:WikiDaemon for installation and usage details
3. - Licenced under LGPL (http://www.gnu.org/copyleft/lesser.html)
4. - Author: http://www.organicdesign.co.nz/nad
5. - Source: http://www.organicdesign.co.nz/server.pl

1. UNDER CONSTRUCTION - this code is being restructured for WikiD II - started 2007-04-26

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

sub serverInitialise {

%::streams = (); $::port = shift or 1729; $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";

# 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 serverProcessMessage { 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'; }

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