basis-library/net/net-serv-db.sml

   1 (* Copyright (C) 2002-2006 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  *
   4  * MLton is released under a BSD-style license.
   5  * See the file MLton-LICENSE for details.
   6  *)
   7
   8 structure NetServDB: NET_SERV_DB =
   9    struct
  10       structure Prim = PrimitiveFFI.NetServDB
  11
  12       datatype entry = T of {name: string,
  13                              aliases: string list,
  14                              port: C_Int.t,
  15                              protocol: string}
  16
  17       local
  18         fun make s (T r) = s r
  19       in
  20         val name = make #name
  21         val aliases = make #aliases
  22         val port = C_Int.toInt o (make #port)
  23         val protocol = make #protocol
  24       end
  25
  26       local
  27         fun get (i: C_Int.t): entry option =
  28           if i <> C_Int.zero
  29             then let
  30                    val name = CUtil.C_String.toString (Prim.getEntryName ())
  31                    val numAliases = Prim.getEntryAliasesNum ()
  32                    fun fill (n, aliases) =
  33                      if C_Int.< (n, numAliases)
  34                        then let
  35                               val alias = CUtil.C_String.toString (Prim.getEntryAliasesN n)
  36                             in
  37                               fill (C_Int.+ (n, 1), alias::aliases)
  38                             end
  39                        else List.rev aliases
  40                    val aliases = fill (0, [])
  41                    val port = Net.C_Int.ntoh (Prim.getEntryPort ())
  42                    val protocol = CUtil.C_String.toString (Prim.getEntryProto ())
  43                  in
  44                    SOME (T {name = name,
  45                             aliases = aliases,
  46                             port = port,
  47                             protocol = protocol})
  48                  end
  49             else NONE
  50       in
  51         fun getByName (name, proto) =
  52           case proto of
  53             SOME proto => get (Prim.getByName (NullString.nullTerm name,
  54                                                NullString.nullTerm proto))
  55           | NONE => get (Prim.getByNameNull (NullString.nullTerm name))
  56         fun getByPort (port, proto) =
  57           let
  58             val port = Net.C_Int.hton (C_Int.fromInt port)
  59           in
  60             case proto of
  61                NONE => get (Prim.getByPortNull port)
  62              | SOME proto =>
  63                   get (Prim.getByPort (port, NullString.nullTerm proto))
  64           end
  65       end
  66    end