Notifier.pl

1. !/usr/bin/perl
2. notifier.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 IO::Socket; use IO::Select; 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!"; $::dir = $Bin; $::log = "$::dir/$::user.log"; $::daemon = 'notifier.pl'; $0 = "$daemon::$::user";

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. Connect to an IRC channels

$::select = new IO::Select; ircConnect('irc.freenode.net', $::user, $::pass, '#organicdesign');

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 & socket 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/; } }

# Handle any IO on the IRC channels we're connected to ircChannels();

}

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

1. Connect to an IRC channel

sub ircConnect { ($host, $user, $pass, $channel) = @_;

$handle = IO::Socket::INET->new( PeerAddr => $host, PeerPort => 6667, Proto => 'tcp' ) or logAdd "could not connect to $channel";

$::select->add($handle);

while (<$handle>) { if (/(NOTICE AUTH).*(checking ident)/i) { print $handle "NICK $user\nUSER $user 0 0 :odbot.pl\n"; last; } }

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 few secs 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 ($::select->can_read(1)) {

# Read some data from this handle if (sysread $handle, my $data, 100) {

# Append the data to the appropriate stream my $stream = fileno $handle; $streams{$stream} = exists($streams{$stream}) ? $streams{$stream}.$data : $data;

# Remove and process any complete messages in the stream if ($streams{$stream} =~ 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"; next; }

# 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)/; print "($ts) $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"; print "($ts) $user: $msg\n"; } } } } }

# Handle has closed (this shouldn't happen, it means the channel must have kicked us) else { $::select->remove($handle); delete $streams{$stream}; $handle->close(); logAdd "Stream$stream disconnected."); } } }