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-2018, University of Amsterdam
    7                              VU University Amsterdam
    8                              CWI, Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(files_ex,
   38          [ set_time_file/3,            % +File, -OldTimes, +NewTimes
   39            link_file/3,                % +OldPath, +NewPath, +Type
   40            chmod/2,                    % +File, +Mode
   41            relative_file_name/3,       % ?AbsPath, +RelTo, ?RelPath
   42            directory_file_path/3,      % +Dir, +File, -Path
   43            directory_member/3,		% +Dir, -Member, +Options
   44            copy_file/2,                % +From, +To
   45            make_directory_path/1,      % +Directory
   46            copy_directory/2,           % +Source, +Destination
   47            delete_directory_and_contents/1, % +Dir
   48            delete_directory_contents/1 % +Dir
   49          ]).   50:- use_module(library(apply)).   51:- use_module(library(error)).   52
   53/** <module> Extended operations on files
   54
   55This module provides additional operations on   files.  This covers both
   56more  obscure  and  possible  non-portable    low-level  operations  and
   57high-level utilities.
   58
   59Using these Prolog primitives is typically   to  be preferred over using
   60operating system primitives through shell/1  or process_create/3 because
   61(1) there are no potential file  name   quoting  issues, (2) there is no
   62dependency  on  operating   system   commands    and   (3)   using   the
   63implementations from this library is usually faster.
   64*/
   65
   66:- predicate_options(directory_member/3, 3,
   67                     [ recursive(boolean),
   68                       follow_links(boolean),
   69                       file_type(atom),
   70                       extensions(list(atom)),
   71                       file_errors(oneof([fail,warning,error])),
   72                       access(oneof([read,write,execute])),
   73                       matches(text),
   74                       exclude(text),
   75                       exclude_directory(text),
   76                       hidden(boolean)
   77                     ]).   78
   79
   80:- use_foreign_library(foreign(files), install_files).   81
   82%!  set_time_file(+File, -OldTimes, +NewTimes) is det.
   83%
   84%   Query and set POSIX time attributes of a file. Both OldTimes and
   85%   NewTimes are lists of  option-terms.   Times  are represented in
   86%   SWI-Prolog's standard floating point numbers.   New times may be
   87%   specified as =now= to indicate the current time. Defined options
   88%   are:
   89%
   90%       * access(Time)
   91%       Describes the time of last access   of  the file. This value
   92%       can be read and written.
   93%
   94%       * modified(Time)
   95%       Describes the time  the  contents  of   the  file  was  last
   96%       modified. This value can be read and written.
   97%
   98%       * changed(Time)
   99%       Describes the time the file-structure  itself was changed by
  100%       adding (link()) or removing (unlink()) names.
  101%
  102%   Below  are  some  example  queries.   The  first  retrieves  the
  103%   access-time, while the second sets the last-modified time to the
  104%   current time.
  105%
  106%       ==
  107%       ?- set_time_file(foo, [access(Access)], []).
  108%       ?- set_time_file(foo, [], [modified(now)]).
  109%       ==
  110
  111%!  link_file(+OldPath, +NewPath, +Type) is det.
  112%
  113%   Create a link in  the  filesystem   from  NewPath  to  OldPath. Type
  114%   defines the type of link and is one of =hard= or =symbolic=.
  115%
  116%   With some limitations, these functions also   work on Windows. First
  117%   of all, the underlying filesystem must  support links. This requires
  118%   NTFS. Second, symbolic links are only supported in Vista and later.
  119%
  120%   @error  domain_error(link_type, Type) if the requested link-type
  121%           is unknown or not supported on the target OS.
  122
  123%!  relative_file_name(+Path:atom, +RelToFile:atom, -RelPath:atom) is det.
  124%!  relative_file_name(-Path:atom, +RelToFile:atom, +RelPath:atom) is det.
  125%
  126%   True when RelPath is Path, relative to the _file_ RelToFile. Path and
  127%   RelTo are first handed to absolute_file_name/2, which makes the
  128%   absolute *and* canonical. Below are two examples:
  129%
  130%   ```
  131%   ?- relative_file_name('/home/janw/nice',
  132%                         '/home/janw/deep/dir/file', Path).
  133%   Path = '../../nice'.
  134%
  135%   ?- relative_file_name(Path, '/home/janw/deep/dir/file', '../../nice').
  136%   Path = '/home/janw/nice'.
  137%   ```
  138%
  139%   Add a terminating `/` to get a path relative to a _directory_, e.g.
  140%
  141%       ?- relative_file_name('/home/janw/deep/dir/file', './', Path).
  142%       Path = 'deep/dir/file'.
  143%
  144%   @param  All paths must be in canonical POSIX notation, i.e.,
  145%           using / to separate segments in the path.  See
  146%           prolog_to_os_filename/2.
  147%   @bug    It would probably have been cleaner to use a directory
  148%	    as second argument.  We can not do such dynamically as this
  149%	    predicate is defined as a _syntactical_ operation, which
  150%	    implies it may be used for non-existing paths and URLs.
  151
  152relative_file_name(Path, RelTo, RelPath) :- % +,+,-
  153    nonvar(Path),
  154    !,
  155    absolute_file_name(Path, AbsPath),
  156    absolute_file_name(RelTo, AbsRelTo),
  157    atomic_list_concat(PL, /, AbsPath),
  158    atomic_list_concat(RL, /, AbsRelTo),
  159    delete_common_prefix(PL, RL, PL1, PL2),
  160    to_dot_dot(PL2, DotDot, PL1),
  161    atomic_list_concat(DotDot, /, RelPath).
  162relative_file_name(Path, RelTo, RelPath) :-
  163    (   is_absolute_file_name(RelPath)
  164    ->  Path = RelPath
  165    ;   file_directory_name(RelTo, RelToDir),
  166        directory_file_path(RelToDir, RelPath, Path0),
  167        absolute_file_name(Path0, Path)
  168    ).
  169
  170delete_common_prefix([H|T01], [H|T02], T1, T2) :-
  171    !,
  172    delete_common_prefix(T01, T02, T1, T2).
  173delete_common_prefix(T1, T2, T1, T2).
  174
  175to_dot_dot([], Tail, Tail).
  176to_dot_dot([_], Tail, Tail) :- !.
  177to_dot_dot([_|T0], ['..'|T], Tail) :-
  178    to_dot_dot(T0, T, Tail).
  179
  180
  181%!  directory_file_path(+Directory, +File, -Path) is det.
  182%!  directory_file_path(?Directory, ?File, +Path) is det.
  183%
  184%   True when Path is the full path-name   for  File in Dir. This is
  185%   comparable to atom_concat(Directory, File, Path), but it ensures
  186%   there is exactly one / between the two parts.  Notes:
  187%
  188%     * In mode (+,+,-), if File is given and absolute, Path
  189%     is unified to File.
  190%     * Mode (-,-,+) uses file_directory_name/2 and file_base_name/2
  191
  192directory_file_path(Dir, File, Path) :-
  193    nonvar(Dir), nonvar(File),
  194    !,
  195    (   (   is_absolute_file_name(File)
  196        ;   Dir == '.'
  197        )
  198    ->  Path = File
  199    ;   sub_atom(Dir, _, _, 0, /)
  200    ->  atom_concat(Dir, File, Path)
  201    ;   atomic_list_concat([Dir, /, File], Path)
  202    ).
  203directory_file_path(Dir, File, Path) :-
  204    nonvar(Path),
  205    !,
  206    (   nonvar(Dir)
  207    ->  (   Dir == '.',
  208            \+ is_absolute_file_name(Path)
  209        ->  File = Path
  210        ;   sub_atom(Dir, _, _, 0, /)
  211        ->  atom_concat(Dir, File, Path)
  212        ;   atom_concat(Dir, /, TheDir)
  213        ->  atom_concat(TheDir, File, Path)
  214        )
  215    ;   nonvar(File)
  216    ->  atom_concat(Dir0, File, Path),
  217        strip_trailing_slash(Dir0, Dir)
  218    ;   file_directory_name(Path, Dir),
  219        file_base_name(Path, File)
  220    ).
  221directory_file_path(_, _, _) :-
  222    throw(error(instantiation_error(_), _)).
  223
  224strip_trailing_slash(Dir0, Dir) :-
  225    (   atom_concat(D, /, Dir0),
  226        D \== ''
  227    ->  Dir = D
  228    ;   Dir = Dir0
  229    ).
  230
  231
  232%!  directory_member(+Directory, -Member, +Options) is nondet.
  233%
  234%   True when Member is a path inside Directory.  Options defined are:
  235%
  236%     - recursive(+Boolean)
  237%       If `true` (default `false`), recurse into subdirectories
  238%     - follow_links(+Boolean)
  239%       If `true` (default), follow symbolic links.
  240%     - file_type(+Type)
  241%       See absolute_file_name/3.
  242%     - extensions(+List)
  243%       Only return entries whose extension appears in List.
  244%     - file_errors(+Errors)
  245%       How to handle errors.  One of `fail`, `warning` or `error`.
  246%       Default is `warning`.  Errors notably happen if a directory is
  247%       unreadable or a link points nowhere.
  248%     - access(+Access)
  249%       Only return entries with Access
  250%     - matches(+GlobPattern)
  251%       Only return files that match GlobPattern.
  252%     - exclude(+GlobPattern)
  253%       Exclude files matching GlobPattern.
  254%     - exclude_directory(+GlobPattern)
  255%       Do not recurse into directories matching GlobPattern.
  256%     - hidden(+Boolean)
  257%       If `true` (default), also return _hidden_ files.
  258%
  259%   This predicate is safe against cycles   introduced by symbolic links
  260%   to directories.
  261%
  262%   The idea for a non-deterministic file   search  predicate comes from
  263%   Nicos Angelopoulos.
  264
  265directory_member(Directory, Member, Options) :-
  266    dict_create(Dict, options, Options),
  267    (   Dict.get(recursive) == true,
  268        \+ Dict.get(follow_links) == false
  269    ->  empty_nb_set(Visited),
  270        DictOptions = Dict.put(visited, Visited)
  271    ;   DictOptions = Dict
  272    ),
  273    directory_member_dict(Directory, Member, DictOptions).
  274
  275directory_member_dict(Directory, Member, Dict) :-
  276    directory_files(Directory, Files, Dict),
  277    member(Entry, Files),
  278    \+ special(Entry),
  279    directory_file_path(Directory, Entry, AbsEntry),
  280    filter_link(AbsEntry, Dict),
  281    (   exists_directory(AbsEntry)
  282    ->  (   filter_dir_member(AbsEntry, Entry, Dict),
  283            Member = AbsEntry
  284        ;   filter_directory(Entry, Dict),
  285            Dict.get(recursive) == true,
  286            \+ hidden_file(Entry, Dict),
  287            no_link_cycle(AbsEntry, Dict),
  288            directory_member_dict(AbsEntry, Member, Dict)
  289        )
  290    ;   filter_dir_member(AbsEntry, Entry, Dict),
  291        Member = AbsEntry
  292    ).
  293
  294directory_files(Directory, Files, Dict) :-
  295    Errors = Dict.get(file_errors),
  296    !,
  297    errors_directory_files(Errors, Directory, Files).
  298directory_files(Directory, Files, _Dict) :-
  299    errors_directory_files(warning, Directory, Files).
  300
  301errors_directory_files(fail, Directory, Files) :-
  302    catch(directory_files(Directory, Files), _, fail).
  303errors_directory_files(warning, Directory, Files) :-
  304    catch(directory_files(Directory, Files), E,
  305          (   print_message(warning, E),
  306              fail)).
  307errors_directory_files(error, Directory, Files) :-
  308    directory_files(Directory, Files).
  309
  310
  311filter_link(File, Dict) :-
  312    \+ ( Dict.get(follow_links) == false,
  313         read_link(File, _, _)
  314       ).
  315
  316no_link_cycle(Directory, Dict) :-
  317    Visited = Dict.get(visited),
  318    !,
  319    absolute_file_name(Directory, Canonical,
  320                       [ file_type(directory)
  321                       ]),
  322    add_nb_set(Canonical, Visited, true).
  323no_link_cycle(_, _).
  324
  325hidden_file(Entry, Dict) :-
  326    false == Dict.get(hidden),
  327    sub_atom(Entry, 0, _, _, '.').
  328
  329%!  filter_dir_member(+Absolute, +BaseName, +Options)
  330%
  331%   True when the given file satisfies the filter expressions.
  332
  333filter_dir_member(_AbsEntry, Entry, Dict) :-
  334    Exclude = Dict.get(exclude),
  335    wildcard_match(Exclude, Entry),
  336    !, fail.
  337filter_dir_member(_AbsEntry, Entry, Dict) :-
  338    Include = Dict.get(matches),
  339    \+ wildcard_match(Include, Entry),
  340    !, fail.
  341filter_dir_member(AbsEntry, _Entry, Dict) :-
  342    Type = Dict.get(file_type),
  343    \+ matches_type(Type, AbsEntry),
  344    !, fail.
  345filter_dir_member(_AbsEntry, Entry, Dict) :-
  346    ExtList = Dict.get(extensions),
  347    file_name_extension(_, Ext, Entry),
  348    \+ memberchk(Ext, ExtList),
  349    !, fail.
  350filter_dir_member(AbsEntry, _Entry, Dict) :-
  351    Access = Dict.get(access),
  352    \+ access_file(AbsEntry, Access),
  353    !, fail.
  354filter_dir_member(_AbsEntry, Entry, Dict) :-
  355    hidden_file(Entry, Dict),
  356    !, fail.
  357filter_dir_member(_, _, _).
  358
  359matches_type(directory, Entry) :-
  360    !,
  361    exists_directory(Entry).
  362matches_type(Type, Entry) :-
  363    \+ exists_directory(Entry),
  364    user:prolog_file_type(Ext, Type),
  365    file_name_extension(_, Ext, Entry).
  366
  367
  368%!  filter_directory(+Entry, +Dict) is semidet.
  369%
  370%   Implement the exclude_directory(+GlobPattern) option.
  371
  372filter_directory(Entry, Dict) :-
  373    Exclude = Dict.get(exclude_directory),
  374    wildcard_match(Exclude, Entry),
  375    !, fail.
  376filter_directory(_, _).
  377
  378
  379%!  copy_file(+From, +To) is det.
  380%
  381%   Copy a file into a new file or  directory. The data is copied as
  382%   binary data.
  383
  384copy_file(From, To) :-
  385    destination_file(To, From, Dest),
  386    setup_call_cleanup(
  387        open(Dest, write, Out, [type(binary)]),
  388        copy_from(From, Out),
  389        close(Out)).
  390
  391copy_from(File, Stream) :-
  392    setup_call_cleanup(
  393        open(File, read, In, [type(binary)]),
  394        copy_stream_data(In, Stream),
  395        close(In)).
  396
  397destination_file(Dir, File, Dest) :-
  398    exists_directory(Dir),
  399    !,
  400    file_base_name(File, Base),
  401    directory_file_path(Dir, Base, Dest).
  402destination_file(Dest, _, Dest).
  403
  404
  405%!  make_directory_path(+Dir) is det.
  406%
  407%   Create Dir and all required  components   (like  mkdir  -p). Can
  408%   raise various file-specific exceptions.
  409
  410make_directory_path(Dir) :-
  411    make_directory_path_2(Dir),
  412    !.
  413make_directory_path(Dir) :-
  414    permission_error(create, directory, Dir).
  415
  416make_directory_path_2(Dir) :-
  417    exists_directory(Dir),
  418    !.
  419make_directory_path_2(Dir) :-
  420    atom_concat(RealDir, '/', Dir),
  421    RealDir \== '',
  422    !,
  423    make_directory_path_2(RealDir).
  424make_directory_path_2(Dir) :-
  425    Dir \== (/),
  426    !,
  427    file_directory_name(Dir, Parent),
  428    make_directory_path_2(Parent),
  429    E = error(existence_error(directory, _), _),
  430    catch(make_directory(Dir), E,
  431          (   exists_directory(Dir)
  432          ->  true
  433          ;   throw(E)
  434          )).
  435
  436%!  copy_directory(+From, +To) is det.
  437%
  438%   Copy the contents of the directory  From to To (recursively). If
  439%   To is the name of an existing  directory, the _contents_ of From
  440%   are copied into To. I.e., no  subdirectory using the basename of
  441%   From is created.
  442
  443copy_directory(From, To) :-
  444    (   exists_directory(To)
  445    ->  true
  446    ;   make_directory(To)
  447    ),
  448    directory_files(From, Entries),
  449    maplist(copy_directory_content(From, To), Entries).
  450
  451copy_directory_content(_From, _To, Special) :-
  452    special(Special),
  453    !.
  454copy_directory_content(From, To, Entry) :-
  455    directory_file_path(From, Entry, Source),
  456    directory_file_path(To, Entry, Dest),
  457    (   exists_directory(Source)
  458    ->  copy_directory(Source, Dest)
  459    ;   copy_file(Source, Dest)
  460    ).
  461
  462special(.).
  463special(..).
  464
  465%!  delete_directory_and_contents(+Dir) is det.
  466%
  467%   Recursively remove the directory Dir and its contents. If Dir is
  468%   a symbolic link or symbolic links   inside  Dir are encountered,
  469%   the links are removed rather than their content. Use with care!
  470
  471delete_directory_and_contents(Dir) :-
  472    read_link(Dir, _, _),
  473    !,
  474    delete_file(Dir).
  475delete_directory_and_contents(Dir) :-
  476    directory_files(Dir, Files),
  477    maplist(delete_directory_contents(Dir), Files),
  478    E = error(existence_error(directory, _), _),
  479    catch(delete_directory(Dir), E,
  480          (   \+ exists_directory(Dir)
  481          ->  true
  482          ;   throw(E)
  483          )).
  484
  485delete_directory_contents(_, Entry) :-
  486    special(Entry),
  487    !.
  488delete_directory_contents(Dir, Entry) :-
  489    directory_file_path(Dir, Entry, Delete),
  490    (   exists_directory(Delete)
  491    ->  delete_directory_and_contents(Delete)
  492    ;   E = error(existence_error(file, _), _),
  493        catch(delete_file(Delete), E,
  494              (   \+ exists_file(Delete)
  495              ->  true
  496              ;   throw(E)))
  497    ).
  498
  499%!  delete_directory_contents(+Dir) is det.
  500%
  501%   Remove all content from  directory   Dir,  without  removing Dir
  502%   itself. Similar to delete_directory_and_contents/2,  if symbolic
  503%   links are encountered in Dir, the  links are removed rather than
  504%   their content.
  505
  506delete_directory_contents(Dir) :-
  507    directory_files(Dir, Files),
  508    maplist(delete_directory_contents(Dir), Files).
  509
  510
  511%!  chmod(+File, +Spec) is det.
  512%
  513%   Set the mode of the target file. Spec  is one of `+Mode`, `-Mode` or
  514%   a plain `Mode`, which adds new   permissions, revokes permissions or
  515%   sets the exact permissions. `Mode`  itself   is  an integer, a POSIX
  516%   mode name or a list of POSIX   mode names. Defines names are `suid`,
  517%   `sgid`, `svtx` and  all names  defined  by  the  regular  expression
  518%   =|[ugo]*[rwx]*|=. Specifying none of "ugo" is the same as specifying
  519%   all of them. For example, to make   a  file executable for the owner
  520%   (user) and group, we can use:
  521%
  522%     ```
  523%     ?- chmod(myfile, +ugx).
  524%     ```
  525
  526chmod(File, +Spec) :-
  527    must_be(ground, Spec),
  528    !,
  529    mode_bits(Spec, Bits),
  530    file_mode_(File, Mode0),
  531    Mode is Mode0 \/ Bits,
  532    chmod_(File, Mode).
  533chmod(File, -Spec) :-
  534    must_be(ground, Spec),
  535    !,
  536    mode_bits(Spec, Bits),
  537    file_mode_(File, Mode0),
  538    Mode is Mode0 /\ \Bits,
  539    chmod_(File, Mode).
  540chmod(File, Spec) :-
  541    must_be(ground, Spec),
  542    !,
  543    mode_bits(Spec, Bits),
  544    chmod_(File, Bits).
  545
  546mode_bits(Spec, Spec) :-
  547    integer(Spec),
  548    !.
  549mode_bits(Name, Bits) :-
  550    atom(Name),
  551    !,
  552    (   file_mode(Name, Bits)
  553    ->  true
  554    ;   domain_error(posix_file_mode, Name)
  555    ).
  556mode_bits(Spec, Bits) :-
  557    must_be(list(atom), Spec),
  558    phrase(mode_bits(0, Bits), Spec).
  559
  560mode_bits(Bits0, Bits) -->
  561    [Spec], !,
  562    (   { file_mode(Spec, B), Bits1 is Bits0\/B }
  563    ->  mode_bits(Bits1, Bits)
  564    ;   { domain_error(posix_file_mode, Spec) }
  565    ).
  566mode_bits(Bits, Bits) -->
  567    [].
  568
  569file_mode(suid, 0o4000).
  570file_mode(sgid, 0o2000).
  571file_mode(svtx, 0o1000).
  572file_mode(Name, Bits) :-
  573    atom_chars(Name, Chars),
  574    phrase(who_mask(0, WMask0), Chars, Rest),
  575    (   WMask0 =:= 0
  576    ->  WMask = 0o0777
  577    ;   WMask = WMask0
  578    ),
  579    maplist(mode_char, Rest, MBits),
  580    foldl(or, MBits, 0, Mask),
  581    Bits is Mask /\ WMask.
  582
  583who_mask(M0, M) -->
  584    [C],
  585    { who_mask(C,M1), !,
  586      M2 is M0\/M1
  587    },
  588    who_mask(M2,M).
  589who_mask(M, M) -->
  590    [].
  591
  592who_mask(o, 0o0007).
  593who_mask(g, 0o0070).
  594who_mask(u, 0o0700).
  595
  596mode_char(r, 0o0444).
  597mode_char(w, 0o0222).
  598mode_char(x, 0o0111).
  599
  600or(B1, B2, B) :-
  601    B is B1\/B2