@program libNewProtoNet.so.1.0.muf
1 10000 d
i
$author Alynna
$version 1.0
$def VERSION { "libProtoNet v" prog "_version" getprop }cat

( How to set up a protodns server -- must be root
  1. Add to /etc/inetd.conf
     8853    stream  tcp     nowait root /usr/sbin/tcpd /usr/local/bin/protodns
     
  2. Upload this file to your server as /usr/local/bin/protodns
     #!/bin/bash
     read REQUEST
     dig +short $REQUEST
  
  3. chmod 755 /usr/local/bin/protodns
  
  4. killall -HUP inetd

If you dont have root, you can use someone elses protodns server, 
but ask the admin first.

209.77.107.10 is permitted to be used, to use this server:
@set $lib/net=_dns:209.77.107.10
@set $lib/net=_bcast:209.77.107.10
)
( config )
$def DISPATCHLISTENERS 8
$def SOCKIDLETIME 60
$def DEBUG prog "MOBILE" flag? if log_status then
( globals )
lvar param
lvar listener
lvar lsocket

$def tostack array_vals pop
$pubdef tostack array_vals pop

$def fromstack array_make
$pubdef fromstack array_make

$def DNSSERVER prog "_dns" getprop

$libdef array2string
: array2string[ arr:stack -- str:string ]
var item
{
stack @ foreach item ! pop 
item @ case
 dbref? when { "d:" item @ }cat end
 int? when { "i:" item @ }cat end
 float? when { "f:" item @ }cat end
 string? when { "s:" item @ }cat end
 default { "x:error" item @ }cat end
endcase
"||"
repeat
}cat
dup strlen 2 - strcut pop
; PUBLIC array2string

$libdef string2array
: string2array[ str:string -- arr:stack ]
var item
string @ "||" explode_array foreach item ! pop 
item @ case
 "d:*" when "" "d:#" subst atoi dbref end
 "i:*" when "" "i:" subst atoi end
 "f:*" when "" "f:" subst strtof dbref end
 "s:*" when 2 strcut swap pop end
endcase
repeat
}array
; PUBLIC string2array

$libdef getsock
: getsock[ sock:socket string:prop -- ? ]
prog { "/~socket/" socket @ sockdescr "/" prop @ }cat getprop
; PUBLIC getsock

$libdef setsock
: setsock[ sock:socket string:prop value -- ? ]
prog { "/~socket/" socket @ sockdescr "/" prop @ }cat value @ setprop
; PUBLIC setsock

$libdef clearsock
: clearsock[ sock:socket -- ? ]
prog { "/~socket/" socket @ sockdescr "/" }cat remove_prop
; PUBLIC clearsock

$libdef netmsg
: netmsg[ sock:socket int:msg -- ]
msg @ case
 200 = when socket @ "200 OK" socksend end
 210 = when socket @ "210 Authentication token OK" socksend end
 220 = when socket @ { "220 " VERSION }cat socksend end
 298 = when socket @ { "298 Idle " SOCKIDLETIME " seconds.  Goodbye." }cat socksend end
 299 = when socket @ "299 Goodbye" socksend end
 300 = when socket @ "300 System AUTH required" socksend end
 301 = when socket @ "301 User AUTH required" socksend end
 402 = when socket @ "402 Host access denied " socksend end
 403 = when socket @ "403 User access denied" socksend end
 404 = when socket @ "404 Service not found or unsupported" socksend end
 500 = when socket @ "500 MUF error" socksend end
 501 = when socket @ "503 Malformed authentication token" socksend end
 503 = when socket @ "503 Malformed stack" socksend end
 599 = when socket @ "599 Bad command" socksend end
endcase
pop
; PUBLIC netmsg


$libdef dns
: dns[ str:query -- str:canon-name str:ip ]
var socket
DNSSERVER 8853 sockopen pop socket !
1 3 1 for pop socket @ sockcheck 0 > if break then repeat
socket @ sockcheck 0 <= if
 "Connection refused" "" socket @ sockclose exit
then
socket @ query @ socksend pop
1 sleep
socket @ sockcheck 0 <= if
 "" "" socket @ sockclose pop exit
then
socket @ sockrecv
socket @ sockrecv
socket @ sockclose pop
; PUBLIC dns

: handler[ sock:socket str:arguments -- ? ]
var cmd
var arg
var target
var pw

arguments @ " " split arg ! cmd !
cmd @ case
 "AUTH" smatch when
  0 sleep
  end
 "HELP" smatch when
 {
 "266 AUTH <username> <password> -- Upgrade to permissions given in specified authentication token"
 "266                               In all other cases it gets anonymous permissions (Guest)"
 "266 EXEC <service> <stack>     -- Execute this service, stack is a string from array2string"
 "266 BCST <service> <stack>     -- Execute this service and send it to everyone I know"
 "266 LIST <mask>                -- List services available (space delimited)"
 "266 QUIT                       -- Disconnect"
 }array foreach swap pop socket @ swap socksend pop repeat
 end
 "QUIT" smatch when
  socket @ 299 netmsg socket @ sockclose pop
  end
 not when "" end
 default socket @ 599 netmsg end
endcase
;

: dispatcher[ -- NEVER ]
var event
var argument
var socket

begin
{ "SOCKET.LISTEN*" "SOCKET.READ*" }array event_waitfor event ! argument !
event @ case 
 "LISTEN" instr when 
   lsocket @ sockaccept socket !
   fork not if
    socket @ HOMEINSTANCE set_sockopt pop
    socket @ SIMPLEQUEUE set_sockopt pop
    socket @ clearsock
    socket @ 220 netmsg
   then 
 end
 "READ" instr when 
   ( Receive data on this socket, if it died, close )
   argument @ nbsockrecv swap 1 < if pop argument @ sockclose then 
   ( Send it and the socket to the handler, if anything was recieved, if not, send back a null )
   dup if argument @ swap handler else pop "" then
   ( If we have something other than null, send it back to the socket, and if it died, close )
   dup if argument @ swap socksend 1 < if pop argument @ sockclose then else pop then
 end
endcase
repeat
;

: startup-sequence
DISPATCHLISTENERS 8472 lsockopen pop lsocket !
dispatcher
;

: netreg

;

: main
param !
command @ case
 "@netreg" smatch when netreg end
 default
 param @ "Startup" smatch if startup-sequence then
 param @ 17 itoc smatch if dispatcher then
 end
endcase
;

.
c
q
@reg libNewProtoNet=lib/net