Notifier.pl

1. !/usr/bin/perl
2. odserver.pl - Multiprotocol notification daemon for OrganicDesign
3. Started 2008-06-20, based on wikid.plOur Perl scripts.
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(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;

1. Set up configuration defaults and get args

our %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}  : die "--pass arg missing!"; $::rules = exists $config{rules} ? $config{rules} : die "--rules arg missing!"; $::daemon = 'odserver.pl'; $::dir = $Bin; $::log = "$::dir/$::user.log";

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

1. Set up a global user-agent

$::client = LWP::UserAgent->new( cookie_jar => {}, agent => 'Mozilla/5.0', from => "$::user\@organicdesign.co.nz", timeout => 30, max_size => 100000 );

1. Retrieve rules

1. Login to all resources found in rules which require authentication (each IRC server needs its own stream)

wikiLogin($::wiki, $::name, $::password);

1. Add a message to the wiki-changes unless --quiet was specified

logAdd("$::daemon has started and is authenticated as \"$::user\"");

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

} }

1. Append message to log file

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

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') { } elsif ($scheme =~ /^https?$/) { } elsif ($scheme eq 'mediawiki') { } elsif ($scheme =~ /^pop3?$/i) { } else { logAdd "Unsupported scheme ($scheme) in getResource" } }

1. Update a resource given a URL

sub putResource { my ($url, $content, $comment) = @_; ($scheme, $user, $pass, $host, $path) = parseURL($url); if ($scheme eq 'file') { } elsif ($scheme eq 'mediawiki') { } elsif ($scheme eq 'mailto') { } elsif ($scheme eq 'irc') { } else { logAdd "Unsupported scheme ($scheme) in putResource" } }