;"MidgardCORE DNS Utilities version 3.1"
;"Copyright 1997, 1998 Midgard Systems and Adam 'Martian' Smyth"

;"This code is free software; you can redistribute it and/or"
;"modify it under the terms of the GNU General Public License"
;"as published by the Free Software Foundation; either version 2"
;"of the License, or (at your option) any later version."

;"This program is distributed in the hope that it will be useful,"
;"but WITHOUT ANY WARRANTY; without even the implied warranty of"
;"MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the"
;"GNU General Public License for more details."

;"The License is available at http://www.gnu.org/copyleft/gpl.html"

;"The author can be contacted at martian@midgard.org"
;"It is *strongly requested* that users of this code register with the author."

;"The latest release of this code can be found at"
;" http://www.midgard.org:8080/~martian/Code/MOO/dns_utils.moo"

;" This module is designed to be pasted as-is into a connection to a MOO server."
;" To install this module, you must be a wizard.";
;" Install in this order: $network_utils, $dns_utils"

;"Dependancy checks"

;"Wizperms are required for installation"
;if(!`player.wizard ! ANY');while(read()!=";\"End of Module\"");endwhile;endif

;"$network_utils must be installed first."
;if(!`valid($network_utils) ! ANY');while(read()!=";\"End of Module\"");endwhile;endif

;"Begining installation..."

;"Simple sanity check. Don't make more than one, if it already exists.";
;if(`valid($dns_utils) ! ANY');while(read()!=";\"-----\"");endwhile;endif
@create $generic_utils called DNS Utilities,dns_utils
@corify dns_utils as $dns_utils
;"-----"

;$dns_utils.description=$command_utils:read()
A client for doing DNS lookups in-DB.

@prop $dns_utils."Types" {"A", "NS", "MD", "MF", "CNAME", "SOA", "MB", "MG", "MR", "NULL", "WKS", "PTR", "HINFO", "MINFO", "MX", "TXT"} r
@prop $dns_utils."Classes" {"IN", "CS", "CH", "HS"} r
@prop $dns_utils."DNSServers" {"127.0.0.1"} ""
@prop $dns_utils."Version" 3.1 rc
@prop $dns_utils."Timeout" 90 rc
@prop $dns_utils."debug" 0 ""
@prop $dns_utils."Cache" {} ""

;;$dns_utils.("help_msg")=$command_utils:read_lines()
This is the Domain Name System client developed by Martian at MidgardMOO

It was developed for use by the MidgardSMTP daemon, but can be used any time DNS queries are needed.
The latest release of this code can be found at http://www.midgard.org:8080/~martian/Code/MOO/dns_utils.moo

Note: You'll probably want to add DNS servers to .DNSServers. They're tried in the order they appear.

:RawBinaryToDecimal({INT, ...})
  Input is a list of integers representing a binary string.
  Output is a single integer, the value of the combined numbers.

  e.g.  $dns_utils:RawBinaryToDecimal({5,16}) => 1296

:RawBinaryToBinaryString({INT, ...})
  Input is a list of integers representing a binary string.
  Output is a string consisting of 1s and 0s, represtenting the binary coding of the input.

  e.g.  $dns_utils:RawBinarytoBinaryString({3,1,52}) => "000000110000000100110100"

:Lookup(STR Item, STR|INT Type, [Ignore Cache]) => {DNS data}
  Item is what you want to look up in the DNS
  Type is a string or integer indicating the type of data to search.
  If Ignore Cache is given and true, perform a new lookup, even if this search is in the cache.
  The returned data is the result of parsing the Answer field of the DNS response.
.

@verb $dns_utils:"RawBinaryToDecimal" this none this rxd
@program $dns_utils:RawBinaryToDecimal
Val = 0;
Mult = 1;
for u in ($list_utils:reverse(args[1]))
  if (typeof(u) == STR)
    for C in ($list_utils:reverse($string_utils:char_list(u)))
      V = $string_utils:to_ascii(C) * Mult;
      Val = Val + V;
      Mult = Mult * 256;
    endfor
  else
    V = u * Mult;
    Val = Val + V;
    Mult = Mult * 256;
  endif
endfor
return Val;
.

@verb $dns_utils:"RawBinaryToBinaryString" this none this rxd
@program $dns_utils:RawBinaryToBinaryString
Val = "";
for u in (args[1])
  if (typeof(u) == STR)
    for C in ($list_utils:reverse($string_utils:char_list(u)))
      V = $math_utils:base_conversion($string_utils:to_ascii(C), 10, 2);
      Val = Val + $string_utils:right(V, 8, "0");
    endfor
  else
    V = $math_utils:base_conversion(u, 10, 2);
    Val = Val + $string_utils:right(V, 8, "0");
  endif
endfor
return Val;
.

@verb $dns_utils:"ReadResponse" this none this rx
@program $dns_utils:ReadResponse
if (caller != this)
  return E_PERM;
endif
fork killtask (this.Timeout)
  this:debug("Timeout. Booting connection.");
  boot_player(args[1]);
endfork
Response = "";
line = read(args[1]);
if (typeof(line) == ERR)
  return E_NONE;
endif
line = line + ((l = read(args[1], 1)) != 0 ? l | "");
Len = decode_binary(line + "~00~00", 1)[1..2];
line = line + ((l = read(args[1], 1)) != 0 ? l | "");
Response = line;
Response = Response[1] == "~" ? Response[4..$] | Response[2..$];
Response = Response[1] == "~" ? Response[4..$] | Response[2..$];
Response = Response + ((l = read(args[1], 1)) != 0 ? l | "");
Len = $network_utils:BinaryListToDecimal(Len);
Response = Response + ((l = read(args[1], 1)) != 0 ? l | "");
this:debug("Expecting ", Len, " bytes of input.");
this:debug("Received ", $network_utils:BinaryStringLength(Response), " bytes of input.");
Response = Response + ((l = read(args[1], 1)) != 0 ? l | "");
while ($network_utils:BinaryStringLength(Response) < Len)
  line = read(args[1]);
  if (typeof(line) == ERR)
    return E_NONE;
  endif
  Response = Response + line;
  this:debug("Received ", $network_utils:BinaryStringLength(Response), " bytes of input.");
endwhile
this:debug("Input read. Killing timeout task and returning.");
kill_task(killtask);
return Response;
.

@verb $dns_utils:"extract_name" this none this rxd
@program $dns_utils:extract_name
if (caller != this)
  return E_PERM;
endif
Pos = args[2];
name = "";
while (!(args[1][Pos] == 0 || args[1][Pos] > 63))
  for c in [Pos + 1..Pos + args[1][Pos]]
    name = name + $String_utils:from_ascii(args[1][c]);
  endfor
  Pos = Pos + args[1][Pos] + 1;
  name = name + ".";
endwhile
if (args[1][Pos])
  suspend(0);
  NewPos = $network_utils:BinaryListToDecimal({args[1][Pos] - 192, args[1][Pos + 1]}) + 1;
  name = name + this:extract_name(args[1], NewPos)[1];
  Pos = Pos + 2;
else
  Pos = Pos + 1;
endif
if (name && name[$] == ".")
  name = name[1..$ - 1];
endif
return {name, Pos};
.

@verb $dns_utils:"ProcessRData" this none this rxd
@program $dns_utils:ProcessRData
if (caller != this)
  return E_PERM;
endif
Type = args[1];
RData = args[2];
PureData = args[3];
Pos = args[4];
if (Type in {1})
  return $string_utils:from_list(RData, ".");
elseif (Type in {2, 5, 12})
  Site = this:Extract_Name(PureData, Pos)[1];
  return Site;
elseif (Type == 6)
  {MName, Pos} = this:Extract_Name(PureData, Pos);
  {RName, Pos} = this:Extract_Name(PureData, Pos);
  Serial = $network_utils:BinaryListToDecimal(PureData[Pos..Pos + 3]);
  Pos = Pos + 4;
  Refresh = $network_utils:BinaryListToDecimal(PureData[Pos..Pos + 3]);
  Pos = Pos + 4;
  Retry = $network_utils:BinaryListToDecimal(PureData[Pos..Pos + 3]);
  Pos = Pos + 4;
  Expire = $network_utils:BinaryListToDecimal(PureData[Pos..Pos + 3]);
  Pos = Pos + 4;
  Minimum = $network_utils:BinaryListToDecimal(PureData[Pos..Pos + 3]);
  Pos = Pos + 4;
  return {MName, RName, Serial, Refresh, Retry, Expire, Minimum};
elseif (Type == 15)
  Pref = $network_utils:BinaryListToDecimal(RData[1..2]);
  Exch = this:Extract_Name(PureData, Pos + 2)[1];
  return {Pref, Exch};
elseif (Type == 16)
  Txt = "";
  for C in (listdelete(RData, 1))
    Txt = Txt + $string_utils:from_ascii(C);
  endfor
  return Txt;
else
  return RData;
endif
.

@verb $dns_utils:"ProcessReply" this none this rxd
@program $dns_utils:ProcessReply
if (caller != this)
  return E_PERM;
endif
if (!args[1])
  return {{}, {}, {}, {}};
endif
Data = decode_binary(args[1], 1);
MID = Data[1..2];
MiscHeader = Data[3..4];
QDCount = $network_utils:BinaryListToDecimal(Data[5..6]);
ANCount = $network_utils:BinaryListToDecimal(Data[7..8]);
NSCount = $network_utils:BinaryListToDecimal(Data[9..10]);
ARCount = $network_utils:BinaryListToDecimal(Data[11..12]);
Pos = 13;
Query = {};
for R in [1..QDCount]
  {QueryName, Pos} = this:extract_name(Data, Pos);
  QueryType = $network_utils:BinaryListToDecimal(Data[Pos..Pos + 1]);
  QueryClass = $network_utils:BinaryListToDecimal(Data[Pos + 2..Pos + 3]);
  Pos = Pos + 4;
  Query = {@Query, {QueryName, QueryType, QueryClass}};
endfor
Answer = {};
for R in [1..ANCount]
  {AnswerName, Pos} = this:extract_name(Data, Pos);
  AnswerType = $network_utils:BinaryListToDecimal(Data[Pos..Pos + 1]);
  AnswerClass = $network_utils:BinaryListToDecimal(Data[Pos + 2..Pos + 3]);
  AnswerTTL = $network_utils:BinaryListToDecimal(Data[Pos + 4..Pos + 7]);
  RDLen = $network_utils:BinaryListToDecimal(Data[Pos + 8..Pos + 9]);
  Pos = Pos + 10;
  AnswerRData = this:ProcessRData(AnswerType, Data[Pos..Pos + RDLen - 1], Data, Pos);
  Pos = Pos + RDLen;
  Answer = {@Answer, {AnswerName, AnswerType, AnswerClass, AnswerTTL, AnswerRData}};
endfor
Authority = {};
for R in [1..NSCount]
  {AuthorityName, Pos} = this:extract_name(Data, Pos);
  AuthorityType = $network_utils:BinaryListToDecimal(Data[Pos..Pos + 1]);
  AuthorityClass = $network_utils:BinaryListToDecimal(Data[Pos + 2..Pos + 3]);
  AuthorityTTL = $network_utils:BinaryListToDecimal(Data[Pos + 4..Pos + 7]);
  RDLen = $network_utils:BinaryListToDecimal(Data[Pos + 8..Pos + 9]);
  Pos = Pos + 10;
  AuthorityRData = this:ProcessRData(AuthorityType, Data[Pos..Pos + RDLen - 1], Data, Pos);
  Pos = Pos + RDLen;
  Authority = {@Authority, {AuthorityName, AuthorityType, AuthorityClass, AuthorityTTL, AuthorityRData}};
endfor
Additional = {};
for R in [1..ARCount]
  {AdditionalName, Pos} = this:extract_name(Data, Pos);
  AdditionalType = $network_utils:BinaryListToDecimal(Data[Pos..Pos + 1]);
  AdditionalClass = $network_utils:BinaryListToDecimal(Data[Pos + 2..Pos + 3]);
  AdditionalTTL = $network_utils:BinaryListToDecimal(Data[Pos + 4..Pos + 7]);
  RDLen = $network_utils:BinaryListToDecimal(Data[Pos + 8..Pos + 9]);
  Pos = Pos + 10;
  AdditionalRData = this:ProcessRData(AdditionalType, Data[Pos..Pos + RDLen - 1], Data, Pos);
  Pos = Pos + RDLen;
  Additional = {@Additional, {AdditionalName, AdditionalType, AdditionalClass, AdditionalTTL, AdditionalRData}};
endfor
return {Query, Answer, Authority, Additional};
.

@verb $dns_utils:"GetDNSData" this none this rx
@program $dns_utils:GetDNSData
if (caller != this)
  return E_PERM;
endif
Lookup = args[1];
QType = args[2];
if (length(args) > 2)
  DNSServer = args[3];
else
  DNSServer = this.DNSServers[1];
endif
this:debug("Server: ", DNSServer);
MID = time() % 65535;
MID = $string_utils:right($math_utils:base_conversion(MID, 10, 2), 16, "0");
Type = "0";
OpCode = "0000";
Auth = "0";
Trunc = "0";
RD = "1";
RA = "0";
Z = "000";
Rcode = "0000";
QCount = 1;
QCount = $string_utils:right($math_utils:base_conversion(QCount, 10, 2), 16, "0");
QAns = $string_utils:space(16, "0");
QAuth = $string_utils:space(16, "0");
QAdd = $string_utils:space(16, "0");
Lookup = {@$string_utils:explode(Lookup, "."), ""};
QName = "";
for i in (Lookup)
  QName = QName + $string_utils:right($math_utils:base_conversion(length(i), 10, 2), 8, "0");
  for c in ($string_utils:char_list(i))
    QName = QName + $string_utils:right($math_utils:base_conversion($string_utils:to_ascii(c), 10, 2), 8, "0");
    $command_utils:suspend_if_needed(0);
  endfor
endfor
QType = $string_utils:right($math_utils:base_conversion(QType, 10, 2), 16, "0");
QClass = 1;
QClass = $string_utils:right($math_utils:base_conversion(QClass, 10, 2), 16, "0");
suspend(0);
BinString = MID + Type + OpCode + Auth + Trunc + RD + RA + Z + Rcode + QCount + QAns + QAuth + QAdd + QName + QType + QClass;
Len = length(BinString) / 8;
BinString = $string_utils:right($math_utils:base_conversion(Len, 10, 2), 16, "0") + BinString;
suspend(0);
Hex = "";
for i in [1..Len + 2]
  String = BinString[(i - 1) * 8 + 1..i * 8];
  Hex = Hex + "~" + $string_utils:right($math_utils:base_conversion(String, 2, 16), 2, "0");
  $command_utils:suspend_if_needed(0);
endfor
for i in [1..2]
  this:debug("Opening connection (Attempt ", i, ") ...");
  con = open_network_connection(DNSServer, 53);
  if (typeof(con) != ERR)
    break;
  endif
  this:debug("Error: ", con);
  suspend(2);
endfor
if (typeof(con) == ERR)
  return E_NONE;
endif
set_connection_option(con, "hold-input", 1);
set_connection_option(con, "binary", 1);
this:debug("Connection ", con, " open.");
this:debug("Sending request...");
notify(con, Hex);
this:debug("Reading reply...");
response = this:ReadResponse(con);
this:debug("Closing connection.");
boot_player(con);
return response;
.

@verb $dns_utils:"Lookup" this none this rxd
@program $dns_utils:Lookup
":lookup(STR Item, STR|INT Type, [Ignore Cache]) => {DNS data}";
"Item is what you want to look up in the DNS";
"Type is a string or integer indicating the type of data to search.";
"if Ignore Cache is given and true, perform a new lookup, even if this search is in the cache.";
"";
if (!caller_perms().wizard)
  return E_PERM;
endif
{Item, Type, ?IgnoreCache = 0} = args;
if (typeof(Type) == STR)
  Type = Type in this.Types;
endif
if (Type == 0 || Type > 16)
  return E_INVARG;
endif
this:debug("Item: ", Item, "  Type: ", Type);
if (!IgnoreCache && (i = $list_utils:iassoc({Item, Type}, this.cache)))
  if (time() < this.Cache[i][2])
    this:Debug("Item found in cache.");
    return this.Cache[i][3];
  endif
endif
for Server in (this.DNSServers)
  if ((Data = this:GetDNSData(Item, Type, Server)) != E_NONE && Data != {})
    break;
  endif
endfor
if (Data == E_NONE)
  return {};
endif
Data = this:ProcessReply(Data);
suspend(0);
Data = Data[2];
expire = Data ? $maxint | 86400;
for i in [1..length(Data)]
  expire = min(expire, Data[i][4]);
  if (Data[i][2] <= length(this.Types))
    Data[i][2] = this.Types[Data[i][2]];
  endif
  if (Data[i][3] <= length(this.Classes))
    Data[i][3] = this.Classes[Data[i][3]];
  endif
endfor
if (expire > 0)
  if (j = $list_utils:iassoc({Item, Type}, this.Cache))
    this.cache[j][2] = expire + time();
    this.cache[j][3] = Data;
  else
    this.cache = {@this.cache, {{Item, Type}, expire + time(), Data}};
  endif
endif
return Data;
.

@verb $dns_utils:"debug" this none this rxd
@program $dns_utils:debug
if (this.debug && caller == this)
  notify(this.owner, tostr(this, ":", callers()[1][2], "> ", @args));
endif
.

@verb $dns_utils:"CycleCache" this none this rxd
@program $dns_utils:CycleCache
if (!caller_perms().wizard)
  return E_PERM;
endif
time = time();
i = 1;
while (i <= length(this.cache))
  if (this.cache[i][2] < time)
    this.cache = listdelete(this.cache, i);
  else
    i = i + 1;
  endif
  $command_utils:suspend_if_needed(0);
endwhile
suspend(10);
fork (86400 + $time_utils:seconds_until_time("06:00:00"))
  this:cyclecache();
endfork
.

;"Installing Wizardly DNS lookup util."
@verb $wiz:@lookup*-n*ocache any any any rx
@program $wiz:@lookup
"Usage: @lookup <hostname> => <DNS 'A' record with IP address>";
"       eg: @lookup yahoo.com => {{\"yahoo.com\", \"A\", \"IN\", 86400, {\"204.71.177.35\"}}";
"Usage: @lookup <IP address> => <DNS 'PTR' record with domain name>";
"       eg: @lookup 204.71.177.35 => {{\"35.177.71.204.IN-ADDR.ARPA\", \"PTR\", \"IN\", 20985, {\"yahoo.com\"}}";
"Usage: @lookup <type> for <hostname> => <DNS '<type>' record>";
"       eg: @lookup mx for yahoo.com => {{\"yahoo.com\", \"MX\", \"IN\", 548, {1, \"mta-x2.yahoomail.com\"}}";
"";
if (player != this)
  return player:tell("No.");
endif
if (!prepstr)
  Site = argstr;
  Type = "A";
else
  Site = iobjstr;
  Type = dobjstr;
endif
if (match(Site, "^[0-9]+%.[0-9]+%.[0-9]+%.[0-9]+$"))
  Site = $string_utils:from_list($list_utils:reverse($string_utils:explode(Site, ".")), ".") + ".IN-ADDR.ARPA";
  if (!prepstr)
    Type = "PTR";
  endif
endif
player:tell(Site, " => ", toliteral($dns_utils:lookup(Site, Type, index(verb, "n"))));
.

;"End of Module"