type system_error = | EIO (* Erreur de bas niveau lors d'un accès au disque *) | EACCESS (* Erreur d'accès *) | EISDIR (* Répertoire trouvé où un fichier régulier est attendu *) | ENOTDIR (* Fichier régulier trouvé où un répertoire est attendu *) | EINVAL (* Argument invalide *) | EEXIST (* Un fichier existe déjà *) | ENOENT (* Un fichier manque *) | EBUSY (* Un fichier est occupé *) | ENOSPC (* Plus d'espace sur le disque *) exception System of system_error * string * string exception Implementation of string let get_int8 s pos = int_of_char s.[pos] let read_int s pos = let c4 = get_int8 s pos in let c3 = get_int8 s (pos+1) in let c2 = get_int8 s (pos+2) in let c1 = get_int8 s (pos+3) in c1 + (c2 lsl 8) + (c3 lsl 16) + (c4 lsl 24) let write_int i s pos = s.[pos+3] <- char_of_int (i land 255); s.[pos+2] <- char_of_int ((i lsr 8) land 255); s.[pos+1] <- char_of_int ((i lsr 16) land 255); s.[pos] <- char_of_int ((i lsr 24) land 255) let system_error err call mes = raise (System (err, call, mes)) let handle_unix f x = try f x with Unix.Unix_error (error,s,mes) -> system_error EIO s (Printf.sprintf "%s/%s" mes (Unix.error_message error)) let implementation_error s = raise (Implementation s) let try_finalize f x finally y = let res = try f x with exn -> finally y; raise exn in finally y; res;; let rec really_read fd buffer start length = if length <= 0 then () else match Unix.read fd buffer start length with 0 -> raise End_of_file | r -> really_read fd buffer (start + r) (length - r);; let debug = ref 0 (* 2 mean no debug *) let to_path name = let rec iter name pos len = try let end_pos = String.index_from name pos '/' in let before = String.sub name pos (end_pos - pos) in let after = iter name (end_pos+1) len in if before = "" then after else before :: after with Not_found -> let before = String.sub name pos (len - pos) in if before = "" then [] else [before] in iter name 0 (String.length name)