safe-string

config/Makefile.in

@@ -432,10 +432,11 @@ FASTTRACK_SRCS= \
   $(SRC_FASTTRACK)/fasttrackClients.mlt \
   $(SRC_FASTTRACK)/fasttrackHandler.ml \
   $(SRC_FASTTRACK)/fasttrackServers.ml \
-  $(SRC_FASTTRACK)/fasttrackPandora.ml \
   $(SRC_FASTTRACK)/fasttrackInteractive.mlt \
   $(SRC_FASTTRACK)/fasttrackMain.mlt
 
+  #$(SRC_FASTTRACK)/fasttrackPandora.ml \
+
 $(BITSTRING)/bitstring_persistent.cmo: $(BITSTRING)/bitstring_persistent.ml $(BITSTRING)/bitstring_persistent.cmi build/bitstring.cma
 	$(OCAMLC) -I $(BITSTRING) -I +camlp4 camlp4lib.cma -c $<
 

src/daemon/common/commonComplexOptions.ml

@@ -1156,9 +1156,9 @@ let backup_tar archive files =
               t_devminor = 0;
               t_prefix = "";
               t_gnu = None;} in
-            let s = String.create size in
+            let s = Bytes.create size in
             Pervasives.really_input ic s 0 size;
-            header, s) in
+            header, Bytes.unsafe_to_string s) in
         Tar.output otar header s
       with
       | e ->

src/daemon/common/commonDownloads.ml

@@ -87,7 +87,7 @@ module Make(M: sig
           in
           let final_pos = Unix32.seek64 (file_fd file) d.download_pos
               Unix.SEEK_SET in *)
-        Unix32.write (file_fd file) d.download_pos b.buf b.pos b.len;
+        Unix32.write_bytes (file_fd file) d.download_pos b.buf b.pos b.len;
 (*        end; *)
 (*      lprintf "DIFF %d/%d\n" nread b.len; *)
         d.download_pos <- d.download_pos ++ (Int64.of_int b.len);

src/daemon/common/commonFile.ml

@@ -975,7 +975,7 @@ let recover_bytes file =
     if pos = max then
       iter_file_out file_pos segments
     else
-    if s.[pos] = '\000' then
+    if Bytes.get s pos = '\000' then
       iter_string_out file_pos (pos+1) max segments
     else
     let begin_pos = file_pos -- (Int64.of_int (max - pos)) in
@@ -995,7 +995,7 @@ let recover_bytes file =
     if pos = max then
       iter_file_in file_pos begin_pos segments
     else
-    if s.[pos] = '\000' then
+    if Bytes.get s pos = '\000' then
       let end_pos = file_pos -- (Int64.of_int (max - pos)) in
 (*      lprintf "  0 byte at %Ld\n" end_pos; *)
       iter_string_out file_pos (pos+1) max 

src/daemon/common/commonMultimedia.ml

@@ -41,10 +41,7 @@ let input_int ic =
   let i1 = input_int16 ic in
   i0 lor (i1 lsl 16)
 
-let input_string4 ic =
-  let s = String.create 4 in
-  really_input ic s 0 4;
-  s
+let input_string4 ic = really_input_string ic 4
 
 let print_string4 v s =
   lprintf "%s :" v;
@@ -230,7 +227,7 @@ let rec page_seek ic s pos =
     else begin
       really_input ic s 0 4;
       seek_in ic (pos_in ic - 3);
-      if s = "OggS"
+      if Bytes.unsafe_to_string s = "OggS"
         then seek_in ic (pos_in ic + 3)
         else page_seek ic s pos
   end
@@ -278,12 +275,10 @@ let rec next_ogg_stream ic ogg_infos str stream_number =
   lprintf "Stream Serial Number: %0.f\n" stream_number;
 *)
   seek_in ic (pos+24);
-  let content_type = String.create 1 in
-  really_input ic content_type 0 1;
+  let content_type = really_input_string ic 1 in
   let content_type = int_of_char content_type.[0] in
   seek_in ic (pos+25);
-  let stream_type = String.create 8 in
-  really_input ic stream_type 0 8;
+  let stream_type = really_input_string ic 8 in
   let stream_type = normalize_stream_type stream_type content_type in
   incr stream_number;
   let pos = pos_in ic in
@@ -299,8 +294,7 @@ let rec next_ogg_stream ic ogg_infos str stream_number =
     | OGG_THEORA_STREAM -> get_ogg_theora_info ic ogg_infos str stream_number
 
 and get_ogg_video_info  ic ogg_infos str sizeof_packet stream_number =
-  let s = String.create sizeof_packet in
-  really_input ic s 0 sizeof_packet;
+  let s = really_input_string ic sizeof_packet in
   let codec = String.lowercase (String.sub s 0 4) in
   let time_unit = read64 (String.sub s 8 8) in
   let video_width =
@@ -326,8 +320,7 @@ and get_ogg_video_info  ic ogg_infos str sizeof_packet stream_number =
   next_ogg_stream ic ogg_infos str stream_number
 
 and get_ogg_audio_info  ic ogg_infos str sizeof_packet stream_number =
-  let s = String.create sizeof_packet in
-  really_input ic s 0 sizeof_packet;
+  let s = really_input_string ic sizeof_packet in
   let codec = get_audio_codec (String.sub s 0 4) in
   let sample_per_unit = read64 (String.sub s 16 8) in
   let channels =
@@ -359,8 +352,7 @@ and get_ogg_audio_info  ic ogg_infos str sizeof_packet stream_number =
 
 and get_ogg_vorbis_info  ic ogg_infos str stream_number =
   seek_in ic (pos_in ic - 2); (* ogm sets 8 octets in the common header as vorbis uses 6 octects for 'vorbis' *)
-  let s = String.create 22 in
-  really_input ic s 0 22;
+  let s = really_input_string ic 22 in
   let version = read32 (String.sub s 0 4) in
   let audio_channels = int_of_char s.[4] in
   let sample_rate = read32 (String.sub s 5 4) in
@@ -389,8 +381,7 @@ and get_ogg_vorbis_info  ic ogg_infos str stream_number =
 
 and get_ogg_theora_info  ic ogg_infos str stream_number =
   seek_in ic (pos_in ic - 2); (* ogm sets 8 octets in the common header as theora uses 6 octects for 'theora' *)
-  let s = String.create 34 in
-  really_input ic s 0 34;
+  let s = really_input_string ic 34 in
   let vmaj = int_of_char s.[0] in
   let vmin = int_of_char s.[1] in
   let vrev = int_of_char s.[2] in
@@ -451,7 +442,7 @@ and get_ogg_index_info ic ogg_infos str stream_number =
 
 let search_info_ogg ic =
     let stream_number = ref 0 in
-    let str = String.create 4 in
+    let str = Bytes.create 4 in
     let ogg_infos = ref [] in
     (* make sure the current reading position is at the file beginning *)
     seek_in ic 0;

src/daemon/common/commonSwarming.ml

@@ -2792,7 +2792,7 @@ let range_range r = (r.range_begin, r.range_end)
 let received up file_begin str string_begin string_len =
   assert (string_begin >= 0);
   assert (string_len >= 0);
-  assert (string_begin + string_len <= Bytes.length str);
+  assert (string_begin + string_len <= String.length str);
 
   let t = up.up_t in
   let s = t.t_s in
@@ -2909,7 +2909,7 @@ let received up file_begin str string_begin string_len =
                             (Printexc2.to_string e) 
                             r.range_begin file_end
                             (file_best_name t.t_file));
-                        file_write_bytes tprim.t_file
+                        file_write tprim.t_file
                           r.range_begin
                           str string_pos string_length;
                         range_received (Some t) r r.range_begin file_end;

src/daemon/common/commonUploads.ml

@@ -290,7 +290,7 @@ let shared_tree = new_shared_dir ""
 
 let md4_of_list md4s =
   let len = List.length md4s in
-  let s = String.create (len * 16) in
+  let s = Bytes.create (len * 16) in
   let rec iter list i =
     match list with
       [] -> ()
@@ -300,7 +300,7 @@ let md4_of_list md4s =
         iter tail (i+16)
   in
   iter md4s 0;
-  Md4.string s
+  Md4.string @@ Bytes.unsafe_to_string s
 
 let rec tiger_of_array array pos block =
   if block = 1 then
@@ -312,11 +312,11 @@ let rec tiger_of_array array pos block =
   else
   let d1 = tiger_of_array array pos (block/2) in
   let d2 = tiger_of_array array (pos+block/2) (block/2) in
-  let s = String.create (1 + Tiger.length * 2) in
+  let s = Bytes.create (1 + Tiger.length * 2) in
   s.[0] <- '\001';
   String.blit (TigerTree.direct_to_string d1) 0 s 1 Tiger.length;
   String.blit (TigerTree.direct_to_string d2) 0 s (1+Tiger.length) Tiger.length;
-  let t = Tiger.string s in
+  let t = Tiger.string @@ Bytes.unsafe_to_string s in
   let t = TigerTree.direct_of_string (Tiger.direct_to_string t) in
   t
 
@@ -345,11 +345,11 @@ let rec tiger_pos2 nblocks =
   pos, list
 
 let tiger_node d1 d2 =
-  let s = String.create (1 + Tiger.length * 2) in
+  let s = Bytes.create (1 + Tiger.length * 2) in
   s.[0] <- '\001';
   String.blit (TigerTree.direct_to_string d1) 0 s 1 Tiger.length;
   String.blit (TigerTree.direct_to_string d2) 0 s (1+Tiger.length) Tiger.length;
-  let t = Tiger.string s in
+  let t = Tiger.string @@ Bytes.unsafe_to_string s in
   let t = TigerTree.direct_of_string (Tiger.direct_to_string t) in
   t
 
@@ -386,12 +386,12 @@ let rec fill_tiger_tree s list =
 
 let flatten_tiger_array array =
   let len = Array.length array in
-  let s = String.create ( len * TigerTree.length) in
+  let s = Bytes.create ( len * TigerTree.length) in
   for i = 0 to len - 1 do
     String.blit (TigerTree.direct_to_string array.(i)) 0
       s (i * TigerTree.length) TigerTree.length
   done;
-  s
+  Bytes.unsafe_to_string s
 
 let unflatten_tiger_array s =
   let len = String.length s / TigerTree.length in
@@ -504,9 +504,9 @@ computation ??? *)
             let file_size = Unix32.getsize64 fd in
             let len64 = min 307200L file_size in
             let len = Int64.to_int len64 in
-            let s = String.create len in
+            let s = Bytes.create len in
             Unix32.read fd zero s 0 len;
-            Md5Ext.string s
+            Md5Ext.string @@ Bytes.unsafe_to_string s
           with e ->
               current_job := None;
               raise e

src/daemon/common/commonWeb.ml

@@ -265,7 +265,7 @@ let _ =
               while true do
                 let nread = Unix.read pipe_out buffer 0 buffersize in
                 if nread = 0 then raise End_of_file;
-                Buffer.add_substring output buffer 0 nread
+                Buffer.add_subbytes output buffer 0 nread
               done
              with 
              | End_of_file -> ()

src/daemon/common/giftDecoding.ml

@@ -11,11 +11,11 @@ let gui_cut_messages f sock nread =
   try
     let rec iter pos len =
       if len = 0 then raise Not_found;
-      if b.buf.[pos] = ';' && (
+      if Bytes.get b.buf pos = ';' && (
           pos = b.pos || 
-          (pos > b.pos && b.buf.[pos-1] <> '\\')) then begin
+          (pos > b.pos && Bytes.get b.buf (pos-1) <> '\\')) then begin
           let len = pos - b.pos+1 in
-          let s = String.sub b.buf b.pos len in
+          let s = Bytes.sub_string b.buf b.pos len in
           buf_used b len;
           f s;
           iter b.pos b.len

src/daemon/common/guiDecoding.ml

@@ -42,10 +42,10 @@ let gui_cut_messages f sock nread =
   let b = buf sock in
   try
     while b.len >= 4 do
-      let msg_len = get_int b.buf b.pos in
+      let msg_len = get_int (Bytes.unsafe_to_string b.buf) b.pos in
       if b.len >= 4 + msg_len then
         begin
-          let s = String.sub b.buf (b.pos+4) msg_len in
+          let s = Bytes.sub_string b.buf (b.pos+4) msg_len in
           buf_used b (msg_len + 4);
           let opcode = get_int16 s 0 in
           (f opcode s : unit)

src/daemon/common/guiEncoding.ml

@@ -44,10 +44,10 @@ let gui_send writer sock t =
     Buffer.reset buf;
     buf_int buf 0;
     writer buf t;
-    let s = Buffer.contents buf in
-    let len = String.length s - 4 in
+    let s = Buffer.to_bytes buf in
+    let len = Bytes.length s - 4 in
     str_int s 0 len;
-    write_string sock s;
+    write_bytes sock s
   with UnsupportedGuiMessage -> ()
 
 (***************

src/daemon/driver/driverCommands.ml

@@ -1389,12 +1389,12 @@ let _ =
                  (* can't close pipe_out in the already forked+executed process... *)
                  let output = Buffer.create 1024 in
                  let buffersize = 1024 in
-                 let buffer = String.create buffersize in
+                 let buffer = Bytes.create buffersize in
                  (try
                     while true do
                       let nread = Unix.read pipe_out buffer 0 buffersize in
                       if nread = 0 then raise End_of_file;
-                      Buffer.add_substring output buffer 0 nread
+                      Buffer.add_subbytes output buffer 0 nread
                     done
                   with 
                   | End_of_file -> ()
@@ -3893,7 +3893,7 @@ let _ =
            let num = int_of_string arg in
            let file = file_find num in
            let swarmer = CommonSwarming.file_swarmer file in
-           let prio = CommonSwarming.get_swarmer_block_priorities swarmer in
+           let prio = Bytes.unsafe_to_string @@ CommonSwarming.get_swarmer_block_priorities swarmer in
            let downloaded = CommonSwarming.get_swarmer_block_verified swarmer in
            pr "\\<code\\>";
            pr "priorities: ";

src/daemon/driver/driverControlers.ml

@@ -464,7 +464,7 @@ let user_reader o telnet sock nread =
   let b = TcpBufferedSocket.buf sock in
   let rec iter () =
     if b.len > 0 then
-      let c = b.buf.[b.pos] in
+      let c = Bytes.get b.buf b.pos in
       buf_used b 1;
 (*      lprintf "char %d\n" (int_of_char c); *)
       if c = '\255' && not telnet.telnet_iac then begin
@@ -766,9 +766,7 @@ let read_theme_page page =
   let theme_page = get_theme_page page in
   Unix2.tryopen_read theme_page (fun file ->
     let size = (Unix.stat theme_page).Unix.st_size in
-    let s = String.make size ' ' in
-    really_input file s 0 size;
-    s)
+    really_input_string file size)
 
 let http_add_gen_header r =
   add_reply_header r "Server" ("MLdonkey/"^Autoconf.current_version);
@@ -929,8 +927,8 @@ let send_preview r file fd size filename exten =
 
   add_reply_header r "Content-Disposition"
   (Printf.sprintf "inline;filename=\"%s\"" (Filename.basename filename)); 
-  let s = String.create 200000 in
-  set_max_output_buffer r.sock (String.length s);
+  let s = Bytes.create 200000 in
+  set_max_output_buffer r.sock (Bytes.length s);
   set_rtimeout r.sock 10000.;
   let rec stream_file file pos sock =
     let max = (max_refill sock) - 1 in