Notifier.pl
From Organic Design wiki
(Redirected from Odserver.pl)
|
#!/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;
}
