├── .gitignore ├── CHANGES.md ├── LICENSE.txt ├── Makefile ├── README.md ├── _headache.config ├── _header ├── dune-project ├── fileutils.opam ├── src └── lib │ └── fileutils │ ├── CommonPath.ml │ ├── ExtensionPath.ml │ ├── FilePath.ml │ ├── FilePath.mli │ ├── FilePath_type.ml │ ├── FileStringExt.ml │ ├── FileUtil.ml │ ├── FileUtil.mli │ ├── FileUtilCHMOD.ml │ ├── FileUtilCMP.ml │ ├── FileUtilCP.ml │ ├── FileUtilDU.ml │ ├── FileUtilFIND.ml │ ├── FileUtilLS.ml │ ├── FileUtilMKDIR.ml │ ├── FileUtilMV.ml │ ├── FileUtilMisc.ml │ ├── FileUtilMode.ml │ ├── FileUtilPWD.ml │ ├── FileUtilPermission.ml │ ├── FileUtilREADLINK.ml │ ├── FileUtilRM.ml │ ├── FileUtilSTAT.ml │ ├── FileUtilSize.ml │ ├── FileUtilTEST.ml │ ├── FileUtilTOUCH.ml │ ├── FileUtilTypes.ml │ ├── FileUtilUMASK.ml │ ├── FileUtilWHICH.ml │ ├── UnixPath.ml │ ├── Win32Path.ml │ ├── dune │ └── str │ ├── FileUtilStr.ml │ └── dune └── test ├── BenchFind.ml ├── dune └── test.ml /.gitignore: -------------------------------------------------------------------------------- 1 | /_build/ 2 | /_opam/ 3 | /dist/ 4 | /test/oUnit.log 5 | /website/website-tools/ 6 | /website/dist/ 7 | *.merlin 8 | *.swp 9 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | ## v0.6.6 - 2024-12-28 2 | 3 | ### Fixed 4 | 5 | - Remove useless dependencies (stdlib-shims and seq) which are shipped with 6 | OCaml 4.14+. 7 | 8 | ## v0.6.5 - 2024-12-27 9 | 10 | ### Fixed 11 | 12 | - `cmp` returns None when comparing two identical files and add some tests for 13 | that. (thanks to jamesjer). 14 | - require OCaml > 4.14, which is now the default in Debian stable. 15 | 16 | ## v0.6.4 - 2022-10-28 17 | 18 | ### Fixed 19 | 20 | - Fix documentation for FilePath.is_updir and FilePath.is_subdir. Thanks to 21 | dmbaturin for the contribution. 22 | - Support for OCaml 5 (thanks to Leonidas-from-XIV and kit-ty-kate) 23 | 24 | 25 | ## v0.6.3 - 2020-07-11 26 | 27 | ### Fixed 28 | 29 | - Fix mkdir when trying to create directory with ~parent:true and a directory 30 | ending with "/". For example: 31 | ``` 32 | mkdir ~parent:true "non-existent/" 33 | ``` 34 | (Closes: #14) 35 | 36 | ## v0.6.2 - 2020-03-26 37 | 38 | ### Fixed 39 | 40 | - Improve documentation: 41 | - hide modules for the implementation. 42 | - clarify usage of chop_extension/add_extension. 43 | - Move fileutils and fileutils.str in their own directories. 44 | 45 | ## v0.6.1 - 2019-09-12 46 | 47 | ### Fixed 48 | 49 | - Migrate the build system to dune (thanks to zapashcanon). 50 | - Migrate CHANGELOG to CHANGES for dune-release. 51 | 52 | ## v0.6.0 - 2019-08-25 53 | 54 | ### Fixed 55 | 56 | - Migrate CHANGELOG to [Keep a Changelog] format. 57 | - umask returns 0 on Windows, this is consistent with 58 | [Perl, Python and Ruby 59 | behavior](https://github.com/gildor478/ocaml-fileutils/pull/6#issuecomment-509062371). 60 | Thanks to @dmbaturin. 61 | 62 | ### Removed 63 | 64 | - Support for MacOS 9, since OCaml doesn't support it since 3.09 (Closes: #8). 65 | 66 | ## v0.5.3 - 2017-11-12 67 | 68 | * Minor release: 69 | - Use bytes rather than string to be compatible with OCaml 4.06.0. 70 | (Closes: #5) 71 | 72 | ## v0.5.2 - 2017-05-23 73 | 74 | * Minor release: 75 | - Test file existence with Unix.LargeFile.lstat in FileUtilRM. 76 | (Closes: OF#1749) 77 | 78 | ## v0.5.1 - 2016-11-02 79 | 80 | * Minor release: 81 | - Fix non POSIX behavior of cp with links when "recurse:false". 82 | (Closes: OF#1649) 83 | 84 | ## v0.5.0 - 2015-07-10 85 | 86 | * Major release to account all the API changes: 87 | * Rebuild the exception/reporting framework: 88 | - Remove exceptions in favor of a single exception per command and a 89 | polymorphic variant tag. 90 | - Use a reporting function that can be passed as a parameter 91 | [?error:'a error_handler] to most of the functions. 92 | * Reimplement functions to be more POSIX compliant implementation (Closes: OF#761): 93 | (functions: cp, umask, chmod, mkdir, rm, mv, touch) 94 | * Make sure dead symlinks are handled properly (Closes: OF#712, OF#711): 95 | - derefenced when needed (functions: test) 96 | - offer the choice when possible (function: stat) 97 | * Implement symbolic mode that may have contextual meaning. 98 | * Improve documentation (add links to POSIX doc, reorganize content in section). 99 | * Split FileUtil.ml into multiple files. 100 | * Implement chmod (Closes: OF#416). 101 | * [cp] now propagate timestamp when invoked with [~preserve] (Closes: OF#709). 102 | * Upgrade OUnit to OUnit2. 103 | * Fix typo in cp (Closes: OF#816, OF#1317). 104 | 105 | ## v0.4.5 - 2013-06-03 106 | 107 | * Fix fd leaking cmp (Closes: OF#1012). 108 | * Fix test suite for BSD system. 109 | 110 | ## v0.4.4 - 2012-06-12 111 | 112 | * Regenerate with oasis 0.3.0~rc6 113 | 114 | ## v0.4.3 - 2011-05-26 115 | 116 | * OASIS enabled 117 | 118 | ## v0.4.2 - 2010-09-06 119 | 120 | * Apply patch from Rüdiger Schmitt, fix handling for '.' in find and ls 121 | (Close: OF#418, OF#736) 122 | 123 | ## v0.4.1 - 2010-09-01 124 | 125 | * Apply patch from S. Glondu to use the right find function in FileUtilStr 126 | (Closes: OF#731) 127 | * Fix some typo in documentation 128 | * Apply patch from Debian to use a byte plugin for ocamlbuild 129 | 130 | ## v0.4.0 - 2009-09-09 131 | 132 | * Simplify interface, avoid nested module when possible: 133 | * Add filename information to all exception 134 | * FileUtil: 135 | * size is now a 64bits integer, functions are restricted to 4 most useful 136 | operations 137 | * Str match is now separated into another module (FileUtilStr, package 138 | fileutils-str) 139 | * All operations are now directly in FileUtil and not in FileUtil.StrUtil 140 | * FilePath: 141 | * Remove is_implicit, use is_relative as replacement 142 | * All functions of FilePath.DefaultPath are now directly accessible in 143 | FilePath 144 | * Default operation on string, use sub-module Abstract for abstract 145 | operations 146 | * FilePath.reduce don't reduce ".." except if asked to (i.e. no symlink) 147 | * CygwinPath related function use directly UnixPath 148 | * Make documentation more clear 149 | * Introduce fast operation for string filename: when possible to operate 150 | directly on string use it 151 | * Drop parser/lexer for path: this is complicated and not efficient. Prefer 152 | simple string manipulation which is more efficient 153 | * Replace build system by ocamlbuild, ocamlfind, a simple Makefile, 154 | ocaml-autoconf macros and configure 155 | * Adapt compilation and test to Windows 156 | * Simplify rm and avoid asking question twice (Closes: #FS79) 157 | * Use Unix.LargeFile to handle huge file (Closes: FS#77) 158 | * Simplify size operation. Now all operation is done on Int64 (Closes: FS#76) 159 | * Implement FileUtilStr that allow Str.regexp match outside the core 160 | FileUtil module (Closes: FS#13) 161 | * Add a wildcard on .a and .lib to allow installation on Windows 162 | (Closes: FS#84) 163 | * Update license header (Closes: FS#8, FS#55) 164 | * Accept "/" as separator for Win32 (Closes: FS#78, FS#83, FS#68) 165 | * For win32, use PATHEXT to locate executable with "which" (Closes: FS#73) 166 | * Don't suppose ".." can be reduced and test it (Closes: FS#10) 167 | * Fix "mv" and allow to copy data between filesystem (Closes: FS#6, FS#7) 168 | * Optimize FileUtil.find speed, now only 2x slower than UNIX find (was 40x slower before) 169 | (Closes: FS#65) 170 | 171 | ## v0.3.0 172 | 173 | * Change the version to 0.3 (lot of changes for a minor version) 174 | * Update webpages 175 | * Correct a bug that prevent sr\@Ltn to be parsed (which comes from the 176 | lexer of UnixPath, there is [^'.''/''\\']* which can produce empty token) 177 | * Correct a bug that prevent to parse the initial current dir (ie produce nothing 178 | when use find "." or find "/a/") 179 | 180 | ## v0.2.2 181 | 182 | * Changes the version to 0.2.2 in TopMakefile.in (closes: FS#33) 183 | * Stop removing Makefile in distclean target (closes: FS#31) 184 | * Change --enable-docdir --enable-builddir to --withXX (closes: FS#32) 185 | * Configure now test that ocamlfind is not detected and that we want to 186 | use ocamlfind (closes: FS#34) 187 | * Correct error concerning parsing of "" as a current dir (closes: FS#40) 188 | * Correct error concerning the test Has_extension (closes: #41) 189 | * Use a new CurrenDir of (Long|Short) to denote the difference between "" and "." 190 | * Implement readlink 191 | * Implement pwd (closes: FS#39) 192 | * Implement cmp (closes: FS#37, FS#38) 193 | * Implement new test: Has_no_extension | Basename_is | Dirname_is 194 | * Implement an anti recursion system (experimental, need to be tested) : 195 | * Use a type action_link: Follow, Skip, SkipInform, AskFollow 196 | * Maitain a set of visited directories 197 | * Implement new test: Is_older_than_date, Is_newer_than_date, Size_bigger_than, 198 | Size_smaller_than, Size_equal_to, Size_fuzzy_equal_to, Custom 199 | * Rewrite the test: Is_older_than, Is_newer_than, now takes only one args 200 | * Implement type size and operation coming along (add, sub, convert, compare, 201 | string_of_size). 202 | * Implement type permission / base_permission and operation coming along ( 203 | permission_of_int, int_of_permission). 204 | * Implement type kind (Dir, File...). 205 | * Implement function stat 206 | * Rewrite find, in order to be able to execute codes foreach filename. Very useful 207 | for rewriting other functions (rm, cp, mv) 208 | * Use list argument in place of single filename for rm, cp 209 | * Fix a bug that prevent ls to be able to list "" 210 | * Reworked unitary tests: include test for symlink and anti recursion 211 | * Unitary tests change from Fort to OUnit test suite 212 | 213 | ## v0.2.1 214 | 215 | * Minor bug fixes to correct website aspect 216 | 217 | ## v0.2.0 218 | 219 | * Use module/functor to abstract a lot of operation. 220 | * Generate a decent ocamldoc documentation 221 | * Abstract regexp matching using functor 222 | * Separate the sysPath modules in two: Abstract and not. Abstract 223 | permits to parse once and for all the filename, and then operate 224 | on it. It allows to handle fast all operation. Concrete module 225 | are only proxy that do the conversion to/from the Abstract 226 | implementation. 227 | * Introduce relation (updir, subdir, compare) to allow manipulating 228 | filename in classical structure (Set, Map...) 229 | * Rename sysPath, sysUtil to filePath, fileUtil since it appears that it is 230 | more consistent regarding the name of the library (i was not convinced, that 231 | sysPath represents anything). 232 | 233 | ## v0.1.1 - 2004-01-30 234 | 235 | * Fix some weird comportement with reduce (especially 236 | when trying to reduce filename which try to .. a root) 237 | and add the possibility to reduce relative filename 238 | * Rework on the way everything is made : 239 | * Support 4 different scheme of filename (Unix (the 240 | native way), MacOS, Win32, Cygwin) 241 | * Each scheme use a parser/lexer to decompose his 242 | filename and a .ml to handle the whole discriminant 243 | element of a specific scheme (ie the way filename are 244 | decomposed and the way path like variable are decomposed) 245 | * All the operation are defined relatively to the 246 | discriminant operation in a functorized module 247 | * Each scheme produces a module from his discriminant element 248 | and from the generic operation. These modules are defined in 249 | SysPath.{UnixPath|Win32Path|CygwinPath|MacOSPath}. 250 | * Depending on the current environement one of the module above 251 | is the default binding for all the operation. 252 | * Add SysUtil which try to create some portable file operation : 253 | mv, cp, touch, mkdir, test, find. This module abandon any non 254 | cross platform operation and will never support it (ie links for 255 | example, won't be supported). 256 | * This release is an alpha release. 0.2 will be the stable one. 257 | 258 | 259 | ## BTS references 260 | 261 | * FS#XX: Flyspray BTS (pre-2008) 262 | * OF#XX: OCaml Forge BTS (pre-2019) 263 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | As a special exception to the GNU Lesser General Public License, you 2 | may link, statically or dynamically, a "work that uses the Library" 3 | with a publicly distributed version of the Library to produce an 4 | executable file containing portions of the Library, and distribute that 5 | executable file under terms of your choice, without any of the 6 | additional requirements listed in clause 6 of the GNU Library General 7 | Public License. By "a publicly distributed version of the Library", we 8 | mean either the unmodified Library as distributed by INRIA, or a 9 | modified version of the Library that is distributed under the 10 | conditions defined in clause 3 of the GNU Library General Public 11 | License. This exception does not however invalidate any other reasons 12 | why the executable file might be covered by the GNU Library General 13 | Public License. 14 | 15 | ----------------------------------------------------------------------- 16 | GNU LESSER GENERAL PUBLIC LICENSE 17 | Version 2.1, February 1999 18 | 19 | Copyright (C) 1991, 1999 Free Software Foundation, Inc. 20 | 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 21 | Everyone is permitted to copy and distribute verbatim copies 22 | of this license document, but changing it is not allowed. 23 | 24 | [This is the first released version of the Lesser GPL. It also counts 25 | as the successor of the GNU Library Public License, version 2, hence 26 | the version number 2.1.] 27 | 28 | Preamble 29 | 30 | The licenses for most software are designed to take away your 31 | freedom to share and change it. By contrast, the GNU General Public 32 | Licenses are intended to guarantee your freedom to share and change 33 | free software--to make sure the software is free for all its users. 34 | 35 | This license, the Lesser General Public License, applies to some 36 | specially designated software packages--typically libraries--of the 37 | Free Software Foundation and other authors who decide to use it. You 38 | can use it too, but we suggest you first think carefully about whether 39 | this license or the ordinary General Public License is the better 40 | strategy to use in any particular case, based on the explanations 41 | below. 42 | 43 | When we speak of free software, we are referring to freedom of use, 44 | not price. Our General Public Licenses are designed to make sure that 45 | you have the freedom to distribute copies of free software (and charge 46 | for this service if you wish); that you receive source code or can get 47 | it if you want it; that you can change the software and use pieces of 48 | it in new free programs; and that you are informed that you can do 49 | these things. 50 | 51 | To protect your rights, we need to make restrictions that forbid 52 | distributors to deny you these rights or to ask you to surrender these 53 | rights. These restrictions translate to certain responsibilities for 54 | you if you distribute copies of the library or if you modify it. 55 | 56 | For example, if you distribute copies of the library, whether gratis 57 | or for a fee, you must give the recipients all the rights that we gave 58 | you. You must make sure that they, too, receive or can get the source 59 | code. If you link other code with the library, you must provide 60 | complete object files to the recipients, so that they can relink them 61 | with the library after making changes to the library and recompiling 62 | it. And you must show them these terms so they know their rights. 63 | 64 | We protect your rights with a two-step method: (1) we copyright the 65 | library, and (2) we offer you this license, which gives you legal 66 | permission to copy, distribute and/or modify the library. 67 | 68 | To protect each distributor, we want to make it very clear that 69 | there is no warranty for the free library. Also, if the library is 70 | modified by someone else and passed on, the recipients should know 71 | that what they have is not the original version, so that the original 72 | author's reputation will not be affected by problems that might be 73 | introduced by others. 74 | 75 | Finally, software patents pose a constant threat to the existence of 76 | any free program. We wish to make sure that a company cannot 77 | effectively restrict the users of a free program by obtaining a 78 | restrictive license from a patent holder. Therefore, we insist that 79 | any patent license obtained for a version of the library must be 80 | consistent with the full freedom of use specified in this license. 81 | 82 | Most GNU software, including some libraries, is covered by the 83 | ordinary GNU General Public License. This license, the GNU Lesser 84 | General Public License, applies to certain designated libraries, and 85 | is quite different from the ordinary General Public License. We use 86 | this license for certain libraries in order to permit linking those 87 | libraries into non-free programs. 88 | 89 | When a program is linked with a library, whether statically or using 90 | a shared library, the combination of the two is legally speaking a 91 | combined work, a derivative of the original library. The ordinary 92 | General Public License therefore permits such linking only if the 93 | entire combination fits its criteria of freedom. The Lesser General 94 | Public License permits more lax criteria for linking other code with 95 | the library. 96 | 97 | We call this license the "Lesser" General Public License because it 98 | does Less to protect the user's freedom than the ordinary General 99 | Public License. It also provides other free software developers Less 100 | of an advantage over competing non-free programs. These disadvantages 101 | are the reason we use the ordinary General Public License for many 102 | libraries. However, the Lesser license provides advantages in certain 103 | special circumstances. 104 | 105 | For example, on rare occasions, there may be a special need to 106 | encourage the widest possible use of a certain library, so that it 107 | becomes a de-facto standard. To achieve this, non-free programs must 108 | be allowed to use the library. A more frequent case is that a free 109 | library does the same job as widely used non-free libraries. In this 110 | case, there is little to gain by limiting the free library to free 111 | software only, so we use the Lesser General Public License. 112 | 113 | In other cases, permission to use a particular library in non-free 114 | programs enables a greater number of people to use a large body of 115 | free software. For example, permission to use the GNU C Library in 116 | non-free programs enables many more people to use the whole GNU 117 | operating system, as well as its variant, the GNU/Linux operating 118 | system. 119 | 120 | Although the Lesser General Public License is Less protective of the 121 | users' freedom, it does ensure that the user of a program that is 122 | linked with the Library has the freedom and the wherewithal to run 123 | that program using a modified version of the Library. 124 | 125 | The precise terms and conditions for copying, distribution and 126 | modification follow. Pay close attention to the difference between a 127 | "work based on the library" and a "work that uses the library". The 128 | former contains code derived from the library, whereas the latter must 129 | be combined with the library in order to run. 130 | 131 | GNU LESSER GENERAL PUBLIC LICENSE 132 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 133 | 134 | 0. This License Agreement applies to any software library or other 135 | program which contains a notice placed by the copyright holder or 136 | other authorized party saying it may be distributed under the terms of 137 | this Lesser General Public License (also called "this License"). 138 | Each licensee is addressed as "you". 139 | 140 | A "library" means a collection of software functions and/or data 141 | prepared so as to be conveniently linked with application programs 142 | (which use some of those functions and data) to form executables. 143 | 144 | The "Library", below, refers to any such software library or work 145 | which has been distributed under these terms. A "work based on the 146 | Library" means either the Library or any derivative work under 147 | copyright law: that is to say, a work containing the Library or a 148 | portion of it, either verbatim or with modifications and/or translated 149 | straightforwardly into another language. (Hereinafter, translation is 150 | included without limitation in the term "modification".) 151 | 152 | "Source code" for a work means the preferred form of the work for 153 | making modifications to it. For a library, complete source code means 154 | all the source code for all modules it contains, plus any associated 155 | interface definition files, plus the scripts used to control 156 | compilation and installation of the library. 157 | 158 | Activities other than copying, distribution and modification are not 159 | covered by this License; they are outside its scope. The act of 160 | running a program using the Library is not restricted, and output from 161 | such a program is covered only if its contents constitute a work based 162 | on the Library (independent of the use of the Library in a tool for 163 | writing it). Whether that is true depends on what the Library does 164 | and what the program that uses the Library does. 165 | 166 | 1. You may copy and distribute verbatim copies of the Library's 167 | complete source code as you receive it, in any medium, provided that 168 | you conspicuously and appropriately publish on each copy an 169 | appropriate copyright notice and disclaimer of warranty; keep intact 170 | all the notices that refer to this License and to the absence of any 171 | warranty; and distribute a copy of this License along with the 172 | Library. 173 | 174 | You may charge a fee for the physical act of transferring a copy, 175 | and you may at your option offer warranty protection in exchange for a 176 | fee. 177 | 178 | 2. You may modify your copy or copies of the Library or any portion 179 | of it, thus forming a work based on the Library, and copy and 180 | distribute such modifications or work under the terms of Section 1 181 | above, provided that you also meet all of these conditions: 182 | 183 | a) The modified work must itself be a software library. 184 | 185 | b) You must cause the files modified to carry prominent notices 186 | stating that you changed the files and the date of any change. 187 | 188 | c) You must cause the whole of the work to be licensed at no 189 | charge to all third parties under the terms of this License. 190 | 191 | d) If a facility in the modified Library refers to a function or a 192 | table of data to be supplied by an application program that uses 193 | the facility, other than as an argument passed when the facility 194 | is invoked, then you must make a good faith effort to ensure that, 195 | in the event an application does not supply such function or 196 | table, the facility still operates, and performs whatever part of 197 | its purpose remains meaningful. 198 | 199 | (For example, a function in a library to compute square roots has 200 | a purpose that is entirely well-defined independent of the 201 | application. Therefore, Subsection 2d requires that any 202 | application-supplied function or table used by this function must 203 | be optional: if the application does not supply it, the square 204 | root function must still compute square roots.) 205 | 206 | These requirements apply to the modified work as a whole. If 207 | identifiable sections of that work are not derived from the Library, 208 | and can be reasonably considered independent and separate works in 209 | themselves, then this License, and its terms, do not apply to those 210 | sections when you distribute them as separate works. But when you 211 | distribute the same sections as part of a whole which is a work based 212 | on the Library, the distribution of the whole must be on the terms of 213 | this License, whose permissions for other licensees extend to the 214 | entire whole, and thus to each and every part regardless of who wrote 215 | it. 216 | 217 | Thus, it is not the intent of this section to claim rights or contest 218 | your rights to work written entirely by you; rather, the intent is to 219 | exercise the right to control the distribution of derivative or 220 | collective works based on the Library. 221 | 222 | In addition, mere aggregation of another work not based on the Library 223 | with the Library (or with a work based on the Library) on a volume of 224 | a storage or distribution medium does not bring the other work under 225 | the scope of this License. 226 | 227 | 3. You may opt to apply the terms of the ordinary GNU General Public 228 | License instead of this License to a given copy of the Library. To do 229 | this, you must alter all the notices that refer to this License, so 230 | that they refer to the ordinary GNU General Public License, version 2, 231 | instead of to this License. (If a newer version than version 2 of the 232 | ordinary GNU General Public License has appeared, then you can specify 233 | that version instead if you wish.) Do not make any other change in 234 | these notices. 235 | 236 | Once this change is made in a given copy, it is irreversible for 237 | that copy, so the ordinary GNU General Public License applies to all 238 | subsequent copies and derivative works made from that copy. 239 | 240 | This option is useful when you wish to copy part of the code of 241 | the Library into a program that is not a library. 242 | 243 | 4. You may copy and distribute the Library (or a portion or 244 | derivative of it, under Section 2) in object code or executable form 245 | under the terms of Sections 1 and 2 above provided that you accompany 246 | it with the complete corresponding machine-readable source code, which 247 | must be distributed under the terms of Sections 1 and 2 above on a 248 | medium customarily used for software interchange. 249 | 250 | If distribution of object code is made by offering access to copy 251 | from a designated place, then offering equivalent access to copy the 252 | source code from the same place satisfies the requirement to 253 | distribute the source code, even though third parties are not 254 | compelled to copy the source along with the object code. 255 | 256 | 5. A program that contains no derivative of any portion of the 257 | Library, but is designed to work with the Library by being compiled or 258 | linked with it, is called a "work that uses the Library". Such a 259 | work, in isolation, is not a derivative work of the Library, and 260 | therefore falls outside the scope of this License. 261 | 262 | However, linking a "work that uses the Library" with the Library 263 | creates an executable that is a derivative of the Library (because it 264 | contains portions of the Library), rather than a "work that uses the 265 | library". The executable is therefore covered by this License. 266 | Section 6 states terms for distribution of such executables. 267 | 268 | When a "work that uses the Library" uses material from a header file 269 | that is part of the Library, the object code for the work may be a 270 | derivative work of the Library even though the source code is not. 271 | Whether this is true is especially significant if the work can be 272 | linked without the Library, or if the work is itself a library. The 273 | threshold for this to be true is not precisely defined by law. 274 | 275 | If such an object file uses only numerical parameters, data 276 | structure layouts and accessors, and small macros and small inline 277 | functions (ten lines or less in length), then the use of the object 278 | file is unrestricted, regardless of whether it is legally a derivative 279 | work. (Executables containing this object code plus portions of the 280 | Library will still fall under Section 6.) 281 | 282 | Otherwise, if the work is a derivative of the Library, you may 283 | distribute the object code for the work under the terms of Section 6. 284 | Any executables containing that work also fall under Section 6, 285 | whether or not they are linked directly with the Library itself. 286 | 287 | 6. As an exception to the Sections above, you may also combine or 288 | link a "work that uses the Library" with the Library to produce a 289 | work containing portions of the Library, and distribute that work 290 | under terms of your choice, provided that the terms permit 291 | modification of the work for the customer's own use and reverse 292 | engineering for debugging such modifications. 293 | 294 | You must give prominent notice with each copy of the work that the 295 | Library is used in it and that the Library and its use are covered by 296 | this License. You must supply a copy of this License. If the work 297 | during execution displays copyright notices, you must include the 298 | copyright notice for the Library among them, as well as a reference 299 | directing the user to the copy of this License. Also, you must do one 300 | of these things: 301 | 302 | a) Accompany the work with the complete corresponding 303 | machine-readable source code for the Library including whatever 304 | changes were used in the work (which must be distributed under 305 | Sections 1 and 2 above); and, if the work is an executable linked 306 | with the Library, with the complete machine-readable "work that 307 | uses the Library", as object code and/or source code, so that the 308 | user can modify the Library and then relink to produce a modified 309 | executable containing the modified Library. (It is understood 310 | that the user who changes the contents of definitions files in the 311 | Library will not necessarily be able to recompile the application 312 | to use the modified definitions.) 313 | 314 | b) Use a suitable shared library mechanism for linking with the 315 | Library. A suitable mechanism is one that (1) uses at run time a 316 | copy of the library already present on the user's computer system, 317 | rather than copying library functions into the executable, and (2) 318 | will operate properly with a modified version of the library, if 319 | the user installs one, as long as the modified version is 320 | interface-compatible with the version that the work was made with. 321 | 322 | c) Accompany the work with a written offer, valid for at least 323 | three years, to give the same user the materials specified in 324 | Subsection 6a, above, for a charge no more than the cost of 325 | performing this distribution. 326 | 327 | d) If distribution of the work is made by offering access to copy 328 | from a designated place, offer equivalent access to copy the above 329 | specified materials from the same place. 330 | 331 | e) Verify that the user has already received a copy of these 332 | materials or that you have already sent this user a copy. 333 | 334 | For an executable, the required form of the "work that uses the 335 | Library" must include any data and utility programs needed for 336 | reproducing the executable from it. However, as a special exception, 337 | the materials to be distributed need not include anything that is 338 | normally distributed (in either source or binary form) with the major 339 | components (compiler, kernel, and so on) of the operating system on 340 | which the executable runs, unless that component itself accompanies 341 | the executable. 342 | 343 | It may happen that this requirement contradicts the license 344 | restrictions of other proprietary libraries that do not normally 345 | accompany the operating system. Such a contradiction means you cannot 346 | use both them and the Library together in an executable that you 347 | distribute. 348 | 349 | 7. You may place library facilities that are a work based on the 350 | Library side-by-side in a single library together with other library 351 | facilities not covered by this License, and distribute such a combined 352 | library, provided that the separate distribution of the work based on 353 | the Library and of the other library facilities is otherwise 354 | permitted, and provided that you do these two things: 355 | 356 | a) Accompany the combined library with a copy of the same work 357 | based on the Library, uncombined with any other library 358 | facilities. This must be distributed under the terms of the 359 | Sections above. 360 | 361 | b) Give prominent notice with the combined library of the fact 362 | that part of it is a work based on the Library, and explaining 363 | where to find the accompanying uncombined form of the same work. 364 | 365 | 8. You may not copy, modify, sublicense, link with, or distribute 366 | the Library except as expressly provided under this License. Any 367 | attempt otherwise to copy, modify, sublicense, link with, or 368 | distribute the Library is void, and will automatically terminate your 369 | rights under this License. However, parties who have received copies, 370 | or rights, from you under this License will not have their licenses 371 | terminated so long as such parties remain in full compliance. 372 | 373 | 9. You are not required to accept this License, since you have not 374 | signed it. However, nothing else grants you permission to modify or 375 | distribute the Library or its derivative works. These actions are 376 | prohibited by law if you do not accept this License. Therefore, by 377 | modifying or distributing the Library (or any work based on the 378 | Library), you indicate your acceptance of this License to do so, and 379 | all its terms and conditions for copying, distributing or modifying 380 | the Library or works based on it. 381 | 382 | 10. Each time you redistribute the Library (or any work based on the 383 | Library), the recipient automatically receives a license from the 384 | original licensor to copy, distribute, link with or modify the Library 385 | subject to these terms and conditions. You may not impose any further 386 | restrictions on the recipients' exercise of the rights granted herein. 387 | You are not responsible for enforcing compliance by third parties with 388 | this License. 389 | 390 | 11. If, as a consequence of a court judgment or allegation of patent 391 | infringement or for any other reason (not limited to patent issues), 392 | conditions are imposed on you (whether by court order, agreement or 393 | otherwise) that contradict the conditions of this License, they do not 394 | excuse you from the conditions of this License. If you cannot 395 | distribute so as to satisfy simultaneously your obligations under this 396 | License and any other pertinent obligations, then as a consequence you 397 | may not distribute the Library at all. For example, if a patent 398 | license would not permit royalty-free redistribution of the Library by 399 | all those who receive copies directly or indirectly through you, then 400 | the only way you could satisfy both it and this License would be to 401 | refrain entirely from distribution of the Library. 402 | 403 | If any portion of this section is held invalid or unenforceable under 404 | any particular circumstance, the balance of the section is intended to 405 | apply, and the section as a whole is intended to apply in other 406 | circumstances. 407 | 408 | It is not the purpose of this section to induce you to infringe any 409 | patents or other property right claims or to contest validity of any 410 | such claims; this section has the sole purpose of protecting the 411 | integrity of the free software distribution system which is 412 | implemented by public license practices. Many people have made 413 | generous contributions to the wide range of software distributed 414 | through that system in reliance on consistent application of that 415 | system; it is up to the author/donor to decide if he or she is willing 416 | to distribute software through any other system and a licensee cannot 417 | impose that choice. 418 | 419 | This section is intended to make thoroughly clear what is believed to 420 | be a consequence of the rest of this License. 421 | 422 | 12. If the distribution and/or use of the Library is restricted in 423 | certain countries either by patents or by copyrighted interfaces, the 424 | original copyright holder who places the Library under this License 425 | may add an explicit geographical distribution limitation excluding those 426 | countries, so that distribution is permitted only in or among 427 | countries not thus excluded. In such case, this License incorporates 428 | the limitation as if written in the body of this License. 429 | 430 | 13. The Free Software Foundation may publish revised and/or new 431 | versions of the Lesser General Public License from time to time. 432 | Such new versions will be similar in spirit to the present version, 433 | but may differ in detail to address new problems or concerns. 434 | 435 | Each version is given a distinguishing version number. If the Library 436 | specifies a version number of this License which applies to it and 437 | "any later version", you have the option of following the terms and 438 | conditions either of that version or of any later version published by 439 | the Free Software Foundation. If the Library does not specify a 440 | license version number, you may choose any version ever published by 441 | the Free Software Foundation. 442 | 443 | 14. If you wish to incorporate parts of the Library into other free 444 | programs whose distribution conditions are incompatible with these, 445 | write to the author to ask for permission. For software which is 446 | copyrighted by the Free Software Foundation, write to the Free 447 | Software Foundation; we sometimes make exceptions for this. Our 448 | decision will be guided by the two goals of preserving the free status 449 | of all derivatives of our free software and of promoting the sharing 450 | and reuse of software generally. 451 | 452 | NO WARRANTY 453 | 454 | 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO 455 | WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 456 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR 457 | OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY 458 | KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE 459 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 460 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 461 | LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME 462 | THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 463 | 464 | 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN 465 | WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY 466 | AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU 467 | FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR 468 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 469 | LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 470 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 471 | FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 472 | SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 473 | DAMAGES. 474 | 475 | END OF TERMS AND CONDITIONS 476 | 477 | How to Apply These Terms to Your New Libraries 478 | 479 | If you develop a new library, and you want it to be of the greatest 480 | possible use to the public, we recommend making it free software that 481 | everyone can redistribute and change. You can do so by permitting 482 | redistribution under these terms (or, alternatively, under the terms 483 | of the ordinary General Public License). 484 | 485 | To apply these terms, attach the following notices to the library. 486 | It is safest to attach them to the start of each source file to most 487 | effectively convey the exclusion of warranty; and each file should 488 | have at least the "copyright" line and a pointer to where the full 489 | notice is found. 490 | 491 | 492 | 493 | Copyright (C) 494 | 495 | This library is free software; you can redistribute it and/or 496 | modify it under the terms of the GNU Lesser General Public 497 | License as published by the Free Software Foundation; either 498 | version 2.1 of the License, or (at your option) any later version. 499 | 500 | This library is distributed in the hope that it will be useful, 501 | but WITHOUT ANY WARRANTY; without even the implied warranty of 502 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 503 | Lesser General Public License for more details. 504 | 505 | You should have received a copy of the GNU Lesser General Public 506 | License along with this library; if not, write to the Free Software 507 | Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 508 | 509 | Also add information on how to contact you by electronic and paper mail. 510 | 511 | You should also get your employer (if you work as a programmer) or 512 | your school, if any, to sign a "copyright disclaimer" for the library, 513 | if necessary. Here is a sample; alter the names: 514 | 515 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 516 | library `Frob' (a library for tweaking knobs) written by James 517 | Random Hacker. 518 | 519 | , 1 April 1990 520 | Ty Coon, President of Vice 521 | 522 | That's all there is to it! 523 | 524 | 525 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # ocaml-fileutils: files and filenames common operations # 3 | # # 4 | # Copyright (C) 2003-2014, Sylvain Le Gall # 5 | # # 6 | # This library is free software; you can redistribute it and/or modify it # 7 | # under the terms of the GNU Lesser General Public License as published by # 8 | # the Free Software Foundation; either version 2.1 of the License, or (at # 9 | # your option) any later version, with the OCaml static compilation # 10 | # exception. # 11 | # # 12 | # This library is distributed in the hope that it will be useful, but # 13 | # WITHOUT ANY WARRANTY; without even the implied warranty of # 14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file # 15 | # COPYING for more details. # 16 | # # 17 | # You should have received a copy of the GNU Lesser General Public License # 18 | # along with this library; if not, write to the Free Software Foundation, # 19 | # Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA # 20 | ############################################################################## 21 | 22 | default: test 23 | 24 | build: 25 | dune build 26 | 27 | doc: 28 | dune build @doc 29 | 30 | test: 31 | dune runtest 32 | 33 | all: 34 | dune build @all 35 | 36 | install: all 37 | dune install 38 | 39 | uninstall: 40 | dune uninstall 41 | 42 | clean: 43 | dune clean 44 | 45 | bench: 46 | dune exec test/benchFind.exe 47 | 48 | .PHONY: build doc test all install uninstall clean 49 | 50 | # Precommit target 51 | # Check style of code. 52 | PRECOMMIT_ARGS= \ 53 | --exclude Makefile 54 | 55 | precommit: 56 | -@if command -v OCamlPrecommit > /dev/null; then \ 57 | OCamlPrecommit $(PRECOMMIT_ARGS); \ 58 | else \ 59 | echo "Skipping precommit checks.";\ 60 | fi 61 | 62 | precommit-full: 63 | OCamlPrecommit --full $(PRECOMMIT_ARGS) 64 | 65 | test: precommit 66 | 67 | .PHONY: precommit 68 | 69 | # Headache target 70 | # Fix license header of file. 71 | 72 | headache: 73 | find ./ \ 74 | -name _darcs -prune -false -o \ 75 | -name .git -prune -false -o \ 76 | -name _build -prune -false -o \ 77 | -type f \ 78 | | xargs headache -h _header -c _headache.config 79 | 80 | .PHONY: headache 81 | 82 | # Deploy target 83 | # Deploy/release the software. 84 | 85 | deploy: doc 86 | dune-release tag 87 | git push --all 88 | git push --tag 89 | dune-release 90 | 91 | .PHONY: deploy 92 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Fileutils - OCaml API to manipulate real files (POSIX like) and filenames 2 | ========================================================================= 3 | 4 | [![OCaml-CI Build Status](https://img.shields.io/endpoint?url=https://ci.ocamllabs.io/badge/gildor478/ocaml-fileutils/master&logo=ocaml)](https://ci.ocamllabs.io/github/gildor478/ocaml-fileutils) 5 | 6 | Features of the project: 7 | 8 | * pure OCaml 9 | * file functions inspired from GNU fileutils (aiming to be POSIX compatible) 10 | * cp: copy files and directories 11 | * mv: rename files and directories 12 | * rm: remove files and directories 13 | * test: check file types and compare values 14 | * find: find files that match certain criteria 15 | * mkdir: create directory and its parents 16 | * ls: list content of a directory 17 | * touch: change file timestamps 18 | * which: locate a command 19 | * readlink: resolve symlink 20 | * du: compute disk usage 21 | * stat: abstract of Unix.stat 22 | * cmp: compare files 23 | * chmod: change permissions of a file 24 | * filename functions support Win32/Unix/MacOS and Cygwin filenames: 25 | * Compare: is_subdir, is_updir, compare 26 | * Transform: make_absolute, make_relative, reduce 27 | * Extension: chop_extension, check_extension 28 | 29 | [travis]: https://travis-ci.org/gildor478/ocaml-fileutils 30 | [travis-img]: https://travis-ci.org/gildor478/ocaml-fileutils.svg?branch=master 31 | [appveyor]: https://ci.appveyor.com/project/gildor478/ocaml-fileutils/branch/master 32 | [appveyor-img]: https://ci.appveyor.com/api/projects/status/pddhb2c22rc8wtd3/branch/master?svg=true 33 | [opam]: https://opam.ocaml.org 34 | 35 | Installation 36 | ------------ 37 | 38 | The recommended way to install fileutils is via the [opam package manager][opam]: 39 | 40 | ```sh 41 | $ opam install fileutils 42 | ``` 43 | 44 | Documentation 45 | ------------- 46 | 47 | API documentation is 48 | [available online](https://gildor478.github.io/ocaml-fileutils). 49 | -------------------------------------------------------------------------------- /_headache.config: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | # ocaml-fileutils: files and filenames common operations # 3 | # # 4 | # Copyright (C) 2003-2014, Sylvain Le Gall # 5 | # # 6 | # This library is free software; you can redistribute it and/or modify it # 7 | # under the terms of the GNU Lesser General Public License as published by # 8 | # the Free Software Foundation; either version 2.1 of the License, or (at # 9 | # your option) any later version, with the OCaml static compilation # 10 | # exception. # 11 | # # 12 | # This library is distributed in the hope that it will be useful, but # 13 | # WITHOUT ANY WARRANTY; without even the implied warranty of # 14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file # 15 | # COPYING for more details. # 16 | # # 17 | # You should have received a copy of the GNU Lesser General Public License # 18 | # along with this library; if not, write to the Free Software Foundation, # 19 | # Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA # 20 | ############################################################################## 21 | 22 | | "aclocal\\.m4" -> no 23 | | ".*\\.patch" -> no 24 | | "install-sh" -> no 25 | | "missing" -> no 26 | | "config\\.log" -> no 27 | | "config\\.status" -> no 28 | | "configure" -> no 29 | | ".*\\.sh" -> skip match:"#!.*" 30 | | ".*\\.sh" -> frame open:"#" line:"#" close:"#" 31 | | "autogen\\.sh" -> frame open:"#" line:"#" close:"#" 32 | | "configure\\.in" -> frame open:"dnl *" line:"*" close:"*" 33 | | "configure\\.ac" -> frame open:"dnl *" line:"*" close:"*" 34 | | ".*\\.xml" -> skip match:"<\?xml.*>" 35 | | ".*\\.xml" -> lines open:"" 36 | | ".*\\.ml\\.in" -> frame open:"(*" line:"*" close:"*)" 37 | | ".*\\.ml" -> skip match:"(\\*pp .* \\*)" 38 | | "_headache\\.config" -> frame open:"#" line:"#" close:"#" 39 | | ".*\\.swp" -> no 40 | | ".*\\.po" -> no 41 | | ".*\\.mo" -> no 42 | | "META" -> frame open:"#" line:"#" close:"#" 43 | | "META\\.in" -> frame open:"#" line:"#" close:"#" 44 | | "POTFILES" -> no 45 | | "LINGUAS" -> no 46 | | ".*\\.pot" -> no 47 | | ".*\\.png" -> no 48 | | "\\.announce" -> no 49 | | ".*\\.mllib" -> frame open:"#" line:"#" close:"#" 50 | | ".*\\.itarget" -> frame open:"#" line:"#" close:"#" 51 | | ".*\\.itarget.in" -> frame open:"#" line:"#" close:"#" 52 | | ".*\\.odocl" -> frame open:"#" line:"#" close:"#" 53 | | "_tags" -> frame open:"#" line:"#" close:"#" 54 | | "\\.boring" -> no 55 | | "\\.gitignore" -> no 56 | | ".*\\.txt" -> no 57 | | ".*\.tar\\.gz" -> no 58 | | ".*\.tar\\.gz\\.asc" -> no 59 | | "setup\\.log" -> no 60 | | "setup\\.data" -> no 61 | | ".*\\.bak" -> no 62 | | "_oasis" -> no 63 | | "_header" -> no 64 | | ".*\\.lua" -> no 65 | | ".*\\.py" -> no 66 | | ".*\\.pyc" -> no 67 | | ".*\\.ico" -> no 68 | | ".*\\.mkd\\.tmpl" -> no 69 | | ".*\\.mkd" -> no 70 | | ".*\\.html" -> no 71 | | ".*\\.css" -> frame open:"/*" line:"*" close:"*/" 72 | | ".*\\.svg" -> skip match:"<\?xml.*>" 73 | | ".*\\.svg" -> lines open:"" 74 | -------------------------------------------------------------------------------- /_header: -------------------------------------------------------------------------------- 1 | ocaml-fileutils: files and filenames common operations 2 | 3 | Copyright (C) 2003-2014, Sylvain Le Gall 4 | 5 | This library is free software; you can redistribute it and/or modify it 6 | under the terms of the GNU Lesser General Public License as published by 7 | the Free Software Foundation; either version 2.1 of the License, or (at 8 | your option) any later version, with the OCaml static compilation 9 | exception. 10 | 11 | This library is distributed in the hope that it will be useful, but 12 | WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file 14 | COPYING for more details. 15 | 16 | You should have received a copy of the GNU Lesser General Public License 17 | along with this library; if not, write to the Free Software Foundation, 18 | Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 19 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.9) 2 | (name fileutils) 3 | 4 | (explicit_js_mode) 5 | 6 | (generate_opam_files) 7 | 8 | (source (github gildor478/ocaml-fileutils)) 9 | (license "LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception") 10 | (authors "Sylvain Le Gall") 11 | (maintainers "Sylvain Le Gall ") 12 | (documentation "https://gildor478.github.io/ocaml-fileutils/") 13 | 14 | (package 15 | (name fileutils) 16 | (synopsis "XDG basedir location for data/cache/configuration files") 17 | (description 18 | "\| This library provides an API to perform POSIX like operations on files like: 19 | "\| 20 | "\| - mv 21 | "\| - cp 22 | "\| - rm 23 | "\| - mkdir 24 | "\| - touch 25 | "\| - which... 26 | "\| 27 | "\| It also provides a module to manipulate abstract filenames: 28 | "\| 29 | "\| - classification 30 | "\| - make_relative: made a filename relative to another 31 | "\| - make_absolute 32 | ) 33 | (depends 34 | base-unix 35 | (ounit2 (and (>= 2.0.0) :with-test)) 36 | (ocaml (>= 4.14)))) 37 | -------------------------------------------------------------------------------- /fileutils.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: "XDG basedir location for data/cache/configuration files" 4 | description: """ 5 | This library provides an API to perform POSIX like operations on files like: 6 | 7 | - mv 8 | - cp 9 | - rm 10 | - mkdir 11 | - touch 12 | - which... 13 | 14 | It also provides a module to manipulate abstract filenames: 15 | 16 | - classification 17 | - make_relative: made a filename relative to another 18 | - make_absolute 19 | """ 20 | maintainer: ["Sylvain Le Gall "] 21 | authors: ["Sylvain Le Gall"] 22 | license: "LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception" 23 | homepage: "https://github.com/gildor478/ocaml-fileutils" 24 | doc: "https://gildor478.github.io/ocaml-fileutils/" 25 | bug-reports: "https://github.com/gildor478/ocaml-fileutils/issues" 26 | depends: [ 27 | "dune" {>= "2.9"} 28 | "base-unix" 29 | "ounit2" {>= "2.0.0" & with-test} 30 | "ocaml" {>= "4.14"} 31 | "odoc" {with-doc} 32 | ] 33 | build: [ 34 | ["dune" "subst"] {dev} 35 | [ 36 | "dune" 37 | "build" 38 | "-p" 39 | name 40 | "-j" 41 | jobs 42 | "--promote-install-files=false" 43 | "@install" 44 | "@runtest" {with-test} 45 | "@doc" {with-doc} 46 | ] 47 | ["dune" "install" "-p" name "--create-install-files" name] 48 | ] 49 | dev-repo: "git+https://github.com/gildor478/ocaml-fileutils.git" 50 | -------------------------------------------------------------------------------- /src/lib/fileutils/CommonPath.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | (** A fast operation cannot be done, will 23 | continue by trying more complex processing 24 | *) 25 | 26 | module StringExt = FileStringExt 27 | 28 | exception CannotHandleFast 29 | 30 | 31 | let fast_concat _ _ = raise CannotHandleFast 32 | let fast_basename _ = raise CannotHandleFast 33 | let fast_dirname _ = raise CannotHandleFast 34 | let fast_is_relative _ = raise CannotHandleFast 35 | let fast_is_current _ = raise CannotHandleFast 36 | let fast_is_parent _ = raise CannotHandleFast 37 | -------------------------------------------------------------------------------- /src/lib/fileutils/ExtensionPath.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | (** Manipulate path extension 23 | *) 24 | 25 | let get fn = 26 | let start_pos = 27 | (String.rindex fn '.') + 1 28 | in 29 | let fn_len = 30 | String.length fn 31 | in 32 | if start_pos = fn_len then 33 | "" 34 | else 35 | String.sub fn start_pos (fn_len - start_pos) 36 | 37 | 38 | let check fn ext = 39 | try 40 | (get fn) = ext 41 | with Not_found -> 42 | false 43 | 44 | 45 | let chop fn = 46 | try 47 | let end_pos = 48 | String.rindex fn '.' 49 | in 50 | if end_pos = 0 then 51 | "" 52 | else 53 | String.sub fn 0 end_pos 54 | with Not_found -> 55 | fn 56 | 57 | 58 | let add fn ext = 59 | fn ^ "." ^ ext 60 | 61 | 62 | let replace fn ext = 63 | add (chop fn) ext 64 | -------------------------------------------------------------------------------- /src/lib/fileutils/FilePath.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FilePath_type 23 | 24 | exception BaseFilenameRelative of filename 25 | exception UnrecognizedOS of string 26 | exception EmptyFilename 27 | exception NoExtension of filename 28 | exception InvalidFilename of filename 29 | 30 | module type OS_SPECIFICATION = 31 | sig 32 | val dir_writer: (filename_part list) -> filename 33 | val dir_reader: filename -> (filename_part list) 34 | val path_writer: (filename list) -> string 35 | val path_reader: string -> (filename list) 36 | val fast_concat: filename -> filename -> filename 37 | val fast_basename: filename -> filename 38 | val fast_dirname: filename -> filename 39 | val fast_is_relative: filename -> bool 40 | val fast_is_current: filename -> bool 41 | val fast_is_parent: filename -> bool 42 | end 43 | 44 | 45 | module type PATH_SPECIFICATION = 46 | sig 47 | type filename 48 | type extension 49 | 50 | val string_of_filename: filename -> string 51 | val filename_of_string: string -> filename 52 | val extension_of_string: string -> extension 53 | val string_of_extension: extension -> string 54 | val make_filename: string list -> filename 55 | val is_subdir: filename -> filename -> bool 56 | val is_updir: filename -> filename -> bool 57 | val compare: filename -> filename -> int 58 | val basename: filename -> filename 59 | val dirname: filename -> filename 60 | val concat: filename -> filename -> filename 61 | val reduce: ?no_symlink:bool -> filename -> filename 62 | val make_absolute: filename -> filename -> filename 63 | val make_relative: filename -> filename -> filename 64 | val reparent: filename -> filename -> filename -> filename 65 | val identity: filename -> filename 66 | val is_valid: filename -> bool 67 | val is_relative: filename -> bool 68 | val is_current: filename -> bool 69 | val is_parent: filename -> bool 70 | val chop_extension: filename -> filename 71 | val get_extension: filename -> extension 72 | val check_extension: filename -> extension -> bool 73 | val add_extension: filename -> extension -> filename 74 | val replace_extension: filename -> extension -> filename 75 | val string_of_path: filename list -> string 76 | val path_of_string: string -> filename list 77 | val current_dir: filename 78 | val parent_dir: filename 79 | end 80 | 81 | 82 | module type PATH_STRING_SPECIFICATION = 83 | sig 84 | module Abstract: PATH_SPECIFICATION 85 | 86 | include PATH_SPECIFICATION with 87 | type filename = string and 88 | type extension = string 89 | end 90 | 91 | 92 | (* Convert an OS_SPECIFICATION to PATH_SPECIFICATION *) 93 | module GenericPath = 94 | functor (OsOperation: OS_SPECIFICATION) -> 95 | struct 96 | type filename = FilePath_type.filename_part list 97 | 98 | type extension = FilePath_type.extension 99 | 100 | (* Filename_from_string *) 101 | 102 | let filename_of_string str = 103 | try 104 | OsOperation.dir_reader str 105 | with Parsing.Parse_error -> 106 | raise (InvalidFilename str) 107 | 108 | (* String_from_filename *) 109 | 110 | let string_of_filename path = 111 | OsOperation.dir_writer path 112 | 113 | (* Reduce *) 114 | 115 | let reduce ?(no_symlink=false) path = 116 | (* TODO: not tail recursive ! *) 117 | let rec reduce_aux lst = 118 | match lst with 119 | | ParentDir :: tl when no_symlink -> 120 | begin 121 | match reduce_aux tl with 122 | | Root s :: tl -> 123 | Root s :: tl 124 | | ParentDir :: tl -> 125 | ParentDir :: ParentDir :: tl 126 | | [] -> 127 | ParentDir :: tl 128 | | _ :: tl -> 129 | tl 130 | end 131 | | ParentDir :: tl -> 132 | ParentDir :: (reduce_aux tl) 133 | | CurrentDir _ :: tl 134 | | Component "" :: tl -> 135 | (reduce_aux tl) 136 | | Component s :: tl -> 137 | Component s :: (reduce_aux tl) 138 | | Root s :: tl -> 139 | Root s :: (reduce_aux tl) 140 | | [] -> 141 | [] 142 | in 143 | let rev_path = List.rev path in 144 | match reduce_aux rev_path with 145 | | [] when no_symlink = false-> 146 | (* assert 147 | * ( List.for_all ( function | Component "" 148 | * | CurrentDir _ -> true | _ -> false ) rev_path ) *) 149 | (try 150 | (* use last CurrentDir _ *) 151 | [ List.find ( function | CurrentDir _ -> true | _ -> false ) rev_path ] 152 | with 153 | | Not_found -> [] ) (* Only Component "" *) 154 | |l -> List.rev l 155 | 156 | 157 | 158 | (* Compare, subdir, updir *) 159 | 160 | type filename_relation = SubDir | UpDir | Equal | NoRelation of int 161 | 162 | let relation_of_filename path1 path2 = 163 | let rec relation_of_filename_aux path1 path2 = 164 | match (path1, path2) with 165 | ([], []) -> 166 | Equal 167 | | (hd1 :: tl1, hd2 :: tl2) -> 168 | if hd1 = hd2 then 169 | relation_of_filename_aux tl1 tl2 170 | else 171 | begin 172 | NoRelation (String.compare 173 | (string_of_filename [hd1]) 174 | (string_of_filename [hd2]) 175 | ) 176 | end 177 | | (_, []) -> SubDir 178 | | ([], _) -> UpDir 179 | in 180 | relation_of_filename_aux path1 path2 181 | 182 | let is_subdir path1 path2 = 183 | match relation_of_filename path1 path2 with 184 | SubDir -> 185 | true 186 | | _ -> 187 | false 188 | 189 | let is_updir path1 path2 = 190 | match relation_of_filename path1 path2 with 191 | UpDir -> 192 | true 193 | | _ -> 194 | false 195 | 196 | 197 | let compare path1 path2 = 198 | match relation_of_filename path1 path2 with 199 | SubDir -> -1 200 | | UpDir -> 1 201 | | Equal -> 0 202 | | NoRelation i -> i 203 | 204 | (* Concat *) 205 | 206 | let concat lst_path1 lst_path2 = 207 | reduce 208 | (match lst_path2 with 209 | | CurrentDir Short :: tl_path2 -> 210 | lst_path1 @ tl_path2 211 | | _ -> 212 | lst_path1 @ lst_path2) 213 | 214 | 215 | (* Is_relative *) 216 | 217 | let is_relative lst_path = 218 | match lst_path with 219 | (Root _) :: _ -> false 220 | | _ -> true 221 | 222 | 223 | (* Is_valid *) 224 | 225 | let is_valid _ = 226 | (* As we are manipulating abstract filename, 227 | and that it has been parsed, we are 228 | sure that all is correct *) 229 | true 230 | 231 | let is_current path = 232 | match path with 233 | [ (CurrentDir _) ] -> true 234 | | _ -> false 235 | 236 | let is_parent path = 237 | match path with 238 | [ ParentDir ] -> true 239 | | _ -> false 240 | 241 | (* Basename *) 242 | 243 | let basename path = 244 | match List.rev path with 245 | | hd :: _ -> [hd] 246 | | [] -> raise EmptyFilename 247 | 248 | (* Dirname *) 249 | 250 | let dirname path = 251 | match List.rev path with 252 | | _ :: tl -> List.rev tl 253 | | [] -> raise EmptyFilename 254 | 255 | (* Extension manipulation *) 256 | 257 | let wrap_extension f path = 258 | match basename path with 259 | | [Component fn] -> 260 | f fn 261 | | _ -> 262 | raise (NoExtension (string_of_filename path)) 263 | 264 | let check_extension path ext = 265 | wrap_extension 266 | (fun fn -> ExtensionPath.check fn ext) 267 | path 268 | 269 | let get_extension path = 270 | wrap_extension 271 | (fun fn -> ExtensionPath.get fn) 272 | path 273 | 274 | let chop_extension path = 275 | wrap_extension 276 | (fun fn -> 277 | concat 278 | (dirname path) 279 | [Component (ExtensionPath.chop fn)]) 280 | path 281 | 282 | let add_extension path ext = 283 | wrap_extension 284 | (fun fn -> 285 | concat 286 | (dirname path) 287 | [Component (ExtensionPath.add fn ext)]) 288 | path 289 | 290 | let replace_extension path ext = 291 | wrap_extension 292 | (fun fn -> 293 | concat 294 | (dirname path) 295 | [Component (ExtensionPath.replace fn ext)]) 296 | path 297 | 298 | let extension_of_string x = x 299 | 300 | let string_of_extension x = x 301 | 302 | (* Make_asbolute *) 303 | let make_absolute path_base path_path = 304 | reduce 305 | (if is_relative path_base then 306 | raise (BaseFilenameRelative (string_of_filename path_base)) 307 | else if is_relative path_path then 308 | path_base @ path_path 309 | else 310 | path_path) 311 | 312 | (* Make_relative *) 313 | let make_relative path_base path_path = 314 | let rec make_relative_aux lst_base lst_path = 315 | match (lst_base, lst_path) with 316 | x :: tl_base, a :: tl_path when x = a -> 317 | make_relative_aux tl_base tl_path 318 | | _, _ -> 319 | let back_to_base = List.rev_map 320 | (fun _ -> ParentDir) 321 | lst_base 322 | in 323 | back_to_base @ lst_path 324 | in 325 | reduce 326 | (if is_relative path_base then 327 | raise (BaseFilenameRelative (string_of_filename path_base)) 328 | else if is_relative path_path then 329 | path_path 330 | else 331 | make_relative_aux path_base path_path) 332 | 333 | (* Make_filename *) 334 | let make_filename lst_path = 335 | reduce (List.flatten (List.map filename_of_string lst_path)) 336 | 337 | (* Reparent *) 338 | let reparent path_src path_dst path = 339 | let path_relative = 340 | make_relative path_src path 341 | in 342 | make_absolute path_dst path_relative 343 | 344 | (* Identity *) 345 | let identity path = path 346 | 347 | (* Manipulate path like variable *) 348 | 349 | let string_of_path lst = 350 | OsOperation.path_writer (List.map string_of_filename lst) 351 | 352 | let path_of_string str = 353 | List.map 354 | filename_of_string 355 | (OsOperation.path_reader str) 356 | 357 | (* Generic filename component *) 358 | 359 | let current_dir = [ CurrentDir Long ] 360 | 361 | let parent_dir = [ ParentDir ] 362 | end 363 | 364 | 365 | (* Convert an OS_SPECIFICATION to PATH_STRING_SPECIFICATION *) 366 | module GenericStringPath = 367 | functor (OsOperation: OS_SPECIFICATION) -> 368 | struct 369 | 370 | module Abstract = GenericPath(OsOperation) 371 | 372 | type filename = string 373 | type extension = string 374 | 375 | let string_of_filename path = 376 | path 377 | 378 | let filename_of_string path = 379 | path 380 | 381 | let string_of_extension ext = 382 | ext 383 | 384 | let extension_of_string str = 385 | str 386 | 387 | let f2s = Abstract.string_of_filename 388 | 389 | let s2f = Abstract.filename_of_string 390 | 391 | let e2s = Abstract.string_of_extension 392 | 393 | let s2e = Abstract.extension_of_string 394 | 395 | let is_subdir path1 path2 = 396 | Abstract.is_subdir (s2f path1) (s2f path2) 397 | 398 | let is_updir path1 path2 = 399 | Abstract.is_updir (s2f path1) (s2f path2) 400 | 401 | let compare path1 path2 = 402 | Abstract.compare (s2f path1) (s2f path2) 403 | 404 | let basename path = 405 | try 406 | OsOperation.fast_basename path 407 | with CommonPath.CannotHandleFast -> 408 | f2s (Abstract.basename (s2f path)) 409 | 410 | let dirname path = 411 | try 412 | OsOperation.fast_dirname path 413 | with CommonPath.CannotHandleFast -> 414 | f2s (Abstract.dirname (s2f path)) 415 | 416 | let concat path1 path2 = 417 | try 418 | OsOperation.fast_concat path1 path2 419 | with CommonPath.CannotHandleFast -> 420 | f2s (Abstract.concat (s2f path1) (s2f path2)) 421 | 422 | let make_filename path_lst = 423 | f2s (Abstract.make_filename path_lst) 424 | 425 | let reduce ?no_symlink path = 426 | f2s (Abstract.reduce ?no_symlink (s2f path)) 427 | 428 | let make_absolute base_path path = 429 | f2s (Abstract.make_absolute (s2f base_path) (s2f path)) 430 | 431 | let make_relative base_path path = 432 | f2s (Abstract.make_relative (s2f base_path) (s2f path)) 433 | 434 | let reparent path_src path_dst path = 435 | f2s (Abstract.reparent (s2f path_src) (s2f path_dst) (s2f path)) 436 | 437 | let identity path = 438 | f2s (Abstract.identity (s2f path)) 439 | 440 | let is_valid path = 441 | try 442 | Abstract.is_valid (s2f path) 443 | with InvalidFilename _ -> 444 | false 445 | 446 | let is_relative path = 447 | try 448 | OsOperation.fast_is_relative path 449 | with CommonPath.CannotHandleFast -> 450 | Abstract.is_relative (s2f path) 451 | 452 | let is_current path = 453 | try 454 | OsOperation.fast_is_current path 455 | with CommonPath.CannotHandleFast -> 456 | Abstract.is_current (s2f path) 457 | 458 | let is_parent path = 459 | try 460 | OsOperation.fast_is_parent path 461 | with CommonPath.CannotHandleFast -> 462 | Abstract.is_parent (s2f path) 463 | 464 | let wrap_extension f path = 465 | let bfn = 466 | OsOperation.fast_basename path 467 | in 468 | if OsOperation.fast_is_parent bfn || 469 | OsOperation.fast_is_current bfn || 470 | not (OsOperation.fast_is_relative bfn) then 471 | raise (NoExtension path) 472 | else 473 | f bfn 474 | 475 | let chop_extension path = 476 | try 477 | wrap_extension 478 | (fun fn -> 479 | OsOperation.fast_concat 480 | (OsOperation.fast_dirname path) 481 | (ExtensionPath.chop fn)) 482 | path 483 | with CommonPath.CannotHandleFast -> 484 | f2s (Abstract.chop_extension (s2f path)) 485 | 486 | let get_extension path = 487 | try 488 | wrap_extension 489 | (fun fn -> ExtensionPath.get fn) 490 | path 491 | with CommonPath.CannotHandleFast -> 492 | e2s (Abstract.get_extension (s2f path)) 493 | 494 | let check_extension path ext = 495 | try 496 | wrap_extension 497 | (fun fn -> ExtensionPath.check fn ext) 498 | path 499 | with CommonPath.CannotHandleFast -> 500 | Abstract.check_extension (s2f path) (s2e ext) 501 | 502 | let add_extension path ext = 503 | try 504 | wrap_extension 505 | (fun fn -> 506 | OsOperation.fast_concat 507 | (OsOperation.fast_dirname path) 508 | (ExtensionPath.add fn ext)) 509 | path 510 | with CommonPath.CannotHandleFast -> 511 | f2s (Abstract.add_extension (s2f path) (s2e ext)) 512 | 513 | let replace_extension path ext = 514 | try 515 | wrap_extension 516 | (fun fn -> 517 | OsOperation.fast_concat 518 | (OsOperation.fast_dirname path) 519 | (ExtensionPath.replace fn ext)) 520 | path 521 | with CommonPath.CannotHandleFast -> 522 | f2s (Abstract.replace_extension (s2f path) (s2e ext)) 523 | 524 | let string_of_path path_lst = 525 | Abstract.string_of_path (List.map s2f path_lst) 526 | 527 | let path_of_string str = 528 | List.map f2s (Abstract.path_of_string str) 529 | 530 | let current_dir = 531 | f2s (Abstract.current_dir) 532 | 533 | let parent_dir = 534 | f2s (Abstract.parent_dir) 535 | end 536 | 537 | 538 | module DefaultPath = GenericStringPath(struct 539 | 540 | let os_depend unix win32 = 541 | match Sys.os_type with 542 | "Unix" 543 | | "Cygwin" -> unix 544 | | "Win32" -> win32 545 | | s -> raise (UnrecognizedOS s) 546 | 547 | let dir_writer = 548 | os_depend 549 | UnixPath.dir_writer 550 | Win32Path.dir_writer 551 | 552 | let dir_reader = 553 | os_depend 554 | UnixPath.dir_reader 555 | Win32Path.dir_reader 556 | 557 | let path_writer = 558 | os_depend 559 | UnixPath.path_writer 560 | Win32Path.path_writer 561 | 562 | let path_reader = 563 | os_depend 564 | UnixPath.path_reader 565 | Win32Path.path_reader 566 | 567 | let fast_concat = 568 | os_depend 569 | UnixPath.fast_concat 570 | Win32Path.fast_concat 571 | 572 | let fast_basename = 573 | os_depend 574 | UnixPath.fast_basename 575 | Win32Path.fast_basename 576 | 577 | let fast_dirname = 578 | os_depend 579 | UnixPath.fast_dirname 580 | Win32Path.fast_dirname 581 | 582 | let fast_is_relative = 583 | os_depend 584 | UnixPath.fast_is_relative 585 | Win32Path.fast_is_relative 586 | 587 | let fast_is_current = 588 | os_depend 589 | UnixPath.fast_is_current 590 | Win32Path.fast_is_current 591 | 592 | let fast_is_parent = 593 | os_depend 594 | UnixPath.fast_is_parent 595 | Win32Path.fast_is_parent 596 | end) 597 | 598 | 599 | module UnixPath = GenericStringPath(UnixPath) 600 | 601 | module Win32Path = GenericStringPath(Win32Path) 602 | 603 | module CygwinPath = UnixPath 604 | 605 | include DefaultPath 606 | -------------------------------------------------------------------------------- /src/lib/fileutils/FilePath.mli: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | (** Operations on abstract filenames. 23 | 24 | This module allow to manipulate string or abstract representation of a 25 | filename. 26 | 27 | Abstract representation of a filename allow to decode it only once, and 28 | should speed up further operation on it (comparison in particular). If you 29 | intend to do a lot of processing on filename, you should consider using its 30 | abstract representation. 31 | 32 | This module manipulate abstract path that are not bound to a real 33 | filesystem. In particular, it makes the assumption that there is no 34 | symbolic link that should modify the meaning of a path. If you intend to use 35 | this module against a real set of filename, the best solution is to apply to 36 | every filename to solve symbolic link through {!FileUtil.readlink}. 37 | 38 | @author Sylvain Le Gall 39 | *) 40 | 41 | (** Filename type. *) 42 | type filename = string 43 | 44 | (** Extension type. *) 45 | type extension = string 46 | 47 | (** {2 Exceptions and types} *) 48 | 49 | (** Cannot pass a base filename which is relative. *) 50 | exception BaseFilenameRelative of filename 51 | 52 | (** We do not have recognized any OS, please contact upstream. *) 53 | exception UnrecognizedOS of string 54 | 55 | (** The filename use was empty. *) 56 | exception EmptyFilename 57 | 58 | (** The last component of the filename does not support extension (Root, 59 | ParentDir...) 60 | *) 61 | exception NoExtension of filename 62 | 63 | (** The filename used is invalid. *) 64 | exception InvalidFilename of filename 65 | 66 | (** {2 Ordering} *) 67 | 68 | (** [is_subdir child parent] Is [child] really a sub directory of [parent] *) 69 | val is_subdir: filename -> filename -> bool 70 | 71 | (** [is_updir parent child] Is [parent] really a parent directory of [child] *) 72 | val is_updir: filename -> filename -> bool 73 | 74 | (** [compare fl1 fl2] Give an order between the two filename. The 75 | classification is done by sub directory relation, [fl1] < [fl2] iff [fl1] is 76 | a subdirectory of [fl2], and lexicographical order of each part of the 77 | reduce filename when [fl1] and [fl2] has no hierarchical relation 78 | *) 79 | val compare: filename -> filename -> int 80 | 81 | (** {2 Standard operations } *) 82 | 83 | (** Current dir. *) 84 | val current_dir: filename 85 | 86 | (** Upper dir. *) 87 | val parent_dir: filename 88 | 89 | (** Make a filename from a set of strings. *) 90 | val make_filename: string list -> filename 91 | 92 | (** Extract only the file name of a filename. 93 | Returns an empty string for directory-only paths like ["dir/"]. *) 94 | val basename: filename -> filename 95 | 96 | (** Extract the directory name of a filename. 97 | Returns an empty string for file-only paths like ["file"]. *) 98 | val dirname: filename -> filename 99 | 100 | (** Append a filename to a filename. *) 101 | val concat: filename -> filename -> filename 102 | 103 | (** Return the shortest filename which is equal to the filename given. It remove 104 | the "." in Unix filename, for example. 105 | If [no_symlink] flag is set, consider that the path doesn't contain symlink 106 | and in this case ".." for Unix filename are also reduced. 107 | *) 108 | val reduce: ?no_symlink:bool -> filename -> filename 109 | 110 | (** Create an absolute filename from a filename relative and an absolute base 111 | filename. 112 | *) 113 | val make_absolute: filename -> filename -> filename 114 | 115 | (** Create a filename which is relative to the base filename. *) 116 | val make_relative: filename -> filename -> filename 117 | 118 | (** [reparent fln_src fln_dst fln] Return the same filename as [fln] 119 | but the root is no more [fln_src] but [fln_dst]. It replaces the 120 | [fln_src] prefix by [fln_dst]. 121 | *) 122 | val reparent: filename -> filename -> filename -> filename 123 | 124 | (** Identity for testing the stability of implode/explode. *) 125 | val identity: filename -> filename 126 | 127 | (** Test if the filename is a valid one. *) 128 | val is_valid: filename -> bool 129 | 130 | (** Check if the filename is relative to a dir or not. 131 | *) 132 | val is_relative: filename -> bool 133 | 134 | (** Check if the filename is the current directory. 135 | *) 136 | val is_current: filename -> bool 137 | 138 | (** Check if the filename is the parent directory. 139 | *) 140 | val is_parent: filename -> bool 141 | 142 | (** {2 Extension}*) 143 | 144 | (** Extension is define as the suffix of a filename, just after the last ".". 145 | *) 146 | 147 | (** Remove extension and the trailing ".". *) 148 | val chop_extension: filename -> filename 149 | 150 | (** Extracts the extension. Raises [Not_found] if there is no extension. *) 151 | val get_extension: filename -> extension 152 | 153 | (** Check the extension. *) 154 | val check_extension: filename -> extension -> bool 155 | 156 | (** Add an extension with a "." before. 157 | Using this function with an empty extension string creates a filename 158 | with a trailing dot.*) 159 | val add_extension: filename -> extension -> filename 160 | 161 | (** Replace extension. *) 162 | val replace_extension: filename -> extension -> filename 163 | 164 | (** {2 PATH-like operation}*) 165 | 166 | (** PATH-like refers the environment variable PATH. This variable holds a list 167 | of filename. The functions [string_of_path] and [path_of_string] allow to 168 | convert this kind of list by using the good separator between filename. 169 | *) 170 | 171 | (** Create a PATH-like string. *) 172 | val string_of_path: filename list -> string 173 | 174 | (** Extract filenames from a PATH-like string. *) 175 | val path_of_string: string -> filename list 176 | 177 | (** {2 Filename specifications} *) 178 | 179 | (** Definition of operations for path manipulation. *) 180 | 181 | (** Generic operations. *) 182 | module type PATH_SPECIFICATION = 183 | sig 184 | type filename 185 | type extension 186 | 187 | (** {3 Converting abstract type from/to string } *) 188 | 189 | (** Create a filename from a string. *) 190 | val string_of_filename: filename -> string 191 | 192 | (** Create a string from a filename. *) 193 | val filename_of_string: string -> filename 194 | 195 | (** Create an extension from a string. *) 196 | val extension_of_string: string -> extension 197 | 198 | (** Return string representation of an extension. *) 199 | val string_of_extension: extension -> string 200 | 201 | (** {3 Standard operations} *) 202 | 203 | (** See {!FilePath.make_filename} *) 204 | val make_filename: string list -> filename 205 | 206 | (** See {!FilePath.is_subdir} *) 207 | val is_subdir: filename -> filename -> bool 208 | 209 | (** See {!FilePath.is_updir} *) 210 | val is_updir: filename -> filename -> bool 211 | 212 | (** See {!FilePath.compare} *) 213 | val compare: filename -> filename -> int 214 | 215 | (** See {!FilePath.basename} *) 216 | val basename: filename -> filename 217 | 218 | (** See {!FilePath.dirname} *) 219 | val dirname: filename -> filename 220 | 221 | (** See {!FilePath.concat} *) 222 | val concat: filename -> filename -> filename 223 | 224 | (** See {!FilePath.reduce} *) 225 | val reduce: ?no_symlink:bool -> filename -> filename 226 | 227 | (** See {!FilePath.make_absolute} *) 228 | val make_absolute: filename -> filename -> filename 229 | 230 | (** See {!FilePath.make_relative} *) 231 | val make_relative: filename -> filename -> filename 232 | 233 | (** See {!FilePath.reparent} *) 234 | val reparent: filename -> filename -> filename -> filename 235 | 236 | (** See {!FilePath.identity} *) 237 | val identity: filename -> filename 238 | 239 | (** See {!FilePath.is_valid} *) 240 | val is_valid: filename -> bool 241 | 242 | (** See {!FilePath.is_relative} *) 243 | val is_relative: filename -> bool 244 | 245 | (** See {!FilePath.is_current} *) 246 | val is_current: filename -> bool 247 | 248 | (** See {!FilePath.is_parent} *) 249 | val is_parent: filename -> bool 250 | 251 | (** See {!FilePath.chop_extension} *) 252 | val chop_extension: filename -> filename 253 | 254 | (** See {!FilePath.get_extension} *) 255 | val get_extension: filename -> extension 256 | 257 | (** See {!FilePath.check_extension} *) 258 | val check_extension: filename -> extension -> bool 259 | 260 | (** See {!FilePath.add_extension} *) 261 | val add_extension: filename -> extension -> filename 262 | 263 | (** See {!FilePath.replace_extension} *) 264 | val replace_extension: filename -> extension -> filename 265 | 266 | (** See {!FilePath.string_of_path} *) 267 | val string_of_path: filename list -> string 268 | 269 | (** See {!FilePath.path_of_string} *) 270 | val path_of_string: string -> filename list 271 | 272 | (** See {!FilePath.current_dir} *) 273 | val current_dir: filename 274 | 275 | (** See {!FilePath.parent_dir} *) 276 | val parent_dir: filename 277 | end 278 | 279 | (** Generic operations, with type filename and extension as strings. *) 280 | module type PATH_STRING_SPECIFICATION = 281 | sig 282 | module Abstract: PATH_SPECIFICATION 283 | 284 | include PATH_SPECIFICATION with 285 | type filename = string and 286 | type extension = string 287 | end 288 | 289 | (** Operations on filenames for other OS. The {!DefaultPath} always match the 290 | current OS. 291 | *) 292 | 293 | (** Default operating system. *) 294 | module DefaultPath: PATH_STRING_SPECIFICATION 295 | 296 | (** Unix operating system. *) 297 | module UnixPath: PATH_STRING_SPECIFICATION 298 | 299 | (** Win32 operating system. *) 300 | module Win32Path: PATH_STRING_SPECIFICATION 301 | 302 | (** Cygwin operating system. *) 303 | module CygwinPath: PATH_STRING_SPECIFICATION 304 | -------------------------------------------------------------------------------- /src/lib/fileutils/FilePath_type.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | type current_dir_type = 23 | Short 24 | | Long 25 | 26 | 27 | type filename_part = 28 | Root of string 29 | | ParentDir 30 | | CurrentDir of current_dir_type 31 | | Component of string 32 | 33 | 34 | type filename = string 35 | 36 | 37 | type extension = string 38 | 39 | 40 | (* Utility function to parse filename *) 41 | 42 | 43 | let begin_string str lst = (str, lst) 44 | 45 | 46 | let add_string str1 (str2, lst) = (str1 ^ str2, lst) 47 | 48 | 49 | let end_string (str, lst) = (Component str) :: lst 50 | 51 | 52 | (* Definition of the caracteristic length of a path *) 53 | let path_length = 80 54 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileStringExt.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | (** Extended String module 23 | *) 24 | 25 | (** Split a string, separator not included 26 | *) 27 | let split ?(start_acc=[]) ?(start_pos=0) ~map sep str = 28 | let str_len = String.length str in 29 | let rec split_aux acc pos = 30 | if pos < str_len then begin 31 | let pos_sep = 32 | try 33 | String.index_from str pos sep 34 | with Not_found -> 35 | str_len 36 | in 37 | let part = String.sub str pos (pos_sep - pos) in 38 | let acc = (map part) :: acc in 39 | if pos_sep >= str_len then 40 | (* Nothing more in the string *) 41 | List.rev acc 42 | else if pos_sep = (str_len - 1) then 43 | (* String end with a separator *) 44 | List.rev ((map "") :: acc) 45 | else 46 | split_aux acc (pos_sep + 1) 47 | end else 48 | List.rev acc 49 | in 50 | split_aux start_acc start_pos 51 | 52 | 53 | (** Cut in two a string, separator not included 54 | *) 55 | let break_at_first sep str = 56 | let pos_sep = 57 | String.index str sep 58 | in 59 | (String.sub str 0 pos_sep), 60 | (String.sub str (pos_sep + 1) ((String.length str) - pos_sep - 1)) 61 | 62 | 63 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtil.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | include FileUtilTypes 23 | include FileUtilPermission 24 | include FileUtilSize 25 | include FileUtilSTAT 26 | include FileUtilUMASK 27 | include FileUtilLS 28 | include FileUtilCHMOD 29 | include FileUtilTEST 30 | include FileUtilPWD 31 | include FileUtilREADLINK 32 | include FileUtilWHICH 33 | include FileUtilMKDIR 34 | include FileUtilTOUCH 35 | include FileUtilFIND 36 | include FileUtilRM 37 | include FileUtilCP 38 | include FileUtilMV 39 | include FileUtilCMP 40 | include FileUtilDU 41 | 42 | type 'a error_handler = string -> 'a -> unit 43 | 44 | module Mode = FileUtilMode 45 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtil.mli: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | (** POSIX utilities for files and directories. 23 | 24 | A module to provide the core POSIX utilities to manipulate files and 25 | directories. All functions try to mimic common POSIX utilities but are 26 | written in pure OCaml. 27 | 28 | @author Sylvain Le Gall 29 | *) 30 | 31 | open FilePath 32 | 33 | 34 | (*********************************************************************) 35 | (** 36 | 37 | {2 Types and exceptions } 38 | 39 | *) 40 | 41 | exception FileDoesntExist of filename 42 | exception RecursiveLink of filename 43 | 44 | (** Generic error handling functions. Whenever such a function is available it 45 | helps report the error and allows to raise an exception. The [string] 46 | provided is the human readable version of ['a]. In most cases ['a] is a 47 | polymorphic variant. 48 | *) 49 | type 'a error_handler = string -> 'a -> unit 50 | 51 | (** Exception raised when after an [error_handler] the execution cannot 52 | continue. The rest of the workflow logic cannot handle the default case and 53 | the whole operation can be in the middle of transformation. 54 | *) 55 | exception Fatal of string 56 | 57 | (** Policy concerning links which are directories. *) 58 | type action_link = 59 | | Follow 60 | (** We consider link as simple directory (it is dangerous) *) 61 | | Skip 62 | (** Just skip it *) 63 | | SkipInform of (filename -> unit) 64 | (** Skip and execute an action *) 65 | | AskFollow of (filename -> bool) 66 | (** Ask and wait for input, false means skip *) 67 | 68 | (** For certain command, you should need to ask the user wether 69 | or not he wants to act. 70 | *) 71 | type interactive = 72 | | Force (** Do it anyway *) 73 | | Ask of (filename -> bool) (** Promp the user *) 74 | 75 | 76 | (*********************************************************************) 77 | (** 78 | 79 | {2 Permission } 80 | 81 | *) 82 | 83 | (** Base permission. This is the permission corresponding to one user or group. 84 | *) 85 | type base_permission = 86 | { 87 | sticky: bool; 88 | exec: bool; 89 | write: bool; 90 | read: bool; 91 | } 92 | 93 | (** Full permission. All the base permissions of a file. 94 | *) 95 | type permission = 96 | { 97 | user: base_permission; 98 | group: base_permission; 99 | other: base_permission; 100 | } 101 | 102 | (** Translate POSIX integer permission. *) 103 | val permission_of_int: int -> permission [@@pure] 104 | 105 | (** Return the POSIX integer permission *) 106 | val int_of_permission: permission -> int [@@pure] 107 | 108 | (** Permission symbolic mode. *) 109 | module Mode: 110 | sig 111 | type who = [`User | `Group | `Other | `All] 112 | type wholist = [ who | `List of who list ] 113 | type permcopy = [`User | `Group | `Other] 114 | type perm = [ `Read | `Write | `Exec | `ExecX | `Sticky | `StickyO ] 115 | type permlist = [ perm | `List of perm list ] 116 | type actionarg = [ permlist | permcopy ] 117 | type action = [ `Set of actionarg | `Add of actionarg | `Remove of actionarg] 118 | type actionlist = [ action | `List of action list ] 119 | type clause = [ `User of actionlist | `Group of actionlist 120 | | `Other of actionlist | `All of actionlist 121 | | `None of actionlist ] 122 | 123 | (** Typical symbolic mode: 124 | - g+r -> [`Group (`Add `Read)] 125 | - u=rw,g+rw,o-rwx -> 126 | [`User (`Set (`List [`Read; `Write])); 127 | `Group (`Add (`List [`Read; `Write])); 128 | `Other (`Remove (`List [`Read; `Write; `Exec]))] 129 | *) 130 | type t = clause list 131 | 132 | val to_string: t -> string [@@pure] 133 | val apply: is_dir:bool -> umask:int -> Unix.file_perm -> t -> Unix.file_perm 134 | end 135 | 136 | (*********************************************************************) 137 | (** 138 | 139 | {2 Size operation} 140 | 141 | *) 142 | 143 | (** File size 144 | *) 145 | type size = 146 | TB of int64 (** Tera bytes *) 147 | | GB of int64 (** Giga bytes *) 148 | | MB of int64 (** Mega bytes *) 149 | | KB of int64 (** Kilo bytes *) 150 | | B of int64 (** Bytes *) 151 | 152 | (** Convert size to bytes. *) 153 | val byte_of_size: size -> int64 [@@pure] 154 | 155 | (** Add two sizes. *) 156 | val size_add: size -> size -> size [@@pure] 157 | 158 | (** Compare two sizes, using the classical compare function. If fuzzy is set to 159 | true, the comparison is done on the most significant size unit of both 160 | value. 161 | *) 162 | val size_compare: ?fuzzy:bool -> size -> size -> int [@@pure] 163 | 164 | (** Convert a value to a string representation. If fuzzy is set to true, only 165 | consider the most significant unit 166 | *) 167 | val string_of_size: ?fuzzy:bool -> size -> string [@@pure] 168 | 169 | (*********************************************************************) 170 | (** 171 | 172 | {2 stat } 173 | 174 | *) 175 | 176 | (** Kind of file. This set is a combination of all POSIX file, some of them 177 | doesn't exist at all on certain file system or OS. 178 | *) 179 | type kind = 180 | Dir 181 | | File 182 | | Dev_char 183 | | Dev_block 184 | | Fifo 185 | | Socket 186 | | Symlink (** @since 0.4.6 *) 187 | 188 | 189 | (** Information about a file. This type is derived from Unix.stat 190 | *) 191 | type stat = 192 | { 193 | kind: kind; 194 | is_link: bool; 195 | permission: permission; 196 | size: size; 197 | owner: int; 198 | group_owner: int; 199 | access_time: float; 200 | modification_time: float; 201 | creation_time: float; 202 | device: int; 203 | inode: int; 204 | } 205 | 206 | 207 | (** [stat fln] Return information about the file (like Unix.stat) 208 | Non POSIX command. 209 | *) 210 | val stat: ?dereference:bool -> filename -> stat 211 | 212 | (*********************************************************************) 213 | (** 214 | 215 | {2 umask } 216 | 217 | *) 218 | 219 | exception UmaskError of string 220 | 221 | (** Possible umask errors. *) 222 | type umask_error = [ `Exc of exn | `NoStickyBit of int ] 223 | 224 | (** Get or set the file mode creation mask. 225 | See {{:http://pubs.opengroup.org/onlinepubs/007904875/utilities/umask.html}POSIX documentation}. 226 | *) 227 | val umask: 228 | ?error:(umask_error error_handler) -> 229 | ?mode:[< `Octal of int | `Symbolic of Mode.t ] -> 230 | [< `Octal of int -> 'a | `Symbolic of Mode.t -> 'a] -> 231 | 'a 232 | 233 | (** Apply umask to a given file permission. 234 | *) 235 | val umask_apply: int -> int 236 | 237 | (*********************************************************************) 238 | (** 239 | 240 | {2 test } 241 | 242 | *) 243 | 244 | (** Pattern you can use to test file. If the file doesn't exist the result is 245 | always false. 246 | *) 247 | type test_file = 248 | | Is_dev_block (** FILE is block special *) 249 | | Is_dev_char (** FILE is character special *) 250 | | Is_dir (** FILE is a directory *) 251 | | Exists (** FILE exists *) 252 | | Is_file (** FILE is a regular file *) 253 | | Is_set_group_ID (** FILE is set-group-ID *) 254 | | Has_sticky_bit (** FILE has its sticky bit set *) 255 | | Is_link (** FILE is a symbolic link *) 256 | | Is_pipe (** FILE is a named pipe *) 257 | | Is_readable (** FILE is readable *) 258 | | Is_writeable (** FILE is writeable *) 259 | | Size_not_null (** FILE has a size greater than zero *) 260 | | Size_bigger_than of size (** FILE has a size greater than given size *) 261 | | Size_smaller_than of size (** FILE has a size smaller than given size *) 262 | | Size_equal_to of size (** FILE has the same size as given size *) 263 | | Size_fuzzy_equal_to of size (** FILE has approximatively the same size as 264 | given size *) 265 | | Is_socket (** FILE is a socket *) 266 | | Has_set_user_ID (** FILE its set-user-ID bit is set *) 267 | | Is_exec (** FILE is executable *) 268 | | Is_owned_by_user_ID (** FILE is owned by the effective user ID *) 269 | | Is_owned_by_group_ID (** FILE is owned by the effective group ID *) 270 | | Is_newer_than of filename (** FILE1 is newer (modification date) than 271 | FILE2 *) 272 | | Is_older_than of filename (** FILE1 is older than FILE2 *) 273 | | Is_newer_than_date of float (** FILE is newer than given date *) 274 | | Is_older_than_date of float (** FILE is older than given date *) 275 | | And of test_file * test_file (** Result of TEST1 and TEST2 *) 276 | | Or of test_file * test_file (** Result of TEST1 or TEST2 *) 277 | | Not of test_file (** Result of not TEST *) 278 | | Match of string (** Compilable match (Str or PCRE or ...) *) 279 | | True (** Always true *) 280 | | False (** Always false *) 281 | | Has_extension of extension (** Check extension *) 282 | | Has_no_extension (** Check absence of extension *) 283 | | Is_parent_dir (** Basename is the parent dir *) 284 | | Is_current_dir (** Basename is the current dir *) 285 | | Basename_is of filename (** Check the basename *) 286 | | Dirname_is of filename (** Check the dirname *) 287 | | Custom of (filename -> bool) (** Custom operation on filename *) 288 | 289 | 290 | (** Test a file. 291 | See {{:http://pubs.opengroup.org/onlinepubs/007904875/utilities/test.html}POSIX documentation}. 292 | *) 293 | val test: 294 | ?match_compile:(filename -> filename -> bool) -> 295 | test_file -> filename -> bool 296 | 297 | (*********************************************************************) 298 | (** 299 | 300 | {2 chmod } 301 | 302 | *) 303 | 304 | exception ChmodError of string 305 | 306 | (** Possible chmod errors. *) 307 | type chmod_error = [`Exc of exn] 308 | 309 | (** Change permissions of files. 310 | See {{:http://pubs.opengroup.org/onlinepubs/007904875/utilities/chmod.html}POSIX documentation}. 311 | *) 312 | val chmod: 313 | ?error:(chmod_error error_handler) -> 314 | ?recurse:bool -> 315 | [< `Octal of Unix.file_perm | `Symbolic of Mode.t ] -> 316 | filename list -> unit 317 | 318 | (*********************************************************************) 319 | (** 320 | 321 | {2 mkdir } 322 | 323 | *) 324 | 325 | exception MkdirError of string 326 | 327 | (** Possible mkdir errors. *) 328 | type mkdir_error = 329 | [ `DirnameAlreadyUsed of filename 330 | | `Exc of exn 331 | | `MissingComponentPath of filename 332 | | `MkdirChmod of filename * Unix.file_perm * string * chmod_error ] 333 | 334 | (** Create the directory which name is provided. Set [~parent] to true 335 | if you also want to create every directory of the path. Use mode to 336 | provide some specific right. 337 | See {{:http://pubs.opengroup.org/onlinepubs/007904875/utilities/mkdir.html}POSIX documentation}. 338 | *) 339 | val mkdir: 340 | ?error:(mkdir_error error_handler) -> 341 | ?parent:bool -> 342 | ?mode:[< `Octal of Unix.file_perm | `Symbolic of Mode.t ] -> 343 | filename -> unit 344 | 345 | (*********************************************************************) 346 | (** 347 | 348 | {2 rm } 349 | 350 | *) 351 | 352 | exception RmError of string 353 | 354 | (** Possible rm errors. *) 355 | type rm_error = 356 | [ `DirNotEmpty of filename 357 | | `Exc of exn 358 | | `NoRecurse of filename ] 359 | 360 | (** Remove the filename provided. Set [~recurse] to true in order to 361 | completely delete a directory. 362 | See {{:http://pubs.opengroup.org/onlinepubs/007904875/utilities/rm.html}POSIX documentation}. 363 | *) 364 | val rm: 365 | ?error:(rm_error error_handler) -> 366 | ?force:interactive -> ?recurse:bool -> filename list -> unit 367 | 368 | (*********************************************************************) 369 | (** 370 | 371 | {2 cp } 372 | 373 | *) 374 | 375 | exception CpError of string 376 | 377 | (** Possible cp errors. *) 378 | type cp_error = 379 | [ `CannotChmodDstDir of filename * exn 380 | | `CannotCopyDir of filename 381 | | `CannotCopyFilesToFile of filename list * filename 382 | | `CannotCreateDir of filename * exn 383 | | `CannotListSrcDir of filename * exn 384 | | `CannotOpenDstFile of filename * exn 385 | | `CannotOpenSrcFile of filename * exn 386 | | `CannotRemoveDstFile of filename * exn 387 | | `DstDirNotDir of filename 388 | | `ErrorRead of filename * exn 389 | | `ErrorWrite of filename * exn 390 | | `Exc of exn 391 | | `NoSourceFile of filename 392 | | `PartialWrite of filename * int * int 393 | | `SameFile of filename * filename 394 | | `UnhandledType of filename * kind ] 395 | 396 | (** Copy the hierarchy of files/directory to another destination. 397 | See {{:http://pubs.opengroup.org/onlinepubs/007904875/utilities/cp.html}POSIX documentation}. 398 | *) 399 | val cp: 400 | ?follow:action_link -> 401 | ?force:interactive -> 402 | ?recurse:bool -> 403 | ?preserve:bool -> 404 | ?error:(cp_error error_handler) -> 405 | filename list -> filename -> unit 406 | 407 | (*********************************************************************) 408 | (** 409 | 410 | {2 mv } 411 | 412 | *) 413 | 414 | exception MvError of string 415 | 416 | (** Possible mv errors. *) 417 | type mv_error = 418 | [ `Exc of exn 419 | | `MvCp of filename * filename * string * cp_error 420 | | `MvRm of filename * string * rm_error 421 | | `NoSourceFile ] 422 | 423 | (** Move files/directories to another destination. 424 | See {{:http://pubs.opengroup.org/onlinepubs/007904875/utilities/mv.html}POSIX documentation}. 425 | *) 426 | val mv: 427 | ?error:(mv_error error_handler) -> 428 | ?force:interactive -> filename -> filename -> unit 429 | 430 | 431 | (*********************************************************************) 432 | (** 433 | 434 | {2 touch } 435 | 436 | *) 437 | 438 | (** Time for file *) 439 | type touch_time_t = 440 | | Touch_now (** Use Unix.gettimeofday *) 441 | | Touch_file_time of filename (** Get mtime of file *) 442 | | Touch_timestamp of float (** Use GMT timestamp *) 443 | 444 | 445 | (** Modify the timestamp of the given filename. 446 | See {{:http://pubs.opengroup.org/onlinepubs/007904875/utilities/touch.html}POSIX documentation}. 447 | If atime and mtime are not specified, they are both considered true. If only 448 | atime or mtime is sepcified, the other is false. 449 | @param atime modify access time. 450 | @param mtime modify modification time. 451 | @param create if file doesn't exist, create it, default true 452 | @param time what time to set, default Touch_now 453 | *) 454 | val touch: 455 | ?atime:bool -> 456 | ?mtime:bool -> 457 | ?create:bool -> ?time:touch_time_t -> filename -> unit 458 | 459 | (*********************************************************************) 460 | (** 461 | 462 | {2 ls } 463 | 464 | *) 465 | 466 | (** Apply a filtering pattern to a filename. 467 | *) 468 | val filter: test_file -> filename list -> filename list 469 | 470 | (** List the content of a directory. 471 | See {{:http://pubs.opengroup.org/onlinepubs/007904875/utilities/ls.html}POSIX documentation}. 472 | *) 473 | val ls: filename -> filename list 474 | 475 | (*********************************************************************) 476 | (** 477 | 478 | {2 Misc operations } 479 | 480 | *) 481 | 482 | (** Return the current dir. 483 | See {{:http://pubs.opengroup.org/onlinepubs/007904875/utilities/pwd.html}POSIX documentation}. 484 | *) 485 | val pwd: unit -> filename 486 | 487 | (** Resolve to the real filename removing symlink. 488 | Non POSIX command. 489 | *) 490 | val readlink: filename -> filename 491 | 492 | (** Try to find the executable in the PATH. Use environement variable 493 | PATH if none is provided. 494 | Non POSIX command. 495 | *) 496 | val which: 497 | ?path:filename list -> filename -> filename 498 | 499 | (** [cmp skip1 fln1 skip2 fln2] Compare files [fln1] and [fln2] starting at pos 500 | [skip1] [skip2] and returning the first octect where a difference occurs. 501 | Returns [Some -1] if one of the files is not readable or if it is not a 502 | file. Returns [None] if given two identical files. 503 | See {{:http://pubs.opengroup.org/onlinepubs/007904875/utilities/cmp.html}POSIX documentation}. 504 | *) 505 | val cmp: 506 | ?skip1:int -> 507 | filename -> ?skip2:int -> filename -> int option 508 | 509 | (** [du fln_lst] Return the amount of space of all the file 510 | which are subdir of fln_lst. Also return details for each 511 | file scanned. 512 | See {{:http://pubs.opengroup.org/onlinepubs/007904875/utilities/du.html}POSIX documentation}. 513 | *) 514 | val du: filename list -> size * (filename * size) list 515 | 516 | (** [find ~follow:fol tst fln exec accu] Descend the directory tree starting 517 | from the given filename and using the test provided. You cannot match 518 | [current_dir] and [parent_dir]. For every file found, the action [exec] is 519 | done, using the [accu] to start. For a simple file listing, you can use 520 | [find True "." (fun x y -> y :: x) []] 521 | See {{:http://pubs.opengroup.org/onlinepubs/007904875/utilities/find.html}POSIX documentation}. 522 | *) 523 | val find: 524 | ?follow:action_link -> 525 | ?match_compile:(filename -> filename -> bool) -> 526 | test_file -> 527 | filename -> ('a -> filename -> 'a) -> 'a -> 'a 528 | 529 | (** For future release: 530 | - [val pathchk: filename -> boolean * string], check whether file names are 531 | valid or portable 532 | - [val setfacl: filename -> permission -> unit], set file access control 533 | lists (UNIX + extended attribute) 534 | - [val getfacl: filename -> permission], get file access control lists 535 | 536 | ACL related function will be handled through a plugin system to handle at 537 | runtime which attribute can be read/write (i.e. Win32 ACL, NFS acl, Linux ACL -- 538 | or none). 539 | *) 540 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilCHMOD.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilTypes 23 | open FileUtilMisc 24 | open FileUtilPermission 25 | open FileUtilSTAT 26 | open FileUtilLS 27 | open FileUtilUMASK 28 | 29 | exception ChmodError of string 30 | 31 | type chmod_error = [`Exc of exn] 32 | 33 | 34 | let chmod 35 | ?(error=fun str _ -> raise (ChmodError str)) 36 | ?(recurse=false) 37 | mode lst = 38 | let _, handle_exception = 39 | handle_error_gen "chmod" error (function #exc -> "") 40 | in 41 | let rec chmod_one fn = 42 | let st = stat fn in 43 | if st.kind = Dir && recurse then begin 44 | List.iter chmod_one (ls fn) 45 | end; 46 | if not st.is_link then begin 47 | let int_perm = 48 | match mode with 49 | | `Octal i -> i 50 | | `Symbolic t -> 51 | FileUtilMode.apply 52 | ~is_dir:(st.kind = Dir) 53 | ~umask:(umask (`Octal (fun i -> i))) 54 | (int_of_permission st.permission) t 55 | in 56 | if int_perm <> int_of_permission st.permission then 57 | try 58 | Unix.chmod fn int_perm 59 | with e -> 60 | handle_exception ~fatal:true e 61 | end 62 | in 63 | List.iter chmod_one lst 64 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilCMP.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilTypes 23 | open FilePath 24 | open FileUtilTEST 25 | 26 | let rec seq_of_channel ch () = 27 | match input_char ch with 28 | | exception End_of_file -> Seq.Nil 29 | | char -> Seq.Cons (char, seq_of_channel ch) 30 | 31 | let cmp ?(skip1 = 0) fln1 ?(skip2 = 0) fln2 = 32 | if (reduce fln1) = (reduce fln2) then 33 | None 34 | else if (test (And(Is_readable, Is_file)) fln1) 35 | && (test (And(Is_readable, Is_file)) fln2) then begin 36 | let fd1 = open_in_bin fln1 in 37 | let fd2 = open_in_bin fln2 in 38 | let clean_fd () = 39 | let () = try close_in fd1 with _ -> () in 40 | let () = try close_in fd2 with _ -> () in 41 | () 42 | in 43 | 44 | let _ = seek_in fd1 skip1 in 45 | let _ = seek_in fd2 skip2 in 46 | let stream1 = seq_of_channel fd1 in 47 | let stream2 = seq_of_channel fd2 in 48 | let rec loop count s1 s2 = 49 | match s1, s2 with 50 | | Seq.Cons (v1, s1), Seq.Cons (v2, s2) when v1 = v2 -> loop (count + 1) (s1 ()) (s2 ()) 51 | | Seq.Nil, Seq.Nil -> (-1) 52 | | _ -> count 53 | in 54 | let count = loop 0 (stream1 ()) (stream2 ()) in 55 | clean_fd (); 56 | match count with 57 | | (-1) -> None 58 | | x -> Some x 59 | end else 60 | Some (-1) 61 | 62 | 63 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilCP.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilTypes 23 | open FilePath 24 | open FileUtilMisc 25 | open FileUtilPermission 26 | open FileUtilTOUCH 27 | open FileUtilRM 28 | open FileUtilSTAT 29 | open FileUtilUMASK 30 | open FileUtilMKDIR 31 | open FileUtilCHMOD 32 | open FileUtilTEST 33 | 34 | exception CpError of string 35 | exception CpSkip 36 | 37 | type cp_error = 38 | [ `CannotChmodDstDir of filename * exn 39 | | `CannotCopyDir of filename 40 | | `CannotCopyFilesToFile of filename list * filename 41 | | `CannotCreateDir of filename * exn 42 | | `CannotListSrcDir of filename * exn 43 | | `CannotOpenDstFile of filename * exn 44 | | `CannotOpenSrcFile of filename * exn 45 | | `CannotRemoveDstFile of filename * exn 46 | | `DstDirNotDir of filename 47 | | `ErrorRead of filename * exn 48 | | `ErrorWrite of filename * exn 49 | | `Exc of exn 50 | | `NoSourceFile of filename 51 | | `PartialWrite of filename * int * int 52 | | `SameFile of filename * filename 53 | | `UnhandledType of filename * kind ] 54 | 55 | 56 | let silent_close fd = try Unix.close fd with _ -> () 57 | 58 | let same_file st1 st2 = 59 | st1.device = st2.device && st1.inode = st2.inode 60 | 61 | let[@ warning "-27"] cp 62 | ?(follow=Skip) 63 | ?(force=Force) 64 | ?(recurse=false) 65 | ?(preserve=false) 66 | ?(error=(fun str _ -> raise (CpError str))) 67 | fln_src_lst 68 | fln_dst = 69 | 70 | let herror, _ = 71 | let spf fmt = Printf.sprintf fmt in 72 | let exs () e = 73 | match e with 74 | | Unix.Unix_error(err, _, _) -> Unix.error_message err 75 | | e -> Printexc.to_string e 76 | in 77 | handle_error_gen "cp" error 78 | (function 79 | | `CannotRemoveDstFile(fn_dst, e) -> 80 | spf "Cannot remove destination file '%s': %a." fn_dst exs e 81 | | `CannotOpenDstFile(fn_dst, e) -> 82 | spf "Cannot open destination file '%s': %a." fn_dst exs e 83 | | `CannotOpenSrcFile(fn_src, e) -> 84 | spf "Cannot open source file '%s': %a." fn_src exs e 85 | | `ErrorRead(fn_src, e) -> 86 | spf "Error reading file '%s': %a." fn_src exs e 87 | | `ErrorWrite(fn_dst, e) -> 88 | spf "Error writing file '%s': %a." fn_dst exs e 89 | | `PartialWrite(fn_dst, read, written) -> 90 | spf 91 | "Partial write to file '%s': %d read, %d written." 92 | fn_dst 93 | read 94 | written 95 | | `CannotCopyDir fn_src -> 96 | spf "Cannot copy directory '%s' recursively." fn_src 97 | | `DstDirNotDir fn_dst -> 98 | spf "Destination '%s' is not a directory." fn_dst 99 | | `CannotCreateDir(fn_dst, e) -> 100 | spf "Cannot create directory '%s': %a." fn_dst exs e 101 | | `CannotListSrcDir(fn_src, e) -> 102 | spf "Cannot list directory '%s': %a." fn_src exs e 103 | | `CannotChmodDstDir(fn_dst, e) -> 104 | spf "'Cannot chmod directory %s': %a." fn_dst exs e 105 | | `NoSourceFile fn_src -> 106 | spf "Source file '%s' doesn't exist." fn_src 107 | | `SameFile(fn_src, fn_dst) -> 108 | spf "'%s' and '%s' are the same file." fn_src fn_dst 109 | | `UnhandledType(fn_src, _) -> 110 | spf "Cannot handle the type of kind for file '%s'." fn_src 111 | | `CannotCopyFilesToFile(_, fn_dst) -> 112 | spf "Cannot copy a list of files to another file '%s'." fn_dst 113 | | #exc -> "") 114 | in 115 | let handle_error e = 116 | herror ~fatal:false e; 117 | raise CpSkip 118 | in 119 | let handle_exception f a h = 120 | try 121 | f a 122 | with e -> 123 | herror ~fatal:false (h e); 124 | raise CpSkip 125 | in 126 | 127 | let copy_time_props st_src fln_dst = 128 | if preserve then begin 129 | touch 130 | ~time:(Touch_timestamp st_src.modification_time) 131 | ~mtime:true 132 | ~create:false 133 | fln_dst; 134 | touch 135 | ~time:(Touch_timestamp st_src.access_time) 136 | ~atime:true 137 | ~create:false 138 | fln_dst; 139 | end 140 | in 141 | 142 | let buffer = Bytes.make 1024 ' ' in 143 | 144 | let cp_file st_src dst_exists fn_src fn_dst = 145 | let mode = int_of_permission st_src.permission in 146 | (* POSIX conditions: *) 147 | (* 3a *) 148 | let fd_dst = 149 | (* 3ai *) 150 | if dst_exists && doit force fn_dst then begin 151 | try 152 | (* 3aii *) 153 | Unix.openfile fn_dst [Unix.O_WRONLY; Unix.O_TRUNC] mode 154 | with _ -> 155 | (* 3aii *) 156 | handle_exception 157 | (fun lst -> rm lst) [fn_dst] 158 | (fun e -> `CannotRemoveDstFile(fn_dst, e)); 159 | handle_exception 160 | (Unix.openfile fn_dst [Unix.O_WRONLY; Unix.O_CREAT]) mode 161 | (fun e -> `CannotOpenDstFile(fn_dst, e)) 162 | end else if not dst_exists then begin 163 | handle_exception 164 | (Unix.openfile fn_dst [Unix.O_WRONLY; Unix.O_CREAT]) mode 165 | (fun e -> `CannotOpenDstFile(fn_dst, e)) 166 | end else begin 167 | raise CpSkip 168 | end 169 | in 170 | let read = ref 0 in 171 | try 172 | let fd_src = 173 | handle_exception 174 | (Unix.openfile fn_src [Unix.O_RDONLY]) 0o600 175 | (fun e -> `CannotOpenSrcFile(fn_src, e)) 176 | in 177 | try 178 | while (read := 179 | handle_exception 180 | (Unix.read fd_src buffer 0) (Bytes.length buffer) 181 | (fun e -> `ErrorRead(fn_src, e)); 182 | !read <> 0) do 183 | let written = 184 | handle_exception 185 | (Unix.write fd_dst buffer 0) !read 186 | (fun e -> `ErrorWrite(fn_dst, e)) 187 | in 188 | if written != !read then 189 | handle_error (`PartialWrite(fn_src, !read, written)) 190 | done; 191 | Unix.close fd_src; 192 | Unix.close fd_dst; 193 | copy_time_props st_src fn_dst 194 | with e -> 195 | let bt = Printexc.get_raw_backtrace () in 196 | silent_close fd_src; 197 | Printexc.raise_with_backtrace e bt 198 | with e -> 199 | let bt = Printexc.get_raw_backtrace () in 200 | silent_close fd_dst; 201 | Printexc.raise_with_backtrace e bt 202 | in 203 | 204 | let cp_symlink fn_src fn_dst = 205 | (* No Unix.lutimes to set time of the symlink. *) 206 | Unix.symlink (Unix.readlink fn_src) fn_dst 207 | in 208 | 209 | let rec cp_dir st_src dst_exists fn_src fn_dst = 210 | (* 2a *) 211 | if not recurse then begin 212 | handle_error (`CannotCopyDir fn_src) 213 | (* 2d, 2c *) 214 | end else if dst_exists && (stat fn_dst).kind <> Dir then begin 215 | handle_error (`DstDirNotDir fn_dst) 216 | end else begin 217 | (* 2e *) 218 | let dst_created = 219 | if not dst_exists then begin 220 | let mode = 221 | let src_mode = int_of_permission st_src.permission in 222 | let dst_mode = 223 | if preserve then src_mode else umask_apply src_mode 224 | in 225 | `Octal (dst_mode lor 0o0700) 226 | in 227 | handle_exception 228 | (fun fn -> mkdir ~mode fn) fn_dst 229 | (fun e -> `CannotCreateDir(fn_dst, e)); 230 | true 231 | end else begin 232 | false 233 | end 234 | in 235 | (* 2f *) 236 | Array.iter 237 | (fun bn -> 238 | if not (is_current bn || is_parent bn) then 239 | cp_one (concat fn_src bn) (concat fn_dst bn)) 240 | (handle_exception 241 | Sys.readdir fn_src 242 | (fun e -> `CannotListSrcDir(fn_src, e))); 243 | (* 2g *) 244 | if dst_created then begin 245 | let mode = 246 | let src_mode = int_of_permission st_src.permission in 247 | `Octal (if preserve then src_mode else umask_apply src_mode) 248 | in 249 | handle_exception 250 | (chmod mode) [fn_dst] 251 | (fun e -> `CannotChmodDstDir(fn_dst, e)); 252 | copy_time_props st_src fn_dst 253 | end 254 | end 255 | 256 | and cp_one fn_src fn_dst = 257 | let st_src, st_src_deref = 258 | (* Check existence of source files. *) 259 | if test_exists fn_src then begin 260 | let st = stat fn_src in 261 | if st.kind = Symlink && not recurse then begin 262 | st, stat ~dereference:true fn_src 263 | end else begin 264 | st, st 265 | end 266 | end else begin 267 | handle_error (`NoSourceFile fn_src) 268 | end 269 | in 270 | 271 | let same_file, dst_exists = 272 | (* Test if fn_dst exists and if it is the same file as fn_src. *) 273 | try 274 | same_file st_src (stat fn_dst), true 275 | with FileDoesntExist _ -> 276 | false, false 277 | in 278 | 279 | if same_file then begin 280 | handle_error (`SameFile(fn_src, fn_dst)) 281 | end; 282 | try 283 | match st_src.kind with 284 | | Dir -> cp_dir st_src dst_exists fn_src fn_dst 285 | | File -> cp_file st_src dst_exists fn_src fn_dst 286 | | Symlink -> 287 | if st_src_deref.kind = Dir || recurse then 288 | cp_symlink fn_src fn_dst 289 | else 290 | cp_file st_src_deref dst_exists fn_src fn_dst 291 | | Fifo | Dev_char | Dev_block | Socket -> 292 | handle_error (`UnhandledType(fn_src, st_src.kind)) 293 | with CpSkip -> 294 | () 295 | in 296 | if test Is_dir fln_dst then 297 | List.iter 298 | (fun fn_src -> 299 | cp_one fn_src (concat fln_dst (basename fn_src))) 300 | fln_src_lst 301 | else if List.length fln_src_lst <= 1 then 302 | List.iter 303 | (fun fn_src -> cp_one fn_src fln_dst) 304 | fln_src_lst 305 | else 306 | handle_error (`CannotCopyFilesToFile(fln_src_lst, fln_dst)) 307 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilDU.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilTypes 23 | open FileUtilSize 24 | open FileUtilSTAT 25 | open FileUtilFIND 26 | 27 | 28 | let du fln_lst = 29 | let du_aux (sz, lst) fln = 30 | let st = stat fln in 31 | (size_add sz st.size, (fln, st.size) :: lst) 32 | in 33 | List.fold_left 34 | (fun accu fln -> find True fln du_aux accu) 35 | (B 0L, []) 36 | fln_lst 37 | 38 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilFIND.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilTypes 23 | open FilePath 24 | open FileUtilMisc 25 | open FileUtilTEST 26 | open FileUtilSTAT 27 | open FileUtilREADLINK 28 | 29 | 30 | let find ?(follow=Skip) ?match_compile tst fln exec user_acc = 31 | 32 | let user_test = compile_filter ?match_compile tst in 33 | 34 | let skip_action = 35 | match follow with 36 | | Skip | AskFollow _ | Follow -> ignore 37 | | SkipInform f -> f 38 | in 39 | 40 | let should_skip fln already_followed = 41 | match follow with 42 | | Skip | SkipInform _ -> true 43 | | AskFollow f -> 44 | if not already_followed then 45 | f fln 46 | else 47 | true 48 | | Follow -> 49 | if already_followed then 50 | raise (RecursiveLink fln) 51 | else 52 | false 53 | in 54 | 55 | let already_read = ref SetFilename.empty in 56 | 57 | let rec find_aux acc fln = 58 | let st_opt = 59 | try 60 | Some (stat fln) 61 | with FileDoesntExist _ -> 62 | None 63 | in 64 | let stL_opt = 65 | match st_opt with 66 | | Some st when st.is_link -> 67 | begin 68 | try 69 | Some (stat ~dereference:true fln) 70 | with FileDoesntExist _ -> 71 | None 72 | end 73 | | _ -> 74 | st_opt 75 | in 76 | let acc = 77 | if user_test ?st_opt ?stL_opt fln then 78 | exec acc fln 79 | else 80 | acc 81 | in 82 | match st_opt with 83 | | Some st -> 84 | if st.kind = Symlink then begin 85 | follow_symlink stL_opt acc fln 86 | end else if st.kind = Dir then begin 87 | enter_dir acc fln 88 | end else begin 89 | acc 90 | end 91 | | None -> acc 92 | 93 | and enter_dir acc drn = 94 | Array.fold_left 95 | (fun acc rfln -> 96 | if is_parent rfln || is_current rfln then 97 | acc 98 | else 99 | find_aux acc (concat drn rfln)) 100 | acc 101 | (Sys.readdir drn) 102 | 103 | and follow_symlink stL_opt acc fln = 104 | match stL_opt with 105 | | Some stL when stL.kind = Dir -> 106 | let cur_link = readlink fln in 107 | let already_followed = 108 | try 109 | already_read := prevent_recursion !already_read cur_link; 110 | false 111 | with RecursiveLink _ -> 112 | true 113 | in 114 | if should_skip fln already_followed then begin 115 | skip_action fln; 116 | acc 117 | end else begin 118 | enter_dir acc fln 119 | end 120 | | _ -> 121 | acc 122 | in 123 | find_aux user_acc (reduce fln) 124 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilLS.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilMisc 23 | 24 | 25 | let ls dirname = 26 | let array_dir = Sys.readdir (solve_dirname dirname) in 27 | let list_dir = Array.to_list array_dir in 28 | List.map 29 | (fun x -> FilePath.concat dirname x) 30 | list_dir 31 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilMKDIR.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilTypes 23 | open FilePath 24 | open FileUtilMisc 25 | open FileUtilTEST 26 | open FileUtilUMASK 27 | open FileUtilCHMOD 28 | 29 | exception MkdirError of string 30 | 31 | type mkdir_error = 32 | [ `DirnameAlreadyUsed of filename 33 | | `Exc of exn 34 | | `MissingComponentPath of filename 35 | | `MkdirChmod of filename * Unix.file_perm * string * exc ] 36 | 37 | 38 | let mkdir 39 | ?(error=(fun str _ -> raise (MkdirError str))) 40 | ?(parent=false) 41 | ?mode dn = 42 | let handle_error, handle_exception = 43 | handle_error_gen "mkdir" error 44 | (function 45 | | `DirnameAlreadyUsed fn -> 46 | Printf.sprintf "Directory %s already exists and is a file." fn 47 | | `MissingComponentPath fn -> 48 | Printf.sprintf 49 | "Unable to create directory %s, an upper directory is missing." 50 | fn 51 | | `MkdirChmod (dn, mode, str, _) -> 52 | Printf.sprintf 53 | "Recursive error in 'mkdir %s' in 'chmod %04o %s': %s" 54 | dn mode dn str 55 | | #exc -> "") 56 | in 57 | let mode_apply = 58 | FileUtilMode.apply ~is_dir:true ~umask:(umask (`Octal (fun i -> i))) 59 | in 60 | let mode_self = 61 | match mode with 62 | | Some (`Octal m) -> m 63 | | Some (`Symbolic t) -> mode_apply 0o777 t 64 | | None -> umask_apply 0o0777 65 | in 66 | let mode_parent = 67 | umask 68 | (`Symbolic 69 | (fun t -> 70 | mode_apply 0 (t @ [`User (`Add (`List [`Write; `Exec]))]))) 71 | in 72 | let rec mkdir_simple mode dn = 73 | if test_exists dn then begin 74 | if test (Not Is_dir) dn then 75 | handle_error ~fatal:true (`DirnameAlreadyUsed dn); 76 | end else begin 77 | if parent then begin 78 | mkdir_simple mode_parent (dirname dn) 79 | end; 80 | (* Make sure that the directory has not been created as a side effect 81 | * of creating the parent. 82 | *) 83 | if not (test_exists dn) then begin 84 | try 85 | Unix.mkdir dn mode; 86 | chmod 87 | ~error:(fun str e -> 88 | handle_error ~fatal:true 89 | (`MkdirChmod (dn, mode, str, e))) 90 | (`Octal mode) [dn] 91 | with Unix.Unix_error(Unix.ENOENT, _, _) 92 | | Unix.Unix_error(Unix.ENOTDIR, _, _) -> 93 | handle_error ~fatal:true (`MissingComponentPath dn) 94 | | e -> handle_exception ~fatal:true e 95 | end 96 | end 97 | in 98 | mkdir_simple mode_self dn (* (FilePath.reduce dn) *) 99 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilMV.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilTypes 23 | open FilePath 24 | open FileUtilMisc 25 | open FileUtilPWD 26 | open FileUtilRM 27 | open FileUtilCP 28 | open FileUtilTEST 29 | 30 | 31 | exception MvError of string 32 | 33 | type mv_error = 34 | [ `Exc of exn 35 | | `MvCp of filename * filename * string * cp_error 36 | | `MvRm of filename * string * rm_error 37 | | `NoSourceFile ] 38 | 39 | 40 | let rec mv 41 | ?(error=fun str _ -> raise (MvError str)) 42 | ?(force=Force) 43 | fln_src fln_dst = 44 | let handle_error, _ = 45 | handle_error_gen "mv" error 46 | (function 47 | | `NoSourceFile -> 48 | "Cannot move an empty list of files." 49 | | `MvCp (fn_src, fn_dst, str, _) -> 50 | Printf.sprintf 51 | "Recursive error in 'mv %s %s' for 'cp %s %s': %s" 52 | fn_src fn_dst fn_src fn_dst str 53 | | `MvRm (fn, str, _) -> 54 | Printf.sprintf "Recursive error in 'mv %s ..' for 'rm %s': %s" 55 | fn fn str 56 | | #exc -> "") 57 | in 58 | let fln_src_abs = make_absolute (pwd ()) fln_src in 59 | let fln_dst_abs = make_absolute (pwd ()) fln_dst in 60 | if compare fln_src_abs fln_dst_abs <> 0 then begin 61 | if test_exists fln_dst_abs && doit force fln_dst then begin 62 | rm [fln_dst_abs]; 63 | mv fln_src_abs fln_dst_abs 64 | end else if test Is_dir fln_dst_abs then begin 65 | mv ~force ~error 66 | fln_src_abs 67 | (make_absolute 68 | fln_dst_abs 69 | (basename fln_src_abs)) 70 | end else if test_exists fln_src_abs then begin 71 | try 72 | Sys.rename fln_src_abs fln_dst_abs 73 | with Sys_error _ -> 74 | cp ~force 75 | ~error:(fun str e -> 76 | handle_error ~fatal:true 77 | (`MvCp (fln_src_abs, fln_dst_abs, str, e))) 78 | ~recurse:true [fln_src_abs] fln_dst_abs; 79 | rm ~force 80 | ~error:(fun str e -> 81 | handle_error ~fatal:true 82 | (`MvRm (fln_src_abs, str, e))) 83 | ~recurse:true [fln_src_abs] 84 | end else 85 | handle_error ~fatal:true `NoSourceFile 86 | end 87 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilMisc.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilTypes 23 | open FilePath 24 | 25 | module SetFilename = Set.Make (struct 26 | type t = filename 27 | let compare = FilePath.compare 28 | end) 29 | 30 | 31 | let doit force fln = 32 | match force with 33 | Force -> true 34 | | Ask ask -> ask fln 35 | 36 | 37 | let prevent_recursion fln_set fln = 38 | (* TODO: use a set of dev/inode *) 39 | if SetFilename.mem fln fln_set then 40 | raise (RecursiveLink fln) 41 | else 42 | SetFilename.add fln fln_set 43 | 44 | 45 | let solve_dirname dirname = 46 | (* We have an ambiguity concerning "" and "." *) 47 | if is_current dirname then 48 | current_dir 49 | else 50 | reduce dirname 51 | 52 | 53 | type exc = [ `Exc of exn ] 54 | 55 | 56 | let handle_error_gen nm error custom = 57 | let handle_error ~fatal e = 58 | let str = 59 | match e with 60 | | `Exc (Unix.Unix_error(err, nm, arg)) -> 61 | Printf.sprintf "%s: %s (%s, %S)" nm (Unix.error_message err) nm arg 62 | | `Exc exc -> 63 | Printf.sprintf "%s: %s" nm (Printexc.to_string exc) 64 | | e -> custom e 65 | in 66 | if fatal then begin 67 | try 68 | error str e; 69 | raise (Fatal str) 70 | with exc -> 71 | raise exc 72 | end else begin 73 | error str e 74 | end 75 | in 76 | let handle_exception ~fatal exc = 77 | handle_error ~fatal (`Exc exc) 78 | in 79 | handle_error, handle_exception 80 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilMode.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | type who = [`User | `Group | `Other | `All] 23 | type wholist = [ who | `List of who list ] 24 | type permcopy = [`User | `Group | `Other] 25 | type perm = [ `Read | `Write | `Exec | `ExecX | `Sticky | `StickyO ] 26 | type permlist = [ perm | `List of perm list ] 27 | type actionarg = [ permlist | permcopy ] 28 | type action = [ `Set of actionarg | `Add of actionarg | `Remove of actionarg] 29 | type actionlist = [ action | `List of action list ] 30 | type clause = [ `User of actionlist | `Group of actionlist 31 | | `Other of actionlist | `All of actionlist 32 | | `None of actionlist ] 33 | 34 | type t = clause list 35 | 36 | 37 | let all_masks = 38 | [ 39 | `User, `Sticky, 0o4000; 40 | `User, `Exec, 0o0100; 41 | `User, `Write, 0o0200; 42 | `User, `Read, 0o0400; 43 | `Group, `Sticky, 0o2000; 44 | `Group, `Exec, 0o0010; 45 | `Group, `Write, 0o0020; 46 | `Group, `Read, 0o0040; 47 | `Other, `StickyO, 0o1000; 48 | `Other, `Exec, 0o0001; 49 | `Other, `Write, 0o0002; 50 | `Other, `Read, 0o0004; 51 | ] 52 | 53 | 54 | let mask = 55 | let module M = 56 | Map.Make 57 | (struct 58 | type t = who * perm 59 | let compare = Stdlib.compare 60 | end) 61 | in 62 | let m = 63 | List.fold_left 64 | (fun m (who, prm, msk) -> M.add (who, prm) msk m) 65 | M.empty all_masks 66 | in 67 | fun who prm -> 68 | try 69 | M.find (who, prm) m 70 | with Not_found -> 71 | 0 72 | 73 | 74 | let of_int i = 75 | let user, group, other = 76 | List.fold_left 77 | (fun (user, group, other) (who, perm, mask) -> 78 | if (i land mask) <> 0 then begin 79 | match who with 80 | | `User -> perm :: user, group, other 81 | | `Group -> user, perm :: group, other 82 | | `Other -> user, group, perm :: other 83 | end else begin 84 | (user, group, other) 85 | end) 86 | ([], [], []) 87 | all_masks 88 | in 89 | [`User (`Set (`List user)); 90 | `Group (`Set (`List group)); 91 | `Other (`Set (`List other))] 92 | 93 | 94 | let to_string = 95 | let perm = 96 | function 97 | | `Read -> "r" 98 | | `Write -> "w" 99 | | `Exec -> "x" 100 | | `Sticky -> "s" 101 | | `ExecX -> "X" 102 | | `StickyO -> "t" 103 | in 104 | let permlist = 105 | function 106 | | `List lst -> String.concat "" (List.map perm lst) 107 | | #perm as prm -> perm prm 108 | in 109 | let permcopy = 110 | function 111 | | `User -> "u" 112 | | `Group -> "g" 113 | | `Other -> "o" 114 | in 115 | let action act = 116 | let sact, arg = 117 | match act with 118 | | `Set arg -> "=", arg 119 | | `Add arg -> "+", arg 120 | | `Remove arg -> "-", arg 121 | in 122 | let sarg = 123 | match arg with 124 | | #permlist as lst -> permlist lst 125 | | #permcopy as prm -> permcopy prm 126 | in 127 | sact^sarg 128 | in 129 | let actionlist = 130 | function 131 | | `List lst -> String.concat "" (List.map action lst) 132 | | #action as act -> action act 133 | in 134 | let clause cls = 135 | let swho, lst = 136 | match cls with 137 | | `User lst -> "u", lst 138 | | `Group lst -> "g", lst 139 | | `Other lst -> "o", lst 140 | | `All lst -> "a", lst 141 | | `None lst -> "", lst 142 | in 143 | swho^(actionlist lst) 144 | in 145 | fun t -> String.concat "," (List.map clause t) 146 | 147 | 148 | let apply ~is_dir ~umask i (t: t) = 149 | let set who prm b i = 150 | let m = mask who prm in 151 | if b then i lor m else i land (lnot m) 152 | in 153 | let get who prm i = 154 | let m = mask who prm in 155 | (i land m) <> 0 156 | in 157 | let permlist _who i lst = 158 | List.fold_left 159 | (fun acc -> 160 | function 161 | | `Exec | `Read | `Write | `Sticky | `StickyO as a -> a :: acc 162 | | `ExecX -> 163 | if is_dir || 164 | List.exists (fun who -> get who `Exec i) 165 | [`User; `Group; `Other] then 166 | `Exec :: acc 167 | else 168 | acc) 169 | [] 170 | (match lst with 171 | | `List lst -> lst 172 | | #perm as prm -> [prm]) 173 | in 174 | let permcopy _who i = 175 | List.fold_left 176 | (fun acc (who, prm, _) -> 177 | if get who prm i then 178 | prm :: acc 179 | else 180 | acc) 181 | [] all_masks 182 | in 183 | let args who i = 184 | function 185 | | #permlist as lst -> permlist who i lst 186 | | #permcopy as who -> permcopy who i 187 | in 188 | let rec action who i act = 189 | match act with 190 | | `Set arg -> 191 | action who 192 | (action who i (`Remove (`List (permcopy who i)))) 193 | (`Add arg) 194 | | `Add arg -> 195 | List.fold_left (fun i prm -> set who prm true i) i (args who i arg) 196 | | `Remove arg -> 197 | List.fold_left (fun i prm -> set who prm false i) i (args who i arg) 198 | in 199 | let actionlist who i lst = 200 | match lst with 201 | | `List lst -> List.fold_left (action who) i lst 202 | | #action as act -> action who i act 203 | in 204 | let actionlist_none i lst = 205 | let numask = lnot umask in 206 | let arg_set_if_mask who i arg b = 207 | List.fold_left 208 | (fun i prm -> 209 | if get who prm numask then 210 | set who prm b i 211 | else 212 | i) 213 | i (args who i arg) 214 | in 215 | List.fold_left 216 | (fun i who -> 217 | List.fold_left 218 | (fun i -> 219 | function 220 | | `Set _ -> i 221 | | `Add arg -> arg_set_if_mask who i arg true 222 | | `Remove arg -> arg_set_if_mask who i arg false) 223 | i 224 | (match lst with 225 | | `List lst -> lst 226 | | #action as act -> [act])) 227 | i [`User; `Group; `Other] 228 | in 229 | 230 | let rec clause i cls = 231 | match cls with 232 | | `User lst -> actionlist `User i lst 233 | | `Group lst -> actionlist `Group i lst 234 | | `Other lst -> actionlist `Other i lst 235 | | `All lst -> 236 | List.fold_left clause i [`User lst; `Group lst; `Other lst] 237 | | `None lst -> actionlist_none i lst 238 | in 239 | List.fold_left clause i t 240 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilPWD.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | let pwd () = FilePath.reduce (Sys.getcwd ()) 23 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilPermission.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilTypes 23 | 24 | 25 | let permission_of_int pr = 26 | let perm_match oct = 27 | (pr land oct) <> 0 28 | in 29 | { 30 | user = 31 | { 32 | sticky = perm_match 0o4000; 33 | exec = perm_match 0o0100; 34 | write = perm_match 0o0200; 35 | read = perm_match 0o0400; 36 | }; 37 | group = 38 | { 39 | sticky = perm_match 0o2000; 40 | exec = perm_match 0o0010; 41 | write = perm_match 0o0020; 42 | read = perm_match 0o0040; 43 | }; 44 | other = 45 | { 46 | sticky = perm_match 0o1000; 47 | exec = perm_match 0o0001; 48 | write = perm_match 0o0002; 49 | read = perm_match 0o0004; 50 | }; 51 | } 52 | 53 | 54 | let int_of_permission pr = 55 | let permission_int = [ 56 | (pr.user.sticky, 0o4000); 57 | (pr.user.exec, 0o0100); 58 | (pr.user.write, 0o0200); 59 | (pr.user.read, 0o0400); 60 | (pr.group.sticky, 0o2000); 61 | (pr.group.exec, 0o0010); 62 | (pr.group.write, 0o0020); 63 | (pr.group.read, 0o0040); 64 | (pr.other.sticky, 0o1000); 65 | (pr.other.exec, 0o0001); 66 | (pr.other.write, 0o0002); 67 | (pr.other.read, 0o0004) 68 | ] 69 | in 70 | List.fold_left (fun full_perm (b, perm) -> 71 | if b then 72 | perm lor full_perm 73 | else 74 | full_perm) 75 | 0o0000 permission_int 76 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilREADLINK.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilTypes 23 | open FilePath 24 | open FileUtilMisc 25 | open FileUtilPWD 26 | open FileUtilTEST 27 | 28 | 29 | let readlink fln = 30 | let all_upper_dir fln = 31 | let rec all_upper_dir_aux lst fln = 32 | let dir = dirname fln in 33 | match lst with 34 | | prev_dir :: _ when prev_dir = dir -> lst 35 | | _ -> all_upper_dir_aux (dir :: lst) dir 36 | in 37 | all_upper_dir_aux [fln] fln 38 | in 39 | let ctst = 40 | let st_opt, stL_opt = None, None in 41 | compile_filter ?st_opt ?stL_opt Is_link 42 | in 43 | let rec readlink_aux already_read fln = 44 | let newly_read = prevent_recursion already_read fln in 45 | let dirs = all_upper_dir fln in 46 | try 47 | let src_link = List.find ctst (List.rev dirs) in 48 | let dst_link = Unix.readlink src_link in 49 | let real_link = 50 | if is_relative dst_link then 51 | reduce (concat (dirname src_link) dst_link) 52 | else 53 | reduce dst_link 54 | in 55 | readlink_aux newly_read (reparent src_link real_link fln) 56 | with Not_found -> 57 | fln 58 | in 59 | readlink_aux SetFilename.empty (make_absolute (pwd ()) fln) 60 | 61 | 62 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilRM.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilTypes 23 | open FilePath 24 | open FileUtilMisc 25 | open FileUtilTEST 26 | open FileUtilLS 27 | 28 | exception RmError of string 29 | 30 | type rm_error = 31 | [ `DirNotEmpty of filename 32 | | `Exc of exn 33 | | `NoRecurse of filename ] 34 | 35 | 36 | let rm 37 | ?(error=fun str _ -> raise (RmError str)) 38 | ?(force=Force) 39 | ?(recurse=false) 40 | fln_lst = 41 | let handle_error, handle_exception = 42 | handle_error_gen "rm" error 43 | (function 44 | | `DirNotEmpty fn -> 45 | Printf.sprintf "Directory %s not empty." fn 46 | | `NoRecurse fn -> 47 | Printf.sprintf 48 | "Cannot delete directory %s when recurse is not set." 49 | fn 50 | | #exc -> "") 51 | in 52 | let test_dir = test (And(Is_dir, Not(Is_link))) in 53 | let rmdir fn = 54 | try 55 | Unix.rmdir fn 56 | with 57 | | Unix.Unix_error(Unix.ENOTEMPTY, _, _) -> 58 | handle_error ~fatal:true (`DirNotEmpty fn) 59 | | e -> 60 | handle_exception ~fatal:true e 61 | in 62 | let rec rm_aux lst = 63 | List.iter 64 | (fun fn -> 65 | let exists = 66 | try 67 | let _st: Unix.LargeFile.stats = Unix.LargeFile.lstat fn in 68 | true 69 | with Unix.Unix_error(Unix.ENOENT, _, _) -> 70 | false 71 | in 72 | if exists && (doit force fn) then begin 73 | if test_dir fn then begin 74 | if recurse then begin 75 | rm_aux (ls fn); 76 | rmdir fn 77 | end else 78 | handle_error ~fatal:true (`NoRecurse fn) 79 | end else 80 | Unix.unlink fn 81 | end) 82 | lst 83 | in 84 | rm_aux fln_lst 85 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilSTAT.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilTypes 23 | open FileUtilPermission 24 | 25 | 26 | let stat ?(dereference=false) fln = 27 | let kind_of_stat ustat = 28 | match ustat.Unix.LargeFile.st_kind with 29 | | Unix.S_REG -> File 30 | | Unix.S_DIR -> Dir 31 | | Unix.S_CHR -> Dev_char 32 | | Unix.S_BLK -> Dev_block 33 | | Unix.S_FIFO -> Fifo 34 | | Unix.S_SOCK -> Socket 35 | | Unix.S_LNK -> Symlink 36 | in 37 | try 38 | let ustat = Unix.LargeFile.lstat fln in 39 | let is_link = (kind_of_stat ustat = Symlink) in 40 | let ustat = 41 | if is_link && dereference then 42 | Unix.LargeFile.stat fln 43 | else 44 | ustat 45 | in 46 | { 47 | kind = kind_of_stat ustat; 48 | is_link = is_link; 49 | permission = permission_of_int ustat.Unix.LargeFile.st_perm; 50 | size = B ustat.Unix.LargeFile.st_size; 51 | owner = ustat.Unix.LargeFile.st_uid; 52 | group_owner = ustat.Unix.LargeFile.st_gid; 53 | access_time = ustat.Unix.LargeFile.st_atime; 54 | modification_time = ustat.Unix.LargeFile.st_mtime; 55 | creation_time = ustat.Unix.LargeFile.st_ctime; 56 | device = ustat.Unix.LargeFile.st_dev; 57 | inode = ustat.Unix.LargeFile.st_ino; 58 | } 59 | with Unix.Unix_error(Unix.ENOENT, _, _) -> 60 | raise (FileDoesntExist fln) 61 | 62 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilSize.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilTypes 23 | 24 | let byte_of_size sz = 25 | let rec mul_1024 n i = 26 | if n > 0 then 27 | mul_1024 28 | (n - 1) 29 | (Int64.mul 1024L i) 30 | else 31 | i 32 | in 33 | match sz with 34 | | B i -> i 35 | | KB i -> mul_1024 1 i 36 | | MB i -> mul_1024 2 i 37 | | GB i -> mul_1024 3 i 38 | | TB i -> mul_1024 4 i 39 | 40 | 41 | let size_add sz1 sz2 = 42 | B (Int64.add (byte_of_size sz1) (byte_of_size sz2)) 43 | 44 | 45 | let size_compare ?(fuzzy=false) sz1 sz2 = 46 | let by1 = 47 | byte_of_size sz1 48 | in 49 | let by2 = 50 | byte_of_size sz2 51 | in 52 | if fuzzy then begin 53 | let rec fuzzy_comp n1 n2 = 54 | if n1 = n2 then 55 | 0 56 | else begin 57 | let up_unit_n1 = 58 | Int64.div n1 1024L 59 | in 60 | let up_unit_n2 = 61 | Int64.div n2 1024L 62 | in 63 | if up_unit_n1 <> 0L && up_unit_n2 <> 0L then 64 | fuzzy_comp up_unit_n1 up_unit_n2 65 | else 66 | Int64.compare n1 n2 67 | end 68 | in 69 | fuzzy_comp by1 by2 70 | end else 71 | Int64.compare by1 by2 72 | 73 | 74 | let string_of_size ?(fuzzy=false) sz = 75 | let szstr i unt (cur_i, cur_unt, tl) = 76 | let tl = 77 | (cur_i, cur_unt) :: tl 78 | in 79 | i, unt, tl 80 | in 81 | 82 | let rec decomp_continue fup i unt acc = 83 | if i = 0L then 84 | szstr i unt acc 85 | else begin 86 | (* Continue with upper unit *) 87 | let r = 88 | Int64.rem i 1024L 89 | in 90 | let q = 91 | Int64.div i 1024L 92 | in 93 | decomp_start (szstr r unt acc) (fup q) 94 | end 95 | 96 | and decomp_start acc sz = 97 | (* Decompose size for current unit and try 98 | * to use upper unit 99 | *) 100 | match sz with 101 | | TB i -> 102 | szstr i "TB" acc 103 | | GB i -> 104 | decomp_continue (fun n -> TB n) i "GB" acc 105 | | MB i -> 106 | decomp_continue (fun n -> GB n) i "MB" acc 107 | | KB i -> 108 | decomp_continue (fun n -> MB n) i "KB" acc 109 | | B i -> 110 | decomp_continue (fun n -> KB n) i "B" acc 111 | in 112 | 113 | (* Only accumulate significant unit in tail *) 114 | let only_significant_unit (cur_i, cur_unt, lst) = 115 | let significant_lst = 116 | List.filter 117 | (fun (i, _) -> i <> 0L) 118 | ((cur_i, cur_unt) :: lst) 119 | in 120 | match significant_lst with 121 | | [] -> cur_i, cur_unt, [] 122 | | (cur_i, cur_unt) :: tl -> (cur_i, cur_unt, tl) 123 | in 124 | 125 | let main_i, main_unt, rem_lst = 126 | only_significant_unit (decomp_start (0L, "B", []) sz) 127 | in 128 | 129 | if fuzzy then begin 130 | let _, rem = 131 | List.fold_left 132 | (fun (div, acc) (i, _unt) -> 133 | let acc = 134 | acc +. ((Int64.to_float i) /. div) 135 | in 136 | div *. 1024.0, 137 | acc) 138 | (1024.0, 0.0) 139 | rem_lst 140 | in 141 | Printf.sprintf "%.2f %s" 142 | ((Int64.to_float main_i) +. rem) 143 | main_unt 144 | end else begin 145 | String.concat 146 | " " 147 | (List.map 148 | (fun (i, unt) -> Printf.sprintf "%Ld %s" i unt) 149 | ((main_i, main_unt) :: rem_lst)) 150 | end 151 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilTEST.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilTypes 23 | open FilePath 24 | open FileUtilMisc 25 | open FileUtilSize 26 | open FileUtilSTAT 27 | 28 | 29 | let compile_filter ?(match_compile=(fun s fn -> s = fn)) flt = 30 | let cflt = 31 | let rec cc = 32 | function 33 | | True -> `Val true 34 | | False -> `Val false 35 | | Is_dev_block -> `Stat (`Kind Dev_block) 36 | | Is_dev_char -> `Stat (`Kind Dev_char) 37 | | Is_dir -> `Stat (`Kind Dir) 38 | | Is_file -> `Stat (`Kind File) 39 | | Is_socket -> `Stat (`Kind Socket) 40 | | Is_pipe -> `Stat (`Kind Fifo) 41 | | Is_link -> `Is_link 42 | | Is_set_group_ID -> `Stat `Is_set_group_ID 43 | | Has_sticky_bit -> `Stat `Has_sticky_bit 44 | | Has_set_user_ID -> `Stat `Has_set_user_ID 45 | | Is_readable -> `Stat `Is_readable 46 | | Is_writeable -> `Stat `Is_writeable 47 | | Is_exec -> `Stat `Is_exec 48 | | Size_not_null -> `Stat (`Size (`Bigger, B 0L)) 49 | | Size_bigger_than sz -> `Stat (`Size (`Bigger, sz)) 50 | | Size_smaller_than sz -> `Stat (`Size (`Smaller, sz)) 51 | | Size_equal_to sz -> `Stat (`Size (`Equal, sz)) 52 | | Size_fuzzy_equal_to sz -> `Stat (`Size (`FuzzyEqual, sz)) 53 | | Is_owned_by_user_ID -> 54 | `Stat (`Is_owned_by_user_ID (Unix.geteuid ())) 55 | | Is_owned_by_group_ID -> 56 | `Stat (`Is_owned_by_group_ID (Unix.getegid ())) 57 | | Exists -> `Stat `Exists 58 | | Is_newer_than fn1 -> `Stat (`Newer (stat fn1).modification_time) 59 | | Is_older_than fn1 -> `Stat (`Older (stat fn1).modification_time) 60 | | Is_newer_than_date(dt) -> `Stat (`Newer dt) 61 | | Is_older_than_date(dt) -> `Stat (`Older dt) 62 | | Has_extension ext -> `Has_extension ext 63 | | Has_no_extension -> `Has_no_extension 64 | | Is_current_dir -> `Is_current_dir 65 | | Is_parent_dir -> `Is_parent_dir 66 | | Basename_is s -> `Basename_is s 67 | | Dirname_is s -> `Dirname_is s 68 | | Custom f -> `Custom f 69 | | Match str -> `Custom (match_compile str) 70 | | And(flt1, flt2) -> 71 | begin 72 | match cc flt1, cc flt2 with 73 | | `Val true, cflt | cflt, `Val true -> cflt 74 | | `Val false, _ | _, `Val false -> `Val false 75 | | cflt1, cflt2 -> `And (cflt1, cflt2) 76 | end 77 | | Or(flt1, flt2) -> 78 | begin 79 | match cc flt1, cc flt2 with 80 | | `Val true, _ | _, `Val true -> `Val true 81 | | `Val false, cflt | cflt, `Val false -> cflt 82 | | cflt1, cflt2 -> `Or (cflt1, cflt2) 83 | end 84 | | Not flt -> 85 | begin 86 | match cc flt with 87 | | `Val b -> `Val (not b) 88 | | cflt -> `Not cflt 89 | end 90 | in 91 | cc flt 92 | in 93 | let need_statL, need_stat = 94 | let rec dfs = 95 | function 96 | | `Val _ | `Has_extension _ | `Has_no_extension | `Is_current_dir 97 | | `Is_parent_dir | `Basename_is _ | `Dirname_is _ 98 | | `Custom _ -> 99 | false, false 100 | | `Stat _ -> 101 | true, false 102 | | `Is_link -> 103 | false, true 104 | | `And (cflt1, cflt2) | `Or (cflt1, cflt2) -> 105 | let need_stat1, need_statL1 = dfs cflt1 in 106 | let need_stat2, need_statL2 = dfs cflt2 in 107 | need_stat1 || need_stat2, need_statL1 || need_statL2 108 | | `Not cflt -> 109 | dfs cflt 110 | in 111 | dfs cflt 112 | in 113 | (* Compiled function to return. *) 114 | fun ?st_opt ?stL_opt fn -> 115 | let st_opt = 116 | if need_stat && st_opt = None then begin 117 | try 118 | match stL_opt with 119 | | Some st when not st.is_link -> stL_opt 120 | | _ -> Some (stat fn) 121 | with FileDoesntExist _ -> 122 | None 123 | end else 124 | st_opt 125 | in 126 | let stL_opt = 127 | if need_statL && stL_opt = None then begin 128 | try 129 | match st_opt with 130 | | Some st when not st.is_link -> st_opt 131 | | _ -> Some (stat ~dereference:true fn) 132 | with FileDoesntExist _ -> 133 | None 134 | end else 135 | stL_opt 136 | in 137 | let rec eval = 138 | function 139 | | `Val b -> b 140 | | `Has_extension ext -> 141 | begin 142 | try 143 | check_extension fn ext 144 | with FilePath.NoExtension _ -> 145 | false 146 | end 147 | | `Has_no_extension -> 148 | begin 149 | try 150 | let _str: filename = chop_extension fn in 151 | false 152 | with FilePath.NoExtension _ -> 153 | true 154 | end 155 | | `Is_current_dir -> is_current (basename fn) 156 | | `Is_parent_dir -> is_parent (basename fn) 157 | | `Basename_is bn -> (FilePath.compare (basename fn) bn) = 0 158 | | `Dirname_is dn -> (FilePath.compare (dirname fn) dn) = 0 159 | | `Custom f -> f fn 160 | | `Stat e -> 161 | begin 162 | match stL_opt, e with 163 | | Some _, `Exists -> true 164 | | Some stL, `Kind knd -> stL.kind = knd 165 | | Some stL, `Is_set_group_ID -> stL.permission.group.sticky 166 | | Some stL, `Has_sticky_bit -> stL.permission.other.sticky 167 | | Some stL, `Has_set_user_ID -> stL.permission.user.sticky 168 | | Some stL, `Size (cmp, sz) -> 169 | begin 170 | let diff = size_compare stL.size sz in 171 | match cmp with 172 | | `Bigger -> diff > 0 173 | | `Smaller -> diff < 0 174 | | `Equal -> diff = 0 175 | | `FuzzyEqual -> 176 | (size_compare ~fuzzy:true stL.size sz) = 0 177 | end 178 | | Some stL, `Is_owned_by_user_ID uid -> uid = stL.owner 179 | | Some stL, `Is_owned_by_group_ID gid -> gid = stL.group_owner 180 | | Some stL, `Is_readable -> 181 | let perm = stL.permission in 182 | perm.user.read || perm.group.read || perm.other.read 183 | | Some stL, `Is_writeable -> 184 | let perm = stL.permission in 185 | perm.user.write || perm.group.write || perm.other.write 186 | | Some stL, `Is_exec -> 187 | let perm = stL.permission in 188 | perm.user.exec || perm.group.exec || perm.other.exec 189 | | Some stL, `Newer dt -> stL.modification_time > dt 190 | | Some stL, `Older dt -> stL.modification_time < dt 191 | | None, _ -> false 192 | end 193 | | `Is_link -> 194 | begin 195 | match st_opt with 196 | | Some st -> st.is_link 197 | | None -> false 198 | end 199 | | `And (cflt1, cflt2) -> (eval cflt1) && (eval cflt2) 200 | | `Or (cflt1, cflt2) -> (eval cflt1) || (eval cflt2) 201 | | `Not cflt -> not (eval cflt) 202 | in 203 | eval cflt 204 | 205 | 206 | let test ?match_compile tst = 207 | let ctst = compile_filter ?match_compile tst in 208 | fun fln -> ctst (solve_dirname fln) 209 | 210 | 211 | let filter flt lst = List.filter (test flt) lst 212 | 213 | 214 | let test_exists = test (Or(Exists, Is_link)) 215 | 216 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilTOUCH.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilTypes 23 | open FileUtilSTAT 24 | open FileUtilTEST 25 | 26 | 27 | let touch ?atime ?mtime ?(create=true) ?(time=Touch_now) fln = 28 | 29 | let atime, mtime = 30 | match atime, mtime with 31 | | None, None -> true, true 32 | | Some b, None -> b, false 33 | | None, Some b -> false, b 34 | | Some b1, Some b2 -> b1, b2 35 | in 36 | 37 | let set_time () = 38 | let fatime, fmtime = 39 | match time with 40 | | Touch_now -> 0.0, 0.0 41 | | Touch_timestamp time_ref -> time_ref, time_ref 42 | | Touch_file_time fln_ref -> 43 | let st = stat fln_ref in 44 | st.access_time, st.modification_time 45 | in 46 | let fatime, fmtime = 47 | if not (atime && mtime) then begin 48 | let st = stat fln in 49 | (if atime then fatime else st.access_time), 50 | (if mtime then fmtime else st.modification_time) 51 | end else begin 52 | fatime, fmtime 53 | end 54 | in 55 | Unix.utimes fln fatime fmtime 56 | in 57 | (* Create file if required *) 58 | if test_exists fln then begin 59 | set_time () 60 | end else if create then begin 61 | close_out (open_out fln); 62 | set_time () 63 | end 64 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilTypes.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FilePath 23 | 24 | exception FileDoesntExist of filename 25 | exception RecursiveLink of filename 26 | exception Fatal of string 27 | 28 | (** See FileUtil.mli *) 29 | type action_link = 30 | | Follow 31 | | Skip 32 | | SkipInform of (filename -> unit) 33 | | AskFollow of (filename -> bool) 34 | 35 | 36 | (** See FileUtil.mli *) 37 | type interactive = 38 | Force 39 | | Ask of (filename -> bool) 40 | 41 | 42 | (** See FileUtil.mli *) 43 | type size = 44 | TB of int64 45 | | GB of int64 46 | | MB of int64 47 | | KB of int64 48 | | B of int64 49 | 50 | 51 | (** See FileUtil.mli *) 52 | type kind = 53 | Dir 54 | | File 55 | | Dev_char 56 | | Dev_block 57 | | Fifo 58 | | Socket 59 | | Symlink 60 | 61 | 62 | (** See FileUtil.mli *) 63 | type base_permission = 64 | { 65 | sticky: bool; 66 | exec: bool; 67 | write: bool; 68 | read: bool; 69 | } 70 | 71 | 72 | (** See FileUtil.mli *) 73 | type permission = 74 | { 75 | user: base_permission; 76 | group: base_permission; 77 | other: base_permission; 78 | } 79 | 80 | 81 | (** See FileUtil.mli *) 82 | type stat = 83 | { 84 | kind: kind; 85 | is_link: bool; 86 | permission: permission; 87 | size: size; 88 | owner: int; 89 | group_owner: int; 90 | access_time: float; 91 | modification_time: float; 92 | creation_time: float; 93 | device: int; 94 | inode: int; 95 | } 96 | 97 | 98 | (** See FileUtil.mli *) 99 | type test_file = 100 | | Is_dev_block 101 | | Is_dev_char 102 | | Is_dir 103 | | Exists 104 | | Is_file 105 | | Is_set_group_ID 106 | | Has_sticky_bit 107 | | Is_link 108 | | Is_pipe 109 | | Is_readable 110 | | Is_writeable 111 | | Size_not_null 112 | | Size_bigger_than of size 113 | | Size_smaller_than of size 114 | | Size_equal_to of size 115 | | Size_fuzzy_equal_to of size 116 | | Is_socket 117 | | Has_set_user_ID 118 | | Is_exec 119 | | Is_owned_by_user_ID 120 | | Is_owned_by_group_ID 121 | | Is_newer_than of filename 122 | | Is_older_than of filename 123 | | Is_newer_than_date of float 124 | | Is_older_than_date of float 125 | | And of test_file * test_file 126 | | Or of test_file * test_file 127 | | Not of test_file 128 | | Match of string 129 | | True 130 | | False 131 | | Has_extension of extension 132 | | Has_no_extension 133 | | Is_parent_dir 134 | | Is_current_dir 135 | | Basename_is of filename 136 | | Dirname_is of filename 137 | | Custom of (filename -> bool) 138 | 139 | 140 | (** See FileUtil.mli *) 141 | type touch_time_t = 142 | | Touch_now 143 | | Touch_file_time of filename 144 | | Touch_timestamp of float 145 | 146 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilUMASK.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilMisc 23 | 24 | exception UmaskError of string 25 | 26 | type umask_error = [ `Exc of exn | `NoStickyBit of int ] 27 | 28 | 29 | let umask 30 | ?(error=(fun str _ -> raise (UmaskError str))) 31 | ?mode out = 32 | let handle_error, handle_exception = 33 | handle_error_gen "umask" error 34 | (function 35 | | `NoStickyBit i -> 36 | Printf.sprintf "Cannot set sticky bit in umask 0o%04o" i 37 | | #exc -> "") 38 | in 39 | let complement i = 0o0777 land (lnot i) in 40 | let try_umask i = 41 | if Sys.os_type = "Win32" then 0 else 42 | try 43 | Unix.umask i 44 | with e -> 45 | handle_exception ~fatal:true e; 46 | raise e 47 | in 48 | let get () = 49 | let cmask = try_umask 0o777 in 50 | let _mask: int = try_umask cmask in 51 | cmask 52 | in 53 | let set i = 54 | let eff_i = i land 0o777 in 55 | let _i: int = 56 | if i <> eff_i then 57 | handle_error ~fatal:true (`NoStickyBit i); 58 | try_umask eff_i 59 | in 60 | eff_i 61 | in 62 | let v = 63 | match mode with 64 | | Some (`Symbolic s) -> 65 | let v = get () in 66 | set 67 | (complement 68 | (FileUtilMode.apply ~is_dir:false ~umask:0 (complement v) s)) 69 | | Some (`Octal i) -> set i 70 | | None -> get () 71 | in 72 | match out with 73 | | `Symbolic f -> f (FileUtilMode.of_int (0o0777 land (lnot v))) 74 | | `Octal f -> f v 75 | 76 | 77 | let umask_apply m = m land (lnot (umask (`Octal (fun i -> i)))) 78 | -------------------------------------------------------------------------------- /src/lib/fileutils/FileUtilWHICH.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FileUtilTypes 23 | open FilePath 24 | open FileUtilTEST 25 | 26 | 27 | let which ?(path) fln = 28 | let real_path = 29 | match path with 30 | | None -> 31 | path_of_string 32 | (try 33 | Sys.getenv "PATH" 34 | with Not_found -> 35 | "") 36 | | Some x -> 37 | x 38 | in 39 | let exec_test = test (And(Is_exec, Is_file)) in 40 | let which_path = 41 | match Sys.os_type with 42 | | "Win32" -> 43 | begin 44 | let real_ext = 45 | List.map 46 | (fun dot_ext -> 47 | (* Remove leading "." if it exists *) 48 | if (String.length dot_ext) >= 1 && dot_ext.[0] = '.' then 49 | String.sub dot_ext 1 ((String.length dot_ext) - 1) 50 | else 51 | dot_ext) 52 | (* Extract possible extension from PATHEXT *) 53 | (path_of_string 54 | (try 55 | Sys.getenv "PATHEXT" 56 | with Not_found -> 57 | "")) 58 | in 59 | let to_filename dirname ext = add_extension (concat dirname fln) ext in 60 | let ctst dirname ext = exec_test (to_filename dirname ext) in 61 | List.fold_left 62 | (fun found dirname -> 63 | if found = None then begin 64 | try 65 | let ext = List.find (ctst dirname) real_ext in 66 | Some (to_filename dirname ext) 67 | with Not_found -> 68 | None 69 | end else 70 | found) 71 | None 72 | real_path 73 | end 74 | | _ -> 75 | begin 76 | let to_filename dirname = concat dirname fln in 77 | try 78 | Some 79 | (to_filename 80 | (List.find 81 | (fun dirname -> 82 | exec_test (to_filename dirname)) real_path)) 83 | with Not_found -> 84 | None 85 | end 86 | in 87 | match which_path with 88 | | Some fn -> fn 89 | | None -> raise Not_found 90 | -------------------------------------------------------------------------------- /src/lib/fileutils/UnixPath.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FilePath_type 23 | 24 | include CommonPath 25 | 26 | 27 | let rec dir_writer lst = 28 | match lst with 29 | Root _ :: tl -> "/"^(dir_writer tl) 30 | | [ CurrentDir Short ] -> "" 31 | | lst -> 32 | let dir_writer_aux cmp = 33 | match cmp with 34 | Root _ -> "" 35 | | ParentDir -> ".." 36 | | CurrentDir _ -> "." 37 | | Component s -> s 38 | in 39 | String.concat "/" ( List.map dir_writer_aux lst ) 40 | 41 | 42 | let dir_reader fn = 43 | let sep = '/' in 44 | let fn_part_of_string = 45 | function 46 | | "." -> CurrentDir Long 47 | | ".." -> ParentDir 48 | | str -> Component str 49 | in 50 | if (String.length fn) > 0 then begin 51 | if fn.[0] = sep then 52 | StringExt.split 53 | ~start_acc:[Root ""] 54 | ~start_pos:1 55 | ~map:fn_part_of_string 56 | sep 57 | fn 58 | else 59 | StringExt.split 60 | ~map:fn_part_of_string 61 | sep 62 | fn 63 | end else 64 | [CurrentDir Short] 65 | 66 | 67 | let path_writer lst = String.concat ":" lst 68 | 69 | 70 | let path_reader str = StringExt.split ~map:(fun s -> s) ':' str 71 | 72 | 73 | let fast_concat fn1 fn2 = 74 | let fn1_len = String.length fn1 in 75 | if fn1_len = 0 || fn1.[fn1_len - 1] = '/' then 76 | fn1 ^ fn2 77 | else 78 | fn1 ^ "/" ^ fn2 79 | 80 | 81 | let fast_basename fn = 82 | try 83 | let start_pos = (String.rindex fn '/') + 1 in 84 | let fn_len = String.length fn in 85 | if start_pos = fn_len then 86 | "" 87 | else 88 | String.sub fn start_pos (fn_len - start_pos) 89 | with Not_found -> 90 | fn 91 | 92 | 93 | let fast_dirname fn = 94 | try 95 | let last_pos = String.rindex fn '/' in 96 | if last_pos = 0 then 97 | "/" 98 | else 99 | String.sub fn 0 last_pos 100 | with Not_found -> 101 | "" 102 | 103 | 104 | let fast_is_relative fn = 105 | if String.length fn = 0 || fn.[0] <> '/' then 106 | true 107 | else 108 | false 109 | 110 | 111 | let fast_is_current fn = 112 | if String.length fn = 0 || fn = "." then 113 | true 114 | else if fn.[0] <> '.' then 115 | false 116 | else 117 | raise CannotHandleFast 118 | 119 | 120 | let fast_is_parent fn = 121 | if fn = ".." then 122 | true 123 | else if String.length fn < 2 || fn.[0] <> '.' || fn.[1] <> '.' then 124 | false 125 | else 126 | raise CannotHandleFast 127 | 128 | -------------------------------------------------------------------------------- /src/lib/fileutils/Win32Path.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | open FilePath_type 23 | 24 | include CommonPath 25 | 26 | 27 | let rec dir_writer lst = 28 | match lst with 29 | Root s :: tl -> (s^":\\")^(dir_writer tl) 30 | | [ CurrentDir Short ] -> "" 31 | | lst -> 32 | let dir_writer_aux cmp = 33 | match cmp with 34 | (* We should raise an exception here *) 35 | Root s -> s 36 | | ParentDir -> ".." 37 | | CurrentDir _ -> "." 38 | | Component s -> s 39 | in 40 | String.concat "\\" (List.map dir_writer_aux lst) 41 | 42 | 43 | let dir_reader str = 44 | let fn_part_of_string = 45 | function 46 | | ".." -> ParentDir 47 | | "." -> CurrentDir Long 48 | | str -> Component str 49 | in 50 | let fn_part_split str = 51 | let lst = 52 | List.flatten 53 | (List.map 54 | (StringExt.split ~map:fn_part_of_string '\\') 55 | (StringExt.split ~map:(fun s -> s) '/' str)) 56 | in 57 | match lst with 58 | (* TODO: we don't make the difference between c:a and c:\a *) 59 | | Component "" :: tl -> tl 60 | | lst -> lst 61 | in 62 | try 63 | let drive_letter, str = StringExt.break_at_first ':' str in 64 | Root drive_letter :: (fn_part_split str) 65 | with Not_found -> 66 | fn_part_split str 67 | 68 | let fast_is_current fn = 69 | if String.length fn = 0 || fn = "." then 70 | true 71 | else if fn.[0] <> '.' then 72 | false 73 | else 74 | raise CannotHandleFast 75 | 76 | let fast_is_parent fn = 77 | if fn = ".." then 78 | true 79 | else if String.length fn < 2 || fn.[0] <> '.' || fn.[1] <> '.' then 80 | false 81 | else 82 | raise CannotHandleFast 83 | 84 | let path_writer lst = String.concat ";" lst 85 | 86 | 87 | let path_reader str = StringExt.split ~map:(fun s -> s) ';' str 88 | -------------------------------------------------------------------------------- /src/lib/fileutils/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name fileutils) 3 | (public_name fileutils) 4 | (wrapped false) 5 | (private_modules 6 | commonPath 7 | extensionPath 8 | filePath_type 9 | fileStringExt 10 | fileUtilCHMOD 11 | fileUtilCMP 12 | fileUtilCP 13 | fileUtilDU 14 | fileUtilFIND 15 | fileUtilLS 16 | fileUtilMKDIR 17 | fileUtilMV 18 | fileUtilMisc 19 | fileUtilMode 20 | fileUtilPWD 21 | fileUtilPermission 22 | fileUtilREADLINK 23 | fileUtilRM 24 | fileUtilSTAT 25 | fileUtilSize 26 | fileUtilTEST 27 | fileUtilTOUCH 28 | fileUtilTypes 29 | fileUtilUMASK 30 | fileUtilWHICH 31 | unixPath 32 | win32Path) 33 | (libraries unix)) 34 | -------------------------------------------------------------------------------- /src/lib/fileutils/str/FileUtilStr.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | (** FileUtil with Str regexp match test 23 | @author Sylvain Le Gall 24 | *) 25 | 26 | (** Compile [FileUtil.Match] expression using [Str.regexp] 27 | *) 28 | let match_compile str = 29 | let regex = Str.regexp str in 30 | fun fn -> Str.string_match regex fn 0 31 | 32 | 33 | (** See {!FileUtil.test} 34 | *) 35 | let test = FileUtil.test ~match_compile:match_compile 36 | 37 | 38 | (** See {!FileUtil.find} 39 | *) 40 | let find = FileUtil.find ~match_compile:match_compile 41 | -------------------------------------------------------------------------------- /src/lib/fileutils/str/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name fileutils_str) 3 | (public_name fileutils.str) 4 | (wrapped false) 5 | (libraries fileutils str)) 6 | -------------------------------------------------------------------------------- /test/BenchFind.ml: -------------------------------------------------------------------------------- 1 | (******************************************************************************) 2 | (* ocaml-fileutils: files and filenames common operations *) 3 | (* *) 4 | (* Copyright (C) 2003-2014, Sylvain Le Gall *) 5 | (* *) 6 | (* This library is free software; you can redistribute it and/or modify it *) 7 | (* under the terms of the GNU Lesser General Public License as published by *) 8 | (* the Free Software Foundation; either version 2.1 of the License, or (at *) 9 | (* your option) any later version, with the OCaml static compilation *) 10 | (* exception. *) 11 | (* *) 12 | (* This library is distributed in the hope that it will be useful, but *) 13 | (* WITHOUT ANY WARRANTY; without even the implied warranty of *) 14 | (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file *) 15 | (* COPYING for more details. *) 16 | (* *) 17 | (* You should have received a copy of the GNU Lesser General Public License *) 18 | (* along with this library; if not, write to the Free Software Foundation, *) 19 | (* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) 20 | (******************************************************************************) 21 | 22 | 23 | (* What should be the fastest possible function in OCaml. *) 24 | let rec simple fn = 25 | let st = Unix.lstat fn in 26 | match st.Unix.st_kind with 27 | | Unix.S_DIR -> 28 | begin 29 | let fd = Unix.opendir fn in 30 | try 31 | while true do 32 | let bn = Unix.readdir fd in 33 | if bn <> "." && bn <> ".." then 34 | simple (Filename.concat fn bn) 35 | done 36 | with End_of_file -> 37 | Unix.closedir fd 38 | end 39 | | Unix.S_LNK -> 40 | () 41 | | _ -> 42 | () 43 | 44 | let () = 45 | if not Sys.unix then exit 0; 46 | let dir = Sys.getenv "HOME" in 47 | let sys_find () = 48 | let _i: int = 49 | Sys.command ("find "^(Filename.quote dir)^" -name '*.mp3' \ 50 | | (echo -n 'Count: '; wc -l)") 51 | in 52 | () 53 | in 54 | let fileutils_find () = 55 | let count = 56 | FileUtil.find 57 | (FileUtil.Has_extension "mp3") 58 | dir 59 | (fun i _ -> i + 1) 60 | 0 61 | in 62 | Printf.eprintf "Count: %d\n%!" count 63 | in 64 | let time str f = 65 | let start_time = 66 | Unix.gettimeofday () 67 | in 68 | let time = 69 | prerr_endline str; 70 | f (); 71 | (Unix.gettimeofday ()) -. start_time 72 | in 73 | Printf.eprintf "Time: %.2fs\n%!" time; 74 | time 75 | in 76 | let () = 77 | prerr_endline "System find (load)"; 78 | sys_find () 79 | in 80 | let time_ref = 81 | time "System find (reference)" sys_find 82 | in 83 | let time_fileutils = 84 | time "FileUtil find" fileutils_find 85 | in 86 | let _time_simple = 87 | time "Simple" (fun () -> simple dir) 88 | in 89 | Printf.eprintf "Performance: %.2f%%\n%!" 90 | (100.0 *. (time_ref /. time_fileutils)) 91 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name benchFind) 3 | (modules benchFind) 4 | (libraries fileutils)) 5 | 6 | (test 7 | (name test) 8 | (modules test) 9 | (libraries fileutils fileutils_str ounit2)) 10 | --------------------------------------------------------------------------------