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