#---------------------------------------------------------------------
# portreport.tcl
#
# TCL script for IRC bot eggdrop
#
# Opens a listening port on eggdrop and reports connection data
# and data send by the client. Script is for debugging purposes.
#
# v0: 04-Jul-2003
# v1: 25-Sep-2003
# + added putlog on termination of connection
#---------------------------------------------------------------------

set portreportport 30000

#---------------------------------------------------------------------
# package requirements
#---------------------------------------------------------------------

package require Tcl 8.0
package require eggdrop 1.6.9

#---------------------------------------------------------------------
# Proc to check the listening port
#---------------------------------------------------------------------

proc portreport:portok { } {

   global portreportport

   # check existence of a listening port

   if {![info exists portreportport]} {
      putlog "PR ERR: no listening port defined."
      return 0
   }

   # check if it is a number between 1025 and 65000

   if {[scan $portreportport %d number] != 1 } {
      putlog "PR ERR: illformatted portnumber."
      return 0
   }

   if {$portreportport != $number} {
      putlog "PR ERR: illformatted portnumber."
      return 0
   }

   if { $number < 1025 || $number > 65000 } {
      putlog "PR ERR: the portnumber must be in the\
      range of 1025-65000."
      return 0
   }

   return 1

}

#---------------------------------------------------------------------
# lookup the uhost and hand over control
#---------------------------------------------------------------------

proc portreport:listen { idx } {

   # lookup the uhost of the connection

   foreach connection [dcclist] {
      if {[lindex $connection 0] == $idx} {
         set hand [lindex $connection 1]
         set host [lindex $connection 2]
         set type [lindex $connection 3]
         set othr [lindex $connection 4]
         set time [lindex $connection 5]
         break
      }
   }

   # report connection info

   putlog "PR LOG ($idx): HAND $hand"
   putlog "PR LOG ($idx): HOST $host"
   putlog "PR LOG ($idx): TYPE $type"
   putlog "PR LOG ($idx): OTHR $othr"
   putlog "PR LOG ($idx): TIME $time"

   control $idx portreport:report

}

#---------------------------------------------------------------------
# report any data incoming on the listening port
#---------------------------------------------------------------------

proc portreport:report { idx text } {

   if { $text == "" } {

      # connection was terminated

      putlog "PR REPORT: Connection IDX $idx terminated by client."

      return 1

   }

   putlog "PR REPORT: $text"

   return 0

}

#---------------------------------------------------------------------
# Check every minute for open connections.
#---------------------------------------------------------------------

bind time - * portreport:timeconnections

proc portreport:timeconnections { args } {

   portreport:connections 30

}

proc portreport:connections { { exptime 0 }} {

   if { [scan $exptime %i exptime] != 1 } {
      set exptime 0
   }

   # a bit awkward to string match

   set matchmask {scri  portreport:*}

   # string match the <other> info of each connection against the
   # matchmask. If there is a match, compare the timestamp of that
   # connection with the currentime.

   foreach connection [dcclist] {
      set type [lindex $connection 4]
      if {[string match $matchmask $type]} {
         set timestamp [lindex $connection 5]
         if {[expr [unixtime] - $timestamp] > $exptime } {
            set idx [lindex $connection 0]
            set uhost [lindex $connection 2]
            killdcc $idx
            putlog "PWV LOG: ($idx) purged connection of $uhost"
         }
      } 
   }
}

#---------------------------------------------------------------------
# On startup check the listen port.
# Open listening port.
#---------------------------------------------------------------------

# check existing connection to this script and terminate when needed.

portreport:connections 

# check port and open listen port

if {![portreport:portok]} { 
   putlog "PR WARNING: port setting is not OK! Check the setting!"
} else {
   set port [listen $portreportport script portreport:listen]
   if { $port != $portreportport } {
      putlog "PR PANIC!!! system changed listen port. Purged listen."
      listen $port off
   } else {
      putlog "Loaded (version 1): Port report\                  
      (listening on port $portreportport)."
   }
}