(*
    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;

signature NET_DB =
sig
	eqtype net_addr
	type addr_family
	type entry
	val name : entry -> string
	val aliases : entry -> string list
	val addrType : entry -> addr_family
	val addr : entry -> net_addr
	val getByName : string -> entry option
	val getByAddr : net_addr * addr_family -> entry option
	val scan : (char, 'a) StringCvt.reader -> (net_addr, 'a) StringCvt.reader
	val fromString : string -> net_addr option
	val toString : net_addr -> string
end;


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

	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 (ch, _) => (* 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 _ => NONE
		end
	
		local
			val doCall: int*int -> entry
				 = RunCall.run_call2 RuntimeCalls.POLY_SYS_network
		in
			fun getByAddr n =
				SOME(doCall(2, n)) handle _ => 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;


	structure NetDB :>
		NET_DB where type addr_family = NetHostDB.addr_family =
	struct
		type net_addr = int
		and addr_family = NetHostDB.addr_family
		type entry = string * string list * addr_family * int
		val name: entry -> string = #1
		val aliases : entry -> string list = #2
		val addrType : entry -> addr_family = #3
		val addr : entry -> net_addr = #4
		
		local
			val doCall: int*string -> entry
				 = RunCall.run_call2 RuntimeCalls.POLY_SYS_network
		in
			fun getByName s =
				SOME(doCall(9, s)) handle _ => NONE
		end
	
		local
			val doCall: int*(int*addr_family) -> entry
				 = RunCall.run_call2 RuntimeCalls.POLY_SYS_network
		in
			fun getByAddr (n, af) =
				SOME(doCall(10, (n, af))) handle _ => NONE
		end

		(* The definition of NetDB.scan is very vague.  Assume it's
		   the same as NetHostDB. *)
		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(p, _, _, _) _ _ x = p(NetHostDB.toString x)
	fun printNet(p, _, _, _) _ _ x = p(NetDB.toString x)
in
	val () = PolyML.install_pp printAddr
	val () = PolyML.install_pp printNet
end