Notifier.pl

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, now this page is for historic record only.

#!/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;
}