File: realpath.ml

package info (click to toggle)
libguestfs 1%3A1.44.0-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 118,932 kB
  • sloc: ansic: 458,017; ml: 51,424; sh: 13,191; java: 9,578; makefile: 7,931; cs: 6,328; haskell: 5,674; python: 3,871; perl: 3,528; erlang: 2,446; xml: 1,347; ruby: 350; pascal: 257; javascript: 157; lex: 135; yacc: 128; cpp: 10
file content (86 lines) | stat: -rw-r--r-- 2,958 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
(* guestfs-inspection
 * Copyright (C) 2009-2020 Red Hat Inc.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License along
 * with this program; if not, write to the Free Software Foundation, Inc.,
 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 *)

open Printf

open Std_utils

let realpath path =
  let chroot = Chroot.create ~name:(sprintf "realpath: %s" path) () in
  Chroot.f chroot Unix_utils.Realpath.realpath path

(* The infamous case_sensitive_path function, which works around
 * the bug in ntfs-3g that all paths are case sensitive even though
 * the underlying filesystem is case insensitive.
 *)
let rec case_sensitive_path path =
  let elems = String.nsplit "/" path in

  (* The caller ensures that the first element of [path] is [/],
   * and therefore the first element of the split list must be
   * empty.
   *)
  assert (List.length elems > 0);
  assert (List.hd elems = "");
  let elems = List.tl elems in

  let chroot =
    Chroot.create ~name:(sprintf "case_sensitive_path: %s" path) () in

  (* Now we iterate down the tree starting at the sysroot. *)
  let elems =
    Chroot.f chroot (
      fun () ->
        let rec loop = function
          | [] -> []
          | [ "."|".." ] ->
             failwithf "path contains \".\" or \"..\" elements"
          | "" :: elems ->
             (* For compatibility with C implementation, we ignore
              * "//" in the middle of the path.
              *)
             loop elems
          | [ file ] ->
             (* If it's the final element, it's allowed to be missing. *)
             (match find_path_element file with
              | None -> [ file ] (* return the original *)
              | Some file -> [ file ]
             );
          | elem :: elems ->
             (match find_path_element elem with
              | None ->
                 failwithf "%s: not found" elem
              | Some elem ->
                 (* This will fail intentionally if not a directory. *)
                 Unix.chdir elem;
                 elem :: loop elems
             )
        in
        loop elems
    ) () in

  (* Reconstruct the case sensitive path. *)
  "/" ^ String.concat "/" elems

and find_path_element name =
  let dir = Sys.readdir "." in
  let dir = Array.to_list dir in
  let lc_name = String.lowercase_ascii name in
  let cmp n = String.lowercase_ascii n = lc_name in
  try Some (List.find cmp dir)
  with Not_found -> None