Notifier.pl

From Organic Design wiki
Revision as of 12:58, 8 December 2011 by Nad (talk | contribs) (Category:PERL)
Legacy.svg 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.

<perl>

  1. !/usr/bin/perl
  2. notifier.pl - Multiprotocol notification daemon for OrganicDesign
  3. Started 2008-06-20, based on wikid.pl
  4. - See http://www.organicdesign.co.nz/odserver.pl
  5. - Licenced under LGPL (http://www.gnu.org/copyleft/lesser.html)
  6. - 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;

  1. 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";

  1. Converts the process into a daemon
  2. - handles --install, --remove, --stop

daemonise();

  1. Retrieve rules

$::rules = getResource($::rules) or die "rules missing or unreadable!";

  1. 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 );

  1. 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) } } }

  1. 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(); }

  1. 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; }

  1. 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; } }

  1. Write passed content to passed file

sub writeFile { my $file = shift; if (open FH, '>', $file) { binmode FH; print FH shift; close FH; return $file; } }

  1. Return an array of scheme, user, password, host and path for a URL

sub parseURL { return ($1, $3, $4, $5, $6) if shift =~ /^(.+?):\/*((.+?):(.+?)@)?(.+?)\/(.+)?$/; }

  1. 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 } }

  1. 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 } }

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

  1. 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."); } } }

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

  1. Login to a MediaWiki
  2. 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 =~ /

\s*(

.+?<\/h2>\s*)?(.+?)\s*<\/div>/is) { logAdd "ERROR: $2" }

else { logAdd "ERROR: couldn't log $user in to $wiki!" } } } return $success; }

  1. Edit a MediaWiki page
  2. 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 =~ /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; } </perl>

Retrieved from "https://organicdesign.nz/wiki/index.php?title=Notifier.pl&oldid=106095"