Index: openacs-4/contrib/packages/irc-logger/ChangeLog =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/irc-logger/ChangeLog,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/irc-logger/ChangeLog 30 Jan 2003 02:48:43 -0000 1.1 @@ -0,0 +1,5 @@ +2003-01-29 Bart Teeuwisse + + * irc-logger.info (Module): Initial revision + (Module): Bumped up revision to 1.0b (beta) + Index: openacs-4/contrib/packages/irc-logger/irc-logger.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/irc-logger/irc-logger.info,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/irc-logger/irc-logger.info 30 Jan 2003 02:48:43 -0000 1.1 @@ -0,0 +1,52 @@ + + + + + IRC Logger + IRC Loggers + f + f + + + + oracle + postgresql + + Bart Teeuwisse +

The IRC logger places the log files of logger (a Perl script by Dave Beckett) into ETP for integration with OpenACS.

+ the Code Mill + The IRC logger places the log files of <a href="http://cvs.ilrt.org/cvsweb/redland/logger/">logger</a> (a Perl script by Dave Beckett) into ETP for integration with OpenACS. Besides logger, this package also depends on <a href="http://www.tdom.org/">tDOM</a> (high performance XML data processing with easy and powerful Tcl scripting functionality). + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 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 -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/irc-logger/perl/logger 30 Jan 2003 02:48:48 -0000 1.1 @@ -0,0 +1,2269 @@ +#!/usr/bin/perl -w +# +# IRC Chat Logger +# +# $Source: /usr/local/cvsroot/openacs-4/contrib/packages/irc-logger/perl/logger,v $ +# $Id: logger,v 1.1 2003/01/30 02:48:48 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 2003/01/30 02:48:48 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 2003/01/30 02:48:48 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.

$time [$nick]: }.$escapedMsg.qq{

IRC log of $escaped_chan on $date

Why

Background

Installation

Usage

irc_channel_name

xsl_stylesheet

irc_rdf_dir

irc_log_interval

Credits

GNU General Public License

Preamble

Terms and conditions for copying, distribution and modification