@program proto.net.mns.muf
1 10000 d
i
$def | 160 itoc

$include $lib/alynna
$include $p.net/sys

$def UDPPORT prog "_port" getprop

$def DEBUG prog "?" flag? if prog owner "P.NET: " rot strcat ansi_notify else pop then

$def .tell me @ ok? if me @ swap ansi_notify then
( 
  Note: MNS does not do confirmation of any packet receipt on either the client
        or server ends, because it must assume the client or MNS server might
        be down.  MNS largely ignores GUIDs, with the exception of passing the
        same GUID it got back to the sender.
  Note: | = (char)255, or \0xff
  
  Commands MNS responds to (with payload):
   <GUID>|PING|<Timein>|<Muckname>|<PortNum>|<FullName>
    PING updates a record and sends information back to both clients and MNS,
    in order to help it determine its own external IP and how fast it can talk
    to the responding server.
    
   <GUID>|UPDT|<Muckname>|<PortNum>|<ip>|<lastupdate>|<fullname>
    Used between MNS servers to propagate known information during a netsync,
    its like ping, but without a response.  An update only occurs if the
    incoming record is newer than the one that is already had.
    
   <GUID>|LIST
    LIST requests that everything that is known about any MUCKs on this server
    to be sent as MUCK updates 

   <GUID>|RSLV|<muckname>
    Same as LIST, except only for the specified host.

  Commands MNS responds with (with payload) to proto.net client port:
   <GUID>|PONG|<Timeout>|<Muckname>|<IP>
   <GUID>|MUCK|<Muckname>|<IP>|<PortNum>|<lastupdate>|<Fullname>
  
)
: mns[ a:udppayload s:event s:id ]
var guid  var cmd  var timein  var timeout  
var muckname  var ip  var port
var muckname2  var ip2  var port2
var fname   var update

( Packet processing: extract common data [the command and guid] from the packet )
0 update !

udppayload @ "from" [] ip !
udppayload @ "data" [] | split | split rot guid ! swap cmd !

udppayload @ "data" [] DEBUG

( Ping request )
cmd @ "PING" smatch if
 systime_precise timeout !
 | split swap timein !
 | split swap muckname !
 | split swap toint port !
 fname !

 ( For timing purposes, return the pong first ) 
 { guid @ | "PONG" | timeout @ | muckname @ | ip @ }cat ip @ port @ udpsend pop
 p.net { "/_mucks/" muckname @ "/lastping" }cat timeout @ setprop 

 ( check the current record and schedule an update if the record changed )
 p.net { "/_mucks/" muckname @ "/name" }cat getpropstr muckname @ smatch not if 1 update ! then
 p.net { "/_mucks/" muckname @ "/ip" }cat getpropstr ip @ smatch not if 1 update ! then 
 p.net { "/_mucks/" muckname @ "/port" }cat getprop port @ != if 1 update ! then
 p.net { "/_mucks/" muckname @ "/fname" }cat getpropstr fname @ smatch not if 1 update ! then
 
 ( if an update is required, do it )
 update @ if 
  p.net { "/_mucks/" muckname @ "/name" }cat muckname @ setprop 
  p.net { "/_mucks/" muckname @ "/ip" }cat ip @ setprop 
  p.net { "/_mucks/" muckname @ "/port" }cat port @ toint setprop 
  p.net { "/_mucks/" muckname @ "/fname" }cat fname @ setprop 
  
  ( And propagate the change to everyone I know )
  mucklist foreach swap pop muckname2 ! 
   { mkguid | "MUCK" | muckname @ | ip @ | port @ | timein @ | fname @ }cat
   p.net { "/_mucks/" muckname2 @ "/ip" }cat getprop 
   p.net { "/_mucks/" muckname2 @ "/port" }cat getprop  
   udpsend pop  
  repeat
  
  ( Then send the update to all my peers )
  p.net "_p.net/mns" array_get_proplist foreach swap pop ":" split atoi port ! ip !
   ( Except of course, myself )
   p.net "_p.net/ip" getprop ip @ smatch p.net "_p.net/port" getprop port @ = if continue then

   p.net { "/_mucks/" muckname @ "/ip" }cat getprop ip2 !
   p.net { "/_mucks/" muckname @ "/port" }cat getprop port2 !
   p.net { "/_mucks/" muckname @ "/fname" }cat getprop fname !
   p.net { "/_mucks/" muckname @ "/lastping" }cat getprop timeout !
   { mkguid | "UPDT" | muckname @ | ip2 @ | port2 @ | timeout @ | fname @ }cat ip @ port @ udpsend pop
  repeat
 then 
then

cmd @ "UPDT" smatch if
 | split swap muckname !
 | split swap ip2 !
 | split swap atoi port2 !
 | split swap strtof timein !
 fname !
 p.net { "/_mucks/" muckname @ "/lastping" }cat getprop timein @ < if
  p.net { "/_mucks/" muckname @ "/name" }cat muckname @ setprop 
  p.net { "/_mucks/" muckname @ "/ip" }cat ip2 @ setprop 
  p.net { "/_mucks/" muckname @ "/port" }cat port2 @ setprop 
  p.net { "/_mucks/" muckname @ "/fname" }cat fname @ setprop 
  p.net { "/_mucks/" muckname @ "/lastping" }cat timein @ setprop 
 then
then

cmd @ "LIST" smatch if
 muckname2 !
 p.net "/_mucks/" array_get_propdirs foreach muckname ! pop
  p.net { "/_mucks/" muckname @ "/ip" }cat getprop ip2 !
  p.net { "/_mucks/" muckname @ "/port" }cat getprop port2 !
  p.net { "/_mucks/" muckname @ "/fname" }cat getprop fname !
  p.net { "/_mucks/" muckname @ "/lastping" }cat getprop timein !
  { guid @ | "MUCK" | muckname @ | ip2 @ | port2 @ | timein @ | fname @ }cat muckname2 @ muckresolve udpsend pop
 repeat
then

cmd @ "RSLV" smatch if
 split swap muckname2 !
 muckname !
 p.net { "/_mucks/" muckname @ "/ip" }cat getprop ip2 !
 p.net { "/_mucks/" muckname @ "/port" }cat getprop port2 !
 p.net { "/_mucks/" muckname @ "/fname" }cat getprop fname !
 p.net { "/_mucks/" muckname @ "/lastping" }cat getprop timein !
 { guid @ | "MUCK" | muckname @ | ip2 @ | port2 @ | timein @ | fname @ }cat muckname2 @ muckresolve udpsend pop
then
;

: netsync
var ip2  var port2
var ip  var port var muckname  var fname  var timeout
( 
 Netsync occurs once every 5 minutes.  It will flush all records longer than
 15 minutes old, then sends UPDTs to all MNS servers.
)
( Clean up old records )
p.net "/_mucks/" array_get_propdirs foreach muckname ! pop
 systime_precise p.net { "/_mucks/" muckname @ "/lastping" }cat getprop 1800 + >= if
  p.net { "/_mucks/" muckname @ "/" }cat remove_prop
 then
repeat

( Send updates to all my peers )
p.net "_p.net/mns" array_get_proplist foreach ":" split atoi port ! ip ! pop
 ( Except of course, myself )
 p.net "_p.net/ip" getprop ip @ smatch if continue then
 
 p.net "/_mucks/" array_get_propdirs foreach swap pop muckname !
  p.net { "/_mucks/" muckname @ "/ip" }cat getprop ip2 !
  p.net { "/_mucks/" muckname @ "/port" }cat getprop port2 !
  p.net { "/_mucks/" muckname @ "/fname" }cat getprop fname !
  p.net { "/_mucks/" muckname @ "/lastping" }cat getprop timeout !
  { mkguid | "UPDT" | muckname @ | ip2 @ | port2 @ | timeout @ | fname @ }cat ip @ port @ udpsend pop
 repeat
repeat  
300 "NETSYNC" timer_start
;

: mnsd
background
{ "Proto.NET MUCK name server daemon v1.0" }cat .tell

( Automatic registration )
#0 "_reg/p.net/mns" getprop not if
 #0 "_reg/p.net/mns" prog setprop
then

( Try to open a UDP socket )
UDPPORT udpopen not if 
 "[PNET]: MNS server could not bind to UDP port 8453!  Please check for duplicate MNS servers running on this IP." dup logstatus .tell exit
then

( Set up the UDP event )
"UDP." UDPPORT intostr strcat "MNS" 'mns 0 onevent

( Set up a timer event for server sync, and start with a sync )
300 "NETSYNC" timer_start netsync

( Say I am running )
prog "_pid" pid setprop
{ "mnsd started successfully." }cat .tell

( Sit in an event wait loop, and react to the netsync timer )
begin
 event_wait "Timer.*" smatch if pop netsync then
 0 sleep
repeat
;

: destroy
prog "_pid" getprop kill
{ "mnsd stopped successfully." }cat .tell
;

: main
UDPPORT not if prog "_port" 8453 setprop then
var! param
param @ "#start" smatch if mnsd then
param @ "startup" smatch if mnsd then
param @ "#stop" smatch if destroy then
param @ "#restart" smatch if destroy mnsd then
param @ "#sync" smatch if netsync then
;
.
c
q
lsedit $p.net/sys=_p.net/mns
.del 1 10000
204.212.105.214:8453
204.209.44.28:64738
70.96.227.46:8453
64.246.24.15:8453
.end
@kill me
@reg proto.net.mns.muf=p.net/mns
@p.net.mns #start
@p.net #start