1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
|
(*
Title: Standard Basis Library: NetHostDB and NetDB Structures and Signatures
Author: David Matthews
Copyright David Matthews 2000, 2016
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License version 2.1 as published by the Free Software Foundation
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
*)
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: LargeInt.int
| 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 * LargeInt.fromInt base + LargeInt.fromInt 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 = LargeInt.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)
val getHostName: unit -> string = RunCall.rtsCallFull0 "PolyNetworkGetHostName"
(* The RTS calls return either zero or the address of the entry. *)
datatype result = AResult of entry | NoResult
local
val doCall: string -> result
= RunCall.rtsCallFull1 "PolyNetworkGetHostByName"
in
fun getByName s =
case doCall s of AResult r => SOME r | NoResult => NONE
end
local
val doCall: LargeInt.int -> result
= RunCall.rtsCallFull1 "PolyNetworkGetHostByAddr"
in
fun getByAddr n =
case doCall n of AResult r => SOME r | NoResult => NONE
end
val scan = scan
and fromString = StringCvt.scanString scan
fun toString (n: in_addr) =
let
fun pr n i =
(if i > 0 then pr (n div 256) (i-1) ^ "." else "") ^
LargeInt.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
|
