4000-convenience.tcl (29366B)
1 #source chanserv.conf 2 3 #more thanks to fireegl 4 # XXX THIS PORTION BLOCKS NONGPL RELEASE 5 6 proc SetUdefDefaults {{name {*}}} { 7 global UdefDefaults 8 foreach udef [array names UdefDefaults $name] { 9 #dict for {key value} $::database(channels) { 10 # if {![dict exists $value $udef]} { 11 # dbase set eggcompat [curctx net] channels $key $value $udef $UdefDefaults($udef) 12 # } 13 #} 14 foreach channel [channels] { 15 if {[catch { channel get $channel $udef }]} { 16 # channel set $channel $udef $UdefDefaults($udef) 17 dbase set eggcompat [curctx net] channels [string toupper $channel] $udef $UdefDefaults($udef) 18 } 19 } 20 } 21 } 22 23 # Defines a new udef: 24 proc setudef {type name {default {}}} { 25 # Store the default for this udef: 26 global UdefDefaults 27 set name [string tolower $name] 28 switch -- $type { 29 {flag} { set UdefDefaults($name) [string is true -strict $default] } 30 {int} { if {$default != {}} { set UdefDefaults($name) $default } else { set UdefDefaults($name) 0 } } 31 {str} - {list} { set UdefDefaults($name) $default } 32 {default} { return -code error "[mc {Invalid udef type: %s} $type]" } 33 } 34 # Store the udef itself: 35 global Udefs 36 set Udefs($name) $type 37 # "UDEF: $name (${type}) defined. Default: $UdefDefaults($name)" 38 # Apply the default to all channels that don't already have it set: 39 SetUdefDefaults $name 40 } 41 42 # getudefs <flag/int/str> 43 # Returns: a list of user defined channel settings of the given type, 44 # or all of them if no type is given. 45 proc getudefs {{type {}}} { 46 # Note/FixMe: Eggdrop probably errors if $type is invalid. 47 # This is not a compatibility problem though 48 global Udefs 49 set list [list] 50 # Note/FixMe: We could also create a new array, called UdefTypes, which looks like (for example): 51 # UdefTypes(flag) "autoop enforcebans ..." 52 # That way we don't need a foreach here, and could just return the list.. 53 foreach u [array names Udefs] { 54 if {$type eq {} || $type eq $Udefs($u)} { 55 lappend list $u 56 } 57 } 58 return $list 59 } 60 61 # renudef <flag/int> <oldname> <newname> 62 # Description: renames a user defined channel flag or integer setting. 63 # Returns: nothing 64 # Module: channels 65 proc renudef {type oldname newname} { 66 global Udefs 67 if {[info exists Udefs($newname)]} {return -1} 68 if {[info exists Udefs($oldname)] && [string equal -nocase $Udefs($oldname) $type]} { 69 dict for {key value} $::database(channels) { 70 if {[dict exists $value $oldname]} { 71 dbase set eggcompat [curctx net] channels $key $newname [dbase get eggcompat [curctx net] channels $key $oldname] 72 dbase unset eggcompat [curctx net] channels $key $oldname 73 } 74 } 75 set Udefs($newname) $Udefs($oldname) 76 unset Udefs($oldname) 77 global UdefDefaults 78 set UdefDefaults($newname) $UdefDefaults($oldname) 79 unset Udefs($oldname) 80 return 1 81 } 82 return 0 83 } 84 85 # deludef <flag/int> <name> 86 # Description: deletes a user defined channel flag or integer setting. 87 # Returns: nothing 88 # Module: channels 89 # Proc written by Papillon@EFNet. 90 # FixMe: This proc is untested and unmodified from what he sent me. Looks broken. =P 91 proc deludef {type name} { 92 global Udefs 93 if {[info exists Udefs($oldname)] && [string equal -nocase $Udefs($oldname) $type]} { 94 dict for {key value} $::database(channels) { if {[dict exists $value $oldname]} { dbase unset eggcompat [curctx net] channels $key $oldname } } 95 unset Udefs($oldname) 96 global UdefDefaults 97 unset Udefs($oldname) 98 return 1 99 } 100 return 0 101 } 102 103 # Returns 1 if it's a valid (existing) name for a udef, or 0 if it's not: 104 proc validudef {name} { 105 global Udefs 106 info exists Udefs($name) 107 } 108 109 110 proc protectopcheck {mc f t p} { 111 if {"o"==$mc && ![channel get $t protectop]} {return} 112 if {"h"==$mc && ![channel get $t protecthalfop]} {return} 113 if {"v"==$mc && ![channel get $t protectvoice]} {return} 114 switch -- $mc { 115 "o" { 116 if {[matchattr [tnda get "login/[curctx net]/$p"] omn|omn $t]} { 117 [curctx proto] putmode [curctx sock] 77 $t +$mc "$p" [tnda get "channels/[curctx net]/[ndaenc $t]/ts"] 118 } 119 } 120 "h" { 121 if {[matchattr [tnda get "login/[curctx net]/$p"] l|l $t]} { 122 [curctx proto] putmode [curctx sock] 77 $t +$mc "$p" [tnda get "channels/[curctx net]/[ndaenc $t]/ts"] 123 } 124 } 125 "v" { 126 if {[matchattr [tnda get "login/[curctx net]/$p"] v|v $t]} { 127 [curctx proto] putmode [curctx sock] 77 $t +$mc "$p" [tnda get "channels/[curctx net]/[ndaenc $t]/ts"] 128 } 129 } 130 } 131 } 132 133 proc finduserbyid {n} { 134 tnda get "login/[curctx net]/$f" 135 } 136 137 # XXX obsolete; safe to remove? 138 proc autoopcheck {c f} { 139 set globe 0 140 if {[channel get $c operit]} {set globe 1} 141 if {[channel get $c autoop]} {set auto nmo} {set auto ""} 142 if {[channel get $c autohalfop]} {append auto l} 143 if {[channel get $c autovoice]} {append auto v} 144 tcs:opcheck $c $f $globe $auto 145 } 146 147 proc unixtime {} { 148 return [clock format [clock seconds] -format %s] 149 } 150 151 # XXX obsolete; safe to remove? 152 proc tcs:opcheck {c f {globe 0} {auto nmolv}} { 153 # puts stdout "$c $f" 154 if {[matchattr [tnda get "login/[curctx net]/$f"] |k $c]} { 155 # obviously optimised for charybdis... ??? 156 [curctx proto] putmode [curctx sock] 77 $c +b "*![tnda get "ident/[curctx net]/$f"]@[tnda get "vhost/[curctx net]/$f"]" [tnda get "channels/[curctx net]/[ndaenc $c]/ts"] 157 [curctx proto] kick [curctx sock] 77 $c $f "Autokicked (+k attribute)" 158 return 159 } 160 if {[matchattr [tnda get "login/[curctx net]/$f"] n|] && $globe} { 161 [curctx proto] putmode [curctx sock] 77 $c +[tnda get "pfx/owner"] $f [tnda get "channels/[curctx net]/[ndaenc $c]/ts"] 162 return 163 } 164 if {[matchattr [tnda get "login/[curctx net]/$f"] |n $c] && ([string first "o" $auto] != -1)} { 165 [curctx proto] putmode [curctx sock] 77 $c +[tnda get "pfx/owner"] $f [tnda get "channels/[curctx net]/[ndaenc $c]/ts"] 166 return 167 } 168 169 if {[matchattr [tnda get "login/[curctx net]/$f"] m|] && $globe} { 170 [curctx proto] putmode [curctx sock] 77 $c +[tnda get "pfx/protect"] $f [tnda get "channels/[curctx net]/[ndaenc $c]/ts"] 171 return 172 } 173 if {[matchattr [tnda get "login/[curctx net]/$f"] |m $c] && ([string first "o" $auto] != -1)} { 174 [curctx proto] putmode [curctx sock] 77 $c +[tnda get "pfx/protect"] $f [tnda get "channels/[curctx net]/[ndaenc $c]/ts"] 175 return 176 } 177 178 if {[matchattr [tnda get "login/[curctx net]/$f"] a|]} { 179 [curctx proto] putmode [curctx sock] 77 $c +o $f [tnda get "channels/[curctx net]/[ndaenc $c]/ts"] 180 return 181 } 182 if {[matchattr [tnda get "login/[curctx net]/$f"] o|] && $globe} { 183 [curctx proto] putmode [curctx sock] 77 $c +o $f [tnda get "channels/[curctx net]/[ndaenc $c]/ts"] 184 return 185 } 186 if {[matchattr [tnda get "login/[curctx net]/$f"] |o $c] && ([string first "o" $auto] != -1)} { 187 [curctx proto] putmode [curctx sock] 77 $c +o $f [tnda get "channels/[curctx net]/[ndaenc $c]/ts"] 188 return 189 } 190 if {[matchattr [tnda get "login/[curctx net]/$f"] l|] && $globe} { 191 [curctx proto] putmode [curctx sock] 77 $c +[tnda get "pfx/halfop"] $f [tnda get "channels/[curctx net]/[ndaenc $c]/ts"] 192 return 193 } 194 if {[matchattr [tnda get "login/[curctx net]/$f"] |l $c] && ([string first "h" $auto] != -1)} { 195 [curctx proto] putmode [curctx sock] 77 $c +[tnda get "pfx/halfop"] $f [tnda get "channels/[curctx net]/[ndaenc $c]/ts"] 196 return 197 } 198 if {[matchattr [tnda get "login/[curctx net]/$f"] v|] && $globe} { 199 [curctx proto] putmode [curctx sock] 77 $c +v $f [tnda get "channels/[curctx net]/[ndaenc $c]/ts"] 200 return 201 } 202 if {[matchattr [tnda get "login/[curctx net]/$f"] |v $c] && ([string first "v" $auto] != -1)} { 203 [curctx proto] putmode [curctx sock] 77 $c +v $f [tnda get "channels/[curctx net]/[ndaenc $c]/ts"] 204 return 205 } 206 } 207 208 # XXX nobody calls me anymore; obsolete. safe to remove? 209 proc bitchopcheck {mc ftp} { 210 set f [lindex $ftp 0] 211 set t [lindex $ftp 1] 212 set p [lindex $ftp 2] 213 puts stdout "$ftp" 214 if {[tnda get "pfx/owner"]==$mc && ![channel get $t bitch]} {return} {if {[tnda get "pfx/owner"] != q} {set mc q}} 215 if {[tnda get "pfx/protect"]==$mc && ![channel get $t bitch]} {return} {if {[tnda get "pfx/protect"] != a} {set mc a}} 216 if {"o"==$mc && ![channel get $t bitch]} {return} 217 if {"h"==$mc && ![channel get $t halfbitch]} {return} 218 if {"v"==$mc && ![channel get $t voicebitch]} {return} 219 switch -glob -- $mc { 220 "q" { 221 if {![matchattr [tnda get "login/[curctx net]/$p"] n|n $t]} { 222 puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" 223 [curctx proto] putmode [curctx sock] 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] 224 } 225 } 226 "a" { 227 if {![matchattr [tnda get "login/[curctx net]/$p"] mn|mn $t]} { 228 puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" 229 [curctx proto] putmode [curctx sock] 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] 230 } 231 } 232 "o" { 233 if {![matchattr [tnda get "login/[curctx net]/$p"] aomn|omn $t]} { 234 puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" 235 [curctx proto] putmode [curctx sock] 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] 236 } 237 } 238 "h" { 239 if {![matchattr [tnda get "login/[curctx net]/$p"] l|l $t]} { 240 puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" 241 [curctx proto] putmode [curctx sock] 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] 242 } 243 } 244 "v" { 245 if {![matchattr [tnda get "login/[curctx net]/$p"] v|v $t]} { 246 puts stdout "M $t -$mc $p [nda get "regchan/[ndaenc $t]/ts"]" 247 [curctx proto] putmode [curctx sock] 77 $t "-$mc" "$p" [nda get "regchan/[ndaenc $t]/ts"] 248 } 249 } 250 } 251 } 252 253 #proc every {milliseconds script} {$script; after $milliseconds [every $milliseconds $script]} 254 #every 1000 [list firellmbind - time [clock format [clock seconds] -format "%M %H %d %m %Y"]] 255 proc utimer {seconds tcl-command} {after [expr $seconds * 1000] ${tcl-command}} 256 proc timer {minutes tcl-command} {after [expr $minutes * 60 * 1000] ${tcl-command}} 257 proc utimers {} {set t {}; foreach a [after info] {lappend t "0 [lindex [after info $a] 0] $a"}; return $t} 258 proc timers {} {set t {}; foreach a [after info] {lappend t "0 [lindex [after info $a] 0] $a"}; return $t} 259 proc killtimer id {return [after cancel $id]} 260 proc killutimer id {return [after cancel $id]} 261 262 proc isbotnick {n} {return [expr {$n == [curctx user] || $n == [curctx uid]}]} 263 264 proc setctx {ctx} { 265 global globctx 266 if {[catch [list set ::sock($ctx)] erre] > 0} {return} ; # silently crap out 267 set globctx $ctx 268 } 269 270 proc setuctx {ctx} { 271 global globuctx 272 if {[% nick2uid $ctx] == "" && !($ctx == "")} {return} ; # silently crap out 273 if {$ctx == ""} { 274 set globuctx "" 275 } { 276 set globuctx [% uid2intclient [% nick2uid $ctx]] 277 } 278 } 279 280 proc % {c args} { 281 set ul [list [curctx proto] $c [curctx sock]] 282 foreach {a} $args {lappend ul $a} 283 uplevel 1 $ul 284 } 285 286 proc @@ {c args} { 287 set ul [list [curctx proto] $c [curctx sock] [curctx unum]] 288 foreach {a} $args {lappend ul $a} 289 uplevel 1 $ul 290 } 291 292 proc getctx {{type net}} {curctx $type} 293 294 proc curctx {{type net}} { 295 if {$::globctx == ""} {return "-"} 296 switch -exact -- [format ".%s" [string tolower $type]] { 297 .sock { 298 return $::sock($::globctx) 299 } 300 .net { 301 return $::globctx 302 } 303 .unum { 304 return $::globuctx 305 } 306 .uid { 307 return [% intclient2uid $::globuctx] 308 } 309 .user { 310 return [% uid2nick [% intclient2uid $::globuctx]] 311 } 312 .proto { 313 return $::nettype($::globctx) 314 } 315 } 316 } 317 318 set globctx "" 319 set globuctx "" 320 321 foreach {pname} [list putserv puthelp putquick putnow] { 322 proc $pname {msg} { 323 if {[curctx unum] != ""} { 324 % putnow [curctx unum] $msg 325 } { 326 % putnow "" $msg 327 } 328 } 329 } 330 331 proc pushmode {mode args} { 332 @@ putmode $mode [join $args " "] 333 } 334 335 proc matchattr {handle attr {chan "*"}} { 336 set handle [string tolower $handle] 337 if {-1!=[string first "&" $attr]} {set and 1} {set and 0} 338 set gattr [lindex [split $attr "&|"] 0] 339 set cattr [lindex [split $attr "&|"] 1] 340 if {$handle == "" || $handle == "*"} {return [expr {(($gattr==$cattr||$cattr=="") && $gattr=="-")?1:0}]};# dump 341 set isattrg 0 342 foreach {c} [split [nda get "eggcompat/[curctx net]/attrs/global/$handle"] {}] { 343 foreach {k} [split $gattr {}] { 344 if {$c == $k} {set isattrg 1} 345 } 346 } 347 set isattrc 0 348 if {"*"!=$chan} { 349 foreach {c} [split [nda get "eggcompat/[curctx net]/attrs/[ndaenc $chan]/$handle"] {}] { 350 foreach {k} [split $cattr {}] { 351 if {$c == $k} {set isattrc 1} 352 } 353 } 354 } 355 if {$and && ($isattrg == $isattrc) && ($isattrc == 1)} {return 1} 356 if {!$and && ($isattrg || $isattrc)} {return 1} 357 return 0 358 } 359 360 proc chattr {handle attr {chan "*"}} { 361 set handle [string tolower $handle] 362 if {$chan == "*"} { 363 set del [list] 364 set app "" 365 set state app 366 foreach {c} [split $attr {}] { 367 if {"+"==$c} {set state app;continue} 368 if {"-"==$c} {set state del;continue} 369 if {$state=="del"} { 370 lappend del $c "" 371 } 372 if {$state=="app"} { 373 lappend del $c "" 374 append app $c 375 } 376 } 377 nda set "eggcompat/[curctx net]/attrs/global/$handle" [join [concat [string map $del [nda get "eggcompat/[curctx net]/attrs/global/$handle"]] $app] ""] 378 } { 379 set del [list] 380 set app "" 381 set state app 382 foreach {c} [split $attr {}] { 383 if {"+"==$c} {set state app;continue} 384 if {"-"==$c} {set state del;continue} 385 if {$state=="del"} { 386 lappend del $c "" 387 } 388 if {$state=="app"} { 389 lappend del $c "" 390 append app $c 391 } 392 } 393 puts stdout [ndaenc $chan] 394 nda set "eggcompat/[curctx net]/attrs/[ndaenc $chan]/$handle" [join [concat [string map $del [nda get "eggcompat/[curctx net]/attrs/[ndaenc $chan]/$handle"]] $app] ""] 395 } 396 } 397 398 proc channels {} { 399 set ret [list] 400 foreach {chan _} [nda get "eggcompat/[curctx net]/channels"] { 401 lappend ret $chan 402 } 403 return $ret 404 } 405 406 proc mc {form args} { 407 format $form {*}$args 408 } 409 410 #TODO: make this a namespace ensemble 411 412 # hey, thanks fireegl 413 proc channel {command {channel {}} args} { 414 # Note: Follow RFC 2812 regarding "2.2 Character codes", http://tools.ietf.org/html/rfc2812 415 # Note that RFC 2812 gets the case of ^ and ~ backwards. ^ = uppercase ~ = lowercase 416 # We should probably not follow the RFC in this instance and instead use the correct case for those two characters. 417 # []\^ (uppers) == {}|~ (lowers) 418 set upperchannel [string toupper $channel] 419 global database 420 switch -- [set command [string tolower $command]] { 421 {add} { 422 set args [lassign [callchannel $command $channel {*}$args] command channel] 423 # Add the channel to the database: 424 dbase set eggcompat [curctx net] channels $upperchannel name $channel 425 SetUdefDefaults 426 # Call ourself again to set the options: 427 if {[llength $args]} { channel set $channel {*}$args } 428 return {} 429 } 430 {set} { 431 if {![dict exists [dbase get eggcompat [curctx net] channels] $upperchannel]} { return -code error "[mc {Invalid Channel: %s} $channel]" } 432 # In the case of "set", $args is already in the form we can use. 433 set setnext 0 434 foreach o $args { 435 if {$setnext} { 436 set setnext 0 437 switch -- $type { 438 {int} - {integer} { 439 # Note, settings such as flood-chan are treated as int's. Hence the need for using split here: 440 lassign [callchannel $command $channel $type $name [split $o {:{ }}]] command channel type name o 441 dbase set eggcompat [curctx net] channels $upperchannel $name $o 442 } 443 {str} - {string} { 444 lassign [callchannel $command $channel $type $name $o] command channel type name o 445 dbase set eggcompat [curctx net] channels $upperchannel $name $o 446 } 447 {list} - {lappend} { 448 lassign [callchannel $command $channel $type $name $o] command channel type name o 449 database channels lappend $upperchannel $name $o 450 } 451 {flag} { 452 # This is so we can support flags being set like: 453 # [channel set #channel bitch +] 454 # or: [channel set #channel revenge 1] 455 # The old way is still supported though. (see below) 456 switch -- $o { 457 {+} { set o 1 } 458 {-} { set o 0 } 459 {default} { set o [string is true -strict $o] } 460 } 461 lassign [callchannel $command $channel $type $name $o] command channel type name o 462 dbase set eggcompat [curctx net] channels $upperchannel $name $o 463 } 464 {unknown} - {default} { 465 return -code error "[mc {Invalid channel option: %s} $name]" 466 } 467 } 468 } elseif {$o != {}} { 469 switch -- [set type [UdefType [set name [string trimleft $o {+-}]]]] { 470 {flag} { 471 switch -- [string index $o 0] { 472 {+} { 473 lassign [callchannel $command $channel $type $name 1] command channel type name o 474 dbase set eggcompat [curctx net] channels $upperchannel $name $o 475 } 476 {-} { 477 lassign [callchannel $command $channel $type $name 0] command channel type name o 478 dbase set eggcompat [curctx net] channels $upperchannel $name $o 479 } 480 {default} { 481 # They must want to set it using a second arg... 482 set setnext 1 483 } 484 } 485 } 486 {int} - {str} - {list} - {integer} - {string} { set setnext 1 } 487 {unknown} - {default} { return -code error "[mc {Illegal channel option: %s} $name]" } 488 } 489 } 490 } 491 } 492 {info} { 493 # COMPATIBILITY WARNING: Because Eggdrop doesn't return the info in any documented or understandable order, 494 # Tcldrop will return a list of each channel setting and it's value. This way makes the info MUCH easier to use by Tcl scripters. 495 if {[dict exists [dbase get eggcompat [curctx net] channels] $upperchannel]} { 496 dict get [dbase get eggcompat [curctx net] channels] $upperchannel 497 } else { 498 return -code error "[mc {No such channel record: %s} $channel]" 499 } 500 } 501 {get} { 502 if {[dict exists [dbase get eggcompat [curctx net] channels] $upperchannel]} { 503 if {[dict exists [dbase get eggcompat [curctx net] channels] $upperchannel {*}$args]} { 504 dict get [dbase get eggcompat [curctx net] channels] $upperchannel {*}$args 505 } else { 506 return -code error "[mc {Unknown channel setting: %s} $args]" 507 } 508 } else { 509 return -code error "[mc {No such channel record: %s} $channel]" 510 } 511 } 512 {list} { 513 set list [list] 514 dict for {key value} [dbase get eggcompat [curctx net] channels] { lappend list [dict get $value name] } 515 return $list 516 } 517 {count} { dict size [dbase get eggcompat [curctx net] channels] } 518 {remove} - {rem} - {delete} - {del} { 519 if {[dict exists [dbase get eggcompat [curctx net] channels] $upperchannel]} { 520 set args [lassign [callchannel $command $channel {*}$args] $command $channel] 521 dbase unset eggcompat [curctx net] channels $upperchannel 522 } else { 523 return -code error "[mc {No such channel record: %s} $channel]" 524 } 525 } 526 {exists} - {exist} { 527 if {[dict exists [dbase get eggcompat [curctx net] channels] $upperchannel]} { 528 return 1 529 } else { 530 return 0 531 } 532 } 533 {default} { return -code error "[mc {Unknown channel sub-command "%s".} $command]" } 534 } 535 } 536 537 # er, no ellenor, that's not how you do that 538 #namespace eval channel { 539 # proc ::channel::get {chan flag} { 540 # if {[::set enda [nda get "eggcompat/[curctx net]/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flag]]"]]!=""} {return $enda} {return 0} 541 # } 542 # proc ::channel::set {chan flags} { 543 # if {[llength $flags] != 1} { 544 # foreach {flag} $flags { 545 # ::set bit [string index $flag 0] 546 # if {$bit=="+"} {::set bitt 1} {::set bitt 0} 547 # ::set flag [string range $flag 1 end] 548 # nda set "eggcompat/[curctx net]/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flag]]" $bitt 549 # } 550 # } { 551 # ::set bit [string index $flags 0] 552 # if {$bit=="+"} {::set bitt 1} {::set bitt 0} 553 # ::set flag [string range $flags 1 end] 554 # nda set "eggcompat/[curctx net]/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flags]]" $bitt 555 # } 556 # } 557 # namespace export * 558 # namespace ensemble create 559 #} 560 561 proc validuser {n} { 562 if {""==[dbase get usernames [curctx net] $n]} {return 0} {return 1} 563 } 564 565 proc userlist {} { 566 set r [list] 567 foreach {u _} [dbase get usernames [curctx net]] { 568 lappend r $u 569 } 570 return $r 571 } 572 573 proc deluser {username} { 574 if {![validuser $username]} {return 0} 575 dbase unset usernames [curctx net] $username 576 } 577 578 proc delhost {username hostmask} { 579 if {![validuser $username]} {return 0} 580 set hmsks [dbase get usernames [curctx net] $username hostmasks 581 set tounset [list] 582 foreach {bindn hm} $hmsks { 583 if {[string tolower $hm] == $hostmask} {lappend tounset $bindn} 584 } 585 foreach {n} $tounset { 586 dbase unset usernames [curctx net] $username hostmasks $n 587 } 588 return 1 589 } 590 591 proc addhost {username hostmask} {adduser $username $hostmask} 592 593 proc adduser {username {hostmask ""}} { 594 #if {[validuser $username]} {return 0} 595 if {$hostmask != ""} {set moretodo 1} {set moretodo 0} 596 while {0!=$moretodo} { 597 set bindnum [rand 1 10000000] 598 if {[dbase get usernames [curctx net] $username hostmasks $bindnum]==""} {set moretodo 0} 599 } 600 if {$hostmask != ""} {dbase set usernames [curctx net] $username hostmasks $bindnum $hostmask} 601 dbase set usernames [curctx net] $username reg 1 602 return 1 603 } 604 605 #llbind [curctx sock] msg 77 "chanset" msgchanset 606 #llbind [curctx sock] msg 77 "chattr" msgchattr 607 #llbind [curctx sock] msg 77 "setxtra" msgxtra 608 #set botnick $cs(nick) 609 #chattr $cs(admin) +mnolv 610 611 proc msgchanset {from msg} { 612 set ndacname [ndaenc [lindex $msg 0 0]] 613 set chanset [lindex $msg 0 1] 614 if {300>[nda get "regchan/$ndacname/levels/[string tolower [tnda get "login/$from"]]"] && ![matchattr [tnda get "login/[curctx net]/$from"] m|m [lindex $msg 0 0]]} { 615 [curctx proto] notice [curctx sock] 77 $from "Only channel super-operators (300) and above and network masters may use eggdrop-compatible chansets." 616 return 617 } 618 channel set [lindex $msg 0 0] $chanset 619 [curctx proto] notice [curctx sock] 77 $from "Eggdrop compatible chanset $chanset set on [lindex $msg 0 0]." 620 } 621 622 proc msgchattr {from msg} { 623 set ndacname [ndaenc [lindex $msg 0 2]] 624 set handle [lindex $msg 0 0] 625 set hand [lindex $msg 0 0] 626 set attrs [lindex $msg 0 1] 627 set chan [lindex $msg 0 2] 628 set ch [lindex $msg 0 2] 629 foreach {c} [split $attrs {}] { 630 if {$c == "+"} {continue} 631 if {$c == "-"} {continue} 632 if {$c == "k"} {set c "mn|mnol"} 633 if {$c == "v"} {set c "mn|lmno"} 634 if {$c == "l"} {set c "mn|mno"} 635 if {$c == "o"} {set c "mn|omn"} 636 if {$c == "m"} {set c "mn|mn"} 637 if {$c == "n"} {set c "n|n"} 638 if {$c == "a"} {set c "mn|"} 639 if {![matchattr [tnda get "login/[curctx net]/$from"] $c $chan]} { 640 [curctx proto] notice [curctx sock] 77 $from "You may only give flags you already possess (Any of flags $c required to set $attrs)." 641 return 642 } 643 } 644 if {""==$chan} {chattr $hand $attrs} {chattr $hand $attrs $chan} 645 [curctx proto] notice [curctx sock] 77 $from "Global flags for $hand are now [nda get "eggcompat/[curctx net]/attrs/global/[string tolower $handle]"]" 646 if {""==[nda get "regchan/$ndacname/levels/[string tolower $hand]"]} {nda set "regchan/$ndacname/levels/[string tolower $hand]" 1} 647 if {$ch != ""} {[curctx proto] notice [curctx sock] 77 $from "Flags on $chan for $hand are now [nda get "eggcompat/[curctx net]/attrs/$ndacname/[string tolower $handle]"]"} 648 } 649 650 proc nick2hand {nick} { 651 foreach {uid nic} [tnda get "nick/[curctx net]"] { 652 if {[string tolower $nick] == [string tolower $nic]} {return [tnda get "login/[curctx net]/$uid"]} 653 } 654 } 655 656 proc uid2hand {uid} { 657 return [tnda get "login/[curctx net]/$uid"] 658 } 659 660 proc getuser {nick datafield {dataval "body"}} { 661 return [dbase get usernames [curctx net] $nick setuser [ndaenc $datafield] [ndaenc $dataval]] 662 } 663 664 proc setuser {nick datafield {dataval "body"} {val {}}} { 665 puts stdout "$nick $datafield $dataval $val" 666 if {[string tolower $datafield] == "pass"} {usetpass $nick $dataval} 667 if {[string tolower $datafield] == "hosts"} {addhost $nick $dataval} 668 if {$val == {} && [string tolower $datafield] != "xtra"} { 669 return [dbase set usernames [curctx net] $nick setuser [ndaenc $datafield] $dataval] 670 } { 671 return [dbase set usernames [curctx net] $nick setuser [ndaenc $datafield] [ndaenc $dataval] $val] 672 } 673 } 674 675 proc msgxtra {from msg} { 676 if {[set log [tnda get "login/[curctx net]/$from"]]==""} { 677 [curctx proto] notice [curctx sock] 77 $from "Until you've registered with the bot, you have no business setting XTRA values." 678 return 679 } 680 set subfield [lindex $msg 0 0] 681 set value [join [lrange [lindex $msg 0] 1 end] " "] 682 setuser $log "XTRA" $subfield $value 683 [curctx proto] notice [curctx sock] 77 $from "Set your user record XTRA $subfield to $value." 684 } 685 686 proc chandname2name {channame} {return $channame} 687 proc channame2dname {channame} {return $channame} 688 689 proc islinked {bot} {return 0} 690 691 proc operHasPrivilege {n i p} { 692 # this bit requires irca. 693 set metadatum [tnda get "metadata/$n/$i/[ndcenc PRIVS]"] 694 set md [split $metadatum " "] 695 set pl [split $p " ,"] 696 foreach {pv} $pl { 697 if {[lsearch $md $pv] != -1} {return 1} 698 } 699 return 0 700 } 701 702 proc operHasAllPrivileges {n i p} { 703 # this bit requires irca. 704 set metadatum [tnda get "metadata/$n/$i/[ndcenc PRIVS]"] 705 set md [split $metadatum " "] 706 set pl [split $p " ,"] 707 foreach {pv} $pl { 708 if {[lsearch $md $pv] == -1} {return 0} 709 } 710 return 1 711 } 712 713 foreach {pn} [list botisop botisvoice botishalfop] { 714 proc $pn {args} {return 1} 715 } 716 717 proc isop {chan id} { 718 return [ismode $chan $id o] 719 } 720 721 proc isvoice {chan id} { 722 return [ismode $chan $id v] 723 } 724 725 proc ishalf {chan id} { 726 return [ismode $chan $id h] 727 } 728 729 proc ishalfop {chan id} { 730 return [ismode $chan $id h] 731 } 732 733 proc ismode {chan id mode} { 734 if {[string first $mode [[curctx proto] getupfx [curctx sock] $chan $id]] != -1} {return 1} {return 0} 735 } 736 737 proc ismodebutnot {chan id mode} { 738 if {[string length [[curctx proto] getupfx [curctx sock] $chan $id]] > 0 && [string first $mode [[curctx proto] getupfx [curctx sock] $chan $id]] == -1} {return 1} {return 0} 739 } 740 741 # rules are odd. you should store the bind return in a variable to unbind it. 742 # flags aren't part of the bind define. 743 set nonusertypes [list conn create encap evnt join login mark mode part pub notc quit topic pubm nick ctcp ctcr] 744 set lowertypes [list notc ctcp ctcr pub msg] 745 proc ibind {type flag text script} { 746 set ctxsock [curctx sock] 747 set ctxuser [curctx unum] 748 if {[lsearch -exact $::nonusertypes [string tolower $type]] != -1} {set binduser "-"} {set binduser $ctxuser} 749 if {[lsearch -exact $::lowertypes [string tolower $type]] != -1} {set text [string tolower $text]} 750 return [llbind $ctxsock $type $binduser $text [list setupthenrun [list [curctx net] $ctxsock $type $ctxuser $flag $text] $script]] 751 } 752 753 proc bind {type flag text script} { 754 set ctxsock [curctx sock] 755 set ctxuser [curctx unum] 756 if {[lsearch -exact $::nonusertypes [string tolower $type]] != -1} {set binduser "-"} {set binduser $ctxuser} 757 if {[lsearch -exact $::lowertypes [string tolower $type]] != -1} {set text [string tolower $text]} 758 #puts stdout [list llbind $ctxsock $type $binduser $text [list isetupthenrun [list [curctx net] $ctxsock $type $ctxuser $flag $text] $script]] 759 return [llbind $ctxsock $type $binduser $text [list isetupthenrun [list [curctx net] $ctxsock $type $ctxuser $flag $text] $script]] 760 } 761 762 proc unbind {type flag text {scrip ""}} { 763 set ctxsock [curctx sock] 764 set ctxuser [curctx unum] 765 if {[lsearch -exact $::nonusertypes [string tolower $type]] != -1} {set binduser "-"} {set binduser $ctxuser} 766 if {[lsearch -exact $::lowertypes [string tolower $type]] != -1} {set text [string tolower $text]} 767 set binds [tnda get "llbinds/[curctx net]/$type/$binduser/[ndcenc $text]"] 768 set killids [list] 769 foreach {id script} $binds { 770 if {[lindex $script 0] == "isetupthenrun" || [lindex $script 0] == "setupthenrun"} { 771 set opts [lindex $script 1] 772 lassign $opts netctx sockctx otype userctx flags otext 773 if {$userctx == $ctxuser && $otype == $type && $text == $otext && ($scrip == "" || $scrip == $script)} {lappend killids $id} 774 } 775 } 776 foreach {id} $killids { 777 unllbind $ctxsock $type $binduser $text $id 778 } 779 } 780 781 proc setupthenrun {opts script args} { 782 lassign $opts netctx sockctx type userctx flags text 783 global globuctx 784 setctx $netctx 785 set globuctx $userctx 786 foreach {a} $args { 787 lappend script $a 788 } 789 eval $script 790 } 791 792 proc isetupthenrun {opts script args} { 793 lassign $opts netctx sockctx type userctx flags text 794 global globuctx 795 if {-1!=[lsearch -exact [list] $type]} {set chan [lindex $args 1]} {set chan "*"} 796 setctx $netctx 797 set globuctx $userctx 798 # "nick uhost hand" 799 lappend script [% uid2nick [lindex $args 0]] 800 lappend script [format "%s@%s" [% uid2ident [lindex $args 0]] [% uid2host [lindex $args 0]]] 801 lappend script [uid2hand [lindex $args 0]] 802 if {![set output [matchattr [uid2hand [lindex $args 0]] $flags $chan]]} {puts stdout "execution denied of $script - matchattr is $output";return} 803 foreach {a} [lrange $args 1 end] { 804 lappend script $a 805 } 806 puts stdout "$script" 807 eval $script 808 } 809 810 foreach {def} { 811 protectop protecthalfop protectvoice operit autoop autohalfop autovoice bitch halfbitch voicebitch inactive 812 } { 813 setudef flag $def 814 } 815 816 proc onchan {nick chan} { 817 set uid [% nick2uid $nick] 818 set ndacname [ndaenc $chan] 819 if {[tnda get "userchan/[curctx net]/$uid/$ndacname"] == "1"} {return 1} {return 0} 820 } 821 822 proc alg {{ha ""}} { 823 if {$ha == ""} { 824 if {[set ha [cdbase get misc [curctx net] hashing]] != ""} {return $ha} 825 if {[set ha [cdbase get gmisc hashing]] != ""} {return $ha} 826 return "SSHA256" 827 } {return $ha} 828 } 829 830 proc passwdok {n p} { 831 set isp [dbase get usernames [curctx net] $n pass] 832 set chkp [pwhash [alg [lindex [split $isp "/"] 0]] $p [lindex [split $isp "/"] end-1]] 833 if {$isp==""} {return 1} 834 if {$chkp == $isp} {return 1} 835 return 0 836 } 837 838 proc usetpass {n p s} { 839 set chkp [pwhash [alg] $p $s] 840 dbase get usernames [curctx net] $n pass $chkp 841 }