( Multi connector ) $include $lib/alynna $def mainpid prog "_pid" getprop $def descrsock sockets @ swap [] dup if "client" [] else pop 0 then $def SOCKET_CLIENT 1 $def SOCKET_SERVER 0 $def LF 13 itoc 10 itoc strcat var sockets var lsocket lvar param : mkevent[ d:target s:cmd i:sdescr s:text -- s:event ] { sdescr @ " " target @ int " " cmd @ " " text @ }cat ; : parseevent[ s:text -- dict:event ] { "sdescr" text @ " " split swap atoi swap "target" swap " " split swap atoi dbref swap "cmd" swap " " split swap "data" swap }dict ; ( sockets is a dict of: : ) : gettsock[ d:target s:cmd s:prop -- value ] target @ { "/@socks/" cmd @ "/" prop @ }cat getprop ; : settsock[ d:target s:cmd s:prop x:value -- ] target @ { "/@socks/" cmd @ "/" prop @ }cat value @ setprop ; : clrtsock[ d:target s:cmd -- ] target @ { "/@socks/" cmd @ "/" }cat remove_prop ; : newsock[ i:type d:target d:source s:cmd sock:socket -- i:sdescr ] { "type" type @ "target" target @ "source" source @ "cmd" cmd @ "client" socket @ "color" target @ cmd @ "color" gettsock "alias" target @ cmd @ "alias" gettsock dup not if pop target @ name then }dict sockets @ socket @ sockdescr ->[] sockets ! socket @ sockdescr ; : getsock[ i:sdescr s:prop -- value ] sockets @ sdescr @ [] prop @ [] ; : setsock[ i:sdescr s:prop x:value -- ] sockets @ sdescr @ [] value @ swap prop @ ->[] sockets @ sdescr @ ->[] sockets ! ; : clrsock[ i:sdescr -- ] sdescr @ "client" getsock sockclose pop sdescr @ "server" getsock sockclose pop sockets @ sdescr @ array_delitem sockets ! ; : chksock[ i:sdescr -- ] sdescr @ "client" getsock sockcheck 1 < sdescr @ "server" getsock sockcheck 1 < or if sdescr @ clrsock 0 exit then 1 ; : getsdescr[ d:source s:cmd -- i:sdescr ] sockets @ foreach var! props var! sdescr props @ "source" [] source @ dbcmp if props @ "cmd" [] cmd @ smatch if sdescr @ exit then then repeat 0 ; : gettarget[ d:source s:cmd -- d:target ] sockets @ foreach var! props var! sdescr props @ "source" [] source @ dbcmp if props @ "cmd" [] cmd @ smatch if props @ "target" [] exit then then repeat #-1 ; : getTtarget[ d:source s:cmd -- d:target ] source @ "/@socks/" array_get_propdirs foreach var! dir pop source @ { "/@socks/" dir @ "/cmd" }cat getprop cmd @ smatch if source @ { "/@socks/" dir @ "/target" }cat getprop exit then repeat #-1 ; : getcmd[ d:source s:target -- s:cmd ] source @ "/@socks/" array_get_propdirs foreach var! dir pop source @ { "/@socks/" dir @ "/target" }cat getprop target @ dbcmp if dir @ exit then repeat "" ; : sys.input[ d:source s:cmd s:text -- ] cmd @ "Queued Event." smatch if exit then source @ cmd @ getsdescr dup var! sdescr not if { "Your character " source @ cmd @ "target" gettsock ansi_unparseobj "^ ^ is not connected." }tell exit then sdescr @ chksock not if exit then text @ not if exit then source @ cmd @ "target" gettsock text @ force ; : sys.output[ i:sdescr s:text -- ] sdescr @ "source" getsock { sdescr @ "color" getsock if "^" sdescr @ "color" getsock "^" then sdescr @ "alias" getsock "> " text @ }cat ansi_notify ; : sys.handler mainpid "command" { "source" me @ "cmd" command @ "text" param @ }dict event_send ; : sys.connect var target var cmd param @ not if { "Syntax: " command @ " " }tell exit then param @ "#all" smatch if { me @ "/@socks/" array_get_propdirs foreach var! dir pop me @ { "/@socks/" dir @ "/auto" }cat getprop if dir @ me @ { "/@socks/" dir @ "/target" }cat getprop then repeat }dict else param @ pmatch target ! target @ int 0 < if { "Who the f--k is that?! (Language! Think of the kits...)" }tell exit then { me @ "/@socks/" array_get_propdirs foreach var! dir pop me @ { "/@socks/" dir @ "/target" }cat getprop target @ dbcmp if dir @ target @ break then repeat }dict then dup not if pop { "There are no commands assigned that link to the target " target @ "." }tell exit then foreach target ! cmd ! { "Connecting: " target @ ansi_unparseobj " on command ^CYAN^" cmd @ "^ ^..." }tell mainpid "connect" { "source" me @ "target" target @ "cmd" cmd @ }dict event_send repeat ; : sys.disconnect[ -- ] param @ not if { "Syntax: " command @ " " }tell exit then param @ "#all" smatch if sockets @ foreach var! props var! sdescr props @ "source" [] me @ dbcmp if props @ "source" [] { "Disconnecting " props @ "target" [] ansi_unparseobj "..." }cat ansi_notify sdescr @ clrsock then repeat else param @ pmatch var! target target @ int 0 < if { "I couldn't find " param @ "!" }tell exit then sockets @ foreach var! props var! sdescr props @ "target" [] target @ dbcmp if props @ "source" [] { "Disconnecting " props @ "target" [] ansi_unparseobj "..." }cat ansi_notify sdescr @ clrsock then repeat then ; : cmd.add param @ "=" explode_array var! params params @ array_count 3 != if { "Syntax: " command @ " ==" }tell exit then params @ 0 [] var! cmd params @ 1 [] var! uname params @ 2 [] var! passwd uname @ pmatch var! target target @ int 0 < if { "Who the f--k is that?! (Language! Think of the kits...)" }tell exit then target @ passwd @ checkpassword not if { "^RED^Permission denied. (You did not give the correct password)" }tell exit then ( command prop ) me @ { "@command/" cmd @ }cat prog setprop me @ cmd @ "target" target @ settsock target @ cmd @ "source" me @ settsock { "Command ^CYAN^" cmd @ "^ ^ has been associated with " target @ ansi_unparseobj " from " me @ ansi_unparseobj "." }tell ; : cmd.auto param @ not if { "Syntax: " command @ " " }tell exit then param @ pmatch var! target target @ int 0 < if { "Who the f--k is that?! (Language! Think of the kits...)" }tell exit then me @ target @ getcmd var! cmd me @ cmd @ "auto" gettsock not if me @ cmd @ "auto" 1 settsock { "Autoconnecting to " target @ " is now ^GREEN^ON^ ^." }tell else me @ cmd @ "auto" 0 settsock { "Autoconnecting to " target @ " is now ^RED^OFF^ ^." }tell then ; : cmd.del param @ pmatch var! target param @ not if { "Syntax: " command @ " " }tell exit then target @ int 0 < if { "Who the f--k is that?! (Language! Think of the kits...)" }tell exit then me @ target @ getcmd var! cmd me @ cmd @ clrtsock target @ cmd @ clrtsock { "Connection to " target @ " is now ^RED^DERETED^ ^!" }tell ; $def COLORS "{black|crimson|forest|brown|navy|violet|aqua|gray|gloom|red|green|yellow|blue|purple|pink|cyan|white}" : cmd.color param @ "=" explode_array var! params params @ array_count 2 != if { "Syntax: " command @ " =" }tell exit then params @ 0 [] pmatch var! target target @ int 0 < if { "Who the f--k is that?! (Language! Think of the kits...)" }tell exit then params @ 1 [] COLORS smatch not if { "I do not know what color that is, try one of these colors: " COLORS "" "{" subst "" "}" subst " " "|" subst }tell exit then me @ target @ getcmd debug_line var! cmd target @ cmd @ "color" params @ 1 [] settsock { "You set the color of " target @ "'s text to ^" params @ 1 [] "^" params @ 1 [] "^ ^." }tell ; : cmd.alias param @ "=" explode_array var! params params @ array_count 2 != if { "Syntax: " command @ " =" }tell exit then params @ 0 [] pmatch var! target target @ int 0 < if { "Who the f--k is that?! (Language! Think of the kits...)" }tell exit then me @ target @ getcmd var! cmd target @ cmd @ "alias" params @ 1 [] settsock { "You set the alias of " target @ "'s to ^CYAN^" params @ 1 [] "^ ^." }tell ; ( Daemon: The main loop for event processing ) : daemon var curevent var cursocket var data var tmp background ( Sockets database initialization ) 0 array_make_dict sockets ! ( Register a new daemon ) prog "_pid" pid setprop 8 65530 lsockopen pop lsocket ! 60 "cleanup" timer_start ( This is the song that does not end, yes it goes on and on, my friend ) begin event_wait var! event var! payload payload @ dictionary? if payload @ "data" [] data ! else 0 data ! then event @ case ( Event for MUCK -> Player ) "socket.read.*" smatch when event @ "." rsplit swap pop atoi descrsock dup cursocket ! if cursocket @ sockdescr cursocket @ sockrecv dup if sys.output else pop pop then then end ( Event for Player -> MUCK ) "user.command" smatch when data @ "source" [] data @ "cmd" [] data @ "text" [] sys.input end ( Event for make new connection client endpoint ) "user.connect" smatch when data @ "source" [] data @ "cmd" [] getsdescr if data @ "source" [] { "Target " data @ "target" [] ansi_unparseobj "^ ^ is already connected." }tell else ( Sing unto the Lord, a new socket ) "66.218.55.145" 65530 sockopen pop cursocket ! SOCKET_CLIENT data @ "target" [] data @ "source" [] data @ "cmd" [] cursocket @ newsock var! sdescr cursocket @ { data @ "target" [] int intostr " " data @ "source" [] int intostr " " data @ "cmd" [] " " sdescr @ intostr }cat socksend pop then end ( Event for new connection server endpoint ) "socket.listen.*" smatch when ( Accept the socket ) lsocket @ sockaccept cursocket ! ( Read a line, which should be an event response ) cursocket @ sockrecv " " explode_array curevent ! ( Tell the client socket about the server socket ) curevent @ 3 [] atoi "server" cursocket @ setsock ( Proto2.0b8.22! Create a descriptor for this socket, then connect it to a user. ) cursocket @ socktodescr curevent @ 0 [] atoi dbref descr_setuser_nopass pop end ( Event for close connection ) "user.quit" smatch when data @ param ! sys.disconnect end "timer.cleanup" smatch when sockets @ foreach pop tmp ! tmp @ chksock pop repeat 60 "cleanup" timer_start end endcase repeat ; : help { "MultiConnector by Alynna (C) 2007 Digital Kitsune Productions - All rights are hoarded" " " "Commands:" " +char #help You're looking at it" " +char #startup (Wizzes) Start the daemon (if it stopped for some reason" " +char/add == Make a new command to control character 'name'." " +char/del Remove the command that controls that character. The character is NOT removed." " +connect Connect to a character" " +disconnect Disconnect from a character" " +char/color = Pick an output color for a character" " +char/alias = Pick a display name for this character" " +char/auto Toggle whether this character is autoconnected or not" }array me @ 1 array_make array_ansi_notify ; ( Handle ANY sort of program entry except library call ) : entry[ -- ] param ! ( Daemon start ) command @ "+char" smatch if param @ "#startup" smatch if daemon exit then param @ "#help" smatch if help exit then then command @ "Queued Event." smatch if param @ "startup" smatch if daemon exit then param @ "connect" smatch if "#all" param ! sys.connect exit then param @ "disconnect" smatch if mainpid "quit" "#all" event_send then then prog getpids mainpid array_findval not if { "The connection daemon was not started, starting it. Try your command again." }tell daemon exit then ( Commands ) command @ "{+char/add|+char/edit}" smatch if cmd.add exit then command @ "+char/del" smatch if cmd.del exit then command @ "+char/auto" smatch if cmd.auto exit then command @ "+char/color" smatch if cmd.color exit then command @ "+char/alias" smatch if cmd.alias exit then command @ "+connect" smatch if sys.connect exit then command @ "+disconnect" smatch if mainpid "quit" param @ event_send exit then command @ "+reconnect" smatch if param @ not if "#all" param ! then mainpid "quit" param @ event_send 0 sleep sys.connect exit then ( Else its a handler of some kind ) sys.handler ;