namespace eval tentacle {
# users and chans must be all lowercase
set users [list "pegasus"]
set chans [list "#laeradchat"]
set host "laerad.net"
set port "40000"
set user "IRC"
set pass "REDACTED"
proc connectSock { } {
variable sock
variable host
variable port
variable user
variable pass
if { [info exists sock] } { return }
# without -async, sock is never set
# thus, we never need to unset or set it to a null string.
# with -async, we get no error here, so catch never fires.
# instead, the readable fileevent will catch the error.
set sock [socket -async $host $port]
fconfigure $sock -translation auto -blocking 0 -buffering line
fileevent $sock readable [namespace code readSock]
# possible but unlikely recursion problem. tail call just in case.
return [writeSock "/login $user $pass"]
}
proc writeSock { text } {
variable sock
# possible but unlikely recursion problem. check semaphore just in case.
if { ![info exists sock] } { connectSock }
if { [catch {puts $sock "$text\r\n"} err] } {
putlog "\[JF\] Error writing ($err), connection closed."
close $sock
return [unset sock]
}
return [flush $sock]
}
proc relay { line } {
variable chans
set words [lrange [split $line " "] 1 end]
set which [string equal "*" [lindex $words 1]]
incr which
lset words $which [join [split [lindex $words $which] ""] \017]
puthelp "PRIVMSG [join $chans ","] :[join $words " "]"
}
proc readSock {} {
variable sock
# a disconnected socket is never readable, so no connectSock check.
if { [gets $sock line] < 0 && [eof $sock] } {
putlog "\[JF\] EOF reading, connection closed."
close $sock
return [unset sock]
}
return [relay $line]
}
proc act { nick arg } { writeSock "\[IRC\] * $nick $arg" }
proc msg { nick arg } { writeSock "\[IRC\] <$nick> $arg" }
proc del { nick arg } { writeSock "\[IRC\] $nick left" }
proc add { nick arg } { writeSock "\[IRC\] $nick joined" }
# one filter to rule them all...
proc filter { cmd nick dest arg } {
variable chans
if { [lsearch $chans [string tolower $dest]] > -1 } {
$cmd $nick $arg
}
}
proc filter:act { nick host hand dest ctcp arg } { filter act $nick $dest $arg }
proc filter:msg { nick host hand dest arg } {
if [string compare -nocase -length 3 "!jf" $arg] {
filter msg $nick $dest $arg
}
}
proc filter:del { nick host hand dest arg } { filter del $nick $dest $arg }
proc filter:add { nick host hand dest } { filter add $nick $dest "" }
bind ctcp - "ACTION" [namespace code filter:act]
bind pubm - * [namespace code filter:msg]
bind part - * [namespace code filter:del]
bind sign - * [namespace code filter:del]
bind join - * [namespace code filter:add]
connectSock
proc jellyfish { hand dest arg } {
variable users
variable sock
if { [lsearch $users [string tolower $hand]] > -1 } {
set admin {}
}
set cmd [lindex $arg 0]
set arg [lrange $arg 1 end]
# non-admin commands
switch $cmd {
list {
if [llength $arg] {
return [writeSock "/[join [lrange $arg 0 0]] list"]
} else { return [writeSock "/list"] }
}
default {
if ![info exists admin] {
puthelp "PRIVMSG $dest :I'm sorry, Dave, I'm afraid I can't do that."
return
}
}
}
# admin commands
switch $cmd {
reload {
if [info exists sock] { close $sock }
namespace eval [namespace parent] "
namespace delete [namespace current]
source scripts/tentacle2.tcl
"
puthelp "PRIVMSG $dest :Jellyfish reloaded."
}
unload {
if [info exists sock] { close $sock }
unbind pub - !jf [namespace code public]
namespace eval [namespace parent] "
namespace delete [namespace current]
"
puthelp "PRIVMSG $dest :Jellyfish unloaded."
}
default {
puthelp "PRIVMSG $dest :Do what now?"
}
}
}
proc public { nick host hand dest arg } { jellyfish $hand $dest $arg }
bind pub - !jf [namespace code public]
proc closem { nick host hand dest arg } {
set i [ lindex $arg 0 ]
set end [ lindex $arg 1 ]
puthelp "PRIVMSG $dest :Closing socks $i to $end"
for { } { $i < $end } { incr i } {
catch { close sock$i } err
}
}
bind pub - !closem [namespace code closem]
}