From da088e4eef2bbea4be262e12db4c36960ff5145a Mon Sep 17 00:00:00 2001 From: Michael Young Date: Mon, 12 Mar 2018 18:49:29 +0000 Subject: [PATCH v4] make xen ocaml safe-strings compliant Xen built with ocaml 4.06 gives errors such as Error: This expression has type bytes but an expression was expected of type string as Byte and safe-strings which were introduced in 4.02 are the default in 4.06. This patch which is partly by Richard W.M. Jones of Red Hat from https://bugzilla.redhat.com/show_bug.cgi?id=1526703 fixes these issues. v4: Where string s is now bytes, rename it to b. Signed-off-by: Michael Young --- tools/ocaml/libs/xb/xb.ml | 34 ++++++++++++++++++---------------- tools/ocaml/libs/xb/xb.mli | 10 +++++----- tools/ocaml/xenstored/logging.ml | 22 +++++++++++----------- tools/ocaml/xenstored/stdext.ml | 2 +- tools/ocaml/xenstored/utils.ml | 20 ++++++++++---------- 5 files changed, 45 insertions(+), 43 deletions(-) diff --git a/tools/ocaml/libs/xb/xb.ml b/tools/ocaml/libs/xb/xb.ml index 50944b5fd6..519842723b 100644 --- a/tools/ocaml/libs/xb/xb.ml +++ b/tools/ocaml/libs/xb/xb.ml @@ -40,7 +40,7 @@ type backend_fd = type backend = Fd of backend_fd | Xenmmap of backend_mmap -type partial_buf = HaveHdr of Partial.pkt | NoHdr of int * string +type partial_buf = HaveHdr of Partial.pkt | NoHdr of int * bytes type t = { @@ -52,7 +52,7 @@ type t = } let init_partial_in () = NoHdr - (Partial.header_size (), String.make (Partial.header_size()) '\000') + (Partial.header_size (), Bytes.make (Partial.header_size()) '\000') let reconnect t = match t.backend with | Fd _ -> @@ -69,26 +69,28 @@ let reconnect t = match t.backend with let queue con pkt = Queue.push pkt con.pkt_out -let read_fd back con s len = - let rd = Unix.read back.fd s 0 len in +let read_fd back con b len = + let rd = Unix.read back.fd b 0 len in if rd = 0 then raise End_of_file; rd -let read_mmap back con s len = +let read_mmap back con b len = + let s = String.make len (char_of_int 0) in let rd = Xs_ring.read back.mmap s len in + Bytes.blit_string s 0 b 0 rd; back.work_again <- (rd > 0); if rd > 0 then back.eventchn_notify (); rd -let read con s len = +let read con b len = match con.backend with - | Fd backfd -> read_fd backfd con s len - | Xenmmap backmmap -> read_mmap backmmap con s len + | Fd backfd -> read_fd backfd con b len + | Xenmmap backmmap -> read_mmap backmmap con b len -let write_fd back con s len = - Unix.write back.fd s 0 len +let write_fd back con b len = + Unix.write back.fd b 0 len let write_mmap back con s len = let ws = Xs_ring.write back.mmap s len in @@ -98,7 +100,7 @@ let write_mmap back con s len = let write con s len = match con.backend with - | Fd backfd -> write_fd backfd con s len + | Fd backfd -> write_fd backfd con (Bytes.of_string s) len | Xenmmap backmmap -> write_mmap backmmap con s len (* NB: can throw Reconnect *) @@ -129,15 +131,15 @@ let input con = | NoHdr (i, buf) -> i in (* try to get more data from input stream *) - let s = String.make to_read '\000' in - let sz = if to_read > 0 then read con s to_read else 0 in + let b = Bytes.make to_read '\000' in + let sz = if to_read > 0 then read con b to_read else 0 in ( match con.partial_in with | HaveHdr partial_pkt -> (* we complete the data *) if sz > 0 then - Partial.append partial_pkt s sz; + Partial.append partial_pkt (Bytes.to_string b) sz; if Partial.to_complete partial_pkt = 0 then ( let pkt = Packet.of_partialpkt partial_pkt in con.partial_in <- init_partial_in (); @@ -147,9 +149,9 @@ let input con = | NoHdr (i, buf) -> (* we complete the partial header *) if sz > 0 then - String.blit s 0 buf (Partial.header_size () - i) sz; + Bytes.blit b 0 buf (Partial.header_size () - i) sz; con.partial_in <- if sz = i then - HaveHdr (Partial.of_string buf) else NoHdr (i - sz, buf) + HaveHdr (Partial.of_string (Bytes.to_string buf)) else NoHdr (i - sz, buf) ); !newpacket diff --git a/tools/ocaml/libs/xb/xb.mli b/tools/ocaml/libs/xb/xb.mli index b4d705201f..d566011fc7 100644 --- a/tools/ocaml/libs/xb/xb.mli +++ b/tools/ocaml/libs/xb/xb.mli @@ -65,7 +65,7 @@ type backend_mmap = { } type backend_fd = { fd : Unix.file_descr; } type backend = Fd of backend_fd | Xenmmap of backend_mmap -type partial_buf = HaveHdr of Partial.pkt | NoHdr of int * string +type partial_buf = HaveHdr of Partial.pkt | NoHdr of int * bytes type t = { backend : backend; pkt_in : Packet.t Queue.t; @@ -76,10 +76,10 @@ type t = { val init_partial_in : unit -> partial_buf val reconnect : t -> unit val queue : t -> Packet.t -> unit -val read_fd : backend_fd -> 'a -> string -> int -> int -val read_mmap : backend_mmap -> 'a -> string -> int -> int -val read : t -> string -> int -> int -val write_fd : backend_fd -> 'a -> string -> int -> int +val read_fd : backend_fd -> 'a -> bytes -> int -> int +val read_mmap : backend_mmap -> 'a -> bytes -> int -> int +val read : t -> bytes -> int -> int +val write_fd : backend_fd -> 'a -> bytes -> int -> int val write_mmap : backend_mmap -> 'a -> string -> int -> int val write : t -> string -> int -> int val output : t -> bool diff --git a/tools/ocaml/xenstored/logging.ml b/tools/ocaml/xenstored/logging.ml index 0c0d03d0c4..e3c769fb2c 100644 --- a/tools/ocaml/xenstored/logging.ml +++ b/tools/ocaml/xenstored/logging.ml @@ -60,11 +60,11 @@ type logger = let truncate_line nb_chars line = if String.length line > nb_chars - 1 then let len = max (nb_chars - 1) 2 in - let dst_line = String.create len in - String.blit line 0 dst_line 0 (len - 2); - dst_line.[len-2] <- '.'; - dst_line.[len-1] <- '.'; - dst_line + let dst_line = Bytes.create len in + Bytes.blit_string line 0 dst_line 0 (len - 2); + Bytes.set dst_line (len-2) '.'; + Bytes.set dst_line (len-1) '.'; + Bytes.to_string dst_line else line let log_rotate ref_ch log_file log_nb_files = @@ -252,13 +252,13 @@ let string_of_access_type = function *) let sanitize_data data = - let data = String.copy data in - for i = 0 to String.length data - 1 + let data = Bytes.copy data in + for i = 0 to Bytes.length data - 1 do - if data.[i] = '\000' then - data.[i] <- ' ' + if Bytes.get data i = '\000' then + Bytes.set data i ' ' done; - String.escaped data + String.escaped (Bytes.to_string data) let activate_access_log = ref true let access_log_destination = ref (File (Paths.xen_log_dir ^ "/xenstored-access.log")) @@ -291,7 +291,7 @@ let access_logging ~con ~tid ?(data="") ~level access_type = let date = string_of_date() in let tid = string_of_tid ~con tid in let access_type = string_of_access_type access_type in - let data = sanitize_data data in + let data = sanitize_data (Bytes.of_string data) in let prefix = prefix !access_log_destination date in let msg = Printf.sprintf "%s %s %s %s" prefix tid access_type data in logger.write ~level msg) diff --git a/tools/ocaml/xenstored/stdext.ml b/tools/ocaml/xenstored/stdext.ml index b8a8fd00e1..41411ee535 100644 --- a/tools/ocaml/xenstored/stdext.ml +++ b/tools/ocaml/xenstored/stdext.ml @@ -122,7 +122,7 @@ let pidfile_write filename = let pid = Unix.getpid () in let buf = string_of_int pid ^ "\n" in let len = String.length buf in - if Unix.write fd buf 0 len <> len + if Unix.write fd (Bytes.of_string buf) 0 len <> len then failwith "pidfile_write failed"; ) (fun () -> Unix.close fd) diff --git a/tools/ocaml/xenstored/utils.ml b/tools/ocaml/xenstored/utils.ml index e89c1aff04..5fcb042351 100644 --- a/tools/ocaml/xenstored/utils.ml +++ b/tools/ocaml/xenstored/utils.ml @@ -45,23 +45,23 @@ let get_hierarchy path = let hexify s = let hexseq_of_char c = sprintf "%02x" (Char.code c) in - let hs = String.create (String.length s * 2) in + let hs = Bytes.create (String.length s * 2) in for i = 0 to String.length s - 1 do let seq = hexseq_of_char s.[i] in - hs.[i * 2] <- seq.[0]; - hs.[i * 2 + 1] <- seq.[1]; + Bytes.set hs (i * 2) seq.[0]; + Bytes.set hs (i * 2 + 1) seq.[1]; done; - hs + Bytes.to_string hs let unhexify hs = let char_of_hexseq seq0 seq1 = Char.chr (int_of_string (sprintf "0x%c%c" seq0 seq1)) in - let s = String.create (String.length hs / 2) in - for i = 0 to String.length s - 1 + let b = Bytes.create (String.length hs / 2) in + for i = 0 to Bytes.length b - 1 do - s.[i] <- char_of_hexseq hs.[i * 2] hs.[i * 2 + 1] + Bytes.set b i (char_of_hexseq hs.[i * 2] hs.[i * 2 + 1]) done; - s + Bytes.to_string b let trim_path path = try @@ -84,10 +84,10 @@ let create_unix_socket name = let read_file_single_integer filename = let fd = Unix.openfile filename [ Unix.O_RDONLY ] 0o640 in - let buf = String.make 20 (char_of_int 0) in + let buf = Bytes.make 20 (char_of_int 0) in let sz = Unix.read fd buf 0 20 in Unix.close fd; - int_of_string (String.sub buf 0 sz) + int_of_string (Bytes.to_string (Bytes.sub buf 0 sz)) let path_complete path connection_path = if String.get path 0 <> '/' then -- 2.14.3