@program client.proto.net.muf 1 10000 d i $include $lib/alynna lvar packetsArray lvar maininstance lvar mnsarray lvar peers lvar myport lvar myname lvar myip lvar myfname $def p.net "$p.net/sys" match $def | 160 itoc $def .tell me @ ok? if me @ swap ansi_notify else logstatus then $def PACKET_NEW 1 $def PACKET_SENT 4 $def PACKET_ACKNOWLEDGED 16 $def PACKET_CONFIRMED 256 $def PACKET_FINISHED 4096 $def PACKET_DEAD 65535 $def DEBUG prog "?" flag? if prog owner "P.NET: " rot strcat ansi_notify then $pubdef : $pubdef p.net "$p.net/sys" match $pubdef | 160 itoc $pubdef mymuck "$p.net/sys" match "_p.net/name" getpropstr : zeropad[ str:hex int:digits -- str:result ] "0000000000000000" hex @ strcat dup strlen digits @ - strcut swap pop ; : mkguid[ -- str:guid ] systime_precise ftostrc ; PUBLIC mkguid $libdef mkguid : fastSetup prog "_p.net/name" getprop myname ! prog "_p.net/port" getprop myport ! prog "_p.net/ip" getpropstr myip ! prog "_p.net/fname" getpropstr myfname ! ; : atos[ a:input -- s:output ] input @ not if "" exit then { input @ foreach swap pop var! item item @ string? if 19 itoc item @ base64encode " " then item @ int? if 14 itoc item @ intostr " " then item @ float? if 6 itoc item @ ftostrc " " then item @ dbref? if 4 itoc "#" item @ int intostr " " then repeat }cat strip ; PUBLIC atos $libdef atos : stoa[ s:input -- a:output ] input @ not if 0 array_make then var x { input @ " " explode_array foreach swap pop var! item item @ 1 strcut item ! x ! x @ case 19 itoc strcmp not when item @ base64decode end 14 itoc strcmp not when item @ atoi end 6 itoc strcmp not when item @ strtof end 4 itoc strcmp not when item @ atoi dbref end endcase repeat }array ; PUBLIC stoa $libdef stoa : p.net.packetgive prog "_pid" getprop "want.packet" pid event_send event_wait pop "data" [] packetsArray ! ; : getMUCK[ s:item s:muck -- value ] p.net { "/_mucks/" muck @ "/" item @ }cat getprop ; PUBLIC getMUCK $libdef getMUCK : getPacket[ s:item s:guid -- value ] packetsArray @ { guid @ item @ }array array_nested_get ; : setPacket[ s:item s:guid value -- ] value @ packetsArray @ { guid @ item @ }array array_nested_set packetsArray ! ; : clearPacket[ s:guid -- ] packetsArray @ guid @ array_delitem packetsArray ! ; : MUCKlist[ -- a:mucklist ] p.net { "/_mucks/" }cat array_get_propdirs ; PUBLIC MUCKlist $libdef MUCKlist : MNSlist[ -- a:mnslist ] p.net "/_p.net/mns" array_get_proplist ; PUBLIC MNSlist $libdef MNSlist : MUCKResolve[ s:muckname -- s:ip s:port ] "ip" muckname @ getmuck dup not if pop "" then "port" muckname @ getmuck ; PUBLIC MUCKResolve $libdef MUCKResolve : sendACK[ s:guid s:ip i:port -- ] { guid @ | "ACK!" }cat ip @ port @ udpsend pop ; : udpsendEx[ s:payload s:ip i:port -- ] { "payload" payload @ "ip" ip @ "port" port @ "status" PACKET_SENT }dict maininstance @ if packetsArray @ mkguid dup var! guid array_setitem packetsArray ! else prog "_pid" getprop "UDPSEND" rot event_send then { guid @ | payload @ }cat ip @ port @ udpsend pop ; ( In order to remain a decentralized network, the client is responsible for doing its own broadcasts ) : p.bcast[ a:payload s:progid s:funcid -- ] prog "_p.net/name" getprop var! myname { myname @ | me @ | "*" | progid @ | funcid @ | payload @ atos }cat var! common mucklist foreach swap pop var! muckid { "CALL" | mkguid | common @ }cat muckid @ MUCKresolve udpsendEx repeat ; PUBLIC p.bcast $libdef p.bcast : p.call[ a:payload s:target s:muckid s:progid s:funcid -- ] prog "_p.net/name" getprop var! myname { "CALL" | mkguid | myname @ | me @ | target @ | progid @ | funcid @ | payload @ atos }cat muckid @ MUCKresolve udpsendEx ; PUBLIC p.call $libdef p.call : p.callback[ a:payload s:source s:target s:muckid s:progid s:funcid -- ] prog "_p.net/name" getprop var! myname { "BACK" | mkguid | myname @ | source @ name | target @ | progid @ | funcid @ | payload @ atos }cat muckid @ MUCKresolve udpsendEx ; PUBLIC p.callback $libdef p.callback : p.net.sync[ i:forced? -- ] fastSetup var besttime "" var! bestip 0 var! bestport ( Things to do during a net sync ) ( 1: send pings to all MNS servers to find out who its fastest to talk to ) prog "/_ping/" remove_prop MNSList foreach swap pop ":" split atoi var! port var! ip mkguid var! guid prog { "_ping/" guid @ "/ip" }cat ip @ setprop prog { "_ping/" guid @ "/port" }cat port @ setprop prog { "_ping/" guid @ "/sent" }cat systime_precise dup besttime ! setprop { guid @ | "PING" | besttime @ | myname @ | myport @ | myfname @ }cat ip @ port @ udpsend pop forced? @ if { "Ping " ip @ ":" port @ " with guid " guid @ "..." }tell then repeat forced? @ if { "Waiting 5 seconds for responses..." }tell then 5 sleep ( Wait 5 seconds for pings to come back ) 1000.0 besttime ! prog "_ping/" array_get_propdirs foreach swap pop var! cur prog { "_ping/" cur @ "/received" }cat getprop if prog { "_ping/" cur @ "/ip" }cat getprop ip ! prog { "_ping/" cur @ "/port" }cat getprop port ! prog { "_ping/" cur @ "/received" }cat getprop prog { "_ping/" cur @ "/sent" }cat getprop - prog { "_ping/" cur @ "/time" }cat rot dup var! pingtime setprop forced? @ if { "^GREEN^" prog { "_ping/" cur @ "/ip" }cat getprop ":" prog { "_ping/" cur @ "/port" }cat getprop " responded in " pingtime @ 4 round " seconds." }tell then else forced? @ if { "^RED^" prog { "_ping/" cur @ "/received" }cat getprop " did not respond!" }tell then then pingtime @ besttime @ < if ip @ bestip ! port @ bestport ! pingtime @ besttime ! then repeat prog "_p.net/fastestip" bestip @ setprop prog "_p.net/fastestport" bestport @ setprop prog "_p.net/fastesttime" besttime @ setprop forced? @ if { "^GREEN^Using MNS server " bestip @ ":" bestport @ " for the next 5 minutes. Responded in " besttime @ dup int? if 0 else 4 round then " seconds." }tell then forced? @ if { "^GREEN^Requesting LIST from the MNS server." }tell then { mkguid | "LIST" | myname @ }cat bestip @ bestport @ udpsend pop ; ( What does the proto.net handler need to process? |ACK! All we do here is notify udpsendEx that the packet with this guid was received by the remote host. |PONG||| The only thing we really care about right now is the guid and the IP. We use systime_precise to measure how long it took us to get the pong, and record the IP we got back as our IP, because it will be the value the other side saw, meaning, our external IP if we're behind a firewall. |CALL|||||| |BACK|||||| Used by p.net, p.bcast, and p.callback to execute an RPC of some kind. p.net sends a CALL to a remote host. p.bcast sends a CALL to all known hosts. p.callback sends a callback to a remote host. |ERR!||| This is sent back from the remote .NET when it could not complete the call on the remote host. ) : findTarget[ s:target -- d:item ] target @ pmatch dup not if pop target @ match then ; : p.net.handler[ a:udppayload s:event s:id ] var guid var cguid var cmd var timein var timeout var muckname var ip var port var muckname2 var ip2 var port2 var fname var update var progid var funcid var tmp var stacksize var source var target fastSetup udppayload @ "data" [] not if exit then udppayload @ "from" [] ip ! udppayload @ "data" [] | split | split rot guid ! swap cmd ! "status" guid @ getPacket PACKET_ACKNOWLEDGED = if pop exit then cmd @ not if pop exit then cmd @ "ACK!" smatch if pop "status" guid @ PACKET_ACKNOWLEDGED setPacket exit then ( packetsArray @ debug_line pop ) cmd @ "PONG" smatch if | split swap timeout ! | split swap muckname ! ip2 ! prog { "_ping/" guid @ "/received" }cat systime_precise setprop prog "_p.net/ip" ip2 @ setprop exit then cmd @ "{CALL|BACK}" smatch if | split swap cguid ! | split swap muckname ! | split swap source ! | split swap target ! | split swap progid ! | split swap funcid ! stoa tmp ! guid @ muckname @ muckresolve sendACK fork not if { "$p.net/" progid @ }cat match dup progid ! if progid @ ".net." funcid @ strcat cancall? if 0 try cmd @ "CALL" smatch if cguid @ muckname @ source @ target @ tmp @ progid @ ".net." funcid @ strcat call else cguid @ muckname @ source @ target @ findtarget tmp @ progid @ ".net." funcid @ strcat call then catch var! awshit { guid @ | "ERR!" | cguid @ | myname @ | awshit @ }cat muckname @ MUCKResolve udpsend pop endcatch else { guid @ | "ERR!" | cguid @ | myname @ | "ERR_NO_FUNCTION" }cat muckname @ MUCKResolve udpsend pop then else { guid @ | cguid @ | myname @ | "ERR_NO_PROGRAM" }cat muckname @ MUCKResolve udpsend pop then pid kill then then cmd @ "MUCK" smatch if | split swap muckname ! | split swap ip2 ! | split swap port2 ! | split swap timein ! fname ! p.net { "/_mucks/" muckname @ "/name" }cat muckname @ setprop p.net { "/_mucks/" muckname @ "/ip" }cat ip2 @ setprop p.net { "/_mucks/" muckname @ "/port" }cat port2 @ atoi setprop p.net { "/_mucks/" muckname @ "/fname" }cat fname @ setprop p.net { "/_mucks/" muckname @ "/lastping" }cat timein @ strtof setprop then ; : p.net.dispatcher[ a:payload s:event s:id ] payload @ "data" [] packetsArray @ mkguid dup var! guid array_setitem packetsArray ! ; : p.net.packetmgr[ a:payload s:event s:id ] ( packetsArray @ debug_line pop ) packetsArray @ foreach var! packet var! guid guid @ "0" smatch if guid @ clearPacket continue then systime_precise guid @ strtof 10.0 + < if guid @ clearPacket continue then packet @ "status" [] PACKET_ACKNOWLEDGED = not if packet @ "payload" [] packet @ "ip" [] packet @ "port" [] udpsend pop then repeat 2 "PNET.PACKET" timer_start ; : firstSetup ( Preload the MNS server list with some known defaults ) prog "_p.net/mns#" getprop not if { "204.212.105.214:8453" (Alynna) "204.209.44.28:8453" (Hinoserm) "70.96.227.46:8453" (Cyberleo) "64.246.24.15:8453" (Cassie) }array prog "_p.net/mns" rot array_put_proplist then ( Find a free port to listen on ) prog "_p.net/port" getprop not if 8472 myport ! begin myport @ udpopen not if myport ++ else break then repeat myport @ udpclose prog "_p.net/port" myport @ setprop then ( If I dont have a name set, set one ) prog "_p.net/fname" getprop not if { "Proto.NET: Please enter the full name of your MUCK." }tell { "It can have spaces and everything:" }tell prog "_p.net/fname" read setprop then prog "_p.net/name" getprop not if { "Proto.NET: Please enter the short name of your MUCK (like an abbreviation)" }tell { "Here's a good example. SCHotE: Southern Cross: Heart of the Empire" }tell { "Do not use any spaces, and keep it pretty short. We have to code with it." }tell prog "_p.net/name" read setprop then ; : p.net.stop prog "_pid" getprop "TERMINATE" 0 event_send me @ if { "^GREEN^Proto.NET stopped." }tell then ; : p.net.start background prog "_pid" pid setprop 1 maininstance ! 0 array_make_dict packetsArray ! myport @ udpopen not if { "Failed to open the port I was originally set up with! (" myport @ ")" }cat .tell exit then ( Timer events ) 2 "PNET.PACKET" timer_start 300 "PNET.NETSYNC" timer_start ( IRQs for events ) $def STRPORT prog "/_p.net/port" getprop intostr strcat "UDP." STRPORT "IRQ0" 'p.net.handler 0 onevent "USER.UDPSEND" "IRQ1" 'p.net.dispatcher 0 onevent "TIMER.PNET.PACKET" "IRQ2" 'p.net.packetmgr 0 onevent me @ if { "^GREEN^Proto.NET started." }tell then 0 p.net.sync begin depth popn event_wait depth not if continue then var! yerf var! package yerf @ "TIMER.PNET.NETSYNC" smatch if 0 p.net.sync 300 "PNET.NETSYNC" timer_start then yerf @ "USER.TERMINATE" smatch if prog "_pid" 0 setprop exit then repeat ; : main[ s:param -- ] ( Check to see if this is the first time setup ) prog "_p.net/name" getprop not if firstSetup then fastSetup command @ "@p.net" smatch if param @ "#start" smatch if p.net.start then param @ "#stop" smatch if p.net.stop then param @ "#restart" smatch if p.net.stop 1 sleep p.net.start then param @ "#sync" smatch if 1 p.net.sync then param @ "#flush" smatch if prog "_mucks" remove_prop 1 p.net.sync then param @ "#mucks" smatch if "MUCKs I know about" header tellme mucklist foreach var! cur pop { "^GREEN^" cur @ capitalize 20 lj "^CYAN^" "fname" cur @ getMUCK }tell repeat "Proto.NET v2.0" footer tellme then then command @ "Queued event." smatch if param @ "Startup" smatch if p.net.start then then ; . c q @kill me @reg client.proto.net.muf=p.net/sys @p.net.mns #start @p.net #start @p.net #sync