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