Difference between revisions of "Server.pl"

From Organic Design wiki
(remove server loop - moving into wikid.pl's main loop)
Line 31: Line 31:
 
logAdd "Listening on port $::port";
 
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.";
 
}
 
 
}
 
}
 
 
}
 
}
  

Revision as of 09:52, 27 April 2007

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