(*
    Title:      Standard Basis Library: NetHostDB and NetDB Structures and Signatures
    Author:     David Matthews
    Copyright   David Matthews 2000

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.
    
    This library 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
    Lesser General Public License for more details.
    
    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
*)

(* G&R 2004 status: no change *)

signature NET_HOST_DB =
sig
    eqtype in_addr
    eqtype addr_family
    type entry
    val name : entry -> string
    val aliases : entry -> string list
    val addrType : entry -> addr_family
    val addr : entry -> in_addr
    val addrs : entry -> in_addr list

    val getByName : string -> entry option
    val getByAddr : in_addr -> entry option
    val getHostName : unit -> string
    val scan : (char, 'a) StringCvt.reader
              -> (in_addr, 'a) StringCvt.reader
    val fromString : string -> in_addr option
    val toString : in_addr -> string
end;

local
    fun power2 0 = 1
    |   power2 n = 2 * power2(n-1)
    val p32 = power2 32
    val p24 = power2 24

    fun scan getc src =
    let
        (* Read a number as either decimal, hex or octal up to the
           given limit. Stops when it reaches the limit or finds a
           character it doesn't recognise. *)
        fun readNum base acc limit src =
        let
            fun addDigit d src =
            let
                val n = case acc of SOME(n, _) => n | NONE => 0
                val next = n*base + d
            in
                (* If we are below the limit we can continue. *)
                if next < limit
                then readNum base (SOME(next, src)) limit src
                else acc
            end
        in
            case getc src of
                NONE => acc
            |   SOME(ch, src') =>
                    if Char.isDigit ch andalso
                        ch < Char.chr(Char.ord #"0" + base)
                    then addDigit (Char.ord ch - Char.ord #"0") src'
                    else if base = 16 andalso (ch >= #"A" andalso ch <= #"F")
                    then addDigit (Char.ord ch - Char.ord #"A" + 10) src'
                    else if base = 16 andalso (ch >= #"a" andalso ch <= #"f")
                    then addDigit (Char.ord ch - Char.ord #"a" + 10) src'
                    else acc
        end

        (* Read a number.  If it starts with 0x or 0X treat it
           as hex, otherwise if it starts with 0 treat as octal
           otherwise decimal. *)
        fun scanNum limit src =
            case getc src of
                NONE => NONE
            |   SOME (#"0", src') =>
                (
                    case getc src' of
                        SOME(ch, src'') =>
                            if ch = #"x" orelse ch = #"X"
                            then
                                (
                                (* If it is invalid we have still read a
                                   zero so return that. *)
                                case readNum 16 NONE limit src'' of
                                    NONE => SOME(0, src')
                                |   res => res
                                )
                            else (* Octal - include the zero. *)
                                readNum 8 NONE limit src'
                    |   NONE => SOME(0, src') (* Just the zero. *)
                )
            |   SOME (_, _) => (* Treat it as a decimal number. *)
                    readNum 10 NONE limit src

        fun scanAddr src limit i acc =
            case scanNum limit src of
                NONE => NONE
            |   SOME(n, src') =>
                let
                    val res = acc*256 + n (* This is the accumulated result. *)
                in
                    (* If the result is more than 24 bits or we've read
                       all the sections we're finished. *)
                    if res >= p24 orelse i = 1 then SOME(res, src')
                    else
                        case getc src' of
                            SOME (#".", src'') =>
                            (
                                (* The limit for sections other than the
                                   first is 256. *)
                                case scanAddr src'' 256 (i-1) res of
                                    NONE => SOME(res, src') (* Return what we had. *)
                                |   r => r
                            )
                        |   _ => SOME(res, src') (* Return what we've got. *)
                end
    in
        scanAddr src p32 4 (* Four sections in all. *) 0
    end (* scan *)

in
    structure NetHostDB :> NET_HOST_DB =
    struct
        type in_addr = int
        and addr_family = int
        type entry = string * string list * addr_family * in_addr list
        val name: entry -> string = #1
        val aliases : entry -> string list = #2
        val addrType : entry -> addr_family = #3
        val addrs : entry -> in_addr list = #4
    
        (* Addr returns the first address in the list. There should always
           be at least one entry. *)
        fun addr e =
            case addrs e of
                a :: _ => a
             |  [] => raise OS.SysErr("No address returned", NONE)
    
        local
            val doCall: int*unit -> string
                 = RunCall.run_call2 RuntimeCalls.POLY_SYS_network
        in
            fun getHostName () = doCall(0, ())
        end
        
        local
            val doCall: int*string -> entry
                 = RunCall.run_call2 RuntimeCalls.POLY_SYS_network
        in
            fun getByName s =
                SOME(doCall(1, s)) handle OS.SysErr _ => NONE
        end
    
        local
            val doCall: int*int -> entry
                 = RunCall.run_call2 RuntimeCalls.POLY_SYS_network
        in
            fun getByAddr n =
                SOME(doCall(2, n)) handle OS.SysErr _ => NONE
        end
    
        val scan = scan
        and fromString = StringCvt.scanString scan
    
        fun toString n =
        let
            fun pr n i =
                (if i > 0 then pr (n div 256) (i-1) ^ "." else "") ^
                    Int.toString (n mod 256)
                
        in
            pr n 3 (* Always generate 4 numbers. *)
        end
    end;

end;


local
    (* Install the pretty printer for NetHostDB.in_addr.
       This must be done outside
       the structure if we use opaque matching. *)
    fun printAddr _ _ x = PolyML.PrettyString(NetHostDB.toString x)
in
    val () = PolyML.addPrettyPrinter printAddr
end

