src/utils/net/upnpClient.ml

   1 (**************************************************************************)
   2 (*  Copyright (c) 2010 zzz <jian@doatest.com>                             *)
   3 (*                                                                        *)
   4 (*  mlupnp, a ocaml wraps of libminiupnpc & libnatpmp for mldonkey        *)
   5 (*                                                                        *)
   6 (*  Permission is hereby granted, free of charge, to any person           *)
   7 (*  obtaining a copy of this software and associated documentation files  *)
   8 (*  (the "Software"), to deal in the Software without restriction,        *)
   9 (*  including without limitation the rights to use, copy, modify, merge,  *)
  10 (*  publish, distribute, sublicense, and/or sell copies of the Software,  *)
  11 (*  and to permit persons to whom the Software is furnished to do so,     *)
  12 (*  subject to the following conditions:                                  *)
  13 (*                                                                        *)
  14 (*  The above copyright notice and this permission notice shall be        *)
  15 (*  included in all copies or substantial portions of the Software.       *)
  16 (*                                                                        *)
  17 (*  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,       *)
  18 (*  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES       *)
  19 (*  OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND              *)
  20 (*  NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS   *)
  21 (*  BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN    *)
  22 (*  ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN     *)
  23 (*  CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE      *)
  24 (*  SOFTWARE.                                                             *)
  25 (**************************************************************************)
  26
  27 (* upnp port map zzz++*)
  28 type ml_port_map = {
  29         mutable enabled : int;
  30         mutable intPort : int;
  31         mutable extPort : int;
  32         mutable isTcp   : int;
  33         mutable natpmpStatus : int;
  34         mutable upnpStatus : int;
  35         mutable notes   : string;
  36 }
  37
  38 let string_of_map_status status =
  39   match status with
  40   | 0 -> "ERROR"
  41   | 1 -> "UNMAPPED"
  42   | 2 -> "UNMAPPING"
  43   | 3 -> "MAPPING"
  44   | 4 -> "MAPPED"
  45         | _ -> "N/A"
  46
  47 let strings_port_map map =
  48         Printf.sprintf "enable:%d ,intPort:%d ,extPort:%d ,isTcp:%d ,natpmpStatus:\"%s\" ,upnpStatus:\"%s\" ,notes:\"%s\""
  49         map.enabled map.intPort map.extPort map.isTcp (string_of_map_status map.natpmpStatus) (string_of_map_status map.upnpStatus) map.notes
  50
  51
  52 external init_maps : unit -> unit = "ml_upnpInitMaps" "noalloc"
  53 (*external set_maps  : unit -> unit = "ml_upnpSetMaps" *)
  54 external dump_maps : unit -> unit = "ml_upnpDumpMaps" "noalloc"
  55 external job_start : unit -> unit = "ml_upnp_job_start" "noalloc"
  56
  57 (* job_stop max_wait_seconds, 0=system default wait seconds *)
  58 external job_stop  : int -> unit = "ml_upnp_job_stop"
  59
  60 external maps_add_item     : int -> int -> int -> int -> string -> unit  = "ml_upnpAddMap"
  61 external maps_remove_item  : int -> int -> int -> int -> string -> unit  = "ml_upnpRemoveMap"
  62
  63 (* remove_all_maps max_wait_seconds, 0=system default wait seconds *)
  64 external remove_all_maps   : int -> unit = "ml_upnpRemoveAllMaps"
  65
  66 (* maps_get , get all maps info to a list *)
  67 external maps_get  : unit -> ml_port_map list = "ml_upnpGetMaps"