[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
You can not post without entering a nick name!
" hform $sock a } } else { foreach {nick post hpost} [lrange $::log end-[expr {$a(CNT)*3-1}] end] { if {$nick eq $enick} { set style my_posts } else { set style other_posts } if { $a(GR) } { puts $sock "$nick: $hpost
" } else { puts $sock "$nick: $post
" } } set a(MSG) "" hform $sock a } puts $sock close $sock } } proc hform { sock anm } { upvar $anm a puts $sock "