tclserv

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

chanserv.tcl (3949B)


      1 # ChanServ for TclServ
      2 # 2018 09 28
      3 # Copyright ©2018CE AsterIRC
      4 # All rights reserved. This file is *reluctantly* under the GNU GPL; see
      5 # LICENSE in the project root for information.
      6 
      7 #           -----------------//----------------
      8 #           ChanServ for TclServ.
      9 # Version 0.9 - released some time in 2017, ChanServ 0.9 was for a time
     10 # AsterIRC's only channels service. It was pretty horrendous. Nevertheless,
     11 # it did its job valiantly. 
     12 # This version's just gonna be a custom Tcl runner.
     13 
     14 blocktnd chanserv
     15 
     16 set chanservunbindalive [llbind - evnt - alive chanserv.connect]
     17 set chanservunbindrehash [llbind - evnt - confloaded chanserv.rehash]
     18 set numversion 1
     19 
     20 proc chanserv.rehash {a} {
     21 #	if {[catch {set oldchanservunbindalive}] == 0} {
     22 #		unllbind - evnt - alive $::oldchanservunbindalive
     23 #		unllbind - evnt - confloaded $::oldchanservunbindrehash
     24 #	}
     25 	set blocks [tnda get "openconf/[ndcenc chanserv]/blocks"]
     26 	for {set i 1} {$i < ($blocks + 1)} {incr i} {
     27 		set netname [string tolower [lindex [tnda get [format "openconf/%s/hdr%s" [ndcenc chanserv] $i]] 0]]
     28 		if {[catch {set ::sock($netname)} result] == 0} {
     29 			if {![eof $::sock($netname)]} {
     30 				after 1000 [list chanserv.oneintro [tnda get [format "openconf/%s/hdr%s" [ndcenc chanserv] $i]] [tnda get [format "openconf/%s/n%s" [ndcenc chanserv] $i]]]
     31 			}
     32 		}
     33 	}
     34 }
     35 
     36 proc chanserv.connect {arg} {
     37 	set blocks [tnda get "openconf/[ndcenc chanserv]/blocks"]
     38 	for {set i 1} {$i < ($blocks + 1)} {incr i} {
     39 		if {[string tolower [lindex [tnda get [format "openconf/%s/hdr%s" [ndcenc chanserv] $i]] 0]] != [string tolower $arg]} {continue}
     40 		after 1000 [list chanserv.oneintro [tnda get [format "openconf/%s/hdr%s" [ndcenc chanserv] $i]] [tnda get [format "openconf/%s/n%s" [ndcenc chanserv] $i]]]
     41 	}
     42 }
     43 
     44 proc cs.confighandler {servicename defdbname headline block} {
     45 	set net [lindex $headline 0]
     46 	set nsock $::sock($net)
     47 	set servicename [format "%s.%s" $servicename [lindex $headline 1]]
     48 	setctx $net
     49 	dictassign $block nick nick ident ident host host modes modes realname realname
     50 	#if {[tnda get "service/$net/$servicename/ourid"] != ""} {
     51 	#	putloglev o * "<$servicename> O damn, I'm already loaded for $net ([tnda get "service/$net/$servicename/ourid"])! Restarting."
     52 	#	% quit [tnda get "service/$net/$servicename/ourid"] "REHASHED; QUITTING TO REAPPLY CONFIG"
     53 	#	tnda unset "service/$net/$servicename/ourid"
     54 	#}
     55 	tnda set "service/$net/$servicename/config" $block
     56 	if {[tnda get "service/$net/$servicename/config/dbname"] == ""} {tnda set "service/$net/$servicename/dbname" $defdbname}
     57 	if {[tnda get "service/$net/$servicename/ourid"] == ""} {
     58 		% sendUid $nick $ident $host $host [set ourid [% getfreeuid]] [expr {($realname == "") ? "* $servicename *" : $realname}] $modes; set connected "Connected"
     59 	} {
     60 		set connected "Already connected"
     61 	}
     62 	set ouroid [tnda get "service/$net/$servicename/ourid"]
     63 	if {[info exists ourid]} {tnda set "service/$net/$servicename/ourid" $ourid} {set ourid [tnda get "service/$net/$servicename/ourid"]}
     64 	puts stdout [format "%s for %s: %s %s %s" $connected $net $nick $ident $host]
     65 	setuctx $nick
     66 }
     67 
     68 proc chanserv.oneintro {headline block} {
     69 	cs.confighandler chanserv chanserv $headline $block
     70 	#llbind - evnt - confloaded [list chanserv.rehash chanserv chanserv $headline $block]
     71 	dictassign $headline net network
     72 	dictassign $block config eggconf nick nick ident username host my-hostname
     73 
     74 	bind time -|- "?0 * * * *" checkchannels
     75 	bind time -|- "?5 * * * *" checkchannels
     76 	bind time -|- "0 * * * *" checkchannels
     77 	bind time -|- "5 * * * *" checkchannels
     78 	setuctx $nick
     79 	mysrc $eggconf
     80 }
     81 
     82 proc checkchannels {a b c d e} {
     83 	set chans [channels]
     84 	foreach {c} $chans {
     85 		set inactive [channel get $c inactive]
     86 		if {!$inactive} {@@ putjoin $c}
     87 	}
     88 	foreach {chan on} [tnda get "userchan/[curctx net]/[curctx uid]"] {
     89 		if {$on} {
     90 			set inactive [channel get $c inactive]
     91 			if {$inactive} {@@ part $c "This channel is not active"}
     92 		}
     93 	}
     94 }