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