On Mon, 12 Mar 2018, Christian Lindig wrote:

 The problem with the old patch is illustrated by the following section
 from the old patch for tools/ocaml/xenstored/utils.ml
 @@ -85,7 +85,7 @@ 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 sz = Unix.read fd buf 0 20 in
 +       let sz = Unix.read fd (Bytes.of_string buf) 0 20 in
         Unix.close fd;
         int_of_string (String.sub buf 0 sz)

 where the patch makes Unix.read write to a Bytes copy of buf and buf
 itself is unchanged, so int_of_string sees a string of null characters
 rather than a string to convert into a number.

Good analysis. (Bytes.of_string buf) created a buffer for the result from read() for which we have no handle.

Reviewing the new patch I believe it is sound. The (new) signature of read_mmap is

 val read_mmap : backend_mmap -> 'a -> bytes -> int -> int

The new implementation is below - argument s used to be a string value and is now a bytes value. I would suggest to reflect this in the names (using b instead of s) as this is about conversion between strings and bytes.
   let read_mmap back con s len =
 -      let rd = Xs_ring.read back.mmap s len in
 +      let stmp = String.make len (char_of_int 0) in
 +      let rd = Xs_ring.read back.mmap stmp len in
 +      Bytes.blit_string stmp 0 s 0 rd;
    back.work_again <- (rd > 0);
    if rd > 0 then
     back.eventchn_notify ();

Below are the functions that changed their type and where this also should be considered:
 -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

-- Christian

Here is version 4 of the patch where I have replaced the uses of s with b where the patch changes it from string to bytes. I have also removed the two trailing spaces and changed stmp back to s.

        Michael Young
From da088e4eef2bbea4be262e12db4c36960ff5145a Mon Sep 17 00:00:00 2001
From: Michael Young <m.a.yo...@durham.ac.uk>
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 <m.a.yo...@durham.ac.uk>
---
 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

_______________________________________________
Xen-devel mailing list
Xen-devel@lists.xenproject.org
https://lists.xenproject.org/mailman/listinfo/xen-devel

Reply via email to