mnet.tcl 49 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751
  1. # CIMS: Community IRC Messaging Service
  2. # CIMS formerly known as MNET (Message Network)
  3. # Copyright (C) 2004 Paul-Dieter Klumpp
  4. #
  5. # This program is free software; you can redistribute it and/or
  6. # modify it under the terms of the GNU General Public License
  7. # as published by the Free Software Foundation; either version 2
  8. # of the License, or (at your option) any later version.
  9. #
  10. # This program is distributed in the hope that it will be useful,
  11. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. # GNU General Public License for more details.
  14. #
  15. # You should have received a copy of the GNU General Public License
  16. # along with this program; if not, write to the Free Software
  17. # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  18. namespace eval ::cims {
  19. set configs_file "scripts/cims/cims_conf.tcl"
  20. #your notes:
  21. # - Requirements:
  22. # -> eggdrop bot version >= 1.6.17
  23. # -> using TCL version >= 8.3
  24. # -> TCLLib version >= 1.6
  25. # -> TCLXML version >= 2.6
  26. #my notes:
  27. # ?- aliasing of channels!
  28. # ?- alternative configs! backupconf..
  29. # ?- xml:dom!
  30. # ?- better http get implementation!
  31. # ?- korrekte Statistiken der User usw?
  32. # ?- wordbanning?
  33. # Now, hands away pls :) except you know what you are doing.
  34. ######
  35. #package prefer stable
  36. # we need a nice tcl version
  37. package require Tcl 8.3
  38. # it's an eggdrop script, right? :)
  39. package require eggdrop 1.6
  40. # we need the tclxml package.. at least 2.6 i think
  41. package require xml
  42. # tclxml needs uri of tcllib.. at least 1.1 i think
  43. package require uri
  44. ############ XML CONFIGURATION PARSING FOLLOWS!! WTF! :) #########
  45. variable mnet_networks
  46. variable mnet_bots
  47. variable mnet_channels
  48. variable mnet_freqs
  49. variable mnet_bans
  50. variable mnet_colors
  51. variable mnet_colors_optional
  52. variable mnet_reached_users
  53. variable mnet_reached_chans
  54. variable mnet_http_config
  55. variable mnet_local_config
  56. variable mnet_histories
  57. variable mnet_netconfig_timer
  58. variable currentNetworkDesc
  59. variable currentNetworkSig
  60. variable startNetworkInstance
  61. variable currentBot
  62. variable currentOwner
  63. variable startBotInstance
  64. variable currentFreqName
  65. variable currentFreqPrefix
  66. variable currentFreqHelpmsg
  67. variable currentFreqDesc
  68. variable startFrequencyInstance
  69. global botnet-nick
  70. # list
  71. set mnet_local_config ""
  72. unset mnet_local_config
  73. # list
  74. set mnet_http_config ""
  75. unset mnet_http_config
  76. set mnet_cfg_reload_interval 0
  77. # list
  78. #set mnet_freqs_onoff "lala lala"
  79. #unset mnet_freqs_onoff
  80. }
  81. proc ::cims::clean_netconfig {} {
  82. variable mnet_bots
  83. variable mnet_channels
  84. variable mnet_freqs
  85. variable mnet_bans
  86. variable mnet_colors
  87. variable mnet_networks
  88. # secure deletion of all config-arrays..
  89. if {[array exists mnet_bots]} {
  90. array unset mnet_bots
  91. }
  92. if {[array exists mnet_channels]} {
  93. array unset mnet_channels
  94. }
  95. if {[array exists mnet_freqs]} {
  96. array unset mnet_freqs
  97. }
  98. if {[array exists mnet_bans]} {
  99. array unset mnet_bans
  100. }
  101. #if {[array exists mnet_freqs_onoff]} {
  102. # array unset mnet_freqs_onoff
  103. #}
  104. if {[array exists mnet_colors]} {
  105. array unset mnet_colors
  106. }
  107. if {[array exists mnet_colors_optional]} {
  108. array unset mnet_colors_optional
  109. }
  110. # list
  111. set mnet_networks ""
  112. unset mnet_networks
  113. # list
  114. set mnet_freqs "lala lala"
  115. unset mnet_freqs
  116. set mnet_bans "lala lala"
  117. unset mnet_bans
  118. # list FIXME (this kills the history upon every .mnet_reload ... :( .. not good)
  119. if {[array exists mnet_histories]} {
  120. array unset mnet_histories
  121. }
  122. set mnet_histories ""
  123. unset mnet_histories
  124. }
  125. proc ::cims::initvars {} {
  126. variable currentNetworkDesc
  127. variable currentNetworkSig
  128. variable startNetworkInstance
  129. variable currentBot
  130. variable currentOwner
  131. variable startBotInstance
  132. variable startFrequencyInstance
  133. variable mnet_networks
  134. variable mnet_freqs
  135. variable mnet_bans
  136. variable mnet_networks_by_prefix
  137. global botnet-nick
  138. set currentNetwork ""
  139. set currentSig ""
  140. set startNetworkInstance ""
  141. set currentBot ""
  142. set currentOwner ""
  143. set startBotInstance ""
  144. set startFrequencyInstance ""
  145. }
  146. ::cims::initvars
  147. proc ::cims::xmlElementStart {tagname attlist args} {
  148. variable mnet_networks
  149. variable mnet_bots
  150. variable mnet_channels
  151. variable mnet_freqs
  152. variable mnet_bans
  153. variable mnet_colors
  154. variable mnet_colors_optional
  155. variable mnet_freqs_onoff
  156. variable currentNetworkDesc
  157. variable currentNetworkSig
  158. variable startNetworkInstance
  159. variable currentBot
  160. variable currentOwner
  161. variable startBotInstance
  162. variable currentFreqName
  163. variable currentFreqPrefix
  164. variable currentFreqHelpmsg
  165. variable currentFreqDesc
  166. variable startFrequencyInstance
  167. global botnet-nick
  168. set proper_botnick [::cims::proper_botnick ${botnet-nick}]
  169. # putlog "::cims:: attr: '$attlist' arg: '$args'"
  170. # getting NETWORK NAME
  171. if {"$tagname" == "mnet"} {
  172. set currentNetworkDesc ""
  173. set currentNetworkSig ""
  174. foreach {key value} $attlist {
  175. if {"$key" == "sig"} {
  176. set currentNetworkSig $value
  177. }
  178. if {"$key" == "desc"} {
  179. set currentNetworkDesc $value
  180. }
  181. if {"$currentNetworkSig" != ""} {
  182. if {"$currentNetworkDesc" != ""} {
  183. putlog "yo: $currentNetworkSig $currentNetworkDesc"
  184. lappend mnet_networks "$currentNetworkSig" "$currentNetworkDesc"
  185. set startNetworkInstance 1
  186. }
  187. }
  188. }
  189. }
  190. # getting botinfos...
  191. if {"$startNetworkInstance" == "1"} {
  192. if {"$tagname" == "bot"} {
  193. set currentBot ""
  194. set currentOwner ""
  195. foreach {key value} $attlist {
  196. if {"$key" == "nick"} {
  197. set currentBot [::cims::proper_botnick $value]
  198. }
  199. if {"$key" == "owner"} {
  200. set currentOwner $value
  201. }
  202. }
  203. if {"$currentBot" != ""} {
  204. if {"$currentOwner" != ""} {
  205. # currentbot auf 9 zeichen runter.. lowercase
  206. # botnick ebenso
  207. lappend mnet_bots($currentNetworkSig) "$currentBot"
  208. putlog "::cims:: cfg: reached botcfg for: $currentBot - and my name is: $proper_botnick"
  209. if {"$currentBot" == "$proper_botnick"} {
  210. putlog "::cims:: Oh yes, I, ${botnet-nick}, am listed for the network $currentNetworkSig by using '$currentBot'!"
  211. set startBotInstance 1
  212. }
  213. }
  214. }
  215. }
  216. # end of $tagname == "bot"
  217. if {"$startBotInstance" == "1"} {
  218. if {"$tagname" == "ch"} {
  219. foreach {key value} $attlist {
  220. if {"$key" == "name"} {
  221. putlog "test: ${value}"
  222. lappend mnet_channels($currentNetworkSig,$currentBot) [::cims::proper_channelname ${value}]
  223. putlog "::cims:: cfg: my channels for $currentNetworkSig $mnet_channels($currentNetworkSig,$currentBot)"
  224. }
  225. }
  226. }
  227. # end of $tagname == "ch"
  228. }
  229. # end of a bot...
  230. if {"$tagname" == "frequency"} {
  231. set currentFreqName ""
  232. set currentFreqPrefix ""
  233. set currentFreqHelpmsg ""
  234. set currentFreqDesc ""
  235. set currentDelay "120"
  236. foreach {key value} $attlist {
  237. if {"$key" == "name"} {
  238. set currentFreqName $value
  239. }
  240. if {"$key" == "prefix"} {
  241. set currentFreqPrefix $value
  242. }
  243. if {"$key" == "helpmsg"} {
  244. set currentFreqHelpmsg $value
  245. }
  246. if {"$key" == "desc"} {
  247. set currentFreqDesc $value
  248. }
  249. if {"$key" == "delay"} {
  250. set currentDelay $value
  251. }
  252. }
  253. if {"$currentFreqName" != ""} {
  254. if {"$currentFreqPrefix" != ""} {
  255. if {"$currentFreqHelpmsg" != ""} {
  256. if {"$currentFreqDesc" != ""} {
  257. putlog "::cims:: i, ${botnet-nick}, serve the frequency: $currentFreqName ($currentFreqPrefix) of $currentNetworkSig!"
  258. set startFrequencyInstance 1
  259. lappend mnet_freqs($currentNetworkSig) "$currentNetworkSig" "$currentFreqName" "$currentFreqPrefix" "$currentFreqHelpmsg" "$currentFreqDesc" "$currentDelay"
  260. }
  261. }
  262. }
  263. }
  264. # end of: alle attribs vorhanden fr eine valide frequenz
  265. }
  266. # end of $tagname == "frequency"
  267. # in element Frequency, there are bans as children.
  268. if {"$startFrequencyInstance" == "1"} {
  269. if {"$tagname" == "ban"} {
  270. set currentBanHostmask ""
  271. set currentBanReason ""
  272. foreach {key value} $attlist {
  273. if {"$key" == "hostmask"} {
  274. set currentBanHostmask $value
  275. }
  276. if {"$key" == "reason"} {
  277. set currentBanReason $value
  278. }
  279. }
  280. if {"$currentBanHostmask" != ""} {
  281. if {"$currentBanReason" != ""} {
  282. putlog "::cims:: adding ban to frequency: $currentNetworkSig, $currentFreqPrefix, $currentBanHostmask, reason: $currentBanReason"
  283. lappend mnet_bans($currentNetworkSig,$currentFreqPrefix) "$currentBanHostmask" "$currentBanReason"
  284. }
  285. }
  286. }
  287. }
  288. if {"$tagname" == "color"} {
  289. set currentColor ""
  290. set currentColorOptional ""
  291. foreach {key value} $attlist {
  292. if {"$key" == "id"} {
  293. set currentColor $value
  294. putlog "::cims:: gone into colors! $value"
  295. }
  296. if {"$key" == "optional"} {
  297. set currentColorOptional $value
  298. putlog "::cims:: color optional? $value"
  299. }
  300. }
  301. if {"$currentColor" != ""} {
  302. set mnet_colors($currentNetworkSig) $currentColor
  303. putlog "::cims:: the color-id for $currentNetworkSig is: $currentColor"
  304. } else {
  305. # make NO color if no color-id or tag has been given:
  306. set mnet_colors($currentNetworkSig) none
  307. }
  308. if {"$currentColorOptional" != ""} {
  309. set mnet_colors_optional($currentNetworkSig) $currentColorOptional
  310. putlog "::cims:: the color is optional: $currentColorOptional"
  311. } else {
  312. set mnet_colors_optional($currentNetworkSig) 0
  313. putlog "::cims:: the color is NOT optional and will be forced."
  314. }
  315. }
  316. }
  317. }
  318. proc ::cims::xmlElementEnd {tagname} {
  319. variable mnet_networks
  320. variable mnet_bots
  321. variable mnet_channels
  322. variable currentNetworkDesc
  323. variable currentNetworkSig
  324. variable startNetworkInstance
  325. variable startBotInstance
  326. variable startFrequencyInstance
  327. variable currentBot
  328. variable currentOwner
  329. if {"$tagname" == "mnet"} {
  330. set startNetworkInstance 0
  331. set currentNetworkDesc ""
  332. set currentNetworkSig ""
  333. }
  334. if {"$tagname" == "bot"} {
  335. set startBotInstance 0
  336. }
  337. if {"$tagname" == "frequency"} {
  338. set startFrequencyInstance 0
  339. }
  340. }
  341. proc ::cims::xmlCdata {data} {
  342. # putlog "::cims:: data found: $data"
  343. return 1
  344. }
  345. proc ::cims::xmlHandleError {errorcode errormsg} {
  346. putlog "::cims:: some error occured: errcode $errorcode: $errormsg"
  347. }
  348. proc ::cims::xmlDefaultCmd {data} {
  349. putlog "::cims:: i don't know this element: $data"
  350. return 1
  351. }
  352. ##################################################################
  353. namespace eval ::cims {
  354. ## some internal variables for messaging and stuff :) not your business after all.
  355. set mnet(version) "mnet 1.012namespaced"
  356. set mnet_max_history 8
  357. set mnet(reached) "0"
  358. set mnet(reached_channels) "0"
  359. set mnet_reached_users(dummy) "0"
  360. set mnet_reached_chans(dummy) "0"
  361. ##
  362. }
  363. proc ::cims::get_data {n} {
  364. if {[string range $n 0 0] == "\{"} {
  365. set n "\\$n"
  366. }
  367. return $n
  368. }
  369. proc ::cims::proper_botnick {botnick} {
  370. set temp [string tolower $botnick]
  371. # abfrage ob zu lang, dann fixen
  372. # putlog "::cims:: $botnick lowercase: $temp"
  373. if {[string length $botnick] > 9} {
  374. set temp [string range $temp 0 8 ]
  375. # putlog "::cims:: botnickname $botnick too long: capping to: $temp"
  376. }
  377. return $temp
  378. }
  379. proc ::cims::proper_channelname {channelname} {
  380. # channel names ARE NOT and SHOULD NOT BE CASE SENSITIVE!
  381. set temp [string tolower $channelname]
  382. set temp [::cims::umlauts $temp]
  383. # putlog "::cims:: $channelname lowercase: $temp"
  384. return $temp
  385. }
  386. proc ::cims::put_local_netmessage {network name chan rec_nickname rec_channel rec_text} {
  387. variable mnet_colors
  388. variable mnet_colors_optional
  389. variable mnet_colors_onoff
  390. # validating incoming vars..
  391. set chan [::cims::proper_channelname $chan]
  392. if {$mnet_colors($network) == "none"} {
  393. # if no color id was found...
  394. set color_string ""
  395. } else {
  396. # if there was a color id...
  397. if {$mnet_colors_optional($network) == 1} {
  398. # check for the channel if activated..
  399. if {$mnet_colors_onoff($name,$chan) == 1} {
  400. set color_string "\003$mnet_colors($network)"
  401. set bold_string "\002"
  402. set bold_string_end "\002"
  403. } else {
  404. set color_string ""
  405. set bold_string ""
  406. set bold_string_end ""
  407. }
  408. } else {
  409. # if not optional then force colors.. whatever :)
  410. set color_string "\003$mnet_colors($network)"
  411. set bold_string "\002"
  412. set bold_string_end "\002"
  413. }
  414. }
  415. putserv "PRIVMSG $chan :${bold_string}${name}${bold_string_end} ${color_string}${rec_nickname} - ${rec_channel} : ${rec_text}"
  416. putlog "::cims:: + local message from $rec_nickname @ $rec_channel to $chan : $rec_text"
  417. }
  418. proc ::cims::put_local_msg {chan text} {
  419. variable mnet_colors
  420. variable mnet_freqs_onoff
  421. putserv "PRIVMSG $chan :$text"
  422. putlog "::cims:: + normal message: ${chan} => '$text'"
  423. }
  424. proc get_httpfile {host file port} {
  425. global botnet-nick
  426. putlog "get_httpfile::debug host: $host file: $file port: $port"
  427. if {[catch {set sock [socket $host $port] } sockerror]} {
  428. putlog "get_httpfile:: sockerror: $sockerror"
  429. return 0
  430. } else {
  431. puts $sock "GET $file HTTP/1.0"
  432. puts $sock "User-Agent: Mozilla/5.0 (compatible; ${botnet-nick}; mnet.tcl)"
  433. puts $sock "Host: $host"
  434. puts $sock "Connection: close"
  435. puts $sock ""
  436. flush $sock
  437. set header_done 0
  438. set data ""
  439. # get some strings out of the http stream.. better write them in a var.. normally.
  440. while {[eof $sock] != 1} {
  441. set bl [gets $sock]
  442. # putlog "test: $bl"
  443. if {[string match "" $bl]} {
  444. set header_done 1
  445. }
  446. if {$header_done == 1} {
  447. set data "$data\n$bl"
  448. }
  449. }
  450. close $sock
  451. return $data
  452. }
  453. }
  454. proc get_localfile {file} {
  455. global botnet-nick
  456. set data ""
  457. if {[file isfile "$file"] == 1} {
  458. set fh [open "$file" "r"]
  459. while {![eof $fh]} {
  460. set line [gets $fh]
  461. append data $line
  462. }
  463. return $data
  464. } else {
  465. putlog "::cims:: Local configfile $file not found. Ignoring."
  466. }
  467. }
  468. proc ::cims::put_nick {nick msg} {
  469. putserv "NOTICE $nick :$msg"
  470. }
  471. proc ::cims::dummy {} {
  472. return 0
  473. }
  474. #not used..
  475. proc ::cims::kill_delaytimer {prefix chan} {
  476. variable mnet_delay
  477. set mnet_delay($prefix,$chan) 0
  478. putlog "Sending in $chan allowed again, since the timer expired"
  479. }
  480. proc ::cims::put_bot {botnetnick data} {
  481. set testlink [islinked $botnetnick]
  482. if {$testlink == 1} {
  483. putlog "::cims:: put_bot: + a message delivered to $botnetnick."
  484. putbot $botnetnick $data
  485. } else {
  486. putlog "::cims:: put_bot: + a message couldn't be delivered. Bot $botnetnick is not linked"
  487. }
  488. }
  489. proc ::cims::chanstat_users {chan users} {
  490. set ch_users [chanlist $chan]
  491. set ch_users_count [llength $ch_users]
  492. set users [expr $users + $ch_users_count]
  493. return $users
  494. }
  495. proc ::cims::history_queue {bucket nickname channel rec_text} {
  496. #::cims::history_queue $network,$name "$timestamp $rec_nickname $rec_channel $rec_text"
  497. variable mnet_histories
  498. variable mnet_max_history
  499. #putlog "::cims:: HISTORY $nickname $channel $rec_text"
  500. set timestamp [clock format [clock seconds] -format "%H:%M:%S"]
  501. #putlog "tstamp: $timestamp"
  502. # no clean:text needed .. already done sometime before.
  503. set input_history "$timestamp / $nickname - $channel : $rec_text"
  504. # putlog "tst: $timestamp nick: $nickname chan: $channel txt: $rec_text"
  505. set list_length 0
  506. if {[info exists mnet_histories($bucket)] == 1} {
  507. set list_length [llength $mnet_histories($bucket)]
  508. putlog "listlength of mnet_histories($bucket) before: $list_length"
  509. }
  510. if {$list_length >= $mnet_max_history} {
  511. # $mnet_max_history 10 - 9
  512. # 5= 1 4
  513. #10= 1 9
  514. # wenn man von 10 auf 5 wechselt: 6 9
  515. set mnet_histories($bucket) [lrange $mnet_histories($bucket) [expr $list_length - $mnet_max_history + 1] [expr $list_length - 1]]
  516. # putlog "grosser oder gleich 10: str: $input"
  517. }
  518. lappend mnet_histories($bucket) $input_history
  519. #set list_length [llength $mnet_histories($bucket)]
  520. #putlog "listlength of mnet_histories($bucket) now: $list_length"
  521. # define your own logging
  522. if {[info procs ::cims::history_logger] == "::cims::history_logger"} {
  523. ::cims::history_logger $bucket $nickname $channel $rec_text
  524. } else {
  525. putlog "::cims:: procedure ::cims::history_logger hasn't been defined. Do it, if you want logging."
  526. }
  527. }
  528. ## procs which are executed remotely follow:
  529. proc ::cims::receive_message {rec_botnick cmd rec_data} {
  530. variable mnet
  531. variable mnet_channels
  532. variable mnet_freqs_onoff
  533. variable mnet_bots
  534. variable mnet_histories
  535. global botnet-nick
  536. #putlog "rec_data string: '$rec_data'"
  537. # escape it to be a list FIRST.. and for output later, let the list JOIN together to a string again!
  538. set rec_data [split $rec_data]
  539. #putlog "rec_data list: '$rec_data'"
  540. set tmp_network [join [lindex $rec_data 0]]
  541. set tmp_name [join [lindex $rec_data 1]]
  542. #putlog "tmp_net: '$tmp_network'"
  543. #putlog "tmp_nam: '$tmp_name'"
  544. set network [::cims::kill_spaces $tmp_network]
  545. #putlog "network: '$network'"
  546. set name [::cims::kill_spaces $tmp_name]
  547. #putlog "name: '$name'"
  548. set rec_nickname [::cims::kill_spaces [join [lindex $rec_data 2]]]
  549. #set rec_nickname [::cims::kill_spaces clean_txt [join [lrange [split $rec_data] 4 end]]]
  550. set rec_channel [::cims::kill_spaces [join [lindex $rec_data 3]]]
  551. #set rec_text [::cims::clean_txt [join [lrange [split $rec_data] 4 end]]]
  552. set rec_text [join [lrange $rec_data 4 end]]
  553. #putlog "rec_text: '$rec_text'"
  554. set allowed [::cims::allowed_netbot $network ${rec_botnick}]
  555. if {$allowed == 0} {
  556. return 0
  557. }
  558. # now the bot is declared as a known bot.
  559. set proper_botnick [::cims::proper_botnick ${botnet-nick}]
  560. putlog "::cims:: + Relaying Message from: $rec_nickname @ $rec_botnick @ $rec_channel: $rec_text"
  561. set users 0
  562. set count_channels 0
  563. ::cims::history_queue $network,$name $rec_nickname $rec_channel $rec_text
  564. foreach {chan} $mnet_channels($network,$proper_botnick) {
  565. if {[::cims::botonchannel $chan] == "1"} {
  566. # erster disable/enable check
  567. if {$mnet_freqs_onoff($name,$chan) == 1} {
  568. incr count_channels
  569. set users [::cims::chanstat_users $chan $users]
  570. putlog "::cims:: * Remote counting $chan users: $users"
  571. ::cims::put_local_netmessage $network $name $chan $rec_nickname $rec_channel $rec_text
  572. } else {
  573. putlog "::cims:: + $chan has disabled $name output"
  574. }
  575. } else {
  576. putlog "::cims:: + Can't relay a message to '$chan' since I am not there."
  577. }
  578. }
  579. # ANSWER! SEND!
  580. ::cims::put_bot $rec_botnick "mnet_answer $network $name $rec_channel $users $count_channels"
  581. return 0
  582. }
  583. proc ::cims::receive_answer {rec_botnick cmd rec_data} {
  584. variable mnet
  585. variable mnet_reached_users
  586. variable mnet_reached_chans
  587. # we receive a STRING in rec_data! convert into list!
  588. set rec_data [split $rec_data]
  589. # work with list (lindex, lrange) and put together to a STRING again with JOIN.
  590. set network [join [lindex $rec_data 0]]
  591. set name [join [lindex $rec_data 1]]
  592. set chan [join [lindex $rec_data 2]]
  593. set rec_usercount [join [lindex $rec_data 3]]
  594. set rec_chancount [join [lindex $rec_data 4]]
  595. # set rec_text [lrange $rec_data 2 end]
  596. # get this bots results to our namespaced variable:
  597. # FIXME: make simple userstats more accurate by sending nicknames back..
  598. # done: userstats should be counted in a correct variablename .. according to network and frequency
  599. # if you don't pay attention to it, a conflict between two broadcasts counting users may appear.
  600. # $mnet_reached_chans($name,$chan) <- $mnet_reached_users($name,$chan)
  601. set mnet_reached_users($name,$chan) [expr $mnet_reached_users($name,$chan) + $rec_usercount]
  602. set mnet_reached_chans($name,$chan) [expr $mnet_reached_chans($name,$chan) + $rec_chancount]
  603. putlog "::cims:: * $rec_botnick told me he sent its message to $rec_usercount people in $rec_chancount channels for $network frequency $name!"
  604. #putlog "::cims:: * Users reached since $name call: $mnet_reached_users($name,$chan) in channels: $mnet_reached_chans($name,$chan)"
  605. }
  606. proc ::cims::clean_braces {text} {
  607. regsub -all "{" $text "" text
  608. regsub -all "}" $text "" text
  609. return $text
  610. }
  611. proc ::cims::kill_spaces {text} {
  612. regsub -all "\\s+" $text "" text
  613. return $text
  614. }
  615. proc ::cims::clean_txt {text} {
  616. # putlog "filter_A: ${text}"
  617. # regsub -all "\\" $text "\\\\" text
  618. # fixes many whitespace between words down to one space between words
  619. regsub -all "\\s+" $text " " text
  620. # filtering out all colorcodes (works well)
  621. regsub -all "\003\[0-9\]\{1,2\},\[0-9\]\{1,2\}" $text "" text
  622. regsub -all "\003\[0-9\]\{1,2\}" $text "" text
  623. regsub -all "\003" $text "" text
  624. # filtering out BOLD text
  625. regsub -all "\002" $text "" text
  626. # underline gets filtered too. (since +c on quakenet would suppress it ...)
  627. regsub -all "\037" $text "" text
  628. # replacing like !!!!!!!!!!!!! with !!!!! (5 letters)
  629. # s/(.?)\1{4,}/\1\1\1\1\1/g;
  630. # - max 5 same chars in a row
  631. regsub -all -nocase -expanded {(.)\1\1\1\1+} $text {\1\1\1\1\1} text
  632. # putlog "test: $text"
  633. set text [string trim $text]
  634. # putlog "filter_B: ${text}"
  635. return $text
  636. }
  637. proc ::cims::umlauts {text} {
  638. # A REAL STRANGE BUG WORKAROUND WITH UMLAUTS
  639. regsub -all "Ä" ${text} "Ä" text
  640. regsub -all "Ü" ${text} "Ü" text
  641. regsub -all "Ö" ${text} "Ö" text
  642. regsub -all "ä" ${text} "ä" text
  643. regsub -all "ü" ${text} "ü" text
  644. regsub -all "ö" ${text} "ö" text
  645. return ${text}
  646. }
  647. proc ::cims::botonchannel {chan} {
  648. # safe "bot-knows-the-channel-and-is-in-there"-function
  649. if {[validchan $chan] == 1 && [botonchan $chan] == 1} {
  650. return 1
  651. } else {
  652. return 0
  653. }
  654. }
  655. # allowcheck for public commands..
  656. proc ::cims::allowed_channel {network name prefix nick mask chan} {
  657. variable mnet
  658. variable mnet_channels
  659. variable mnet_bots
  660. variable mnet_freqs
  661. variable mnet_networks_by_prefix
  662. variable mnet_colors
  663. global botnick botnet-nick lastbind
  664. # validating incoming vars
  665. set chan [::cims::proper_channelname $chan]
  666. putlog "::cims:: = a command for ($prefix) triggered by $nick ($mask) in $chan"
  667. # the command must be from a channel of "ownchannels"
  668. putlog "::cims:: = trying if $chan is allowed in network: $network"
  669. set found 0
  670. set proper_botnick [::cims::proper_botnick ${botnet-nick}]
  671. foreach _trigger_chan $mnet_channels($network,$proper_botnick) {
  672. #putlog "::cims:: = test: $_trigger_chan vs $chan"
  673. if {[string compare -nocase $_trigger_chan $chan] == 0} {
  674. putlog "::cims:: = channel: $_trigger_chan is allowed in network: $network"
  675. set found 1
  676. } else {
  677. # putlog "::cims:: = not in list: $chan"
  678. }
  679. }
  680. if {$found == 0} {
  681. putlog "::cims:: = triggering $prefix of network $network in $chan is not allowed (in my point of view)"
  682. return 0
  683. }
  684. set snd_nick [::cims::get_data $nick]
  685. if {![isop $nick $chan]} {
  686. putlog "::cims:: = allowed in $chan, but $nick is no op"
  687. ::cims::put_nick $nick "Sorry $nick, you need to be op."
  688. return 0
  689. }
  690. if {$nick == $botnick} {
  691. # no recursion :)
  692. return 0
  693. }
  694. # got through all checks .. so it's an OK channel
  695. return 1
  696. }
  697. # checks if the user is allowed, returns 1 if OK.
  698. # checks against the xml config of the banned ones.
  699. proc ::cims::allowed_user {network name prefix nick mask chan} {
  700. variable mnet
  701. variable mnet_channels
  702. variable mnet_bots
  703. variable mnet_bans
  704. variable mnet_networks_by_prefix
  705. variable mnet_colors
  706. global botnick botnet-nick lastbind
  707. # validating incoming vars
  708. set chan [::cims::proper_channelname $chan]
  709. # does mnet_bans even exist? it's optional after all.
  710. if {[info exists mnet_bans($network,$prefix)] == 1} {
  711. putlog "::cims:: = a command for ($prefix) triggered by $nick ($mask) in $chan"
  712. # the command must be from a channel of "ownchannels"
  713. putlog "::cims:: = trying if $nick ($mask) banned from frequency: $network,$prefix"
  714. set found 0
  715. foreach {hostmask reason} $mnet_bans($network,$prefix) {
  716. if {[string match [string tolower $hostmask] [string tolower $mask]]} {
  717. putlog "::cims:: = allowed_user: $nick ($mask) is not allowed in network ($network) by hostmask ($hostmask) for reason: $reason"
  718. set found 1
  719. } else {
  720. # putlog "::cims:: = not in list: $chan"
  721. }
  722. }
  723. if {$found == 1} {
  724. # tell the user his ban. :)
  725. ::cims::put_nick $nick "::cims:: Not allowed to send messages. Reason: $reason"
  726. return 0
  727. }
  728. }
  729. # got through all checks .. so user is not in banlist
  730. return 1
  731. }
  732. # allowcheck for bots sending netmessages
  733. proc ::cims::allowed_netbot {network netbot} {
  734. variable mnet
  735. variable mnet_bots
  736. global botnick botnet-nick lastbind
  737. putlog "::cims:: = a netbot $netbot sending message... allowed?"
  738. # the command must be from a channel of "ownchannels"
  739. set found 0
  740. set proper_botnick [::cims::proper_botnick ${botnet-nick}]
  741. set proper_netbot [::cims::proper_botnick $netbot]
  742. foreach {_netbotnick} $mnet_bots($network) {
  743. if {$_netbotnick == $proper_netbot} {
  744. putlog "::cims:: = netbot: $proper_netbot is allowed in network: $network"
  745. set found 1
  746. } else {
  747. # putlog "::cims:: = netbot: ...."
  748. }
  749. }
  750. if {$found == 0} {
  751. putlog "::cims:: = $proper_netbot of network $network sent me something - but it is not allowed in my network: $network"
  752. return 0
  753. }
  754. if {$netbot == ${botnet-nick}} {
  755. # if myself (for some reason) then don't do anything... no recursion :)
  756. return 0
  757. }
  758. # got through all checks .. so it's an OK netbot for a given network
  759. return 1
  760. }
  761. proc ::cims::reply_timeout {name chan} {
  762. variable mnet
  763. variable mnet_reached_users
  764. variable mnet_reached_chans
  765. # clean $name and $chan
  766. set name [::cims::kill_spaces $name]
  767. set chan [::cims::kill_spaces $chan]
  768. # easify variables
  769. set users $mnet_reached_users($name,$chan)
  770. set chans $mnet_reached_chans($name,$chan)
  771. #putlog "::cims:: HIER $name UND $chan"
  772. # inzwischen drfte auch die antwort gekommen sein.. also jetzt mnet_reached_* auswerten nach timeout..
  773. # make stats channel-dependent
  774. putlog "::cims:: * After ALL: Count_Users: $mnet_reached_users($name,$chan) Count_Channels: $mnet_reached_chans($name,$chan)"
  775. # Give me some reply.
  776. ::cims::put_local_msg ${chan} "::cims:: Message sent to $users users in $chans channels."
  777. }
  778. ### public reachable commands
  779. proc ::cims::history_frequency {nick mask hand chan text} {
  780. # proc triggered by specified $prefix_history
  781. variable mnet
  782. variable mnet_channels
  783. variable mnet_bots
  784. variable mnet_networks_by_prefix
  785. variable mnet_colors
  786. variable mnet_freqs
  787. variable mnet_freqs_onoff
  788. variable mnet_histories
  789. variable mnet_max_history
  790. global botnick lastbind
  791. set com $lastbind
  792. # validating incoming vars
  793. set chan [::cims::proper_channelname $chan]
  794. # cutting .prefix_history down to .prefix
  795. set prefix [string range $com 0 [expr [string first _ $com] -1]]
  796. #putlog "::cims:: the prefix is $prefix"
  797. set network [join [lindex $mnet_networks_by_prefix($prefix) 0]]
  798. set name [join [lindex $mnet_networks_by_prefix($prefix) 1]]
  799. set help [join [lindex $mnet_networks_by_prefix($prefix) 2]]
  800. set desc [join [lindex $mnet_networks_by_prefix($prefix) 3]]
  801. putlog "network: $network"
  802. set allowed [::cims::allowed_channel $network $name $prefix $nick $mask $chan]
  803. if {$allowed == 0} {
  804. return 0
  805. }
  806. # now generally allowed.
  807. putlog "mnet_history: $com triggered by $nick in $chan"
  808. if {[info exists mnet_histories($network,$name)] == 1} {
  809. set list_length [llength $mnet_histories($network,$name)]
  810. if {$list_length >= 1} {
  811. set msg "::cims:: last $mnet_max_history messages of $network $name:"
  812. ::cims::put_nick $nick $msg
  813. set x_count 0
  814. foreach {msg} $mnet_histories($network,$name) {
  815. incr x_count
  816. set backwards_x [expr $list_length - $x_count]
  817. set msg [lindex $mnet_histories($network,$name) $backwards_x]
  818. ::cims::put_nick $nick "($x_count/$list_length) $msg"
  819. }
  820. }
  821. } else {
  822. ::cims::put_nick $nick "::cims:: no accumulated history for $network $name"
  823. }
  824. }
  825. proc ::cims::enable_frequency {nick mask hand chan text} {
  826. # proc triggered by specified $prefix_enable
  827. variable mnet
  828. variable mnet_channels
  829. variable mnet_bots
  830. variable mnet_networks_by_prefix
  831. variable mnet_colors
  832. variable mnet_freqs
  833. variable mnet_freqs_onoff
  834. global botnick lastbind
  835. set com $lastbind
  836. # validating incoming vars
  837. set chan [::cims::proper_channelname $chan]
  838. # cutting .prefix_enable down to .prefix
  839. set prefix [string range $com 0 [expr [string first _ $com] -1]]
  840. #putlog "::cims:: the prefix is $prefix"
  841. set network [join [lindex $mnet_networks_by_prefix($prefix) 0]]
  842. set name [join [lindex $mnet_networks_by_prefix($prefix) 1]]
  843. set help [join [lindex $mnet_networks_by_prefix($prefix) 2]]
  844. set desc [join [lindex $mnet_networks_by_prefix($prefix) 3]]
  845. #putlog "network: $network"
  846. set allowed [::cims::allowed_channel $network $name $prefix $nick $mask $chan]
  847. if {$allowed == 0} {
  848. return 0
  849. }
  850. # now generally allowed.
  851. putlog "mnet_freq_status: before $mnet_freqs_onoff($name,$chan)"
  852. set mnet_freqs_onoff($name,$chan) 1
  853. putlog "mnet_freq_status: now $mnet_freqs_onoff($name,$chan)"
  854. ::cims::put_local_msg $chan "::cims:: $name _output_ enabled for $chan"
  855. }
  856. proc ::cims::disable_frequency {nick mask hand chan text} {
  857. # proc triggered by specified $prefix_enable
  858. variable mnet
  859. variable mnet_channels
  860. variable mnet_bots
  861. variable mnet_networks_by_prefix
  862. variable mnet_colors
  863. variable mnet_freqs
  864. variable mnet_freqs_onoff
  865. global botnick lastbind
  866. set com $lastbind
  867. # validating incoming vars
  868. set chan [::cims::proper_channelname $chan]
  869. # cutting .prefix_enable down to .prefix
  870. set prefix [string range $com 0 [expr [string first _ $com] -1]]
  871. putlog "::cims:: the prefix is $prefix"
  872. set network [join [lindex $mnet_networks_by_prefix($prefix) 0]]
  873. set name [join [lindex $mnet_networks_by_prefix($prefix) 1]]
  874. set help [join [lindex $mnet_networks_by_prefix($prefix) 2]]
  875. set desc [join [lindex $mnet_networks_by_prefix($prefix) 3]]
  876. #putlog "network: $network"
  877. set allowed [::cims::allowed_channel $network $name $prefix $nick $mask $chan]
  878. if {$allowed == 0} {
  879. return 0
  880. }
  881. # now generally allowed.
  882. putlog "mnet_freq_status: before $mnet_freqs_onoff($name,$chan)"
  883. set mnet_freqs_onoff($name,$chan) 0
  884. putlog "mnet_freq_status: now $mnet_freqs_onoff($name,$chan)"
  885. ::cims::put_local_msg $chan "::cims:: $name _output_ disabled for $chan"
  886. }
  887. proc ::cims::toggle_frequency {nick mask hand chan text} {
  888. # proc triggered by specified $prefix_toggle
  889. variable mnet mnet_channels mnet_bots mnet_networks_by_prefix \
  890. mnet_colors \
  891. mnet_freqs mnet_freqs_onoff
  892. global botnick lastbind
  893. set com $lastbind
  894. # validating incoming vars
  895. set chan [::cims::proper_channelname $chan]
  896. # cutting .prefix_enable down to .prefix
  897. set prefix [string range $com 0 [expr [string first _ $com] -1]]
  898. # putlog "::cims:: the prefix is $prefix"
  899. set network [join [lindex $mnet_networks_by_prefix($prefix) 0]]
  900. set name [join [lindex $mnet_networks_by_prefix($prefix) 1]]
  901. set help [join [lindex $mnet_networks_by_prefix($prefix) 2]]
  902. set desc [join [lindex $mnet_networks_by_prefix($prefix) 3]]
  903. # putlog "network: $network"
  904. set allowed [::cims::allowed_channel $network $name $prefix $nick $mask $chan]
  905. if {$allowed == 0} {
  906. return 0
  907. }
  908. # now generally allowed.
  909. putlog "mnet_freq_status: toggle $mnet_freqs_onoff($name,$chan)"
  910. if {$mnet_freqs_onoff($name,$chan) == 1} {
  911. set mnet_freqs_onoff($name,$chan) 0
  912. ::cims::put_local_msg $chan "::cims:: toggling ${name} _output_, now disabled for ${chan}"
  913. } else {
  914. set mnet_freqs_onoff($name,$chan) 1
  915. ::cims::put_local_msg $chan "::cims:: toggling ${name} _output_, now enabled for ${chan}"
  916. }
  917. putlog "mnet_freq_status: toggle now $mnet_freqs_onoff($name,$chan)"
  918. # frequency toggled .. :)
  919. }
  920. #::cims::enable_color
  921. proc ::cims::enable_color {nick mask hand chan text} {
  922. # proc triggered by specified $prefix_enable
  923. variable mnet mnet_channels mnet_bots mnet_networks_by_prefix \
  924. mnet_colors_optional mnet_colors_onoff
  925. global botnick lastbind
  926. set com $lastbind
  927. # validating incoming vars
  928. set chan [::cims::proper_channelname $chan]
  929. # cutting .prefix_enable down to .prefix
  930. set prefix [string range $com 0 [expr [string first _ $com] -1]]
  931. #putlog "::cims:: the prefix is $prefix"
  932. set network [join [lindex $mnet_networks_by_prefix($prefix) 0]]
  933. set name [join [lindex $mnet_networks_by_prefix($prefix) 1]]
  934. set help [join [lindex $mnet_networks_by_prefix($prefix) 2]]
  935. set desc [join [lindex $mnet_networks_by_prefix($prefix) 3]]
  936. #putlog "network: $network"
  937. set allowed [::cims::allowed_channel $network $name $prefix $nick $mask $chan]
  938. if {$allowed == 0} {
  939. return 0
  940. }
  941. # now generally allowed.
  942. if {$mnet_colors_optional($network) != 1} {
  943. return 0
  944. }
  945. putlog "mnet_color_status: before $mnet_colors_onoff($name,$chan)"
  946. set mnet_colors_onoff($name,$chan) 1
  947. putlog "mnet_color_status: now $mnet_colors_onoff($name,$chan)"
  948. ::cims::put_local_msg $chan "::cims:: $name _coloroutput_ enabled for $chan"
  949. }
  950. #::cims::disable_color
  951. proc ::cims::disable_color {nick mask hand chan text} {
  952. # proc triggered by specified $prefix_enable
  953. variable mnet
  954. variable mnet_channels
  955. variable mnet_bots
  956. variable mnet_networks_by_prefix
  957. variable mnet_colors_optional
  958. variable mnet_colors_onoff
  959. global botnick lastbind
  960. set com $lastbind
  961. # validating incoming vars
  962. set chan [::cims::proper_channelname $chan]
  963. # cutting .prefix_enable down to .prefix
  964. set prefix [string range $com 0 [expr [string first _ $com] -1]]
  965. #putlog "::cims:: the prefix is $prefix"
  966. set network [join [lindex $mnet_networks_by_prefix($prefix) 0]]
  967. set name [join [lindex $mnet_networks_by_prefix($prefix) 1]]
  968. set help [join [lindex $mnet_networks_by_prefix($prefix) 2]]
  969. set desc [join [lindex $mnet_networks_by_prefix($prefix) 3]]
  970. #putlog "network: $network"
  971. set allowed [::cims::allowed_channel $network $name $prefix $nick $mask $chan]
  972. if {$allowed == 0} {
  973. return 0
  974. }
  975. # now generally allowed.
  976. if {$mnet_colors_optional($network) != 1} {
  977. return 0
  978. }
  979. putlog "mnet_color_status: before $mnet_colors_onoff($name,$chan)"
  980. set mnet_colors_onoff($name,$chan) 0
  981. putlog "mnet_color_status: now $mnet_colors_onoff($name,$chan)"
  982. ::cims::put_local_msg $chan "::cims:: $name _coloroutput_ disabled for $chan"
  983. }
  984. #::cims::toggle_color
  985. proc ::cims::toggle_color {nick mask hand chan text} {
  986. # proc triggered by specified $prefix_toggle
  987. variable mnet
  988. variable mnet_channels
  989. variable mnet_bots
  990. variable mnet_networks_by_prefix
  991. variable mnet_colors_optional
  992. variable mnet_colors_onoff
  993. global botnick lastbind
  994. set com $lastbind
  995. # validating incoming vars
  996. set chan [::cims::proper_channelname $chan]
  997. # cutting .prefix_enable down to .prefix
  998. set prefix [string range $com 0 [expr [string first _ $com] -1]]
  999. # putlog "::cims:: the prefix is $prefix"
  1000. set network [join [lindex $mnet_networks_by_prefix($prefix) 0]]
  1001. set name [join [lindex $mnet_networks_by_prefix($prefix) 1]]
  1002. set help [join [lindex $mnet_networks_by_prefix($prefix) 2]]
  1003. set desc [join [lindex $mnet_networks_by_prefix($prefix) 3]]
  1004. # putlog "network: $network"
  1005. set allowed [::cims::allowed_channel $network $name $prefix $nick $mask $chan]
  1006. if {$allowed == 0} {
  1007. return 0
  1008. }
  1009. # now generally allowed.
  1010. if {$mnet_colors_optional($network) != 1} {
  1011. return 0
  1012. }
  1013. putlog "mnet_color_status: toggle $mnet_colors_onoff($name,$chan)"
  1014. if {$mnet_colors_onoff($name,$chan) == 1} {
  1015. set mnet_colors_onoff($name,$chan) 0
  1016. ::cims::put_local_msg $chan "::cims:: toggling ${name} _coloroutput_, now disabled for ${chan}"
  1017. } else {
  1018. set mnet_colors_onoff($name,$chan) 1
  1019. ::cims::put_local_msg $chan "::cims:: toggling ${name} _coloroutput_, now enabled for ${chan}"
  1020. }
  1021. putlog "mnet_color_status: toggle now $mnet_colors_onoff($name,$chan)"
  1022. # color for a channel toggled .. :)
  1023. }
  1024. #::cims::toggle_color
  1025. proc ::cims::status_frequency {nick mask hand chan text} {
  1026. # proc triggered by specified $prefix_toggle
  1027. variable mnet mnet_channels mnet_bots mnet_networks_by_prefix \
  1028. mnet_colors_optional mnet_colors_onoff \
  1029. mnet_freqs_onoff \
  1030. mnet_reached_users mnet_reached_chans
  1031. global botnick lastbind
  1032. set com $lastbind
  1033. # validating incoming vars
  1034. set chan [::cims::proper_channelname $chan]
  1035. # cutting .prefix_enable down to .prefix
  1036. set prefix [string range $com 0 [expr [string first _ $com] -1]]
  1037. # putlog "::cims:: the prefix is $prefix"
  1038. set network [join [lindex $mnet_networks_by_prefix($prefix) 0]]
  1039. set name [join [lindex $mnet_networks_by_prefix($prefix) 1]]
  1040. set help [join [lindex $mnet_networks_by_prefix($prefix) 2]]
  1041. set desc [join [lindex $mnet_networks_by_prefix($prefix) 3]]
  1042. # putlog "network: $network"
  1043. set allowed [::cims::allowed_channel $network $name $prefix $nick $mask $chan]
  1044. if {$allowed == 0} {
  1045. return 0
  1046. }
  1047. # now generally allowed.
  1048. ## get status for this frequency.
  1049. set status_message "$chan $name: "
  1050. if {$mnet_freqs_onoff($name,$chan) == 1} {
  1051. append status_message "frequency output is on. "
  1052. } else {
  1053. append status_message "frequency output is off. "
  1054. }
  1055. if {$mnet_colors_optional($network) == 1} {
  1056. if {$mnet_colors_onoff($name,$chan) == 1} {
  1057. append status_message "colors are turned on. "
  1058. } else {
  1059. append status_message "colors are turned off. "
  1060. }
  1061. } else {
  1062. append status_message "message-colors are forced. "
  1063. }
  1064. if {[info exists mnet_reached_users($name,$chan)]} {
  1065. if {[info exists mnet_reached_chans($name,$chan)]} {
  1066. append status_message "Your last message reached about $mnet_reached_users($name,$chan) users and $mnet_reached_chans($name,$chan) channels. "
  1067. }
  1068. }
  1069. ::cims::put_local_msg $chan "$status_message"
  1070. }
  1071. # checks timers of channels ... if not found, then ok with "0" secs left.. if found then return $secsleft
  1072. proc ::cims::check_spam_protection {prefix chan} {
  1073. variable mnet_delay
  1074. # validating incoming vars
  1075. set chan [::cims::proper_channelname $chan]
  1076. # check for pending timers.. spam-protection
  1077. set timerlist [utimers]
  1078. set secondsLeft 0
  1079. if {![info exists mnet_delay($prefix,$chan)]} {
  1080. set mnet_delay($prefix,$chan) 0
  1081. } else {
  1082. foreach {timerinfo} $timerlist {
  1083. set secsleft [join [lindex $timerinfo 0]]
  1084. set timer_id [join [lindex $timerinfo 2]]
  1085. # putlog "sec: $secsleft tid: $timer_id"
  1086. # putlog "checking timer ($timer_id) against mdelay-id: $mnet_delay($prefix,$chan)"
  1087. if {$timer_id == $mnet_delay($prefix,$chan)} {
  1088. return $secsleft
  1089. }
  1090. }
  1091. }
  1092. return 0
  1093. }
  1094. proc ::cims::messaging_public {nick mask hand chan text} {
  1095. # proc triggered by specified $prefix and calling the following (internal) one
  1096. variable mnet
  1097. variable mnet_channels
  1098. variable mnet_bots
  1099. variable mnet_networks_by_prefix
  1100. variable mnet_colors
  1101. variable mnet_freqs
  1102. variable mnet_freqs_onoff
  1103. variable mnet_delay
  1104. variable mnet_histories
  1105. variable mnet_reached_users
  1106. variable mnet_reached_chans
  1107. global botnet-nick lastbind
  1108. # validating incoming vars
  1109. set chan [::cims::proper_channelname $chan]
  1110. set prefix $lastbind
  1111. # $mnet_networks_by_prefix($prefix) is already a list! Don't split it! But work with lindex and lrange on it! later: JOIN it to a string.
  1112. set my_network_entry $mnet_networks_by_prefix($prefix)
  1113. set network [join [lindex $my_network_entry 0]]
  1114. set name [join [lindex $my_network_entry 1]]
  1115. set help [join [lindex $my_network_entry 2]]
  1116. set desc [join [lindex $my_network_entry 3]]
  1117. set delay [join [lindex $my_network_entry 4]]
  1118. set allowed [::cims::allowed_channel $network $name $prefix $nick $mask $chan]
  1119. if {$allowed == 0} {
  1120. return 0
  1121. }
  1122. # now generally allowed.
  1123. # is user banned from sending??
  1124. set user_allowed [::cims::allowed_user $network $name $prefix $nick $mask $chan]
  1125. if {$user_allowed == 0} {
  1126. return 0
  1127. }
  1128. # user has not been matched against banlist. So he's allowed here.
  1129. # cleaning given strings...
  1130. set text [::cims::clean_txt $text]
  1131. # check here if we have some text or not.. :)
  1132. if {$text == "" || $text == "{}"} {
  1133. # output some help:
  1134. putlog "::cims:: = gave him some help"
  1135. ::cims::put_local_msg $chan $help
  1136. } else {
  1137. # ok, now send! (if timer allows it)
  1138. ### spamprotection
  1139. # returns the seconds that are left for this channel .. or 0 if no seconds left.
  1140. set secsleft [::cims::check_spam_protection $prefix $chan]
  1141. if {$secsleft > 0} {
  1142. putlog "::cims:: The timer of $prefix for $chan is still running. The guy has to wait ($secsleft/$delay) more seconds. I tell him."
  1143. ::cims::put_nick $nick "Sorry $nick, usage of $prefix only every $delay seconds. $secsleft seconds for $chan remaining."
  1144. # now BREAK "messaging_public".
  1145. # NO break.. for debug :)) arf
  1146. return 0
  1147. }
  1148. # if we went through the timer check ... so it doesn't exist anymore then we set a new one:
  1149. # set a timer-id to check for again, if it's allowed or not .. delay
  1150. set mnet_delay($prefix,$chan) [utimer $delay ::cims::dummy]
  1151. ### end spamprotection
  1152. ## HE IS SENDING NOW!
  1153. set mnet(reached) "0"
  1154. set mnet(reached_channels) "0"
  1155. # reset stats .. because he is just freshly sending
  1156. set mnet_reached_users($name,$chan) "0"
  1157. set mnet_reached_chans($name,$chan) "0"
  1158. ::cims::history_queue $network,$name $nick $chan $text
  1159. # send them first, we await a reply!
  1160. set proper_botnick [::cims::proper_botnick ${botnet-nick}]
  1161. # putlog "{botnet-nick} huar: $proper_botnick"
  1162. # single sends TO ALL REMOTE BOTS with their remote CHANNELS...
  1163. # let's see which mode for sending is used...
  1164. foreach _botnick $mnet_bots($network) {
  1165. if {$_botnick == $proper_botnick} {
  1166. } else { # if not myself!
  1167. putlog "::cims:: send: + I am about to send a message to $_botnick for $network: $name: $text"
  1168. # safe put_bot function..
  1169. ::cims::put_bot $_botnick "mnet_receive $network $name $nick $chan $text"
  1170. }
  1171. }
  1172. # SEND TO ALL OWN CHANNELS...
  1173. # send to all own channels, except to the channel the message originating from:
  1174. foreach _ownchan $mnet_channels($network,$proper_botnick) {
  1175. if {$_ownchan == $chan} {
  1176. } else { # if not own channel!
  1177. if {[::cims::botonchannel $_ownchan] == "1"} {
  1178. putlog "::cims:: = i am on $_ownchan"
  1179. # second enable/disable check
  1180. if {$mnet_freqs_onoff($name,$_ownchan) == 1} {
  1181. # userstats local
  1182. # set mnet(reached) [::cims::chanstat_users $_ownchan $mnet(reached)]
  1183. set mnet_reached_users($name,$chan) [::cims::chanstat_users $_ownchan $mnet_reached_users($name,$chan)]
  1184. putlog "::cims:: * Localcounting up $_ownchan users: $mnet_reached_users($name,$chan)"
  1185. # channel count local
  1186. incr mnet_reached_chans($name,$chan)
  1187. ::cims::put_local_netmessage $network $name $_ownchan $nick $chan $text
  1188. } else {
  1189. putlog "::cims:: + $_ownchan has disabled $name output"
  1190. }
  1191. } else {
  1192. putlog "::cims:: + Can't send a local message to '$_ownchan' since I am not there."
  1193. }
  1194. }
  1195. }
  1196. # wait here some more! (10 seconds with utimer)
  1197. utimer 5 "::cims::reply_timeout $name $chan"
  1198. # notice: better would be to go into the "reply" when all known bots already answered..
  1199. # then, if a bot is missing, but it was a known bot, just use a timeout with about 5-10 seconds..
  1200. # if the bot still didn't answer, then just go into "reply".
  1201. }
  1202. }
  1203. ### END public reachable commands
  1204. proc ::cims::binds {} {
  1205. variable currentNetworkDesc
  1206. variable currentNetworkSig
  1207. variable startNetworkInstance
  1208. variable currentBot
  1209. variable currentOwner
  1210. variable startBotInstance
  1211. variable mnet_networks
  1212. variable mnet_freqs
  1213. variable mnet_networks_by_prefix
  1214. variable mnet_channels
  1215. variable mnet_freqs_onoff
  1216. variable mnet_colors_onoff
  1217. global botnet-nick
  1218. set proper_botnick [::cims::proper_botnick ${botnet-nick}]
  1219. # binding of irc commands ... only works well if a config was loaded..
  1220. foreach {network desc} $mnet_networks {
  1221. # putlog "test: network is $network"
  1222. # putlog "test: networkdesc is $desc"
  1223. foreach {network name prefix help desc msgdelay} $mnet_freqs($network) {
  1224. putlog "network: $network"
  1225. putlog "name: $name"
  1226. putlog "prefix: $prefix"
  1227. putlog "help: $help"
  1228. putlog "desc: $desc"
  1229. putlog "msgdelay: $msgdelay"
  1230. set mnet_networks_by_prefix($prefix) "{$network} {$name} {$help} {$desc} {$msgdelay}"
  1231. # setting variables on init.
  1232. foreach {channel} $mnet_channels($network,$proper_botnick) {
  1233. # catch like php isset() - but catch returns 0 if OK!
  1234. set channel [::cims::proper_channelname $channel]
  1235. if {[catch {set mnet_freqs_onoff($name,$channel)}] == 1} {
  1236. set mnet_freqs_onoff($name,$channel) 1
  1237. putlog "::cims:: initially enabling $name for channel: $channel"
  1238. } else {
  1239. putlog "::cims:: $name for $channel is already on output: $mnet_freqs_onoff($name,$channel)"
  1240. }
  1241. # catch like php isset() - but catch returns 0 if OK!
  1242. if {[catch {set mnet_colors_onoff($name,$channel)}] == 1} {
  1243. set mnet_colors_onoff($name,$channel) 0
  1244. putlog "::cims:: initially disabling colors for $name for channel (if not forced): $channel"
  1245. } else {
  1246. putlog "::cims:: coloroutput of $name for $channel is already on (if not forced): $mnet_colors_onoff($name,$channel)"
  1247. }
  1248. }
  1249. bind pub - ${prefix} ::cims::messaging_public
  1250. # $network $name $prefix $help $desc
  1251. bind pub - ${prefix}_enable ::cims::enable_frequency
  1252. bind pub - ${prefix}_disable ::cims::disable_frequency
  1253. bind pub - ${prefix}_toggle ::cims::toggle_frequency
  1254. bind pub - ${prefix}_enable_colors ::cims::enable_color
  1255. bind pub - ${prefix}_disable_colors ::cims::disable_color
  1256. bind pub - ${prefix}_toggle_colors ::cims::toggle_color
  1257. # with typos..
  1258. bind pub - ${prefix}_enable_color ::cims::enable_color
  1259. bind pub - ${prefix}_disable_color ::cims::disable_color
  1260. bind pub - ${prefix}_toggle_color ::cims::toggle_color
  1261. bind pub - ${prefix}_history ::cims::history_frequency
  1262. bind pub - ${prefix}_status ::cims::status_frequency
  1263. bind pub - .mnet_status ::cims::dummy
  1264. # FIXME: make some more commands available to have control over the messages
  1265. # - "_stats"?
  1266. }
  1267. }
  1268. }
  1269. bind bot - mnet_receive ::cims::receive_message
  1270. bind bot - mnet_answer ::cims::receive_answer
  1271. bind dcc m mnet_reload ::cims::dcc_configload
  1272. proc ::cims::conf_parsing {} {
  1273. variable mnet_config
  1274. variable mnet_num_configs
  1275. set parser [xml::parser \
  1276. -elementstartcommand ::cims::xmlElementStart \
  1277. -elementendcommand ::cims::xmlElementEnd \
  1278. -defaultcommand ::cims::xmlDefaultCmd \
  1279. -characterdatacommand ::cims::xmlCdata \
  1280. ]
  1281. # -errorcommand xmlHandleError
  1282. for {set y 1} {$y <= $mnet_num_configs} {incr y} {
  1283. set configfile $mnet_config($y)
  1284. # putlog "HRM?: $configfile"
  1285. $parser parse "$configfile"
  1286. }
  1287. }
  1288. proc ::cims::dcc_configload {dummy1 dummy2 dummy3} {
  1289. # wrapper command for ::cims::netconfigload
  1290. putlog "::cims:: = reloading configs..."
  1291. ::cims::clean_netconfig
  1292. ::cims::netconfigload
  1293. }
  1294. proc ::cims::netconfigload {} {
  1295. variable mnet_http_config
  1296. variable mnet_local_config
  1297. variable mnet_config
  1298. variable mnet_num_configs
  1299. putlog "debug:: $mnet_http_config"
  1300. # possible methods to load a config are: get_httpfile and get_localfile
  1301. # get_httpfile
  1302. # get_localfile RELATIVE_PATH_AND_FILE
  1303. set x 0
  1304. if {[info exists mnet_http_config]} {
  1305. foreach {host httpfile port} $mnet_http_config {
  1306. # FIXME config validating.. is the file received correctly? or do
  1307. # we only have a 404 error message there? ... bad thing still.
  1308. incr x
  1309. set mnet_config($x) [get_httpfile $host $httpfile $port]
  1310. }
  1311. }
  1312. if {[info exists mnet_local_config]} {
  1313. foreach {localfile} $mnet_local_config {
  1314. # FIXME config validating.. could we open the file?
  1315. # is the file a correct config?
  1316. incr x
  1317. set mnet_config($x) [get_localfile $localfile]
  1318. }
  1319. }
  1320. # $x is now at its highest count.
  1321. set mnet_num_configs $x
  1322. if {$x > 0} {
  1323. utimer 5 ::cims::conf_parsing
  1324. utimer 10 ::cims::binds
  1325. } else {
  1326. putlog "::cims:: no configurations loaded."
  1327. }
  1328. }
  1329. # looping this one
  1330. proc ::cims::interval_conf {} {
  1331. variable mnet_cfg_reload_interval
  1332. variable mnet_configtimer_set
  1333. variable mnet_netconfig_timer
  1334. # putlog "::cims:: interval conf! $mnet_configtimer_set huh?"
  1335. if {$mnet_configtimer_set == 1} {
  1336. putlog "::cims:: starting intervalled configload ($mnet_cfg_reload_interval minutes)"
  1337. ::cims::clean_netconfig
  1338. ::cims::netconfigload
  1339. set mnet_netconfig_timer [timer $mnet_cfg_reload_interval ::cims::interval_conf]
  1340. } else {
  1341. putlog "::cims:: was about to make a automatic configload again, but it has been disabled recently."
  1342. }
  1343. }
  1344. namespace eval ::cims {
  1345. ############# CONFIG SECTION ##############
  1346. ### the real config section is supposed to be here...
  1347. if {[info exists configs_file]} {
  1348. if {[file isfile "$configs_file"] == 1} {
  1349. source $configs_file
  1350. putlog "::cims:: configs file '$configs_file' loaded."
  1351. }
  1352. }
  1353. ############# CONFIG SHOULD NOW BE LOADED ONTO THE MANY VARIABLES ##############
  1354. # pls hands away again: starting up just defined configs ...
  1355. putlog "::cims:: = Messaging Network ($mnet(version)) loaded"
  1356. putlog "::cims:: = as master, reload current net-configs with .mnet_reload"
  1357. putlog "::cims:: = do .rehash and .mnet_reload if you defined a new net-config."
  1358. if {$mnet_cfg_reload_interval >= 90} {
  1359. if {![info exists mnet_netconfig_timer]} {
  1360. set mnet_configtimer_set 1
  1361. ::cims::interval_conf
  1362. # this one loops
  1363. }
  1364. } else {
  1365. if {[info exists mnet_netconfig_timer]} {
  1366. set mnet_configtimer_set 0
  1367. killtimer $mnet_netconfig_timer
  1368. unset mnet_netconfig_timer
  1369. }
  1370. set mnet_cfg_reload_interval 0
  1371. ::cims::clean_netconfig
  1372. ::cims::netconfigload
  1373. }
  1374. }