cl58 Posted January 9, 2010 Posted January 9, 2010 I am trying to run a log bot for irc on services.cl58tools.co.cc however, I cannot get the script to run. Everytime I run http://services.cl58tools.co.cc/perl/log-irc.pl it says: Internal Server Error The server encountered an internal error or misconfiguration and was unable to complete your request. Please contact the server administrator, webmaster@services.cl58tools.co.cc and inform them of the time the error occurred, and anything you might have done that may have caused the error. More information about this error may be available in the server error log. Additionally, a 404 Not Found error was encountered while trying to use an ErrorDocument to handle the request. Apache/2.2.11 (Unix) mod_ssl/2.2.11 OpenSSL/0.9.8e-fips-rhel5 mod_wsgi/3.0c3 Python/2.4.3 mod_auth_passthrough/2.1 mod_bwlimited/1.4 FrontPage/5.0.2.2635 Server at services.cl58tools.co.cc Port 80 Please Help
Byron Posted January 9, 2010 Posted January 9, 2010 Go to your error logs at your cpanel and see if you see error messages. You can add this to your script and it will write any errors to a text file named errors.txt BEGIN { use CGI::Carp qw(carpout); use diagnostics; open(LOG, ">errors.txt"); carpout(LOG); close(LOG); } Remove it or comment it out when your finished.
cl58 Posted January 13, 2010 Author Posted January 13, 2010 My entire error log: [Tue Jan 12 17:28:25 2010] [error] [client 67.85.177.19] File does not exist: /home/cl58tool/public_html/500.shtml [Tue Jan 12 17:23:09 2010] [error] [client 67.85.177.19] File does not exist: /home/cl58tool/public_html/500.shtml [Tue Jan 12 17:23:02 2010] [error] [client 66.249.71.91] File does not exist: /home/cl58tool/public_html/services/500.shtml [Tue Jan 12 17:23:02 2010] [error] [client 67.85.177.19] File does not exist: /home/cl58tool/public_html/403.shtml [Tue Jan 12 17:23:02 2010] [error] [client 67.85.177.19] attempt to invoke directory as script: /home/cl58tool/public_html/cgi-bin/ [Tue Jan 12 17:22:32 2010] [error] [client 67.85.177.19] File does not exist: /home/cl58tool/public_html/500.shtml, referer: http://www.cl58tools.co.cc/mt/ [Tue Jan 12 17:22:31 2010] [error] [client 67.85.177.19] File does not exist: /home/cl58tool/public_html/500.shtml, referer: http://www.cl58tools.co.cc/mt/ Also, where do I put that code. I am now trying to install MoveableType and I need perl for that.
Byron Posted January 13, 2010 Posted January 13, 2010 Also, where do I put that code. I am now trying to install MoveableType and I need perl for that. Put that code right under the she-bang line. This line here: #!/usr/bin/perl Then click onto your file and then refresh your directory to read the errors.txt file.
cl58 Posted January 13, 2010 Author Posted January 13, 2010 I did that and it is still showing the 404 Internal Server error as if the file does not exist. Also, the errors.txt file is not being created.
Byron Posted January 13, 2010 Posted January 13, 2010 I did that and it is still showing the 404 Internal Server error as if the file does not exist. Also, the errors.txt file is not being created. I'm showing a 500 Internal Server Error on this file: http://services.cl58tools.co.cc/perl/log-irc.pl Do you have the correct file permissions? Should be 755.
cl58 Posted January 13, 2010 Author Posted January 13, 2010 That file along with all MoveableType files are all 755
cl58 Posted January 13, 2010 Author Posted January 13, 2010 Which one? The IRC one or a MoveableType file? IRC One #! /usr/bin/perl BEGIN { use CGI::Carp qw(carpout); use diagnostics; open(LOG, ">errors.txt"); carpout(LOG); close(LOG); } my $BSD_STYLE_LICENSE = <<'EOF'; Copyright (c) 2007, Jason Fesler All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. Neither the name Jason Fesler nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. EOF use Net::IRCService; use Net::IRCService::DB; use YAML::Syck; # Human readable, used for config use JSON::Syck; # Machine compact, for machine readable log use Text::Wrap; use strict; use FileCache maxopen => 100; use POSIX qw(strftime tzset); my $VERSION = "0.10"; ########################################################################## # WARNING # ########################################################################## # my_* functions will be called BEFORE Net::IRCService::DB functions # # will due to our local functions being registered before DB functions. # # Unfortunately, DB functions can only be registered AFTER we init # # Net::IRCService; and I want to have all hooks in place before then. # ########################################################################## my $YAML = "$0.yaml"; my %yaml; # $0.yaml config my @bots; # Array of yaml->bots my %bots; # Copy of yaml->bots my %joined; # Bots track where they joined my %topics; # track topic changes my %topics_by; # And who made them my %my_EK_count; # How many times any one op killed me my $db = new Net::IRCService::DB; my $statusbar = '-\|/'; my $statuscount = 0; $| = 1; init(); main_loop(); ###################################################### # Function declarations # ###################################################### # I'm a bit inconsistent on where I use these. sub print_tty(@); ###################################################### # Configuration and Init related # ###################################################### sub _lc($) { my $nick = shift; $nick =~ tr/[]\\/{}|/; return lc($nick); } sub init { load_yaml(); log_init(); copy_event_numbers(); &init_service( %{ $yaml{"connection"} } ); } ## end sub init sub load_yaml { my $ref = LoadFile($YAML) or die "$!"; %yaml = %{$ref}; after_yaml(); } sub save_yaml { DumpFile( "$YAML.$$", \%yaml ); if ( -s "$YAML.$$" ) { rename( "$YAML.$$", "$YAML" ); } else { warn "Failed to create a useful $YAML.$$"; } after_yaml(); } ## end sub save_yaml sub after_yaml { @bots = keys %{ $yaml{"bots"} }; %bots = map { $_ => 1 } @bots; } my %eventnumbers; sub copy_event_numbers { foreach my $e ( keys %Net::IRCService:: ) { if ( $e =~ /^EVENT_/ ) { no strict "refs"; my $f = "Net::IRCService::$e"; eval { # Do not error. Just try it, and let exceptions go silent. my $fvalue = &$f(); $eventnumbers{$fvalue} = $e; # Prepare debugging function my $d = "debug_$e"; my $perl = "sub $d { my_ALLDEBUG('$e',\@_) }"; eval $perl; die $@ if $@; my $m = "my_$e"; if ( defined( &{$m} ) ) { # Add local function to chain if found add_event_handler( &$f(), \&$m ); } else { # Add debugging function to chain to show uncaught events add_event_handler( &$f(), \&$d ); } }; } ## end if ( $e =~ /^EVENT_/ ) } ## end foreach my $e ( keys %Net::IRCService::) } ## end sub copy_event_numbers ###################################################### # IRC server events # ###################################################### sub print_tty(@) { print @_ if ( -t STDOUT ); } sub my_ALLDEBUG { my $e = shift @_; $e = $eventnumbers{$e} if ( exists $eventnumbers{$e} ); return if ( ( $e eq "EVENT_DEBUG" ) && grep( /irc_send_now/, @_ ) ); print_tty "\e[1;31m" if ( $e eq "EVENT_RAW_IN" ); print_tty "\e[1;33m" if ( $e eq "EVENT_RAW_OUT" ); print_tty "\e[0;33m" if ( $e eq "EVENT_SEND" ); print_tty "\e[0;33m" if ( $e eq "EVENT_SEND_NOW" ); local $YAML::Syck::Headless = 1; if ( scalar @_ <= 1 ) { print "$e\: @_\n"; } else { print Dump( { $e => \@_ } ); } print_tty "\e[0m"; } ## end sub my_ALLDEBUG sub my_EVENT_DEBUG { } sub my_EVENT_RAW_IN { } sub my_EVENT_RAW_OUT { } sub my_EVENT_RAW_SEND { } sub my_EVENT_SEND { } sub my_EVENT_SEND_NOW { } sub my_EVENT_RAW_SENDNOW { } sub my_EVENT_CAPAB { } sub my_EVENT_MODE { } sub my_EVENT_SERVER { } sub my_EVENT_SNICK { } sub my_EVENT_PING { } sub my_EVENT_INIT { } # idle loop sub my_EVENT_DO_ONE_LOOP { $statuscount++; if ( -t STDOUT && -t STDERR ) { die "what statusbar=$statusbar" unless ( length($statusbar) ); print STDERR substr( $statusbar, $statuscount % length($statusbar), 1 ); print STDERR "\r"; } if ( ( $statuscount % 10 ) == 0 ) { logbot_periodic(); } } ## end sub my_EVENT_DO_ONE_LOOP sub my_EVENT_DISCONNECTED { print "Server has disconnected, we need to clear all state.\n"; print "Cheating and just exiting instead.\n"; print "Run this under daemontools.\n"; exit; } ## end sub my_EVENT_DISCONNECTED sub my_EVENT_CONNECTED { $db->init(); # Start tracking users, channels, etc. } sub my_EVENT_SVINFO { bot_connect($_) foreach (@bots); # Connect our bots } sub my_EVENT_SSJOIN { my ( $server, $ts, $channel, $mode, $nick ) = @_; logbot_do_logging( "JOIN", $nick, $channel, "" ); bots_join($channel); } sub my_EVENT_PART { my ( $nick, $channel, $message ) = @_; $message ||= ""; logbot_do_logging( "PART", $nick, $channel, $message ); $nick = _lc $nick; $channel = lc $channel; $DB::single = 1; my (@users) = grep( lc $_ ne $nick, $db->channel_get_users($channel) ); if ( !scalar @users ) { # The bots are the last here. We are no longer needed. foreach (@bots) { bot_part( $_, $channel ); } delete $topics{$channel}; } ## end if ( !scalar @users ) } ## end sub my_EVENT_PART sub my_EVENT_QUIT { my ($nick) = @_; foreach my $channel ( get_user_channels($nick) ) { print "EVENT_QUIT: Caling my_EVENT_PART($nick,$channel,Client quit IRC)\n"; my_EVENT_PART( $nick, $channel, "Client quit IRC" ); } } ## end sub my_EVENT_QUIT sub my_EVENT_CTOPIC { my ( $nick, $channel, $topic ) = @_; logbot_do_logging( "TOPIC", $nick, $channel, $topic ); $topics{ lc $channel } = @_; $topics_by{ lc $channel } = $nick; } ## end sub my_EVENT_CTOPIC sub my_EVENT_KILL { my ( $nick, $bot ) = @_; $nick = _lc $nick; $bot = _lc $bot; if ( exists $bots{$bot} ) { bot_connect($bot); bot_say( $bot, $nick, "Please do not kill the bot. It reincarnates and you do not." ); if ( $my_EK_count{$nick}++ > 2 ) { bot_kill( $bot, $nick, "Please do not kill the bot. It reincarnates and you do not." ); } ## end if ( $my_EK_count{$nick... foreach my $channel ( $db->channel_list ) { logbot_do_logging( "KILL", $bot, $channel, "Bot killed by $nick but reincarnating" ); $joined{$bot}{$channel} = 0; bots_join($channel); } ## end foreach my $channel ( $db->channel_list) } ## end if ( exists $bots{$bot... } ## end sub my_EVENT_KILL sub my_EVENT_KICK { my ( $nick, $channel, $bot ) = @_; my ( $kicker, $channel, $kickee ) = @_; $nick = _lc $nick; $bot = _lc $bot; if ( exists $bots{$bot} ) { # We got kicked, dude! logbot_do_logging( "KICK", $bot, $channel, "Kicked by $nick - considering this an uninvite" ); $joined{$bot}{$channel} = 0; # Treat like uninvited: $yaml{bots}{$bot}{"channels"}{$channel} = 0; save_yaml(); bot_say( $bot, $nick, "Use /invite $bot $channel to bring me back." ); bot_say( $bot, $nick, "Or use /msg $bot join $channel if your client does not do invites" ); } ## end if ( exists $bots{$bot... else { logbot_do_logging( "KICK", $kicker, $channel, "kicked $kickee" ); my_EVENT_PART( $kickee, $channel, "kicked by $kicker" ); } } ## end sub my_EVENT_KICK sub my_EVENT_WHOIS { my ( $nick, $bot, $crap ) = @_; $nick = _lc $nick; $bot = _lc $bot; my $s = $yaml{connection}{SERVER_NAME}; irc_send("311 $nick $bot $s * :services bot uses Net::IRCService"); irc_send("318 $nick :Nosy bugger aren't you"); } ## end sub my_EVENT_WHOIS sub my_EVENT_PRIVMSG { my ( $nick, $towho, $string ) = @_; if ( $towho =~ /^#/ ) { logbot_do_logging( "PRIVMSG", $nick, $towho, $string ); } $nick = _lc $nick; $towho = lc $towho; if ( exists $bots{$towho} ) { if ( $string =~ m#\x01PING# ) { $string =~ s#PING#PONG#; bot_say( $towho, $nick, $string ); return; } } ## end if ( exists $bots{$towho... # We still don't know if this is a message to me my $tome; my $replyto; if ( $towho =~ m/^#/ ) { # Really a channel ( $tome, $string ) = split( /[ :]+/, $string ); if ( exists $bots{ lc $tome } ) { $replyto = $towho; } else { return; # Not a message to me. } } else { if ( exists $bots{$towho} ) { $tome = $towho; $replyto = $nick; } else { return; } } ## end else [ if ( $towho =~ m/^#/ ) my $bot = $tome; # $tome = my name # $nick = requestor # $replyto = how to reply my (@words) = split( /\s+/, $string ); if ( ( $replyto =~ m/^#/ ) && ( $string =~ /^(part|leave)\s*$/i ) ) { # Leave this channel. bot_say( $bot, $replyto, "/invite $bot to bring back" ); bot_uninvited( $bot, $replyto ); return; } ## end if ( ( $replyto =~ m/^#/... if ( $words[0] =~ /^(join|invite)$/ ) { if ( $words[1] =~ /^#/ ) { if ( $db->channel_exists( $words[1] ) ) { bot_invited( $bot, $words[1] ); } else { bot_say( $bot, $replyto, "No such channel $words[1]" ); } } ## end if ( $words[1] =~ /^#/) return; } ## end if ( $words[0] =~ /^(join|invite)$/) my @args = @words; my $f; $f = "$bot" . "_" . shift @args; if ( defined &{$f} ) { no strict "refs"; return if &$f( $nick, $bot, $replyto, @args ); } $f = "$bot" . "_" . "unhandled"; if ( defined &{$f} ) { no strict "refs"; return if &$f( $nick, $bot, $replyto, @words ); } bot_say( $bot, $replyto, "unknown command \x02$string\x02" ); } ## end sub my_EVENT_PRIVMSG sub my_EVENT_NOTICE { my ( $nick, $towho, $string ) = @_; if ( $towho =~ /^#/ ) { logbot_do_logging( "NOTICE", $nick, $towho, $string ); } } ## end sub my_EVENT_NOTICE sub my_EVENT_CNICK { my ( $oldnick, $newnick, $ts ) = @_; # Need to find all channels to log this in. foreach my $channel ( get_user_channels($oldnick), get_user_channels($newnick) ) { logbot_do_logging( "CNICK", $oldnick, $channel, "nick changed to $newnick" ); } ## end foreach my $channel ( get_user_channels... } ## end sub my_EVENT_CNICK sub my_EVENT_AWAY { my ( $nick, $message ) = @_; foreach my $channel ( get_user_channels($nick) ) { logbot_do_logging( "AWAY", $nick, $channel, "Away message: $message" ) if ( $message =~ /./ ); logbot_do_logging( "AWAY", $nick, $channel, "No longer away" ) if ( $message !~ /./ ); } ## end foreach my $channel ( get_user_channels... } ## end sub my_EVENT_AWAY sub my_EVENT_UNKNOWN { my (@stuff) = @_; my ($stuff) = @_; if ( $stuff =~ m#^PASS (\S+) TS (\d+)# ) { irc_send_now("PASS $1 TS $2"); return; } if ( $stuff =~ m#^:(\S+) INVITE (\S+) (\#\S+)#i ) { my ( $nick, $bot, $channel ) = ( $1, $2, $3 ); bot_invited( $2, $3 ); return; } if ( $stuff =~ m#^:(\S+) AWAY(.*)# ) { my ( $nick, $msg ) = ( $1, $2 ); $msg =~ s/^\s+//; $msg =~ s/^://; my_EVENT_AWAY( $1, $2 ); return; } ## end if ( $stuff =~ m#^:(\S+) AWAY(.*)#) my_ALLDEBUG( "UNKNOWN", @_ ); } ## end sub my_EVENT_UNKNOWN ###################################################### # Helper functions for a bot # ###################################################### sub bot_shouldjoin { my ( $bot, $channel ) = @_; $bot = _lc $bot; $channel = lc $channel; if ( exists $yaml{"bots"}{$bot}{"channels"}{$channel} ) { return $yaml{"bots"}{$bot}{"channels"}{$channel}; } if ( exists $yaml{"bots"}{$bot}{"autojoin"} ) { foreach my $re ( @{ $yaml{"bots"}{$bot}{"autojoin"} } ) { return 1 if ( $channel =~ m/$re/ ); } } return 0; } ## end sub bot_shouldjoin # Scan configs for $channel # See what bots belong there # See how many of them are not yet joined. sub bots_join { my ($channel) = @_; my @needbots; foreach my $bot (@bots) { if ( !$joined{$bot}{$channel} ) { push( @needbots, $bot ) if ( bot_shouldjoin( $bot, $channel ) ); } } return if ( !@needbots ); my $ts = $db->channel_get_ts($channel); $ts ||= time; foreach my $bot (@needbots) { irc_send("SJOIN $ts $channel + $bot"); $joined{$bot}{$channel} = 1; logbot_do_logging( "JOIN", $bot, $channel ); if ( $bot eq "logbot" ) { # Make sure we record who is already in channel once we start logging my @users = $db->channel_get_users($channel); if (@users) { logbot_do_logging( "JOIN", "@users", $channel ); } # Indicate who we are, and a timestamp if ( $yaml{options}{introduction} ) { bot_say( $bot, $channel, $yaml{options}{introduction} ); } } ## end if ( $bot eq "logbot" ) my $f; $f = "$bot" . "_" . "joined"; if ( defined &{$f} ) { no strict "refs"; &{$f}($channel); } } ## end foreach my $bot (@needbots) } ## end sub bots_join sub bot_connect { my ($bot) = @_; my $t = time; my $s = $yaml{connection}{SERVER_NAME}; irc_send("NICK $bot 0 1 +i ~$bot $s $s :services bot"); } ## end sub bot_connect sub bot_say { my ( $bot, $nick, $message ) = @_; logbot_do_logging( "PRIVMSG", $bot, $nick, $message ); irc_send(":$bot PRIVMSG $nick :$message"); } sub bot_kill { my ( $bot, $nick, $message ) = @_; my $s = $yaml{connection}{SERVER_NAME}; irc_send(":$bot KILL $nick $s\!$nick :$message"); } sub bot_invited { my ( $bot, $channel ) = @_; $bot = _lc $bot; $channel = lc $channel; $yaml{bots}{$bot}{"channels"}{$channel} = 1; bots_join($channel); # Will join if needed save_yaml(); } ## end sub bot_invited sub bot_part { my ( $bot, $channel ) = @_; $bot = _lc $bot; $channel = lc $channel; if ( $joined{$bot}{$channel} ) { logbot_do_logging( "PART", $bot, $channel ); irc_send(":$bot PART $channel") if ( $joined{$bot}{$channel} ); $joined{$bot}{$channel} = 0; } } ## end sub bot_part sub bot_uninvited { my ( $bot, $channel ) = @_; bot_part(@_); $bot = _lc $bot; $channel = lc $channel; $yaml{bots}{$bot}{"channels"}{$channel} = 0; save_yaml(); } ## end sub bot_uninvited sub get_user_channels { my ($nick) = @_; return () if ( !$db->user_exists($nick) ); my $ref = $db->user_find($nick); my @ret; foreach ( keys %{ ${$ref}{channels} } ) { push( @ret, $_ ); } @ret = sort @ret; return @ret; } ## end sub get_user_channels ###################################################### # logbot specific # ###################################################### sub logbot_help { my ( $nick, $bot, $replyto, @args ) = @_; if ( $replyto =~ /^#/ ) { bot_say( $bot, $replyto, "To have $bot leave, type: \x02$bot\: leave\x02 . You can get the log url with \x02$bot\: url\x02 . For more info, \x02/msg $bot help\x02." ); } else { bot_say( $bot, $replyto, "To invite me to a channel, either \x02/msg $bot invite #channel\x02 or, from the channel, \x02/invite $bot\x02" ); if ( $db->is_oper($nick) ) { bot_say( $bot, $replyto, "Oper only: \x02/msg $bot showchannels [-v] [-users] [#channel ..]\x02" ); bot_say( $bot, $replyto, "Oper only: \x02/msg $bot showusers [username ..] [servername ..]\x02" ); } ## end if ( $db->is_oper($nick... } ## end else [ if ( $replyto =~ /^#/ ) return 1; # Handled } ## end sub logbot_help sub logbot_info { my ( $nick, $bot, $replyto, @args ) = @_; my $i = $yaml{options}{introduction}; bot_say( $bot, $replyto, "log-irc.pl $VERSION; this installation: $i", ); return 1; # Handled } ## end sub logbot_info sub logbot_version { return &logbot_info(@_); } sub logbot_time { my ( $nick, $bot, $replyto, @args ) = @_; _logbot_ts( "logbot", $replyto ); return 1; } sub _logbot_url { my ($channel) = @_; my ($name) = logbot_set_basename($channel); my ($dir) = $yaml{options}{logpath}; substr( $name, 0, length($dir) ) = ""; $name =~ s#^/+##; my ($urlbase) = $yaml{options}{urlbase}; $urlbase =~ s#/+$##; $name = "$urlbase/$name"; } ## end sub _logbot_url my %logbot_url_last; sub logbot_url { my ( $nick, $bot, $replyto, @args ) = @_; if ( $replyto =~ /^#/ ) { my $url = _logbot_url($replyto); bot_say( $bot, $replyto, "log file url is \x02 $url \x02" ); $logbot_url_last{ lc $replyto } = $url; return 1; } else { return 0; } } ## end sub logbot_url sub logbot_showchannels { my ( $nick, $bot, $replyto, @args ) = @_; # Privately only. return 0 if ( $replyto =~ m/^#/ ); return 0 unless ( $db->is_oper($nick) ); my %options = map { lc $_ => 1 } @args; $options{"-channel"} = 1 if ( grep( /^#/, @args ) ); # Limit to a few chans foreach my $channel ( $db->channel_list ) { # Sometimes we only want a specific channel next if ( ( $options{"-channel"} ) && ( !exists $options{ lc $channel } ) ); my @show; my @users = $db->channel_get_users($channel); my $count = scalar @users; # Sometimes we want to know who is inside, too. if ( $options{"-users"} ) { my @users = $db->channel_get_users($channel); foreach my $user (@users) { my $ref = $db->user_find($user); if ( $db->has_op( $user, $channel ) ) { $user = '@' . ${$ref}{"nick"}; } elsif ( $db->has_voice( $user, $channel ) ) { $user = '+' . ${$ref}{"nick"}; } push( @show, $user ); } ## end foreach my $user (@users) } ## end if ( $options{"-users"... @show = sort @show; unshift( @show, "($count)" ); local ($Text::Wrap::columns) = 400; if ( $options{"-v"} ) { $channel =~ s/^#//; $channel = "#\Q$channel"; } @show = wrap( "$channel ", "$channel ... ", @show ); foreach (@show) { chomp; bot_say( $bot, $nick, $_ ); } } ## end foreach my $channel ( $db->channel_list) bot_say( $bot, $nick, "End of showchannels @args" ); return 1; } ## end sub logbot_showchannels sub logbot_showusers { # Sneak a peek into Net::IRCService::DB - no API my ( $nick, $bot, $replyto, @args ) = @_; # Privately only. return 0 if ( $replyto =~ m/^#/ ); return 0 unless ( $db->is_oper($nick) ); my %options = map { lc $_ => 1 } @args; $options{"-user"} = 1 if ( grep( /^[^-]/, @args ) ); # Limit to a few users or a server # Copy the hash over. my @users = $db->user_list; my %byserver; foreach my $user (@users) { my $ref = $db->user_find($user); my $show = ${$ref}{'nick'}; # As they are known as, not LC my $server = ${$ref}{'server'}; # Where are are in from next if ( ( $options{"-user"} ) && ( !exists $options{ lc $user } ) && ( !exists $options{ lc $server } ) ); # nick hops ts mode ident host server geco $show = "\@$show" if ( $db->is_oper($user) ); $byserver{$server} ||= []; push( @{ $byserver{$server} }, $show ); } ## end foreach my $user (@users) foreach my $server ( sort keys %byserver ) { my @show = @{ $byserver{$server} }; @show = sort @show; my $count = scalar @show; unshift( @show, "($count)" ); local ($Text::Wrap::columns) = 400; @show = wrap( "$server ", "$server ... ", @show ); foreach (@show) { chomp; bot_say( $bot, $nick, $_ ); } } ## end foreach my $server ( sort keys... bot_say( $bot, $nick, "End of showusers @args" ); return 1; } ## end sub logbot_showusers ###################################################### # Logging related functions go here. # ###################################################### my @tz = (); sub log_init { unless (@tz) { my $t; if ( exists $yaml{options}{tz} ) { $t = $yaml{options}{tz}; if ( !ref $t ) { $t = [$t]; } @tz = @{$t}; } ## end if ( exists $yaml{options... } ## end unless (@tz) # die "No TZ in config file (options->tz should be scalar or array)" # unless (@tz); $ENV{"TZ"} = $tz[0] if (@tz); tzset(); die "missing options->logpath" unless ( $yaml{options}{logpath} ); die "missing options->urlbase" unless ( $yaml{options}{urlbase} ); die "missing options->periodic" unless ( $yaml{options}{periodic} ); logbot_periodic(); } ## end sub log_init sub channel_safe { my ($channel) = @_; $channel = lc $channel; $channel =~ s/^#//; $channel =~ s/[^a-z0-9_-]/_/g; return $channel; } ## end sub channel_safe my ( $year, $month, $day, $hour, $minute ); my ($nextperiodic); my %filename_cache; my %did_ts_cache; sub logbot_periodic { my $time = time; my $frequency = $yaml{options}{periodic}; if ( $time > $nextperiodic ) { # print "logbot_periodic recalculating\n"; $nextperiodic = $time + $frequency - ( $time % $frequency ); $ENV{"TZ"} = $tz[0] if (@tz); tzset(); ( $year, $month, $day, $hour, $minute ) = split( / /, strftime( '%Y %m %d %H %M', localtime time ) ); %filename_cache = (); # Force recalculation %did_ts_cache = (); # And channel announcements } ## end if ( $time > $nextperiodic) } ## end sub logbot_periodic sub _logbot_ts { my ( $bot, $channel ) = @_; $channel = lc $channel; my $ts = timestamps(); $did_ts_cache{$channel} = time; bot_say( $bot, $channel, "time is $ts" ); if ( $channel =~ m/^#/ ) { my $url = _logbot_url($channel); if ( $url ne $logbot_url_last{$channel} ) { bot_say( $bot, $channel, "log file url is now \x02 $url \x02" ); $logbot_url_last{ lc $channel } = $url; } } ## end if ( $channel =~ m/^#/) } ## end sub _logbot_ts sub logbot_set_basename { my ($channel) = lc shift @_; if ( !exists $filename_cache{$channel} ) { my $channel_safe = channel_safe($channel); my $dir = $yaml{options}{logpath}; $dir =~ s#/$##; # Trim to known state my $log = "$dir/$channel_safe/$year/$month"; system( "mkdir", "-p", $log ); $log .= "/$year-$month-$day"; $filename_cache{$channel} = $log; } ## end if ( !exists $filename_cache... return $filename_cache{$channel}; } ## end sub logbot_set_basename sub openfile_txt { my ($channel) = lc shift @_; return cacheout ">>", logbot_set_basename($channel) . ".txt"; } sub openfile_machine { my ($channel) = lc shift @_; return cacheout ">>", logbot_set_basename($channel) . ".machine"; } sub logbot_do_logging { my ( $event, $nick, $channel, $message ) = @_; $nick = _lc $nick; my $onick = $nick; if ( $nick =~ /^[@\+]/ ) { $nick =~ s/^[@\+]//; } else { if ( $db->is_member( $nick, $channel ) ) { $onick = ( $db->has_op( $nick, $channel ) ? '@' : '' ) . $nick; } } $channel = lc $channel; no strict "refs"; if ( $joined{"logbot"}{ lc $channel } ) { my $fresh = !exists $filename_cache{$channel}; my $fh_mac = openfile_machine($channel); my $fh_txt = openfile_txt($channel); if ($fresh) { $fh_mac->autoflush(1); $fh_txt->autoflush(1); } # Machine parsable print $fh_mac JSON::Syck::Dump( { "time" => time, "event" => $event, "nick" => $onick, "channel" => $channel, "message" => $message } ) . "\n"; # Human readable my $time = strftime( '%H:%M:%S', localtime time ); if ( $event eq "PRIVMSG" ) { print $fh_txt "$time $channel <$nick> $message\n"; # Timestamps _logbot_ts( "logbot", $channel ) unless ( $did_ts_cache{$channel}++ ); } elsif ( $event =~ m#^(CNICK|KILL|AWAY)$# ) { # don't show channel name print $fh_txt "$time $nick $event $message\n"; } elsif ( $event eq "TOPIC" ) { print $fh_txt "$time $channel $nick changed topic to $message\n"; } else { print $fh_txt "$time $channel $nick $event\n"; } } ## end if ( $joined{"logbot"}... } ## end sub logbot_do_logging sub timestamps { my $time = time; my @res; my $prevdate = ""; if ( !@tz ) { my ( $d, $t, $z ) = split( / /, strftime( '%Y-%m-%d %H:%M %Z', localtime $time ) ); return "$d $t $z"; } foreach my $tz (@tz) { $ENV{"TZ"} = $tz; my ($where) = reverse split( m#/#, $tz ); tzset(); my ( $d, $t, $z ) = split( / /, strftime( '%Y-%m-%d %H:%M %Z', localtime $time ) ); if ( $d eq $prevdate ) { push( @res, "$where=$t $z" ); } else { push( @res, "$where=$d $t $z" ); $prevdate = $d; } } ## end foreach my $tz (@tz) $ENV{"TZ"} = $tz[0]; tzset(); return join( "; ", @res ); } ## end sub timestamps Also, http://services.cl58tools.co.cc/perl/errors.txt is working now.
Byron Posted January 13, 2010 Posted January 13, 2010 Which one? The IRC one or a MoveableType file? Which ever file your having a problem with. I want to download the script to my site and see if I can generate the errors.
cl58 Posted January 13, 2010 Author Posted January 13, 2010 Which one? The IRC one or a MoveableType file? Which ever file your having a problem with. I want to download the script to my site and see if I can generate the errors. I put the IRC script up and, if you want to check out MT, I haven't edited anything so you can see http://www.movabletype.com/ for the code (only if you want to check both and fixing one may fix the other).
Byron Posted January 13, 2010 Posted January 13, 2010 This support request is being escalated to our root admin. djbob is there anyway he can run his script on our server? This is the errors he is generating: http://services.cl58tools.co.cc/perl/errors.txt
Ashoat Posted January 13, 2010 Posted January 13, 2010 Why not specify the full path to the file you need to include? Alternately, you can add it to @INC. (I'm basically rehashing the error message - just do what it says.)
Byron Posted January 13, 2010 Posted January 13, 2010 Why not specify the full path to the file you need to include? Alternately, you can add it to @INC. (I'm basically rehashing the error message - just do what it says.) I thought the errors were telling him that the module [ Net/IRCService.pm ] couldn't be found and that it would need to be added, is that not what it means?
Recommended Posts