Merge pull request #4724 from rescript-lang/no_marshal

no unsafe Marshall in encoding/decoding .bsdeps

Author: bobzhang

jscomp/bsb/bsb_ninja_check.ml

@@ -22,23 +22,69 @@
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
+[@@@warning "+9"]
 
 type t =
   { 
     dir_or_files : string array ;
     st_mtimes : float array;
     source_directory :  string ;    
   }
+(* float_of_string_opt *)
+external hexstring_of_float : float -> int -> char -> string
+  = "caml_hexstring_of_float"
+
+let hex_of_float f = hexstring_of_float f (-1) '-'
+
+(* This should not lose any preicision *)
+(* let id (f : float) = 
+    float_of_string (hex_of_float f) = f
+ *)
+
+let encode ( {source_directory ; st_mtimes; dir_or_files} : t ) 
+    (buf: Ext_buffer.t)= 
+  Ext_buffer.add_string_char buf Bs_version.version '\n';  
+  Ext_buffer.add_string_char buf source_directory '\n';
+  let dir_or_files_len = Array.length dir_or_files in 
+  (if dir_or_files_len <> 0 then begin 
+    Ext_buffer.add_string buf dir_or_files.(0);
+    for i = 1 to dir_or_files_len - 1 do 
+      Ext_buffer.add_char_string buf '\t' dir_or_files.(i) 
+    done  
+  end);
+  Ext_buffer.add_char buf '\n';
+  let st_mtimes_len = Array.length st_mtimes in 
+  (if st_mtimes_len <> 0 then begin 
+    Ext_buffer.add_string buf (hex_of_float st_mtimes.(0));
+    for i = 1 to st_mtimes_len - 1 do 
+      Ext_buffer.add_char_string buf '\t' (hex_of_float st_mtimes.(i))  
+    done     
+  end);
+  Ext_buffer.add_char buf '\n'
+  
+let decode_exn ic  =
+  let source_directory = input_line ic in 
+  let dir_or_files = input_line ic in 
+  let dir_or_files = 
+    Array.of_list 
+      (Ext_string.split dir_or_files '\t') in 
+  let st_mtimes_line = 
+    input_line ic in 
+  let st_mtimes = 
+    Ext_array.of_list_map 
+      (Ext_string.split st_mtimes_line '\t')   
+      (fun x -> float_of_string x) in 
+  close_in ic ;
+  {dir_or_files; st_mtimes; source_directory}
 
 
-let magic_number = Bs_version.version
-
 (* TODO: for such small data structure, maybe text format is better *)
 
 let write (fname : string)  (x : t) =
+  let buf = Ext_buffer.create 1_000 in   
+  encode x buf;  
   let oc = open_out_bin fname in
-  output_string oc magic_number ;
-  output_value oc x ;
+  Ext_buffer.output_buffer oc buf ;
   close_out oc
 
 
@@ -47,6 +93,7 @@ let write (fname : string)  (x : t) =
 
 type check_result =
   | Good
+  | Bsb_file_corrupted
   | Bsb_file_not_exist (** We assume that it is a clean repo *)
   | Bsb_source_directory_changed
   | Bsb_bsc_version_mismatch
@@ -56,6 +103,7 @@ type check_result =
 let pp_check_result fmt (check_resoult : check_result) =
   Format.pp_print_string fmt (match check_resoult with
       | Good -> "OK"
+      | Bsb_file_corrupted -> "Stored data corrupted"
       | Bsb_file_not_exist -> "Dependencies information missing"
       | Bsb_source_directory_changed ->
         "Bsb source directory changed"
@@ -75,17 +123,10 @@ let rec check_aux cwd (xs : string array) (ys: float array) i finish =
       check_aux cwd xs ys (i + 1 ) finish
     else Other current_file
 
+    
+
+
 
-let read (fname : string) (cont : t -> check_result) =
-  match open_in_bin fname with   (* Windows binary mode*)
-  | ic ->
-    let buffer = really_input_string ic (String.length magic_number) in
-    if (buffer <> magic_number) then Bsb_bsc_version_mismatch
-    else
-      let res : t = input_value ic  in
-      close_in ic ;
-      cont res
-  | exception _ -> Bsb_file_not_exist
 
 let record ~per_proj_dir ~file  (file_or_dirs : string list) : unit =
   let dir_or_files = Array.of_list file_or_dirs in 
@@ -95,8 +136,9 @@ let record ~per_proj_dir ~file  (file_or_dirs : string list) : unit =
            (Unix.stat (Filename.concat per_proj_dir  x )).st_mtime
          )
   in 
-  write (file ^ "_js" )
-    { st_mtimes ;
+  write file
+    { 
+      st_mtimes ;
       dir_or_files;
       source_directory = per_proj_dir ;
     }
@@ -108,19 +150,26 @@ let record ~per_proj_dir ~file  (file_or_dirs : string list) : unit =
     bit in case we found a different version of compiler
 *)
 let check ~(per_proj_dir:string) ~forced ~file : check_result =
-  read ( file ^ "_js" )  (fun  {
-      dir_or_files ; source_directory; st_mtimes
-    } ->
-      if per_proj_dir <> source_directory then Bsb_source_directory_changed else
-      if forced then Bsb_forced (* No need walk through *)
-      else
-        try
-          check_aux per_proj_dir dir_or_files st_mtimes  0 (Array.length dir_or_files)
-        with e ->
-          begin
-            Bsb_log.info
-              "@{<info>Stat miss %s@}@."
-              (Printexc.to_string e);
-            Bsb_file_not_exist        
-          end)
+  match  open_in_bin file with   (* Windows binary mode*)    
+  | exception _ -> Bsb_file_not_exist
+  | ic ->
+    if input_line ic <> Bs_version.version then Bsb_bsc_version_mismatch
+    else 
+      match decode_exn ic with 
+      | exception _ -> Bsb_file_corrupted (* corrupted file *)
+      | {
+        dir_or_files ; source_directory; st_mtimes
+      } ->
+        if per_proj_dir <> source_directory then Bsb_source_directory_changed else
+        if forced then Bsb_forced (* No need walk through *)
+        else
+          try
+            check_aux per_proj_dir dir_or_files st_mtimes  0 (Array.length dir_or_files)
+          with e ->
+            begin
+              Bsb_log.info
+                "@{<info>Stat miss %s@}@."
+                (Printexc.to_string e);
+              Bsb_file_not_exist        
+            end
 

jscomp/bsb/bsb_ninja_check.mli

@@ -36,6 +36,7 @@
 
 type check_result = 
   | Good
+  | Bsb_file_corrupted
   | Bsb_file_not_exist (** We assume that it is a clean repo *)  
   | Bsb_source_directory_changed
   | Bsb_bsc_version_mismatch  

jscomp/bsb/bsb_ninja_regen.ml

@@ -48,7 +48,8 @@ let regenerate_ninja
   | Good ->
     None  (* Fast path, no need regenerate ninja *)
   | Bsb_forced 
-  | Bsb_bsc_version_mismatch 
+  | Bsb_bsc_version_mismatch
+  | Bsb_file_corrupted
   | Bsb_file_not_exist 
   | Bsb_source_directory_changed  
   | Other _ -> 

lib/4.06.1/bsb.ml

@@ -12387,6 +12387,7 @@ module Bsb_ninja_check : sig
 
 type check_result = 
   | Good
+  | Bsb_file_corrupted
   | Bsb_file_not_exist (** We assume that it is a clean repo *)  
   | Bsb_source_directory_changed
   | Bsb_bsc_version_mismatch  
@@ -12449,23 +12450,69 @@ end = struct
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
+[@@@warning "+9"]
 
 type t =
   { 
     dir_or_files : string array ;
     st_mtimes : float array;
     source_directory :  string ;    
   }
+(* float_of_string_opt *)
+external hexstring_of_float : float -> int -> char -> string
+  = "caml_hexstring_of_float"
+
+let hex_of_float f = hexstring_of_float f (-1) '-'
 
+(* This should not lose any preicision *)
+(* let id (f : float) = 
+    float_of_string (hex_of_float f) = f
+ *)
+
+let encode ( {source_directory ; st_mtimes; dir_or_files} : t ) 
+    (buf: Ext_buffer.t)= 
+  Ext_buffer.add_string_char buf Bs_version.version '\n';  
+  Ext_buffer.add_string_char buf source_directory '\n';
+  let dir_or_files_len = Array.length dir_or_files in 
+  (if dir_or_files_len <> 0 then begin 
+    Ext_buffer.add_string buf dir_or_files.(0);
+    for i = 1 to dir_or_files_len - 1 do 
+      Ext_buffer.add_char_string buf '\t' dir_or_files.(i) 
+    done  
+  end);
+  Ext_buffer.add_char buf '\n';
+  let st_mtimes_len = Array.length st_mtimes in 
+  (if st_mtimes_len <> 0 then begin 
+    Ext_buffer.add_string buf (hex_of_float st_mtimes.(0));
+    for i = 1 to st_mtimes_len - 1 do 
+      Ext_buffer.add_char_string buf '\t' (hex_of_float st_mtimes.(i))  
+    done     
+  end);
+  Ext_buffer.add_char buf '\n'
+  
+let decode_exn ic  =
+  let source_directory = input_line ic in 
+  let dir_or_files = input_line ic in 
+  let dir_or_files = 
+    Array.of_list 
+      (Ext_string.split dir_or_files '\t') in 
+  let st_mtimes_line = 
+    input_line ic in 
+  let st_mtimes = 
+    Ext_array.of_list_map 
+      (Ext_string.split st_mtimes_line '\t')   
+      (fun x -> float_of_string x) in 
+  close_in ic ;
+  {dir_or_files; st_mtimes; source_directory}
 
-let magic_number = Bs_version.version
 
 (* TODO: for such small data structure, maybe text format is better *)
 
 let write (fname : string)  (x : t) =
+  let buf = Ext_buffer.create 1_000 in   
+  encode x buf;  
   let oc = open_out_bin fname in
-  output_string oc magic_number ;
-  output_value oc x ;
+  Ext_buffer.output_buffer oc buf ;
   close_out oc
 
 
@@ -12474,6 +12521,7 @@ let write (fname : string)  (x : t) =
 
 type check_result =
   | Good
+  | Bsb_file_corrupted
   | Bsb_file_not_exist (** We assume that it is a clean repo *)
   | Bsb_source_directory_changed
   | Bsb_bsc_version_mismatch
@@ -12483,6 +12531,7 @@ type check_result =
 let pp_check_result fmt (check_resoult : check_result) =
   Format.pp_print_string fmt (match check_resoult with
       | Good -> "OK"
+      | Bsb_file_corrupted -> "Stored data corrupted"
       | Bsb_file_not_exist -> "Dependencies information missing"
       | Bsb_source_directory_changed ->
         "Bsb source directory changed"
@@ -12502,17 +12551,10 @@ let rec check_aux cwd (xs : string array) (ys: float array) i finish =
       check_aux cwd xs ys (i + 1 ) finish
     else Other current_file
 
+    
+
+
 
-let read (fname : string) (cont : t -> check_result) =
-  match open_in_bin fname with   (* Windows binary mode*)
-  | ic ->
-    let buffer = really_input_string ic (String.length magic_number) in
-    if (buffer <> magic_number) then Bsb_bsc_version_mismatch
-    else
-      let res : t = input_value ic  in
-      close_in ic ;
-      cont res
-  | exception _ -> Bsb_file_not_exist
 
 let record ~per_proj_dir ~file  (file_or_dirs : string list) : unit =
   let dir_or_files = Array.of_list file_or_dirs in 
@@ -12522,8 +12564,9 @@ let record ~per_proj_dir ~file  (file_or_dirs : string list) : unit =
            (Unix.stat (Filename.concat per_proj_dir  x )).st_mtime
          )
   in 
-  write (file ^ "_js" )
-    { st_mtimes ;
+  write file
+    { 
+      st_mtimes ;
       dir_or_files;
       source_directory = per_proj_dir ;
     }
@@ -12535,21 +12578,28 @@ let record ~per_proj_dir ~file  (file_or_dirs : string list) : unit =
     bit in case we found a different version of compiler
 *)
 let check ~(per_proj_dir:string) ~forced ~file : check_result =
-  read ( file ^ "_js" )  (fun  {
-      dir_or_files ; source_directory; st_mtimes
-    } ->
-      if per_proj_dir <> source_directory then Bsb_source_directory_changed else
-      if forced then Bsb_forced (* No need walk through *)
-      else
-        try
-          check_aux per_proj_dir dir_or_files st_mtimes  0 (Array.length dir_or_files)
-        with e ->
-          begin
-            Bsb_log.info
-              "@{<info>Stat miss %s@}@."
-              (Printexc.to_string e);
-            Bsb_file_not_exist        
-          end)
+  match  open_in_bin file with   (* Windows binary mode*)    
+  | exception _ -> Bsb_file_not_exist
+  | ic ->
+    if input_line ic <> Bs_version.version then Bsb_bsc_version_mismatch
+    else 
+      match decode_exn ic with 
+      | exception _ -> Bsb_file_corrupted (* corrupted file *)
+      | {
+        dir_or_files ; source_directory; st_mtimes
+      } ->
+        if per_proj_dir <> source_directory then Bsb_source_directory_changed else
+        if forced then Bsb_forced (* No need walk through *)
+        else
+          try
+            check_aux per_proj_dir dir_or_files st_mtimes  0 (Array.length dir_or_files)
+          with e ->
+            begin
+              Bsb_log.info
+                "@{<info>Stat miss %s@}@."
+                (Printexc.to_string e);
+              Bsb_file_not_exist        
+            end
 
 
 end
@@ -14490,7 +14540,8 @@ let regenerate_ninja
   | Good ->
     None  (* Fast path, no need regenerate ninja *)
   | Bsb_forced 
-  | Bsb_bsc_version_mismatch 
+  | Bsb_bsc_version_mismatch
+  | Bsb_file_corrupted
   | Bsb_file_not_exist 
   | Bsb_source_directory_changed  
   | Other _ ->