1(*
2    Title:      Standard Basis Library: NetHostDB and NetDB Structures and Signatures
3    Author:     David Matthews
4    Copyright   David Matthews 2000, 2016
5
6    This library is free software; you can redistribute it and/or
7    modify it under the terms of the GNU Lesser General Public
8    License version 2.1 as published by the Free Software Foundation
9    
10    This library is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13    Lesser General Public License for more details.
14    
15    You should have received a copy of the GNU Lesser General Public
16    License along with this library; if not, write to the Free Software
17    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
18*)
19
20signature NET_HOST_DB =
21sig
22    eqtype in_addr
23    eqtype addr_family
24    type entry
25    val name : entry -> string
26    val aliases : entry -> string list
27    val addrType : entry -> addr_family
28    val addr : entry -> in_addr
29    val addrs : entry -> in_addr list
30
31    val getByName : string -> entry option
32    val getByAddr : in_addr -> entry option
33    val getHostName : unit -> string
34    val scan : (char, 'a) StringCvt.reader
35              -> (in_addr, 'a) StringCvt.reader
36    val fromString : string -> in_addr option
37    val toString : in_addr -> string
38end;
39
40local
41    fun power2 0 = 1: LargeInt.int
42    |   power2 n = 2 * power2(n-1)
43    val p32 = power2 32
44    val p24 = power2 24
45
46    fun scan getc src =
47    let
48        (* Read a number as either decimal, hex or octal up to the
49           given limit. Stops when it reaches the limit or finds a
50           character it doesn't recognise. *)
51        fun readNum base acc limit src =
52        let
53            fun addDigit d src =
54            let
55                val n = case acc of SOME(n, _) => n | NONE => 0
56                val next = n * LargeInt.fromInt base + LargeInt.fromInt d
57            in
58                (* If we are below the limit we can continue. *)
59                if next < limit
60                then readNum base (SOME(next, src)) limit src
61                else acc
62            end
63        in
64            case getc src of
65                NONE => acc
66            |   SOME(ch, src') =>
67                    if Char.isDigit ch andalso
68                        ch < Char.chr(Char.ord #"0" + base)
69                    then addDigit (Char.ord ch - Char.ord #"0") src'
70                    else if base = 16 andalso (ch >= #"A" andalso ch <= #"F")
71                    then addDigit (Char.ord ch - Char.ord #"A" + 10) src'
72                    else if base = 16 andalso (ch >= #"a" andalso ch <= #"f")
73                    then addDigit (Char.ord ch - Char.ord #"a" + 10) src'
74                    else acc
75        end
76
77        (* Read a number.  If it starts with 0x or 0X treat it
78           as hex, otherwise if it starts with 0 treat as octal
79           otherwise decimal. *)
80        fun scanNum limit src =
81            case getc src of
82                NONE => NONE
83            |   SOME (#"0", src') =>
84                (
85                    case getc src' of
86                        SOME(ch, src'') =>
87                            if ch = #"x" orelse ch = #"X"
88                            then
89                                (
90                                (* If it is invalid we have still read a
91                                   zero so return that. *)
92                                case readNum 16 NONE limit src'' of
93                                    NONE => SOME(0, src')
94                                |   res => res
95                                )
96                            else (* Octal - include the zero. *)
97                                readNum 8 NONE limit src
98                    |   NONE => SOME(0, src') (* Just the zero. *)
99                )
100            |   SOME (_, _) => (* Treat it as a decimal number. *)
101                    readNum 10 NONE limit src
102
103        fun scanAddr src limit i acc =
104            case scanNum limit src of
105                NONE => NONE
106            |   SOME(n, src') =>
107                let
108                    val res = acc*256 + n (* This is the accumulated result. *)
109                in
110                    (* If the result is more than 24 bits or we've read
111                       all the sections we're finished. *)
112                    if res >= p24 orelse i = 1 then SOME(res, src')
113                    else
114                        case getc src' of
115                            SOME (#".", src'') =>
116                            (
117                                (* The limit for sections other than the
118                                   first is 256. *)
119                                case scanAddr src'' 256 (i-1) res of
120                                    NONE => SOME(res, src') (* Return what we had. *)
121                                |   r => r
122                            )
123                        |   _ => SOME(res, src') (* Return what we've got. *)
124                end
125    in
126        scanAddr src p32 4 (* Four sections in all. *) 0
127    end (* scan *)
128
129in
130    structure NetHostDB :> NET_HOST_DB =
131    struct
132        type in_addr = LargeInt.int
133        and addr_family = int
134        type entry = string * string list * addr_family * in_addr list
135        val name: entry -> string = #1
136        val aliases : entry -> string list = #2
137        val addrType : entry -> addr_family = #3
138        val addrs : entry -> in_addr list = #4
139    
140        (* Addr returns the first address in the list. There should always
141           be at least one entry. *)
142        fun addr e =
143            case addrs e of
144                a :: _ => a
145             |  [] => raise OS.SysErr("No address returned", NONE)
146    
147        val getHostName: unit -> string = RunCall.rtsCallFull0 "PolyNetworkGetHostName"
148        
149        (* The RTS calls return either zero or the address of the entry. *)
150        datatype result = AResult of entry | NoResult
151
152        local
153            val doCall: string -> result
154                 = RunCall.rtsCallFull1 "PolyNetworkGetHostByName"
155        in
156            fun getByName s =
157                case doCall s of AResult r => SOME r | NoResult => NONE
158        end
159    
160        local
161            val doCall: LargeInt.int -> result
162                 = RunCall.rtsCallFull1 "PolyNetworkGetHostByAddr"
163        in
164            fun getByAddr n =
165                case doCall n of AResult r => SOME r | NoResult => NONE
166        end
167    
168        val scan = scan
169        and fromString = StringCvt.scanString scan
170    
171        fun toString (n: in_addr) =
172        let
173            fun pr n i =
174                (if i > 0 then pr (n div 256) (i-1) ^ "." else "") ^
175                    LargeInt.toString (n mod 256)
176                
177        in
178            pr n 3 (* Always generate 4 numbers. *)
179        end
180    end;
181
182end;
183
184
185local
186    (* Install the pretty printer for NetHostDB.in_addr.
187       This must be done outside
188       the structure if we use opaque matching. *)
189    fun printAddr _ _ x = PolyML.PrettyString(NetHostDB.toString x)
190in
191    val () = PolyML.addPrettyPrinter printAddr
192end
193
194