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

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

 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 underlying 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, +RelToFile:atom, -RelPath:atom) is det

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

True when RelPath is Path, relative to the file RelToFile. 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'.

Add a terminating / to get a path relative to a directory, e.g.

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

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

- It would probably have been cleaner to use a directory as second argument. We can not do such dynamically as this predicate is defined as a syntactical operation, which implies it may be used for non-existing paths and URLs.

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

 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

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

 directory_member(+Directory, -Member, +Options) is nondet

True when Member is a path inside Directory. Options defined are:

recursive(+Boolean)

If true (default false), recurse into subdirectories

follow_links(+Boolean)

If true (default), follow symbolic links.

file_type(+Type)

See absolute_file_name/3.

extensions(+List)

Only return entries whose extension appears in List.

file_errors(+Errors)

How to handle errors. One of fail, warning or error. Default is warning. Errors notably happen if a directory is unreadable or a link points nowhere.

access(+Access)

Only return entries with Access

matches(+GlobPattern)

Only return files that match GlobPattern.

exclude(+GlobPattern)

Exclude files matching GlobPattern.

exclude_directory(+GlobPattern)

Do not recurse into directories matching GlobPattern.

hidden(+Boolean)

If true (default), also return hidden files.

This predicate is safe against cycles introduced by symbolic links to directories.

The idea for a non-deterministic file search predicate comes from Nicos Angelopoulos.

  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, _, _, '.').

 filter_dir_member(+Absolute, +BaseName, +Options)

True when the given file satisfies the filter expressions.

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

 filter_directory(+Entry, +Dict) is semidet

Implement the exclude_directory(+GlobPattern) option.

  376filter_directory(Entry, Dict) :-
  377    Exclude = Dict.get(exclude_directory),
  378    wildcard_match(Exclude, Entry),
  379    !, fail.
  380filter_directory(_, _).

 copy_file(+From, +To) is det

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

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

 make_directory_path(+Dir) is det

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

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

 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.

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

 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!

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

 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.

  510delete_directory_contents(Dir) :-
  511    directory_files(Dir, Files),
  512    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 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).

  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