Server.pl

From Organic Design wiki
Revision as of 09:52, 27 April 2007 by Nad (talk | contribs) (remove server loop - moving into wikid.pl's main loop)
  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";

}

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