fix: all compilation errors and most warnings given by 4.00.1

rixed · Aug 16, 2013 · 61efdbc · 61efdbc
1 parent f1ecc3c
commit 61efdbc
Show file tree

Hide file tree

Showing 31 changed files with 71 additions and 65 deletions.
diff --git a/Makefile b/Makefile
@@ -53,7 +53,7 @@ EXAMPLES_BYTE = \
 	examples/capecho.byte \
 	examples/load_tester.byte \
 	examples/pcap_reorder.byte \
-#	examples/simu_perfweb.byte
+	examples/simu_perfweb.byte
 
 EXAMPLES_OPT = $(EXAMPLES_BYTE:.byte=.opt)
 EXAMPLES = $(EXAMPLES_BYTE) $(EXAMPLES_OPT)

diff --git a/browser.ml b/browser.ml
@@ -27,7 +27,6 @@
 
 *)
 open Batteries
-open Bitstring
 open Tools
 open Http
 open Html
@@ -269,7 +268,7 @@ let rec request t ?(command="GET") ?(headers=[]) ?body url cont =
             TRXtop.tx http in
         match find_vacant_cnx t addr port with
             | None ->
-                if debug then Printf.printf "Browser: establishing new cnx\n" ;
+                if debug then Printf.printf "Browser: establishing new cnx to %s\n" (Host.string_of_addr addr) ;
                 let http = TRXtop.make () in
                 t.host.Host.tcp_connect addr port (function
                 | None -> cont None

diff --git a/clock.ml b/clock.ml
@@ -34,7 +34,6 @@
 
 *)
 open Batteries
-open Bitstring
 open Tools
 
 let debug = false

diff --git a/dhcpd.ml b/dhcpd.ml
@@ -18,7 +18,6 @@
  * along with RobiNet.  If not, see <http://www.gnu.org/licenses/>.
  *)
 open Batteries
-open Bitstring
 open Tools
 open Dhcp
 
@@ -48,6 +47,7 @@ let serve ?(port=Udp.Port.o 67) host ips =
                     (* Store the offer *before* spawning the responding thread *)
                     BitHash.replace offers dhcp.Pdu.chaddr offered_ip ;
                     (* Send the offer *)
+                    Log.(log logger Debug (lazy (Printf.sprintf "Offering IP %s to %s" (Ip.Addr.to_string offered_ip) (hexstring_of_bitstring dhcp.Pdu.chaddr)))) ;
                     Pdu.make_offer ~mac:(host.Host.get_mac ())
                                    ~xid:dhcp.Pdu.xid offered_ip
                                    dhcp.Pdu.client_id |>

diff --git a/examples/arp_query.ml b/examples/arp_query.ml
@@ -18,7 +18,6 @@
  * along with RobiNet.  If not, see <http://www.gnu.org/licenses/>.
  *)
 open Bitstring
-open Tools
 
 (* TODO: make this a parameter.
          make eth0 a command line arg *)
@@ -32,7 +31,7 @@ let arp_query (src_eth : Eth.Addr.t) src_ip target_ip =
     let eth = Eth.Pdu.make Arp.HwProto.arp src_eth Eth.Addr.broadcast (Arp.Pdu.pack arp) in
     Pcap.inject iface (string_of_bitstring (Eth.Pdu.pack eth))
 
-let rec wait_answer target_ip_bits =
+let wait_answer target_ip_bits =
     (* TODO: times out *)
     let rec aux () =
         let _ts, packet = Pcap.sniff iface in

diff --git a/examples/beautify_html.ml b/examples/beautify_html.ml
@@ -21,7 +21,6 @@
    Display the HTML structure of a file containing HTML.
 *)
 open Batteries
-open Bitstring
 open Tools
 
 let main =

diff --git a/examples/beautify_mac.ml b/examples/beautify_mac.ml
@@ -17,7 +17,6 @@
  * You should have received a copy of the GNU Affero General Public License
  * along with RobiNet.  If not, see <http://www.gnu.org/licenses/>.
  *)
-open Bitstring
 
 let main =
     let beautify_one mac =

diff --git a/examples/capecho.ml b/examples/capecho.ml
@@ -21,8 +21,6 @@
    This will open a pcap file and add duplicates (with a given delay)
 *)
 open Batteries
-open Bitstring
-open Tools
 open Pcap
 
 let handle_file delay ifile ofile =

diff --git a/examples/http_echo_server.ml b/examples/http_echo_server.ml
@@ -21,8 +21,6 @@
    Small HTTP server for tests
 *)
 open Batteries
-open Bitstring
-open Tools
 
 let run port =
     let host = Localhost.make () in

diff --git a/examples/http_load.ml b/examples/http_load.ml
@@ -22,7 +22,6 @@
    from a given URL.
 *)
 open Batteries
-open Bitstring
 open Tools
 
 let run ifname src_range nb_srcs ?gw ?search_sfx ?nameserver ?pause max_depth start_url =

diff --git a/examples/http_static_server.ml b/examples/http_static_server.ml
@@ -21,8 +21,6 @@
    Small HTTP server for tests
 *)
 open Batteries
-open Bitstring
-open Tools
 
 let run port root =
     let host = Localhost.make () in

diff --git a/examples/pcap_reorder.ml b/examples/pcap_reorder.ml
@@ -23,8 +23,6 @@
 *)
 
 open Batteries
-open Bitstring
-open Tools
 
 let input_of name =
     Pcap.enum_of_file name

diff --git a/examples/simu_perfweb.ml b/examples/simu_perfweb.ml
@@ -22,41 +22,41 @@ let make_net avg_group_size nb_groups ifname nameserver =
          * server and a switch, with a free port for external connectivity. *)
         let nb_hosts = avg_group_size in
         Log.(log logger Info (lazy (Printf.sprintf "Create group %d with %d hosts" i nb_hosts))) ;
+        (* FIXME: nameserver should be nothing but a fence in our virtual internet *)
         let group = Sim.Net.make_simple_lan ~nameserver nb_hosts in
         Log.(log logger Info (lazy "Connect it...")) ;
         (* Sim.Net.connect takes two nets and connect them the obvious way *)
         if Result.is_bad (Sim.Net.connect inet group) then
             should_not_happen () ;
         group) in
     Log.(log logger Info (lazy ("Connecting "^ifname))) ;
-    let sink, sniff_thread = Sim.Net.make_sink ifname in
+    let sink, _sniff_thread = Sim.Net.make_sink ifname in
     if Result.is_bad (Sim.Net.connect inet sink) then
         should_not_happen () ;
-    Sim.Net.union (inet :: sink :: groups), [ sniff_thread ]
+    Sim.Net.union (inet :: sink :: groups)
 
 (** Spawn a browser thread in all hosts of the given network, that will browse
  * at random in a human like fashion from the root url *)
+(* FIXME: Would be easier if we could give to make_net a sort of 'init' function for each host *)
 let random_browsing net url =
-    List.filter_map (function
+    List.iter (function
         | Sim.Net.Host host ->
             Log.(log logger Info (lazy (Printf.sprintf "Starting a new web browser on %s" host.Host.name))) ;
             let browser = Browser.make host in
-            Some (Browser.user browser ~pause:5. 1000 url)
-        | _ -> None)
+            Browser.user browser ~pause:5. 1000 url
+        | _ -> ())
         net.Sim.Net.equip
 
 
 (** {1 Main function} *)
 
-(** A simulation is basically a function returning the threads. *)
-let simul_webperf avg_group_size nb_groups duration ifname nameserver url =
+(** This will creates the objects and queue the first callbacks but does not start the clock *)
+let simul_webperf avg_group_size nb_groups _duration ifname nameserver url =
     Log.(log logger Info (lazy (Printf.sprintf "Starting webperf simulation with %d groups of %d users (avg) for base url %s"
         nb_groups avg_group_size (Url.to_string url)))) ;
-    let net, net_threads = make_net avg_group_size nb_groups ifname nameserver in
+    let net = make_net avg_group_size nb_groups ifname nameserver in
     Log.(log logger Info (lazy "Starting browser on each host...")) ;
-    let browsers = random_browsing net url in
-    Log.(log logger Info (lazy "Running it all...")) ;
-    Clock.run (net_threads @ browsers)
+    random_browsing net url
 
 let main =
     let url = ref "http://google.com"
@@ -80,5 +80,7 @@ let main =
                   (Clock.Interval.sec (float_of_int !duration))
                   !ifname
                   (Ip.Addr.of_string !nameserver)
-                  (Url.of_string !url)
+                  (Url.of_string !url) ;
+    Log.(log logger Info (lazy "Running it all...")) ;
+    Clock.run true
 
diff --git a/examples/test_dhcp.ml b/examples/test_dhcp.ml
@@ -21,7 +21,6 @@
    Small HTTP server for tests
 *)
 open Batteries
-open Bitstring
 open Tools
 
 let run iface =

diff --git a/examples/test_ping.ml b/examples/test_ping.ml
@@ -4,7 +4,6 @@
    Test that a host answer a ping
 *)
 open Batteries
-open Bitstring
 open Tools
 
 let run () =

diff --git a/examples/tunnel.ml b/examples/tunnel.ml
@@ -22,7 +22,6 @@
    to a given destination.
 *)
 open Batteries
-open Bitstring
 open Tools
 
 let tunnel ifname tun_ip tun_mac gw search_sfx nameserver dst dst_port src_port =

diff --git a/examples/wanaplay.ml b/examples/wanaplay.ml
@@ -23,7 +23,6 @@
  a reservation at a decent time. Many hours of sleep saved thanks to RobiNet! ;->)
 *)
 open Batteries
-open Bitstring
 open Tools
 
 (* At each step, we:

diff --git a/html.ml b/html.ml
@@ -495,7 +495,7 @@ let rec iter_nodes f = function
 let iter_node f tree = iter_nodes f [tree]
 
 exception Found_node of node
-let rec find_first_node f tree =
+let find_first_node f tree =
     try
         iter_node (fun n -> if f n then raise (Found_node n)) tree ;
         None
@@ -512,7 +512,7 @@ let filter_map_node f tree =
             aux l n.children in
     aux [] [tree]
 
-let rec attrs_of l =
+let attrs_of l =
     let rec aux prev = function
         | [] -> prev
         | `Attr x :: l' -> aux (x::prev) l'

diff --git a/ip.ml b/ip.ml
@@ -133,8 +133,8 @@ module Addr = struct
             else
                 None
         in
-        Scanf.sscanf str "%ld.%ld.%ld.%ld" assemble
-        (* FIXME: checkme! *)
+        try Scanf.sscanf str "%ld.%ld.%ld.%ld" assemble
+        with Scanf.Scan_failure _ -> None
 
     (** Convert an {!Ip.Addr.t} to a [bitstring]. *)
     let to_bitstring (t : t) = (BITSTRING { (t :> int32) : 32 })

diff --git a/localhost.ml b/localhost.ml
@@ -113,7 +113,7 @@ let gethostbyname name cont =
         Ip.Addr.of_inet_addr |>
         List.of_enum in
     cont (Some ips)
-    
+
 
 let tcp_connect dst ?src_port (dst_port : Tcp.Port.t) cont =
     let connect_tcp_ inet_addr =

diff --git a/log.ml b/log.ml
@@ -24,7 +24,6 @@
   Additionally, messages of higher level than some threshold are copied onto stderr.
 *)
 open Batteries
-open Tools
 
 (* Basically, Info is the lowest thing you want to see by default. *)
 type level  = Critical | Error | Warning | Info | Debug

diff --git a/make.common b/make.common
@@ -6,8 +6,8 @@ OCAMLDOC   = ocamlfind ocamldoc -html -colorize-code -thread -sort -stars
 OCAMLMKTOP = ocamlfind ocamlmktop -thread -g
 QTEST      = qtest
 DOCDIR    ?= doc/
-override OCAMLOPTFLAGS += $(INCS) -w Ael -g -annot
-override OCAMLFLAGS    += $(INCS) -w Ael -g -annot
+override OCAMLOPTFLAGS += $(INCS) -w Ael-31 -g -annot
+override OCAMLFLAGS    += $(INCS) -w Ael-31 -g -annot
 
 CAMLINCLUDE = $(shell ocamlfind printconf stdlib)
 CPPFLAGS   += -I $(CAMLINCLUDE) -I .

diff --git a/metric.ml b/metric.ml
@@ -46,7 +46,6 @@
 *)
 
 open Batteries
-open Bitstring
 open Tools
 
 let debug = false
@@ -180,7 +179,7 @@ let print_report oc =
     Hashtbl.iter (fun _ ev -> Timed.print oc ev) Timed.all ;
     flush oc
 
-let rec report_thread oc period =
+let report_thread oc period =
     let rec loop () =
         Thread.delay period ;
         print_report oc ;

diff --git a/pcap.ml b/pcap.ml
@@ -39,6 +39,7 @@ Tcp.Pdu.make ~dst_port:(Tcp.Port.o 5000) (bitstring_of_string "HTTP/1.2 pas glop
 
 {[
 
+let grep needle haystack = try String.find haystack needle ; true with Not_found -> false in
 Pcap.enum_of_file "input.pcap" |>
     Enum.filter (fun pdu -> grep "needle" (string_of_bitstring (pdu.Pcap.Pdu.payload :> bitstring))) |>
     Pcap.file_of_enum "output.pcap";;
@@ -303,7 +304,7 @@ let read_next_pkt global_header ic =
 (** From a pcap file, returns an [Enum.t] of {!Pcap.Pdu.t}. *)
 let enum_of_file fname =
     let global_header, ic = read_global_header fname in
-    let rec next () =
+    let next () =
         try read_next_pkt global_header ic
         with IO.No_more_input | IO.Input_closed ->
             raise Enum.No_more_elements in

diff --git a/.ocamlinit → robinet.init b/.ocamlinit → robinet.init
@@ -1,10 +1,16 @@
+(* from OPAM. *)
+let () =
+  try Topdirs.dir_directory (Sys.getenv "OCAML_TOPLEVEL_PATH")
+  with Not_found -> ()
+;;
+
 (*
 #require "findlib";;
 Toploop.use_silently
 	Format.err_formatter (Filename.concat (Findlib.package_directory "batteries") "battop.ml");;
 *)
 #require "bitstring";;
-#require "batteries.pa_string.syntax";;
+#require "batteries";;
 #camlp4o;;
 
 open Batteries;;