@program IRCMUCK-bridge.muf
1 1000 d
i
$include $lib/alynna
lvar param
lvar server
lvar port
lvar nick
lvar pw
lvar chan
$def LN "IRCMUCK" pretty tellme

: loadconfig
#0 "_sys/ircmuck/server" getprop tostr server !
#0 "_sys/ircmuck/port"   getprop tostr port !
#0 "_sys/ircmuck/chan"   getprop tostr chan !
#0 "_sys/ircmuck/nick"   getprop tostr nick !
#0 "_sys/ircmuck/pw"     getprop tostr pw !
;

: saveconfig
#0 "_sys/ircmuck/server" server @ tostr setprop
#0 "_sys/ircmuck/port"   port @   tostr setprop
#0 "_sys/ircmuck/chan"   chan @   tostr setprop
#0 "_sys/ircmuck/nick"   nick @   tostr setprop
#0 "_sys/ircmuck/pw"     pw @     tostr setprop
;

: CN ( s -- )
var text text !
var tmp
  online_array foreach tmp ! pop
  tmp @ "_prefs/xpub" getprop if
   tmp @ text @ "XPub" pretty ansi_notify
  then
  repeat  
;

: extractline ( s -- s:userhost s:command s:misc s:misc2 s:text )
var px
var count

var userhost
var cmd
var misc
var misc2
var text
px !

( Cut up the initial colon if there is one )
px @ 1 strcut swap dup ":" smatch if pop px ! else pop pop then
( explode : )
px @ ":" split strip text !
" " explode count ! 
count @ 1 >= if strip userhost ! then
count @ 2 >= if strip cmd ! then
count @ 3 >= if strip misc ! then
count @ 4 >= if count @ 3 - str put cat misc2 ! then
text @ misc2 @ misc @ cmd @ userhost @
;

: extractuserhost ( s -- s:hostname s:username s:nickname )
var hostname
var username
var nickname
"!" explode pop nickname !
"@" explode pop username ! hostname !
hostname @ username @ nickname @
;

: waitforsocket ( socket -- i )
var socket socket !
var wait 15 wait !
var sockstat
( Wait a few seconds to see if this thing goes cool. )
1 wait @ 1 for pop 
 socket @ sockcheck dup 0 > if exit else sockstat ! 1 sleep then
repeat
socket @ sockclose sockstat @
;

: sendline ( socket s -- )
"PRIVMSG " chan @ " :" strcat strcat swap strcat socksend
;

: xline ( s -- )
#0 "/ircmuck#/" array_get_proplist
swap array_appenditem
#0 "/ircmuck#/" rot array_put_proplist
;

: proclines ( socket -- i )
( i = 0: The connection died )
( i = 1: The last line was processed )
var socket
var sockstat
var line
var curline
var userhost
var cmd
var misc
var misc2
var text
var hostname
var username
var nickname
var tmp

socket ! 
socket @ sockrecv sockstat ! line !
sockstat @ not if 0 exit then
( Remove 10's coming from raw IRC .. )
line @ "" 10 itoc subst line !
( Delimit by 13's )
line @ 13 itoc explode foreach pop 
 extractline userhost ! cmd ! misc ! misc2 ! line !
 userhost @ extractuserhost nickname ! username ! hostname !

 ( Respond to pings )
 nickname @ "PING" smatch if 
  socket @ "PONG :" line @ strcat socksend 
 then

 ( Echo something messaged to channel to the MUCKs.. )
 cmd @ "PRIVMSG" smatch if
   str "<" nickname @ "@" nick @ "> " text @ cat CN
  then

 ( Process joins )
 cmd @ "JOIN" smatch if
   str nickname @ " has joined the channel (" misc @ ")" cat CN
  then

 ( Process parts )
 cmd @ "PART" smatch if
   str nickname @ " has left the channel (" misc @ ")" cat CN
  then

 ( Process quits )
 cmd @ "QUIT" smatch if
   str nickname @ " has quit IRC (" misc @ ")" cat CN
  then

 ( Process 001 numeric )
 cmd @ "001" smatch if
   text @ CN
  then

 ( Process 353 numeric )
 cmd @ "353" smatch if
   str "Other listeners on channel: " text @ cat CN
  then
repeat
1
;

: xconnect
var socket
var sockstat

var damn
var item
var value

loadconfig
( Lets try to config for 10 seconds )
str "Attempting to connect to " server @ ":" port @ "..." cat LN
server @ port @ atoi nbsockopen pop socket !
socket @ waitforsocket sockstat !
sockstat @ 0  = if 
 "Connection timed out." LN then
sockstat @ -1 = if 
 "Connection refused." LN then
( Connect and log in )
"Logging in..." LN
socket @ str "NICK " nick @ cat socksend
socket @ str "USER " nick @ " " nick @ " * " nick @ cat socksend
socket @ str "PRIVMSG Nickserv :identify " pw @ cat socksend
socket @ str "JOIN " chan @ cat socksend

( begin send/recv loop )
begin
( Send any new lines buffered )
#0 "/ircmuck#/" array_get_proplist foreach value ! item !
 value @ 3 itoc not if
  socket @ value @ sendline
 else
  socket @ sockclose
  "Socket terminated." CN
  exit
 then
repeat
( Clear the send buffer )
#0 "/ircmuck#/" { } array_make array_put_proplist

( Receive any new lines, close if dead )
socket @ proclines not if 
 socket @ sockclose 
 "Socket died, please reconnect." CN
 exit then

1 sleep
repeat
;

: docs
{
} array_make atellme
;

: xconfig
loadconfig
param @ not if
     "Current config:" LN
 str "Server: " server @ cat LN
then
param @ "=" explode 5 = not if
 str "Damage: " command @ " <nick>=<pw>=<chan>=<server>=<port>" cat LN exit
then
nick ! pw ! chan ! server ! port ! saveconfig

;

: main
param !
param @ tolower "#help" smatch if docs exit then

command @ tolower case
 "xl"           when xline    end
 "@xconnect"    when xconnect end
 "@xdisconnect" when 3 itoc param ! xline end
 "@xconfig"     when xconfig  end
endcase

;
.
c
q