[Richard Suchenwirth] 2007-12-19 - I love the [Tcl chatroom]. It's like my peer group. So I was quite frustrated when good old Ralfchat (a [Perl] script) on `mini.net` was closed down, because that was my only way to participate in the chat from my cellphone.
But isn't Tcl an enabling language? Why not put useful parts from [picoIRC 0.2] and [Playing CGI] together, and build my own bridge between [IRC] and [http]? The following script connects to IRC (you may have to fumble with the ircnick, if it is reported as being in use) and collects what is posted to the #tcl channel. It also provides a web server that listens on port 80, and provides the latest posts to the customer there. Also, it accepts posts and posts them to #tcl... It's all quite crude, but what do you expect from less than 90 lines of code, depending on nothing but [Tcl]? At least, it works quite well from my cell phone, so I can chat from that again (if a server is started).
Here goes:
----
#!/usr/bin/env tclsh
# webchain.tcl - HTTP <-> IRC bridge
set port 80
set encoding iso8859-1 ;# utf-8
set nick someone
set ircserver irc.freenode.org
set ircport 6667
set chan #tcl
set ircnick webchain
set log {webchain Welcome.}
proc irc_recv {} {
gets $::fd line
if {[string trim $line] ne ""} {puts $line}
# handle PING messages from server
if {[lindex [split $line] 0] eq "PING"} {
send "PONG [info hostname] [lindex [split $line] 1]"; return
}
if {[regexp {:([^!]*)![^ ].* +PRIVMSG ([^ :]+) +:(.*)} $line -> \
nick target msg]} {
set tag ""
if [regexp {\001ACTION(.+)\001} $msg -> msg] {set tag italic}
if [in {azbridge ijchain} $nick] {
regexp {<([^>]+)>(.+)} $msg -> nick msg
}
if {$tag eq "italic"} {set msg $msg}
lappend ::log $nick $msg
} else {lappend ::log - $line}
}
proc in {list element} {expr {[lsearch -exact $list $element]>=0}}
proc post msg {
if [regexp {^/me (.+)} $msg -> action] {set msg "\001ACTION $action\001"}
foreach line [split $msg \n] {send "PRIVMSG $::chan :<$::nick> $line"}
}
proc send str {puts $::fd $str; flush $::fd}
proc answer {sock host2 port2} {
fileevent $sock readable [list serve $sock]
}
proc encmap enc {string map {utf- UTF iso ISO-} $enc}
proc serve sock {
fconfigure $sock -blocking 0 -encoding $::encoding
gets $sock line
if {[fblocked $sock]} return
fileevent $sock readable ""
set args ""
regexp {(/[^ ?]*)\??([^ ]*)?} $line -> tail args
puts $sock "HTTP/1.0 200 OK"
puts $sock "Content-Type: text/html;charset=$[encmap $::encoding]\n"
puts $sock webchain
array set a [concat {MSG "" NICK "" CNT 30} [kvsplit $args]]
if {$a(MSG) ne ""} {
lappend ::log $a(NICK) $a(MSG)
set ::log [lrange $::log end-999 end]
set ::nick $a(NICK)
post $a(MSG)
}
foreach {nick post} [lrange $::log end-[expr {$a(CNT)*2-1}] end] {
puts $sock "$nick: $post
"
}
puts $sock "
"
puts $sock
close $sock
}
proc kvsplit kv {
set res ""
foreach i [split $kv &] {
foreach {k v} [split $i =] break
lappend res $k [unescape $v]
}
set res
}
proc unescape str {
regsub -all {%(..)} [string map {+ " "} $str] {\u00\1} str
subst $str
}
#-- connect to IRC...
set ::fd [socket $::ircserver $::ircport]
send "NICK $::ircnick"
send "USER $::ircnick 0 * :Tcl user"
send "JOIN $::chan"
fileevent $::fd readable irc_recv
socket -server answer $port
puts "Server ready..."
vwait forever
----
!!!!!!
%| [Category Example] | [Category Internet] |%
!!!!!!