|
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
# notifier.pl - Multiprotocol notification daemon for OrganicDesign
# Started 2008-06-20, based on wikid.pl
# - See http://www.organicdesign.co.nz/odserver.pl
# - Licenced under LGPL (http://www.gnu.org/copyleft/lesser.html)
# - Author: http://www.organicdesign.co.nz/nad
use POSIX qw(setsid);
use FindBin qw($Bin);
use Getopt::Long;
use Cwd;
use HTTP::Request;
use LWP::UserAgent;
use IO::Socket;
use IO::Select;
use strict;
# Set up global configuration from args and defaults
%::config = (join ' ', @ARGV);
GetOptions(\%::config, 'user=s', 'pass=s', 'rules=s');
$::user = exists $::config{user} ? $::config{user} : die "--user arg missing!";
$::pass = exists $::config{pass} ? $::config{pass} : '';
$::rules = exists $::config{rules} ? $::config{rules} : 'http://www.organicdesign.co.nz/wiki/index.php?title=Config:Notifier?action=raw';
$::dir = $Bin;
$::log = "$::dir/$::user.log";
$::daemon = 'notifier.pl';
$0 = "$daemon::$::user";
# Converts the process into a daemon
# - handles --install, --remove, --stop
daemonise();
# Retrieve rules
$::rules = getResource($::rules) or die "rules missing or unreadable!";
# Global user-agent for making HTTP connections
$::http = LWP::UserAgent->new(
cookie_jar => {},
agent => 'Mozilla/5.0',
from => "$::user\@organicdesign.co.nz",
timeout => 30,
max_size => 100000
);
# Login to channels and wikis found in rules
foreach (split '/^/', $::rules) {
if (/^\*?\s*schedule\s*:\s*(.+?)\s*^\*?\s*source\s*:\s*(.+?)\s*^\*?\s*match\s*:\s*(.+?)\s*^\*?\s*target\s*:\s*(.+?)\s*^\*?\s*message\s*:\s*(.+?)\s*^\*?\s*comment\s*:\s*(.+?)\s*/msi) {
($schedule, $source, $match, $target, $message, $comment) = ($1, $2, $3, $4, $5, $6);
($scheme,,, $host, $path) = parseURL($source);
if ($scheme eq 'irc') { ircConnect($host, $path, $::user, $::pass) }
elsif ($scheme eq 'mediawiki') { wikiLogin( $host.$path, $::user, $::pass) }
}
}
# Main schedule & socket loop
while (1) {
# Refresh the rules every minute or so
# 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/;
}
}
# Handle any IO on the IRC channels we're connected to
ircChannels();
}
# Append message to log file
sub logAdd {
my $entry = shift;
open LOGH, '>>', $::log or die "Can't open $::log for writing!";
print LOGH localtime()." : $entry\n";
close LOGH;
return $entry;
}
# 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;
}
}
# Return an array of scheme, user, password, host and path for a URL
sub parseURL {
return ($1, $3, $4, $5, $6) if shift =~ /^(.+?):\/*((.+?):(.+?)@)?(.+?)\/(.+)?$/;
}
# Obtain a resource from a URL
sub getResource {
($scheme, $user, $pass, $host, $path) = parseURL(shift);
if ($scheme eq 'file') {
return readFile($path ? "/$host/$path" : "/$host");
}
elsif ($scheme =~ /^https?$/) {
my $response = $::http->get($url);
return $response->content if $response->is_success;
}
elsif ($scheme =~ /^pop3?$/i) {
}
else { return '' }
}
# Update a resource given a URL
sub putResource {
my ($url, $content, $comment) = @_;
($scheme, $user, $pass, $host, $path) = parseURL($url);
if ($scheme eq 'file') {
writeFile($path ? "/$host/$path" : "/$host", $content);
}
elsif ($scheme eq 'mediawiki') {
wikiPageEdit($1, $2, $content, $comment, 0) if $url =~ /(.+?)\?title=(.+)/;
}
}
elsif ($scheme eq 'mailto') {
}
elsif ($scheme eq 'irc') {
print $::channels{$path} $content;
}
else { return '' }
}
# Connect to an IRC channel
sub ircConnect {
($host, $channel, $user, $pass) = @_;
# Connect to IRC server
$handle = IO::Socket::INET->new( PeerAddr => $host, PeerPort => 6667, Proto => 'tcp' )
or logAdd "could not connect to $channel";
# Add the stream to data structures creating if necessary
%::channels = () unless defined %::channels;
$::socks = new IO::Select unless defined $::socks;
$::socks->add($handle);
$::channels{fileno $handle} = ( channel => $channel, buffer => '' );
$::channels{$channel} = $handle;
# Identify nick
while (<$handle>) {
if (/(NOTICE AUTH).*(checking ident)/i) {
print $handle "NICK $user\nUSER $user 0 0 :$::daemon\n";
last;
}
}
# Wait for initialisation message and respond to PING if necessary
while (<$handle>) {
# if the server asks for a ping
print $handle "PONG :".(split(/ :/, $_))[1] if /^PING/;
# end of MOTD section
if (/ (376|422) /) {
print $handle "NICKSERV :identify $user $pass\n";
last;
}
}
# Wait for a while and join the channel
sleep 1;
print $handle "JOIN $channel\n";
}
# Handle any IO on the IRC channels we're connected to
sub ircChannels {
# Loop thru readable handles
for my $handle ($::socks->can_read(0.5)) {
# Read some data from this handle
if (sysread $handle, my $data, 100) {
my $stream = fileno $handle;
$channel = $::channels{$stream}{channel};
# Append the data to this streams buffer
$::channels{$stream}{buffer} .= $data;
# Remove and process any complete messages in the stream
if ($::channels{$stream}{buffer} =~ s/^(.*\r?\n)//s) {
for (split /\r?\n/, $1) {
($command, $text) = split(/ :/, $_);
# Respond to pings if any
if ($command eq 'PING') {
$text =~ s/[\r\n]//g;
print $handle "PONG $text\n";
}
# Not a ping
else {
# Extract info and tidy
($nick, $type, $chan) = split(/ /, $_);
($nick, $host) = split(/!/, $nick);
$nick =~ s/://;
$text =~ s/[:\r\n]+//;
# Process if the line is a message in the channel
if ($chan eq $channel) {
$ts = localtime();
$ts = $1 if $ts =~ /(\d\d:\d\d:\d\d)/;
logAdd "($ts) $channel/$nick: $text\n";
# Respond if message is known
if ($text =~ /(^|\W)$::user(\W|$)/i) {
$msg = "Yo $nick, you talking to me?";
print $handle "PRIVMSG $channel :$msg\n";
logAdd "($ts) $channel/$user: $msg\n";
}
}
}
}
}
}
# Handle has closed (this shouldn't happen, it means the channel must have kicked us)
else {
$::socks->remove($handle);
$handle->close();
delete $::channels{$stream};
delete $::channels{$channel};
logAdd "$channel disconnected.");
}
}
}
# Converts the process into a daemon and also handle --install and --remove
sub daemonise {
# Install the service into init.d and rc2-5.d
if (exists $::config{install}) {
# todo: check if notifier of this name not already running
my $fn = "$::daemon-".lc $::user;
my $target = "/etc/init.d/$fn.sh";
writeFile $target, "#!/bin/sh\n/usr/bin/perl $::dir/$::daemon --user=$::user --pass=$::pass --rules=$::rules\n";
symlink $target, "/etc/rc$_.d/S99$fn" for 2..5;
chmod 0755, "/etc/init.d/$fn.sh";
logAdd "$fn.sh added to /etc/init.d";
}
# Remove the named service and exit
# - remove shell script from init.d and links from rc[2-5].d
if (exists $::config{remove}) {
my $fn = "$::daemon-".lc $::user;
unlink "/etc/rc$_.d/S99$fn" for 2..5;
unlink "/etc/init.d/$fn.sh";
logAdd "$fn.sh removed from /etc/init.d";
exit;
}
# Stop daemon and exit
elsif (exists $::config{stop}) {
logAdd "Stopping $::daemon::$::user... (not done yet)";
# - find currently running notifier of this name and kill it
exit;
}
# Start daemon normally
# - todo: check if notifier of this name not already running
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;
logAdd "$::daemon::$::user started successfully\n";
}
# Login to a MediaWiki
# todo: check if logged in first
sub wikiLogin {
my ($wiki, $user, $pass) = @_;
my $url = "$wiki?title=Special:Userlogin";
my $success = 0;
my $retries = 1;
while ($retries--) {
my $html = '';
if ($::http->get($url)->is_success) {
my %form = (wpName => $user, wpPassword => $pass, wpLoginattempt => 'Log in', wpRemember => '1');
my $response = $::http->post("$url&action=submitlogin&type=login", \%form);
$html = $response->content;
$success = $response->is_success && $html =~ /You are now logged in/;
}
if ($success) {
logAdd "$user successfully logged in to $wiki.";
$retries = 0;
}
else {
if ($html =~ /<div class="errorbox">\s*(<h2>.+?<\/h2>\s*)?(.+?)\s*<\/div>/is) { logAdd "ERROR: $2" }
else { logAdd "ERROR: couldn't log $user in to $wiki!" }
}
}
return $success;
}
# Edit a MediaWiki page
# todo: don't return success if edited succeeded but made no changes
sub wikiPageEdit {
my ($wiki, $title, $content, $comment, $minor) = @_;
logAdd "Attempting to edit \"$title\" on $wiki";
my $success = 0;
my $err = 'ERROR';
my $retries = 1;
while ($retries--) {
# Request the page for editing and extract the edit-token
my $response = $::http->get("$wiki?title=$title&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="(.+?)"/sm
or
$response->content =~ /^<input type='hidden' value="(.*?)" name="wpSection".+?value="(.*?)" name="wpEdittime".+?value="(.*?)" name="wpEditToken"/sm
)) {
# 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 = $::http->post("$wiki?title=$title&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 "\"$title\" updated." }
else { logAdd "$err: Couldn't edit \"$title\" on $wiki!\n" }
}
return $success;
}
