#!/usr/bin/perl -w

# Autor : Marc Quinton@stna.dgac.fr / quinquin/IRCnet
# Date : june 1999.
# 
# This script is a Perl script to automate some functions under IRC xchat[1].
# To get IRC events, this script needs a patch wich is not in xchat distribution.
# See below [2]
#
# For now, this script can auto-op some users under some channels.
# I plan to make auto-topic function. There is also a ping function
# that make auto-reconnect more reliable under slow links.
#
# TODO : 
#  1/ know if I am operator before issuing some actions,
#  2/ request operator status if need,
#  3/ make auto-topic,
#  4/ take care of IRC server. Create some sort of classes for IRC server : IRCnet, Undernet ...
#  5/ 
# 
# [1] : xchat : http://xchat.linuxpower.org

# wich functions : NA / Not ready Available, plan to do it.
$do_log = 0;       # log all messages from IRC server to a file.
$do_autoop = 1;    # make auto-op with some users in some channels
$do_autotopic = 1; # NA / send topic in some channels
$do_ping = 0;      # make ping irc server. This may make connection more reliable under slow links.
                   # auto-reconnect are generaly handled more gracefully.


# list of #channels and addresses to auto OP !
# channels are separated with ",". No spaces, be carrefull !
# hum, why not a syntaxe like : #channel[/IRCnet] or #channel[/irc.server.net] ...
#
%auto_op = qw (
  quinquin\@.*\.cybercable\.fr            #linux-31,#toulouse,#linux,#linux-fr
  marc\@.*\.stna\.dgac\.fr                #linux-31,#toulouse
);



# non user configuration parameters.
# you don't need to modify them.
# -----------------------------------
$verbose = 0;
$time_delay = 600;  # delay in seconds between ping ... pong !
$log = $ENV{"HOME"} . "/.xchat/" . "inbound.log";

# end of configuration
# ------------------------------------------------------------------------------------

IRC::print "\0035:: Loading auto-op script ::\003 \n";

if ($do_log) {
  open (LOG, ">>$log") || IRC::print "\0035:: inbound: error openning log file ::\003 \n";
  # auto-flush ...
  select((select(LOG), $| = 1)[0]);
}

IRC::add_message_handler("INBOUND",        "inbound_handler");

IRC::add_timeout_handler($time_delay * 1000, "ping_timeout_handler") if ($do_ping);


sub ping_timeout_handler
{ 
  # 1: on continue, 0 on arrete
  IRC::add_timeout_handler($time_delay * 1000, "ping_timeout_handler");
  # PING :irc.twiny.net
  IRC::command("/ping");
  $last_pong = time;
  return 0;
}


sub inbound_handler
{ 

  local($line) = @_;
  # IRC::print "inbound_handler() ''$line''\n";

  # ERROR
  # ERROR :Closing Link: quinquin[~marc@yod.stna.dgac.fr] (Ping timeout)
  # ERROR :Closing Link: quinquin[unknown@143.196.31.73] (Unauthorized connection)
  # :Joker31 KILLSESSION #linux-31 corneille -> fermeture d'une fenetre sur un #chan

  # ping-pong
  # PING :salambo.Enserb.U-Bordeaux.Fr
  # PING :corneille
  if($line =~ m/PING :(.*)/ && $do_ping) {
     $host = $1;
     $delay = time - $last_ping{$host};
     # glob value
     $last_ping{$host} = time;

     # IRC::print "$line\n";
     IRC::print "PING from $host : $delay\n" if ($last_ping{$host} != 0 && $verbose == 1);
  }
 
  # pong
  # :salambo.Enserb.U-Bordeaux.Fr PONG salambo.Enserb.U-Bordeaux.Fr :Joker31
  if($line =~ m/ PONG /) {
     # IRC::print "$line\n";
     ($host,$foo, $nick) = $line =~ /^:(.*) PONG (.*) :(.*)/;
     $delay = time - $last_pong{$host};
     $last_pong{$host} = time;
     # IRC::print "PONG from $host $delay\n";
     return 1; # attention : 1, le dernier plugin !
  }

  # 331 : no topic is set ! send "/raw TOPIC #channel" before !
  # :irc.twiny.net 331 quinquin #linux-31 :No topic is set.
  # topic : topic status
  # :corneille 332 Joker31 #linux-31 :linux-31, le canal du CULTe : http://savage.iut-blagnac.fr/
  # topic : notification
  # Joker31!~marc@yod.stna.dgac.fr TOPIC #linux-31 :linux-31, le canal du CULTe ...

  # :irc.twiny.net 331 quinquin #linux-31 :No topic is set.
  if($line =~ m/:(.*) 331 (.*) (.*) :No topic is set./) {
     $channel = $3;
     if( $channel eq "#linux") {
         IRC::send_raw "TOPIC $channel :#linux-31, le canal du CULTe : http://savage.iut-blagnac.fr/\n";
     }
     return 1;
  }
  # join
  # :quinquin!~marc@yod.stna.dgac.fr JOIN :#linux-31
  # if($line =~ m/:(.+?)\!(.+?) JOIN :(.*)/) {

  if($line =~ m/:(.+?)\!(.+?) JOIN :(.*)/) {

     $nick = $1;
     $addr = $2;
     $chan = $3;

     if($do_autoop) {
       foreach $myuser (keys %auto_op) {
         if("$nick\!$addr" =~ m/$myuser/i) {
            # channel names are like this : #chan1[,#chan2]* ...
            $chans = $auto_op{$myuser};
            foreach $mychan (split(/\,/, $chans)) {
              if( $mychan eq $chan) {
                IRC::command("/MODE $chan +o $nick");
              }
            }
         }
       }
     }
     # if ( $channel eq "#linux-31") {
     #  # TOPIC #linux-31 :linux-31 ... le channel du CULTe
     #  IRC::send_raw "TOPIC $channel\n";
     #  # IRC::send_raw "TOPIC $channel :#linux-31, le canal du CULTe : http://savage.iut-blagnac.fr/\n";
     # }
  }
  
  printf LOG "%s\n", $line if ($do_log);
  return 0;
}


_END_

# [2] : patch to xchat version 0.96 and below :
# in function : perl.c::perl_inbound() :
# 
# int perl_inbound(struct session *sess, struct server *serv, char *buf)
# {
#    GSList *handler;
#    struct _perl_inbound_handlers *data;
#    char *message_type, *tmp_mtype;
#    char *tmp;
#    SV *handler_return;
# 
#    ....
# 
#    for (handler = perl_inbound_handlers; handler != g_slist_last(perl_inbound_handlers); handler = handler->next)
#    {
#       data = handler->data;
#       /* this is here !!! */
#       /* was : if (!strcmp(message_type, data->message_type) */
#       if (!strcmp(message_type, data->message_type) || !strcmp("INBOUND", data->message_type))
#       {
#          handler_return = execute_perl(data->handler_name, buf);
#          if (SvIV(handler_return))
#  ...
# }