From OrganicDesign Wiki
| 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, this is only useful for a historic record of work done. You may find a link to the currently used concept or function in this article, if not you can contact the author to find out what has taken the place of this legacy item.
|
|
#!/usr/bin/perl
# wikid.pl - MediaWiki Wiki-Daemon Extension
# - Version 2.00 started on 2007-04-26
# - See http://www.mediawiki.org/wiki/Extension:WikiDaemon for installation and usage details
# - Licenced under LGPL (http://www.gnu.org/copyleft/lesser.html)
# - Author: http://www.organicdesign.co.nz/nad
$::ver = '2.00 (2007-04-26)';
use POSIX qw(strftime setsid);
use FindBin qw($Bin);
use Getopt::Long;
use Cwd;
use HTTP::Request;
use LWP::UserAgent;
use Net::SCP::Expect;
use IO::Socket;
use IO::Select;
use MIME::Base64;
use strict;
# Set up configuration defaults and get args
our %config = (join ' ',@ARGV);
GetOptions(\%config,'name=s','password=s','wiki=s','port=i','quiet');
$::name = exists $config{name} ? $config{name} : die "--name arg missing!";
$::password = exists $config{password} ? $config{password} : die "--password arg missing!";
$::wiki = exists $config{wiki} ? $config{wiki} : die "--wiki arg missing!";
$::port = exists $config{port} ? $config{port} : 0;
$::dir = $Bin;
$::log = "$::dir/$::name.log";
$::daemon = 'wikid.pl';
$::subname = 'main';
$0 = "$daemon::$::name";
# Run as a daemon (see daemonise.pl article for more details and references regarding perl daemons)
open STDIN, '/dev/null';
open STDOUT, ">>../$::log";
open STDERR, ">>../$::log";
defined ( my $pid = fork ) or die "Can't fork: $!";
exit if $pid;
setsid or die "Can't start a new session: $!";
umask 0;
# Set up a global user-agent
$::client = LWP::UserAgent->new(
cookie_jar => {},
agent => 'Mozilla/5.0',
from => "$::name\@$::daemon",
timeout => 30,
max_size => 500000
);
# Login to local wiki (using global user-agent)
wikiLogin($::wiki,$::name,$::password);
# Add a message to the wiki-changes unless --quiet was specified
logAdd("$::daemon has started as \"$::name\"");
unless(exists $config{quiet}) {
my $comment = "[[$::daemon]] has started as \"$::name\"";
wikiPageAppend($::wiki,"User:$::name/Log","\n*".localtime()." : $comment",$comment,1);
}
# Extract schedule from wiki or file
my @cron;
# Set up TCP server (sets $:server, $::streams, $::select)
&serverInitialise if $::port;
#---------------------------------------------------------------------------------------------------------#
# MAIN SERVER & CRON LOOP
while(1) {
# Check if any of the cron items match the current localtime
my $date = scalar localtime;
for my $i (@cron) {
if ($i =~ /^\*\s*\/(.+?)\/\s*:\s*(\S+)\s*(.+)?/) {
my($rule, $func, $args) = ($1, $2, $3);
spawn($func, split /\s*,\s*/, $args) if $date =~ /$rule/;
}
}
# Loop through streams from select list needing attention
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.");
}
}
}
#---------------------------------------------------------------------------------------------------------#
# GENERAL SUPPORT FUNCTIONS
# use Term::ANSIColor for colouring log entries
sub logAdd {
my $entry = shift;
my $subname;
$subname = $::subname ? "[$subname]\t" : '';
open LOGH,'>>',$::log or die "Can't open $::log for writing!";
print LOGH localtime()." : $subname$entry\n";
close LOGH;
return $entry;
}
# Read in and execute a snippet
sub declare {
$::subname = shift;
if (open FH,'<',$::subname) {
logAdd("Declaring \"$::subname\"") unless $@;
binmode FH;
sysread FH, (my $code), -s $::subname;
close FH;
eval $code;
logAdd("\"$::subname\" failed: $@") if $@;
}
else { logAdd("Couldn't declare $::subname!") }
$::subname = '';
}
# Function for spawning a child to execute a function by name
sub spawn {
my $subname = shift;
my $subref = eval '\&$subname';
$SIG{CHLD} = 'IGNORE';
if (defined(my $pid = fork)) {
if ($pid) { logAdd("Spawned child ($pid) for \"$subname\"") }
else {
$::subname = $subname;
$0 = "$::daemon: $::name ($subname)";
&$subref(@_);
exit;
}
}
else { logAdd("Cannot fork a child for \"$subname\": $!") }
}
# Read and return content from passed file
sub readFile {
my $file = shift;
if (open FH,'<',$file) {
binmode FH;
sysread FH, (my $out), -s $file;
close FH;
return $out;
}
}
# Write passed content to passed file
sub writeFile {
my $file = shift;
if (open FH,'>',$file) {
binmode FH;
print FH shift;
close FH;
return $file;
}
}
#---------------------------------------------------------------------------------------------------------#
# SERVER FUNCTIONS
# Initialise server listening on our port
sub serverInitialise {
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;
%::streams = ();
logAdd("Listening on port $::port");
}
# 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) : ($::name,'','HTTP/1.1');
# If request authenticates service it, else return 401
if ($ct =~ /^cmd/ ? ($msg =~ /Authorization: Basic (\w+)/ and decode_base64($1) eq "$::name:$::password") : 1) {
# Process a command
if ($ct =~ /^cmd(.*)/) {
logAdd("Executing $title command.");
$article = '<pre>'.command($title).'</pre>';
$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 -->/$title/g;
$tmp =~ s/<!-- content -->/ 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::$::name\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";
}
}
#---------------------------------------------------------------------------------------------------------#
# MEDIAWIKI INTEGRATION FUNCTIONS - todo: remove xmlwiki dependency
# Login to a MediaWiki
sub wikiLogin {
my ($wiki,$user,$pass) = @_;
my $url = "$wiki?title=Special:Userlogin";
my $success = 0;
my $retries = 3;
while ($retries--) {
if ($::client->get($url)->is_success) {
my %form = (wpName => $user, wpPassword => $pass, wpLoginattempt => 'Log in', wpRemember => '1');
my $response = $::client->post("$url&action=submitlogin", \%form);
$success = $response->is_success && $response->content =~ m/You are now logged in/;
}
logAdd($success ? "$::name has logged $user in to $wiki." : "ERROR: $::name couldn't log $user in to $wiki!");
$retries = 0 if $success;
}
return $success;
}
# Edit a MediaWiki page
# todo: don't return success if edited succeeded but made no changes
sub wikiPageEdit {
my ($wiki,$page,$content,$comment,$minor) = @_;
logAdd("Attempting to edit \"$page\" on $wiki");
my $success = 0;
my $err = 'ERROR';
my $retries = 3;
while ($retries--) {
# Request the page for editing and extract the edit-token
my $response = $::client->get("$wiki?title=$page&action=edit");
if ($response->is_success and (
$response->content =~ /^<input\ type='hidden'\ value="(.*?)"\
name="wpSection".+?value="(.*?)"\
name="wpStarttime".+?value="(.*?)"\
name="wpEdittime".+?<\/textarea>.+?
^<input\ type='hidden'\ value="(.+?)"\
name="wpEditToken".+?name="wpAutoSummary"\
type="hidden"\ value="(.+?)"/sxm
or
$response->content =~ /^<input\ type='hidden'\ value="(.*?)"\
name="wpSection".+?value="(.*?)"\
name="wpEdittime".+?value="(.*?)"\
name="wpEditToken"/sxm
)) {
# Got token etc, now submit an edit-form
my %form = (
wpSection => $1,
wpEdittime => $5 ? $3 : $2,
wpEditToken => $5 ? $4 : $3,
wpTextbox1 => $content,
wpSummary => $comment,
wpSave => 'Save page'
);
$form{wpMinoredit} = 1 if $minor;
$form{wpStarttime} = $2 if $5;
$form{wpAutoSummary} = $5 if $5;
$response = $::client->post("$wiki?title=$page&action=submit", \%form);
if ($response->content =~ /<!-- start content -->Someone else has changed this page/) {
$err = 'EDIT CONFLICT';
$retries = 0;
} else { $success = !$response->is_error }
} else { $err = $response->is_success ? 'MATCH FAILED' : 'RQST FAILED' }
if ($success) { $retries = 0; logAdd "$::name has modified \"$page\""; }
else { logAdd("$err: $::name couldn't edit \"$page\" on $wiki!") }
}
return $success;
}
# Append a wiki page
sub wikiPageAppend {
my ($wiki,$page,$append,$comment) = @_;
my $content = wikiRawPage($wiki, $page);
$content = '' if $content eq '(There is currently no text in this page)';
return wikiPageEdit($wiki,$page,$content.$append,$comment);
}
# Get the date of last edit of an article
sub wikiLastEdit {
my($wiki,$page) = @_;
# Request the last history entry and extract date
my $response = $::client->request(HTTP::Request->new(GET => "$wiki?title=$page&action=history&limit=1&xpath://view:"));
return $1 if $response->is_success and $response->content =~ /<a.+?>(\d+:\d+.+?\d)<\/a>/;
}
# Get all the details of the last edit
# - the returned items are formatted specifically for the XmlWiki changes
sub wikiLastEditDetails {
my($wiki,$page) = @_;
# Try getting the last edit of page history from the wiki
my $url = "$wiki?title=$page&xpath://view:&action=history&limit=1";
my $get = $::client->get($url);
$get->is_success ? my $content = $get->content : return logAdd "Couldn't connect to $wiki";
# Log in and try again if content is not a history page
unless ($content =~ /<div id="contentSub">(Revision history)|(Historikk)/) {
logAdd("\t$page required the login") unless wikiLogin($wiki,$::peer,$::pwd1);
$get = $::client->get($url);
$get->is_success ? $content = $get->content : return logAdd "Couldn't connect to $wiki";
return logAdd("Not a valid history page!") unless $content =~ /<div id="contentSub">Revision history/;
}
# Extract and return the required information
my $time = $content =~ /<a.+?>(\d+:\d+.+?\d+)<\/a>/ ? $1 : '';
my $site = $content =~ /<a href=".*?([^\/]+?):About"/ ? $1 : '???';
$site =~ s/_/ /g;
my $diff = $content =~ /<a href=".+?(\?title=.+?)".*?>last<\/a>/
? "<a$::style href=\"$wiki$1\">diff</a>" : '';
my $hist = "<a$::style href=\"$wiki?title=$page&action=history\">hist</a>";
my $user = $content =~ /<span class='.*?user'><a.+?title="(.+?)".*?>(.+?)<\/a>/i
? "<a$::style href=\"$wiki?title=$1\">$2</a>" : '???';
my $talk = "<a$::style href=\"$wiki?title=User_talk:$user\">talk</a>";
my $flags = $content =~ /<span class="minor">(.+?)<\/span>/ ? $1 : '';
my $title = $page;
$title =~ s/_/ /g;
$title = "<a$::style href=\"$wiki?title=$page\">$title</a>";
my $comment = $content =~ /<span class=.comment.>\((.+?)\)<\/span>/
? $1 : $content =~ /<em>\((.+?)\)<\/em><\/li>/ ? $1 : '';
return ($site,$time,$diff,$hist,$flags,$title,$user,$talk,$comment);
}
# Retreive the raw content of a page
sub wikiRawPage {
my( $wiki, $page ) = @_;
my $response = $::client->get("$wiki?title=$page&action=raw");
return $response->content if $response->is_success;
}
# Returns a hash of link/title pairs
# - the page has no view transforms or skin applied,
# - it is returned after the data transforms, so the list can be composed of list-cats and embeds.
sub wikiGetList {
my($wiki,$page) = @_;
my $response = $::client->get("$wiki?title=$page&action=raw&templates=expand");
my %list = $response->content =~ /<li>.*?<a href="(.+?)"\s+title="(.+?)"\s*>.+?<\/a>\s*<\/li>/gs;
# bugfix: swap keys/vals
my %tmp = ();
while (my($k,$v) = each %list) { $tmp{$v} = $k };
return %tmp;
}
# Returns mediawiki version string
# Should work for all versions of mediawiki or xmlwiki
sub wikiGetVersion {
my $wiki = shift;
my $response = $::client->get("$wiki?title=Special:Version");
return $1 if $response->content =~ /MediaWiki.+?: ([0-9.]+[0x20-0x7e]+)/;
}
# Logout of a MediaWiki
sub wikiLogout {
my $wiki = shift;
my $success = $::client->get("$wiki?title=Special:Userlogout")->is_success;
logAdd($success ? "$::name has logged out of $wiki." : "WARNING: $::name couldn't logout of $wiki!");
return $success;
}
