Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tag: 0.7.6
Fetching contributors…

Cannot retrieve contributors at this time

file 303 lines (230 sloc) 8.178 kb
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 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303
(***********************************************************************)
(* *)
(* Copyright 2012 OCamlPro *)
(* Copyright 2012 INRIA *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Public License version 3.0. *)
(* *)
(* OPAM 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. *)
(* *)
(***********************************************************************)

module Base = OpamMisc.Base

let log fmt = OpamGlobals.log "FILENAME" fmt

module Dir = struct

  include OpamMisc.Base

  let of_string dirname =
    if not (Filename.is_relative dirname) then
      dirname
    else
      OpamSystem.real_path dirname

  let to_string dirname =
    if dirname.[String.length dirname - 1] = Filename.dir_sep.[0] then
      Filename.concat (Filename.dirname dirname) (Filename.basename dirname)
    else
      dirname

end

let raw_dir s = s

let with_tmp_dir fn =
  OpamSystem.with_tmp_dir (fun dir -> fn (Dir.of_string dir))

let rmdir dirname =
  log "rmdir %s" (Dir.to_string dirname);
  OpamSystem.remove (Dir.to_string dirname)

let cwd () =
  Dir.of_string (Unix.getcwd ())

let mkdir dirname =
  OpamSystem.mkdir (Dir.to_string dirname)

let list_dirs d =
  let fs = OpamSystem.directories_with_links (Dir.to_string d) in
  List.map Dir.of_string fs

let in_dir dirname fn =
  if Sys.file_exists dirname then
    OpamSystem.in_dir dirname fn
  else
    OpamGlobals.error_and_exit "%s does not exist!" dirname

let exec dirname ?(add_to_env=[]) ?(add_to_path=[]) cmds =
  OpamSystem.in_dir (Dir.to_string dirname)
    (fun () ->
      OpamSystem.commands
        ~add_to_env
        ~add_to_path:(List.map Dir.of_string add_to_path)
        cmds)

let move_dir src dst =
  OpamSystem.command [ "mv"; Dir.to_string src; Dir.to_string dst ]

let copy_dir src dst =
  with_tmp_dir (fun tmp ->
    OpamSystem.command [ "rsync"; "-a"; Filename.concat (Dir.to_string src) "/"; Dir.to_string tmp ];
    match list_dirs tmp with
    | [f] ->
      rmdir dst;
      move_dir f dst
    | _ -> OpamGlobals.error_and_exit "Error while copying %s to %s" (Dir.to_string src) (Dir.to_string dst)
  )

let link_dir src dst =
  rmdir dst;
  let tmp_dst = Filename.concat (Filename.basename src) (Filename.basename dst) in
  let base = Filename.dirname dst in
  mkdir base;
  if dst = tmp_dst then
    in_dir base (fun () -> OpamSystem.command [ "ln"; "-s"; src])
  else
    in_dir base (fun () ->
      OpamSystem.commands [
        ["ln"; "-s"; src];
        ["mv"; (Filename.basename src); (Filename.basename dst) ];
      ])

let basename_dir dirname =
  Base.of_string (Filename.basename (Dir.to_string dirname))

let dirname_dir dirname =
  Dir.to_string (Filename.dirname (Dir.of_string dirname))

let exists_dir dirname =
  Sys.file_exists (Dir.to_string dirname)

let (/) d1 s2 =
  let s1 = Dir.to_string d1 in
  raw_dir (Filename.concat s1 s2)

type t = {
  dirname: Dir.t;
  basename: Base.t;
}

let create dirname basename =
  let b1 = Filename.dirname (Base.to_string basename) in
  let b2 = Base.of_string (Filename.basename (Base.to_string basename)) in
  if basename = b2 then
    { dirname; basename }
  else
    { dirname = dirname / b1; basename = b2 }

let of_basename basename =
  let dirname = Dir.of_string "." in
  { dirname; basename }

let raw_file str =
  let dirname = raw_dir (Filename.dirname str) in
  let basename = Base.of_string (Filename.basename str) in
  create dirname basename

let to_string t =
  Filename.concat (Dir.to_string t.dirname) (Base.to_string t.basename)

let digest t =
  Digest.to_hex (Digest.file (to_string t))

let touch t =
  OpamSystem.write (to_string t) ""

let chmod t p =
  Unix.chmod (to_string t) p

let of_string s =
  let dirname = Filename.dirname s in
  let basename = Filename.basename s in
  {
    dirname = Dir.of_string dirname;
    basename = Base.of_string basename;
  }

let dirname t = t.dirname

let basename t = t.basename

let read filename =
  OpamSystem.read (to_string filename)

let write filename raw =
  OpamSystem.write (to_string filename) raw

let remove filename =
  OpamSystem.remove_file (to_string filename)

let exists filename =
  Sys.file_exists (to_string filename)

let with_contents fn filename =
  fn (read filename)

let check_suffix filename s =
  Filename.check_suffix (to_string filename) s

let add_extension filename suffix =
  of_string ((to_string filename) ^ "." ^ suffix)

let chop_extension filename =
  of_string (Filename.chop_extension (to_string filename))

let list_files d =
  let fs = OpamSystem.rec_files (Dir.to_string d) in
  List.map of_string fs

let copy src dst =
  OpamSystem.copy (to_string src) (to_string dst)

let move src dst =
  OpamSystem.command [ "mv"; to_string src; to_string dst ]

let link src dst =
  if OpamGlobals.os = OpamGlobals.Win32 then
    copy src dst
  else
    OpamSystem.link (to_string src) (to_string dst)

let process_in fn src dst =
  let src_s = to_string src in
  let dst = Filename.concat (Dir.to_string dst) (Filename.basename src_s) in
  fn src (of_string dst)

let copy_in = process_in copy

let link_in = process_in link

let extract filename dirname =
  OpamSystem.extract (to_string filename) (Dir.to_string dirname)

let extract_in filename dirname =
  OpamSystem.extract_in (to_string filename) (Dir.to_string dirname)

let starts_with dirname filename =
  OpamMisc.starts_with (Dir.to_string dirname) (to_string filename)

let remove_prefix ~prefix filename =
  let prefix =
    let str = Dir.to_string prefix in
    if str = "" then "" else Filename.concat str "" in
  let dirname = to_string filename in
  OpamMisc.remove_prefix ~prefix dirname

let download filename dirname =
  mkdir dirname;
  let file = OpamSystem.download ~filename:(to_string filename) ~dirname:(Dir.to_string dirname) in
  of_string file

let download_iter filenames dirname =
  let rec aux = function
    | [] ->
      OpamSystem.internal_error "Cannot download %s" (String.concat ", " (List.map to_string filenames))
    | h::t ->
      try download h dirname
      with _ -> aux t in
  aux filenames

let patch filename dirname =
  in_dir dirname (fun () -> OpamSystem.patch (to_string filename))

module O = struct
  type tmp = t
  type t = tmp
  let compare x y = compare (to_string x) (to_string y)
  let to_string = to_string
end

module Map = OpamMisc.Map.Make(O)
module Set = OpamMisc.Set.Make(O)

module OP = struct

  let (/) = (/)

  let (//) d1 s2 =
    let d = Filename.dirname s2 in
    let b = Filename.basename s2 in
    if d <> "." then
      create (d1 / d) (Base.of_string b)
  else
      create d1 (Base.of_string s2)

end

module Attribute = struct

  type t = {
    base: Base.t;
    md5 : string;
    perm: int option;
  }

  let base t = t.base

  let md5 t = t.md5

  let perm t = t.perm

  let create base md5 perm =
    { base; md5; perm=Some perm }

  let to_string t =
    let perm = match t.perm with
      | None -> ""
      | Some p -> Printf.sprintf " 0o%o" p in
    Printf.sprintf "%s %s%s" (Base.to_string t.base) t.md5 perm

  let of_string s =
    match OpamMisc.split s ' ' with
    | [base; md5] -> { base=Base.of_string base; md5; perm=None }
    | [base;md5; perm] -> { base=Base.of_string base; md5; perm=Some (int_of_string perm) }
    | k -> OpamGlobals.error_and_exit "Remote_file: %s" (String.concat " " k)

  module O = struct
    type tmp = t
    type t = tmp
    let to_string = to_string
    let compare = compare
  end

  module Set = OpamMisc.Set.Make(O)

  module Map = OpamMisc.Map.Make(O)

end
Something went wrong with that request. Please try again.