@prog new-nni.muf
1 99999 d
1 i
( new-nni.muf Written by Hinoserm. Use freely, but at your own risk. 11/05/02 )
(-----------------------------------------------------------------------------)
( To install program:                                                         )
(                                                                             )
( Upload program and set it A. Recompile program to start it. You can watch   )
(  the logwall for some status messages when the program connects or          )
(  disconnects so that you know it's working properly.                        )
(                                                                             )
( Create an action named 'nni' [I usually name it 'nni;ni;xpub'] and link it  )
(  to this program.                                                           )
(                                                                             )
( '@set nni=_/channel:NNI'. This step is very important, especially if you've )
(  got aliases to the NNI action, since this tells it which channel the       )
(  action belongs to. If this prop isn't set, it can lead to all sorts of     )
(  problems.                                                                  )
(                                                                             )
(  You may also create other channels. Use the steps above, replacing all     )
(   instances of 'NNI' with whatever you want to name your new channel.       )
(  But remember, new channels are only useful if you tell other MUCKs about   )
(   them, and the other MUCKs must also set them up as described above.       )
(                                                                             )
( That's it! The channels default to off, see 'nni #help' for more info.      )
(                                                                             )
( Should the connection to the server ever be interrupted, the program will   )
(  automaticly detect this and attempt to reconnect every 30 seconds until    )
(  it succeeds.                                                               )
(-----------------------------------------------------------------------------)
( Program must be set W3, since it uses socket primitives.                    )
(                                                                             )
( Also, if you don't have socket events enabled, or can't support them, the   )
(  program will loop continually looking for new data to read off the socket. )
(                                                                             )
( This is unavoidable without socket events, so expect the program to use     )
(  rather large amounts of CPU time. If you're experianced enough, you can    )
(  try to optimize my code a bit better. If you succeed, let me know, I'd be  )
(  more than happy to implement any changes that improve speed.               )
(                                                                             )
( I highly suggest you '@tune log_sockets=off' before using this program      )
(  without socket event support.                                              )
(                                                                             )
( This program currently can only run on ProtoMUCK versions 1.75 or higher.   )
(  If you can modify it to run on other versions and/or other MUCK servers, I )
(  would be more than happy to implement the changes.                         )
(                                                                             )
( Questions? Complaints? Comments? Contact me! fox85@ginkosoft.com            )
(-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-)
( This program is to be considered HIGHLY UNSTABLE and DANGEROUS.             )
( If it breaks, let me know, but I assume no responsibility if it causes any  )
(  damage.                                                                    )
(-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-!-)
(
IWC|MSG|<MUCK>|<CHAN>|<PREF>|<MSG>
IWC|WHO|<MUCK>|<CHAN>|<PREF>
IWC|RWH|<TMCK>|<MUCK>|<CHAN>|<PREF>|<WHO>|<UWHO>
IWC|NCH|<MUCK>|<CHAN>|<TAG>|<TEXTC>|<OREF>
IWC|MLS|<MUCK>|<CHAN>|<PREF>
IWC|RML|<TMCK>|<MUCK>|<CHAN>|<PREF>
IWC|GLS|<MUCK>
IWC|RGL|<TMCK>|<MUCK>|<CHANLIST>
)
( User changable defines: )
$def punctarr { " "  "." ","  "'" "`"  ":" ";"  "!" "?"  "-" "_"  "+" "=" } array_make
$def pingtime 30 ( Time between each ping, in seconds. Try to keep this above 10. )
( System defines: )
$def |  27 itoc strcat
$def |s 27 itoc strcat strcat
$def getpid prog "@pid" getpropstr atoi
$def pad ( s i -- s ) "                                  " rot swap strcat swap ansi_strcut pop
( This program doesn't run properly on ProtoMUCK versions below 1.75, so I added this check. )
$ifdef __proto<Proto1.75
   $abort Only supported by ProtoMUCK 1.75 or higher.
$endif
( This check makes socket events-related stuff happy. )
$ifdef __proto<Proto1.80
   $def SEVENTS 0
   $ansi --^RED^ProtoMUCK version is below 1.80.
   $ansi --^RED^Socket event usage will be disabled.
   $ansi --^RED^Expect the program to use tons of CPU time.
$else
   $def SEVENTS "socket_events" sysparm "yes" stringcmp not
$endif
( Smaller functions used throughout the program: )
: gethostname  ( -- s ) prog "_/host" getpropstr dup not if pop "caffeine.ginkosoft.com" then ;
: getportnum   ( -- i ) prog "_/port" getpropstr dup not if pop 39397 else atoi then ;
: getmuckname  ( -- s ) prog "_/muck" getpropstr dup not if pop "muckname" sysparm then ;
: getcname     ( -- s ) trigger @ "_/channel" getpropstr dup not if pop command @ then ;
: getcprop   ( s -- s ) me @ "_/ichan/" getcname strcat "/" strcat rot strcat getpropstr ;
: setcprop ( s x -- s ) me @ "_/ichan/" getcname strcat "/" strcat 4 rotate strcat rot setprop ;
: getarg   ( a x -- s ) array_getitem dup string? not if pop "" then ;
: do_restart   ( i -- ) prog "@pid" remove_prop prog "Startup" queue pop exit ;
: e_send       ( s -- ) getpid dup ispid? if "out" rot event_send else pop then ;
( Larger functions used throughout the program: )
: parse_idle ( i -- s )
   dup 31535999 > if
      pop "365d"
   else dup 86399 > if
      86400 / intostr "d" strcat
   else dup 3599 > if
      3600 / intostr "h" strcat
   else dup 59 > if
      60 / intostr "m" strcat
   else
      intostr "s" strcat
   then then then then
;
( Packet processing functions: )
( IWC|MSG|<MUCK>|<CHAN>|<PREF>|<MSG>)
: process_message ( a -- )
   dup 1 array_getitem dup string? not if 2 popn exit then
   dup -3 rotate "^RED^" swap strcat "> ^YELLOW^[^CYAN^" strcat
   over 0 array_getitem dup string? not if 4 popn exit then
   "^YELLOW^] ^NORMAL^" strcat strcat
   swap 3 getarg strcat
   ( chan msg )
   1 array_make online_array "_/ichan/" 4 rotate strcat "/on?" strcat "yes" array_filter_prop array_ansi_notify
;
( IWC|WHO|<MUCK>|<CHAN>|<PREF> )
: process_who_cmd ( a -- )
   ( muck chan pref )
   dup 0 array_getitem dup string? not if
      2 popn exit
   then "IWC" | "RWH" |s swap |s getmuckname |s
   ( a s )
   over 1 array_getitem dup string? not if
      3 popn exit
   then dup -4 rotate |s
   swap 2 array_getitem dup string? not if
      4 popn exit
   then |s
   ( muck chan pref d i )
   online_array foreach swap pop
      3 pick "*" stringcmp not over "_/ichan/" 6 pick strcat "/on?" strcat getpropstr "yes" stringcmp not or if
         dup name | over unparseobj |s swap descrleastidle descridle parse_idle strcat over swap strcat e_send
      else pop then
   repeat 2 popn
;
( IWC|RWH|<TMCK>|<MUCK>|<CHAN>|<PREF>|<WHO>|<UWHO>|<IDLE> )
: process_who_reply ( a -- )
   dup 0 getarg getmuckname stringcmp if pop exit then
   dup  4 getarg 15 pad "  " strcat          ( Name )
   over 1 getarg 19 pad "  " strcat strcat   ( MUCK )
   over 6 getarg 6  pad      strcat          ( Idle )
   swap 3 getarg stod dup ok? not if         ( PRef )
      2 popn exit
   then
   swap ansi_notify
;
( IWC|RML|<TMCK>|<MUCK>|<PREF>|<MDSC>|<MHPT> )
: process_mlist_reply ( a -- )
   dup 0 getarg getmuckname stringcmp if pop exit then
   dup  1 getarg 19 pad "  " strcat          ( MUCK     )
   over 4 getarg 24 pad "  " strcat strcat   ( ConnInfo )
   over 3 getarg 30 pad      strcat          ( Desc )
   swap 2 getarg stod dup ok? not if         ( PRef )
      2 popn exit
   then
   swap ansi_notify
;
( IWC|MLS|<MUCK>|<PREF> )
: process_mlist_cmd ( a -- )
   ( muck chan pref )
   dup 0 array_getitem dup string? not if
      2 popn exit
   then "IWC" | "RML" |s swap |s getmuckname |s
   swap 1 array_getitem dup string? not if
      3 popn exit
   then |s
   prog "_/muckdesc"     getpropstr |s
   prog "_/muckhostport" getpropstr strcat

   e_send
;

(
  IWC|MSG|<MUCK>|<CHAN>|<PREF>|<MSG>
  IWC|WHO|<MUCK>|<CHAN>|<PREF>
  IWC|RWH|<TMCK>|<MUCK>|<CHAN>|<PREF>|<WHO>|<UWHO>
  IWC|NCH|<MUCK>|<CHAN>|<TAG>|<TEXTC>|<OREF>
  IWC|MLS|<MUCK>|<PREF>
  IWC|RML|<TMCK>|<MUCK>|<PREF>|<MDSC>|<MHPT>
  IWC|CLS|<MUCK>
  IWC|RCL|<TMCK>|<MUCK>|<CHANLIST>
)
: process_input ( s -- )
   27 itoc split swap "IWC" stringcmp if
      pop exit
   else ( cmd muck|... )
      27 itoc split 27 itoc explode_array swap
      dup "MSG" stringcmp 0 = if
         pop process_message exit
      else dup "WHO" stringcmp 0 = if
         pop process_who_cmd exit
      else dup "RWH" stringcmp 0 = if
         pop process_who_reply exit
      else dup "MLS" stringcmp 0 = if
         pop process_mlist_cmd exit
      else dup "RML" stringcmp 0 = if
         pop process_mlist_reply exit
      else
         2 popn exit
      then then then then then
   then
;
: do_opensock ( s i -- x ; Try to open a connection. If fails, returns string with error. Otherwise, returns sock. )
   nbsockopen dup "Operation now in progress" stringcmp if
      swap pop
   else pop
      20 "timeout" timer_start
      begin
         "TIMER.timeout" event_exists if
            pop "Connection timed out" break
         then
         dup sockcheck dup 1 = if
            pop break
         else -1 = if
            pop "Connection refused" break
         then then
         prog "d" flag? sleep
      repeat
      "timeout" timer_stop
   then
;
: do_disconnected ( sock -- )
   "INET: Connection closed. Attempting to restart..." logstatus
   prog "_/lastconnerr" "Connection closed." setprop
   sockclose pop 10 do_restart exit
;
: do_login ( sock -- i )
   dup "LGN" | getmuckname |s prog "@/loginpass" getpropstr strcat socksend 0 = if do_disconnected 0 exit then
   20 "lgntimeout" timer_start
   begin
      SEVENTS if event_wait else event_count if event_wait else dup "SOCKET.READ" then then
      dup "SOCKET.READ" stringpfx if pop
         dup nbsockrecv swap not SEVENTS and if pop do_disconnected 0 exit else
            dup not if pop pop continue then
            "LGN" | "SUCC" strcat stringcmp if
               "INET: Login failure. Your password may be invalid or your MUCK name may" logstatus
               "INET:  have been changed. To obtain proper login information, contact" logstatus
               "INET:  fox85@ginkosoft.com. Program halted." logstatus
               sockclose pop 0 exit
            else
               pop 1 exit
            then
         then
      else
         "TIMER.lgntimeout" stringpfx if pop do_disconnected 0 exit then
      then
      prog "d" flag? sleep
   repeat
;
: start-daemon ( -- )
   background
   gethostname getportnum do_opensock dup string? if
      prog "_/lastconnerr" rot setprop
      30 do_restart exit
   else
      "INET: Connected. Logging in..." logstatus
      dup do_login not if pop exit then
      prog "@pid" pid intostr setprop
      10 "ping" timer_start
      SEVENTS swap
      begin
       over if event_wait else event_count if event_wait else dup "SOCKET.READ" then then
       dup "SOCKET.READ" stringpfx if pop
         dup nbsockrecv swap not SEVENTS and if pop
           do_disconnected exit
         else swap pop dup if
           1 try process_input catch "INET(PROCESS_INPUT): " swap strcat logstatus endcatch
         else pop then then
       else dup "TIMER.ping" stringcmp not if
         2 popn dup "IWC" | "PNG" |s getmuckname strcat socksend 0 = if
           do_disconnected exit
         then
         10 "ping" timer_start
       else dup "USER.out" stringcmp not if
         pop "data" getarg over swap socksend 0 = if
           do_disconnected exit
         then
       else 2 popn then then then
       prog "d" flag? sleep
      repeat
   then
;
: do_help ( -- )
   me @ "InterMUCK channel program, written by Hinoserm. (v1.3)" ansi_notify
   me @ " " ansi_notify
   me @ "^BLUE^Usage:" ansi_notify
   me @ "^GREEN^  " command @ strcat "  ^WHITE^<^YELLOW^msg^WHITE^>"  strcat 25 pad "- ^BLUE^Say something over the net."  strcat ansi_notify
   me @ "^GREEN^  " command @ strcat "^CYAN^ :^WHITE^<^YELLOW^msg^WHITE^>" strcat 25 pad "- ^BLUE^Pose something over the net." strcat ansi_notify
   me @ " " ansi_notify
   me @ "^GREEN^  " command @ strcat "^CYAN^ #help" strcat 25 pad "^WHITE^- ^BLUE^This help screen."      strcat ansi_notify
   me @ "^GREEN^  " command @ strcat "^CYAN^ #on"   strcat 25 pad "^WHITE^- ^BLUE^Turn this channel on."  strcat ansi_notify
   me @ "^GREEN^  " command @ strcat "^CYAN^ #off"  strcat 25 pad "^WHITE^- ^BLUE^Turn this channel off." strcat ansi_notify
   me @ " " ansi_notify
   me @ "^GREEN^  " command @ strcat "^CYAN^ #who"  strcat 25 pad "^WHITE^- ^BLUE^Show who's listening to this channel." strcat ansi_notify
   me @ "^GREEN^  " command @ strcat "^CYAN^ #mucks" strcat 25 pad "^WHITE^- ^BLUE^Show all MUCKs connected to the network." strcat ansi_notify
;
: do_chan ( s -- )
   getpid ispid? not if pop "^RED^No connection." me @ swap ansi_notify exit then
   dup "#HELP" stringcmp not if
      pop do_help exit
   then
   dup "#ON" stringcmp not if
      pop me @ "^GREEN^Channel turned on." ansi_notify
      me @ name " has joined the channel." strcat
      "IWC" | "MSG" |s getmuckname |s getcname |s me @ dtos |s swap strcat e_send
      "on?" "yes" setcprop exit
   then
   dup "#WHO" stringcmp not if
      me @ "Players listening to channel (" getcname strcat "):" strcat ansi_notify
      me @ "                                            " ansi_notify
      me @ "Player           MUCK name            Idle  " ansi_notify
      me @ "---------------  -------------------  ------" ansi_notify
      pop "IWC" | "WHO" |s getmuckname |s getcname |s me @ dtos strcat e_send exit
   then
   dup "#MUCKS" stringcmp not if
      me @ "MUCKs connected to the network:                                              " ansi_notify
      me @ "                                                                             " ansi_notify
      me @ "MUCK name            Connection info           Description                   " ansi_notify
      me @ "-------------------  ------------------------  ------------------------------" ansi_notify
      pop "IWC" | "MLS" |s getmuckname |s me @ dtos strcat e_send exit
   then
   "on?" getcprop "yes" stringcmp if
      pop me @ "^RED^You don't have this channel turned on!" ansi_notify exit
   then
   dup "#OFF" stringcmp not if
      pop me @ "^GREEN^Channel turned off." ansi_notify
      "on?" "" setcprop
      me @ name " has left the channel." strcat
      "IWC" | "MSG" |s getmuckname |s getcname |s me @ dtos |s swap strcat e_send
      exit
   then
   1 strcut swap dup ":" stringcmp if swap strcat
      me @ name " says, \"" strcat swap strcat "\"" strcat
   else pop
      dup 1 strcut pop punctarr foreach swap pop over stringcmp not if pop "" break then repeat if " " swap strcat then
      me @ name swap strcat
   then
   "IWC" | "MSG" |s getmuckname |s getcname |s me @ dtos |s swap strcat e_send

   me @ "_/ichan/" getcname strcat "/lasttime" strcat systime intostr setprop
;
: main
   prog "@/loginpass" getpropstr not if
      me @ "^RED^The MUCK login password is not properly set." ansi_notify
      me @ "^RED^Please obtain a password for this system." ansi_notify
      exit
   then
   dup "Startup" stringcmp not trigger @ exit? not and if pop
      0 try
        start-daemon exit
      catch
        "INET(START-DAEMON): " swap strcat " (Restart in 1m)" strcat logstatus
      endcatch
   else
      do_chan exit
   then
;
.
c
q
@register #me new-nni.muf=tmp/prog1
@set $tmp/prog1=L
@set $tmp/prog1=A
@set $tmp/prog1=2
@propset $tmp/prog1=int:/.debug/crashpid:5
@propset $tmp/prog1=int:/.debug/errcount:1
@propset $tmp/prog1=str:/.debug/lastarg:Startup
@propset $tmp/prog1=str:/.debug/lastcmd:Queued Event.
@propset $tmp/prog1=int:/.debug/lastcrash:1055624020
@propset $tmp/prog1=str:/.debug/lastcrashtime:06/14/03 20:53:41
@propset $tmp/prog1=str:/.debug/lasterr:new-nni.muf(#3884), line 344; GETPROPSTR: Non-object argument (1)
@propset $tmp/prog1=int:/.debug/lastplayer:2
@propset $tmp/prog1=str:/@/loginpass:enemy.org
@propset $tmp/prog1=str:/@pid:5
@propset $tmp/prog1=str:/_/de:A scroll containing a spell called new-imc.muf
@propset $tmp/prog1=str:/_/lastconnerr:Connection closed.
@propset $tmp/prog1=str:/_/muckdesc:muck.animaltracks.net:1418
@propset $tmp/prog1=str:/_/muckhostport:209.77.107.10:1418
@propset $tmp/prog1=str:/_/mucks/FFDA/pass:enemy.org
@propset $tmp/prog1=str:/_/shortdesc:muck.animaltracks.net:1418
@action pdev;pd=#0=tmp/exit1
@link $tmp/exit1=
@propset $tmp/exit1=str:/_/channel:PDEV
@action @xpub;xpub;[;nni=#0=tmp/exit1
@link $tmp/exit1=
@propset $tmp/exit1=str:/@thingie:yes
@propset $tmp/exit1=str:/_/channel:NNI