Index: openacs-4/contrib/packages/irc-logger/perl/logger =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/irc-logger/perl/logger,v diff -u -r1.2 -r1.3 --- openacs-4/contrib/packages/irc-logger/perl/logger 31 May 2004 07:09:13 -0000 1.2 +++ openacs-4/contrib/packages/irc-logger/perl/logger 12 Sep 2013 14:38:11 -0000 1.3 @@ -1,16 +1,14 @@ #!/usr/bin/perl -w # -# IRC Chat Logger +# IRC RDF Chat Logger # # $Source$ # $Id$ -# arch-tag: a8cfbee4-a440-4285-82d6-617c0fe86c25 # -# (C) Copyright 2000-2002 Dave Beckett, ILRT, University of Bristol +# (C) Copyright 2000-2001 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 +# with modifications from Ralph Swick # http://www.w3.org/People/all#swick # # This program is free software; you can redistribute it and/or @@ -40,7 +38,7 @@ use Sys::Hostname; use Getopt::Long; use IO::Handle; -use POSIX qw(strftime); +use Encode; # From CPAN use URI; @@ -50,29 +48,18 @@ %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); @@ -108,53 +95,31 @@ qr|(file://)([^] \)>"\'\n[\t\\]*)(.*)$|, qr|(gopher://)([^] \)>"\'\n[\t\\]*)(.*)$|, qr|(nntp://)([^] \)>"\'\n[\t\\]*)(.*)$|, - qr|(wais://)([^] \)>"\'\n[\t\\]*)(.*)$|, # " + qr|(wais://)([^] \)>"\'\n[\t\\]*)(.*)$|, qr|(telnet://)([^] \)>"\'\n[\t\\]*)(.*)$|, qr|(prospero://)([^] \)>"\'\n[\t\\]*)(.*)$|, - qr|(mailto:)([^] \)>"\'\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 +$::Log_Root=''; -# root dir of logs; prepended to LogName_Pattern -$::Log_LocalPath=undef; # include '/' if you need it +# place on the web this corresponds to +$::Log_URI=''; -# 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; @@ -167,9 +132,11 @@ # Process ID $::PID_File=undef; -# Channel name (added by bartt) -$::Channel_Name=undef; +# On connect /msg $user $cmd +$::Connect_User=undef; +$::Connect_CMD=undef; + ###################################################################### package URI::irc; @@ -200,74 +167,60 @@ 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 $usage=<<"EOT"; +Usage: $::program [option...] password channel-URI channel-title log-dir log-URI + where option is one or more of: + -html write an XHTML log + -notext Do not write a text log + -log Write logs to logfile rather than the default + of channel/YYYY-MM-DD + (\".txt\", \".html\", and \".rdf\" will be appended) + -nick set the nick + -connectuser on connect /msg this user + -connectcmd with this command - my(%do_log_types)=map {$_ => 1} @::DefaultLogTypes; + -noaction Do not log /me messages + -noofftopic Do not ignore lines starting with [off] + -userhosts Record user\@host in /join messages - print $::program,': $Id$',"\n"; + and channel-URI is like irc://host[:port]/channel +EOT - 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; + my(%do_log_types)=map {$_ => 1} @::DefaultLogTypes; + my $log_name=undef; + die $usage unless GetOptions ('action!' => \$::LogActionMsgs, + 'html!' => \$do_log_types{'html'}, + 'text!' => \$do_log_types{'txt'}, + 'log=s' => \$log_name, + 'nick=s' => \$::Nick, + 'connectuser=s' => \$::Connect_User, + 'connectcmd=s' => \$::Connect_CMD, + 'userhost!' => \$::LogUserHosts, + 'offtopic!' => \$::OffTopic, + ) && @ARGV==5; @::DefaultLogTypes=grep($do_log_types{$_}, @::LogTypes); - my($password,$uri_string)=@ARGV; + my($password,$uri_string,$channel_title, $log_root, $log_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: log dir $log_root does not exist\n" unless -d $log_root; - die "$::program: admin dir $::AdminDir does not exist\n" - unless -d $::AdminDir; - # Set globals $::Password=$password; + $::Log_Root=$log_root; + $::Log_URI=$log_uri_string; + $::Do_Welcome=0; $::Departing=0; $::Connecting=1; # Open the administrative log file - my $admin_log_file=$::AdminDir.'/'.$::Nick.'.log'; + my $admin_log_file=$::Log_Root.'/admin.log'; $::Admin_LOG=new IO::File; $::Admin_LOG->open(">>$admin_log_file") @@ -279,19 +232,15 @@ # 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'; + $::PID_File=$::Log_Root.'/logger-'.$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; + my $channel=&Channel_new($uri, $channel_title, $log_name); + Channel_join($channel); # Never returns @@ -309,36 +258,22 @@ # 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} +@::Channels=(); - # ActionItems[] -> {Topic}, {Pointer}, {id} +sub Channel_new ($$$) { + my($uri,$title,$log_name)=@_; -sub Channel_new ($) { - my($uri)=@_; - my $self={}; + # Channel title + $self->{Title}=$title; + # 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; + $self->{LogName}=$log_name; # topic of channel $self->{Topic}=''; @@ -349,8 +284,6 @@ # True if logging $self->{Listening}=0; - $self->{LogsOpen} = 0; - # Track midnight rollover $self->{hour}= undef; @@ -368,12 +301,6 @@ # 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; @@ -387,7 +314,7 @@ my $channel_name=$uri->channel; - $self->{Listening}=$::LogInitial; + $self->{Listening}=1; my $user_name=substr($channel_name,0,8)."-logger"; @@ -403,12 +330,12 @@ $self->{CONN}=$conn; - Channel_open_logs($self) if $::LogInitial; + Channel_open_logs($self); # Install handlers - # On 'end of MOTD' event, join channel + # On 'end of MOTD' event, join ilrt channel $conn->add_global_handler(376, \&on_connect); - $conn->add_global_handler('welcome', \&on_connect); + $conn->add_global_handler('nomotd', \&on_connect); $conn->add_global_handler(353, \&on_names); $conn->add_global_handler('disconnect', \&on_disconnect); @@ -423,44 +350,24 @@ $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.'/'; + my $channel_name=$uri->channel; $channel_name=~ s/\W//g; + + return $::Log_Root.'/'.$uri->host.$::PortSep.$uri->port.'/'.$channel_name.'/'; } @@ -469,23 +376,16 @@ my(@file_dates); - if (my $log_name=$self->{LogFilePrefix}) { + if (my $log_name=$self->{LogName}) { @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 + next unless $file =~ /^(\d\d\d\d-\d\d-\d\d).txt/; my $date=$1; - $date =~ s/-$//; # trim a trailing hyphen if one exists push(@file_dates, ["$log_dir/$file", $date]); } closedir(DIR); @@ -520,74 +420,52 @@ my $self=shift; my $conn=$self->{CONN}; - my $channel_name=$self->{NAME}; - $channel_name =~ s/^[#&]//; + my $uri=$self->{URI}; + my $channel_name=$uri->channel; 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); + my $log_dir=Channel_get_log_dir($self); + + mkpath([$log_dir], 0, 0755) if ! -d $log_dir; # Failed! - if (! -d $dir) { - log_admin_event($self, undef, time, "Failed to create chat log dir $dir - $!"); + if (! -d $log_dir) { + log_admin_event($self, undef, time, "Failed to create chat log dir $log_dir - $!"); unlink $::PID_File; - return; + exit(0); } + $self->{LogFilePrefix}=$log_dir."/".$date; + $self->{LogURIPrefix}=$::Log_URI.$date if $::Log_URI; } - - 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; + exit(0); } $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}; @@ -596,7 +474,7 @@ 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; + exit(0); } my $escaped_chan = xml_escape($channel_name); @@ -629,7 +507,7 @@ 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; + exit(0); } } @@ -647,7 +525,6 @@ # 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) { @@ -656,7 +533,7 @@ 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; + exit(0); } my $escaped_chan_uri = xml_escape($self->{URI}); @@ -676,7 +553,7 @@ 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; + exit(0); } } @@ -690,43 +567,29 @@ } $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; +sub log_event ($$$;$) { + my($self, $event, $t, $msg)=@_; + my $nick=$event->nick; - my $channel=Channel_by_name(($event->to)[0]); + my $channel=Channel_by_conn($self); - return if !$channel || !$channel->{Listening}; + return if !$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]); @@ -743,6 +606,9 @@ $channel->{hour} = $hour; + + $msg=ensure_utf8($msg); + if (grep($_ eq 'txt', @{$channel->{LogTypes}})) { my $txt_msg=$nick ? qq{<$nick> $msg} : $msg; my $txt_log_fh=$channel->{FH}->{txt}; @@ -808,18 +674,6 @@ 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; - } } @@ -851,11 +705,23 @@ my $channel=Channel_by_conn($self); - my $channel_name = $channel->{NAME}; + my $channel_name; + if ($channel->{URI}->channel =~ m/[\#&]/) { + $channel_name = $channel->{URI}->channel; # don't add a prefix if one was given + } else { + $channel_name ='#' . $channel->{URI}->channel; # else assume a public channel + } + + if($::Connect_User && $::Connect_CMD) { + $self->privmsg($::Connect_User, $::Connect_CMD); + } + log_admin_event($self, $event, time, "Connected to server"); $self->join($channel_name); + $channel->{Listening}=1; + $self->me($channel_name, 'is logging'); } @@ -895,7 +761,6 @@ 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; @@ -915,12 +780,6 @@ 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); @@ -943,31 +802,15 @@ 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); @@ -986,24 +829,6 @@ } -# 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) = @_; @@ -1040,23 +865,6 @@ 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"; - } } @@ -1072,7 +880,7 @@ # What to do when someone does /topic MSG sub on_topic { my ($self, $event) = @_; - my $channel=Channel_by_name(($event->to)[0]); + my $channel=Channel_by_conn($self); my $nick=$event->nick; my(@args)=$event->args; @@ -1091,6 +899,7 @@ # What to do when someone joins a channel logger is on. sub on_join { my ($self, $event) = @_; + my $channel=Channel_by_conn($self); my ($channel_name) = ($event->to)[0]; my $user_nick=$event->nick; @@ -1099,34 +908,9 @@ "%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; @@ -1139,175 +923,96 @@ "For extensive help do: /msg $::Nick help" ); + my $do_sleep=0; for my $output (@intro) { - Say( $self, $event->nick, $output ); + sleep(1) if $do_sleep; + $self->privmsg($event->nick, $output); + $do_sleep=1; } } sub command_for_me ($$$$$) { my($self, $event, $channel_name, $command, $is_private)=@_; + my $channel=Channel_by_conn($self); 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 $dest_nick=($is_private ? $from_nick : $event->to); + my $valid_password=0; if($command =~ s/^password (\S+)\s*//) { if($1 eq $::Password) { $valid_password=1; } else { - Say( $self, $dest_nick, "Invalid password" ); + $self->privmsg($dest_nick, "Invalid password"); return; } } if($valid_password) { - # please quit - if($command=~ /^(?:please\s+|pls\s+)?(?:quit|finish|terminate|die die die|exterminate)$/i) { + if($command=~ /^(?:quit|finish|terminate|die die die|exterminate|bye|excuse us)/i) { $::Departing=1; - for my $channel (@::Channels) { - $self->me($channel->{NAME}, 'is departing'); - sleep(1); - } + $self->me($event->to, 'is departing'); # Log who told me to quit - log_admin_event($self, $event, time, "$::Nick told to quit"); + log_admin_event($self, $event, time, "Logger 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->me($event->to, ' is departing'); $self->quit; sleep(1); $::Connecting=1; $self->connect(); return; } - # debug if($command eq 'debug') { - Say( $self, $dest_nick, "Debugging is on" ); + $self->privmsg($dest_nick, "Debugging is on"); $self->debug(1); return; } - # nodebug if($command eq 'nodebug') { - Say( $self, $dest_nick, "Debugging is off" ); + $self->privmsg($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 ); + $self->me($event->to, 'is not logging'); # 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 ); + $self->me($event->to, 'is already not logging'); } 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 ); + $self->me($event->to, 'is logging'); # 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 ); + $self->me($event->to, 'is already logging'); } 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; @@ -1323,121 +1028,53 @@ } else { $output="There is no log URI"; } - Say( $self, $dest_nick, $output ); - log_event($self, $event, time, $output, $self->nick) unless $is_private; + $self->privmsg($dest_nick, $output); + log_event($self, $event, time, $output) 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; - } + if($command=~ /^chump\s*(.+)$/i) { + my $item=$1; + my($log_uri)=$channel->{LogURIPrefix}; - # 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; - } + my $output; + my $chump=undef; + if($item =~ /^([A-Za-z]+):?$/) { + $chump=uc $1; + $chump=undef if $chump eq 'BLURB'; + } - # [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; + if(!$chump) { + $output="Invalid chump item $item"; + } elsif($log_uri) { + $log_uri.="#".$channel->{Last_ID} if $channel->{Last_ID}; + $output="$chump:See [$log_uri|discussion]"; + } else { + $output="There is no log URI"; + } + $self->privmsg($dest_nick, $output); + log_event($self, $event, time, $output) unless $is_private; + return; } - # [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->{Listening}) { + $output="I'm not logging. "; + } else { + $output="I'm logging. "; } - if ($channel) { - if(!$channel->{Listening}) { - $output="I'm not logging. "; - } else { - $output="I'm logging. "; - } - - # Allow question? - if ($command =~ /^(.+)\?$/) { - $command="grep $1"; - } + # 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, + my(@help)=( + "The commands I know are:", + " silence - Stop logging (also: stop, off, ...)", + " listen - Start logging (also: start, on, ...)", + " bookmark - Give the URI of the current log", + " chump LETTER - Record the URI of the current log under chump LETTER", "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" ); @@ -1448,135 +1085,67 @@ } @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, + "My public output is logged but these lines are not searchable.", + "The logs are at $::Log_URI", "Do $::Nick, adminhelp for help on administrative commands", ); - + my $do_sleep=0; for my $output (@help) { - Say( $self, $dest_nick, $output ); + sleep(1) if $do_sleep; + $self->privmsg($dest_nick, $output); + $do_sleep=1; } 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", + " quit - I will depart", + " restart - I will leave and rejoin channel", + " debug - Turn on debugging", + " nodebug - Turn off debugging", "These commands work only with the admin PASSWORD like this:", "/msg $::Nick password PASSWORD command'", ); - + my $do_sleep=0; for my $output (@help) { - Say( $self, $dest_nick, $output ); + sleep(1) if $do_sleep; + $self->privmsg($dest_nick, $output); + $do_sleep=1; } 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; - } + $output.=qq{Sorry, searching removed.}; } 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 ); + $self->privmsg($dest_nick, $output); log_event($self, $event, time, $output) unless $is_private; } ###################################################################### # Utility subroutines +sub ensure_utf8 ($) { + my $text = shift; + + # If it cannot be decoded as UTF-8... + my $t="".$text.""; + eval { decode("utf8", $t, Encode::FB_CROAK); }; + if($@) { + # Assume it is latin-1 (there is no real IRC encoding), encode as UTF-8 + $text=encode("utf8", decode("iso-8859-1", $text), Encode::FB_QUIET); + } + + $text; +} + + # Escape any special characters that are significant to XML # Then hide any CVS/RCS tags from future invocations of CVS/RCS @@ -1599,7 +1168,8 @@ $string =~ s//\>/g; $string =~ s/[\x00-\x1F]//g; # remove ASCII 0-31 - $string =~ s/([\x80-\xFF])/"\&#".ord($1).";"/ge; # escape ASCII 128-255 +# Output is UTF-8, so don't throw away high characters +# $string =~ s/([\x80-\xFF])/"\&#".ord($1).";"/ge; # escape ASCII 128-255 $string; } @@ -1663,545 +1233,37 @@ return $l; } +__END__ -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$'; # 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 +logger - RDF IRC Chat Logger =head1 SYNOPSIS - logger [options...] PASSWORD CHANNEL-URI + logger [options...] PASSWORD CHANNEL-URI CHANNEL-TITLE LOG-DIR LOG-URI > logger.log 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 + CHANNEL-TITLE A title to use in welcome messages + LOG-DIR Root directory to start writing logs + LOG-URI URI of where the logs appear on the web 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 / + -html Write an XHTML log as well as text and RDF. + -log LOGFILE Write logs to LOGFILE rather than the default + of CHANNEL/YYYY-MM-DD (".txt", ".html", and ".rdf" + will be appended) -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) + -noaction Do not log /me messages -noofftopic Do not ignore lines starting with [off] - -notext Do not write a text log -userhosts Record user@host from /join messages =head1 DESCRIPTION @@ -2234,14 +1296,10 @@ 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 +The current log URI can be recorded in a particular chump bot item +using: + logger, chump D +to record the discussion below item D. Logger has some administrative commands that can be found from: /msg logger adminhelp Fisheye: Tag 1.1 refers to a dead (removed) revision in file `openacs-4/contrib/packages/irc-logger/perl/logger-bart'. Fisheye: No comparison available. Pass `N' to diff? Index: openacs-4/contrib/packages/irc-logger/tcl/irc-logger-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/irc-logger/tcl/irc-logger-procs.tcl,v diff -u -r1.9 -r1.10 --- openacs-4/contrib/packages/irc-logger/tcl/irc-logger-procs.tcl 31 May 2004 07:09:14 -0000 1.9 +++ openacs-4/contrib/packages/irc-logger/tcl/irc-logger-procs.tcl 12 Sep 2013 14:38:11 -0000 1.10 @@ -53,6 +53,7 @@ ad_proc -public irc::logger::apply_xslt { -rdf_log:required -xsl_style:required + {-package_id ""} } { Transform the RDF IRC log to HTML using passed XSL stylesheet. @@ -75,28 +76,41 @@ # Return the empty string if the XSL style could not be applied. set text "" + # Return the empty string if the XSL style could not be applied. + set text "" + if {![catch {set rdf [dom parse [read [open $rdf_log r]]]} error_msg]} { if {![catch {set xsl [dom parse [read [open $xsl_style r]]]} error_msg]} { # Transform the RDF DOM tree to an HTML DOM tree - + if {![catch {set html [$rdf xslt $xsl]} error_msg]} { # Serialize the HTML DOM tree as HTML text set text [$html asHTML] - $html delete + } else { ns_log warning "irc::logger::apply_xslt - Could not transform RDF log '$rdf_log' to HTML with XSL sheet '$xsl_style': $error_msg" } - $xsl delete } else { ns_log warning "irc::logger::apply_xslt - Could not parse $xsl_style: $error_msg" } $rdf delete } else { ns_log warning "irc::logger::apply_xslt - Could not parse $rdf_log: $error_msg" } + + # clean up the dom references, otherwise we have a mem leak. + if {[info exists rdf]} { + $rdf delete + } + if {[info exists xsl]} { + $xsl delete + } + if {[info exists html]} { + $html delete + } return $text } @@ -211,7 +225,9 @@ -xsl_style [parameter::get \ -parameter xsl_stylesheet \ -package_id $package_id \ - -default "[acs_package_root_dir [apm_package_key_from_id $package_id]]/data/default.xsl"]] + -default "[acs_package_root_dir [apm_package_key_from_id $package_id]]/data/default.xsl"] \ + -package_id $package_id] + if {![empty_string_p $irc_html_log]} { # The transformation was succesful. Time to create @@ -402,9 +418,15 @@ # Locate the first user with a screen name of 'nick' on this # site. DB caching reduces the number of hits on the DB # itself. + + # community_member_url was changed to require a conn + # it always returned / for the subsite since we run from a + # scheduled proc. This needs to be smarter. + set community_member_url "[ad_parameter -package_id [ad_acs_kernel_id] CommunityMemberURL]?[export_vars {user_id}]" + if {[db_0or1row get_user {}]} { - set link "$nick" + set link "$nick" } else { set link $nick }