Fix #701

Normalize link target paths

src/drive.ml

@@ -2299,6 +2299,12 @@ let create_remote_resource ?link_target is_folder path mode =
   let cache = context.Context.cache in
   let parent_path = Filename.dirname path_in_cache in
   let create_file =
+    let mountpoint_path = context.mountpoint_path in
+    let mountpoint_path =
+      if ExtString.String.ends_with mountpoint_path Filename.dir_sep then
+        Filename.chop_suffix mountpoint_path Filename.dir_sep
+      else mountpoint_path
+    in
     get_resource parent_path trashed >>= fun parent_resource ->
     let parent_id =
       parent_resource |. CacheData.Resource.remote_id |> Option.get
@@ -2313,7 +2319,6 @@ let create_remote_resource ?link_target is_folder path mode =
       | None -> false
       | Some tp ->
           if not (Filename.is_relative tp) then
-            let mountpoint_path = context.mountpoint_path in
             ExtString.String.starts_with tp mountpoint_path
           else true
     in
@@ -2344,13 +2349,23 @@ let create_remote_resource ?link_target is_folder path mode =
             else target_dirname ^ Filename.dir_sep ^ tp
           else tp
         in
+        let target_path =
+          if ExtString.String.starts_with target_path mountpoint_path then
+            let mountpoint_path_length = String.length mountpoint_path in
+            String.sub target_path mountpoint_path_length
+              (String.length target_path - mountpoint_path_length)
+          else target_path
+        in
         let target_path =
           if ExtString.String.ends_with target_path Filename.dir_sep then
             Filename.chop_suffix target_path Filename.dir_sep
           else target_path
         in
+        let normalized_target_path =
+          try Utils.normalize_absolute_path target_path with _ -> ""
+        in
         let target_path_in_cache, target_trashed =
-          get_path_in_cache target_path config
+          get_path_in_cache normalized_target_path config
         in
         get_resource target_path_in_cache target_trashed >>= fun resource ->
         if CacheData.Resource.is_shortcut resource then

src/utils.ml

@@ -31,15 +31,15 @@ let try_finally f finally =
     finally ();
     result
   with e ->
-    ( try finally ()
-      with e' ->
-        let message = Printexc.to_string e' in
-        let backtrace = Printexc.get_backtrace () in
-        let elapsed = Unix.gettimeofday () -. start_time in
-        let thread_id = get_thread_id () in
-        Printf.fprintf !log_channel
-          "[%f] TID=%d: Error in finally block:\nException:%s\nBacktrace:%s\n%!"
-          elapsed thread_id message backtrace );
+    (try finally ()
+     with e' ->
+       let message = Printexc.to_string e' in
+       let backtrace = Printexc.get_backtrace () in
+       let elapsed = Unix.gettimeofday () -. start_time in
+       let thread_id = get_thread_id () in
+       Printf.fprintf !log_channel
+         "[%f] TID=%d: Error in finally block:\nException:%s\nBacktrace:%s\n%!"
+         elapsed thread_id message backtrace);
     raise e
 
 (* Channels *)
@@ -60,15 +60,15 @@ let open_log_out_ch log_to path =
   | p when String.index p '/' = 0 -> open_out p
   | l ->
       failwith
-        ( "Invalid log_to value: " ^ l
-        ^ " should be 'stdout', 'stderr', or an absolute path" )
+        ("Invalid log_to value: " ^ l
+       ^ " should be 'stdout', 'stderr', or an absolute path")
 
 let log_message format =
   if !verbose then (
     if !debug_buffers then Mutex.lock log_mutex;
     let result = Printf.fprintf !log_channel format in
     if !debug_buffers then Mutex.unlock log_mutex;
-    result )
+    result)
   else Printf.ifprintf !log_channel format
 
 let log_with_header format =
@@ -79,7 +79,7 @@ let log_with_header format =
     Printf.fprintf !log_channel "[%f] TID=%d: " elapsed thread_id;
     let result = Printf.fprintf !log_channel format in
     if !debug_buffers then Mutex.unlock log_mutex;
-    result )
+    result)
   else Printf.ifprintf !log_channel format
 
 let log_exception e =
@@ -184,10 +184,10 @@ let start_browser browser url =
     let status = Unix.close_process_in ch in
     if status = Unix.WEXITED 0 then (
       log_with_header "END: Starting web browser with command: %s\n" command;
-      true )
+      true)
     else (
       log_with_header "FAIL: Starting web browser with command: %s\n" command;
-      false )
+      false)
   in
   let browsers =
     if browser <> "" then [ browser ]
@@ -208,7 +208,7 @@ let with_retry ?(filter_exception = fun _ -> true) f label =
       if n >= !max_retries then (
         log_with_header "Error during %s after %d attempts: %s\n%!" label
           !max_retries (Printexc.to_string e);
-        raise e )
+        raise e)
       else
         let n' = n + 1 in
         log_with_header "Retrying (%d/%d) %s after exception: %s\n%!" n'
@@ -253,3 +253,16 @@ let base64_encode s =
   let base64 = Cryptokit.Base64.encode_compact () in
   Cryptokit.transform_string base64 s
 
+(* Normalize paths *)
+let normalize_absolute_path path =
+  if Filename.is_relative path then failwith "Absolute path expected";
+  let dirs = Str.split (Str.regexp (Str.quote Filename.dir_sep)) path in
+  let rec loop ds accu =
+    match ds with
+    | [] -> accu
+    | "" :: ts | "." :: ts -> loop ts accu
+    | ".." :: ts -> loop ts (List.tl accu)
+    | d :: ts -> loop ts (d :: accu)
+  in
+  let normalized_dirs = loop dirs [] |> List.rev in
+  Filename.dir_sep ^ String.concat Filename.dir_sep normalized_dirs

test/testSuite.ml

@@ -3,6 +3,11 @@ open OUnit
 let _ =
   let suite =
     "google-drive-ocamlfuse test suite"
-    >::: [ TestBuffering.suite; TestThreadPool.suite; TestBufferPool.suite ]
+    >::: [
+           TestBuffering.suite;
+           TestThreadPool.suite;
+           TestBufferPool.suite;
+           TestUtils.suite;
+         ]
   in
   OUnit.run_test_tt_main suite

test/testUtils.ml

@@ -0,0 +1,23 @@
+open OUnit
+
+let test_normlize_absolute_path () =
+  let normalized =
+    Utils.normalize_absolute_path "/home/test/../tmp/./gdrive/test123/../test"
+  in
+  assert_equal ~printer:(fun x -> x) "/home/tmp/gdrive/test" normalized
+
+let test_normlize_absolute_path_2 () =
+  let normalized = Utils.normalize_absolute_path "/home/..//.///./test" in
+  assert_equal ~printer:(fun x -> x) "/test" normalized
+
+let test_normlize_absolute_path_3 () =
+  let normalized = Utils.normalize_absolute_path "/home/..//.///./test/" in
+  assert_equal ~printer:(fun x -> x) "/test" normalized
+
+let suite =
+  "Utils test"
+  >::: [
+         "test_normlize_absolute_path" >:: test_normlize_absolute_path;
+         "test_normlize_absolute_path 2" >:: test_normlize_absolute_path_2;
+         "test_normlize_absolute_path 3" >:: test_normlize_absolute_path_3;
+       ]