path.ml

   1 let debug = false
   2
   3 type unix_path =
   4   | Bad_dir
   5   | Bad_file
   6   | Path of string
   7
   8 let convert_compress_slashes s =
   9   let l = String.length s in
  10   let t = String.create l in
  11   let rec loop prev_slash i j =
  12     if i = l
  13     then
  14       j
  15     else
  16       let c = s.[i] in
  17         if c = '\\'
  18         then
  19           if prev_slash
  20           then
  21             loop true (succ i) j
  22           else
  23             begin
  24               t.[j] <- '/';
  25               loop true (succ i) (succ j)
  26             end
  27         else
  28           begin
  29             t.[j] <- c;
  30             loop false (succ i) (succ j)
  31           end
  32   in
  33   let rl = loop false 0 0 in
  34     if rl = String.length t
  35     then
  36       t
  37     else
  38       String.sub t 0 rl
  39
  40 let convert_slashes = convert_compress_slashes
  41
  42 let find_unix_path path =
  43   let dirname = Filename.dirname path in
  44     if debug
  45     then
  46       Format.eprintf "find_unix_path: %S - %S %b@.@."
  47         path dirname (Sys.file_exists dirname);
  48     if not (Sys.file_exists dirname)
  49     then
  50       Bad_dir
  51     else
  52       if not (Sys.file_exists path)
  53       then
  54         let basename = Filename.basename path in
  55         let names = Sys.readdir dirname in
  56           if debug
  57           then
  58             Format.eprintf "readdir: %S@." dirname;
  59         let lowercase_name = String.lowercase basename in
  60         let find_string_lower target names =
  61           let len = Array.length names in
  62           let rec finder index =
  63             if index = len
  64             then
  65               None
  66             else
  67               let name = names.(index) in
  68               let lowercase_name = String.lowercase name in
  69                 if lowercase_name = target
  70                 then
  71                   Some name
  72                 else
  73                   finder (succ index)
  74           in
  75             finder 0
  76         in
  77           match (find_string_lower lowercase_name names) with
  78             | None ->
  79                 Bad_file
  80             | Some name ->
  81                 Path (Filename.concat dirname name)
  82       else
  83         Path path
  84
  85 let rec find path =
  86   if debug
  87   then
  88     Format.eprintf "find(%S)@." path;
  89   let res = find_unix_path path in
  90     match res with
  91       | Bad_dir ->
  92           let dirname = Filename.dirname path in
  93           let res = find dirname in
  94             begin
  95               match res with
  96                 | Path correct_dirname ->
  97                     let basename = Filename.basename path in
  98                     let path = Filename.concat correct_dirname basename in
  99                       find_unix_path path
 100                 | _ ->
 101                     Bad_dir
 102             end
 103       | other ->
 104           other
 105
 106 let split s =
 107   let len = String.length s in
 108   let rec collect list pos =
 109     if pos = len
 110     then
 111       list
 112     else
 113       match s.[pos] with
 114         | ' ' | '\t' | '\n' | '\r' ->
 115             collect list (succ pos)
 116         | '"' ->
 117             let endpos =
 118               try
 119                 String.index_from s pos '"'
 120               with Not_found->
 121                 prerr_string "Path.split: mismatched quote ";
 122                 prerr_string (String.escaped s);
 123                 prerr_string " pos:";
 124                 prerr_int pos;
 125                 prerr_newline ();
 126                 len
 127             in
 128             let s = String.sub s pos (endpos - pos) in
 129               collect (s :: list) endpos
 130         | _ ->
 131             let endpos =
 132               try
 133                 String.index_from s pos ' '
 134               with Not_found->
 135                 len
 136             in
 137             let s = String.sub s pos (endpos - pos) in
 138               collect (s :: list) endpos
 139   in
 140     collect [] 0
 141
 142 let find2 win_path =
 143   let s1 =
 144     if not Wine.native || !Wine.native_convert_slashes
 145     then
 146       convert_slashes win_path
 147     else
 148       win_path
 149   in
 150     if Wine.native
 151     then
 152       Some s1
 153     else
 154       let s2 = Drive.subst s1 in
 155       let unix_path = find s2 in
 156         begin
 157           match unix_path with
 158             | Bad_dir
 159             | Bad_file ->
 160                 if debug
 161                 then
 162                   begin
 163                     prerr_string "Path.find2 Bad_file: ";
 164                     prerr_string (String.copy win_path);
 165                     prerr_char ' ';
 166                     prerr_string (String.copy s1);
 167                     prerr_char ' ';
 168                     prerr_string (String.copy s2);
 169                     prerr_char ' ';
 170                     prerr_newline ();
 171                     exit 103
 172                   end;
 173                 None
 174             | Path unix_path ->
 175                 Some unix_path
 176         end
 177
 178 let output oc dir_only win_path =
 179   let s1 =
 180     if not Wine.native || !Wine.native_convert_slashes
 181     then
 182       convert_slashes win_path
 183     else
 184       win_path
 185   in
 186     if Wine.native
 187     then
 188       output_string oc s1
 189     else
 190       let s2 = Drive.subst s1 in
 191       let s3 =
 192         if dir_only
 193         then
 194           Filename.dirname s2
 195         else
 196           s2
 197       in
 198       let unix_path = find s3 in
 199         begin
 200           match unix_path with
 201             | Bad_dir
 202             | Bad_file ->
 203                 if debug
 204                 then
 205                   begin
 206                     prerr_string "Path.output Bad_file: ";
 207                     prerr_string ( win_path);
 208                     print_char ' ';
 209                     prerr_string ( s1);
 210                     prerr_char ' ';
 211                     prerr_string ( s2);
 212                     prerr_char ' ';
 213                     prerr_newline ();
 214                     exit 104
 215                   end;
 216                 output_string oc win_path
 217             | Path unix_path ->
 218                 if dir_only
 219                 then
 220                   output_string oc (Filename.concat s3 (Filename.basename s2))
 221                 else
 222                   output_string oc unix_path
 223         end
 224
 225 let prerr = output stderr
 226 let print = output stdout
 227
 228 let abs_predicate s =
 229   not (Filename.is_relative s) && Sys.file_exists s
 230
 231 let check_and_modify_absolute_no_root s =
 232   if abs_predicate s
 233   then
 234     begin
 235       prerr_string (String.escaped s);
 236       prerr_endline
 237         " is absolute and exists, but no wine drive mapping root is defined";
 238       s
 239     end
 240   else
 241     s
 242
 243 let check_and_modify_absolute_root root s =
 244   if abs_predicate s
 245   then
 246     if false
 247     then
 248       let r = String.create (String.length s + 2) in
 249         r.[0] <- root;
 250         r.[1] <- ':';
 251         StringLabels.blit
 252           ~src:s
 253           ~src_pos:0
 254           ~dst:r
 255           ~dst_pos:2
 256           ~len:(String.length s);
 257         r
 258     else
 259       let r = String.create (String.length s + 1) in
 260         r.[0] <- '\\';
 261         r.[1] <- '\\';
 262         StringLabels.blit
 263           ~src:s
 264           ~src_pos:1
 265           ~dst:r
 266           ~dst_pos:2
 267           ~len:(String.length s - 1);
 268         r
 269   else
 270     s
 271
 272 let check_and_modify_absolute s =
 273   if Wine.native
 274   then
 275     s
 276   else
 277     match Drive.get_root () with
 278       | None ->
 279           check_and_modify_absolute_no_root s
 280       | Some root ->
 281           check_and_modify_absolute_root root s