0999-conn.tcl (4655B)
1 package require tls 2 3 # just to have sanity here. don't want a {} dict or a bum array 4 # this is for the logging algorithm to work once implemented, too, among other important things 5 set ::netname(-) - 6 #set ::nettype(-) - 7 #set ::sock(-) - 8 9 proc connect {addr port script} { 10 if {[string index $port 0] == "+"} { set port [string range $port 1 end] ; set comd ::tls::socket } {set comd socket} 11 set sck [$comd $addr $port] 12 fconfigure $sck -blocking 0 -buffering line 13 fileevent $sck readable [concat $script $sck] 14 return $sck 15 } 16 17 proc mknetwork {headlines block} { 18 if {[llength $headlines]<2} { 19 puts stdout "fuck it, block's invalid ($headlines)" 20 return 21 } 22 set proto [dict get $block proto] 23 set numeric [dict get $block numeric] 24 set pass [dict get $block pass] 25 set host [dict get $block host] 26 set port [dict get $block port] 27 set isupport [dict get $block isupport] 28 set servername [lindex $headlines 1] 29 set netname [lindex $headlines 0] 30 if {[catch {set ::sock($netname)} result] == 0} { 31 if {![eof $::sock($netname)]} { 32 putloglev o * "probably rehashing (connected network block, [tnda get rehashing], $result)" 33 return 34 } 35 } 36 if {[dict exists $block prefix]} { 37 # only required for ts6 38 set prefixes [split [dict get $block prefix] " "] 39 set pfxl [split [lindex $prefixes 0] {}] 40 set pfxr [split [lindex $prefixes 1] {}] 41 set pfx [list] 42 foreach {p} $pfxl {m} $pfxr { 43 lappend pfx $p 44 lappend pfx $m 45 } 46 tnda set "netinfo/$netname/prefix" $pfx 47 set pfx [list] 48 foreach {m} $pfxl {p} $pfxr { 49 lappend pfx $p 50 lappend pfx $m 51 } 52 tnda set "netinfo/$netname/pfxchar" $pfx 53 } { 54 # safe defaults, will cover charybdis and chatircd 55 # hey, me from the past - wouldn't this just overwrite? 56 tnda set "netinfo/$netname/prefix" [list @ o % h + v] 57 tnda set "netinfo/$netname/prefix" [list o @ h % v +] 58 } 59 if {[dict exists $block type]} { 60 tnda set "netinfo/$netname/type" [dict get $block type] 61 } { tnda set "netinfo/$netname/type" norm } 62 if {[string length $isupport] > 0} { 63 foreach {tok} [split $isupport " "] { 64 foreach {key val} [split $tok "="] { 65 if {$key == "PREFIX"} { 66 if {[tnda get "netinfo/$netname/pfxissjoin"] == 1} {continue} 67 set v [string range $val 1 end] 68 set mod [split $v ")"] 69 set modechar [split [lindex $mod 1] {}] 70 set modepref [split [lindex $mod 0] {}] 71 foreach {c} $modechar {x} $modepref { 72 tnda set "netinfo/$netname/prefix/$c" $x 73 } 74 foreach {x} $modechar {c} $modepref { 75 tnda set "netinfo/$netname/pfxchar/$c" $x 76 } 77 } elseif {$key == "SJOIN"} { 78 tnda set "netinfo/$netname/pfxissjoin" 1 79 set v [string range $val 1 end] 80 set mod [split $v ")"] 81 set modechar [split [lindex $mod 1] {}] 82 set modepref [split [lindex $mod 0] {}] 83 foreach {c} $modechar {x} $modepref { 84 tnda set "netinfo/$netname/prefix/$c" $x 85 } 86 foreach {x} $modechar {c} $modepref { 87 tnda set "netinfo/$netname/pfxchar/$c" $x 88 } 89 } elseif {$key == "CHANMODES"} { 90 set spt [split $val ","] 91 tnda set "netinfo/$netname/chmban" [lindex $spt 0] 92 tnda set "netinfo/$netname/chmparm" [format "%s%s" [lindex $spt 0] [lindex $spt 1]] 93 tnda set "netinfo/$netname/chmpartparm" [lindex $spt 2] 94 tnda set "netinfo/$netname/chmnoparm" [lindex $spt 3] 95 } else { 96 tnda set "netinfo/$netname/isupport/[ndaenc $key]" $val 97 } 98 } 99 } 100 } 101 # open a connection 102 set socke [connect $host $port [list $proto irc-main]] 103 after 500 [list $proto login $socke $numeric $pass $netname $servername $block] 104 llbind - dead - $socke [list after 5000 [list mknetwork $headlines $block]] 105 foreach {def} { 106 protectop protecthalfop protectvoice operit autoop autohalfop autovoice bitch halfbitch voicebitch 107 } { 108 setudef flag $def 109 } 110 tnda set "netinfo/$netname/crontab" [cron add "* * * * *" eval [concat firellmbind $socke time - {[clock format [clock seconds] -format "%M %H %d %m %Y"]} \ 111 {[clock format [clock seconds] -format "%M"]} \ 112 {[clock format [clock seconds] -format "%H"]} \ 113 {[clock format [clock seconds] -format "%d"]} \ 114 {[clock format [clock seconds] -format "%m"]} \ 115 {[clock format [clock seconds] -format "%Y"]} \ 116 ]] 117 # store it up 118 # postblock network $headlines $block 119 } 120 121 proc core.conn.mknetworks {args} { 122 set blocks [tnda get "openconf/[ndcenc network]/blocks"] 123 for {set i 1} {$i < ($blocks + 1)} {incr i} { 124 puts stdout "$blocks" 125 after 1000 [list mknetwork [tnda get [format "openconf/%s/hdr%s" [ndcenc network] $i]] [tnda get [format "openconf/%s/n%s" [ndcenc network] $i]]] 126 } 127 } 128 129 blocktnd network 130 131 llbind - evnt - confloaded core.conn.mknetworks 132 133 #blockwcb network mknetwork