Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/system/Basis/Implementation/Sockets/host-db.sml
ViewVC logotype

Annotation of /sml/trunk/src/system/Basis/Implementation/Sockets/host-db.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1394 - (view) (download)

1 : monnier 416 (* host-db.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     *)
6 :    
7 :     local
8 :     structure Word8 = Word8Imp
9 :     in
10 : mblume 1394 structure NetHostDBInternal :> sig
11 :     (* export extra element for internal use by Basis implementation *)
12 :     include NET_HOST_DB
13 :     val INADDR : Socket.addr -> in_addr
14 :     val unINADDR : in_addr -> Socket.addr
15 :     end
16 :     where type addr_family = Socket.AF.addr_family
17 :     = struct
18 : monnier 416
19 : mblume 1394 structure SysW = SysWordImp
20 : monnier 416
21 :     fun netdbFun x = CInterface.c_function "SMLNJ-Sockets" x
22 :    
23 : mblume 1394 datatype in_addr = INADDR of Socket.addr
24 : mblume 1393 type addr_family = Socket.AF.addr_family
25 : monnier 416
26 : mblume 1394 fun unINADDR (INADDR a) = a
27 :    
28 : monnier 416 datatype entry = HOSTENT of {
29 :     name : string,
30 :     aliases : string list,
31 :     addrType : addr_family,
32 :     addrs : in_addr list
33 :     }
34 :    
35 :     local
36 :     fun conc field (HOSTENT a) = field a
37 :     in
38 :     val name = conc #name
39 :     val aliases = conc #aliases
40 :     val addrType = conc #addrType
41 :     val addrs = conc #addrs
42 :     val addr = List.hd o addrs
43 :     end (* local *)
44 :    
45 :     (* Host DB query functions *)
46 :     local
47 : mblume 1393 type hostent = (string * string list * Socket.af * Socket.addr list)
48 : monnier 416 fun getHostEnt NONE = NONE
49 :     | getHostEnt (SOME(name, aliases, addrType, addrs)) = SOME(HOSTENT{
50 :     name = name, aliases = aliases,
51 : mblume 1393 addrType = Socket.AF.AF addrType,
52 : mblume 1394 addrs = List.map INADDR addrs
53 : monnier 416 })
54 :     val getHostByName' : string -> hostent option = netdbFun "getHostByName"
55 : mblume 1393 val getHostByAddr' : Socket.addr -> hostent option = netdbFun "getHostByAddr"
56 : monnier 416 in
57 :     val getByName = getHostEnt o getHostByName'
58 : mblume 1394 fun getByAddr (INADDR addr) = getHostEnt(getHostByAddr' addr)
59 : monnier 416 end (* local *)
60 :    
61 :     fun scan getc strm = let
62 :     fun w2b w = Word8.fromLargeWord(SysW.toLargeWord w)
63 :     fun getB (w, shft) = SysW.andb(SysW.>>(w, shft), 0wxFF)
64 : mblume 1394 fun mkAddr (a, b, c, d) = INADDR(Word8Vector.fromList[
65 : monnier 416 w2b a, w2b b, w2b c, w2b d
66 :     ])
67 :     in
68 : mblume 1393 case (Socket.toWords getc strm)
69 : monnier 416 of SOME([a, b, c, d], strm) =>
70 :     SOME(mkAddr(a, b, c, d), strm)
71 :     | SOME([a, b, c], strm) =>
72 :     SOME(mkAddr(a, b, getB(c, 0w8), getB(c, 0w0)), strm)
73 :     | SOME([a, b], strm) =>
74 :     SOME(mkAddr(a, getB(b, 0w16), getB(b, 0w8), getB(b, 0w0)), strm)
75 :     | SOME([a], strm) =>
76 :     SOME(mkAddr(getB(a, 0w24), getB(a, 0w16), getB(a, 0w8), getB(a, 0w0)), strm)
77 :     | _ => NONE
78 :     (* end case *)
79 :     end
80 :    
81 :     val fromString = StringCvt.scanString scan
82 :    
83 : mblume 1394 fun toString (INADDR addr) = let
84 : monnier 416 fun get i = Word8Vector.sub(addr, i)
85 :     in
86 : mblume 1393 Socket.fromBytes(get 0, get 1, get 2, get 3)
87 : monnier 416 end
88 :    
89 :     val getHostName : unit -> string = netdbFun "getHostName"
90 :    
91 :     end
92 : mblume 1394
93 :     (* restrict to NET_HOST_DB *)
94 :     structure NetHostDB : NET_HOST_DB = NetHostDBInternal
95 :    
96 : monnier 416 end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0