(******************************************************************************) (* ocaml-fileutils: files and filenames common operations *) (* *) (* Copyright (C) 2003-2014, Sylvain Le Gall *) (* *) (* This library is free software; you can redistribute it and/or modify it *) (* under the terms of the GNU Lesser General Public License as published by *) (* the Free Software Foundation; either version 2.1 of the License, or (at *) (* your option) any later version, with the OCaml static compilation *) (* exception. *) (* *) (* This library 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 file *) (* COPYING for more details. *) (* *) (* You should have received a copy of the GNU Lesser General Public License *) (* along with this library; if not, write to the Free Software Foundation, *) (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) (******************************************************************************) open FileUtilTypes open FilePath open FileUtilMisc open FileUtilTEST open FileUtilUMASK open FileUtilCHMOD exception MkdirError of string type mkdir_error = [ `DirnameAlreadyUsed of filename | `Exc of exn | `MissingComponentPath of filename | `MkdirChmod of filename * Unix.file_perm * string * exc ] let mkdir ?(error=(fun str _ -> raise (MkdirError str))) ?(parent=false) ?mode dn = let handle_error, handle_exception = handle_error_gen "mkdir" error (function | `DirnameAlreadyUsed fn -> Printf.sprintf "Directory %s already exists and is a file." fn | `MissingComponentPath fn -> Printf.sprintf "Unable to create directory %s, an upper directory is missing." fn | `MkdirChmod (dn, mode, str, e) -> Printf.sprintf "Recursive error in 'mkdir %s' in 'chmod %04o %s': %s" dn mode dn str | #exc -> "") in let mode_apply = FileUtilMode.apply ~is_dir:true ~umask:(umask (`Octal (fun i -> i))) in let mode_self = match mode with | Some (`Octal m) -> m | Some (`Symbolic t) -> mode_apply 0o777 t | None -> umask_apply 0o0777 in let mode_parent = umask (`Symbolic (fun t -> mode_apply 0 (t @ [`User (`Add (`List [`Write; `Exec]))]))) in let rec mkdir_simple mode dn = if test_exists dn then begin if test (Not Is_dir) dn then handle_error ~fatal:true (`DirnameAlreadyUsed dn); end else begin if parent then mkdir_simple mode_parent (dirname dn); try Unix.mkdir dn mode; chmod ~error:(fun str e -> handle_error ~fatal:true (`MkdirChmod (dn, mode, str, e))) (`Octal mode) [dn] with Unix.Unix_error(Unix.ENOENT, _, _) | Unix.Unix_error(Unix.ENOTDIR, _, _) -> handle_error ~fatal:true (`MissingComponentPath dn) | e -> handle_exception ~fatal:true e end in mkdir_simple mode_self dn