Ocaml Compatibility, Strings Deprecated Warning (#1705)

* Use camlp4 to select Bytes vs. String modules with a Compat module
* Fixed http.ml warning

sw/ground_segment/cockpit/gcs.ml

@@ -26,6 +26,7 @@ module G = MapCanvas
 open Printf
 open Latlong
 
+
 let locale = GtkMain.Main.init ~setlocale:false ()
 
 let soi = string_of_int
@@ -377,7 +378,7 @@ let options =
     "-auto_hide_fp", Arg.Unit (fun () -> Live.auto_hide_fp true; hide_fp := true), "Automatically hide flight plans of unselected aircraft";
     "-timestamp", Arg.Set timestamp, "Bind on timestampped telemetry messages";
     "-ac_ids", Arg.String (fun s -> Live.filter_ac_ids s), "comma separated list of AC IDs to show in GCS";
-    "-no_confirm_kill", Arg.Unit (fun () -> confirm_kill := false), "Disable kill confirmation from strip button"; 
+    "-no_confirm_kill", Arg.Unit (fun () -> confirm_kill := false), "Disable kill confirmation from strip button";
   ]
 
 
@@ -498,7 +499,7 @@ let resize = fun (widget:GObj.widget) orientation size ->
 
 let rec pack_widgets = fun orientation xml widgets packing ->
   let size = try Some (ExtXml.int_attrib xml "size") with _ -> None in
-  match String.lowercase (Xml.tag xml) with
+  match Compat.bytes_lowercase (Xml.tag xml) with
       "widget" ->
         let name = ExtXml.attrib xml "name" in
         let widget =
@@ -525,7 +526,7 @@ and pack_list = fun resize orientation xmls widgets packing ->
 
 let rec find_widget_children = fun name xml ->
   let xmls = Xml.children xml in
-  match String.lowercase (Xml.tag xml) with
+  match Compat.bytes_lowercase (Xml.tag xml) with
       "widget" when ExtXml.attrib xml "name" = name -> xmls
     | "rows" | "columns" ->
       let rec loop = function
@@ -539,7 +540,7 @@ let rec find_widget_children = fun name xml ->
 
 let rec replace_widget_children = fun name children xml ->
   let xmls = Xml.children xml
-  and tag = String.lowercase (Xml.tag xml) in
+  and tag = Compat.bytes_lowercase (Xml.tag xml) in
   match tag with
       "widget" ->
         Xml.Element("widget",
@@ -561,7 +562,7 @@ let rec update_widget_size = fun orientation widgets xml ->
     if orientation = `HORIZONTAL then rect.Gtk.width else rect.Gtk.height
   in
   let xmls = Xml.children xml
-  and tag = String.lowercase (Xml.tag xml) in
+  and tag = Compat.bytes_lowercase (Xml.tag xml) in
   match tag with
       "widget" ->
         let name = ExtXml.attrib xml "name" in

sw/ground_segment/cockpit/live.ml

@@ -27,6 +27,7 @@ open Latlong
 module LL = Latlong
 open Printf
 
+
 module Tele_Pprz = PprzLink.Messages(struct let name = "telemetry" end)
 module Ground_Pprz = PprzLink.Messages(struct let name = "ground" end)
 module Alert_Pprz = PprzLink.Messages(struct let name = "alert" end)
@@ -167,7 +168,7 @@ let select_ac = fun acs_notebook ac_id ->
     if !active_ac <> "" then begin
       let ac' = find_ac !active_ac in
       ac'.strip#hide_buttons ();
-      ac'.notebook_label#set_width_chars (String.length ac'.notebook_label#text);
+      ac'.notebook_label#set_width_chars (Compat.bytes_length ac'.notebook_label#text);
       if !_auto_hide_fp then hide_fp ac'
     end;
 
@@ -339,12 +340,12 @@ let mark = fun (geomap:G.widget) ac_id track plugin_frame ->
 let attributes_pretty_printer = fun attribs ->
   (* Remove the optional attributes *)
   let valid = fun a ->
-    let a = String.lowercase a in
+    let a = Compat.bytes_lowercase a in
     a <> "no" && a <> "strip_icon" && a <> "strip_button" && a <> "pre_call"
     && a <> "post_call" && a <> "key" && a <> "group" in
 
   let sprint_opt = fun b s ->
-    if String.length b > 0 then
+    if Compat.bytes_length b > 0 then
       sprintf " %s%s%s" s b s
     else
       ""
@@ -631,7 +632,7 @@ let create_ac = fun ?(confirm_kill=true) alert (geomap:G.widget) (acs_notebook:G
   let settings_file = Http.file_of_url settings_url in
   let settings_xml =
     try
-      if String.compare "replay" settings_file <> 0 then
+      if Compat.bytes_compare "replay" settings_file <> 0 then
         ExtXml.parse_file ~noprovedtd:true settings_file
       else
         Xml.Element("empty", [], [])
@@ -731,7 +732,7 @@ let create_ac = fun ?(confirm_kill=true) alert (geomap:G.widget) (acs_notebook:G
         and airspeed = sprintf "%.1f" ac.airspeed in
 
         let msg_items = ["WIND_INFO"; ac_id; "42"; wind_east; wind_north;airspeed] in
-        let value = String.concat ";" msg_items in
+        let value = Compat.bytes_concat ";" msg_items in
         let vs = ["ac_id", PprzLink.String ac_id; "message", PprzLink.String value] in
         Ground_Pprz.message_send "dl" "RAW_DATALINK" vs;
       with

sw/ground_segment/cockpit/page_settings.ml

@@ -24,6 +24,7 @@
 
 open Printf
 
+
 let (//) = Filename.concat
 
 
@@ -90,7 +91,7 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) ac_id packing dl_
       1.
   in
   (* get number of digits after decimal dot *)
-  let digits = try String.length (ExtXml.attrib dl_setting "step") - String.index (ExtXml.attrib dl_setting "step") '.' - 1 with _ -> 0 in
+  let digits = try Compat.bytes_length (ExtXml.attrib dl_setting "step") - Compat.bytes_index (ExtXml.attrib dl_setting "step") '.' - 1 with _ -> 0 in
   let page_incr = step_incr
   and page_size = step_incr
   and show_auto = try ExtXml.attrib dl_setting "auto" = "true" with _ -> false in
@@ -248,7 +249,7 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) ac_id packing dl_
 
   (** Insert the related buttons in the strip and prepare the papgets DnD *)
   List.iter (fun x ->
-    match String.lowercase (Xml.tag x) with
+    match Compat.bytes_lowercase (Xml.tag x) with
         "strip_button" ->
           let label = ExtXml.attrib x "name"
           and sp_value = ExtXml.float_attrib x "value"
@@ -292,7 +293,7 @@ let same_tag_for_all = function
   | x::xs ->
     let tag_first = Xml.tag x in
     List.iter (fun y -> assert(ExtXml.tag_is y tag_first)) xs;
-    String.lowercase tag_first
+    Compat.bytes_lowercase tag_first
 
 
 (** Build the tree of settings *)
@@ -365,4 +366,3 @@ object (self)
     let settings = Array.fold_right (fun setting r -> try (setting#index, setting#xml, setting#last_known_value)::r with _ -> r) variables [] in
     SaveSettings.popup airframe_filename (Array.of_list settings) do_change
 end
-

sw/ground_segment/cockpit/saveSettings.ml

@@ -22,6 +22,7 @@
  *
  *)
 
+
 module U = Unix
 
 (** How to have them local ? *)
@@ -198,7 +199,7 @@ let fill_data = fun (model:GTree.tree_store) settings airframe_xml ->
 
   (* Warning if needed *)
   if !not_in_airframe_file <> [] then begin
-    GToolbox.message_box ~title:"Warning" (Printf.sprintf "Some parameters not writable in the airframe file:\n\n%s" (String.concat "\n" !not_in_airframe_file));
+    GToolbox.message_box ~title:"Warning" (Printf.sprintf "Some parameters not writable in the airframe file:\n\n%s" (Compat.bytes_concat "\n" !not_in_airframe_file));
   end
 
 

sw/ground_segment/cockpit/sectors.ml

@@ -2,11 +2,12 @@
 
 open Printf
 
+
 let (//) = Filename.concat
 
 let rec display = fun (geomap:MapCanvas.widget) r ->
 
-  match String.lowercase (Xml.tag r) with
+  match Compat.bytes_lowercase (Xml.tag r) with
       "disc" ->
         let rad = float_of_string (ExtXml.attrib r "radius")
         and geo = Latlong.of_string (ExtXml.attrib (ExtXml.child r "point") "pos") in

sw/ground_segment/cockpit/strip.ml

@@ -23,6 +23,7 @@
  *)
 
 open Printf
+
 module LL=Latlong
 
 let (//) = Filename.concat
@@ -327,7 +328,7 @@ object
 
     (* add a button widget in a vertical box if it belongs to a group (create new group if needed) *)
   method add_widget ?(group="") w =
-    let (vbox, pack) = match String.length group with
+    let (vbox, pack) = match Compat.bytes_length group with
         0 -> (GPack.vbox ~show:true (), true)
       | _ -> try (Hashtbl.find button_tbl group, false) with
           Not_found ->

sw/ground_segment/tmtc/broadcaster.ml

@@ -1,3 +1,4 @@
+
 open Printf
 
 let () =
@@ -24,12 +25,12 @@ let () =
 
     (* Forward telemetry on Ivy *)
     let buffer_size = 256 in
-    let buffer = String.create buffer_size in
+    let buffer = Compat.bytes_create buffer_size in
     let get_tcp = fun _ ->
       begin
         try
           let n = input i buffer 0 buffer_size in
-          let data = String.sub buffer 0 n in
+          let data = Compat.bytes_sub buffer 0 n in
 
           Ivy.send (sprintf "%s %s" !ivy_to (Base64.encode_string data))
         with

sw/ground_segment/tmtc/fw_server.ml

@@ -22,6 +22,7 @@
  *
  *)
 
+
 open Printf
 open Server_globals
 open Aircraft
@@ -57,10 +58,10 @@ let ivalue = fun x ->
     | _ -> failwith "Receive.log_and_parse: int expected"
 
 let format_string_field = fun s ->
-  let s = String.copy s in
-  for i = 0 to String.length s - 1 do
+  let s = Compat.bytes_copy s in
+  for i = 0 to Compat.bytes_length s - 1 do
     match s.[i] with
-        ' ' -> s.[i] <- '_'
+        ' ' ->  Compat.bytes_set s i '_'
       | _ -> ()
   done;
   s
@@ -356,4 +357,3 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values ->
       a.datalink_status.downlink_rate <- ivalue "downlink_rate";
       a.datalink_status.downlink_msgs <- ivalue "downlink_nb_msgs"
     | _ -> ()
-

sw/ground_segment/tmtc/ivy2serial.ml

@@ -38,6 +38,7 @@ module Tm_Pprz = PprzLink.Messages(struct let name = "telemetry" end)
 module Dl_Pprz = PprzLink.Messages(struct let name = "datalink" end)
 module PprzTransport = Protocol.Transport(Pprz_transport.Transport)
 
+
 open Printf
 
 let () =
@@ -80,12 +81,12 @@ let () =
 
   (* The function to be called when data is available *)
   let buffer_size = 256 in
-  let buffer = String.create buffer_size in
+  let buffer = Compat.bytes_create buffer_size in
   let get_datalink_message = fun _ ->
     begin
       try
         let n = input (Unix.in_channel_of_descr fd) buffer 0 buffer_size in
-        let b = String.sub buffer 0 n in
+        let b = Compat.bytes_sub buffer 0 n in
         Debug.trace 'x' (Debug.xprint b);
 
         let use_dl_message = fun payload ->

sw/ground_segment/tmtc/ivy2udp.ml

@@ -28,6 +28,7 @@ module Tm_Pprz = PprzLink.Messages(struct let name = "telemetry" end)
 module Dl_Pprz = PprzLink.Messages(struct let name = "datalink" end)
 module PprzTransport = Protocol.Transport(Pprz_transport.Transport)
 
+
 open Printf
 
 let () =
@@ -61,7 +62,7 @@ let () =
       let (msg_id, vs) = Tm_Pprz.values_of_string args.(0) in
       let payload = Tm_Pprz.payload_of_values msg_id (int_of_string !id) vs in
       let buf = Pprz_transport.Transport.packet payload in
-      let n = String.length buf in
+      let n = Compat.bytes_length buf in
       let n' = Unix.sendto socket buf 0 n [] sockaddr in
       assert (n = n')
     with _ -> () in
@@ -74,12 +75,12 @@ let () =
   Unix.bind socket sockaddr;
 
   let buffer_size = 256 in
-  let buffer = String.create buffer_size in
+  let buffer = Compat.bytes_create buffer_size in
   let get_datalink_message = fun _ ->
     begin
       try
         let n = input (Unix.in_channel_of_descr socket) buffer 0 buffer_size in
-        let b = String.sub buffer 0 n in
+        let b = Compat.bytes_sub buffer 0 n in
         Debug.trace 'x' (Debug.xprint b);
 
         let use_dl_message = fun payload ->

sw/ground_segment/tmtc/ivy_tcp_aircraft.ml

@@ -3,6 +3,7 @@ module Tm_Pprz = PprzLink.Messages(struct let name = "telemetry" end)
 module Dl_Pprz = PprzLink.Messages(struct let name = "datalink" end)
 module PprzTransport = Protocol.Transport(Pprz_transport.Transport)
 
+
 open Printf
 let () =
   let ivy_bus = ref Defivybus.default_ivy_bus  in
@@ -40,12 +41,12 @@ let () =
 
   (* Forward a datalink command on the bus *)
   let buffer_size = 256 in
-  let buffer = String.create buffer_size in
+  let buffer = Compat.bytes_create buffer_size in
   let get_datalink_message = fun _ ->
     begin
       try
         let n = input i buffer 0 buffer_size in
-        let b = String.sub buffer 0 n in
+        let b = Compat.bytes_sub buffer 0 n in
         Debug.trace 'x' (Debug.xprint b);
 
         let use_dl_message = fun payload ->

sw/ground_segment/tmtc/ivy_tcp_controller.ml

@@ -1,3 +1,4 @@
+
 open Printf
 
 module Tm_Pprz = PprzLink.Messages(struct let name = "telemetry" end)
@@ -28,12 +29,12 @@ let () =
   let (i, o) = Unix.open_connection sockaddr in
 
   let buffer_size = 256 in
-  let buffer = String.create buffer_size in
+  let buffer = Compat.bytes_create buffer_size in
   let get_message = fun _ ->
     begin
       try
         let n = input i buffer 0 buffer_size in
-        let b = String.sub buffer 0 n in
+        let b = Compat.bytes_sub buffer 0 n in
         Debug.trace 'x' (Debug.xprint b);
 
         let use_tele_message = fun payload ->

sw/ground_segment/tmtc/kml.ml

@@ -22,6 +22,7 @@
  *
  *)
 
+
 open Aircraft
 open Latlong
 open Printf
@@ -91,7 +92,7 @@ let circle = fun geo radius alt ->
     let wgs84 = of_utm WGS84 utm in
     coordinates wgs84 alt in
   let points = Array.init 360 degree_point in
-  String.concat " " (points.(359) :: Array.to_list points)
+  Compat.bytes_concat " " (points.(359) :: Array.to_list points)
 
 
 let ring_around_home = fun utm0 fp ->
@@ -236,7 +237,7 @@ let update_horiz_mode =
       let alt = ac.desired_altitude in
       match ac.horiz_mode with
           Segment (p1, p2) ->
-            let coordinates = String.concat " " (List.map (fun p -> coordinates p alt) [p1; p2]) in
+            let coordinates = Compat.bytes_concat " " (List.map (fun p -> coordinates p alt) [p1; p2]) in
             let kml_changes = update_linear_ring url_flight_plan "horiz_mode" coordinates in
             print_xml ac.name "route_changes.kml" kml_changes
         | Circle (p, r) ->