commit 08069e7cced0e7563101a1a7c4adb867caa51613
parent 34f646f25679c01344b0f432b8e21f218ac8ee92
Author: Ellenor Malik <ellenor@umbrellix.net>
Date: Sun, 21 Oct 2018 01:04:00 +0000
Hopefully.
Diffstat:
16 files changed, 1283 insertions(+), 112 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -6,3 +6,4 @@ scripts/
maintest.tcl
services.db.bk*
*.bak
+tcldrop-files
diff --git a/boilerplate.tcl b/boilerplate.tcl
@@ -0,0 +1,14 @@
+proc confighandler {servicename defdbname headline block} {
+ set net [lindex $headline 0]
+ set nsock $::sock($net)
+ dictassign $block nick nick ident ident host host realname realname
+ if {[llength [tnda get "service/$net/$servicename/config"]] != 0} {return -code error "<$servicename> O damn, I'm already loaded for $net!"
+ tnda set "service/$net/$servicename/config" $block
+ if {[tnda get "service/$net/$servicename/config/dbname"] == ""} {tnda set "service/$net/$servicename/dbname" $defdbname}
+ setctx $net
+ if {[% intclient2uid [tnda get "service/$net/$servicename/ourid"]] == ""} {% sendUid $nick $ident $host $host [set ourid [% getfreeuid]] [expr {($realname == "") ? "* $servicename *" : $realname}] $modes; set connected "Connected"} {set connected "Already connected"}
+ set ouroid [tnda get "service/$net/$servicename/ourid"]
+ if {[info exists ourid]} {tnda set "service/$net/$servicename/ourid" $ourid} {set ourid [tnda get "service/$net/$servicename/ourid"]}
+ puts stdout [format "%s for %s: %s %s %s" $connected $net $nick $ident $host]
+}
+
diff --git a/core/0000-callbacks.tcl b/core/0000-callbacks.tcl
@@ -20,7 +20,8 @@ proc firellbind {sock type client comd args} {
# puts stdout "$sock $type $client [ndcenc $comd] $args"
global globuctx globctx
set globctx $::netname($sock)
- set globuctx $client
+ set oldglobuctx $globuctx
+ if {$client == "-"} {set globuctx ""} {set globuctx $client}
if {""!=[tnda get "llbinds/$::netname($sock)/$type/$client/[ndcenc $comd]"]} {
foreach {id script} [tnda get "llbinds/$::netname($sock)/$type/$client/[ndcenc $comd]"] {
if {$script != ""} {
@@ -35,6 +36,43 @@ proc firellbind {sock type client comd args} {
}
}
};return
+ } {
+# puts stdout "didn't find one"
}
+ set globuctx $oldglobuctx
#if {""!=[tnda get "llbinds/$type/-/[ndcenc $comd]"]} {foreach {id script} [tnda get "llbinds/$type/-/[ndcenc $comd]"] {$script [lindex $args 0] [lrange $args 1 end]};return}
}
+
+proc firellmbind {sock type client comd args} {
+# puts stdout "$sock $type $client [ndcenc $comd] $args"
+ global globuctx globctx
+ set globctx $::netname($sock)
+ set oldglobuctx $globuctx
+ if {$client == "-"} {set globuctx ""} {set globuctx $client}
+ foreach {comde scripts} [tnda get "llbinds/$::netname($sock)/$type/$client"] {
+ set text [ndadec $comde]
+ if {[string match $text $comd]} {
+ foreach {id script} $scripts {
+ if {$script != ""} {
+ set scr $script
+# lappend $scr $sock
+ foreach {a} $args {
+ lappend scr $a
+ }
+ if {[set errcode [catch {eval $scr} erre]] > 0} {
+ puts stdout [format "in script (#%s) %s:\n\nerror code %s, %s\ncontact script developer for assistance\n" $id $scr $errcode $erre]
+ firellbind $sock evnt - error $erre {*}$scr
+ }
+ }
+ }
+ }
+ }
+ set globuctx $oldglobuctx
+ #if {""!=[tnda get "llbinds/$type/-/[ndcenc $comd]"]} {foreach {id script} [tnda get "llbinds/$type/-/[ndcenc $comd]"] {$script [lindex $args 0] [lrange $args 1 end]};return}
+}
+proc putloglev {lev ch msg} {
+ # punt
+ firellmbind [curctx sock] log - [format "%s %s" $ch $lev] $lev $ch $msg
+ firellbind [curctx sock] logall - - $lev $ch $msg
+}
+proc putlog {msg} {putloglev o * $msg}
diff --git a/core/0002-statemachine.tcl b/core/0002-statemachine.tcl
@@ -1,60 +1,76 @@
-proc nick2uid {sck nick} {
+proc nick2uid {nick} {
+ set sck [curctx sock]
foreach {u n} [tnda get "nick/$::netname($sck)"] {
if {[string tolower $n] == [string tolower $nick]} {return $u}
}
return ""
}
-proc intclient2uid {sck nick} {
+proc intclient2uid {nick} {
+ set sck [curctx sock]
foreach {u n} [tnda get "intclient/$::netname($sck)"] {
if {[string tolower $n] == [string tolower $nick]} {return $u}
}
return ""
}
-proc uid2nick {sck u} {
+proc uid2nick {u} {
+ set sck [curctx sock]
return [tnda get "nick/$::netname($sck)/$u"]
}
-proc uid2rhost {sck u} {
+proc uid2rhost {u} {
+ set sck [curctx sock]
return [tnda get "rhost/$::netname($sck)/$u"]
}
-proc uid2host {sck u} {
+proc uid2host {u} {
+ set sck [curctx sock]
return [tnda get "vhost/$::netname($sck)/$u"]
}
-proc uid2ident {sck u} {
+proc uid2ident {u} {
+ set sck [curctx sock]
return [tnda get "ident/$::netname($sck)/$u"]
}
-proc nick2host {sck nick} {
+proc nick2host {nick} {
+ set sck [curctx sock]
return [tnda get "vhost/$::netname($sck)/[nick2uid $netname $nick]"]
}
-proc nick2ident {sck nick} {
+proc nick2ident {nick} {
+ set sck [curctx sock]
return [tnda get "ident/$::netname($sck)/[nick2uid $netname $nick]"]
}
-proc nick2rhost {sck nick} {
+proc nick2rhost {nick} {
+ set sck [curctx sock]
return [tnda get "rhost/$::netname($sck)/[nick2uid $netname $nick]"]
}
-proc nick2ipaddr {sck nick} {
+proc nick2ipaddr {nick} {
+ set sck [curctx sock]
return [tnda get "ipaddr/$::netname($sck)/[nick2uid $netname $nick]"]
}
-proc getts {sck chan} {
+proc getts {chan} {
+ set sck [curctx sock]
return [tnda get "channels/$::netname($sck)/[ndaenc $chan]/ts"]
}
-proc getpfx {sck chan nick} {
+proc getpfx {chan nick} {
+ set sck [curctx sock]
return [tnda get "channels/$::netname($sck)/[ndaenc $chan]/modes/[nick2uid $netname $nick]"]
}
-proc getupfx {sck chan u} {
+proc getupfx {chan u} {
return [tnda get "channels/$::netname($sck)/[ndaenc $chan]/modes/$u"]
+ set sck [curctx sock]
}
-proc getpfxchars {sck modes} {
+proc getpfxchars {modes} {
+ set sck [curctx sock]
set o ""
foreach {c} [split $modes {}] {
append o [nda get "netinfo/$::netname($sck)/prefix/$c"]
}
return $o
}
-proc getmetadata {sck nick metadatum} {
+proc getmetadata {nick metadatum} {
+ set sck [curctx sock]
return [tnda get "metadata/$::netname($sck)/[nick2uid $netname $nick]/[ndcenc $metadatum]"]
}
-proc getcertfp {sck nick} {
+proc getcertfp {nick} {
+ set sck [curctx sock]
return [tnda get "certfps/$::netname($sck)/[nick2uid $netname $nick]"]
}
@@ -76,11 +92,13 @@ putcmdlog "down $mc $f $t $p $n"
tnda set "channels/$n/$chan/modes/$p" [string map [list $mc ""] [tnda get "channels/$n/$chan/modes/$p"]]
}
-proc uid2intclient {sck u} {
+proc uid2intclient {u} {
+ set sck [curctx sock]
return [tnda get "intclient/$::netname($sck)/$u"]
}
-proc getfreeuid {sck} {
+proc getfreeuid {} {
+ set sck [curctx sock]
set work 1
set cns [list]
foreach {_ cnum} [tnda get "intclient/$::netname($sck)"] {lappend cns $cnum}
diff --git a/core/0003-fireegl-cron.tcl b/core/0003-fireegl-cron.tcl
@@ -0,0 +1,322 @@
+# cron -- A cron-like scheduler for scripts.
+
+# Copyright (C) 2010 Tcldrop Development Team <Tcldrop-Dev>
+
+# $Id$
+
+# Usage:
+#
+# cron valid $cron
+# Returns 1 if the cron format is valid, 0 otherwise.
+# cron parse $cron
+# Takes a standard cron time format and returns a dict containing all the possible minutes/hours/days/months/weekdays.
+# cron match $dict
+# Takes the dict returned from parse and returns 1 if the current time/date matches, 0 otherwise.
+# crontab add $cron $command ...
+# Add a new crontab, where $cron is a standard cron time format, and $command is the command to run when there's a match. Returns an ID for the new crontab.
+# crontab remove $id
+# Removes a crontab by ID.
+# crond start
+# Starts the 1-minute loop necessary for running the crontab commands.
+# Note: It's started automatically when a crontab is added.
+# crond stop
+# Stops the 1-minute loop.
+# Note: It's stopped automatically when all the crontabs are removed.
+
+# For the cron syntax, see "man 5 crontab".
+
+namespace eval ::cron {
+ package provide cron 1.0
+ variable IDCount
+ if {![info exists IDCount]} { variable IDCount 0 }
+ variable TimerID
+ if {![info exists TimerID]} { variable TimerID {} }
+ namespace export cron crontab crond
+ namespace ensemble create -command cron -subcommands [list match valid parse add remove start stop]
+ namespace ensemble create -command crontab -subcommands [list add remove]
+ namespace ensemble create -command crond -subcommands [list start stop]
+}
+
+# parses $cron and returns a dict containing all the minutes/hours/days/months/weekdays specified by $cron
+# Example:
+# input: 50-60/2 */4,21 09/2 7-9,december 7-4
+# result: minutes {0 50 52 54 56 58} hours {0 4 8 12 16 20 21} days {9 11 13 15 17 19 21 23 25 27 29 31} months {7 8 9 12} weekdays {0 1 2 3 4}
+proc ::cron::parse {cron} {
+ # Allow special strings:
+ switch -- $cron {
+ {@hourly} { set cron {0 * * * *} }
+ {@midnight} { set cron {0 0 * * *} }
+ {@daily} { set cron {0 1 * * *} }
+ {@weekly} { set cron {0 0 * * 0} }
+ {@monthly} { set cron {0 0 1 * *} }
+ {@yearly} - {@annually} { set cron {0 0 1 1 *} }
+ {@reboot} { return -code error {@reboot not supported.} }
+ }
+ foreach info {{minutes 0 59} {hours 0 23} {days 1 31} {months 1 12} {weekdays 0 6}} element $cron {
+ lassign $info name min max
+ dict set times $name [list]
+ # Calls parse_element to turn the cron-syntax into one we can more generically deal with:
+ foreach element [parse_element $element $name] {
+ lassign $element skip start end
+ if {$end eq {}} {
+ # Set the end to the highest allowable.
+ set end $max
+ # Use [scan] to remove any leading 0's (zeros):
+ } elseif {![scan $end {%d} end]} {
+ # parse_element should've complained about this, but just in case:
+ return -code error "\"$end\" is invalid. (Only decimal integer values are allowed.)"
+ } elseif {$end < $min || $end > ($max + 1)} {
+ return -code error "$end is outside the allowed range for ${name}: $min-$max"
+ }
+ if {$start eq {}} {
+ # Set the start to the lowest allowable.
+ set start $min
+ # Use [scan] to remove any leading 0's (zeros):
+ } elseif {![scan $start {%d} start]} {
+ # parse_element should've complained about this, but just in case:
+ return -code error "\"$start\" is invalid. (Only decimal integer values are allowed.)"
+ } elseif {$start < $min || $start > ($max + 1)} {
+ return -code error "$start is outside the allowed range for ${name}: $min-$max"
+ } elseif {$start == ($max + 1)} {
+ # If, for example, the start (and possibly the end) is 7 for the weekday, we'll make it/them 0:
+ set start $min
+ if {$end == ($max + 1)} { set end $min }
+ # Note: Specifying 0-7 will still mean every day of the week.
+ }
+ # Generate the list of possible values:
+ set count $start
+ while {$count <= $end} {
+ if {$count == ($max + 1)} {
+ # If we landed on $max + 1, we set it as $min and break the loop.
+ # This makes 60 become 0 for minutes, 24 becomes 0 for hours, 32 becomes 1 for days, 13 becomes 1 for months, and 7 becomes 0 for weekdays..
+ dict lappend times $name $min
+ break
+ }
+ dict lappend times $name $count
+ incr count $skip
+ }
+ }
+ # Remove duplicates:
+ dict set times $name [lsort -unique -integer [dict get $times $name]]
+ }
+ return $times
+}
+
+# Used by [parse]
+# Parses a single cron element, returning {{skip start end} ...}
+# skip = the skip/step value (defaults to 1)
+# start = the start of the range (may not be specified)
+# end = the end of the range (may not be specified)
+proc ::cron::parse_element {element {name {}}} {
+ set retval [list]
+ foreach element [split $element {,;:|&}] {
+ if {$element eq {*}} {
+ # Example: *
+ lappend retval [list 1]
+ } elseif {[string is digit -strict $element]} {
+ # Example: 9
+ lappend retval [list 1 $element $element]
+ } elseif {[regexp -- {^(\d+)\-(\d+)$} $element -> from to]} {
+ # Example: 3-9
+ lappend retval [list 1 $from $to]
+ } elseif {[regexp -- {^\*/(\d+)$} $element -> div] && $div >= 1} {
+ # Example: */2
+ lappend retval [list $div]
+ } elseif {[regexp -- {^(\d+)\-(\d+)/(\d*)$} $element -> from to div]} {
+ # Example: 3-9/2
+ lappend retval [list $div $from $to]
+ } elseif {[regexp -- {^(\d+)/(\d*)$} $element -> from div] && $div >= 1} {
+ # Example: 9/2
+ lappend retval [list $div $from]
+ } elseif {[string trim $element] ne {}} {
+ # Ignore ""
+ # Try to deal with names for days/months (ranges and skip/step are not supported in this case):
+ switch -- $name {
+ {days} {
+ switch -nocase -- $element {
+ {sun} - {sunday} { set element 0 }
+ {mon} - {monday} { set element 1 }
+ {tue} - {tuesday} { set element 2 }
+ {wed} - {wednesday} { set element 3 }
+ {thu} - {thursday} { set element 4 }
+ {fri} - {friday} { set element 5 }
+ {sat} - {saturday} { set element 6 }
+ {default} { return -code error "Failed to process: $element" }
+ }
+ }
+ {months} {
+ switch -nocase -- $element {
+ {jan} - {january} { set element 1 }
+ {feb} - {february} { set element 2 }
+ {mar} - {march} { set element 3 }
+ {apr} - {april} { set element 4 }
+ {may} { set element 5 }
+ {jun} - {june} { set element 6 }
+ {jul} - {july} { set element 7 }
+ {aug} - {august} { set element 8 }
+ {sep} - {september} { set element 9 }
+ {oct} - {october} { set element 10 }
+ {nov} - {november} { set element 11 }
+ {dec} - {december} { set element 12 }
+ {default} { return -code error "Failed to process: $element" }
+ }
+ }
+ {} - {default} { return -code error "Failed to process: $element" }
+ }
+ lappend retval [list 1 $element $element]
+ }
+ }
+ # Return the lists of skips/ranges we built up, or return {1} which means a skip of 1 and the full range.
+ if {[llength $retval]} { return $retval } else { list 1 }
+}
+
+# Takes the dict given by the output of [parse] and returns 1 if the current time/date is a match, else 0.
+proc ::cron::match {dict} {
+ lassign [clock format [clock seconds] -format {%M %k %e %N %w}] minute hour day month dayofweek
+ if {[scan $minute {%d}] in [dict get $dict minutes] && $hour in [dict get $dict hours] && $month in [dict get $dict months] && ($dayofweek in [dict get $dict weekdays] || $day in [dict get $dict days])} { return 1 } else { return 0 }
+}
+
+# Checks to see if the supplied cron is valid:
+proc ::cron::valid {cron} {
+ # This RE consists of 5 instances of the same basic RE. Each instance has
+ # "\d+" substituted for a RE that validates the number sequence associated
+ # with that instance.
+ #
+ # Base Regex, explained:
+ # Match any number of comma separated items if there are any:
+ # (0*\d+|\*)(-0*\d+)?(/\d+)?,)*
+ # Match the last item in this instance:
+ # (0*\d+|\*)(-0*\d+)?(/\d+)?\s
+ regexp -expanded -- {
+ # minute (0-59) - ([0-9]|[1-5][0-9])
+ ^((0*([0-9]|[1-5][0-9])|\*)(-0*([0-9]|[1-5][0-9]))?(/\d+)?,)*
+ (0*([0-9]|[1-5][0-9])|\*)(-0*([0-9]|[1-5][0-9]))?(/\d+)?\s
+ # hour (0-23) - ([0-9]|1[0-9]|2[0-3])
+ ((0*([0-9]|1[0-9]|2[0-3])|\*)(-0*([0-9]|1[0-9]|2[0-3]))?(/\d+)?,)*
+ (0*([0-9]|1[0-9]|2[0-3])|\*)(-0*([0-9]|1[0-9]|2[0-3]))?(/\d+)?\s
+ # day of month (1-31) - ([1-9]|[12][0-9]3[01])
+ ((0*([1-9]|[12][0-9]3[01])|\*)(-0*([1-9]|[12][0-9]3[01]))?(/\d+)?,)*
+ (0*([1-9]|[12][0-9]3[01])|\*)(-0*([1-9]|[12][0-9]3[01]))?(/\d+)?\s
+ # month (1-12) - ([1-9]|1[0-2])
+ ((0*([1-9]|1[0-2])|\*)(-0*([1-9]|1[0-2]))?(/\d+)?,)*
+ (0*([1-9]|1[0-2])|\*)(-0*([1-9]|1[0-2]))?(/\d+)?\s
+ # day of week (0-7) - [0-7]
+ ((0*[0-7]|\*)(-0*[0-7])?(/\d+)?,)*
+ (0*[0-7]|\*)(-0*[0-7])?(/\d+)?$
+ } $cron
+}
+
+# Creates a new crontab which will run $args (the script) whenever the current time/date matches,
+# returns an identifier which can be used to remove it.
+proc ::cron::add {cron args} {
+ if {[llength $args]} {
+ variable IDCount
+ variable crontabs
+ dict set crontabs [incr IDCount] [dict create cron [parse $cron] command $args]
+ # Start the 1-minute loop:
+ start
+ return $IDCount
+ }
+}
+
+# Removes a crontab:
+proc ::cron::remove {id} {
+ variable crontabs
+ if {[dict exists $crontabs $id]} {
+ dict unset crontabs $id
+ if {[dict size $crontabs] == 0} {
+ # Stop the 1-minute loop if there aren't any crontabs set.
+ stop
+ }
+ }
+}
+
+# This is the 1-minute looping proc, it processes all the matching crontabs for this minute:
+proc ::cron::DoCron {} {
+ # Start another after timer to run this proc again at the start of the next minute + 1 second + 17ms to 126ms:
+ variable TimerID [after [expr { 60000 - ([clock milliseconds] % 60000) + 1017 + int(rand() * 127) }] [namespace code DoCron]]
+ # Run all the crontabs that match for this minute:
+ variable crontabs
+ set count 231
+ dict for {id info} $crontabs {
+ if {[match [dict get $info cron]]} {
+ # Run this command 16 to 256ms from now..
+ # (Trying to make each command in this batch run 16ms apart.)
+ after [expr { 16 + ([incr count 16] % 247) }] [dict get $info command]
+ }
+ }
+ # Notes and logic behind the weird expr's:
+ # The extra 1 second added to the 1-minute loop is to avoid any issue with leap seconds...
+ # If an extra second is added due to leap seconds,
+ # the loop would start at the 59th second of the minute it already did.
+ # (I think, I don't know this for sure.)
+ #
+ # Example:
+ # An after timer is started at 23:59:00 to run 1000ms in the future.
+ # If a leap-second is added, when the script runs after 1000ms is up
+ # it will then be 23:59:59 when the script does a [clock format].
+ # (Somebody correct me if I'm wrong please.)
+ # I may be off by 1 minute.. If the leap second is added at 00:00:00,
+ # the script, when run, would see the time as 00:00:59.
+ #
+ # The extra 16ms between running the commands is so they don't run
+ # all at once, causing the process to use a lot of CPU-time in a short
+ # amount of time. If they're 16ms apart, it spreads the load out.
+ # 16ms, on Windows XP at least, is how often a process gets its share of the CPU.
+ #
+ # There's no good reason for the rand(). =P
+ #
+ # The effect of all this, is that the command scripts will run at most 1.4 seconds into the minute.
+}
+
+# Starts the 1-minute loop if it's not already running:
+proc ::cron::start {} {
+ variable TimerID
+ if {$TimerID eq {}} {
+ variable TimerID [after [expr { 60000 - ([clock milliseconds] % 60000) + 1017 + int(rand() * 127) }] [namespace code DoCron]]
+ }
+}
+
+# Stops the 1-minute loop:
+proc ::cron::stop {} {
+ variable TimerID
+ after cancel $TimerID
+ variable TimerID {}
+}
+
+# The rest is just used for testing purposes:
+
+# field allowed values
+# ----- --------------
+# minute 0-59
+# hour 0-23
+# day of month 1-31
+# month 1-12 (or names, see below)
+# day of week 0-7 (0 or 7 is Sun, or use names)
+
+if {0} {
+ namespace eval ::cron {
+ puts "now: [clock format [clock seconds] -format {%M %H %d %m %w}]"
+ # minute hour day month weekday
+ set testval "50-60/2;09 */4,21 09/2 7-9,december *"
+ #set testval $argv
+ puts "cron input: $testval"
+ puts "parse result: [set parseresult [::cron::parse $testval]]"
+ puts "match result: [::cron::match $parseresult]"
+ puts "parse time: [time { ::cron::parse $testval } 10000]"
+ puts "match time: [time { ::cron::match $parseresult } 10000]"
+ set matchmax [dict create minutes {0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59} hours {0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23} days {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31} months {1 2 3 4 5 6 7 8 9 10 11 12} weekdays {0 1 2 3 4 5 6}]
+ puts "match time (max): [time { ::cron::match $matchmax } 10000]"
+ set matchmin [dict create minutes {} hours {} days {} months {} weekdays {}]
+ puts "match time (min): [time { ::cron::match $matchmin } 10000]"
+ add {*/2} puts test
+ }
+ after 999999 [list set ::forever 1]
+ vwait ::forever
+}
+
+puts stdout "fireegl was here"
+namespace eval cron {
+ namespace export *
+ namespace ensemble create
+}
diff --git a/core/0004-hashing.tcl b/core/0004-hashing.tcl
@@ -0,0 +1,63 @@
+#! /usr/bin/env tclsh
+
+# Yea, another password manager. "Password--" it's called, because it's entirely stateless.
+# Just takes a master password, a protocol, and a site, and spits out a password.
+
+#
+# This file is part of the password-- distribution (https://github.com/xxxx or http://xxx.github.io).
+# Copyright (c) 2016 Ellenor Malik, legal name "Jack Dennis Johnson". All rights reserved.
+#
+# This file is free software - you may distribute it under the M.I.T. license.
+# If included with GPL'd software, this file is instead available under the terms of
+# the GPL, of the version relevant to the whole.
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to deal
+# in the Software without restriction, including without limitation the rights
+# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+# copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+# THE SOFTWARE.
+
+package require Expect
+package require base64
+package require aes
+package require sha256
+
+proc pad {origlen {mult 16}} {
+ set next [expr $origlen/$mult+1]
+ set nextl [expr ${next}*${mult}]
+ set padlen [expr ${nextl}-${origlen}]
+ return $padlen
+}
+
+proc encrypt {site pass} {
+ set inited [::aes::Init ecb [::sha2::sha256 -bin -- [join [list $site $pass] ":"]] "aaaaaaaaaaaaaaaa"]
+ set padout [pad [string length $site]]
+ append site [string repeat \0 $padout]
+ set encd [::aes::Encrypt $inited [::sha2::sha256 -bin -- $pass]]
+ ::aes::Final $inited
+ return [encrypt-v1 $site $encd]
+}
+
+proc encrypt-v1 {site pass} {
+ set inited [::aes::Init ecb [::sha2::sha256 -bin -- $pass] "aaaaaaaaaaaaaaaa"]
+ set padout [pad [string length $site]]
+ append site [string repeat \0 $padout]
+ set encd [::aes::Encrypt $inited $site]
+ ::aes::Final $inited
+ return $encd
+}
+
+proc pwhash.SSHA256 {pass {site "a"}} {
+ return [format "SSHA256/%s/%s" $site [string map {/ - + _ = {}} [::base64::encode -maxlen 0 -wrapchar "" [encrypt $site $pass]]]]
+}
diff --git a/core/0999-conn.tcl b/core/0999-conn.tcl
@@ -21,6 +21,7 @@ proc mknetwork {headlines block} {
set pass [dict get $block pass]
set host [dict get $block host]
set port [dict get $block port]
+ set isupport [dict get $block isupport]
set servername [lindex $headlines 1]
set netname [lindex $headlines 0]
if {[catch {set ::sock($netname)} result] == 0} {
@@ -44,10 +45,64 @@ proc mknetwork {headlines block} {
# safe defaults, will cover charybdis and chatircd
tnda set "netinfo/$netname/prefix" [list @ o % h + v]
}
+ if {[dict exists $block type]} {
+ tnda set "netinfo/$netname/type" [dict get $block type]
+ } { tnda set "netinfo/$netname/type" norm }
+ if {[string length $isupport] > 0} {
+ foreach {tok} [split $isupport " "] {
+ foreach {key val} [split $tok "="] {
+ if {$key == "PREFIX"} {
+ if {[tnda get "netinfo/$netname/pfxissjoin"] == 1} {continue}
+ set v [string range $val 1 end]
+ set mod [split $v ")"]
+ set modechar [split [lindex $mod 1] {}]
+ set modepref [split [lindex $mod 0] {}]
+ foreach {c} $modechar {x} $modepref {
+ tnda set "netinfo/$netname/prefix/$c" $x
+ }
+ foreach {x} $modechar {c} $modepref {
+ tnda set "netinfo/$netname/pfxchar/$c" $x
+ }
+ } elseif {$key == "SJOIN"} {
+ tnda set "netinfo/$netname/pfxissjoin" 1
+ set v [string range $val 1 end]
+ set mod [split $v ")"]
+ set modechar [split [lindex $mod 1] {}]
+ set modepref [split [lindex $mod 0] {}]
+ foreach {c} $modechar {x} $modepref {
+ tnda set "netinfo/$netname/prefix/$c" $x
+ }
+ foreach {x} $modechar {c} $modepref {
+ tnda set "netinfo/$netname/pfxchar/$c" $x
+ }
+ } elseif {$key == "CHANMODES"} {
+ set spt [split $val ","]
+ tnda set "netinfo/$netname/chmban" [lindex $spt 0]
+ tnda set "netinfo/$netname/chmparm" [format "%s%s" [lindex $spt 0] [lindex $spt 1]]
+ tnda set "netinfo/$netname/chmpartparm" [lindex $spt 2]
+ tnda set "netinfo/$netname/chmnoparm" [lindex $spt 3]
+ } else {
+ tnda set "netinfo/$netname/isupport/[ndaenc $key]" $val
+ }
+ }
+ }
+ }
# open a connection
set socke [connect $host $port [list $proto irc-main]]
after 500 $proto login $socke $numeric $pass $netname $servername
llbind - dead - $socke [list after 5000 [list mknetwork $headlines $block]]
+ foreach {def} {
+ protectop protecthalfop protectvoice operit autoop autohalfop autovoice bitch halfbitch voicebitch
+ } {
+ setudef flag $def
+ }
+ tnda set "netinfo/$netname/crontab" [cron add "* * * * *" eval [concat firellmbind $socke time - {[clock format [clock seconds] -format "%M %H %d %m %Y"]} \
+ {[clock format [clock seconds] -format "%M"]} \
+ {[clock format [clock seconds] -format "%H"]} \
+ {[clock format [clock seconds] -format "%d"]} \
+ {[clock format [clock seconds] -format "%m"]} \
+ {[clock format [clock seconds] -format "%Y"]} \
+ ]]
# store it up
# postblock network $headlines $block
}
diff --git a/core/2003-ts6.tcl b/core/2003-ts6.tcl
@@ -31,7 +31,7 @@ proc ::ts6::b64d {numb} {
}
proc putl {args} {
-# puts stdout [join $args " "]
+ puts stdout [join $args " "]
puts {*}$args
}
@@ -149,6 +149,9 @@ proc ::ts6::part {sck uid targ msg} {
set sendnn [string repeat "A" [expr {6-[string length $sendid]}]]
append sendnn $sendid
putl $sck [format ":%s%s PART %s :%s" $sid $sendnn $targ $msg]
+ set chan [ndaenc $targ]
+ tnda set "userchan/$::netname($sck)/$sid$sendnn/$chan" 0
+ tnda set "channels/$::netname($sck)/$chan/status/[lindex $comd 0]" ""
}
proc ::ts6::quit {sck uid msg} {
@@ -200,7 +203,24 @@ proc ::ts6::putmode {sck uid targ mode {parm ""} {ts ""}} {
set sendid [::ts6::b64e $uid]
set sendnn [string repeat "A" [expr {6-[string length $sendid]}]]
append sendnn $sendid
- putl $sck [format ":%s%s TMODE %s %s %s %s" $sid $sendnn $ts $targ $mode $parm]
+ putl $sck [format ":%s" [set com [format "%s%s TMODE %s %s %s %s" $sid $sendnn $ts $targ $mode $parm]]]
+ set comd [split $com " "]
+ set ctr 4
+ set state 1
+ foreach {c} [split $mode {}] {
+ if {$c == "+"} {
+ set state 1
+ } elseif {$c == "-"} {
+ set state 0
+ } elseif {[string match [format "*%s*" $c] [tnda get "netinfo/$::netname($sck)/chmparm"]] || ($state&&[string match [format "*%s*" $c] [tnda get "netinfo/$::netname($sck)/chmpartparm"]])} {
+ [expr {$state?"::ts6::checkop":"::ts6::checkdeop"}] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] [lindex $comd [incr ctr]]
+# firellmbind $sck mode - [format "%s %s%s" [string tolower [lindex $comd 3]] [expr {$state ? "+" : "-"}] $c] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] [lindex $comd [incr ctr]]
+ } else {
+ [expr {$state?"::ts6::checkop":"::ts6::checkdeop"}] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] [lindex $comd [incr ctr]]
+# firellmbind $sck mode - [format "%s %s%s" [string tolower [lindex $comd 3]] [expr {$state ? "+" : "-"}] $c] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] ""
+# firellmbind $sck mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 3] ""
+ }
+ }
}
proc ::ts6::sendencap {sck uid targ args} {
@@ -227,6 +247,9 @@ proc ::ts6::putjoin {sck uid targ {ts ""}} {
set sendnn [string repeat "A" [expr {6-[string length $sendid]}]]
append sendnn $sendid
putl $sck [format ":%s SJOIN %s %s + :%s%s" $sid $ts $targ $sid $sendnn]
+ set chan [ndaenc $targ]
+ tnda set "userchan/$::netname($sck)/$sid$sendnn/$chan" 1
+# tnda set "channels/$::netname($sck)/$chan/status/[lindex $comd 0]" ""
}
proc ::ts6::validchan {sck channelname} {
@@ -253,7 +276,7 @@ proc ::ts6::quitstorm {sck sid comment {doinit 1}} {
proc ::ts6::irc-main {sck} {
global sid sock socksid
if {[eof $sck]} {
- putl stdout "We're dead, folks."
+ puts stdout "We're dead, folks."
# firellbind $sck evnt "-" "ts6.dead" $::netname($sck) $sck
firellbind $sck evnt "-" "dead" $::netname($sck) $sck
firellbind - evnt "-" "dead" $sck $::netname($sck)
@@ -271,6 +294,12 @@ proc ::ts6::irc-main {sck} {
if {$gotsplitwhere != -1} {lappend comd $payload}
if {[lindex $comd 0] == "PING"} {putl $sck "PONG $::snames($sck) :$payload"}
if {[lindex $comd 0] == "SERVER"} {putl $sck "VERSION"}
+ if {$one == 1} {
+ set sourceof [lindex $comd 0]
+ set two 2
+ } { set sourceof ""
+ set two 1}
+ firellbind $sck raw - [lindex $comd $one] $sourceof [lindex $comd $one] [join [lrange $comd $two end] " "]
set erreno [catch {
switch -nocase -- [lindex $comd $one] {
"479" {putcmdlog $payload}
@@ -327,7 +356,7 @@ proc ::ts6::irc-main {sck} {
tnda set "userchan/$::netname($sck)/$uidd/$chan" 0
}
- ::ts6::snote $sck F [format "!! NETSPLIT: %s (%s) has quit due to netsplit (%s: %s)" [tnda get "nick/$::netname($sck)/$uidd"] $uidd [tnda get "servers/$::netname($sck)/[ndaenc $srv]/name"] [lindex $comd [expr {$one + 2}]]
+ ::ts6::snote $sck x [format "!! NETSPLIT: %s (%s) has quit due to netsplit (%s: %s)" [tnda get "nick/$::netname($sck)/$uidd"] $uidd [tnda get "servers/$::netname($sck)/[ndaenc $srv]/name"] [lindex $comd [expr {$one + 2}]]
tnda unset "login/$::netname($sck)/$uidd"
tnda unset "nick/$::netname($sck)/$uidd"
tnda set "oper/$::netname($sck)/$uidd" 0
@@ -374,6 +403,7 @@ proc ::ts6::irc-main {sck} {
}
} elseif {$key == "CHANMODES"} {
set spt [split $val ","]
+ tnda set "netinfo/$::netname($sck)/chmban" [lindex $spt 0]
tnda set "netinfo/$::netname($sck)/chmparm" [format "%s%s" [lindex $spt 0] [lindex $spt 1]]
tnda set "netinfo/$::netname($sck)/chmpartparm" [lindex $spt 2]
tnda set "netinfo/$::netname($sck)/chmnoparm" [lindex $spt 3]
@@ -387,12 +417,41 @@ proc ::ts6::irc-main {sck} {
"PRIVMSG" {
if {[::ts6::validchan $sck [lindex $comd 2]]} {
set client chan
- firellbind $sck pub "-" [string tolower [lindex [split $payload " "] 0]] [lindex $comd 2] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
- firellbind $sck evnt "-" "chanmsg" [lindex $comd 0] [lindex $comd 2] $payload
+ set words [split $payload " "]
+ set kword [lindex $words 0]
+ if {[string index $payload 0] == "\001"} {
+ set payload [string range $payload 1 end-1]
+ set words [split $payload " "]
+ set kword [lindex $words 0]
+ set payload [join [lrange $words 1 end] " "]
+ firellbind $sck ctcp - [string tolower $payload] [lindex $comd 0] [lindex $comd 2] $kword $payload
+ } {
+ set mpayload [join [lrange $words 1 end] " "]
+ firellbind $sck pub - [string tolower $payload] [lindex $comd 0] [lindex $comd 2] $mpayload
+ firellmbind $sck pubm - [string tolower $payload] [lindex $comd 0] [lindex $comd 2] $payload
+ }
+ #firellbind $sck notc "-" [string tolower [lindex [split $payload " "] 0]] [lindex $comd 2] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
+ #firellmbind $sck pnotcm $client [string tolower [lindex [split $payload " "] 0]] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
+# firellbind $sck pubnotc-m "-" [string tolower [lindex [split $payload " "] 0]] [lindex $comd 2] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
+ #firellbind $sck "evnt" "-" "channotc" [lindex $comd 0] [lindex $comd 2] $payload
} {
set client [tnda get "intclient/$::netname($sck)/[lindex $comd 2]"]
- firellbind $sck msg $client [string tolower [lindex [split $payload " "] 0]] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
- firellbind $sck "evnt" "-" "privmsg" [lindex $comd 0] [lindex $comd 2] $payload
+ set words [split $payload " "]
+ set kword [lindex $words 0]
+ if {[string index $payload 0] == "\001"} {
+ set payload [string range $payload 1 end-1]
+ set words [split $payload " "]
+ set kword [lindex $words 0]
+ set payload [join [lrange $words 1 end] " "]
+ firellbind $sck ctcp - [string tolower $kword] [lindex $comd 0] [% uid2nick [lindex $comd 2]] $kword $payload
+ } {
+ set mpayload [join [lrange $words 1 end] " "]
+ firellbind $sck msg $client [string tolower $kword] [lindex $comd 0] $mpayload
+ firellmbind $sck msgm $client [string tolower $payload] [lindex $comd 0] $payload
+ }
+ #firellbind $sck notc $client [string tolower [lindex [split $payload " "] 0]] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
+ #firellmbind $sck notcm $client [string tolower [lindex [split $payload " "] 0]] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
+ #firellbind $sck "evnt" "-" "privnotc" [lindex $comd 0] [lindex $comd 2] $payload
}
}
@@ -400,13 +459,33 @@ proc ::ts6::irc-main {sck} {
if {![tnda get "netinfo/$::netname($sck)/connected"]} {return}
if {[::ts6::validchan $sck [lindex $comd 2]]} {
set client chan
- firellbind $sck pubnotc "-" [string tolower [lindex [split $payload " "] 0]] [lindex $comd 2] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
+ if {[string index $payload 0] == "\001"} {
+ set payload [string range $payload 1 end-1]
+ set words [split $payload " "]
+ set kword [lindex $words 0]
+ set payload [join [lrange $words 1 end] " "]
+ firellbind $sck ctcr - [string tolower $payload] [lindex $comd 0] [lindex $comd 2] $kword $payload
+ } {
+ firellmbind $sck notc - [string tolower $payload] [lindex $comd 0] [lindex $comd 2] $payload
+ }
+ #firellbind $sck notc "-" [string tolower [lindex [split $payload " "] 0]] [lindex $comd 2] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
+ #firellmbind $sck pnotcm $client [string tolower [lindex [split $payload " "] 0]] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
# firellbind $sck pubnotc-m "-" [string tolower [lindex [split $payload " "] 0]] [lindex $comd 2] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
- firellbind $sck "evnt" "-" "channotc" [lindex $comd 0] [lindex $comd 2] $payload
+ #firellbind $sck "evnt" "-" "channotc" [lindex $comd 0] [lindex $comd 2] $payload
} {
set client [tnda get "intclient/$::netname($sck)/[lindex $comd 2]"]
- firellbind $sck notc $client [string tolower [lindex [split $payload " "] 0]] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
- firellbind $sck "evnt" "-" "privnotc" [lindex $comd 0] [lindex $comd 2] $payload
+ if {[string index $payload 0] == "\001"} {
+ set payload [string range $payload 1 end-1]
+ set words [split $payload " "]
+ set kword [lindex $words 0]
+ set payload [join [lrange $words 1 end] " "]
+ firellbind $sck ctcr - [string tolower $payload] [lindex $comd 0] [% uid2nick [lindex $comd 2]] $kword $payload
+ } {
+ firellmbind $sck notc - [string tolower $payload] [lindex $comd 0] [% uid2nick [lindex $comd 2]] $payload
+ }
+ #firellbind $sck notc $client [string tolower [lindex [split $payload " "] 0]] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
+ #firellmbind $sck notcm $client [string tolower [lindex [split $payload " "] 0]] [lindex $comd 0] [join [lrange [split $payload " "] 1 end] " "]
+ #firellbind $sck "evnt" "-" "privnotc" [lindex $comd 0] [lindex $comd 2] $payload
}
}
@@ -425,7 +504,8 @@ proc ::ts6::irc-main {sck} {
"JOIN" {
set chan [string map {/ [} [::base64::encode [string tolower [lindex $comd 3]]]]
if {""==[tnda get "channels/$::netname($sck)/$chan/ts"]} {firellbind $sck create "-" "-" [lindex $comd 3] [lindex $comd 0] $::netname($sck)}
- firellbind $sck join "-" "-" [lindex $comd 3] [lindex $comd 0] $::netname($sck)
+# firellbind $sck join "-" "-" [lindex $comd 3] [lindex $comd 0] $::netname($sck)
+ firellmbind $sck join - [format "%s %s!%s@%s" [lindex $comd 3] [% uid2nick [lindex $comd 0]] [% uid2ident [lindex $comd 0]] [% uid2host [lindex $comd 0]]] [lindex $comd 0] [lindex $comd 3]
tnda set "channels/$::netname($sck)/$chan/ts" [lindex $comd 2]
tnda set "userchan/$::netname($sck)/[lindex $comd 0]/$chan" 1
}
@@ -437,7 +517,9 @@ proc ::ts6::irc-main {sck} {
if {[lindex $comd 2] > [tnda get "channels/$::netname($sck)/$chan/ts"]} {return} ;# send it packing.
set type [lindex $comd 4]
foreach {mask} $adding {
- firellbind $sck mode - + $type [lindex $comd 0] [lindex $comd 3] $mask $::netname($sck)
+ ::ts6::checkop [lindex $comd 0] [lindex $comd 3] [format "%s%s" + $type] $mask
+ firellmbind $sck mode - [format "%s +%s" [lindex $comd 3] $type] [lindex $comd 0] [lindex $comd 3] "+$type" $mask
+ #+ $type [lindex $comd 0] [lindex $comd 3] $mask $::netname($sck)
}
}
@@ -450,9 +532,12 @@ proc ::ts6::irc-main {sck} {
} elseif {$c == "-"} {
set state 0
} elseif {[string match [format "*%s*" $c] [tnda get "netinfo/$::netname($sck)/chmparm"]] || ($state&&[string match [format "*%s*" $c] [tnda get "netinfo/$::netname($sck)/chmpartparm"]])} {
- firellbind $sck mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 3] [lindex $comd [incr ctr]] $::netname($sck)
+ [expr {$state?"::ts6::checkop":"::ts6::checkdeop"}] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] [lindex $comd [incr ctr]]
+ firellmbind $sck mode - [format "%s %s%s" [string tolower [lindex $comd 3]] [expr {$state ? "+" : "-"}] $c] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] [lindex $comd [incr ctr]]
} else {
- firellbind $sck mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 3] "" $::netname($sck)
+ [expr {$state?"::ts6::checkop":"::ts6::checkdeop"}] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] [lindex $comd [incr ctr]]
+ firellmbind $sck mode - [format "%s %s%s" [string tolower [lindex $comd 3]] [expr {$state ? "+" : "-"}] $c] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] ""
+# firellmbind $sck mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 3] ""
}
}
}
@@ -461,10 +546,26 @@ proc ::ts6::irc-main {sck} {
set chan [ndaenc [lindex $comd 3]]
if {[string index [lindex $comd 4] 0] == "+"} {
set four 5
+ set ctr 4
if {[string match "*l*" [lindex $comd 4]]} {incr four}
if {[string match "*f*" [lindex $comd 4]]} {incr four}
if {[string match "*j*" [lindex $comd 4]]} {incr four}
if {[string match "*k*" [lindex $comd 4]]} {incr four}
+ foreach {c} [split [lindex $comd 4] {}] {
+ if {$c == "+"} {
+ set state 1
+ } elseif {$c == "-"} {
+ # _NOTREACHED
+ set state 0
+ } elseif {[string match [format "*%s*" $c] [tnda get "netinfo/$::netname($sck)/chmparm"]] || ($state&&[string match [format "*%s*" $c] [tnda get "netinfo/$::netname($sck)/chmpartparm"]])} {
+ [expr {$state?"::ts6::checkop":"::ts6::checkdeop"}] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] [lindex $comd [incr ctr]]
+ firellmbind $sck mode - [format "%s %s%s" [string tolower [lindex $comd 3]] [expr {$state ? "+" : "-"}] $c] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] [lindex $comd [incr ctr]]
+ } else {
+ [expr {$state?"::ts6::checkop":"::ts6::checkdeop"}] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] [lindex $comd [incr ctr]]
+ firellmbind $sck mode - [format "%s %s%s" [string tolower [lindex $comd 3]] [expr {$state ? "+" : "-"}] $c] [lindex $comd 0] [lindex $comd 3] [format "%s%s" [expr {$state?"+":"-"}] $c] ""
+# firellmbind $sck mode "-" [expr {$state ? "+" : "-"}] $c [lindex $comd 0] [lindex $comd 3] ""
+ }
+ }
} {
set four 4
}
@@ -486,11 +587,14 @@ proc ::ts6::irc-main {sck} {
# if {"uo"==$state} {append uo $c}
# }
putcmdlog [format "JOIN %s by nicknumber %s (nick %s, modes %s)" [ndadec $chan] $nick [tnda get "nick/$::netname($sck)/$un"] $uo]
- firellbind $sck join "-" "-" [lindex $comd 3] $un $::netname($sck)
+# firellbind $sck join "-" "-" [lindex $comd 3] $un $::netname($sck)
+ firellmbind $sck join - [format "%s %s!%s@%s" [lindex $comd 3] [% uid2nick $un] [% uid2ident $un] [% uid2host $un]] $un [lindex $comd 3]
tnda set "userchan/$::netname($sck)/$un/$chan" 1
- if {""!=$uo} {tnda set "channels/$::netname($sck)/$chan/modes/$un" $uo
+ if {""!=$uo} {tnda set "channels/$::netname($sck)/$chan/status/$un" $uo
foreach {c} [split $uo {}] {
- firellbind $sck mode "-" + $c $un [lindex $comd 3] $un $::netname($sck)
+ ::ts6::checkop [lindex $comd 0] [lindex $comd 3] [format "%s%s" + $c] $un
+ firellmbind $sck mode - [format "%s +%s" [lindex $comd 3] $c] [lindex $comd 0] [lindex $comd 3] "+$c" $un
+ # firellbind $sck mode "-" + $c $un [lindex $comd 3] $un $::netname($sck)
}
}
}
@@ -498,16 +602,22 @@ proc ::ts6::irc-main {sck} {
}
"PART" {
- firellbind $sck part "-" "-" [lindex $comd 2] [lindex $comd 0] $::netname($sck)
+ set un [lindex $comd 0]
+ firellmbind $sck part - [format "%s %s!%s@%s" [lindex $comd 2] [% uid2nick $un] [% uid2ident $un] [% uid2host $un]] $un [lindex $comd 2] [lindex $comd 3]
+ firellbind $sck part "-" "-" [lindex $comd 2] [lindex $comd 0] [lindex $comd 3]
set chan [string map {/ [} [::base64::encode [string tolower [lindex $comd 2]]]]
tnda set "userchan/$::netname($sck)/[lindex $comd 0]/$chan" 0
+ tnda set "channels/$::netname($sck)/$chan/status/[lindex $comd 0]" ""
}
"KICK" {
- firellbind $sck part "-" "-" [lindex $comd 2] [lindex $comd 3] $::netname($sck)
+ firellbind $sck part "-" "-" [lindex $comd 2] [lindex $comd 3] [lindex $comd 4]
+ set chan [string map {/ [} [::base64::encode [string tolower [lindex $comd 2]]]]
+ tnda set "userchan/$::netname($sck)/[lindex $comd 3]/$chan" 0
}
"NICK" {
+ firellmbind $sck nick "-" [format "%s %s" "*" [lindex $comd 2]] [lindex $comd 0] "*" [lindex $comd 2]
tnda set "nick/$::netname($sck)/[lindex $comd 0]" [lindex $comd 2]
tnda set "ts/$::netname($sck)/[lindex $comd 0]" [lindex $comd 3]
}
@@ -594,6 +704,7 @@ proc ::ts6::irc-main {sck} {
foreach {chan _} [tnda get "userchan/$::netname($sck)/[lindex $comd 0]"] {
firellbind $sck part "-" "-" [ndadec $chan] [lindex $comd 0] $::netname($sck)
tnda set "userchan/$::netname($sck)/[lindex $comd 0]/$chan" 0
+ tnda set "channels/$::netname($sck)/$chan/status/[lindex $comd 0]" ""
}
tnda unset "login/$::netname($sck)/[lindex $comd 0]"
@@ -687,8 +798,8 @@ proc ::ts6::login {sck {osid "42"} {password "link"} {servname "net"} {servernam
putl $sck "SERVER $servername 1 :chary.tcl for Eggdrop and related bots"
putl $sck "SVINFO 6 6 0 :[clock format [clock seconds] -format %s]"
putl $sck ":$num VERSION"
- llbind $sck mode - + ::ts6::checkop
- llbind $sck mode - - ::ts6::checkdeop
+# llbind $sck mode - "* +*" ::ts6::checkop
+# llbind $sck mode - "* -*" ::ts6::checkdeop
chan event $sck readable [list ::ts6::irc-main $sck]
}
@@ -710,6 +821,9 @@ proc ::ts6::intclient2uid {sck nick} {
proc ::ts6::uid2nick {sck u} {
return [tnda get "nick/$::netname($sck)/$u"]
}
+proc ::ts6::uid2rname {sck u} {
+ return [tnda get "rname/$::netname($sck)/$u"]
+}
proc ::ts6::uid2rhost {sck u} {
return [tnda get "rhost/$::netname($sck)/$u"]
}
@@ -735,10 +849,10 @@ proc ::ts6::getts {sck chan} {
return [tnda get "channels/$::netname($sck)/[ndaenc $chan]/ts"]
}
proc ::ts6::getpfx {sck chan nick} {
- return [tnda get "channels/$::netname($sck)/[ndaenc $chan]/modes/[::ts6::nick2uid $netname $nick]"]
+ return [tnda get "channels/$::netname($sck)/[ndaenc $chan]/status/[::ts6::nick2uid $netname $nick]"]
}
proc ::ts6::getupfx {sck chan u} {
- return [tnda get "channels/$::netname($sck)/[ndaenc $chan]/modes/$u"]
+ return [tnda get "channels/$::netname($sck)/[ndaenc $chan]/status/$u"]
}
proc ::ts6::getpfxchars {sck modes} {
set o ""
@@ -754,26 +868,71 @@ proc ::ts6::getcertfp {sck nick} {
return [tnda get "certfps/$::netname($sck)/[::ts6::nick2uid $netname $nick]"]
}
-proc ::ts6::checkop {mc s c p n} {
- set f $s
- set t $c
- if {[tnda get "netinfo/$n/pfxchar/$mc"]==""} {return}
+proc ::ts6::checkop {f t m p} {
+ set n [curctx net]
+ set mc [string index $m 1]
+ puts stdout [format ":%s MODE %s %s %s" $f $t $m $p]
+ if {[tnda get "netinfo/$n/pfxchar/$mc"]==""} {::ts6::handlemode $f $t $m $p;return}
putcmdlog "up $mc $f $t $p $n"
set chan [string map {/ [} [::base64::encode [string tolower $t]]]
- tnda set "channels/$n/$chan/modes/$p" [format {%s%s} [string map [list $mc ""] [tnda get "channels/$n/$chan/modes/$p"]] $mc]
+ tnda set "channels/$n/$chan/status/$p" [format {%s%s} [string map [list $mc ""] [tnda get "channels/$n/$chan/status/$p"]] $mc]
}
-proc ::ts6::checkdeop {mc s c p n} {
- set f $s
- set t $c
- if {[tnda get "netinfo/$n/pfxchar/$mc"]==""} {return}
+proc ::ts6::checkdeop {f t m p} {
+ set n [curctx net]
+ set mc [string index $m 1]
+ puts stdout [format ":%s MODE %s %s %s" $f $t $m $p]
+ if {[tnda get "netinfo/$n/pfxchar/$mc"]==""} {::ts6::handlemode $f $t $m $p;return}
putcmdlog "down $mc $f $t $p $n"
set chan [string map {/ [} [::base64::encode [string tolower $t]]]
- tnda set "channels/$n/$chan/modes/$p" [string map [list $mc ""] [tnda get "channels/$n/$chan/modes/$p"]]
+ tnda set "channels/$n/$chan/status/$p" [string map [list $mc ""] [tnda get "channels/$n/$chan/status/$p"]]
+}
+
+proc ::ts6::handlemode {from t mode parm} {
+ set n [curctx net]
+ set chan [string map {/ [} [::base64::encode [string tolower $t]]]
+ puts stdout [format ":%s MODE %s %s %s" $from $t $mode $parm]
+ if {[string index $mode 0] == "+"} {set state 1} {set state 0}
+ set mc [string index $mode 1]
+ if {$state} {
+ if {[lsearch -exact [split [tnda get "netinfo/$n/chmban"] {}] $mc] == -1} {tnda set "channels/$n/$chan/mode" [format {%s%s} [string map [list $mc ""] [tnda get "channels/$n/$chan/mode"]] $mc]}
+ if {$parm != ""} {
+ if {[lsearch -exact [split [tnda get "netinfo/$n/chmban"] {}] $mc] != -1} {
+ set ban [tnda get "channels/$n/$chan/modes/[ndcenc $mc]"]
+ lappend ban $parm
+ tnda set "channels/$n/$chan/modes/[ndcenc $mc]" $ban
+ } {
+ tnda set "channels/$n/$chan/modes/[ndcenc $mc]" $parm
+ }
+ }
+ } {
+ if {[lsearch -exact [split [tnda get "netinfo/$n/chmban"] {}] $mc] == -1} {tnda set "channels/$n/$chan/mode" [string map [list $mc ""] [tnda get "channels/$n/$chan/mode"]]}
+ if {$parm != "" || [lsearch -exact [split [tnda get "netinfo/$n/chmpartparm"] {}] $mc] != -1} {
+ if {[lsearch -exact [split [tnda get "netinfo/$n/chmban"] {}] $mc] != -1} {
+ set ban [tnda get "channels/$n/$chan/modes/[ndcenc $mc]"]
+ lappend ban $parm
+ tnda set "channels/$n/$chan/modes/[ndcenc $mc]" $ban
+ } {
+ if {$parm == ""} {
+ tnda unset "channels/$n/$chan/modes/[ndcenc $mc]"
+ } {
+ tnda set "channels/$n/$chan/modes/[ndcenc $mc]" $parm
+ }
+ }
+ }
+ }
+ puts stdout [format "Now, the state machine for $t looks like:"]
+ puts stdout [tnda get "channels/$n/$chan"]
+ puts stdout [tnda get "userchan/$n/$chan"]
}
-proc ::ts6::formprefix {sck nick} {
- return [format ":%s " $nick]
+proc ::ts6::putnow {sck intclient msg} {
+ if {$intclient != ""} {
+ set nick [% intclient2uid $intclient]
+ } {
+ set nick $sid($sck)
+ }
+ putl $sck [format ":%s %s" $nick $msg]
}
proc ::ts6::uid2intclient {sck u} {
return [tnda get "intclient/$::netname($sck)/$u"]
diff --git a/core/4000-eggcom.tcl b/core/4000-eggcom.tcl
@@ -1,8 +1,110 @@
#source chanserv.conf
-#llbind [curctx sock] mode "-" "+" bitchopcheck
-#llbind [curctx sock] mode "-" "-" protectopcheck
-#llbind [curctx sock] join "-" "-" autoopcheck
+#more thanks to fireegl
+
+proc SetUdefDefaults {{name {*}}} {
+ global UdefDefaults
+ foreach udef [array names UdefDefaults $name] {
+ #dict for {key value} $::database(channels) {
+ # if {![dict exists $value $udef]} {
+ # dbase set eggcompat [curctx net] channels $key $value $udef $UdefDefaults($udef)
+ # }
+ #}
+ foreach channel [channels] {
+ if {[catch { channel get $channel $udef }]} {
+ # channel set $channel $udef $UdefDefaults($udef)
+ dbase set eggcompat [curctx net] channels [string toupper $channel] $udef $UdefDefaults($udef)
+ }
+ }
+ }
+}
+
+# Defines a new udef:
+proc setudef {type name {default {}}} {
+ # Store the default for this udef:
+ global UdefDefaults
+ set name [string tolower $name]
+ switch -- $type {
+ {flag} { set UdefDefaults($name) [string is true -strict $default] }
+ {int} { if {$default != {}} { set UdefDefaults($name) $default } else { set UdefDefaults($name) 0 } }
+ {str} - {list} { set UdefDefaults($name) $default }
+ {default} { return -code error "[mc {Invalid udef type: %s} $type]" }
+ }
+ # Store the udef itself:
+ global Udefs
+ set Udefs($name) $type
+ # "UDEF: $name (${type}) defined. Default: $UdefDefaults($name)"
+ # Apply the default to all channels that don't already have it set:
+ SetUdefDefaults $name
+}
+
+# getudefs <flag/int/str>
+# Returns: a list of user defined channel settings of the given type,
+# or all of them if no type is given.
+proc getudefs {{type {}}} {
+ # Note/FixMe: Eggdrop probably errors if $type is invalid.
+ # This is not a compatibility problem though
+ global Udefs
+ set list [list]
+ # Note/FixMe: We could also create a new array, called UdefTypes, which looks like (for example):
+ # UdefTypes(flag) "autoop enforcebans ..."
+ # That way we don't need a foreach here, and could just return the list..
+ foreach u [array names Udefs] {
+ if {$type eq {} || $type eq $Udefs($u)} {
+ lappend list $u
+ }
+ }
+ return $list
+}
+
+# renudef <flag/int> <oldname> <newname>
+# Description: renames a user defined channel flag or integer setting.
+# Returns: nothing
+# Module: channels
+proc renudef {type oldname newname} {
+ global Udefs
+ if {[info exists Udefs($newname)]} {return -1}
+ if {[info exists Udefs($oldname)] && [string equal -nocase $Udefs($oldname) $type]} {
+ dict for {key value} $::database(channels) {
+ if {[dict exists $value $oldname]} {
+ dbase set eggcompat [curctx net] channels $key $newname [dbase get eggcompat [curctx net] channels $key $oldname]
+ dbase unset eggcompat [curctx net] channels $key $oldname
+ }
+ }
+ set Udefs($newname) $Udefs($oldname)
+ unset Udefs($oldname)
+ global UdefDefaults
+ set UdefDefaults($newname) $UdefDefaults($oldname)
+ unset Udefs($oldname)
+ return 1
+ }
+ return 0
+}
+
+# deludef <flag/int> <name>
+# Description: deletes a user defined channel flag or integer setting.
+# Returns: nothing
+# Module: channels
+# Proc written by Papillon@EFNet.
+# FixMe: This proc is untested and unmodified from what he sent me. Looks broken. =P
+proc deludef {type name} {
+ global Udefs
+ if {[info exists Udefs($oldname)] && [string equal -nocase $Udefs($oldname) $type]} {
+ dict for {key value} $::database(channels) { if {[dict exists $value $oldname]} { dbase unset eggcompat [curctx net] channels $key $oldname } }
+ unset Udefs($oldname)
+ global UdefDefaults
+ unset Udefs($oldname)
+ return 1
+ }
+ return 0
+}
+
+# Returns 1 if it's a valid (existing) name for a udef, or 0 if it's not:
+proc validudef {name} {
+ global Udefs
+ info exists Udefs($name)
+}
+
proc protectopcheck {mc f t p} {
if {"o"==$mc && ![channel get $t protectop]} {return}
@@ -40,6 +142,10 @@ proc autoopcheck {c f} {
tcs:opcheck $c $f $globe $auto
}
+proc unixtime {} {
+ return [clock format [clock seconds] -format %s]
+}
+
proc tcs:opcheck {c f {globe 0} {auto nmolv}} {
# puts stdout "$c $f"
if {[matchattr [tnda get "login/[curctx net]/$f"] |k $c]} {
@@ -140,6 +246,8 @@ proc bitchopcheck {mc ftp} {
}
}
+#proc every {milliseconds script} {$script; after $milliseconds [every $milliseconds $script]}
+#every 1000 [list firellmbind - time [clock format [clock seconds] -format "%M %H %d %m %Y"]]
proc utimer {seconds tcl-command} {after [expr $seconds * 1000] ${tcl-command}}
proc timer {minutes tcl-command} {after [expr $minutes * 60 * 1000] ${tcl-command}}
proc utimers {} {set t {}; foreach a [after info] {lappend t "0 [lindex [after info $a] 0] $a"}; return $t}
@@ -149,9 +257,6 @@ proc killutimer id {return [after cancel $id]}
proc isbotnick {n} {return [expr {$n == $::globuctx}]}
-set globctx ""
-set globuctx ""
-
proc setctx {ctx} {
global globctx
if {[catch [list set ::sock($ctx)] erre] > 0} {return} ; # silently crap out
@@ -160,8 +265,12 @@ proc setctx {ctx} {
proc setuctx {ctx} {
global globuctx
- if {[% nick2uid $ctx] == ""} {return} ; # silently crap out
- set globuctx [% uid2intclient [% nick2uid $ctx]]
+ if {[% nick2uid $ctx] == "" && !($ctx == "")} {return} ; # silently crap out
+ if {$ctx == ""} {
+ set globuctx ""
+ } {
+ set globuctx [% uid2intclient [% nick2uid $ctx]]
+ }
}
proc % {c args} {
@@ -170,7 +279,15 @@ proc % {c args} {
uplevel 1 $ul
}
-proc curctx {{type .net}} {
+proc @@ {c args} {
+ set ul [list [curctx proto] $c [curctx sock] [curctx unum]]
+ foreach {a} $args {lappend ul $a}
+ uplevel 1 $ul
+}
+
+proc getctx {{type net}} {curctx $type}
+
+proc curctx {{type net}} {
if {$::globctx == ""} {return ""}
switch -exact -- [format ".%s" [string tolower $type]] {
.sock {
@@ -194,26 +311,29 @@ proc curctx {{type .net}} {
}
}
+set globctx ""
+set globuctx ""
+
foreach {pname} [list putserv puthelp putquick putnow] {
proc $pname {msg} {
- puts [curctx sock] [[curctx proto] formprefix [curctx sock] $msg]
+ if {[curctx unum] != ""} {
+ % putnow [curctx unum] $msg
+ } {
+ % putnow "" $msg
+ }
}
}
-proc msgmt {from msg} {
- set handle [lindex $msg 0]
- set attr [lindex $msg 1]
- set chan [lindex $msg 2]
- [curctx proto] notice [curctx sock] 77 $from "$handle $attr $chan Matchattr result: [matchattr $handle $attr $chan]"
+proc pushmode {mode args} {
+ @@ putmode $mode [join $args " "]
}
-#llbind [curctx sock] msg 77 "matchattr" msgmt
-
proc matchattr {handle attr {chan "*"}} {
set handle [string tolower $handle]
if {-1!=[string first "&" $attr]} {set and 1} {set and 0}
set gattr [lindex [split $attr "&|"] 0]
set cattr [lindex [split $attr "&|"] 1]
+ if {$handle == "" || $handle == "*"} {return [expr {(($gattr==$cattr||$cattr=="") && $gattr=="-")?1:0}]};# dump
set isattrg 0
foreach {c} [split [nda get "eggcompat/[curctx net]/attrs/global/$handle"] {}] {
foreach {k} [split $gattr {}] {
@@ -272,37 +392,195 @@ proc chattr {handle attr {chan "*"}} {
}
proc channels {} {
- foreach {chan _} [nda get "regchan"] {
+ set ret [list]
+ foreach {chan _} [nda get "eggcompat/[curctx net]/channels"] {
lappend ret $chan
}
return $ret
}
-namespace eval channel {
- proc ::channel::get {chan flag} {
- if {[::set enda [nda get "eggcompat/[curctx net]/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flag]]"]]!=""} {return $enda} {return 0}
- }
- proc ::channel::set {chan flags} {
- if {[llength $flags] != 1} {
- foreach {flag} $flags {
- ::set bit [string index $flag 0]
- if {$bit=="+"} {::set bitt 1} {::set bitt 0}
- ::set flag [string range $flag 1 end]
- nda set "eggcompat/[curctx net]/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flag]]" $bitt
+proc mc {form args} {
+ format $form {*}$args
+}
+
+#TODO: make this a namespace ensemble
+
+# hey, thanks fireegl
+proc channel {command {channel {}} args} {
+ # Note: Follow RFC 2812 regarding "2.2 Character codes", http://tools.ietf.org/html/rfc2812
+ # Note that RFC 2812 gets the case of ^ and ~ backwards. ^ = uppercase ~ = lowercase
+ # We should probably not follow the RFC in this instance and instead use the correct case for those two characters.
+ # []\^ (uppers) == {}|~ (lowers)
+ set upperchannel [string toupper $channel]
+ global database
+ switch -- [set command [string tolower $command]] {
+ {add} {
+ set args [lassign [callchannel $command $channel {*}$args] command channel]
+ # Add the channel to the database:
+ dbase set eggcompat [curctx net] channels $upperchannel name $channel
+ SetUdefDefaults
+ # Call ourself again to set the options:
+ if {[llength $args]} { channel set $channel {*}$args }
+ return {}
+ }
+ {set} {
+ if {![dict exists [dbase get eggcompat [curctx net] channels] $upperchannel]} { return -code error "[mc {Invalid Channel: %s} $channel]" }
+ # In the case of "set", $args is already in the form we can use.
+ set setnext 0
+ foreach o $args {
+ if {$setnext} {
+ set setnext 0
+ switch -- $type {
+ {int} - {integer} {
+ # Note, settings such as flood-chan are treated as int's. Hence the need for using split here:
+ lassign [callchannel $command $channel $type $name [split $o {:{ }}]] command channel type name o
+ dbase set eggcompat [curctx net] channels $upperchannel $name $o
+ }
+ {str} - {string} {
+ lassign [callchannel $command $channel $type $name $o] command channel type name o
+ dbase set eggcompat [curctx net] channels $upperchannel $name $o
+ }
+ {list} - {lappend} {
+ lassign [callchannel $command $channel $type $name $o] command channel type name o
+ database channels lappend $upperchannel $name $o
+ }
+ {flag} {
+ # This is so we can support flags being set like:
+ # [channel set #channel bitch +]
+ # or: [channel set #channel revenge 1]
+ # The old way is still supported though. (see below)
+ switch -- $o {
+ {+} { set o 1 }
+ {-} { set o 0 }
+ {default} { set o [string is true -strict $o] }
+ }
+ lassign [callchannel $command $channel $type $name $o] command channel type name o
+ dbase set eggcompat [curctx net] channels $upperchannel $name $o
+ }
+ {unknown} - {default} {
+ return -code error "[mc {Invalid channel option: %s} $name]"
+ }
+ }
+ } elseif {$o != {}} {
+ switch -- [set type [UdefType [set name [string trimleft $o {+-}]]]] {
+ {flag} {
+ switch -- [string index $o 0] {
+ {+} {
+ lassign [callchannel $command $channel $type $name 1] command channel type name o
+ dbase set eggcompat [curctx net] channels $upperchannel $name $o
+ }
+ {-} {
+ lassign [callchannel $command $channel $type $name 0] command channel type name o
+ dbase set eggcompat [curctx net] channels $upperchannel $name $o
+ }
+ {default} {
+ # They must want to set it using a second arg...
+ set setnext 1
+ }
+ }
+ }
+ {int} - {str} - {list} - {integer} - {string} { set setnext 1 }
+ {unknown} - {default} { return -code error "[mc {Illegal channel option: %s} $name]" }
+ }
+ }
+ }
+ }
+ {info} {
+ # COMPATIBILITY WARNING: Because Eggdrop doesn't return the info in any documented or understandable order,
+ # 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.
+ if {[dict exists [dbase get eggcompat [curctx net] channels] $upperchannel]} {
+ dict get [dbase get eggcompat [curctx net] channels] $upperchannel
+ } else {
+ return -code error "[mc {No such channel record: %s} $channel]"
+ }
+ }
+ {get} {
+ if {[dict exists [dbase get eggcompat [curctx net] channels] $upperchannel]} {
+ if {[dict exists [dbase get eggcompat [curctx net] channels] $upperchannel {*}$args]} {
+ dict get [dbase get eggcompat [curctx net] channels] $upperchannel {*}$args
+ } else {
+ return -code error "[mc {Unknown channel setting: %s} $args]"
+ }
+ } else {
+ return -code error "[mc {No such channel record: %s} $channel]"
+ }
+ }
+ {list} {
+ set list [list]
+ dict for {key value} [dbase get eggcompat [curctx net] channels] { lappend list [dict get $value name] }
+ return $list
+ }
+ {count} { dict size [dbase get eggcompat [curctx net] channels] }
+ {remove} - {rem} - {delete} - {del} {
+ if {[dict exists [dbase get eggcompat [curctx net] channels] $upperchannel]} {
+ set args [lassign [callchannel $command $channel {*}$args] $command $channel]
+ dbase unset eggcompat [curctx net] channels $upperchannel
+ } else {
+ return -code error "[mc {No such channel record: %s} $channel]"
+ }
+ }
+ {exists} - {exist} {
+ if {[dict exists [dbase get eggcompat [curctx net] channels] $upperchannel]} {
+ return 1
+ } else {
+ return 0
}
- } {
- ::set bit [string index $flags 0]
- if {$bit=="+"} {::set bitt 1} {::set bitt 0}
- ::set flag [string range $flags 1 end]
- nda set "eggcompat/[curctx net]/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flags]]" $bitt
}
+ {default} { return -code error "[mc {Unknown channel sub-command "%s".} $command]" }
}
- namespace export *
- namespace ensemble create
}
+# er, no ellenor, that's not how you do that
+#namespace eval channel {
+# proc ::channel::get {chan flag} {
+# if {[::set enda [nda get "eggcompat/[curctx net]/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flag]]"]]!=""} {return $enda} {return 0}
+# }
+# proc ::channel::set {chan flags} {
+# if {[llength $flags] != 1} {
+# foreach {flag} $flags {
+# ::set bit [string index $flag 0]
+# if {$bit=="+"} {::set bitt 1} {::set bitt 0}
+# ::set flag [string range $flag 1 end]
+# nda set "eggcompat/[curctx net]/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flag]]" $bitt
+# }
+# } {
+# ::set bit [string index $flags 0]
+# if {$bit=="+"} {::set bitt 1} {::set bitt 0}
+# ::set flag [string range $flags 1 end]
+# nda set "eggcompat/[curctx net]/chansets/[ndaenc $chan]/[ndaenc [string map {+ ""} $flags]]" $bitt
+# }
+# }
+# namespace export *
+# namespace ensemble create
+#}
+
proc validuser {n} {
- if {""==[nda get "usernames/$n"]} {return 0} {return 1}
+ if {""==[dbase get usernames [curctx net] $n]} {return 0} {return 1}
+}
+
+proc userlist {} {
+ set r [list]
+ foreach {u _} [dbase get usernames [curctx net]] {
+ lappend r $u
+ }
+ return $r
+}
+
+proc deluser {username} {
+ if {![validuser $username]} {return 0}
+ dbase unset usernames [curctx net] $username
+}
+
+proc adduser {username {hostmask ""}} {
+ if {[validuser $username]} {return 0}
+ if {$hostmask != ""} {set moretodo 1} {set moretodo 0}
+ while {0!=$moretodo} {
+ set bindnum [rand 1 10000000]
+ if {[dbase get usernames [curctx net] $username]!=""} {} {set moretodo 0}
+ }
+ if {$hostmask != ""} {dbase set usernames [curctx net] $username hostmasks $bindnum $hostmask}
+ dbase set usernames [curctx net] $username reg 1
+ return 1
}
#llbind [curctx sock] msg 77 "chanset" msgchanset
@@ -351,8 +629,8 @@ proc msgchattr {from msg} {
}
proc nick2hand {nick} {
- foreach {uid nic} [tnda get "nick"] {
- if {$nick == $nic} {return [tnda get "login/[curctx net]/$uid"]}
+ foreach {uid nic} [tnda get "nick/[curctx net]"] {
+ if {[string tolower $nick] == [string tolower $nic]} {return [tnda get "login/[curctx net]/$uid"]}
}
}
@@ -361,11 +639,18 @@ proc uid2hand {uid} {
}
proc getuser {nick datafield {dataval "body"}} {
- return [nda get "usernames/$nick/setuser/[ndaenc $datafield]/[ndaenc $dataval]"]
+ return [dbase get usernames [curctx net] $nick setuser [ndaenc $datafield] [ndaenc $dataval]]
}
-proc setuser {nick datafield {dataval "body"} val} {
- return [nda set "usernames/$nick/setuser/[ndaenc $datafield]/[ndaenc $dataval]" $val]
+proc setuser {nick datafield {dataval "body"} {val {}}} {
+ puts stdout "$nick $datafield $dataval $val"
+ if {[string tolower $datafield] == "pass"} {usetpass $nick $dataval}
+ if {[string tolower $datafield] == "hosts"} {addhost $nick $dataval}
+ if {$val == {} && [string tolower $datafield] != "xtra"} {
+ return [dbase set usernames [curctx net] $nick setuser [ndaenc $datafield] $dataval]
+ } {
+ return [dbase set usernames [curctx net] $nick setuser [ndaenc $datafield] [ndaenc $dataval] $val]
+ }
}
proc msgxtra {from msg} {
@@ -406,6 +691,10 @@ proc operHasAllPrivileges {n i p} {
return 1
}
+foreach {pn} [list botisop botisvoice botishalfop] {
+ proc $pn {args} {return 1}
+}
+
proc isop {chan id} {
return [ismode $chan $id o]
}
@@ -418,6 +707,10 @@ proc ishalf {chan id} {
return [ismode $chan $id h]
}
+proc ishalfop {chan id} {
+ return [ismode $chan $id h]
+}
+
proc ismode {chan id mode} {
if {[string first $mode [[curctx proto] getupfx [curctx sock] $chan $id]] != -1} {return 1} {return 0}
}
@@ -428,17 +721,97 @@ proc ismodebutnot {chan id mode} {
# rules are odd. you should store the bind return in a variable to unbind it.
# flags aren't part of the bind define.
+set nonusertypes [list conn create encap evnt join login mark mode part pub notc quit topic pubm nick ctcp ctcr]
+set lowertypes [list notc ctcp ctcr pub msg]
+proc ibind {type flag text script} {
+ set ctxsock [curctx sock]
+ set ctxuser [curctx unum]
+ if {[lsearch -exact $::nonusertypes [string tolower $type]] != -1} {set binduser "-"} {set binduser $ctxuser}
+ if {[lsearch -exact $::lowertypes [string tolower $type]] != -1} {set text [string tolower $text]}
+ return [llbind $ctxsock $type $binduser $text [list setupthenrun [list [curctx net] $ctxsock $type $ctxuser $flag $text] $script]]
+}
+
proc bind {type flag text script} {
set ctxsock [curctx sock]
set ctxuser [curctx unum]
- return [llbind $ctxsock $type $ctxuser [list matchthenrun $ctxsock $ctxuser $flag $script]]
+ if {[lsearch -exact $::nonusertypes [string tolower $type]] != -1} {set binduser "-"} {set binduser $ctxuser}
+ if {[lsearch -exact $::lowertypes [string tolower $type]] != -1} {set text [string tolower $text]}
+ puts stdout [list llbind $ctxsock $type $binduser $text [list isetupthenrun [list [curctx net] $ctxsock $type $ctxuser $flag $text] $script]]
+ return [llbind $ctxsock $type $binduser $text [list isetupthenrun [list [curctx net] $ctxsock $type $ctxuser $flag $text] $script]]
}
-proc matchthenrun {sock user flags script args} {
- #setctx $sock
+proc unbind {type flag text {scrip ""}} {
+ set ctxsock [curctx sock]
+ set ctxuser [curctx unum]
+ if {[lsearch -exact $::nonusertypes [string tolower $type]] != -1} {set binduser "-"} {set binduser $ctxuser}
+ if {[lsearch -exact $::lowertypes [string tolower $type]] != -1} {set text [string tolower $text]}
+ set binds [tnda get "llbinds/[curctx net]/$type/$binduser/[ndcenc $text]"]
+ set killids [list]
+ foreach {id script} $binds {
+ if {[lindex $script 0] == "isetupthenrun" || [lindex $script 0] == "setupthenrun"} {
+ set opts [lindex $script 1]
+ lassign $opts netctx sockctx otype userctx flags otext
+ if {$userctx == $ctxuser && $otype == $type && $text == $otext && ($scrip == "" || $scrip == $script)} {lappend killids $id}
+ }
+ }
+ foreach {id} $killids {
+ unllbind $ctxsock $type $binduser $text $id
+ }
+}
+
+proc setupthenrun {opts script args} {
+ lassign $opts netctx sockctx type userctx flags text
+ setctx $netctx
+ setuctx [% uid2nick $userctx]
foreach {a} $args {
lappend script $a
}
-# matchattr [uid2hand $user] $flags
eval $script
}
+
+proc isetupthenrun {opts script args} {
+ lassign $opts netctx sockctx type userctx flags text
+ global globuctx
+ if {-1!=[lsearch -exact [list] $type]} {set chan [lindex $args 1]} {set chan "*"}
+ setctx $netctx
+ set globuctx $userctx
+ # "nick uhost hand"
+ lappend script [% uid2nick [lindex $args 0]]
+ lappend script [format "%s@%s" [% uid2ident [lindex $args 0]] [% uid2host [lindex $args 0]]]
+ lappend script [uid2hand [lindex $args 0]]
+ if {![set output [matchattr [uid2hand [lindex $args 0]] $flags $chan]]} {puts stdout "execution denied of $script - matchattr is $output";return}
+ foreach {a} [lrange $args 1 end] {
+ lappend script $a
+ }
+ puts stdout "$script"
+ eval $script
+}
+
+foreach {def} {
+protectop protecthalfop protectvoice operit autoop autohalfop autovoice bitch halfbitch voicebitch inactive
+} {
+setudef flag $def
+}
+
+proc onchan {nick chan} {
+ set uid [% nick2uid $nick]
+ set ndacname [ndaenc $chan]
+ if {[tnda get "userchan/[curctx net]/$uid/$ndacname"] == "1"} {return 1} {return 0}
+}
+
+proc alg {{ha ""}} {
+ if {$ha == ""} {return "SSHA256"} {return $ha}
+}
+
+proc passwdok {n p} {
+ set isp [dbase get usernames [curctx net] $n pass]
+ set chkp [pwhash.[alg [lindex [split $isp "/"] 0]] $p]
+ if {$isp==""} {return 1}
+ if {$chkp == $isp} {return 1}
+ return 0
+}
+
+proc usetpass {n p} {
+ set chkp [pwhash.SSHA256 $p]
+ dbase get usernames [curctx net] $n pass $chkp
+}
diff --git a/main.tcl b/main.tcl
@@ -8,7 +8,7 @@ package require sha1
source b64.tcl
-proc pwhash {pass} {
+proc pwhash.SHA1 {pass} {
global b64
set hash [::sha1::sha1 -hex $pass]
return "SHA1/$hash"
@@ -89,7 +89,19 @@ set nd [readbfile services.db]
set globwd [pwd]
set gettext [list]
+proc outputbotnick {var no oper} {
+ upvar $var v
+ set v [curctx user]
+}
+
+proc showcontexts {var no oper} {
+ upvar $var v
+# puts stdout "curctx is [curctx unum]@[curctx net]"
+}
+
trace add variable nd [list write unset] [list save.db [format "%s/%s" [pwd] services.db]]
+trace add variable botnick [list read] [list outputbotnick]
+trace add variable globuctx [list read write] [list showcontexts]
#::tie::tie nd file services.db
diff --git a/modules/chanserv.tcl b/modules/chanserv.tcl
@@ -0,0 +1,66 @@
+# ChanServ for TclServ
+# 2018 09 28
+# Copyright ©2018CE AsterIRC
+# All rights reserved. This file is under the GNU GPL; see
+# LICENSE in the project root for information.
+
+# -----------------//----------------
+# ChanServ for TclServ.
+# Version 0.9 - released some time in 2017, ChanServ 0.9 was for a time
+# AsterIRC's only channels service. It was pretty horrendous. Nevertheless,
+# it did its job valiantly.
+# This version's just gonna be a custom Tcl runner.
+
+blocktnd chanserv
+
+llbind - evnt - alive chanserv.connect
+set numversion 1
+
+proc chanserv.connect {arg} {
+ puts stdout [format "there are %s chanserv blocks" [set blocks [tnda get "openconf/[ndcenc chanserv]/blocks"]]]
+ for {set i 1} {$i < ($blocks + 1)} {incr i} {
+ if {[string tolower [lindex [tnda get [format "openconf/%s/hdr%s" [ndcenc chanserv] $i]] 0]] != [string tolower $arg]} {continue}
+ 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]]]
+ }
+}
+
+proc cs.confighandler {servicename defdbname headline block} {
+ set net [lindex $headline 0]
+ set nsock $::sock($net)
+ dictassign $block nick nick ident ident host host modes modes realname realname
+ if {[llength [tnda get "service/$net/$servicename/config"]] != 0} {return -code error "<$servicename> O damn, I'm already loaded for $net!"}
+ tnda set "service/$net/$servicename/config" $block
+ if {[tnda get "service/$net/$servicename/config/dbname"] == ""} {tnda set "service/$net/$servicename/dbname" $defdbname}
+ setctx $net
+ if {[% intclient2uid [tnda get "service/$net/$servicename/ourid"]] == ""} {% sendUid $nick $ident $host $host [set ourid [% getfreeuid]] [expr {($realname == "") ? "* $servicename *" : $realname}] $modes; set connected "Connected"} {set connected "Already connected"}
+ set ouroid [tnda get "service/$net/$servicename/ourid"]
+ if {[info exists ourid]} {tnda set "service/$net/$servicename/ourid" $ourid} {set ourid [tnda get "service/$net/$servicename/ourid"]}
+ puts stdout [format "%s for %s: %s %s %s" $connected $net $nick $ident $host]
+ setuctx $nick
+}
+
+proc chanserv.oneintro {headline block} {
+ cs.confighandler chanserv chanserv $headline $block
+ dictassign $block config eggconf nick nick
+
+ bind time -|- "?0 * * * *" checkchannels
+ bind time -|- "?5 * * * *" checkchannels
+ bind time -|- "0 * * * *" checkchannels
+ bind time -|- "5 * * * *" checkchannels
+ setuctx $nick
+ mysrc $eggconf
+}
+
+proc checkchannels {a b c d e} {
+ set chans [channels]
+ foreach {c} $chans {
+ set inactive [channel get $c inactive]
+ if {!$inactive} {@@ putjoin $c}
+ }
+ foreach {chan on} [tnda get "userchan/[curctx net]/[curctx uid]"] {
+ if {$on} {
+ set inactive [channel get $c inactive]
+ if {$inactive} {@@ part $c "This channel is not active"}
+ }
+ }
+}
diff --git a/modules/debugserv.tcl b/modules/debugserv.tcl
@@ -40,7 +40,8 @@ proc debugserv.oneintro {headline block} {
set net [lindex $headline 0]
set nsock $::sock($net)
dictassign $block logchan logchan nick nick ident ident host host modes modes realname realname rehashprivs rehashprivs idcommand nspass nickserv nickserv nsserv nsserv \
- dnsconf dnsconf
+ dnsconf dnsconf dbname dbname
+ if {$dbname == ""} {set dbname debugserv}
tnda set "debugserv/$net/rehashprivs" $rehashprivs
tnda set "debugserv/$net/logchan" $logchan
#tnda set "debugserv/$net/nspass" $nspass
@@ -64,7 +65,7 @@ proc debugserv.oneintro {headline block} {
if {[string first [debugserv.find6sid $net $nsserv] [% nick2uid $nickserv]] == 0} {
% privmsg $ourid $nickserv $nspass
} {
- % privmsg $ourid $logchan [gettext debugserv.impostornickserv $nickserv [$::nettype($net) nick2uid $n $nickserv] $nsserv [debugserv.find6sid $net $nsserv]]
+ % privmsg $ourid $logchan [gettext debugserv.impostornickserv $nickserv [% nick2uid $nickserv] $nsserv [debugserv.find6sid $net $nsserv]]
}
}
after 650 % putjoin $ourid $logchan
diff --git a/modules/quoteserv.tcl b/modules/quoteserv.tcl
@@ -49,7 +49,7 @@ proc quoteserv.oneintro {headline block} {
if {[string first [quoteserv.find6sid $net $nsserv] [% nick2uid $nickserv]] == 0} {
% privmsg $ourid $nickserv $nspass
} {
- % privmsg $ourid $logchan [gettext quoteserv.impostornickserv $nickserv [$::nettype($net) nick2uid $n $nickserv] $nsserv [quoteserv.find6sid $net $nsserv]]
+ % privmsg $ourid $logchan [gettext quoteserv.impostornickserv $nickserv [nick2uid $nickserv] $nsserv [quoteserv.find6sid $net $nsserv]]
}
}
after 650 % putjoin $ourid $logchan
@@ -130,14 +130,18 @@ proc quoteservdo {n chan from m} {
set ndacname [string map {/ [} [::base64::encode [string tolower [lindex $opara 0]]]]
set para [lrange $para 1 end]
if {![quoteservenabled [lindex $opara 0]]} {
- % privmsg [tnda get "quoteserv/[curctx net]/ourid"] $targ [gettext quoteserv.disabled $chan]
- return
- }
+ set disabled 1
+ } { set disabled 0}
} else {
set targ $chan
+ set disabled 0
}
switch -nocase -glob -- $subcmd {
"se*" {
+ if {$disabled} {
+ % privmsg [tnda get "quoteserv/[curctx net]/ourid"] $targ [gettext quoteserv.disabled $chan]
+ return
+ }
set ptn [format "*%s*" [join $para " "]]
set qts [quotesearch $chan $ptn]
if {[llength $qts] != 0} {
@@ -146,7 +150,11 @@ proc quoteservdo {n chan from m} {
% privmsg [tnda get "quoteserv/[curctx net]/ourid"] $targ [gettext quoteserv.noresults]
}
}
- "vi*1st*ma*" {
+ "vi*1*ma*" {
+ if {$disabled} {
+ % privmsg [tnda get "quoteserv/[curctx net]/ourid"] $targ [gettext quoteserv.disabled $chan]
+ return
+ }
set ptn [format "*%s*" [join $para " "]]
set qts [quotesearch $chan $ptn]
if {[llength $qts]} {
@@ -160,6 +168,10 @@ proc quoteservdo {n chan from m} {
}
}
"ad*" {
+ if {$disabled} {
+ % privmsg [tnda get "quoteserv/[curctx net]/ourid"] $targ [gettext quoteserv.disabled $chan]
+ return
+ }
set qt [join $para " "]
set qtn [expr {([llength [nda get "quoteserv/[curctx net]/quotes/$ndacname"]]/6)+1}]
nda set "quoteserv/[curctx net]/quotes/$ndacname/q$qtn" $qt
@@ -180,6 +192,10 @@ proc quoteservdo {n chan from m} {
}
}
"de*" {
+ if {$disabled} {
+ % privmsg [tnda get "quoteserv/[curctx net]/ourid"] $targ [gettext quoteserv.disabled $chan]
+ return
+ }
set qtn [lindex $para 0]
if {![string is integer $qtn]} {
% privmsg [tnda get "quoteserv/[curctx net]/ourid"] $targ [gettext quoteserv.usevalidint]
@@ -210,7 +226,7 @@ proc quoteservdo {n chan from m} {
}
}
"jo*" {
- set tochan [lindex $para 0]
+ set tochan $chan
if {[ismodebutnot $tochan $from v] || [operHasPrivilege [curctx net] $from [tnda get "quoteserv/[curctx net]/operflags"]]} {
quoteservjoin $tochan
} {
@@ -218,6 +234,10 @@ proc quoteservdo {n chan from m} {
}
}
"goa*" - "pa*" - "le*" {
+ if {$disabled} {
+ % privmsg [tnda get "quoteserv/[curctx net]/ourid"] $targ [gettext quoteserv.disabled $chan]
+ return
+ }
set tochan [lindex $para 0]
if {[ismodebutnot $tochan $from v] || [operHasPrivilege [curctx net] $from [tnda get "quoteserv/[curctx net]/operflags"]]} {
quoteservpart $tochan [format "(%s) %s!%s@%s" [tnda get "login/[curctx net]/$from"] [% uid2nick $from] [% uid2ident $from] [% uid2host $from]]
@@ -226,6 +246,10 @@ proc quoteservdo {n chan from m} {
}
}
"vi*" {
+ if {$disabled} {
+ % privmsg [tnda get "quoteserv/[curctx net]/ourid"] $targ [gettext quoteserv.disabled $chan]
+ return
+ }
set qtn [lindex $para 0]
if {![string is integer $qtn]} {% privmsg [tnda get "quoteserv/[curctx net]/ourid"] $targ [gettext quoteserv.usevalidint]}
set qt [nda get "quoteserv/[curctx net]/quotes/$ndacname/q$qtn"]
diff --git a/modules/weather.tcl b/modules/weather.tcl
@@ -49,7 +49,7 @@ proc weatherserv.oneintro {headline block} {
if {[string first [weatherserv.find6sid $net $nsserv] [% nick2uid $nickserv]] == 0} {
% privmsg $ourid $nickserv $nspass
} {
- % privmsg $ourid $logchan [gettext weatherserv.impostornickserv $nickserv [$::nettype($net) nick2uid $n $nickserv] $nsserv [weatherserv.find6sid $net $nsserv]]
+ % privmsg $ourid $logchan [gettext weatherserv.impostornickserv $nickserv [nick2uid $nickserv] $nsserv [weatherserv.find6sid $net $nsserv]]
}
}
after 650 [list % putjoin $ourid $logchan]
diff --git a/nda.tcl b/nda.tcl
@@ -66,6 +66,30 @@ namespace eval nda {
namespace ensemble create
}
+# alt API:
+namespace eval dbase {
+ proc ::dbase::get {args} {
+ global nd
+ if {[info exists nd] && ![catch {dict get $nd {*}$args} eee]} {return $eee} {return ""}
+ }
+
+ proc ::dbase::set {args} {
+ global nd
+ if {[lindex $args 1] == ""} {
+ return ""
+ }
+ return [dict set nd {*}$args]
+ }
+
+ proc ::dbase::unset {args} {
+ global nd
+ return [dict unset nd {*}$args]
+ }
+
+ namespace export *
+ namespace ensemble create
+}
+
namespace eval tnda {
proc ::tnda::get {path} {
global tnd
diff --git a/services.conf.example b/services.conf.example
@@ -7,6 +7,7 @@ network "pand" "services.invalid" {
pass link
proto ts6
prefix {*~&@%+ yqaohv}
+ isupport "CHANMODES=beIM,k,flj,CDFQRTXcgimnprstu CHANLIMIT=&'#+\"1234567890:100 PREFIX=(yqaohv)*~&@%+ MAXLIST=beIM:100 MODES=4 NETWORK=Pandersticks STATUSMSG=@ PRIVILEGEMSG=@,.,qaohv SJOIN=(yqaohv)*~&@%+"
}
#old;
