Rampup port: Fix genesis ledger directory growing in size

src/lib/genesis_ledger_helper/genesis_ledger_helper.ml

@@ -47,6 +47,9 @@ module Tar = struct
         Ok ()
     | Error err ->
         Error (Error.tag err ~tag:"Error extracting tar file")
+
+  let filename_without_extension =
+    String.chop_suffix_if_exists ~suffix:".tar.gz"
 end
 
 let file_exists ?follow_symlinks filename =
@@ -132,46 +135,44 @@ module Ledger = struct
               ] ;
           return None
     in
+    let search_local filename =
+      Deferred.List.find_map ~f:(file_exists filename) search_paths
+    in
+    let search_local_and_s3 filename =
+      match%bind search_local filename with
+      | Some path ->
+          return (Some path)
+      | None ->
+          load_from_s3 filename
+    in
     let%bind hash_filename =
       match config.hash with
-      | Some hash -> (
+      | Some hash ->
           let hash_filename = hash_filename hash ~ledger_name_prefix in
-          let%bind tar_path =
-            Deferred.List.find_map ~f:(file_exists hash_filename) search_paths
-          in
-          match tar_path with
-          | Some _ ->
-              return tar_path
-          | None ->
-              load_from_s3 hash_filename )
+          search_local_and_s3 hash_filename
       | None ->
           return None
     in
-    let search_local_and_s3 ?other_data name =
-      let named_filename =
-        named_filename ~constraint_constants ~num_accounts:config.num_accounts
-          ~balances:config.balances ~ledger_name_prefix ?other_data name
-      in
-      match%bind
-        Deferred.List.find_map ~f:(file_exists named_filename) search_paths
-      with
-      | Some path ->
-          return (Some path)
-      | None ->
-          load_from_s3 named_filename
-    in
     match hash_filename with
     | Some filename ->
         return (Some filename)
     | None -> (
+        let search_local_and_s3 ?other_data name =
+          let named_filename =
+            named_filename ~constraint_constants
+              ~num_accounts:config.num_accounts ~balances:config.balances
+              ~ledger_name_prefix ?other_data name
+          in
+          search_local_and_s3 named_filename
+        in
         match (config.base, config.name) with
         | Named name, _ ->
             let named_filename =
               named_filename ~constraint_constants
                 ~num_accounts:config.num_accounts ~balances:config.balances
                 ~ledger_name_prefix name
             in
-            Deferred.List.find_map ~f:(file_exists named_filename) search_paths
+            search_local named_filename
         | Accounts accounts, _ ->
             search_local_and_s3 ~other_data:(accounts_hash accounts) "accounts"
         | Hash hash, None ->
@@ -186,11 +187,33 @@ module Ledger = struct
     [%log trace] "Loading $ledger from $path"
       ~metadata:
         [ ("ledger", `String ledger_name_prefix); ("path", `String filename) ] ;
-    let dirname = Uuid.to_string (Uuid_unix.create ()) in
-    (* Unpack the ledger in the autogen directory, since we know that we have
-       write permissions there.
-    *)
+    let dirname =
+      Tar.filename_without_extension @@ Filename.basename filename
+    in
     let dirname = genesis_dir ^/ dirname in
+    (* remove dir if it exists *)
+    let%bind () =
+      if%bind file_exists ~follow_symlinks:true dirname then (
+        [%log trace] "Genesis ledger dir $path already exists, removing"
+          ~metadata:[ ("path", `String dirname) ] ;
+        let rec remove_dir dir =
+          let%bind files = Sys.ls_dir dir in
+          let%bind () =
+            Deferred.List.iter files ~f:(fun file ->
+                let file = dir ^/ file in
+                remove file )
+          in
+          Unix.rmdir dir
+        and remove file =
+          match%bind Sys.is_directory file with
+          | `Yes ->
+              remove_dir file
+          | _ ->
+              Unix.unlink file
+        in
+        remove dirname )
+      else Deferred.unit
+    in
     let%bind () = Unix.mkdir ~p:() dirname in
     let open Deferred.Or_error.Let_syntax in
     let%map () = Tar.extract ~root:dirname ~file:filename () in