#!/usr/bin/perl -w # # IRC Chat Logger # # $Source: /usr/local/cvsroot/openacs.org-dev/packages/irc-logger/perl/logger,v $ # $Id: logger,v 1.1.1.1 2003/02/11 23:08:36 bartt Exp $ # # (C) Copyright 2000-2002 Dave Beckett, ILRT, University of Bristol # http://purl.org/net/dajobe/ # # enhancements to Dave's work # Copyright (c) 2001, 2002 Ralph Swick, Massachusetts Institute of Technology # http://www.w3.org/People/all#swick # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # See http://www.gnu.org/copyleft/gpl.html # # For documentation run perldoc on this file 'perldoc logger' # use strict; # Standard Perl modules use File::Path; use File::Basename; use Sys::Hostname; use Getopt::Long; use IO::Handle; use POSIX qw(strftime); # From CPAN use URI; use Net::IRC; %ENV=(); $ENV{PATH}='/bin:/usr/bin:/usr/local/bin'; my $AdminChannel; # channel for administrative messages $::LogInitial = 1; # log the initial channel my $ReaperThreshold = 0; # seconds since last 'interesting' message # after which bot resigns from channel # 0 disables auto-parting my $ReaperScheduled = 0; # reap idle channels semaphore # Global constants $::program=basename $0; $::Host=(hostname || 'unknown'); $::Nick='logger'; # OK this can be changed if clashes $::IRC_Name='Chat Logger'; $::Max_Results=5; $::Max_Max_Results=20; $::CVSCommitInterval = 120; # seconds between CVS commits if -cvs specified $::LogActionMsgs=1; $::LogUserHosts=0; $::OffTopic=1; # [off] at start of line is not logged $::HelpURI = undef; # URI for detailed help @::LogTypes=qw(rdf html txt); @::DefaultLogTypes=qw(rdf txt); # ugly system dependencies # MSWin does not permit ":" in file path components $::PortSep = $^O eq "MSWin32" ? "/" : ":"; $::html_suffix="\n\n\n"; $::html_suffix_length=undef; # account for \n to \r\n expansion in stdio $::rdf_suffix=" \n \n\n\n"; $::rdf_suffix_length=undef; # account for \n to \r\n expansion in stdio #URIschemes and URIpatterns must match in order. The order is not signficant. @::URIschemes = ( 'http://', 'news:', 'ftp://', 'file://', 'gopher://', 'nntp://', 'wais://', 'telnet://', 'prospero://', 'mailto:' ); @::URIpatterns = ( qr|(http://)([^] \)>\"\'\n\[\t\\]*)(.*)$|, qr|(news:)([^] \)>"\'\n[\t\\]*)(.*)$|, qr|(ftp://)([^] \)>"\'\n[\t\\]*)(.*)$|, qr|(file://)([^] \)>"\'\n[\t\\]*)(.*)$|, qr|(gopher://)([^] \)>"\'\n[\t\\]*)(.*)$|, qr|(nntp://)([^] \)>"\'\n[\t\\]*)(.*)$|, qr|(wais://)([^] \)>"\'\n[\t\\]*)(.*)$|, # " qr|(telnet://)([^] \)>"\'\n[\t\\]*)(.*)$|, qr|(prospero://)([^] \)>"\'\n[\t\\]*)(.*)$|, qr|(mailto:)([^] \)>"\'\n[\t\\]*)(.*)$|, # " ); $::ActionDropped = 'dropped'; # Global variables # IRC object $::IRC=undef; # directory for admin logs; '/' will be added. Also default log dir $::AdminDir='.'; # root dir of logs; prepended to LogName_Pattern $::Log_LocalPath=undef; # include '/' if you need it # path & POXIX::strftime() pattern for logs. # '' will be replaced with the channel name, less leading '#' and '&' # '.html', '.rdf', '.txt' will be appended $::LogName_Pattern=undef; $::Default_Pattern = '/%Y-%m-%d'; # True if handles meeting action item commands $::Do_Actions=0; $::ActionLogName_Pattern=undef; $::Default_ActionPattern = '/%Y-%m-%d-actions'; $::Do_CVS=0; # if logs are to be committed to CVS $::TestMode=0; # if system() is to be no-op'd # place on the web this corresponds to; prepended to LogName_Pattern $::Log_URI=''; # include '/' if you need one # System password $::Password=''; # Print welcome message? $::Do_Welcome=0; # Allow invites $::Do_Invites=0; # True if leaving (so don't reconnect) $::Departing=0; # True if connecting (don't log server notices) $::Connecting=0; # Administrative messages log $::Admin_LOG=undef; # Process ID $::PID_File=undef; # Channel name (added by bartt) $::Channel_Name=undef; ###################################################################### package URI::irc; # http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt # irc:[ //[ [:] ]/[] [,needpass] ] require URI::_server; @URI::irc::ISA=qw(URI::_server); sub default_port { 6667 } sub channel ($) { my $path=shift->path; if($path && $path =~ m%^/([^/]+)%) { return $1; } undef; } package main; # this hideous concatenation only serves to hide this source line from CVS # The objective is to create a regex pattern that matches all CVS/RCS keywords $::CVSkeywords = '\$'.'Date\$|\$'.'Date:.*\$|\$'.'Revision\$|\$'.'Revision:.*\$|\$'.'Author\$|\$'.'Author:.*\$|\$'.'Id\$|\$'.'Id:.*\$|\$'.'Log\$|\$'.'Log:.*\$|\$'.'Header\$|\$'.'Header:.*\$|\$'.'Locker\$|\$'.'Locker:.*\$|\$'.'Name\$|\$'.'Name:.*\$|\$'.'RCSfile\$|\$'.'RCSfile:.*\$|\$'.'Source\$|\$'.'Source:.*\$|\$'.'State\$|\$'.'State:.*\$'; ###################################################################### sub main { my $usage="Usage: $::program [option...] PASSWORD CHANNEL-URI\n"; # From __DATA__ section below my $scanning=0; while() { if(!$scanning) { $scanning=1 if /PASSWORD CHANNEL-URI/; } else { last if /=head1/; $usage.=$_; } } my(%do_log_types)=map {$_ => 1} @::DefaultLogTypes; print $::program,': $Id: logger,v 1.1.1.1 2003/02/11 23:08:36 bartt Exp $',"\n"; die $usage unless GetOptions ( 'actions!' => \$::Do_Actions, 'admin=s' => \$::AdminDir, 'alog=s' => \$::ActionLogName_Pattern, 'cvs!' => \$::Do_CVS, 'invites' => \$::Do_Invites, 'helpuri=s' => \$::HelpURI, 'html!' => \$do_log_types{'html'}, 'idleparttime=s' => \$ReaperThreshold, 'initiallog!' => \$::LogInitial, 'log=s' => \$::LogName_Pattern, 'lroot=s' => \$::Log_LocalPath, 'me!' => \$::LogActionMsgs, 'nick=s' => \$::Nick, 'offtopic!' => \$::OffTopic, 'system!' => \$::TestMode, 'text!' => \$do_log_types{'txt'}, 'uroot=s' => \$::Log_URI, 'userhost!' => \$::LogUserHosts, ) && @ARGV==2; @::DefaultLogTypes=grep($do_log_types{$_}, @::LogTypes); my($password,$uri_string)=@ARGV; my $uri; eval '$uri=new URI $uri_string'; die "$::program: '$uri_string' does not look like an IRC URI\n" if ($@ || !$uri); # replace '' in $::Log_LocalPath and $::Log_URI my $server = $uri->host.$::PortSep.$uri->port; $::Log_LocalPath =~ s//$server/ if $::Log_LocalPath; $::Log_URI =~ s//$server/ if $::Log_URI; if ($::Log_LocalPath) { die "$::program: log dir $::Log_LocalPath does not exist\n" unless -d $::Log_LocalPath; } die "$::program: admin dir $::AdminDir does not exist\n" unless -d $::AdminDir; # Set globals $::Password=$password; $::Departing=0; $::Connecting=1; # Open the administrative log file my $admin_log_file=$::AdminDir.'/'.$::Nick.'.log'; $::Admin_LOG=new IO::File; $::Admin_LOG->open(">>$admin_log_file") or die "$::program Failed to append to admin log file $admin_log_file - $!\n"; $::Admin_LOG->autoflush(1); umask 022; # FIXME - pid_file should not have channel in it, when logger # handles multiple channels my $channel_name=$uri->channel; $::PID_File=$::AdminDir.'/'.$::Nick.'-'.$channel_name.'.pid'; open(PID,">$::PID_File"); print PID "$$\n"; close(PID); # Store channel name in global parameter for later reference in # on_msg. bartt $::Channel_Name = $uri->channel; $::IRC = new Net::IRC; my $channel=&Channel_new($uri); $AdminChannel = $channel; Channel_join($channel); # Never returns $::IRC->start; } # MAIN CODE &main; exit(0); ###################################################################### # Methods on 'logger Channel' object # package Logger::Channel; @::Channels=(); # [] -> {CONN}, {NAME}, {URI}, {Topic}, {Title} # {Listening}, {MsgTime}, {LogFilePrefix}, # {LogURIPrefix}, {CVSFiles}, {LogTypes} # {CVSCommitScheduled}, {LogsOpen} # {ActionItems} {IgnoreActions} # {LogName} - unused as of 2002-02-18 but # kept for possible future use # {ActionLog} # ActionItems[] -> {Topic}, {Pointer}, {id} sub Channel_new ($) { my($uri)=@_; my $self={}; # irc:: URI $self->{URI}=$uri; my $channel_name = $uri->channel; $channel_name ='#' . $channel_name unless $channel_name =~ m/^[\#&]/; $self->{NAME} = $channel_name; # Channel title $self->{Title}=$channel_name.' channel'; # a file prefix to log to (i.e. write log_name.rdf etc.) or undef # to use default schema $self->{LogName}=undef; # topic of channel $self->{Topic}=''; # Last ID seen $self->{Last_ID}=''; # True if logging $self->{Listening}=0; $self->{LogsOpen} = 0; # Track midnight rollover $self->{hour}= undef; # NET::IRC connection object $self->{CONN}=undef; $self->{LogTypes}=[@::DefaultLogTypes]; for my $type (@{$self->{LogTypes}}) { $self->{FH}->{$type}=undef; } # Prefix of log files - add ".html" etc. to give file name $self->{LogFilePrefix}=undef; # Prefix of log URIs or undef if no URI $self->{LogURIPrefix}=undef; # Prefix of log files - add ".html" etc. to give file name $self->{LogFilePrefix}=undef; # Prefix of log URIs or undef if no URI $self->{LogURIPrefix}=undef; push(@::Channels, $self); $self; } sub Channel_join($) { my($self)=@_; my $uri=$self->{URI}; my $channel_name=$uri->channel; $self->{Listening}=$::LogInitial; my $user_name=substr($channel_name,0,8)."-logger"; my $conn = $::IRC->newconn(Nick => $::Nick, Server => $uri->host, Port => $uri->port, Ircname => $::IRC_Name, Username => $user_name, LocalAddr => $::Host); die "$::program: Cannot create connection to $uri\n" unless $conn; $self->{CONN}=$conn; Channel_open_logs($self) if $::LogInitial; # Install handlers # On 'end of MOTD' event, join channel $conn->add_global_handler(376, \&on_connect); $conn->add_global_handler('welcome', \&on_connect); $conn->add_global_handler(353, \&on_names); $conn->add_global_handler('disconnect', \&on_disconnect); $conn->add_handler('msg', \&on_msg); $conn->add_handler('public', \&on_public); $conn->add_handler('part', \&on_part); $conn->add_handler('join', \&on_join); $conn->add_handler('kick', \&on_kick); $conn->add_handler('caction', \&on_caction); $conn->add_handler('quit', \&on_quit); $conn->add_handler('nick', \&on_nick); $conn->add_handler('nicknameinuse', \&on_nicknameinuse); $conn->add_handler('topic', \&on_topic); $conn->add_handler('notice', \&on_notice); $conn->add_handler('invite', \&on_invite); # turn off CTCP ACTION warnings from Net::IRC::Connection.pm BEGIN { $SIG{'__WARN__'} = sub { warn $_[0] if not $_[0] =~ m/^ONE:/ } } # turn off CTCP ACTION warnings from Net::IRC::Connection.pm # Not required for Net::IRC 0.71 or later BEGIN { $SIG{'__WARN__'} = sub { warn $_[0] if not $_[0] =~ m/^ONE:/ } } } sub Channel_by_conn($) { my $conn=shift; for my $channel (@::Channels) { return $channel if $channel->{CONN} == $conn; } return undef; } sub Channel_by_name($) { my $name=shift; for my $channel (@::Channels) { return $channel if $channel->{NAME} =~ m/^\Q$name\E$/i; } return undef; } sub Channel_get_log_dir ($) { my $self=shift; return $::Log_LocalPath if $::Log_LocalPath; # %%% need something special for $self->{LogFilePrefix} ? my $uri=$self->{URI}; return $uri->host.$::PortSep.$uri->port.'/'; } sub Channel_get_log_lines ($) { my $self=shift; my(@file_dates); if (my $log_name=$self->{LogFilePrefix}) { @file_dates=["$log_name.txt", undef]; } else { my $log_dir=Channel_get_log_dir($self); return () if !opendir(DIR, $log_dir); my $name = $self->{NAME}; $name =~ s/^[#&]//; for my $file (reverse sort readdir(DIR)) { next unless $file =~ /.*$name.*\.txt/; # $file =~ m/^(\d\d\d\d-\d\d-\d\d)/; # %%% need to generalize this date-extraction from $::LogName_Pattern $file =~ m/^([-\d]*)/; # any number of leading hyphen-separated digits my $date=$1; $date =~ s/-$//; # trim a trailing hyphen if one exists push(@file_dates, ["$log_dir/$file", $date]); } closedir(DIR); } # In date order, newest lines at top my(@results)=(); # Newest files first for my $file_date (@file_dates) { my($file,$date)=@$file_date; open(LOG, $file) or next; # Append to list, reverse date sorted list - i.e. older entries at end my(@lines); while() { chomp; # Ignore logger's own output next if m%^\d\d:\d\d:\d\d <$::Nick>%; next if !length $_; $_="$date $_" if $date; push(@lines, $_); }; close(LOG); push(@results, reverse @lines); } return(@results); } sub Channel_open_logs ($) { my $self=shift; my $conn=$self->{CONN}; my $channel_name=$self->{NAME}; $channel_name =~ s/^[#&]//; my @tm = gmtime; $tm[5]+= 1900; $tm[4]++; my $date = sprintf("%04d-%02d-%02d", $tm[5], $tm[4], $tm[3]); my(%log_files); my $log_dir='./'; if (my $log_name=$self->{LogName}) { $self->{LogFilePrefix}=$log_name; $self->{LogURIPrefix}=$::Log_URI if $::Log_URI; } else { my $logname; if ($::LogName_Pattern) { $log_name = strftime( $::LogName_Pattern, gmtime ); } else { $log_name = strftime( $::Default_Pattern, gmtime ); $log_dir=Channel_get_log_dir($self); } $log_name =~ s//$channel_name/; $self->{LogBasename} = $log_name; $self->{LogFilePrefix} = ($::Log_LocalPath ? $::Log_LocalPath : $log_dir).$log_name; $self->{LogURIPrefix} = $::Log_URI.$log_name if $::Log_URI; } my $dir=dirname($self->{LogFilePrefix}); if (! -d $dir) { mkpath([$dir], 0, 0755); # Failed! if (! -d $dir) { log_admin_event($self, undef, time, "Failed to create chat log dir $dir - $!"); unlink $::PID_File; return; } } print "$::program: Opening ",$self->{LogFilePrefix},"\n"; for my $type (@{$self->{LogTypes}}) { $log_files{$type}=$self->{LogFilePrefix}.".".$type; } my $cvs_files = ''; if (grep($_ eq 'txt', @{$self->{LogTypes}})) { $cvs_files .= $self->{LogBasename}.'.txt ' if $::Do_CVS; my $txt_log_fh=$self->{FH}->{txt}=new IO::File; my $txt_log_file=$log_files{txt}; if (!$self->{FH}->{txt}->open(">>$txt_log_file")) { log_admin_event($self, undef, time, "Failed to create text log file $txt_log_file - $!"); unlink $::PID_File; return; } $txt_log_fh->autoflush(1); } if (grep($_ eq 'html', @{$self->{LogTypes}})) { $cvs_files .= $self->{LogBasename}.'.html ' if $::Do_CVS; my $html_log_fh; my $html_log_file=$log_files{html}; if (!-r $html_log_file) { # new file? $html_log_fh=$self->{FH}->{html}=new IO::File; if (!$html_log_fh->open(">$html_log_file")) { log_admin_event($self, undef, time, "Failed to create HTML log file $html_log_file - $!"); unlink $::PID_File; return; } my $escaped_chan = xml_escape($channel_name); print $html_log_fh <<"EOT"; IRC log of $escaped_chan on $date EOT my $progID = '$Id: logger,v 1.1.1.1 2003/02/11 23:08:36 bartt Exp $'; $progID =~ s/\$/\$/g; # Hide the CVS tag from CVS in the output print $html_log_fh ''; print $html_log_fh <<"EOT";

IRC log of $escaped_chan on $date

Timestamps are in UTC.

EOT print $html_log_fh $::html_suffix; } else { $html_log_fh=$self->{FH}->{html}=new IO::File; if (!$html_log_fh->open("+<$html_log_file")) { log_admin_event($self, undef, time, "Failed to append to HTML log file $html_log_file - $!"); unlink $::PID_File; return; } } # figure out whether stdio expands NEWLINE to CRLF if (!defined $::html_suffix_length) { seek($html_log_fh, 0, 2); # find the end my $curlen = tell($html_log_fh); print $html_log_fh $::html_suffix; $::html_suffix_length = tell($html_log_fh) - $curlen; truncate ($html_log_fh, $curlen); } $html_log_fh->autoflush(1); } # Note RDF log type is not optional ;-) $cvs_files .= $self->{LogBasename}.'.rdf ' if $::Do_CVS; my $rdf_log_fh; my $rdf_log_file=$log_files{rdf}; if(!-r $rdf_log_file) { $rdf_log_fh=$self->{FH}->{rdf}=new IO::File; if (!$rdf_log_fh->open(">$rdf_log_file")) { log_admin_event($self, undef, time, "Failed to create RDF log file $rdf_log_file - $!"); unlink $::PID_File; return; } my $escaped_chan_uri = xml_escape($self->{URI}); print $rdf_log_fh <<"EOT"; EOT print $rdf_log_fh $::rdf_suffix; } else { $rdf_log_fh=$self->{FH}->{rdf}=new IO::File; if (!$rdf_log_fh->open("+<$rdf_log_file")) { log_admin_event($self, undef, time, "Failed to append to RDF log file $rdf_log_file - $!"); unlink $::PID_File; return; } } # figure out whether stdio expands NEWLINE to CRLF if (!defined $::rdf_suffix_length) { seek($rdf_log_fh, 0, 2); # find the end my $curlen = tell($rdf_log_fh); print $rdf_log_fh $::rdf_suffix; $::rdf_suffix_length = tell($rdf_log_fh) - $curlen; truncate ($rdf_log_fh, $curlen); } $self->{FH}->{rdf}->autoflush(1); $self->{LogsOpen} = 1; if ($cvs_files) { $self->{CVSFiles} = $cvs_files; $self->{CVSCommitScheduled} = 0; my $ECHO = $::TestMode ? 'echo ' : ''; system(("${ECHO}sh -c 'cd $::Log_LocalPath; cvs add $cvs_files &'")); } } sub Channel_close_logs ($) { my $self=shift; return unless $self->{LogsOpen}; for my $type (@{$self->{LogTypes}}) { $self->{FH}->{$type}->close; $self->{FH}->{$type}=undef; } $self->{LogsOpen} = 0; } ###################################################################### # Logging - methods on Net::IRC::Connection object sub log_event ($$$;$$) { my($self, $event, $t, $msg, $fake_nick)=@_; my $nick=$fake_nick ? $fake_nick : $event->nick; my $channel=Channel_by_name(($event->to)[0]); return if !$channel || !$channel->{Listening}; Channel_open_logs($channel) unless $channel->{LogsOpen}; $channel->{MsgTime} = time; my @tm = gmtime($t); $tm[5]+= 1900; $tm[4]++; my $date = sprintf("%04d-%02d-%02d", $tm[5], $tm[4], $tm[3]); my $time = sprintf("%02d:%02d:%02d", $tm[2], $tm[1], $tm[0]); my $date_time="$date $time"; my $hour=$tm[2]; # if we're using dated logs and we passed midnight, start new logs if (!$channel->{LogName} && defined $channel->{hour} && ($hour < $channel->{hour})) { Channel_close_logs($channel); Channel_open_logs($channel); } $channel->{hour} = $hour; if (grep($_ eq 'txt', @{$channel->{LogTypes}})) { my $txt_msg=$nick ? qq{<$nick> $msg} : $msg; my $txt_log_fh=$channel->{FH}->{txt}; print $txt_log_fh "$time $txt_msg\n"; } # Make a legal XML id from the time my $ID="T$time"; $ID =~ s/:/-/g; # add a unique suffix if necessary if(length($channel->{Last_ID}) != length($ID)) { # If last ID was in same second, need to start from next # ID HH-MM-SS-X and increment X # otherwise, new ID is OK if ($channel->{Last_ID} =~ /^$ID-(\d+)$/) { $ID.="-".($1+1); } } elsif($ID eq $channel->{Last_ID}) { # Else if was same as last ID, must be first duplicate of this # ID in this time slot ie last id was HH-MM-SS so add -1 to make # it unique HH-MM-SS-1 $ID.="-1"; } $channel->{Last_ID}=$ID; my @uris = getURI($msg); if (grep($_ eq 'html', @{$channel->{LogTypes}})) { my $html_log_fh=$channel->{FH}->{html}; # seek back # @@ note that this assumes the existing data was NL-expanded identically seek($html_log_fh, -$::html_suffix_length, 2); # 2= SEEK_END my $escapedMsg = cvs_escape($msg); if ($#uris > -1) { $escapedMsg = URI2link($escapedMsg, @uris); } print $html_log_fh qq{
$time [$nick]
}.$escapedMsg.qq{
\n}; print $html_log_fh $::html_suffix; } my $rdf_log_fh=$channel->{FH}->{rdf}; # seek back # @@ note that this assumes the existing data was NL-expanded identically seek($rdf_log_fh, -$::rdf_suffix_length, 2); # 2= SEEK_END print $rdf_log_fh <<"EOT"; ${date}T${time}Z EOT print $rdf_log_fh qq{ }.cvs_escape($msg).qq{\n}; print $rdf_log_fh qq{ \n} if $nick; foreach my $uri (@uris) { $uri = xml_escape($uri); print $rdf_log_fh qq{ \n}; } print $rdf_log_fh qq{ \n}; print $rdf_log_fh qq{ \n}; print $rdf_log_fh $::rdf_suffix; if ($::Do_CVS && !$channel->{CVSCommitScheduled} && $channel->{CVSFiles}) { my $ECHO = $::TestMode ? 'echo ' : ''; $self->schedule( $::CVSCommitInterval, sub { system(("${ECHO}sh -c 'cd $::Log_LocalPath; cvs commit -m \"[$::Nick] sync\" ".$channel->{CVSFiles}." &'")); $channel->{CVSCommitScheduled} = 0; } ); $channel->{CVSCommitScheduled} = 1; } } sub log_admin_event ($$$;$) { my($self, $event, $t, $msg)=@_; my $nick=$event ? $event->nick : ''; my @tm = gmtime($t); $tm[5]+= 1900; $tm[4]++; my $date = sprintf("%04d-%02d-%02d", $tm[5], $tm[4], $tm[3]); my $time = sprintf("%02d:%02d:%02d", $tm[2], $tm[1], $tm[0]); my $txt_msg=$nick ? qq{<$nick> $msg} : $msg; if($::Admin_LOG) { print $::Admin_LOG "${date}Z${time} $txt_msg\n"; } else { warn "${date}Z${time} $txt_msg\n"; } } ###################################################################### # Global events # What to do when logger successfully connects. sub on_connect { my ($self, $event) = @_; my $channel=Channel_by_conn($self); my $channel_name = $channel->{NAME}; log_admin_event($self, $event, time, "Connected to server"); $self->join($channel_name); } # What to do when logger's nick is already used sub on_nicknameinuse { my ($self, $event) = @_; if ($::Nick !~ /_/) { $::Nick.="_1"; } else { my($name,$number)=split(/_/, $::Nick); $::Nick=$name."_".($number+1); } $self->nick($::Nick); } # Prints the names of people in a channel when we enter. sub on_names { my ($self, $event) = @_; my (@list, $channel_name) = ($event->args); # splice() only works on real arrays. Sigh. ($channel_name, @list) = splice @list, 2; log_event($self, $event, time, "Users on $channel_name: @list"); $::Connecting=0; } # Reconnect to the server when we die. sub on_disconnect { my ($self, $event) = @_; my $t=time; my $m="Disconnected from ". $event->from(). " (". ($event->args())[0]. ")"; log_admin_event($self, $event, $t, $m); log_event($self, $event, $t, $m); log_pending_output($self); return if $::Departing; log_admin_event($self, $event, time, "Attempting to reconnect"); unlink $::PID_File; exit(0); } ###################################################################### # Per connection events # When received a private message sub on_msg { my($self,$event)=@_; my $nick = $event->nick; my $channel_name = $event->to; # The above channel_name blocks private responses to commands issued # on a public channel. Ugly hack: use the name of the initial # channel instead . But.... it works. bartt $channel_name = "#$::Channel_Name"; return if $nick eq $::Nick; my $arg = join(' ', $event->args); command_for_me($self, $event, $channel_name, $arg, 1); } # What to do when we receive channel text. sub on_public { my ($self, $event) = @_; my @to = $event->to; my ($nick, $mynick) = ($event->nick, $self->nick); my $arg = join(' ', $event->args); # Private stuff return if ($::OffTopic && $arg =~ /^\[off\]/i); log_event($self, $event, time, $arg); if ($arg =~ /^$mynick[,:]\s*(.*)$/i) { command_for_me($self, $event, $to[0], $1, 0); } else { watch_significant_events($self, $event, $to[0], $arg, 0, 0); } if ($ReaperThreshold && !$ReaperScheduled) { $self->schedule( $ReaperThreshold/4, \&ReapIdleChannels, $self ); $ReaperScheduled = 1; } } # What to do when we receive /me (and other stuff??) sub on_caction { my ($self, $event) = @_; my $nick = $event->nick; my $mynick = $self->nick; my $arg = join(' ', $event->args); if ($arg =~ /^$mynick,\s+(.*)$/i) { command_for_me($self, $event, @{$event->to}[0], $1, 0); } else { watch_significant_events($self, $event, @{$event->to}[0], $arg, 0, 0); } # Private stuff return if !$::LogActionMsgs || ($::OffTopic && $arg =~ /^\[off\]/i); log_event($self, $event, time, "* $nick $arg"); } # What to do when someone leaves a channel logger is on. sub on_part { my ($self, $event) = @_; my ($channel_name) = ($event->to)[0]; my $nick=$event->nick; log_event($self, $event, time, "$nick has left $channel_name"); } # We've been invited to a channel sub on_invite { my ($self, $event) = @_; my $nick = $event->nick; my $arg = join('~', $event->args); my @args = $event->args; my $channel_name = $args[0]; my $channel_password = $args[1]; # maybe return if !$::Do_Invites; log_admin_event($self, $event, time, "Invited to $channel_name ($arg)"); $self->join($channel_name, $channel_password); } # What to do when we receive channel notice (mostly other bots) sub on_notice { my ($self, $event) = @_; my $nick = $event->nick; my $arg = join(' ', $event->args); # Private stuff return if ($::OffTopic && $arg =~ /^\[off\]/i); return if $::Connecting; log_event($self, $event, time, $arg); } # What to do when someone leaves a channel logger is on. sub on_quit { my ($self, $event) = @_; my $nick=$event->nick; my $arg = join(' ', $event->args); my $msg="$nick has quit"; $msg.=" ($arg)" if $::LogUserHosts; log_event($self, $event, time, $msg); } # What to do when someone is kicked on a channel logger is on. sub on_kick { my ($self, $event) = @_; my $nick=$event->nick; my $whom = ($event->to)[0]; my $channel_name = ($event->args)[0]; my $msg="$nick has kicked $whom from $channel_name"; log_event($self, $event, time, $msg); log_admin_event($self, $event, time, $msg); my $channel = Channel_by_name($channel_name); if ($channel) { Channel_close_logs($channel); $channel->{Listening} = 0; for (my $index=0; $index <= $#::Channels; $index++) { if ($::Channels[$index] == $channel) { splice(@::Channels, $index, 1); last; } } } else { my $msg = "Unknown channel from $nick on $channel_name"; log_admin_event($self, $event, time, $msg); print $msg, "\n"; } } # What to do when someone does /nick sub on_nick { my ($self, $event) = @_; my $nick=$event->nick; my $arg = join(' ', $event->args); log_event($self, $event, time, "$nick is now known as $arg"); } # What to do when someone does /topic MSG sub on_topic { my ($self, $event) = @_; my $channel=Channel_by_name(($event->to)[0]); my $nick=$event->nick; my(@args)=$event->args; my $arg; if(@args == 3) { $arg=$args[2]; log_event($self, $event, time, "topic is: $arg"); } else { $arg=$args[0]; log_event($self, $event, time, "$nick has changed the topic to: $arg"); } $channel->{Topic}=$arg; } # What to do when someone joins a channel logger is on. sub on_join { my ($self, $event) = @_; my ($channel_name) = ($event->to)[0]; my $user_nick=$event->nick; my $format=$::LogUserHosts ? "%s (%s) has joined $channel_name" : "%s has joined $channel_name"; my $t=time; my $m=sprintf($format, $user_nick, $event->userhost); my $channel = Channel_by_name($channel_name); if (!$channel) { $channel_name =~ s/^#//; # Net::IRC doesn't permit leading '#' my $t_uri = $AdminChannel->{URI}; my $uri_string = 'irc://'.$t_uri->host.':'.$t_uri->port.'/'.$channel_name; my $uri = new URI $uri_string; $channel = &Channel_new($uri); $channel->{CONN} = $self; $channel->{MsgTime} = time; $channel->{Listening} = 1; # Always join in listen mode # %%% could this be executed if we depart the AdminChannel and rejoin? $channel->{Listening} = $::LogInitial if $channel == $AdminChannel; Channel_open_logs($channel); } log_event($self, $event, $t, $m); if($user_nick eq $::Nick) { log_admin_event($self, $event, $t, $m); $channel->{Listening} = 1; # Always join in listen mode $channel->{Listening} = $::LogInitial if $channel == $AdminChannel; Say( $self, $event->to, $channel->{Listening} ? 'is logging' : 'is not logging', 0 ); $channel->{MsgTime} = time; } return if !$::Do_Welcome; my $logging=($channel->{Listening}) ? "logging" : "not logging"; my(@intro)=( "Welcome to the $channel->{Title}", "I'm currently $logging to $::Log_URI", "For extensive help do: /msg $::Nick help" ); for my $output (@intro) { Say( $self, $event->nick, $output ); } } sub command_for_me ($$$$$) { my($self, $event, $channel_name, $command, $is_private)=@_; my $from_nick=$event->nick; my $dest_nick=($is_private ? $from_nick : $event->to); # Workaround to enable private responses to commands issued in public # channels # my $channel= $is_private ? undef # Channel_by_nick($from_nick) # : Channel_by_name($channel_name); my $channel = Channel_by_name($channel_name); $command=~s/^\s+//; my $output=''; my $valid_password=0; if($command =~ s/^password (\S+)\s*//) { if($1 eq $::Password) { $valid_password=1; } else { Say( $self, $dest_nick, "Invalid password" ); return; } } if($valid_password) { # please quit if($command=~ /^(?:please\s+|pls\s+)?(?:quit|finish|terminate|die die die|exterminate)$/i) { $::Departing=1; for my $channel (@::Channels) { $self->me($channel->{NAME}, 'is departing'); sleep(1); } # Log who told me to quit log_admin_event($self, $event, time, "$::Nick told to quit"); $self->quit; unlink $::PID_File; exit(0); } # please announce xxxx if($command=~ /^(?:please\s+|pls\s+)?((?:announce|remark|whisper))\s+(.*)$/i) { my $aloud = $1 eq 'announce'; my $message = $2; do_announce( $self, $message, $aloud ); Say( $self, $dest_nick, 'done' ); return; } # restart if($command eq 'restart') { $::Departing=1; Say($self, $event->to, ' is departing', 0 ); $self->quit; sleep(1); $::Connecting=1; $self->connect(); return; } # debug if($command eq 'debug') { Say( $self, $dest_nick, "Debugging is on" ); $self->debug(1); return; } # nodebug if($command eq 'nodebug') { Say( $self, $dest_nick, "Debugging is off" ); $self->debug(0); return; } # are you busy? if($command =~ /^(?:are you\s+)?(?:busy\?)/i) { my ($where, $idle); for my $channel (@::Channels) { if ($channel->{Listening}) { $where .= ' '.$channel->{NAME}; $idle .= ' '.$channel->{NAME}.':' .int ((time - $channel->{MsgTime} + 30)/60); } } Say( $self, $dest_nick, $where ? "I'm listening on$where" : "no, $from_nick, I'm not listening anywhere" ); Say( $self, $dest_nick, 'Idle mins:'.$idle ) if $idle; return; } } # please excuse us if($::Do_Invites && $command=~ /^(?:please\s+|pls\s+)?(?:bye|part|excuse us|leave)/i) { if($command=~ /^(?:please\s+|pls\s+)?part\s+(\S*)\s*$/i && $1) { $channel_name = $1; $channel = Channel_by_name($channel_name); } unless ($channel) { Say( $self, $dest_nick, "I don't know what channel you might mean" ); return; } if($::Do_Actions) { DisplayActionItems($self, $event, $channel, $from_nick, $dest_nick); } Perform( $dest_nick, sub { # Log who told me to quit log_admin_event($self, $event, time, "$::Nick told to depart $channel_name"); $self->part($channel_name); Channel_close_logs($channel); $channel->{Listening} = 0; for (my $index=0; $index <= $#::Channels; $index++) { if ($::Channels[$index] == $channel) { splice(@::Channels, $index, 1); last; } } } ); return; } if($command=~ /^(?:be quiet|shut up|silence|sshush|stop|off|nolisten)/i) { unless ($channel) { Say( $self, $dest_nick, "I don't know what channel you might mean" ); return; } if($channel->{Listening}) { Say( $self, $event->to, 'is not logging', 0 ); # Log who turned me off log_admin_event($self, $event, time, "Logging turned off"); $channel->{Listening}=0; } else { Say( $self, $event->to, 'is already not logging', 0 ); } return; } if($command=~ /^(?:hello|log|listen|record|start|begin|on|listen)/i) { unless ($channel) { Say( $self, $dest_nick, "I don't know what channel you might mean" ); return; } if(!$channel->{Listening}) { Say( $self, $event->to, 'is logging', 0 ); # Log who turned me on log_admin_event($self, $event, time, "Logging turned on"); $channel->{Listening}=1; } else { Say( $self, $event->to, 'is already logging', 0 ); } return; } if($command=~ /^(?:sync)/i) { unless ($channel) { Say( $self, $dest_nick, "I don't know what channel you might mean" ); return; } Channel_close_logs($channel); Channel_open_logs($channel); return; } if($command=~ /^(?:pointer|bookmark|here|where am i\?)/i) { my($log_uri)=$channel->{LogURIPrefix}; my $output; if($log_uri) { $log_uri.="#".$channel->{Last_ID} if $channel->{Last_ID}; $output="See $log_uri"; } else { $output="There is no log URI"; } Say( $self, $dest_nick, $output ); log_event($self, $event, time, $output, $self->nick) unless $is_private; return; } # please ignore action items, please track action items if($::Do_Actions && $command =~ /^(?:please\s+|pls\s+)?((?:ignore|track))\s+action(?:\s+item)?s$/i) { my $which = $1; if ($which eq 'ignore') { $channel->{IgnoreActions} = 1; } else { delete $channel->{IgnoreActions}; } Say( $self, $dest_nick, "ok, $from_nick, I will $which action items" ); return; } # what [are the] action[ item]s? # [please] show [the] action[ item]s? if ($::Do_Actions && ($command =~ /^what(?:\s+are\s+the)?\s+action(?:\s+item)?s\?$/i || $command =~ /^(?:please\s+|pls\s+)?(?:show|list)(?:\s+the)?\s+action(?:\s+item)?s$/i) ) { DisplayActionItems($self, $event, $channel, $from_nick, $dest_nick); return 1; } # [please] drop action nn if ($::Do_Actions && $command =~ m/^(?:please\s+|pls\s+)?drop\s+action\s+(.*)$/) { $channel->{MsgTime} = time; if ($channel->{IgnoreActions}) { Say( $self, $dest_nick, "I am ignoring action items, $from_nick" ); return 1; } if ($is_private) { Say( $self, $dest_nick, "I will not do that one-on-one, $from_nick" ); return 1; } my $action = $1; my $actionitems = $channel->{ActionItems}; if ($action !~ m/^\d+$/ || $action == 0) { Say( $self, $dest_nick, 'I can only remove action items by number' ); return 1; } $action = $action - 1; # delete must be numeric if ($actionitems) { if ($action <= $#{$actionitems}) { $actionitems->[$action]->{Status} = $::ActionDropped; ExportActionList( $channel ); Say( $self, $dest_nick, 'removing action '.($action+1).', '.$actionitems->[$action]->{Topic} ); } else { my $length = $#{$actionitems}+1; Say( $self, $dest_nick, 'I only see '.$length.' action item'.($length == 1 ? '' : 's') ); } } else { Say( $self, $dest_nick, 'I see no action items' ); } return 1; } # [please] join [] if ($::Do_Invites && $command =~ m/^(?:please\s+|pls\s+)?join\s+(\S*)\s*(\S*)\s*$/) { my $channel_name = $1; my $channel_key = $2; print "join $channel_name $channel_key from $from_nick\n"; log_admin_event($self, $event, time, "Join request for $channel_name from $from_nick"); $self->join($channel_name, $channel_key); return 1; } if ($channel) { if(!$channel->{Listening}) { $output="I'm not logging. "; } else { $output="I'm logging. "; } # Allow question? if ($command =~ /^(.+)\?$/) { $command="grep $1"; } } if($command=~ /^help/i) { my(@help)=(); if ($::HelpURI) { @help=( "More detailed help is available in $::HelpURI" ); } @help=(@help, "Some of the commands I know are:", " silence - Stop logging (also: stop, off, ...)", " listen - Start logging (also: start, on, ...)", " excuse us - Leave the channel (also: bye)", " grep [-i] [first-last|max] - Search the logs", " e.g. grep foo, grep 5 bar, grep -i things [case independent]", " bookmark - Give the URI of the current log"); @help=(@help, " show action items - give a list of ACTION: entries", " drop action n - remove entry [n] from the list of action items") if $::Do_Actions; @help=(@help, "I respond to '$::Nick, command' in public and '/msg $::Nick command' in private", "Logging Policy: All public output is logged if I am listening except for" ); if (! $::LogActionMsgs) { @help=(@help, "\"action\" messages (messages sent with the '/me' command) and" ); } @help=(@help, "any lines starting [off]. All commands to me are logged.", "My public output is logged but these lines are not searchable."); if($self->{LogURIPrefix} || $::Log_URI) { @help=(@help, "The log is in ".($self->{LogURIPrefix} ? $self->{LogURIPrefix} : $::Log_URI)); } @help=(@help, "Do $::Nick, adminhelp for help on administrative commands", ); for my $output (@help) { Say( $self, $dest_nick, $output ); } return; } if($command =~ /^adminhelp/i) { my(@help)=( "Administrative commands are as follows:", " quit - I will depart", " restart - I will leave and rejoin channel", " debug - Turn on debugging", " nodebug - Turn off debugging", " announce MSG - Sends message to all channels", " busy - Gives summary of channels being listened on", "These commands work only with the admin PASSWORD like this:", "/msg $::Nick password PASSWORD command'", ); for my $output (@help) { Say( $self, $dest_nick, $output ); } return; } if ($command =~ /^(?:grep|search for|find)\s+(.+)$/) { unless ($channel) { Say( $self, $dest_nick, "I don't know what channel you might mean" ); return; } my $search=$1; my $flags=''; my($first,$count)=(0,$::Max_Results); if($search=~ s/^-i\s+//) { $flags='(?i)'; } if($search=~ s/^(\d+|\d+-\d+)\s+(?:things about\s+|)//) { my $arg=$1; $arg=1 if $arg eq "0"; # fix previous breakage if($arg=~ m%^(\d+)-(\d+)$%) { my $last; ($first,$last)=($1,$2); $count=$last-$first+1; $count=1 if $count<0; } else { $count=$arg; } } my $orig_search=$search; # Only allow a few regexes # Remove (?...) blocks since they can do evals $search =~ s/\(\?[^)]+\)//g; # Remove backticks since they can run processes $search =~ s/\`//g; # Remove variable references $search =~ s/\$//g; # Quote '/'s $search =~ s%/%\\/%g; # Prefix with flags $search=$flags.$search; my(@lines)=Channel_get_log_lines($channel); my(@results); eval "\@results=grep(/$search/, \@lines)"; if($!) { @results=(); my $msg=$!; $msg=~ s/^ at .+$//; $output.=qq{ Sorry, search failed with error - $msg}; } elsif (!@results) { $output.=qq{ Sorry, nothing found for '$orig_search'}; $output.=qq{ (internally: "$search")} if $orig_search ne $search; } else { my $size=scalar(@results); my $pl=($size != 1) ? 's' : ''; $output.=" I found $size answer$pl for '$orig_search'"; my $last=$first+$count-1; $last=$size-1 if $last > $size-1; if($first !=0 || $last != $size-1) { $output.=" (showing $first...$last)"; } Say( $self, $dest_nick, $output ); # Set result nick to me $event->nick($::Nick); log_event($self, $event, time, $output) unless $is_private; my $count=0; for(my $i=$first; $i <= $last; $i++) { $output="$i) ".$results[$i]; Say( $self, $dest_nick, $output ); log_event($self, $event, time, $output) unless $is_private; $count++; last if $count > $::Max_Max_Results; } return; } } else { return if watch_significant_events($self, $event, $channel_name, $command, $is_private, 1); $output.="I don't understand '$command', $from_nick. Try /msg $::Nick help"; } Say( $self, $dest_nick, $output ); log_event($self, $event, time, $output) unless $is_private; } ###################################################################### # Utility subroutines # Escape any special characters that are significant to XML # Then hide any CVS/RCS tags from future invocations of CVS/RCS sub cvs_escape ($) { my ($text) = @_; $text = xml_escape($text); return $text if ($text !~ /\$/o); # nothing to hide if ($text =~ /$::CVSkeywords/o) { $text =~ s/\$/$/g; } return $text; } sub xml_escape ($) { my $string=shift; $string =~ s/\&/\&/g; $string =~ s//\>/g; $string =~ s/[\x00-\x1F]//g; # remove ASCII 0-31 $string =~ s/([\x80-\xFF])/"\&#".ord($1).";"/ge; # escape ASCII 128-255 $string; } # URI recognition # The following URI recognition algorithm was translated from # the Hypermail implementation; see parseurl() in # http://dev.w3.org/cvsweb/~checkout~/hypermess/hypermail/src/string.c?rev=1.4 #returns a list of any URIs found in the input string sub getURI ($) { my ($l) = @_; my @ret = (); if ($l !~ /:/o) { # give up if input can't have any schemes return (); } chomp $l; while (my $leftmost = length ($l)) { # while string is not empty my $i = 0; my $match = -1; foreach my $u (@::URIschemes) { # search for first matching URI scheme my $p = index( $l, $u ); if ($p >= 0 && $p < $leftmost) { $leftmost = $p; $match = $i; } $i++; } if ($match != -1) { # if a scheme was found, extract the URI $l = substr($l, $leftmost); my $u = $l; $u =~ s/$::URIpatterns[$match]/$1$2/; $l = $3; # rest of string after extracting the pattern @ret=(@ret, $u); } else { $l = ""; } } return @ret; } #Return a string with any URIs specified by the second argument (a list) #found in the first argument expanded to HTML anchors sub URI2link ($@) { my ($l, @uri) = @_; chomp $l; foreach my $u (@uri) { my $p = quotemeta $u; $l =~ s/($p)/$1<\/a>/; } return $l; } my %OutputQueue; # {nick}->@{queue} my $SayScheduled = 0; my $OutputBytesPending = 0; # total bytes we're expecting to write my $nextNickInQueue; # round-robin the queue # Queued output to the irc server; this tries to avoid flooding the # server with output requests and the liklihood that the server will # kick us # # Accepts: $conn - connection # $nick - the channel name or nick to be addresses # $msg - the text to send # $addressed - (optional) boolean: 1 if privmsg, 0 if /me sub Say { my ($conn, $nick, $msg, $addressed) = @_; my $to = ref($nick) eq "ARRAY" ? join('~', @{$nick}) : $nick; $addressed = 1 if not defined $addressed; my @queues = keys %OutputQueue; # when queue is empty, output immediately but set timer # safe time to next output depends on the size of this output text; # thanks to Hugo Haas for recommending the algorithm. my $msgLength = length($msg) + ($addressed ? 9 : 18); # 9 = length('PRIVMSG '), 18 = length('PRIVMSG :^AACTION ') if (! $SayScheduled) { if ($addressed) { $conn->privmsg($nick, $msg) } else { $conn->me($nick, $msg) } my $interval = 1 + int $msgLength/80; $conn->schedule($interval, \&_doSay); $SayScheduled++; } else { my $queue = \@{$OutputQueue{$to}->{queue}}; push @$queue, [$conn, $nick, $msg, $addressed]; $OutputBytesPending += $msgLength; } } # Perform an action after queued output has been drained # # Accepts: $nick - channel whose output queue must be drained first # $proc - procedure to be called sub Perform { my ($nick, $proc) = @_; unless (ref $proc eq 'CODE') { warn 'Second argument to Perform() is not a coderef'; return; } my $to = ref($nick) eq "ARRAY" ? join('~', @{$nick}) : $nick; my @queues = keys %OutputQueue; # when queue is empty, call the procedure immediately if (! $SayScheduled) { $proc->(); } else { my $queue = \@{$OutputQueue{$to}->{queue}}; push @$queue, [$proc]; } } sub _doSay { my ($conn) = @_; # ignored my @nicks = keys %OutputQueue; my $nicksRemaining = $#nicks + 1; $SayScheduled = 0; # assume we're done return unless $nicksRemaining; my $nickToOutput = $nextNickInQueue ? $nextNickInQueue : $nicks[0]; my $interval = 1; # time to next safe output my $queue = \@{$OutputQueue{$nickToOutput}->{queue}}; if ( $#$queue >= 0) { my $conn = $$queue[0][0]; if (ref($conn) eq "Net::IRC::Connection") { my $nick = $$queue[0][1]; my $msg = $$queue[0][2]; my $addressed = $$queue[0][3]; shift @$queue; # safe time to next output depends on the size of this output text; # thanks to Hugo Haas for recommending part of the algorithm. my $msgLength = length($msg) + ($addressed ? 9 : 18); # 9 = length('PRIVMSG '), 18 = length('PRIVMSG :^AACTION ') # the more output we have to do, the more likely it is that a # slow client will cause our output queue in the server to build # Therefore we add more penalty as a function of the number of # bytes we expect to output $interval = 1 + int ($msgLength/($OutputBytesPending > 320 ? 60 : 100)); if ($addressed) { $conn->privmsg($nick, $msg) } else { $conn->me($nick, $msg) } $OutputBytesPending -= $msgLength; } else { # it's an action to perform, now that channel output is drained shift @$queue; $conn->(); } } if ($#$queue < 0) { delete $OutputQueue{$nickToOutput}; $nicksRemaining--; } if ($nicksRemaining) { # repeat until queue is drained $conn->schedule($interval, \&_doSay) if !$SayScheduled++; } my $next = 1; for my $nick (@nicks) { last if $nick eq $nickToOutput; $next++; } $nextNickInQueue = $nicks[$next]; } sub do_announce { my ($conn, $message, $first_person) = @_; for my $channel (@::Channels) { Say( $conn, $channel->{NAME}, $message, $first_person ); } } sub AdminNotice { my ($message) = @_; Say( $AdminChannel->{CONN}, $AdminChannel->{NAME}, $message) if $AdminChannel->{Listening}; } # on forced disconnect, report what channels had output for debugging sub log_pending_output($) { my ($self) = @_; my @queuedNicks = keys %OutputQueue; my $msg; if ($#queuedNicks == -1) { $msg = "no output is queued. $OutputBytesPending bytes pending."; } else { $msg = "total of $OutputBytesPending bytes pending for "; my $sep = ''; for my $nick (@queuedNicks) { my $Qentry = @{$OutputQueue{$nick}->{queue}}[0]; my $to = @{$Qentry}[1]; $msg.=$sep.(ref($to) eq "ARRAY" ? join('~', @{$to}) : $to); $sep = ', '; } } log_admin_event($self, undef, time, $msg); } # Looks for messages to which to respond that are not directly addressed # to the bot. # # Returns 0 if no such message was found, else 1 sub watch_significant_events ($$$$$$) { my($self, $event, $channel_name, $msg, $is_private, $addressed)=@_; my $from_nick=$event->nick; my $channel= $is_private ? undef # Channel_by_nick($from_nick) : Channel_by_name($channel_name); my $dest_nick=($is_private ? $from_nick : join('',$event->to)); return 0 if !$channel; return if !$::Do_Actions; # ACTION: if ($msg =~ m/^\s*(?:ACTION\s*)([-:])\s*(.*)$/) { $channel->{MsgTime} = time; if ($channel->{IgnoreActions}) { Say( $self, $dest_nick, "I am ignoring action items, $from_nick", 1 ) if $addressed; return 1; } if ($is_private) { Say( $self, $dest_nick, "I will not do that one-on-one, $from_nick", 1 ); return 1; } my $what = $1; my $add = $what eq ':'; my $actionitems = $channel->{ActionItems}; if ($add) { my $topic = $2; my $action = {}; $action->{Topic} = $topic; if ($channel->{Last_ID}) { $action->{Pointer} = $channel->{LogURIPrefix}.'#'.$channel->{Last_ID} } if ($actionitems) { push(@{$actionitems}, $action); } else { $actionitems = [$action]; $channel->{ActionItems} = $actionitems; } my $count = $#{$actionitems} + 1; $action->{id} = $count; ExportActionList($channel); Say( $self, $dest_nick, ($addressed ? '' : 'records ').'action '.$count, $addressed ); } else { my $actionID = $2; if ($actionID !~ m/^\d+$/ || $actionID == 0) { if ($addressed) { Say( $self, $dest_nick, 'I can only remove action items by number', 1 ); } return 1; } $actionID = $actionID - 1; # delete must be numeric if ($actionitems) { if ($actionID <= $#{$actionitems}) { $actionitems->[$actionID]->{Status} = $::ActionDropped; ExportActionList($channel); Say( $self, $dest_nick, ($addressed ? 'dropping' : 'drops').' action '.($actionID+1).', '.$actionitems->[$actionID]->{Topic}, $addressed ); } elsif ($addressed) { my $length = $#{$actionitems}+1; Say( $self, $dest_nick, 'I only see '.$length.' action item'.($length == 1 ? '' : 's').', '.$from_nick, 1 ); } } else { Say( $self, $dest_nick, ($addressed ? 'I see' : 'sees').' no action items', $addressed ); } } return 1; } # action nnn = xxx if ($msg =~ m/^\s*(?:ACTION)\s*([0-9]*)\s*=\s*(.*)$/) { $channel->{MsgTime} = time; if ($channel->{IgnoreActions}) { Say( $self, $dest_nick, "I am ignoring action items, $from_nick", 1 ) if $addressed; return 1; } if ($is_private) { Say( $self, $dest_nick, "I will not do that one-on-one, $from_nick", 1 ); return 1; } my $which = $1; my $action = {}; $action->{Topic} = $2; if ($channel->{Last_ID}) { $action->{Pointer} = $channel->{LogURIPrefix}.'#'.$channel->{Last_ID} } my $actionitems = $channel->{ActionItems}; if ($which == 0) { if ($addressed) { Say( $self, $dest_nick, 'I can only replace action items by number', 1 ); } return 1; } $which = $which - 1; # index must be numeric if ($action) { if ($which <= $#{$actionitems}) { $actionitems->[$which]->{Topic} = $action->{Topic}; ExportActionList($channel); Say( $self, $dest_nick, ($addressed ? '' : 'records ').'action '.($which+1).' replaced', $addressed ); } elsif ($addressed) { my $length = $#{$actionitems}+1; Say( $self, $dest_nick, 'I only see '.$length.' action item'.($length == 1 ? '' : 's'), 1 ); } } else { Say( $self, $dest_nick, ($addressed ? 'I see' : 'sees').' no open action items', $addressed ); } return 1; } } sub ReapIdleChannels($) { my ($conn) = @_; for (my $index=0; $index <= $#::Channels; $index++) { # have to use indexed-for since we intend to modify the array my $channel = $::Channels[$index]; if ($channel->{Listening} && $channel != $AdminChannel) { # if nothing interesting has been heard from the channel in 2 hours if ((time - $channel->{MsgTime}) > $ReaperThreshold) { log_admin_event($conn, undef, time, "$::Nick auto-departing $channel->{NAME}"); print "Auto-departing '$channel->{NAME}'\n"; $conn->me($channel->{NAME}, 'excuses himself; his presence no longer seems to be needed'); $conn->part($channel->{NAME}); Channel_close_logs($channel); $channel->{Listening} = 0; splice(@::Channels, $index, 1); redo; # restart w/o incrementing } } } $ReaperScheduled = 0; } sub DisplayActionItems($$$$$) { my ($self, $event, $channel, $from_nick, $dest_nick) = @_; $channel->{MsgTime} = time; my $nick = $self->nick; if ($channel->{IgnoreActions}) { my $msg = "I am ignoring action items, $from_nick"; Say( $self, $dest_nick, $msg ); log_event($self, $event, time, $msg, $nick); return 1; } my $actionitems = $channel->{ActionItems} ? $channel->{ActionItems} : []; my $actionCount = $#{$actionitems} + 1; if ($actionCount) { $actionCount = 0; # count the number of still-open actions for my $action (@{$actionitems}) { $actionCount++ unless $action->{Status} && $action->{Status} eq $::ActionDropped; } } if ($actionCount == 0) { my $msg = 'I see no action items'; Say( $self, $dest_nick, $msg ); log_event($self, $event, time, $msg, $nick); return 1; } my $msg = 'I see '.$actionCount.' open action item'.($actionCount == 1 ? '' : 's').':'; Say( $self, $dest_nick, $msg ); log_event($self, $event, time, $msg, $nick); for my $action (@{$actionitems}) { next if $action->{Status} && $action->{Status} eq $::ActionDropped; $msg = 'ACTION: '.$action->{Topic}.' ['.$action->{id}.']'; Say( $self, $dest_nick, $msg ); log_event($self, $event, time, $msg, $nick); if ($action->{Pointer}) { $msg = ' recorded in '.$action->{Pointer}; Say( $self, $dest_nick, $msg ); log_event($self, $event, time, $msg, $nick); } } } sub ExportActionList($) { my ($channel) = @_; my $docname; unless ($docname = $channel->{ActionLog}) { if ($::ActionLogName_Pattern) { $docname = strftime( $::ActionLogName_Pattern, gmtime ); } else { $docname = strftime( $::Default_ActionPattern, gmtime ); my $log_dir=Channel_get_log_dir($channel); if(!-d $log_dir) { mkpath([$log_dir], 0, 0755); # Failed! if (! -d $log_dir) { log_admin_event($channel, undef, time, "Failed to create chat log dir $log_dir - $!"); unlink $::PID_File; return; } } } { my $channel_name = $channel->{NAME}; $channel_name =~ s/^[#&]//; $docname =~ s//$channel_name/; } my $ECHO = $::TestMode ? 'echo ' : ''; system(("${ECHO}sh -c 'cd $::Log_LocalPath; cvs add $docname &'")); $channel->{ActionLog} = $docname; $channel->{CVSFiles} = ($channel->{CVSFiles} || '').$docname; } unless (open( ACTIONS, ">".($::Log_LocalPath || './').$docname)) { print 'Failed to open '.($::Log_LocalPath || './').$docname."\n"; return 0; } my $progname = basename(__FILE__); my $CVSRevision = '$Revision: 1.1.1.1 $'; # capture CVS info here $CVSRevision =~ s/\$//g; # drop '$' for W3C site repository checkin my $datetime = strftime( '%Y-%m-%dT%H:%MZ', gmtime ); my $mtgRecord = xml_escape($channel->{LogURIPrefix} || $::Log_URI); print ACTIONS <<"EOT"; $datetime Action Items from $mtgRecord $::Nick $progname $CVSRevision EOT my $actionitems = $channel->{ActionItems} ? $channel->{ActionItems} : []; if ($#{$actionitems} >= 0) { for my $action (@{$actionitems}) { print ACTIONS '
  • ',xml_escape($action->{Topic}),''; print ACTIONS ' ',$action->{Status},'' if $action->{Status}; print ACTIONS ' ' if $action->{Pointer}; print ACTIONS '
  • '; } } print ACTIONS '
    '; close ACTIONS; return 1; } # The documentation starts here. Perl allows use of this area # via the special file handle DATA __DATA__ =pod =head1 NAME logger - IRC Chat Logger =head1 SYNOPSIS logger [options...] PASSWORD CHANNEL-URI An irc logger bot that automatically generated logs for various IRC chat channels. Call it with parameters above where PASSWORD Administrator password for some commands CHANNEL-URI IRC channel URI like irc://host[:port]/channel and options are: main options: -admin PATH Directory for administrative logs and PID files -helpuri URI specifies the name of a more detailed help document -cvs commit logs to CVS; -lroot PATH must be specified -idleparttime SEC leave ('part') a channel if it has been quite for more than SEC seconds. If s==0 (the default), do not leave. -log PATTERN Name pattern for log files; uses strftime() substitutions, '' will be replaced with the channel name. Default is /%Y-%m-%d (".txt", ".html", and ".rdf" will be appended) -lroot PATH Write logs to PATH concat PATTERN (from -log PATTERN) '' in PATH will be replaced with host:port Default is / -nick NICK Use IRC nick NICK -uroot URI URI prefix for logs; '/' is not automatically added '' will be replaced with host:port simple on/off options: -actions Track action items -html Write an XHTML log as well as text and RDF -noinvites Do not allow invite command -noinitiallog Do not log the initial channel (specified in CHANNEL-URI) -nome Do not log /me messages (WAS -noaction in logger 1.76) -noofftopic Do not ignore lines starting with [off] -notext Do not write a text log -userhosts Record user@host from /join messages =head1 DESCRIPTION The logger bot listens to the chat channel and records it in public logs which are written live in three formats - RDF, plain text and HTML (usually created from RDF via XSLT by some other program). Logger accepts a few commands that can be done publically with logger, COMMAND or privately with /msg logger COMMAND The full list of commands can be found by the help command /msg logger help Logger can be told to stop listening/recording to the chat, if for some reason this is required. For individual messages this can be done by putting the phrase '[off]' at the start of a line of text and for longer conversations, tell logger to stop listening with: logger, off and recording again with logger, on (there are other synonyms). The on/off messages are logged, as well as all public commands to logger. This feature can be turned off with -noofftopic The current log URI, and the position in it can be queried at any time with logger, pointer or using one of the other aliases: here, bookmark, where am i? Logger also can perform searches over the logs using the C or C command (or ending anything to logger with C). It returns matches to the given perl regex in recent output, most recent first. See the help text for more details. Selected results can be returned by prefixing the command with a count or a range like this: /msg logger grep 5 things /msg logger grep 10-20 things Logger has some administrative commands that can be found from: /msg logger adminhelp These require the startup password in order to use, for example this will make logger terminate: /msg logger password PASSWORD quit logger will attempt to reconnect when disconnected but doesn't yet handle all network problems very gracefully. =head2 LICENSE GNU GPL version 2 or later - see http://www.gnu.org/copyleft/gpl.html =head2 AUTHOR Dave Beckett - http://purl.org/net/dajobe/, Institute for Learning and Research Technology, http://ilrt.org/, University of Bristol. with lots of changes from Ralph Swick - http://www.w3.org/People/all#swick, W3C/MIT =cut