cims.tcl 54 KB

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