cims.tcl 56 KB

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