1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2002-2017, University of Amsterdam 7 Vu University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(files_ex, 37 [ set_time_file/3, % +File, -OldTimes, +NewTimes 38 link_file/3, % +OldPath, +NewPath, +Type 39 chmod/2, % +File, +Mode 40 relative_file_name/3, % ?AbsPath, +RelTo, ?RelPath 41 directory_file_path/3, % +Dir, +File, -Path 42 copy_file/2, % +From, +To 43 make_directory_path/1, % +Directory 44 copy_directory/2, % +Source, +Destination 45 delete_directory_and_contents/1, % +Dir 46 delete_directory_contents/1 % +Dir 47 ]). 48:- use_module(library(apply)). 49:- use_module(library(error)). 50 51/** <module> Extended operations on files 52 53This module provides additional operations on files. This covers both 54more obscure and possible non-portable low-level operations and 55high-level utilities. 56 57Using these Prolog primitives is typically to be preferred over using 58operating system primitives through shell/1 or process_create/3 because 59(1) there are no potential file name quoting issues, (2) there is no 60dependency on operating system commands and (3) using the 61implementations from this library is usually faster. 62*/ 63 64 65:- use_foreign_library(foreign(files), install_files). 66 67%! set_time_file(+File, -OldTimes, +NewTimes) is det. 68% 69% Query and set POSIX time attributes of a file. Both OldTimes and 70% NewTimes are lists of option-terms. Times are represented in 71% SWI-Prolog's standard floating point numbers. New times may be 72% specified as =now= to indicate the current time. Defined options 73% are: 74% 75% * access(Time) 76% Describes the time of last access of the file. This value 77% can be read and written. 78% 79% * modified(Time) 80% Describes the time the contents of the file was last 81% modified. This value can be read and written. 82% 83% * changed(Time) 84% Describes the time the file-structure itself was changed by 85% adding (link()) or removing (unlink()) names. 86% 87% Below are some example queries. The first retrieves the 88% access-time, while the second sets the last-modified time to the 89% current time. 90% 91% == 92% ?- set_time_file(foo, [access(Access)], []). 93% ?- set_time_file(foo, [], [modified(now)]). 94% == 95 96%! link_file(+OldPath, +NewPath, +Type) is det. 97% 98% Create a link in the filesystem from NewPath to OldPath. Type 99% defines the type of link and is one of =hard= or =symbolic=. 100% 101% With some limitations, these functions also work on Windows. 102% First of all, the unerlying filesystem must support links. This 103% requires NTFS. Second, symbolic links are only supported in 104% Vista and later. 105% 106% @error domain_error(link_type, Type) if the requested link-type 107% is unknown or not supported on the target OS. 108 109%! relative_file_name(+Path:atom, +RelTo:atom, -RelPath:atom) is det. 110%! relative_file_name(-Path:atom, +RelTo:atom, +RelPath:atom) is det. 111% 112% True when RelPath is Path, relative to RelTo. Path and RelTo are 113% first handed to absolute_file_name/2, which makes the absolute 114% *and* canonical. Below are two examples: 115% 116% == 117% ?- relative_file_name('/home/janw/nice', 118% '/home/janw/deep/dir/file', Path). 119% Path = '../../nice'. 120% 121% ?- relative_file_name(Path, '/home/janw/deep/dir/file', '../../nice'). 122% Path = '/home/janw/nice'. 123% == 124% 125% @param All paths must be in canonical POSIX notation, i.e., 126% using / to separate segments in the path. See 127% prolog_to_os_filename/2. 128% @bug This predicate is defined as a _syntactical_ operation. 129 130relative_file_name(Path, RelTo, RelPath) :- % +,+,- 131 nonvar(Path), 132 !, 133 absolute_file_name(Path, AbsPath), 134 absolute_file_name(RelTo, AbsRelTo), 135 atomic_list_concat(PL, /, AbsPath), 136 atomic_list_concat(RL, /, AbsRelTo), 137 delete_common_prefix(PL, RL, PL1, PL2), 138 to_dot_dot(PL2, DotDot, PL1), 139 atomic_list_concat(DotDot, /, RelPath). 140relative_file_name(Path, RelTo, RelPath) :- 141 ( is_absolute_file_name(RelPath) 142 -> Path = RelPath 143 ; file_directory_name(RelTo, RelToDir), 144 directory_file_path(RelToDir, RelPath, Path0), 145 absolute_file_name(Path0, Path) 146 ). 147 148delete_common_prefix([H|T01], [H|T02], T1, T2) :- 149 !, 150 delete_common_prefix(T01, T02, T1, T2). 151delete_common_prefix(T1, T2, T1, T2). 152 153to_dot_dot([], Tail, Tail). 154to_dot_dot([_], Tail, Tail) :- !. 155to_dot_dot([_|T0], ['..'|T], Tail) :- 156 to_dot_dot(T0, T, Tail). 157 158 159%! directory_file_path(+Directory, +File, -Path) is det. 160%! directory_file_path(?Directory, ?File, +Path) is det. 161% 162% True when Path is the full path-name for File in Dir. This is 163% comparable to atom_concat(Directory, File, Path), but it ensures 164% there is exactly one / between the two parts. Notes: 165% 166% * In mode (+,+,-), if File is given and absolute, Path 167% is unified to File. 168% * Mode (-,-,+) uses file_directory_name/2 and file_base_name/2 169 170directory_file_path(Dir, File, Path) :- 171 nonvar(Dir), nonvar(File), 172 !, 173 ( ( is_absolute_file_name(File) 174 ; Dir == '.' 175 ) 176 -> Path = File 177 ; sub_atom(Dir, _, _, 0, /) 178 -> atom_concat(Dir, File, Path) 179 ; atomic_list_concat([Dir, /, File], Path) 180 ). 181directory_file_path(Dir, File, Path) :- 182 nonvar(Path), 183 !, 184 ( nonvar(Dir) 185 -> ( Dir == '.', 186 \+ is_absolute_file_name(Path) 187 -> File = Path 188 ; sub_atom(Dir, _, _, 0, /) 189 -> atom_concat(Dir, File, Path) 190 ; atom_concat(Dir, /, TheDir) 191 -> atom_concat(TheDir, File, Path) 192 ) 193 ; nonvar(File) 194 -> atom_concat(Dir0, File, Path), 195 strip_trailing_slash(Dir0, Dir) 196 ; file_directory_name(Path, Dir), 197 file_base_name(Path, File) 198 ). 199directory_file_path(_, _, _) :- 200 throw(error(instantiation_error(_), _)). 201 202strip_trailing_slash(Dir0, Dir) :- 203 ( atom_concat(D, /, Dir0), 204 D \== '' 205 -> Dir = D 206 ; Dir = Dir0 207 ). 208 209 210%! copy_file(From, To) is det. 211% 212% Copy a file into a new file or directory. The data is copied as 213% binary data. 214 215copy_file(From, To) :- 216 destination_file(To, From, Dest), 217 setup_call_cleanup( 218 open(Dest, write, Out, [type(binary)]), 219 copy_from(From, Out), 220 close(Out)). 221 222copy_from(File, Stream) :- 223 setup_call_cleanup( 224 open(File, read, In, [type(binary)]), 225 copy_stream_data(In, Stream), 226 close(In)). 227 228destination_file(Dir, File, Dest) :- 229 exists_directory(Dir), 230 !, 231 file_base_name(File, Base), 232 directory_file_path(Dir, Base, Dest). 233destination_file(Dest, _, Dest). 234 235 236%! make_directory_path(+Dir) is det. 237% 238% Create Dir and all required components (like mkdir -p). Can 239% raise various file-specific exceptions. 240 241make_directory_path(Dir) :- 242 make_directory_path_2(Dir), 243 !. 244make_directory_path(Dir) :- 245 permission_error(create, directory, Dir). 246 247make_directory_path_2(Dir) :- 248 exists_directory(Dir), 249 !. 250make_directory_path_2(Dir) :- 251 atom_concat(RealDir, '/', Dir), 252 RealDir \== '', 253 !, 254 make_directory_path_2(RealDir). 255make_directory_path_2(Dir) :- 256 Dir \== (/), 257 !, 258 file_directory_name(Dir, Parent), 259 make_directory_path_2(Parent), 260 E = error(existence_error(directory, _), _), 261 catch(make_directory(Dir), E, 262 ( exists_directory(Dir) 263 -> true 264 ; throw(E) 265 )). 266 267%! copy_directory(+From, +To) is det. 268% 269% Copy the contents of the directory From to To (recursively). If 270% To is the name of an existing directory, the _contents_ of From 271% are copied into To. I.e., no subdirectory using the basename of 272% From is created. 273 274copy_directory(From, To) :- 275 ( exists_directory(To) 276 -> true 277 ; make_directory(To) 278 ), 279 directory_files(From, Entries), 280 maplist(copy_directory_content(From, To), Entries). 281 282copy_directory_content(_From, _To, Special) :- 283 special(Special), 284 !. 285copy_directory_content(From, To, Entry) :- 286 directory_file_path(From, Entry, Source), 287 directory_file_path(To, Entry, Dest), 288 ( exists_directory(Source) 289 -> copy_directory(Source, Dest) 290 ; copy_file(Source, Dest) 291 ). 292 293special(.). 294special(..). 295 296%! delete_directory_and_contents(+Dir) is det. 297% 298% Recursively remove the directory Dir and its contents. If Dir is 299% a symbolic link or symbolic links inside Dir are encountered, 300% the links are removed rather than their content. Use with care! 301 302delete_directory_and_contents(Dir) :- 303 read_link(Dir, _, _), 304 !, 305 delete_file(Dir). 306delete_directory_and_contents(Dir) :- 307 directory_files(Dir, Files), 308 maplist(delete_directory_contents(Dir), Files), 309 E = error(existence_error(directory, _), _), 310 catch(delete_directory(Dir), E, 311 ( \+ exists_directory(Dir) 312 -> true 313 ; throw(E) 314 )). 315 316delete_directory_contents(_, Entry) :- 317 special(Entry), 318 !. 319delete_directory_contents(Dir, Entry) :- 320 directory_file_path(Dir, Entry, Delete), 321 ( exists_directory(Delete) 322 -> delete_directory_and_contents(Delete) 323 ; E = error(existence_error(file, _), _), 324 catch(delete_file(Delete), E, 325 ( \+ exists_file(Delete) 326 -> true 327 ; throw(E))) 328 ). 329 330%! delete_directory_contents(+Dir) is det. 331% 332% Remove all content from directory Dir, without removing Dir 333% itself. Similar to delete_directory_and_contents/2, if symbolic 334% links are encountered in Dir, the links are removed rather than 335% their content. 336 337delete_directory_contents(Dir) :- 338 directory_files(Dir, Files), 339 maplist(delete_directory_contents(Dir), Files). 340 341 342%! chmod(+File, +Spec) is det. 343% 344% Set the mode of the target file. Spec is one of `+Mode`, `-Mode` or 345% a plain `Mode`, which adds new permissions, revokes permissions or 346% sets the exact permissions. `Mode` itself is an integer, a POSIX 347% mode name or a list of POSIX mode names. Defines names are `suid`, 348% `sgid`, `svtx` and the all names defined by the regular expression 349% =|[ugo]*[rwx]*|=. Specifying none of "ugo" is the same as specifying 350% all of them. For example, to make a file executable for the owner 351% (user) and group, we can use: 352% 353% ``` 354% ?- chmod(myfile, +ugx). 355% ``` 356 357chmod(File, +Spec) :- 358 must_be(ground, Spec), 359 !, 360 mode_bits(Spec, Bits), 361 file_mode_(File, Mode0), 362 Mode is Mode0 \/ Bits, 363 chmod_(File, Mode). 364chmod(File, -Spec) :- 365 must_be(ground, Spec), 366 !, 367 mode_bits(Spec, Bits), 368 file_mode_(File, Mode0), 369 Mode is Mode0 /\ \Bits, 370 chmod_(File, Mode). 371chmod(File, Spec) :- 372 must_be(ground, Spec), 373 !, 374 mode_bits(Spec, Bits), 375 chmod_(File, Bits). 376 377mode_bits(Spec, Spec) :- 378 integer(Spec), 379 !. 380mode_bits(Name, Bits) :- 381 atom(Name), 382 !, 383 ( file_mode(Name, Bits) 384 -> true 385 ; domain_error(posix_file_mode, Name) 386 ). 387mode_bits(Spec, Bits) :- 388 must_be(list(atom), Spec), 389 phrase(mode_bits(0, Bits), Spec). 390 391mode_bits(Bits0, Bits) --> 392 [Spec], !, 393 ( { file_mode(Spec, B), Bits1 is Bits0\/B } 394 -> mode_bits(Bits1, Bits) 395 ; { domain_error(posix_file_mode, Spec) } 396 ). 397mode_bits(Bits, Bits) --> 398 []. 399 400file_mode(suid, 0o4000). 401file_mode(sgid, 0o2000). 402file_mode(svtx, 0o1000). 403file_mode(Name, Bits) :- 404 atom_chars(Name, Chars), 405 phrase(who_mask(0, WMask0), Chars, Rest), 406 ( WMask0 =:= 0 407 -> WMask = 0o0777 408 ; WMask = WMask0 409 ), 410 maplist(mode_char, Rest, MBits), 411 foldl(or, MBits, 0, Mask), 412 Bits is Mask /\ WMask. 413 414who_mask(M0, M) --> 415 [C], 416 { who_mask(C,M1), !, 417 M2 is M0\/M1 418 }, 419 who_mask(M2,M). 420who_mask(M, M) --> 421 []. 422 423who_mask(o, 0o0007). 424who_mask(g, 0o0070). 425who_mask(u, 0o0700). 426 427mode_char(r, 0o0444). 428mode_char(w, 0o0222). 429mode_char(x, 0o0111). 430 431or(B1, B2, B) :- 432 B is B1\/B2