Notifier.pl
- !/usr/bin/perl
- notifier.pl - Multiprotocol notification daemon for OrganicDesign
- Started 2008-06-20, based on wikid.plOur Perl scripts.
- - 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} : ; $::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 );
- Global selection of active sockets
$::socks = new IO::Select;
- 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) {
# 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') { } elsif ($scheme =~ /^https?$/) { } elsif ($scheme eq 'mediawiki') { } 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') { } elsif ($scheme eq 'mediawiki') { } elsif ($scheme eq 'mailto') { } elsif ($scheme eq 'irc') { } else { return } }
- Connect to an IRC channel
sub ircConnect { ($host, $channel, $user, $pass) = @_;
$handle = IO::Socket::INET->new( PeerAddr => $host, PeerPort => 6667, Proto => 'tcp' ) or logAdd "could not connect to $channel";
$::socks->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 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(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"; }
# Not a ping else {
# Extract info and tidy ($nick, $type, $channel) = split(/ /, $_); ($nick, $host) = split(/!/, $nick); $nick =~ s/://; $text =~ s/[:\r\n]+//;
# Process if the line is a message in the channel if ($type eq 'PRIVMSG') { $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); delete $streams{$stream}; $handle->close(); logAdd "Stream$stream 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"; }