PLASMA/src/libsrc/inet.pla

include "inc/cmdsys.plh"
//
// Net object
//
struc t_inet
    word initIP
    word serviceIP
    word openUDP
    word sendUDP
    word closeUDP
    word listenTCP
    word connectTCP
    word sendTCP
    word closeTCP
    word setInterfaceIP
    word getInterfaceHA
    word setDNS
    word resolveIP
    word setCallback
    word setParam
end
//
// DNS message
//
struc t_dnshdr
    word dnsID
    word dnsCode
    word dnsQdCount
    word dnsAnCount
    word dnsNsCount
    word dnsArCount
end
//
// External interface to net class. Must be first.
//
export byte[t_inet] iNet
//
// List of loadable network device drivers
//
byte netDrivers = "UTHERNET2"
byte            = "UTHERNET"
byte            = ""
word driver = @netDrivers
//
// DNS address (default to Google DNS)
//
byte[4] dns = 8,8,8,8
const DNS_QUERY  = 1
const DNS_ANSWER = 2
byte stateDNS

def iNetSetDNS(ipptr)
    return memcpy(@dns, ipptr, 4)
end

def putln
    return putc($0D)
end
def putb(hexb)
    return call($FDDA, hexb, 0, 0, 0)
end
def puth(hex)
    return call($F941, hex >> 8, hex, 0, 0)
end
def puti(i)
  if i < 0; putc('-'); i = -i; fin
  if i < 10
    putc(i + '0')
  else
    puti(i / 10)
    putc(i % 10 + '0')
  fin
end
def putip(ipptr)
    byte i
    
    for i = 0 to 2
        puti(ipptr->[i]); putc('.')
    next
    return puti(ipptr->[i])
end
def dumpbytes(buf, len)
    word i
    
    for i = 0 to len - 1
        putb(buf->[i])
	if i & 7 == 7
	    putln
	else
	    putc(' ')
	fin
    next
end

def parseIP(ipstr, ipaddr)
    byte i
    word endstr
    
    endstr = ipstr + ^ipstr
    for i = 0 to 3
	ipstr = ipstr + 1
        while ^ipstr >= '0' and ^ipstr <= '9' and ipstr <= endstr
	    ipaddr->[i] = ipaddr->[i] * 10 + ^ipstr - '0'
	    ipstr = ipstr + 1
	loop
	if ^ipstr <> '.' and ipstr < endstr
	    return 0
	fin
    next
    return i == 3
end

def parseDomain(domstr, msgptr)
    byte i, l

    l = 0
    for i = 1 to ^domstr
        if domstr->[i] == '.'
	    msgptr->[l] = i - l - 1
	    l = i
	else
	    msgptr->[i] = domstr->[i]
	fin
    next
    msgptr->[l] = i - l - 1
    msgptr  = msgptr + i
    ^msgptr = 0 // Terminate label list
    return msgptr + 1 
end

def recvDNS(remip, remport, pkt, len, ipaddr)
    byte q, r
    word resptr
    
    if pkt=>dnsID == $BEEF
        q = pkt->dnsQdCount.1
        r = pkt->dnsAnCount.1 + pkt->dnsNsCount.1 + pkt->dnsArCount.1
	resptr = pkt + t_dnshdr
	while q
	    while ^resptr
	        //puts(resptr); putc('.')
		resptr = resptr + ^resptr + 1
	    loop
	    resptr = resptr + 1
	    //putln; dumpbytes(resptr, 4); putln
	    resptr = resptr + 4
	    q = q - 1
	loop
	while r
	    //dumpbytes(resptr, 40); putln
	    if ^resptr & $C0 == $C0
	        resptr = resptr + 2
	    else
	        while ^resptr
	            //puts(resptr); putc('.')
		    resptr = resptr + ^resptr + 1
		loop
		resptr = resptr + 1
	    fin
	    if resptr->1 == 1 and resptr->3 == 1 and resptr->9 == 4
	        ipaddr=>0 = resptr=>10
		ipaddr=>2 = resptr=>12
	    fin
	    //putln; dumpbytes(resptr, 10); putc(':'); putln
	    resptr = resptr + 8
	    //dumpbytes(resptr + 2, ^(resptr + 1))
	    resptr = resptr + 2 + ^(resptr + 1); putln
	    r = r - 1
	loop
    fin
    stateDNS = DNS_ANSWER
end

def iNetResolve(namestr, ipaddr)
    word dnspkt, msgptr, msglen
    word portDNS, timeout
    
    ipaddr=>0 = 0
    ipaddr=>2 = 0
    if not parseIP(namestr, ipaddr)
        //
	// Query Domain Name Server for address
	//
	dnspkt             = heapmark // Use heap as working DNS query packet
	msgptr             = dnspkt
	msgptr=>dnsID      = $BEEF
	msgptr=>dnsCode    = $0001 // RD (Recursion Desired)
	msgptr=>dnsQdCount = $0100 // BE count = 1
	msgptr=>dnsAnCount = 0
	msgptr=>dnsNsCount = 0
	msgptr=>dnsArCount = 0
	msgptr             = parseDomain(namestr, msgptr + t_dnshdr)
	msgptr=>0          = $0100 // BE TYPE  = Address
	msgptr=>2          = $0100 // BE CLASS = INternet
	msglen             = msgptr - dnspkt + 4
	heapalloc(msglen)
	//
	// Prepare to receive DNS answer from server
	//
	portDNS = iNet:openUDP(3999, @recvDNS, ipaddr)
	//
	// Service IP
	//
	stateDNS = DNS_QUERY
	iNet:sendUDP(portDNS, @dns, 53, dnspkt, msglen)
	for timeout = 1 to 1000
	    iNet:serviceIP()
	    if stateDNS == DNS_ANSWER
	        break
	    fin
	next
	iNet:closeUDP(portDNS)
	heaprelease(dnspkt)
    fin
    return ipaddr=>0 <> 0 or ipaddr=>2 <> 0
end

export def iNetInit
    //
    // Look for net hardware
    //
    while ^driver
        //puts(driver);putln
	if modexec(driver) >= 0
            break
	fin
	driver = driver + ^driver + 1
    loop
    if !^driver
        return 0
    fin
    //
    // Get an IP address
    //
    modexec("DHCP")
    iNet:resolveIP = @iNetResolve
    return @iNet
end

//
// Fill iNet class
//
iNet:initIP    = @iNetInit
iNet:setDNS    = @iNetSetDNS

done