cims-eggdrop/cims_interconnect.tcl

# CIMS: Community IRC Messaging Service
# CIMS formerly known as MNET (Message Network)
# Multiple Network Interconnection MASTER Script
# Copyright (C) 2004 Paul-Dieter Klumpp
#
# 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.


namespace eval ::cims::interconnect {
	variable layout
	variable sshcommand {ssh}
	variable host {stomp@b4r.org}
	variable mnet_interconnect_version "ic!0.1"


}



proc ::cims::interconnect::connect {} {
	variable sshcommand
	variable host
	variable pipe

	set command $sshcommand
  lappend command $host
	putlog "command is $command"
	if {[catch {
		
		if {![info exists pipe] || $pipe == ""} {
			set pipe [open "|$command" r+]
			fconfigure $pipe -translation binary -blocking 0 -buffering line
		} else {
			putlog "already connected here: $pipe"
		}
	} error]} {
		set pipe ""
		putlog "error $error"
		#conect again in a time
	}  else  {

		# read from console input
		::cims::interconnect::readloop

		# check if connection is alive.. if not, reset it.
		::cims::interconnect::pingloop

	}
}

proc ::cims::interconnect::connect_from_bind {nick mask hand chan text} {
	::cims::interconnect::connect
}


proc ::cims::interconnect::disconnect {} {
	variable pipe

	::cims::interconnect::send "PART"
	close $pipe
	set pipe ""
}

proc ::cims::interconnect::disconnect_from_bind {nick mask hand chan text} {
	::cims::interconnect::disconnect
}

proc ::cims::interconnect::reconnect {} {
	::cims::interconnect::disconnect
	::cims::interconnect::connect
}

proc ::cims::interconnect::reconnect_from_bind {nick mask hand chan text} {
	::cims::interconnect::reconnect
}


proc ::cims::interconnect::send {msg} {
	variable pipe

	if {$msg != "" && $pipe != ""} {
		putlog "writing $msg to pipe '$pipe'"

		if {[catch {
			puts $pipe "$msg"
		} error]} {
			close $pipe
			set pipe ""

			# well, it seems, our connection is broken, let's reconnect in 2 seconds.
			utimer 2 "::cims::interconnect::connect"
		}
	}

}

proc ::cims::interconnect::send_from_bind {nick mask hand chan text} {
	::cims::interconnect::send "$text"
}

proc ::cims::timeout_reply_from_ic_for_netbot {netbot network freqname source} {
	set bcid $::cims::interconnect::sources($freqname,$source)

	if {[info exists ::cims::interconnect::receive_count($bcid)]} {
		set output "$::cims::interconnect::receive_count($bcid)"
	} 

	# Give him a reply.
	::cims::put_bot $netbot "mnet_interconnect_answer $network $freqname $source $output"

}

proc ::cims::timeout_reply_from_local_for_ic {bcid network freqname source} {
  variable mnet_reached_users 
	variable mnet_reached_userlist
  variable mnet_reached_chans

	# clean $name and $source
	set freqname [::putils::kill_spaces $freqname]
	set source [::putils::kill_spaces $source]
	
	# easify variables
	set userlist $mnet_reached_userlist($freqname,$source)
	set user_cnt [llength $userlist]
	set mnet_reached_users($freqname,$source) $user_cnt

	set chan_cnt $mnet_reached_chans($freqname,$source)

	
	# inzwischen drfte auch die antwort gekommen sein.. also jetzt mnet_reached_* auswerten nach timeout..
	
	# make stats channel-dependent 
	#putlog "::cims:: * userlist is finally: $userlist "
	putlog "::cims:: * After ALL: Count_Users: $user_cnt  Count_Channels: $mnet_reached_chans($freqname,$source)"
	
	# Give me some reply.
	::cims::interconnect::send "BC_RE $bcid Users=$user_cnt,Channels=$chan_cnt"
}


# this proc is a new proc for cims. 
# the message came from interconnect and injects into the netbots and own channels
proc ::cims::message_from_interconnect {network freqname source nick text} {
  variable mnet_reached_users 
  variable mnet_reached_userlist
  variable mnet_reached_chans

	#putlog "freqname: $freqname"
	#putlog "source: $source"
	#putlog "nick: $nick"
	#putlog "text: $text"

	# reset stats .. because he is just freshly sending
	set mnet_reached_users($freqname,$source) "0"
	set mnet_reached_userlist($freqname,$source) ""
	set mnet_reached_chans($freqname,$source) "0"

	::cims::history_queue $network,$freqname $nick $source $text
	
	# send them first, we await a reply!

	# single sends TO ALL REMOTE BOTS with their remote CHANNELS...
	# let's see which mode for sending is used...
	::cims::message_to_netbots $network $freqname $source $nick $text
	
	# SEND TO ALL OWN CHANNELS...
	# send to all own channels, except to the channel the message originating from:
	::cims::message_to_own_channels $network $freqname $source $nick $text

		
}

proc ::cims::interconnect::add_up {bcid item count} {
	variable receive_count

	# schon drin?
	if {![info exists receive_count($bcid)]} {
		set receive_count($bcid) ""
	}

	set position [lsearch $receive_count($bcid) $item]

	if {$position > -1} {
		#putlog "item: $item is drin, weil posi $position"
		set the_old_count [lindex $receive_count($bcid) [expr $position + 1]]

		# the_old_count gets increased by $count
		incr the_old_count $count

		# we set it ..
		lset receive_count($bcid) [expr $position + 1] $the_old_count

	} else {
		#putlog "item: $item nicht drin, weil posi $position"
		lappend receive_count($bcid) "$item" "$count"
	}
	
	#putlog "hum: $receive_count($bcid)"
}

# called right before the output...
proc ::cims::timeout_reply_from_local_for_netbots_plugin {freqname source} {
	upvar output output
	set bcid $::cims::interconnect::sources($freqname,$source)

	if {[info exists ::cims::interconnect::receive_count($bcid)]} {
		set output "$output $::cims::interconnect::receive_count($bcid)"
	} 
}

# this is the stuff we read on the console.
proc ::cims::interconnect::work {inputline} {
	variable broadcasts
	variable sources
	variable receive_count

	#putlog "work that out: $inputline"

	regexp -lineanchor {^.*\d: (.*)} $inputline matched sub
	putlog "subline: $sub"

	if {[regexp -all {^PONG} $sub] > 0} {
		#putlog "interconnect pong received"

	} elseif {[regexp -lineanchor -all {^(BC_ID) (.+) for: (.+),(.+),(.+)$} $sub whole command bcid network freqname source] > 0} {
	# this tells us, we sent a REQ_BC before. 

		set broadcasts($bcid) [list "$network" "$freqname" "$source"]
		set ::cims::interconnect::sources($freqname,$source) "$bcid"

		#putlog "bcid vars saved: $broadcasts($bcid) "

		# reset receive counters.
		set receive_user_count($bcid) 0
		set receive_item_count($bcid) 0

	} elseif {[regexp -lineanchor -all {^(BC_RE) (.+) (.+)=(\d+),(.+)=(\d+)$} $sub whole command bcid user_string user_count item_string item_count] > 0} {
		#BC_RE f4k3h4sh 5,3
		# central does some routing over central to make sure, the BC_RE message is only sent to me
		# ok cool .. i hope we sent a message with that $bcid before. And 

		#.. we check on $bcid - find out the correct cims-vars (chan, freq, etc) 
		# and add user_count, item_count to them. 
		
		# now, let's validate that bcid .. we check if that bcid exists.. so the originating message is from me.
		if {[info exists broadcasts($bcid)] == 1} {
			set that $broadcasts($bcid)
			set network [join [lindex $that 0]]
			set freqname [join [lindex $that 1]]
			set source [join [lindex $that 2]]

			# count up
			::cims::interconnect::add_up "$bcid" "$user_string" "$user_count"
			::cims::interconnect::add_up "$bcid" "$item_string" "$item_count"

			# ready the variable, so it can be read from the plugin.
			set ::cims::interconnect::receive_count($bcid) "$::cims::interconnect::receive_count($bcid)"

		}
	
	} elseif {[regexp -lineanchor -all {^(BC) (.+) (.+),(.+),(.+),'(.+)','(.+)'$} $sub whole command bcid network freqname source nick text] > 0} {

		# THIS IS FRESH INPUT. ESCAPE IT.
		set freqname [split $freqname]
		set source [split $source]
		set nick [split $nick]
		set text [split $text]
		putlog "freqname: $freqname"
		putlog "source: $source"
		putlog "nick: $nick"
		putlog "text: $text"


		# parse here above.. or just use:
		#set network "QDEV"
		#set freqname "-dev-"
		#set source "http://qwnu"
		#set nick "testnickname"
		#set text "testmessage"

		# here, we read a message from central and put it to all local channels and netbots.
		::cims::message_from_interconnect $network $freqname $source $nick $text


		# in the meantime, we even get all replies and counts (by ::cims::). 
		# Now, we should get that count and send it to the central as a reply. Hitting the original sender.
		utimer 4 "::cims::timeout_reply_from_local_for_ic $bcid $network $freqname $source"
		

	} elseif {[regexp -all {^WHO.*} $sub whole] > 0} {
		# ignore this one - it's fully handled by central.
	} elseif {[regexp -all -nocase {^C (.*): (.*)} $sub whole sub1 sub2] > 0} {
		# received, with command "C "
		if {"$sub2" != ""} {
			::putils::put_local_msg "#aztest" "C $sub1: $sub2"
		}
	} else {
		# received, but it has no command
		#::putils::put_local_msg "#aztest" "not handled: $sub"
	}

}
 
proc ::cims::interconnect::read {} {
	variable pipe

	#putlog "into read"

	if {$pipe != ""} {
		#while { ![eof $pipe] } {
			gets $pipe inputline
			if {$inputline != ""} {
				::cims::interconnect::work "$inputline"
			}
			
		#}
	}
	#putlog "ending of read"
}


proc ::cims::interconnect::readloop {} {
	variable pipe

	# check timers.. if old is running, don't start a new one
	set timerlist [utimers]

	set matched 0
	foreach {timerinfo} $timerlist {
		set timer_proc [join [lindex $timerinfo 1]]
		set timer_id [join [lindex $timerinfo 2]]
		if {[string match -nocase "::cims::interconnect::readloop" $timer_proc] == 1} {
			set matched 1
		}
	}

	if {$matched == 0 && $pipe != ""} { 
		utimer 1 "::cims::interconnect::readloop" 
	}

	# read a line
	::cims::interconnect::read
}

proc ::cims::interconnect::ping {} {
	#putlog "into read"

	::cims::interconnect::send "PING"
}

proc ::cims::interconnect::pingloop {} {
	variable pipe

	# check timers.. if old is running, don't start a new one
	set timerlist [utimers]

	set matched 0
	foreach {timerinfo} $timerlist {
		set timer_proc [join [lindex $timerinfo 1]]
		set timer_id [join [lindex $timerinfo 2]]
		if {[string match -nocase "::cims::interconnect::pingloop" $timer_proc] == 1} {
			set matched 1
		}
	}

	if {$matched == 0 && $pipe != ""} { 
		utimer 120 "::cims::interconnect::pingloop" 
	}

	# start a ping
	::cims::interconnect::ping
}

# this proc is a plugin proc for cims. it only gets executed if it exists.
# the message came from our bot.
proc ::cims::message_from_local_plugin {network freqname source nick text} {

	# send the message into central
	putlog "wo bin ich da? $source"
	::cims::interconnect::send "REQ_BC $network,$freqname,$source,'$nick','$text'"

	# save BC_ID for this combination of parameters - is done in the above "::work"

	# receive answers from the other networks

	# prepare stats so that the local stats-counter takes it. the local stats are getting put out
  # at the end of ::cims::messaging_public_from_bind by ::cims::reply_timeout


}

# this proc is a plugin proc for cims. it only gets executed if it exists.
# we received a message from a netbot
proc ::cims::message_from_netbot_to_plugin {netbot network freqname source nick text} {
	# send the message into central
	::cims::interconnect::send "REQ_BC $network,$freqname,$source,'$nick','$text'"

	# receive answers from the other networks
	# in the meantime, we get all the BC_RE replies and counts.
	# Now, we should get that count and send it to originating netbot.
	utimer 5 "::cims::timeout_reply_from_ic_for_netbot $netbot $network $freqname $source"

	# send an own answer to the originating netbot

}


proc ::cims::interconnect::bindings {} {

  bind pub - !mnet_connect    ::cims::interconnect::connect_from_bind
	bind pub - !mnet_disconnect ::cims::interconnect::disconnect_from_bind
	bind pub - !mnet_reconnect  ::cims::interconnect::reconnect_from_bind
	bind pub - !mnet_input      ::cims::interconnect::send_from_bind

}

proc ::cims::interconnect::main {} {
	variable mnet_interconnect_version
  variable pipe

  putlog "mnet! = mnet interconnection MASTER script loaded: $mnet_interconnect_version"

	::cims::interconnect::bindings
	::cims::interconnect::connect

}


namespace eval ::cims::interconnect {
  # timer weil $botnet-nick nicht sofort von eggdrop gesetzt wird
  utimer 3 "::cims::interconnect::main"
}