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)).

   65:- use_foreign_library(foreign(files), install_files).

 set_time_file(+File, -OldTimes, +NewTimes) is det

Query and set POSIX time attributes of a file. Both OldTimes and NewTimes are lists of option-terms. Times are represented in SWI-Prolog's standard floating point numbers. New times may be specified as now to indicate the current time. Defined options are:

access(Time)

Describes the time of last access of the file. This value can be read and written.

modified(Time)

Describes the time the contents of the file was last modified. This value can be read and written.

changed(Time)

Describes the time the file-structure itself was changed by adding (link()) or removing (unlink()) names.

Below are some example queries. The first retrieves the access-time, while the second sets the last-modified time to the current time.

?- set_time_file(foo, [access(Access)], []).
?- set_time_file(foo, [], [modified(now)]).

 link_file(+OldPath, +NewPath, +Type) is det

Create a link in the filesystem from NewPath to OldPath. Type defines the type of link and is one of hard or symbolic.

With some limitations, these functions also work on Windows. First of all, the unerlying filesystem must support links. This requires NTFS. Second, symbolic links are only supported in Vista and later.

Errors

- domain_error(link_type, Type) if the requested link-type is unknown or not supported on the target OS.

 relative_file_name(+Path:atom, +RelTo:atom, -RelPath:atom) is det

relative_file_name(-Path:atom, +RelTo:atom, +RelPath:atom) is det

True when RelPath is Path, relative to RelTo. Path and RelTo are first handed to absolute_file_name/2, which makes the absolute and canonical. Below are two examples:

?- relative_file_name('/home/janw/nice',
                      '/home/janw/deep/dir/file', Path).
Path = '../../nice'.

?- relative_file_name(Path, '/home/janw/deep/dir/file', '../../nice').
Path = '/home/janw/nice'.

Arguments:

All	- paths must be in canonical POSIX notation, i.e., using / to separate segments in the path. See prolog_to_os_filename/2.

bug

- This predicate is defined as a syntactical operation.

  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).

 directory_file_path(+Directory, +File, -Path) is det

directory_file_path(?Directory, ?File, +Path) is det

True when Path is the full path-name for File in Dir. This is comparable to atom_concat(Directory, File, Path), but it ensures there is exactly one / between the two parts. Notes:

• In mode (+,+,-), if File is given and absolute, Path is unified to File.
• Mode (-,-,+) uses file_directory_name/2 and file_base_name/2

  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    ).

 copy_file(From, To) is det

Copy a file into a new file or directory. The data is copied as binary data.

  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).

 make_directory_path(+Dir) is det

Create Dir and all required components (like mkdir -p). Can raise various file-specific exceptions.

  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          )).

 copy_directory(+From, +To) is det

Copy the contents of the directory From to To (recursively). If To is the name of an existing directory, the contents of From are copied into To. I.e., no subdirectory using the basename of From is created.

  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(..).

 delete_directory_and_contents(+Dir) is det

Recursively remove the directory Dir and its contents. If Dir is a symbolic link or symbolic links inside Dir are encountered, the links are removed rather than their content. Use with care!

  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    ).

 delete_directory_contents(+Dir) is det

Remove all content from directory Dir, without removing Dir itself. Similar to delete_directory_and_contents/2, if symbolic links are encountered in Dir, the links are removed rather than their content.

  337delete_directory_contents(Dir) :-
  338    directory_files(Dir, Files),
  339    maplist(delete_directory_contents(Dir), Files).

 chmod(+File, +Spec) is det

Set the mode of the target file. Spec is one of +Mode, -Mode or a plain Mode, which adds new permissions, revokes permissions or sets the exact permissions. Mode itself is an integer, a POSIX mode name or a list of POSIX mode names. Defines names are suid, sgid, svtx and the all names defined by the regular expression [ugo]*[rwx]*. Specifying none of "ugo" is the same as specifying all of them. For example, to make a file executable for the owner (user) and group, we can use:

?- chmod(myfile, +ugx).

  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