Commit 352540b4 authored by Gerd Stolpmann's avatar Gerd Stolpmann

Porting to OCaml-4.02 and using -safe-string

parent 3726cfd7
static. =
EXTRAFLAGS =
ConfMsgChecking(for -safe-string)
if $(equal $(shell-code ocamlc -safe-string), 0)
EXTRAFLAGS += -safe-string
ConfMsgResult(yes)
export
else
ConfMsgResult(no)
USE_OCAMLFIND = true
BYTE_ENABLED = true
OCAMLFLAGS += $(EXTRAFLAGS)
# Set this to "true" on the command-line for invoking amqp_gen
if $(not $(defined REGENERATE))
......@@ -23,7 +34,7 @@ FILES[] =
netamqp_basic
netamqp_tx
OCAMLPACKS += rpc
OCAMLPACKS += rpc bytes
LocalOCamlGeneratedFiles($(GEN))
......
......@@ -716,17 +716,17 @@ let output_field_decoder fields f indent =
emit (offset+1) true false fields'
| `Short ->
fprintf f
"Netamqp_rtypes.read_uint2_unsafe _s (!_c+%d) in\n"
"Netamqp_rtypes.read_string_uint2_unsafe _s (!_c+%d) in\n"
offset;
emit (offset+2) true false fields'
| `Long ->
fprintf f
"Netnumber.BE.read_uint4_unsafe _s (!_c+%d) in\n"
"Netnumber.BE.read_string_uint4_unsafe _s (!_c+%d) in\n"
offset;
emit (offset+4) true false fields'
| `Longlong ->
fprintf f
"Netnumber.BE.read_uint8_unsafe _s (!_c+%d) in\n"
"Netnumber.BE.read_string_uint8_unsafe _s (!_c+%d) in\n"
offset;
emit (offset+8) true false fields'
| `Bit ->
......@@ -737,7 +737,7 @@ let output_field_decoder fields f indent =
| `Timestamp ->
fprintf f
"Int64.to_float(Netnumber.int64_of_uint8\
(Netnumber.BE.read_uint8_unsafe _s (!_c+%d))) in\n"
(Netnumber.BE.read_string_uint8_unsafe _s (!_c+%d))) in\n"
offset;
emit (offset+8) true false fields'
| _ ->
......@@ -784,9 +784,9 @@ let output_method_decoder spec f =
fprintf f
" if _l < 4 then %s;\n" exn_too_short;
fprintf f
" let _class_index = Netamqp_rtypes.read_uint2_unsafe _s 0 in\n";
" let _class_index = Netamqp_rtypes.read_string_uint2_unsafe _s 0 in\n";
fprintf f
" let _meth_index = Netamqp_rtypes.read_uint2_unsafe _s 2 in\n";
" let _meth_index = Netamqp_rtypes.read_string_uint2_unsafe _s 2 in\n";
fprintf f
" let _c = ref 4 in\n";
fprintf f
......@@ -873,7 +873,7 @@ let output_prop_decoder fields f indent =
fprintf f
"%s _c := _c0 + 2;\n" istr;
fprintf f
"%s Some(Netamqp_rtypes.read_uint2_unsafe _s _c0)\n"
"%s Some(Netamqp_rtypes.read_string_uint2_unsafe _s _c0)\n"
istr;
| `Long ->
fprintf f
......@@ -881,7 +881,7 @@ let output_prop_decoder fields f indent =
fprintf f
"%s _c := _c0 + 4;\n" istr;
fprintf f
"%s Some(Netnumber.BE.read_uint4_unsafe _s _c0)\n"
"%s Some(Netnumber.BE.read_string_uint4_unsafe _s _c0)\n"
istr;
| `Longlong ->
fprintf f
......@@ -889,7 +889,7 @@ let output_prop_decoder fields f indent =
fprintf f
"%s _c := _c0 + 8;\n" istr;
fprintf f
"%s Some(Netnumber.BE.read_uint8_unsafe _s _c0)\n"
"%s Some(Netnumber.BE.read_string_uint8_unsafe _s _c0)\n"
istr;
| `Bit ->
assert false (* already handled above *)
......@@ -900,7 +900,7 @@ let output_prop_decoder fields f indent =
"%s _c := _c0 + 8;\n" istr;
fprintf f
"%s Some(Int64.to_float(Netnumber.int64_of_uint8\
(Netnumber.BE.read_uint8_unsafe _s _c0)))\n"
(Netnumber.BE.read_string_uint8_unsafe _s _c0)))\n"
istr;
| `Shortstr ->
fprintf f
......@@ -935,11 +935,11 @@ let output_header_decoder spec f =
fprintf f
" if _l < 14 then %s;\n" exn_too_short;
fprintf f
" let _class_index = Netamqp_rtypes.read_uint2_unsafe _s 0 in\n";
" let _class_index = Netamqp_rtypes.read_string_uint2_unsafe _s 0 in\n";
fprintf f
" let _size_rt = Netnumber.BE.read_uint8_unsafe _s 4 in\n";
" let _size_rt = Netnumber.BE.read_string_uint8_unsafe _s 4 in\n";
fprintf f
" let _flags = Netamqp_rtypes.read_uint2_unsafe _s 12 in\n";
" let _flags = Netamqp_rtypes.read_string_uint2_unsafe _s 12 in\n";
fprintf f
" let _c = ref 14 in\n";
fprintf f
......@@ -1008,7 +1008,7 @@ let output_field_encoder fields f indent =
let finish_bitfield offset =
fprintf f
"%sString.unsafe_set _s %d (Char.chr _x);\n" istr offset in
"%sBytes.unsafe_set _s %d (Char.chr _x);\n" istr offset in
let finish_s length =
fprintf f
......@@ -1028,7 +1028,7 @@ let output_field_encoder fields f indent =
if not s_flag then (
let num = get_cumulated_length fields in
fprintf f
"%slet _s = String.create %d in\n" istr num;
"%slet _s = Bytes.create %d in\n" istr num;
);
if t = `Bit && not bitfield_flag then
fprintf f
......@@ -1038,7 +1038,7 @@ let output_field_encoder fields f indent =
fprintf f
"%sif %s < 0 || %s > 255 then %s;\n" istr n n exn_range;
fprintf f
"%sString.unsafe_set _s %d (Char.unsafe_chr %s);\n"
"%sBytes.unsafe_set _s %d (Char.unsafe_chr %s);\n"
istr offset n;
emit (offset+1) true false fields'
| `Short ->
......@@ -1129,17 +1129,17 @@ let output_method_encoder spec f =
else
""
);
let s = String.create 4 in
s.[0] <- Char.chr ((cls.class_index lsr 8) land 0xff);
s.[1] <- Char.chr (cls.class_index land 0xff);
s.[2] <- Char.chr ((meth.meth_index lsr 8) land 0xff);
s.[3] <- Char.chr (meth.meth_index land 0xff);
let s = Bytes.create 4 in
Bytes.set s 0 (Char.chr ((cls.class_index lsr 8) land 0xff));
Bytes.set s 1 (Char.chr (cls.class_index land 0xff));
Bytes.set s 2 (Char.chr ((meth.meth_index lsr 8) land 0xff));
Bytes.set s 3 (Char.chr (meth.meth_index land 0xff));
if meth.meth_fields = [] then
fprintf f
" %S\n" s
" Bytes.of_string %S\n" s
else (
fprintf f
" let _acc = [ %S ] in\n" s;
" let _acc = [ Bytes.of_string %S ] in\n" s;
fprintf f
" let _acc_len = 4 in\n";
output_field_encoder meth.meth_fields f 10;
......@@ -1203,9 +1203,9 @@ let output_prop_encoder fields f indent =
fprintf f
"%s if _x < 0 || _x > 255 then %s;\n" istr6 exn_range;
fprintf f
"%s let _s = String.create 1 in\n" istr6;
"%s let _s = Bytes.create 1 in\n" istr6;
fprintf f
"%s String.unsafe_set _s 0 (Char.unsafe_chr _x);\n"
"%s Bytes.unsafe_set _s 0 (Char.unsafe_chr _x);\n"
istr6;
fprintf f
"%s (_s :: _acc, _acc_len+1) in\n" istr6
......@@ -1213,14 +1213,14 @@ let output_prop_encoder fields f indent =
fprintf f
"%s if _x < 0 || _x > 65535 then %s;\n" istr6 exn_range;
fprintf f
"%s let _s = String.create 2 in\n" istr6;
"%s let _s = Bytes.create 2 in\n" istr6;
fprintf f
"%s Netamqp_rtypes.write_uint2_unsafe _s 0 _x;\n" istr6;
fprintf f
"%s (_s :: _acc, _acc_len+2) in\n" istr6
| `Long ->
fprintf f
"%s let _s = String.create 4 in\n" istr6;
"%s let _s = Bytes.create 4 in\n" istr6;
fprintf f
"%s Netnumber.BE.write_uint4_unsafe _s 0 _x;\n"
istr6;
......@@ -1228,7 +1228,7 @@ let output_prop_encoder fields f indent =
"%s (_s :: _acc, _acc_len+4) in\n" istr6
| `Longlong ->
fprintf f
"%s let _s = String.create 8 in\n" istr6;
"%s let _s = Bytes.create 8 in\n" istr6;
fprintf f
"%s Netnumber.BE.write_uint8_unsafe _s 0 _x;\n" istr6;
fprintf f
......@@ -1237,7 +1237,7 @@ let output_prop_encoder fields f indent =
assert false
| `Timestamp ->
fprintf f
"%s let _s = String.create 8 in\n" istr6;
"%s let _s = Bytes.create 8 in\n" istr6;
fprintf f
"%s let _x' = \
Netnumber.uint8_of_int64(Int64.of_float _x) in\n"
......@@ -1297,13 +1297,13 @@ let output_header_encoder spec f =
""
);
fprintf f
" let _s = String.make 14 '\\000' in\n";
" let _s = Bytes.make 14 '\\000' in\n";
let c0 = Char.chr ((cls.class_index lsr 8) land 0xff) in
let c1 = Char.chr (cls.class_index land 0xff) in
fprintf f
" String.unsafe_set _s 0 '\\x%02x';\n" (Char.code c0);
" Bytes.unsafe_set _s 0 '\\x%02x';\n" (Char.code c0);
fprintf f
" String.unsafe_set _s 1 '\\x%02x';\n" (Char.code c1);
" Bytes.unsafe_set _s 1 '\\x%02x';\n" (Char.code c1);
fprintf f
" Netnumber.BE.write_uint8_unsafe _s 4 \
(Netnumber.uint8_of_int64 _size);\n";
......@@ -1333,10 +1333,10 @@ let output_header_encoder spec f =
fprintf f
" in\n";
fprintf f
" String.unsafe_set _s 12 \
" Bytes.unsafe_set _s 12 \
(Char.chr((_flags lsr 8) land 0xff));\n";
fprintf f
" String.unsafe_set _s 13 \
" Bytes.unsafe_set _s 13 \
(Char.chr(_flags land 0xff));\n";
fprintf f
" let _acc = [ _s ] in\n";
......@@ -1369,7 +1369,7 @@ let output_heartbeat_encoder f =
fprintf f
" frame_channel = 0;\n";
fprintf f
" frame_payload = [Netamqp_rtypes.mk_mstring \"\\000\\000\"];\n";
" frame_payload = [Netamqp_rtypes.mk_mstring (Bytes.of_string \"\\000\\000\")];\n";
fprintf f
" }\n\n"
......@@ -1395,7 +1395,7 @@ let output_proto_header_encoder f =
fprintf f
" frame_channel = 0;\n";
fprintf f
" frame_payload = [Netamqp_rtypes.mk_mstring data];\n";
" frame_payload = [Netamqp_rtypes.mk_mstring (Bytes.of_string data)];\n";
fprintf f
" }\n\n"
......
This diff is collapsed.
......@@ -587,6 +587,9 @@ let check_complete ep frame b props =
)
let hex_dump_s s pos len =
Rpc_util.hex_dump_b (Bytes.unsafe_of_string s) pos len
let handle_frame_0_9 ep frame =
(* AMQP-0-9-specific version *)
dlogr
......@@ -602,7 +605,7 @@ let handle_frame_0_9 ep frame =
| `Proto_header -> "proto_header"
)
frame.frame_channel
(Rpc_util.hex_dump_s s 0 (String.length s) ^
(hex_dump_s s 0 (String.length s) ^
if n > String.length s then "..." else "")
);
let msg = Netamqp_methods_0_9.decode_message frame in
......@@ -821,10 +824,15 @@ let shared_sub_mstring (ms : Netxdr_mstring.mstring)
invalid_arg "Netamqp_endpoint.shared_sub_mstring";
( object(self)
method length = sub_len
method blit_to_bytes mpos s spos len =
ms#blit_to_bytes (sub_pos+mpos) s spos len
method blit_to_string mpos s spos len =
ms#blit_to_string (sub_pos+mpos) s spos len
method blit_to_memory mpos mem mempos len =
ms#blit_to_memory (sub_pos+mpos) mem mempos len
method as_bytes =
let (s,pos) = ms#as_bytes in
(s,pos+sub_pos)
method as_string =
let (s,pos) = ms#as_string in
(s,pos+sub_pos)
......@@ -1225,7 +1233,7 @@ let announce_e ep =
let frame =
{ frame_type = `Proto_header;
frame_channel = 0;
frame_payload = [ Netamqp_rtypes.mk_mstring data ]
frame_payload = [ Netamqp_rtypes.mk_mstring (Bytes.of_string data) ]
} in
Queue.add frame ep.out_prio_q;
let eng, notify = Uq_engines.signal_engine ep.esys in
......
......@@ -41,33 +41,45 @@ and table =
(string * table_field) list
let read_uint2_unsafe s p =
let read_string_uint2_unsafe s p =
let c1 = String.unsafe_get s p in
let c0 = String.unsafe_get s (p+1) in
((Char.code c1) lsl 8) lor (Char.code c0)
let read_uint2 s p =
let read_string_uint2 s p =
let l = String.length s in
if p < 0 || p > l-2 then
invalid_arg "Netamqp_rtypes.read_string_uint2";
read_string_uint2_unsafe s p
let read_uint2_unsafe s p =
let c1 = Bytes.unsafe_get s p in
let c0 = Bytes.unsafe_get s (p+1) in
((Char.code c1) lsl 8) lor (Char.code c0)
let read_uint2 s p =
let l = Bytes.length s in
if p < 0 || p > l-2 then
invalid_arg "Netamqp_rtypes.read_uint2";
read_uint2_unsafe s p
let write_uint2_unsafe s p x =
String.unsafe_set s p (Char.unsafe_chr ((x lsr 8) land 0xff));
String.unsafe_set s (p+1) (Char.unsafe_chr (x land 0xff))
Bytes.unsafe_set s p (Char.unsafe_chr ((x lsr 8) land 0xff));
Bytes.unsafe_set s (p+1) (Char.unsafe_chr (x land 0xff))
let write_uint2 s p x =
let l = String.length s in
let l = Bytes.length s in
if p < 0 || p > l-2 || x < 0 || x > 65535 then
invalid_arg "Netamqp_rtypes.write_uint2";
write_uint2_unsafe s p x
let uint2_as_string x =
let s = String.create 2 in
let s = Bytes.create 2 in
write_uint2 s 0 x;
s
Bytes.to_string s
let decode_shortstr s c l =
......@@ -83,28 +95,28 @@ let decode_shortstr s c l =
let encode_shortstr s =
let n = String.length s in
if n > 255 then raise(Encode_error "String too long (shortstr)");
let p = String.make 1 (Char.unsafe_chr n) in
( [s; p], n+1 )
let p = Bytes.make 1 (Char.unsafe_chr n) in
( [Bytes.of_string s; p], n+1 )
let encode_shortstr_straight s =
let n = String.length s in
if n > 255 then raise(Encode_error "String too long (shortstr)");
let p = String.make 1 (Char.unsafe_chr n) in
( [p; s] (* ! *), n+1 )
let p = Bytes.make 1 (Char.unsafe_chr n) in
( [p; Bytes.of_string s] (* ! *), n+1 )
let encode_shortstr_for_field s =
let n = String.length s in
if n > 255 then raise(Encode_error "String too long (shortstr)");
let p = String.create 2 in
String.unsafe_set p 0 's';
String.unsafe_set p 1 (Char.unsafe_chr n);
( [p; s], n+2 )
let p = Bytes.create 2 in
Bytes.unsafe_set p 0 's';
Bytes.unsafe_set p 1 (Char.unsafe_chr n);
( [p; Bytes.of_string s], n+2 )
let decode_longstr_nocopy s c l =
assert(String.length s >= l);
if !c >= l - 3 then raise(Decode_error "Message too short");
let n_rt = Netnumber.BE.read_uint4_unsafe s !c in
let n_rt = Netnumber.BE.read_string_uint4_unsafe s !c in
let n =
try Netnumber.int_of_uint4 n_rt
with Netnumber.Cannot_represent _ ->
......@@ -126,7 +138,7 @@ let encode_longstr s =
try Netnumber.uint4_of_int n
with _ -> raise(Encode_error "String too long (longstr)") in
let p = Netnumber.BE.uint4_as_string n_rt in
( [s; p], n+4 )
( [Bytes.of_string s; Bytes.of_string p], n+4 )
let encode_longstr_for_field s =
......@@ -134,10 +146,10 @@ let encode_longstr_for_field s =
let n_rt =
try Netnumber.uint4_of_int n
with _ -> raise(Encode_error "String too long (longstr)") in
let p = String.create 5 in
String.unsafe_set p 0 'S';
let p = Bytes.create 5 in
Bytes.unsafe_set p 0 'S';
Netnumber.BE.write_uint4_unsafe p 1 n_rt;
( [p; s], n+5 )
( [ p; Bytes.of_string s], n+5 )
let rec parse_table s c l =
......@@ -195,7 +207,7 @@ and decode_field s c l : table_field =
*)
| 'I' ->
expect 4;
let x = Netnumber.BE.read_int4_unsafe s !c in
let x = Netnumber.BE.read_string_int4_unsafe s !c in
let v = `Sint4 x in
c := !c + 4;
v
......@@ -221,20 +233,20 @@ and decode_field s c l : table_field =
*)
| 'f' ->
expect 4;
let x = Netnumber.float_of_fp4(Netnumber.BE.read_fp4 s !c) in
let x = Netnumber.float_of_fp4(Netnumber.BE.read_string_fp4 s !c) in
let v = `Float x in
c := !c + 4;
v
| 'd' ->
expect 8;
let x = Netnumber.float_of_fp8(Netnumber.BE.read_fp8 s !c) in
let x = Netnumber.float_of_fp8(Netnumber.BE.read_string_fp8 s !c) in
let v = `Double x in
c := !c + 8;
v
| 'D' ->
expect 5;
let scale = Char.code s.[!c] in
let x = Netnumber.BE.read_uint4_unsafe s (!c+1) in
let x = Netnumber.BE.read_string_uint4_unsafe s (!c+1) in
let v = `Decimal(scale,x) in
c := !c + 5;
v
......@@ -256,7 +268,7 @@ and decode_field s c l : table_field =
*)
| 'T' ->
expect 8;
let x = Netnumber.BE.read_uint8_unsafe s !c in
let x = Netnumber.BE.read_string_uint8_unsafe s !c in
let t =
try Int64.to_float(Netnumber.int64_of_uint8 x)
with _ ->
......@@ -296,13 +308,13 @@ let rec encode_field field =
(* Note: the list is built in the right order! *)
match field with
| `Bool b ->
(if b then ["t\001"] else ["t\000"]), 2
(if b then [Bytes.of_string "t\001"] else [Bytes.of_string "t\000"]), 2
| `Sint1 x ->
if x < (-128) || x > 127 then
raise(Encode_error "Value out of range (Sint1)");
let s = String.create 2 in
String.unsafe_set s 0 'b';
String.unsafe_set s 1
let s = Bytes.create 2 in
Bytes.unsafe_set s 0 'b';
Bytes.unsafe_set s 1
(Char.unsafe_chr (if x < 0 then x+256 else x));
([s], 2)
(*
......@@ -329,8 +341,8 @@ let rec encode_field field =
([s], 3)
*)
| `Sint4 x ->
let s = String.create 5 in
String.unsafe_set s 0 'I';
let s = Bytes.create 5 in
Bytes.unsafe_set s 0 'I';
Netnumber.BE.write_int4_unsafe s 1 x;
([s], 5)
(*
......@@ -352,16 +364,16 @@ let rec encode_field field =
*)
| `Float x ->
let s = "f" ^ Netnumber.BE.fp4_as_string (Netnumber.fp4_of_float x) in
([s], 5)
([Bytes.of_string s], 5)
| `Double x ->
let s = "d" ^ Netnumber.BE.fp8_as_string (Netnumber.fp8_of_float x) in
([s], 9)
([Bytes.of_string s], 9)
| `Decimal(scale, x) ->
if scale < 0 || scale > 255 then
raise(Encode_error "Value out of range (Decimal)");
let s = String.create 6 in
String.unsafe_set s 0 'D';
String.unsafe_set s 1 (Char.unsafe_chr scale);
let s = Bytes.create 6 in
Bytes.unsafe_set s 0 'D';
Bytes.unsafe_set s 1 (Char.unsafe_chr scale);
Netnumber.BE.write_uint4_unsafe s 2 x;
([s], 6)
(*
......@@ -389,8 +401,8 @@ let rec encode_field field =
( s :: x', !len + 5 )
*)
| `Timestamp x ->
let s = String.create 9 in
String.unsafe_set s 0 'T';
let s = Bytes.create 9 in
Bytes.unsafe_set s 0 'T';
Netnumber.BE.write_uint8_unsafe s 1
( try
(Netnumber.uint8_of_int64 (Int64.of_float x))
......@@ -400,9 +412,9 @@ let rec encode_field field =
([s], 9)
| `Table x ->
let (l, n) = encode_table_straight x in
("F" :: l, n+1)
(Bytes.of_string "F" :: l, n+1)
| `Null ->
(["V"], 1)
([Bytes.of_string "V"], 1)
and encode_table_straight x =
let n = ref 0 in
......@@ -418,7 +430,7 @@ and encode_table_straight x =
x
) in
let p = Netnumber.BE.uint4_as_string (Netnumber.uint4_of_int !n) in
(p :: l, !n + 4)
(Bytes.of_string p :: l, !n + 4)
let encode_table x =
......@@ -427,18 +439,18 @@ let encode_table x =
let mk_mstring s =
Netxdr_mstring.string_based_mstrings # create_from_string
s 0 (String.length s) false
Netxdr_mstring.bytes_based_mstrings # create_from_bytes
s 0 (Bytes.length s) false
let unsafe_rev_concat l n =
let s = String.create n in
let s = Bytes.create n in
let k = ref n in
List.iter
(fun x ->
let p = String.length x in
let p = Bytes.length x in
k := !k - p;
String.unsafe_blit x 0 s !k p
Bytes.unsafe_blit x 0 s !k p
)
l;
assert(!k = 0);
......
......@@ -8,10 +8,12 @@
type uint2 = int
val read_uint2 : string -> int -> uint2
val read_uint2_unsafe : string -> int -> uint2
val write_uint2 : string -> int -> uint2 -> unit
val write_uint2_unsafe : string -> int -> uint2 -> unit
val read_uint2 : Bytes.t -> int -> uint2
val read_uint2_unsafe : Bytes.t -> int -> uint2
val read_string_uint2 : string -> int -> uint2
val read_string_uint2_unsafe : string -> int -> uint2
val write_uint2 : Bytes.t -> int -> uint2 -> unit
val write_uint2_unsafe : Bytes.t -> int -> uint2 -> unit
val uint2_as_string : uint2 -> string
......@@ -20,8 +22,8 @@ val uint2_as_string : uint2 -> string
val decode_shortstr : string -> int ref -> int -> string
val decode_longstr : string -> int ref -> int -> string
val encode_shortstr : string -> (string list * int)
val encode_longstr : string -> (string list * int)
val encode_shortstr : string -> (Bytes.t list * int)
val encode_longstr : string -> (Bytes.t list * int)
(* result (list, n): [list] is the list of part strings in reverse order,
[n] is the length of the [list] contents in bytes
*)
......@@ -78,10 +80,10 @@ and table =
val decode_table : string -> int ref -> int -> table
val encode_table : table -> (string list * int)
val encode_table : table -> (Bytes.t list * int)
(** {2 Misc} *)
val unsafe_rev_concat : string list -> int -> string
val unsafe_rev_concat : Bytes.t list -> int -> Bytes.t
val mk_mstring : string -> Netxdr_mstring.mstring
val mk_mstring : Bytes.t -> Netxdr_mstring.mstring
......@@ -31,6 +31,10 @@ let string_of_sockaddr =
| `Implied -> "<implied>"
| `Sockaddr sa -> Netsys.string_of_sockaddr sa
let hex_dump_s s pos len =
Rpc_util.hex_dump_b (Bytes.unsafe_of_string s) pos len
exception Error of string
......@@ -85,8 +89,8 @@ let mem_dummy() =
Bigarray.char Bigarray.c_layout 0
let mk_mstring s =
Netxdr_mstring.string_based_mstrings # create_from_string
s 0 (String.length s) false
Netxdr_mstring.bytes_based_mstrings # create_from_bytes
s 0 (Bytes.length s) false
exception Continue of (unit -> unit)
......@@ -107,7 +111,7 @@ class tcp_amqp_multiplex_controller sockname peername
object(self)
val mutable rd_buffer = Netpagebuffer.create mem_size
val mutable rd_buffer_nomem =
if mplex#mem_supported then "" else String.create fallback_size
if mplex#mem_supported then Bytes.create 0 else Bytes.create fallback_size
val mutable rd_mode = `Frame_header 0
val mutable rd_processing = false
......@@ -179,17 +183,17 @@ object(self)
~when_done:(fun exn_opt n ->
dlogr (fun () ->
sprintf "Reading [str]: %s%s"
(Rpc_util.hex_dump_s
(Rpc_util.hex_dump_b
rd_buffer_nomem 0 (min n 200))
(if n > 200 then "..." else "")
);
Netpagebuffer.add_sub_string
Netpagebuffer.add_subbytes
rd_buffer rd_buffer_nomem 0 n;
mplex_when_done exn_opt n
)
rd_buffer_nomem
0
(String.length rd_buffer_nomem)
(Bytes.length rd_buffer_nomem)
);
self # timer_event `Start `R
......@@ -207,9 +211,9 @@ object(self)
(with 8 bytes)
*)
try
let s = Netpagebuffer.sub rd_buffer 0 7 in
let s = Netpagebuffer.sub_bytes rd_buffer 0 7 in
let frame_type =
match s.[0] with
match Bytes.get s 0 with
| '\001' -> `Method
| '\002' -> `Header
| '\003' -> `Body
......@@ -217,9 +221,9 @@ object(self)
| '\065' when rd_stream_at_beginning -> `Proto_header
| _ -> raise(Error "Bad frame header") in
if frame_type = `Proto_header then (
if String.sub s 0 5 = "AMQP\000" then (
if Bytes.sub_string s 0 5 = "AMQP\000" then (
if len >= 8 then (
let p = Netpagebuffer.sub rd_buffer 5 3 in
let p = Netpagebuffer.sub_bytes rd_buffer 5 3 in
let frame =
{ frame_type = `Proto_header;
frame_channel = 0;
......@@ -260,7 +264,7 @@ object(self)
Netpagebuffer.sub rd_buffer (payload_start+size) 1 in
if trailer = "\xCE" then (
let data =
Netpagebuffer.sub rd_buffer payload_start size in
Netpagebuffer.sub_bytes rd_buffer payload_start size in
let ms =
mk_mstring data in
let frame =
......@@ -302,7 +306,7 @@ object(self)
assert(not mplex#writing);
(* - `String(s,p,l): We have still to write s[p] to s[p+l-1]
(* - `Bytes(s,p,l): We have still to write s[p] to s[p+l-1]
- `Memory(m,p,l,ms,q): We have still to write
m[p] to m[p+l-1], followed by ms[q] to end of ms
(where ms is the managed string)
......@@ -313,26 +317,26 @@ object(self)
let l = ms#length in
assert(r <= l);
match ms # preferred with
| `String ->
let (s,pos) = ms#as_string in (* usually only r=0 *)
`String(s,pos+r,l-r)
| `Bytes ->
let (s,pos) = ms#as_bytes in (* usually only r=0 *)
`Bytes(s,pos+r,l-r)
| `Memory ->
if mplex#mem_supported then (
let (m,pos) = ms#as_memory in
`Memory(m, pos+r, l-r, ms, l)
)
else
let (s,pos) = ms#as_string in
`String(s,pos+r,l-r) in
let (s,pos) = ms#as_bytes in
`Bytes(s,pos+r,l-r) in
let rec optimize_items items =
(* Merge adjacent short items (only for strings) *)
match items with
| (`String(s1,p1,l1) as i1) :: (`String(s2,p2,l2) as i2) :: items' ->
| (`Bytes(s1,p1,l1) as i1) :: (`Bytes(s2,p2,l2) as i2) :: items' ->
if l1 < 256 && l2 < 256 then (
let b = Buffer.create (l1+l2) in
Buffer.add_substring b s1 p1 l1;
Buffer.add_substring b s2 p2 l2;
Buffer.add_subbytes b s1 p1 l1;
Buffer.add_subbytes b s2 p2 l2;
gather_items b items'
)
else
......@@ -344,17 +348,17 @@ object(self)