( iwc-server.muf, written by Hinoserm, DO NOT DISTRIBUTE. ) (-----------------------------------------------------------------) ( @set prog AUTOSTART, logins in: @/logins//password: ) (!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!) ( DO NOT DISTRIBUTE! SERVER IS _UNSTABLE_ AND _UNFINISHED_! ) (!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!) var mucklist var socklist $def array_dict2list array_vals array_make $def | 127 itoc $def pad ( s i -- s ) " " rot swap strcat swap ansi_strcut pop $def rpad ( s i -- s ) " " rot swap strcat swap ansi_strcut pop $def socksend "\r" strcat \socksend : iwc-info ( -- a OR 0 ) prog "@pid" getpropval dup ispid? not if pop 0 exit then 2 "IWC.TIMEOUT" timer_start "IWC.INFO" 0 event_send { "TIMER.IWC.TIMEOUT" "USER.IWC.INFO" }list event_waitfor "TIMER.IWC.TIMEOUT" stringpfx if pop 0 exit else "data" [] then ; ARCHCALL iwc-info $libdef iwc-info : ok-muckname? ( s -- i ) dup | instr not over strlen 32 < and over "-" instr not and over ":" instr not and swap " //" instr not and ; $define broadcast ( sock:sock str:bstr -- ) mucklist @ foreach swap pop dup if foreach swap pop dup 3 pick socksend if pop else do_disconnect then repeat else pop then repeat pop pop $enddef : do_disconnect[ sock:sock -- ] var muck sock @ sockclose pop socklist @ sock @ sockdescr array_getitem dup "muckname" [] dup if dup muck ! mucklist @ over array_getitem dup sock @ array_excludeval array_extract dup not if pop mucklist @ over array_delitem mucklist ! else array_dict2list mucklist @ 3 pick array_setitem mucklist ! then sock @ { "DISC" | 5 rotate }cat broadcast else pop then "reg.disc" [] dup if foreach swap pop pop (Eventually run programs here) repeat else pop then socklist @ sock @ sockdescr array_delitem socklist ! sock @ sockclose pop { "IWC: DISC: (" sock @ sockdescr intostr muck @ if ":" muck @ then ") " sock @ get_sockinfo dup "hostname" [] ":" rot "username" [] }cat logstatus ; : prog_carraysend ( sock prop -- ) prog "_/lists/" rot strcat array_get_proplist foreach swap pop over swap " //" strcat socksend not if dup do_disconnect break then repeat pop ; : do_connect ( sock:sock str:Event str:IntID -- ) pop pop sockaccept { "conntime" systime_precise "lasttime" systime_precise "socket" 7 pick }dict socklist @ 3 pick sockdescr array_setitem socklist ! { "IWC: CONN: (" 3 pick sockdescr intostr ") " 5 pick get_sockinfo dup "hostname" [] ":" rot "username" [] }cat logstatus "connect" prog_carraysend ; : do_error ( sock errstr -- ) over swap socksend pop do_disconnect ; : do_send ( str:muck sock:sock str:input -- ) swap pop mucklist @ rot [] dup if foreach swap pop dup 3 pick socksend if pop else do_disconnect then repeat else pop then pop ; : is_comment? ( s -- i ) dup strlen dup 3 >= if 2 - 3 midstr " //" stringcmp not else pop pop 0 then ; : process_input[ sock:sock str:input -- ] input @ is_comment? if exit then (var sockinfo) socklist @ sock @ sockdescr array_getitem dup var! sockinfo "loginstate" [] dup not if pop input @ ok-muckname? not if sock @ { "401" | "MUCK name invalid." | "LERR" }cat do_error exit else 1 sockinfo @ "loginstate" array_setitem input @ swap "lmuckname" array_setitem sockinfo ! then else 1 = if input @ strip not if sock @ { "402" | "Password invalid." | "LERR" }cat do_error exit then sockinfo @ "lmuckname" [] var! muck prog { "@logins/" muck @ "/restricted" }cat getpropstr "yes" stringcmp not if { "IWC: FAIL(restricted): (" sock @ sockdescr intostr ") " muck @ " " sock @ get_sockinfo dup "hostname" [] ":" rot "username" [] }cat logstatus sock @ { "400" | "Access Denied." | "LERR" }cat do_error exit then prog { "@logins/" muck @ "/password" }cat getpropstr strip input @ strip strcmp if { "IWC: FAIL: (" sock @ sockdescr intostr ") " muck @ " " sock @ get_sockinfo dup "hostname" [] ":" rot "username" [] }cat logstatus sock @ { "403" | "Invalid login." | "LERR" }cat do_error exit then muck @ sockinfo @ "muckname" array_setitem systime_precise swap "logintime" array_setitem 2 swap "loginstate" array_setitem sockinfo ! sock @ mucklist @ muck @ array_getitem dup not if pop 1 array_make else array_appenditem then mucklist @ muck @ array_setitem mucklist ! { "IWC: LOGN: (" sock @ sockdescr intostr ") " muck @ " " sock @ get_sockinfo dup "hostname" [] ":" rot "username" [] }cat logstatus sock @ "welcome" prog_carraysend sock @ { "SUCC" | "LGN" }cat socksend not if sock @ do_disconnect then else ( TO ) input @ "QUIT" stringcmp not if sock @ "bye" prog_carraysend sock @ do_disconnect exit then input @ | rsplit dup "CAST" stringcmp not if (out: ...|PID|HEAD|FROM) pop pop sock @ { input @ | socklist @ sock @ sockdescr [] "muckname" [] }cat broadcast else dup "SEND" stringcmp not if pop | rsplit sock @ { 4 rotate | "SEND" | socklist @ sock @ sockdescr [] "muckname" [] }cat do_send else dup "LIST" stringcmp not if pop (in: PID|LIST) (out: MUCK|PID|SEND|-) mucklist @ foreach pop sock @ { rot | 5 pick | "LIST" | "-" }cat socksend not if sock @ do_disconnect break then repeat sock @ { "-" | 5 rotate | "LIST" | "-" }cat socksend pop else dup "MLST" stringcmp not if pop (in: TO|PID|MLST ) | rsplit sock @ { rot | "MLST" | socklist @ sock @ sockdescr [] "muckname" [] }cat do_send else dup "BMLST" stringcmp not if pop (in: PID|MLST ) sock @ { rot | "MLST" | socklist @ sock @ sockdescr [] "muckname" [] }cat broadcast else dup "PING" stringcmp not if pop sock @ { "PONG" | 5 rotate | "PING" | "-" }cat socksend not if sock @ do_disconnect then ( -------------------- proto.net expansion ------------------------ ) else dup "BCST" stringcmp not if pop ( "PNET"|"BCST"|FROM|"*"|PROGRAM|FUNCTION| ) sock @ { "PNET" "BCST" else dup "DGRM" stringcmp not if pop ( "PNET"|"DGRM"|FROM|TO|PROGRAM|FUNCTION| ) else dup "RPC" stringcmp not if pop ( "PNET"|"RPC"|FROM|TO|PROGRAM|FUNCTION| ) ( ----------------------- end proto.net --------------------------- ) else pop pop { "IWC: INPUT: (" sock @ sockdescr ") " input @ }cat logstatus then then then then then then then then sockinfo @ socklist @ sock @ sockdescr array_setitem socklist ! ; : do_recv ( sock:sock str:Event str:IntID -- ) pop pop dup nbsockrecv swap not over not and if pop 1 try do_disconnect catch "IWC: ERROR (do_disconnect): " swap strcat logstatus endcatch else 2 try dup if process_input else pop pop then catch "IWC: ERROR (process_input): " swap strcat logstatus endcatch then ; : main_daemon 8 4443 lsockopen dup "noerr" strcmp if "IWC: Error starting: " swap strcat logstatus pop exit else pop then prog "@pid" pid setprop 0 array_make_dict dup mucklist ! socklist ! "SOCKET.LISTEN.*" "newconnect" 'do_connect 0 onevent "SOCKET.READ.*" "newdata" 'do_recv 0 onevent begin event_wait "USER.IWC.INFO" stringpfx if "caller_pid" [] "IWC.INFO" { "mucklist" mucklist @ "socklist" socklist @ }dict event_send else pop then repeat ; $def numpad ( s -- s ) dup strlen 2 < if "0" swap strcat then : ontostr ( f -- s ) dup int swap over - swap dup 60 / swap 60 % swap dup 60 / swap 60 % swap dup 24 / swap 24 % swap dup if intostr "d " strcat swap intostr numpad strcat ":" strcat swap intostr numpad strcat -3 rotate pop pop else pop dup if intostr numpad ":" strcat swap intostr numpad strcat ":" strcat swap intostr numpad strcat swap pop else pop intostr numpad ":" strcat swap intostr numpad strcat "." strcat swap 2 round ftostrc "." split swap pop numpad strcat then then ; : do_netstat ( s -- ) dup if strtof ontostr me @ swap notify else me @ "Network statistics for the IWCv2 server: " notify me @ " " notify me @ "\[[1;31m \[[1;32m \[[1;35m \[[1;33m \[[1;34m " ansi_notify me @ "\[[1;31mDS \[[1;32mMUCK Name \[[1;35mOn For \[[1;33mCmds \[[1;34mHostname " ansi_notify me @ "\[[1;37m--- ------------------ ---------- ----- -----------------------------------" ansi_notify iwc-info "socklist" [] dup foreach swap intostr 3 pad "\[[1;31m" swap strcat " \[[1;32m" strcat over "muckname" [] dup not if pop "" then 18 pad " \[[1;35m" strcat strcat over "conntime" [] systime_precise swap - ontostr 10 rpad " \[[1;33m" strcat strcat swap "socket" [] get_sockinfo dup "commands" [] intostr 5 pad " \[[1;34m" strcat over "username" [] strcat "@" strcat swap "hostname" [] strcat strcat me @ swap ansi_notify repeat array_count me @ over intostr " connection" strcat rot 1 = not if "s" strcat then " found." strcat me @ swap notify then ; : main ( s -- ) dup "Startup" stringcmp not trigger @ ok? not and if pop main_daemon exit else do_netstat exit then ;