@program iwc-client.muf 
1 10000 d
i
( iwc-client.muf, by Hinoserm, DO NOT DISTRIBUTE. )
(-------------------------------------------------)
( The program should give the instructions when   )
(  you compile it. Contact hinoserm@protomuck.org )
(  to obtain your login info.                     )
(-------------------------------------------------)
( Much thanks to The_Blob for helping to optimize )
(  some of my functions.                          )
(!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!)
( This will not run on Proto2b5.12 or older.      )
( This program could be considered UNSAFE.        )
(!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!)
  
$author Hinoserm
$note IWCv2 Client Program, unfinished.
$version 0.9
$lib-version 0.4
  
$def | 127 itoc
$pubdef | 127 itoc
  
$def MUCKNAME prog "@config/muckname" getpropstr
$def PASSWORD prog "@config/password" getpropstr
$def HOSTNAME "iwc1.ginkosoft.com"
$def PORT     4443
      
$def array_keys2list array_keys array_make
      
$def list_modules ( -- a ) #0 "_reg/iwc" array_get_propvals array_keys2list

: log ( s i -- )
   pop "IWC: " swap strcat logstatus
;
   
( // START PUBLIC FUNCTIONS // )
   
: iwc-send ( str:data str:pid str:to -- int:status )
   prog "@pid" getpropval dup ispid? not if pop 0 exit then
   "IWC.SEND" { 6 rotate dup array? if | array_join then | 7 rotate | 8 rotate | "SEND" }cat event_send 1
; PUBLIC iwc-send
$libdef iwc-send
   
: iwc-bcast ( str:data str:pid -- int:status )
   prog "@pid" getpropval dup ispid? not if pop 0 then
   "IWC.SEND" { 5 rotate dup array? if | array_join then | 6 rotate | "CAST" }cat event_send 1
; MAGECALL iwc-bcast
$libdef iwc-bcast
   
: iwc-mlist ( int:timeout -- arr:list OR int:0 )
   "i" checkargs
   prog "@pid" getpropval dup ispid? not if pop pop 0 exit then
   "IWC.SEND" { pid | "LIST" }cat event_send
   
   "IWC.TIMEOUT" timer_start
   0 array_make
   
   begin
      { "TIMER.IWC.TIMEOUT" "USER.IWC.LIST" }list event_waitfor
      "TIMER.IWC.TIMEOUT" stringpfx if
         pop pop 0 break
      else
         "data" [] "data" [] dup "-" strcmp not if pop "IWC.TIMEOUT" timer_stop break then
         swap array_appenditem
      then
  repeat
; MAGECALL iwc-mlist
$libdef iwc-mlist
  
: iwc-getdata ( int:timeout -- arr:data OR int:0 )
   "i" checkargs
   prog "@pid" getpropval ispid? not if pop 0 exit then
   "IWC.TIMEOUT" timer_start
   
   { "TIMER.IWC.TIMEOUT" "USER.IWC.SEND" "USER.IWC.CAST" }list event_waitfor
   "TIMER.IWC.TIMEOUT" stringpfx if
      pop 0 exit
   else "data" [] then
   
   "IWC.TIMEOUT" timer_stop
; PUBLIC iwc-getdata
$libdef iwc-getdata
  
: iwc-get ( arr:types int:timeout -- arr:data OR int:0 )
   prog "@pid" getpropval ispid? not if pop pop 0 exit then
   "IWC.TIMEOUT" timer_start
   dup string? if "USER.IWC." swap strcat 1 array_make then
   
   { "TIMER.IWC.TIMEOUT" }list array_union event_waitfor
   "TIMER.IWC.TIMEOUT" stringpfx if
      pop 0 exit
   else "data" [] then
   
   "IWC.TIMEOUT" timer_stop
; PUBLIC iwc-get
$libdef iwc-get
   
: iwc-mods ( str:muck int:timeout -- arr:mods OR int:0 )
   "si" checkargs
   over not 3 pick MUCKNAME stringcmp not or if
      pop list_modules exit
   else
      prog "@pid" getpropval dup ispid? not if pop pop 0 exit then
      "IWC.SEND" { 5 rotate | pid | "MLST" }cat event_send
   
      "IWC.TO.MDS" timer_start
      0 array_make
      begin
         { "TIMER.IWC.TO.MDS" "USER.IWC.SEND" }list event_waitfor
         "TIMER.IWC.TO.MDS" stringpfx if
            pop pop 0 break
         else
            "data" [] "data" []
            dup not if pop break then
            swap array_appenditem
         then
      repeat
   then
; PUBLIC iwc-mods
$libdef iwc-mods
               
: iwc-hasmod? ( str:muck str:mod int:timeout -- int:bool )
   "ssi" checkargs
   rot swap iwc-mods swap array_findval not not
; PUBLIC iwc-hasmod?
$libdef iwc-hasmod?

: iwc-crypt ( str:in str:key -- str:out )
    ""
    1 4 pick strlen 1 for
       4 pick swap 1 midstr ctoi dup
       1 5 pick strlen 1 for
          5 pick swap 1 midstr ctoi bitxor
       repeat
       dup if swap then pop itoc strcat
    repeat -3 rotate pop pop
; PUBLIC iwc-crypt
$libdef iwc-crypt
   
: iwc-modlist ( -- arr:data OR int:0 )
   5 iwc-mlist dup not if pop 0 exit then
   prog "@pid" getpropval dup ispid? not if pop pop 0 exit then
   "IWC.SEND" { pid | "BMLST" }cat event_send
   
   0 array_make_dict
   5 "IWC.TO.ML" timer_start
   
   begin
      { "TIMER.IWC.TO.ML" "USER.IWC.SEND" }list event_waitfor
      "TIMER.IWC.TO.ML" stringpfx if
         pop swap pop break
      else
         ( mlist a darr a data )
         "data" [] dup "data" [] dup if
            -3 rotate "from" [] 2 dupn array_getitem dup not if pop 0 array_make then
            4 rotate swap array_appenditem -3 rotate array_setitem 
         else pop
            rot dup rot "from" [] array_excludeval array_extract dup not if
               pop break
            else swap then
        then
      then
   repeat
   "IWC.TO.ML" timer_stop
; PUBLIC iwc-modlist
$libdef iwc-modlist
   
: iwc-mod-mlist ( str:mod -- arr:data OR int:0)
   "s" checkargs
   iwc-modlist dup not if pop pop 0 exit then
   0 array_make
   
   swap foreach
      4 pick array_findval if swap array_appenditem else pop then
   repeat swap pop
; PUBLIC iwc-mod-mlist
$libdef iwc-mod-mlist
  
( // START COMMON FUNCTIONS // )
    
: is_comment? ( s -- i )
   dup strlen dup 3 >= if
      2 - 3 midstr " //" stringcmp not
   else pop pop 0 then
;

: ok-muckname? ( s -- i )
   dup | instr not
   over strlen 32 < and
   over "-" stringcmp and
   over ":" instr not and
   swap is_comment? not and
;
  
$define get_registered ( s -- d )
   #0 "_reg/iwc/" rot strcat getprop dup dbref? not if pop #-1 then
$enddef
   
$define prog_registered? ( d -- ? )
   #0 "_reg/iwc" array_get_propvals swap array_findval
$enddef
   
$define register_prog ( d s -- )
   #0 "_reg/iwc/" rot strcat rot setprop
$enddef
   
: pid_registered? ( i -- i )
   dup ispid? if
      getpidinfo "CALLED_PROG" [] prog_registered?
   else pop 0 then
;
   
: do_error ( i s -- )
   prog "@lastiwcerr" getpropstr over strcmp 3 pick -1 = or if
      "ERROR: " over strcat 0 log
      prog "@lastiwcerr" rot setprop
      dup -1 = not if prog "Startup" queue else pop then
   else
      "ERROR: " swap strcat 1 log
      dup -1 = not if 2 * prog "Startup" queue else pop then
   then
;
   
: do_connect ( -- sock OR i s )
   HOSTNAME PORT nbsockopen dup "Operation now in progress" stringcmp if
      swap pop 20 swap exit
   else pop then
   
   10 "CONN.TIMEOUT" timer_start
$ifdef __proto<Proto2.0b6.00
   0  "CONN.CHECK"   timer_start
   begin
      0 sleep
      { "TIMER.CONN.*" }list event_waitfor
      "TIMER.CONN.TIMEOUT" stringpfx if
         "CONN.CHECK" timer_stop
         pop pop 30 "Failed to connect before timeout." exit break
      else
         pop dup sockcheck if break then
         1 "CONN.CHECK" timer_start
      then
   repeat
   "CONN.CHECK" timer_stop
$else
   { "TIMER.CONN.*" "SOCKET.CONNECT.*" }list event_waitfor
   "TIMER.CONN.TIMEOUT" stringpfx if
      pop pop 30 "Failed to connect before timeout." exit
   else pop then
$endif
   "CONN.TIMEOUT" timer_stop
   
   dup MUCKNAME socksend not if pop 20 "End of line." exit then
   dup PASSWORD socksend not if pop 20 "End of line." exit then
   
   10 "CONN.TIMEOUT" timer_start
   begin
      0 sleep
      { "TIMER.CONN.*" "SOCKET.READ.*" }list event_waitfor
      "TIMER.CONN.TIMEOUT" stringpfx if
         pop pop 30 "Failed to log in before timeout." exit
      else
         nbsockrecv swap not if
            pop sockclose pop 20 "End of line." exit
         then dup not over is_comment? or if
            pop 10 "CONN.TIMEOUT" timer_start continue
         then | rsplit dup "LERR" stringcmp not if
            pop | rsplit swap pop -1 swap exit
         else 
            "LGN" stringcmp not swap "SUCC" stringcmp not and if 
               break else continue
            then
         then
      then
   repeat
   "CONN.TIMEOUT" timer_stop
   0 sleep
;
   
( // START DAEMON CODE // )
   
: process_topid ( str:type str:from str:data str:pid sock:sock -- int:stop )
   { 
      "sock" rot
      "data" 6 rotate
      "from" 8 rotate
      "pid" 9 pick
      "type" 12 pick
      "time" systime_precise 
   }dict
   
   over number? if swap atoi
      dup pid_registered? if
         "IWC." 4 rotate toupper strcat rot event_send
      else 3 popn then 0
   else rot pop
      swap ":" rsplit dup not if pop "main" then
      swap get_registered dup program? not if 3 popn 0 exit then
      
      dup "_iwc_" 4 pick strcat cancall? if
         fork not if
            depth try
               3 array_make depth -1 * rotate depth -- popn array_vals pop
               "_iwc_" rot strcat call
            catch
               "MODULE ERROR: " swap strcat logstatus
            endcatch
            depth popn 1
         else 3 popn 0 then
      else 3 popn 0 then
   then
;
   
: process_input ( sock:sock str:input -- int:stop )
   dup is_comment? if pop pop 0 exit then
   
   | rsplit swap | rsplit
   dup "CAST" stringcmp not
    over "SEND" stringcmp not or
    over "LIST" stringcmp not or
    over "PING" stringcmp not or if
      swap | rsplit 3 rotate -4 rotate 5 rotate process_topid
   else dup "MLST" stringcmp not if pop
      list_modules foreach swap pop
         over 4 pick iwc-send pop
      repeat
      "" swap rot iwc-send pop pop 0
   else
      4 popn 0
   then then
;
   
: main_daemon ( -- )
   MUCKNAME not PASSWORD not or if
      -1 "MUCK login not configured!" do_error exit
   then background
   
   "Connecting..." 2 log
   do_connect dup string? if do_error exit then
   prog "@pid" pid setprop
   "Connected." 0 log
   
   10 "PING" timer_start
   begin
      event_wait
      dup "SOCKET.READ." stringpfx if pop
         dup nbsockrecv swap not over not and if
            pop pop 10 "Disconnected." do_error exit
         else
            process_input if exit then
         then
      else dup "USER.IWC.SEND" stringpfx if pop
         dup "caller_prog" [] prog_registered? if
            over swap "data" [] socksend not if
               pop 10 "Disconnected." do_error exit
            then
         else pop then
      else dup "TIMER.PING" strcmp not if
         pop pop dup "P //" socksend not if
            pop 10 "Disconnected." do_error exit
         then 60 "PING" timer_start
      else
         pop pop
      then then then
   repeat
;
   
( // START USER INTERFACE CODE // )
   
: do_help ( -- )
   me @ "IWCv2 client program, by Hinoserm." notify
   me @ "  " notify
   me @ { "  " command @ tolower " #help               -  Shows this help screen.          " }cat notify
   me @ { "  " command @ tolower " #reg <prog>=<name>  -  Load a program module.           " }cat notify
   (me @ { "  " command @ tolower " #config             -  Start the menu config system.    " }cat notify)
   me @ { "  " command @ tolower " #stop               -  Shut down the IWC client service." }cat notify
   me @ { "  " command @ tolower " #start              -  Start up the IWC client service. " }cat notify
   me @ { "  " command @ tolower " #restart            -  Restart the IWC client service.  " }cat notify
;
   
: do_start ( -- )
   prog "@pid" getpropval ispid? if
      me @ "\[[1;33mThe service is already started." ansi_notify
   else
      me @ "\[[1;32mStarting..." ansi_notify
      background main_daemon exit
   then
;
   
: do_stop ( -- )
   prog "@pid" getpropval dup ispid? not if
      pop me @ "\[[1;33mThe service is not started." ansi_notify
   else
      kill if
         me @ "\[[1;32mStopped." ansi_notify
      else
         me @ "\[[1;31mCould not stop the process." ansi_notify
      then
      prog "@pid" remove_prop
   then
;
   
: do_reg ( s -- )
   " " split swap pop "=" split swap
   dup not 3 pick not or if
      pop pop me @ "\[[1;33mMissing argument." notify exit
   then
   
   match dup program? not if
      pop pop me @ "\[[1;33mObject not found or not of type program." notify exit
   then
   
   swap dup name-ok? not over ok-muckname? not or if
      pop pop me @ "\[[1;31mInvalid module name." notify exit
   then
   
   register_prog
   me @ "\[[1;32mRegistered." ansi_notify
;
   
( // START USER-DEIDIOTIZER DIRECTIVES // )
   
$ansi ^YELLOW^IWC ^WHITE^>> ^RED^ Remember to:
$ansi ^YELLOW^IWC ^WHITE^>> ^GREEN^   @set iwc-client.muf=A
$ansi ^YELLOW^IWC ^WHITE^>> ^GREEN^   @set iwc-client.muf=W3
$ansi ^YELLOW^IWC ^WHITE^>> ^GREEN^   @set iwc-client.muf=L
$ansi ^YELLOW^IWC ^WHITE^>> ^GREEN^   @set iwc-client.muf=@config/muckname:<login name>
$ansi ^YELLOW^IWC ^WHITE^>> ^GREEN^   @set iwc-client.muf=@config/password:<login password>
$ansi ^YELLOW^IWC ^WHITE^>> ^GREEN^   @propset #0=dbref:_reg/iwc/sys:iwc-client.muf
$ansi ^YELLOW^IWC ^WHITE^>> ^GREEN^   @action iwc=#0=iwcact
$ansi ^YELLOW^IWC ^WHITE^>> ^GREEN^   @link $iwcact=iwc-client.muf
$ansi ^YELLOW^IWC ^WHITE^>> ^GREEN^   iwc #start
$ansi ^YELLOW^IWC ^WHITE^>> ^RED^ If you need assistance, contact hinoserm@protomuck.org.
   
( // MAIN FUNCTION // )
   
: main ( s -- )
   dup "Startup" stringcmp not trigger @ #-1 dbcmp caller program? or and if
      pop 0 try
         main_daemon
      catch
         10 "MUF ERROR: " rot strcat do_error
      endcatch exit
   else
      me @ "w" flag? not if
         me @ "\[[1;31mPermission denied." ansi_notify exit
      then
      dup "#restart" stringcmp not if pop do_stop do_start exit then
      dup "#start"   stringcmp not if pop do_start exit then
      dup "#stop"    stringcmp not if pop do_stop  exit then
      dup "#reg"     stringpfx     if     do_reg   exit then
      pop do_help exit
   then
;
.
c
q