View source with formatted comments or as raw
    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)).   50
   51/** <module> Extended operations on files
   52
   53This module provides additional operations on   files.  This covers both
   54more  obscure  and  possible  non-portable    low-level  operations  and
   55high-level utilities.
   56
   57Using these Prolog primitives is typically   to  be preferred over using
   58operating system primitives through shell/1  or process_create/3 because
   59(1) there are no potential file  name   quoting  issues, (2) there is no
   60dependency  on  operating   system   commands    and   (3)   using   the
   61implementations from this library is usually faster.
   62*/
   63
   64
   65:- use_foreign_library(foreign(files), install_files).   66
   67%!  set_time_file(+File, -OldTimes, +NewTimes) is det.
   68%
   69%   Query and set POSIX time attributes of a file. Both OldTimes and
   70%   NewTimes are lists of  option-terms.   Times  are represented in
   71%   SWI-Prolog's standard floating point numbers.   New times may be
   72%   specified as =now= to indicate the current time. Defined options
   73%   are:
   74%
   75%       * access(Time)
   76%       Describes the time of last access   of  the file. This value
   77%       can be read and written.
   78%
   79%       * modified(Time)
   80%       Describes the time  the  contents  of   the  file  was  last
   81%       modified. This value can be read and written.
   82%
   83%       * changed(Time)
   84%       Describes the time the file-structure  itself was changed by
   85%       adding (link()) or removing (unlink()) names.
   86%
   87%   Below  are  some  example  queries.   The  first  retrieves  the
   88%   access-time, while the second sets the last-modified time to the
   89%   current time.
   90%
   91%       ==
   92%       ?- set_time_file(foo, [access(Access)], []).
   93%       ?- set_time_file(foo, [], [modified(now)]).
   94%       ==
   95
   96%!  link_file(+OldPath, +NewPath, +Type) is det.
   97%
   98%   Create a link in the filesystem   from  NewPath to OldPath. Type
   99%   defines the type of link and is one of =hard= or =symbolic=.
  100%
  101%   With some limitations, these  functions   also  work on Windows.
  102%   First of all, the unerlying filesystem  must support links. This
  103%   requires NTFS. Second, symbolic  links   are  only  supported in
  104%   Vista and later.
  105%
  106%   @error  domain_error(link_type, Type) if the requested link-type
  107%           is unknown or not supported on the target OS.
  108
  109%!  relative_file_name(+Path:atom, +RelTo:atom, -RelPath:atom) is det.
  110%!  relative_file_name(-Path:atom, +RelTo:atom, +RelPath:atom) is det.
  111%
  112%   True when RelPath is Path, relative to RelTo. Path and RelTo are
  113%   first handed to absolute_file_name/2, which   makes the absolute
  114%   *and* canonical. Below are two examples:
  115%
  116%   ==
  117%   ?- relative_file_name('/home/janw/nice',
  118%                         '/home/janw/deep/dir/file', Path).
  119%   Path = '../../nice'.
  120%
  121%   ?- relative_file_name(Path, '/home/janw/deep/dir/file', '../../nice').
  122%   Path = '/home/janw/nice'.
  123%   ==
  124%
  125%   @param  All paths must be in canonical POSIX notation, i.e.,
  126%           using / to separate segments in the path.  See
  127%           prolog_to_os_filename/2.
  128%   @bug    This predicate is defined as a _syntactical_ operation.
  129
  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).
  157
  158
  159%!  directory_file_path(+Directory, +File, -Path) is det.
  160%!  directory_file_path(?Directory, ?File, +Path) is det.
  161%
  162%   True when Path is the full path-name   for  File in Dir. This is
  163%   comparable to atom_concat(Directory, File, Path), but it ensures
  164%   there is exactly one / between the two parts.  Notes:
  165%
  166%     * In mode (+,+,-), if File is given and absolute, Path
  167%     is unified to File.
  168%     * Mode (-,-,+) uses file_directory_name/2 and file_base_name/2
  169
  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    ).
  208
  209
  210%!  copy_file(From, To) is det.
  211%
  212%   Copy a file into a new file or  directory. The data is copied as
  213%   binary data.
  214
  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).
  234
  235
  236%!  make_directory_path(+Dir) is det.
  237%
  238%   Create Dir and all required  components   (like  mkdir  -p). Can
  239%   raise various file-specific exceptions.
  240
  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          )).
  266
  267%!  copy_directory(+From, +To) is det.
  268%
  269%   Copy the contents of the directory  From to To (recursively). If
  270%   To is the name of an existing  directory, the _contents_ of From
  271%   are copied into To. I.e., no  subdirectory using the basename of
  272%   From is created.
  273
  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(..).
  295
  296%!  delete_directory_and_contents(+Dir) is det.
  297%
  298%   Recursively remove the directory Dir and its contents. If Dir is
  299%   a symbolic link or symbolic links   inside  Dir are encountered,
  300%   the links are removed rather than their content. Use with care!
  301
  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    ).
  329
  330%!  delete_directory_contents(+Dir) is det.
  331%
  332%   Remove all content from  directory   Dir,  without  removing Dir
  333%   itself. Similar to delete_directory_and_contents/2,  if symbolic
  334%   links are encountered in Dir, the  links are removed rather than
  335%   their content.
  336
  337delete_directory_contents(Dir) :-
  338    directory_files(Dir, Files),
  339    maplist(delete_directory_contents(Dir), Files).
  340
  341
  342%!  chmod(+File, +Spec) is det.
  343%
  344%   Set the mode of the target file. Spec  is one of `+Mode`, `-Mode` or
  345%   a plain `Mode`, which adds new   permissions, revokes permissions or
  346%   sets the exact permissions. `Mode`  itself   is  an integer, a POSIX
  347%   mode name or a list of POSIX   mode names. Defines names are `suid`,
  348%   `sgid`, `svtx` and the all names   defined by the regular expression
  349%   =|[ugo]*[rwx]*|=. Specifying none of "ugo" is the same as specifying
  350%   all of them. For example, to make   a  file executable for the owner
  351%   (user) and group, we can use:
  352%
  353%     ```
  354%     ?- chmod(myfile, +ugx).
  355%     ```
  356
  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