Merge pull request #151 from lindig/CP-27898

CP-27898 port to Dune, remove warnings, fix Travis

Author: robhoes

.travis.yml

@@ -1,12 +1,12 @@
 language: c
-services: docker
-install:
-    - wget https://raw.githubusercontent.com/xenserver/xenserver-build-env/master/utils/travis-build-repo.sh
-script: bash travis-build-repo.sh
-sudo: true
+sudo: required
+service: docker
+install: wget https://raw.githubusercontent.com/ocaml/ocaml-ci-scripts/master/.travis-docker.sh
+script: bash -ex .travis-docker.sh
 env:
-    global:
-        - REPO_PACKAGE_NAME=xcp-networkd
-        - REPO_CONFIGURE_CMD=true
-        - REPO_BUILD_CMD=make
-        - REPO_TEST_CMD='make test'
+  global:
+    - PACKAGE="xapi-networkd"
+    - PINS="xapi-networkd:."
+    - BASE_REMOTE="https://github.com/xapi-project/xs-opam.git"
+  matrix:
+    - DISTRO="debian-9-ocaml-4.06"

COVERAGE.md

@@ -1,3 +1,6 @@
+0.39.0 (04-Dec-2018)
+* This file in no longer maintained. See the Git history'
+
 0.10.0 (14-Aug-2015):
 * Preliminary support for FCoE
 * Support xapi `originator`
@@ -15,7 +18,7 @@
 0.9.4 (3-Jun-2014):
 * Use oasis for building
 * Update to new stdext interface
-* Fix CA-118425/SCTX-1559: An earlier error could cause problems with VLANs 
+* Fix CA-118425/SCTX-1559: An earlier error could cause problems with VLANs
 * Enable LACP bonding on linux bridge
 * Fix CA-116420: Bonds were getting incorrect MAC addresses on 3.x kernels
 * Fix CA-120846: Finding MAC addresses for bonds

ChangeLog

@@ -3,18 +3,6 @@
 
 The easiest way to install is via opam:
 
-    opam init
-    opam remote add xen-org git://github.com/xen-org/opam-repo-dev
-    opam install xcp-networkd
-
-# Coverage Profiling
-
-This code can be instrumented for coverage profiling:
-
-    make coverage
-    make
-
-See [COVERAGE.md](./COVERAGE.md) for details and
-[profiling/](./profiling/) for supporting code.
-
+  opam repo add xs-opam https://github.com/xapi-project/xs-opam.git
+  opam pin add .
 

INSTALL

@@ -1,11 +1,13 @@
 BINDIR ?= /usr/bin
 SBINDIR ?= /usr/sbin
 MANDIR ?= /usr/share/man/man1
+PROFILE=release
+
 
 .PHONY: release build install uninstall clean test doc reindent
 
 release:
-	dune build @install @networkd/man --profile=release
+	dune build @install @networkd/man --profile=$(PROFILE)
 
 build:
 	dune build @install @networkd/man
@@ -27,11 +29,16 @@ clean:
 	dune clean
 
 test:
-	dune runtest --profile=release
+	dune runtest --profile=$(PROFILE)
+
+gprof:
+	dune runtest --profile=gprof
+	@echo "To view results, run:"
+	@echo "gprof _build/default/test/network_test.exe _build/default/gmon.out"
 
 # requires odoc
 doc:
-	dune build @doc --profile=release
+	dune build @doc --profile=$(PROFILE)
 
 reindent:
 	ocp-indent --inplace **/*.ml*

Makefile

@@ -0,0 +1,14 @@
+(env
+ (gprof
+  (ocamlopt_flags
+   (:standard -g -p)
+  )
+  (flags (:standard))
+ )
+ (dev
+  (flags (:standard))
+ )
+ (release
+  (flags (:standard))
+ )
+)

dune

@@ -1,18 +1,16 @@
 (library
-  (name networklibs)
-  (flags (:standard :standard -bin-annot -safe-string))
-  (libraries
-    astring
-    forkexec
-    mtime
-    mtime.clock.os
-    rpclib
-    systemd
-    threads
-    re.perl
-    xapi-stdext-unix
-    xapi-inventory
-    xapi-idl.network
-   )
-  (wrapped false)
+ (name networklibs)
+ (libraries
+  astring
+  forkexec
+  mtime
+  mtime.clock.os
+  rpclib
+  systemd
+  threads
+  re.perl
+  xapi-stdext-unix
+  xapi-inventory
+  xapi-idl.network)
+ (wrapped false)
 )

lib/dune

@@ -20,6 +20,7 @@ val json_rpc_read_timeout : int64 ref
 val json_rpc_write_timeout : int64 ref
 
 val timeout_read : Unix.file_descr -> int64 -> string
+
 (** Do an JSON-RPC call to a server that is listening on a Unix domain 
  *  socket at the given path. *)
 val with_rpc : ?version:Jsonrpc.version -> path:string -> call:Rpc.call -> unit -> Rpc.response

lib/jsonrpc_client.mli

@@ -65,7 +65,7 @@ let read_management_conf () =
         bridge
     in
     let mac = Network_utils.Ip.get_mac device in
-    let ipv4_conf, ipv4_gateway, dns =
+    let ipv4_conf, ipv4_gateway, _dns =
       match List.assoc "MODE" args with
       | "static" ->
         let ip = List.assoc "IP" args |> Unix.inet_addr_of_string in

lib/network_config.ml

@@ -14,7 +14,6 @@
 
 open Xapi_stdext_pervasives
 open Xapi_stdext_unix
-open Xapi_stdext_std
 open Network_interface
 
 module D = Debug.Make(struct let name = "network_utils" end)
@@ -93,7 +92,7 @@ let check_n_run ?(on_error=default_error_handler) ?(log=true) run_func script ar
 
 let call_script ?(timeout=Some 60.0) ?on_error ?log script args =
   let call_script_internal env script args =
-    let (out,err) = Forkhelpers.execute_command_get_output ~env ?timeout script args in
+    let (out,_err) = Forkhelpers.execute_command_get_output ~env ?timeout script args in
     out
   in
   check_n_run ?on_error ?log call_script_internal script args
@@ -155,7 +154,7 @@ module Sysfs = struct
     try
       output_string outchan (l ^ "\n");
       close_out outchan
-    with exn -> close_out outchan; raise (Network_error (Write_error file))
+    with _ -> close_out outchan; raise (Network_error (Write_error file))
 
   let is_physical name =
     try
@@ -175,7 +174,7 @@ module Sysfs = struct
     try
       let devpath = Unix.readlink (getpath name "device") in
       List.hd (List.rev (Astring.String.cuts ~empty:false ~sep:"/" devpath))
-    with exn -> "N/A"
+    with _ -> "N/A"
 
   let get_pci_ids name =
     let read_id_from path =
@@ -193,7 +192,7 @@ module Sysfs = struct
     try
       let driver_path = Unix.readlink (getpath dev "device/driver") in
       match Astring.String.cut ~sep:"/" ~rev:true driver_path with
-      | Some (prefix, suffix) -> Some suffix
+      | Some (_prefix, suffix) -> Some suffix
       | None ->
         debug "get %s driver name: %s does not contain slash" dev driver_path;
         None
@@ -417,11 +416,6 @@ module Ip = struct
   let get_mtu dev =
     int_of_string (List.hd (link dev "mtu"))
 
-  let get_state dev =
-    match addr dev "state" with
-    | "UP" :: _ -> true
-    | _ -> false
-
   let get_mac dev =
     List.hd (link dev "link/ether")
 
@@ -748,7 +742,7 @@ module Dhclient = struct
     let ipv6' = if ipv6 then "6" else "" in
     Filename.concat "/var/lib/xcp" (Printf.sprintf "dhclient%s-%s.conf" ipv6' interface)
 
-  let generate_conf ?(ipv6=false) interface options =
+  let[@warning "-27"] generate_conf ?(ipv6=false) interface options =
     let minimal = ["subnet-mask"; "broadcast-address"; "time-offset"; "host-name"; "nis-domain";
                    "nis-servers"; "ntp-servers"; "interface-mtu"] in
     let set_gateway = 
@@ -874,7 +868,7 @@ module Proc = struct
         loop None [] lines
       in
       check_lines lines
-    with e ->
+    with _ ->
       error "Error: could not read %s." (bonding_dir ^ name);
       []
 
@@ -894,14 +888,10 @@ module Proc = struct
           with _ ->
             vlans
         ) [] "/proc/net/vlan/config"
-    with e ->
+    with _ ->
       error "Error: could not read /proc/net/vlan/config";
       []
 
-  let get_bond_links_up name =
-    let statusses = get_bond_slave_info name "MII Status" in
-    List.fold_left (fun x (_, y) -> x + (if y = "up" then 1 else 0)) 0 statusses
-
   let get_ipv6_disabled () =
     try
       Unixext.string_of_file "/proc/sys/net/ipv6/conf/all/disable_ipv6"
@@ -1002,7 +992,7 @@ module Ovs = struct
 
     let get_real_bridge name =
       match bridge_to_vlan name with
-      | Some (parent, vlan) -> parent
+      | Some (parent, _vlan) -> parent
       | None -> name
 
     let get_bond_link_status name =
@@ -1026,11 +1016,6 @@ module Ovs = struct
           ) ([], None) lines
       with _ -> [], None
 
-    let get_bond_links_up name =
-      let slaves, _ = get_bond_link_status name in
-      let links_up = List.filter snd slaves in
-      List.length (links_up)
-
     let get_bond_mode name =
       try
         let output = String.trim (vsctl ~log:false ["get"; "port"; name; "bond_mode"]) in
@@ -1119,7 +1104,7 @@ module Ovs = struct
 
     let inject_igmp_query ~name =
       try
-        let vvifs = get_bridge_vlan_vifs name in
+        let vvifs = get_bridge_vlan_vifs ~name in
         let bvifs = bridge_to_interfaces name in
         let bvifs' = List.filter (fun vif -> Astring.String.is_prefix ~affix:"vif" vif) bvifs in
         (* The vifs may be large. However considering current XS limit of 1000VM*7NIC/VM + 800VLANs, the buffer of CLI should be sufficient for lots of vifxxxx.xx *)
@@ -1210,9 +1195,6 @@ module Ovs = struct
     let destroy_port name =
       vsctl ["--"; "--with-iface"; "--if-exists"; "del-port"; name]
 
-    let port_to_bridge name =
-      vsctl ~log:false ["port-to-br"; name]
-
     let make_bond_properties name properties =
       let known_props = ["mode"; "hashing-algorithm"; "updelay"; "downdelay";
                          "miimon"; "use_carrier"; "rebalance-interval";
@@ -1422,7 +1404,7 @@ module Modprobe = struct
   let get_config_from_comments driver =
     try
       let open Xapi_stdext_std.Listext in
-      Unixext.read_lines (getpath driver)
+      Unixext.read_lines ~path:(getpath driver)
       |> List.filter_map (fun x ->
           let line = String.trim x in
           if not (Astring.String.is_prefix ~affix:("# ") line)
@@ -1501,7 +1483,7 @@ module Modprobe = struct
       else
         trimed_s
     in
-    let lines = try Unixext.read_lines (getpath driver) with _ -> [] in
+    let lines = try Unixext.read_lines ~path:(getpath driver) with _ -> [] in
     let new_conf = List.map parse_single_line lines in
     match !has_probe_conf, !need_rebuild_initrd with
     | true, true ->