View source with formatted comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker and Matt Lilley
    4    E-mail:        jan@swi-prolog.org
    5    WWW:           https://www.swi-prolog.org
    6    Copyright (c)  2012-2026, VU University Amsterdam
    7                              SWI-Prolog Solutions b.v.
    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(archive,
   37          [ archive_open/3,             % +Stream, -Archive, +Options
   38            archive_open/4,             % +Stream, +Mode, -Archive, +Options
   39            archive_create/3,           % +OutputFile, +InputFileList, +Options
   40            archive_close/1,            % +Archive
   41            archive_property/2,         % +Archive, ?Property
   42            archive_next_header/2,      % +Archive, -Name
   43            archive_open_entry/2,       % +Archive, -EntryStream
   44            archive_header_property/2,  % +Archive, ?Property
   45            archive_set_header_property/2,      % +Archive, +Property
   46            archive_extract/3,          % +Archive, +Dir, +Options
   47
   48            archive_entries/2,          % +Archive, -Entries
   49            archive_data_stream/3,      % +Archive, -DataStream, +Options
   50            archive_foldl/4             % :Goal, +Archive, +State0, -State
   51          ]).   52:- autoload(library(error), [existence_error/2, domain_error/2, must_be/2]).   53:- autoload(library(filesex), [directory_file_path/3, make_directory_path/1]).   54:- autoload(library(lists), [member/2, append/3, selectchk/3]).   55:- autoload(library(apply), [maplist/3, partition/4]).   56:- autoload(library(option), [option/3, option/2, merge_options/3]).   57
   58:- meta_predicate
   59    archive_foldl(4, +, +, -).   60
   61/** <module> Access several archive formats
   62
   63This library uses _libarchive_ to access   a variety of archive formats.
   64The following example lists the entries in an archive:
   65
   66  ```
   67  list_archive(File) :-
   68      setup_call_cleanup(
   69          archive_open(File, Archive, []),
   70          (   repeat,
   71              (   archive_next_header(Archive, Path)
   72              ->  format('~w~n', [Path]),
   73                  fail
   74              ;   !
   75              )
   76          ),
   77          archive_close(Archive)).
   78  ```
   79
   80Here  is an  alternative way  of  doing this,  using archive_foldl/4,  a
   81higher level predicate.
   82
   83  ```
   84  list_archive2(File) :-
   85      list_archive(File, Headers),
   86      maplist(writeln, Headers).
   87
   88  list_archive2(File, Headers) :-
   89      archive_foldl(add_header, File, Headers, []).
   90
   91  add_header(Path, _, [Path|Paths], Paths).
   92  ```
   93
   94Here is another example which counts the files in the archive and prints
   95file  type  information, also using archive_foldl/4:
   96
   97  ```
   98  print_entry(Path, Handle, Cnt0, Cnt1) :-
   99      archive_header_property(Handle, filetype(Type)),
  100      format('File ~w is of type ~w~n', [Path, Type]),
  101      Cnt1 is Cnt0 + 1.
  102
  103  list_archive_headers(File) :-
  104      archive_foldl(print_entry, File, 0, FileCount),
  105      format('We have ~w files', [FileCount]).
  106  ```
  107
  108@see https://github.com/libarchive/libarchive/
  109*/
  110
  111:- use_foreign_library(foreign(archive4pl)).  112
  113%!  archive_open(+Data, -Archive, +Options) is det.
  114%
  115%   Wrapper around archive_open/4 that opens the archive in read mode.
  116
  117archive_open(Stream, Archive, Options) :-
  118    archive_open(Stream, read, Archive, Options).
  119
  120:- predicate_options(archive_open/4, 4,
  121                     [ close_parent(boolean),
  122                       filters(list(oneof([all,bzip2,compress,gzip,grzip,lrzip,
  123                                     lzip,lzma,lzop,none,rpm,uu,xz]))),
  124                       formats(list(oneof([all,'7zip',ar,cab,cpio,empty,gnutar,
  125                                     iso9660,lha,mtree,rar,raw,tar,xar,zip]))),
  126                       filter(oneof([all,bzip2,compress,gzip,grzip,lrzip,
  127                                     lzip,lzma,lzop,none,rpm,uu,xz])),
  128                       format(oneof([all,'7zip',ar,cab,cpio,empty,gnutar,
  129                                     iso9660,lha,mtree,rar,raw,tar,xar,zip])),
  130                       compression(oneof([all,bzip2,compress,gzip,grzip,lrzip,
  131                                     lzip,lzma,lzop,none,rpm,uu,xz]))
  132                     ]).  133:- predicate_options(archive_create/3, 3,
  134                     [ directory(atom),
  135                       pass_to(archive_open/4, 4)
  136                     ]).  137
  138%!  archive_open(+Data, +Mode, -Archive, +Options) is det.
  139%
  140%   Open the  archive in  Data and  unify Archive with  a handle  to the
  141%   opened archive.  Data is either a  file name (as accepted by open/4)
  142%   or a stream  that has been opened with the  option type(binary).  If
  143%   Data  is an  already  open  stream, the  caller  is responsible  for
  144%   closing it  (but see option  close_parent(true)) and must  not close
  145%   the stream  until after archive_close/1  is called.  Mode  is either
  146%   `read` or  `write`.  Details are controlled  by Options.  Typically,
  147%   the option close_parent(true) is used  to also close the Data stream
  148%   if the archive  is closed using archive_close/1.   For other options
  149%   when reading, the defaults are typically fine - for writing, a valid
  150%   format  and   optional  filters  must  be   specified.   The  option
  151%   format(raw) must be  used to process compressed streams  that do not
  152%   contain explicit  entries (e.g.,  gzip'ed data)  unambibuously.  The
  153%   =raw=  format creates  a _pseudo  archive_ holding  a single  member
  154%   named =data=.
  155%
  156%     * close_parent(+Boolean)
  157%     If this option is =true=  (default =false=), Data stream is closed
  158%     when archive_close/1 is called on Archive. If Data is a file name,
  159%     the default is =true=.
  160%
  161%     * filters(+Filters)
  162%     Support the filters in the list Filters.  In read mode, if no
  163%     filter is provided, =all= is assumed.  In write mode, =none= is
  164%     assumed and at most one filter is allowed.  Supported values are
  165%     =all=, =bzip2=, =compress=, =gzip=, =grzip=, =lrzip=, =lzip=,
  166%     =lzma=, =lzop=, =none=, =rpm=, =uu= and =xz=.
  167%
  168%     * formats(+Formats)
  169%     Support the formats in the list Formats.  In write mode, you must
  170%     supply a single format.  If no format is provided, =all= is
  171%     assumed for read mode.  Note that =all= does *not* include =raw=
  172%     and =mtree=.  To open both archive and non-archive files, =all=
  173%     together with =raw= and/or =mtree= must be specified.  Supported
  174%     values are =all=, =7zip=, =ar=, =cab=, =cpio=, =empty=, =gnutar=,
  175%     =iso9660=, =lha=, =mtree=, =rar=, =raw=, =tar=, =xar= and =zip=.
  176%
  177%     * filter(+Filter)
  178%     * format(+Format)
  179%     * compression(+Filter)
  180%     Deprecated.  Add a single filter or format.  Repeating these
  181%     options to support multiple filters/formats is deprecated in
  182%     favour of filters/1 and formats/1.  compression/1 is a synonym for
  183%     filter/1.
  184%
  185%   Note that the  actually supported compression types  and formats may
  186%   vary  depending  on the  version  and  installation options  of  the
  187%   underlying libarchive  library.  This  predicate raises a  domain or
  188%   permission error if  the (explicitly) requested format  or filter is
  189%   not supported.
  190%
  191%   @error  domain_error(filter, Filter) if the requested
  192%           filter is invalid (e.g., `all` for writing).
  193%   @error  domain_error(format, Format) if the requested
  194%           format type is not supported.
  195%   @error  permission_error(set, filter, Filter) if the requested
  196%           filter is not supported.
  197
  198archive_open(stream(Stream), Mode, Archive, Options) :-
  199    !,
  200    archive_open_stream(Stream, Mode, Archive, Options).
  201archive_open(Stream, Mode, Archive, Options) :-
  202    is_stream(Stream),
  203    !,
  204    archive_open_stream(Stream, Mode, Archive, Options).
  205archive_open(File, Mode, Archive, Options) :-
  206    open(File, Mode, Stream, [type(binary)]),
  207    merge_options([close_parent(true)], Options, Options1),
  208    catch(archive_open_stream(Stream, Mode, Archive, Options1),
  209          E, (close(Stream, [force(true)]), throw(E))).
  210
  211%!  archive_open_stream(+Stream, +Mode, -Archive, +Options) is det.
  212%
  213%   Wrapper around the foreign '$archive_open_stream'/4 that canonicalises
  214%   the options: multiple filter/compression and format options are folded
  215%   into a single filters(List) and formats(List) option.
  216
  217archive_open_stream(Stream, Mode, Archive, Options0) :-
  218    archive_options(Options0, Options),
  219    '$archive_open_stream'(Stream, Mode, Archive, Options).
  220
  221%!  archive_options(+Options0, -Options) is det.
  222%
  223%   Fold the (possibly repeated) filter/1, compression/1 and format/1
  224%   options into a single filters/1 and formats/1 list option, as
  225%   expected by the foreign code.  Repeating filter or format is
  226%   deprecated in favour of the list form.
  227
  228archive_options(Options0, Options) :-
  229    fold_options([filter,compression], filters, Options0, Options1),
  230    fold_options([format], formats, Options1, Options).
  231
  232fold_options(Names, ListName, Options0, Options) :-
  233    partition(option_of(Names), Options0, Singulars, Rest),
  234    (   Singulars == []
  235    ->  Options = Options0
  236    ;   maplist(arg(1), Singulars, Values),
  237        (   Singulars = [_,_|_]
  238        ->  print_message(warning, archive(deprecated_repeat(ListName)))
  239        ;   true
  240        ),
  241        (   ListOpt =.. [ListName, Old],
  242            selectchk(ListOpt, Rest, Rest1)
  243        ->  append(Old, Values, All)
  244        ;   Rest1 = Rest,
  245            All = Values
  246        ),
  247        Merged =.. [ListName, All],
  248        Options = [Merged|Rest1]
  249    ).
  250
  251option_of(Names, Option) :-
  252    compound(Option),
  253    functor(Option, Name, 1),
  254    memberchk(Name, Names).
  255
  256
  257%!  archive_close(+Archive) is det.
  258%
  259%   Close  the   archive.   If   close_parent(true)  was   specified  in
  260%   archive_open/4, the underlying entry stream  is closed too. If there
  261%   is an  entry opened with archive_open_entry/2,  actually closing the
  262%   archive is  delayed until  the stream associated  with the  entry is
  263%   closed.   This can  be used  to open  a stream  to an  archive entry
  264%   without having to worry about closing the archive:
  265%
  266%     ```
  267%     archive_open_named(ArchiveFile, EntryName, Stream) :-
  268%         archive_open(ArchiveFile, Archive, []),
  269%         archive_next_header(Archive, EntryName),
  270%         archive_open_entry(Archive, Stream),
  271%         archive_close(Archive).
  272%     ```
  273
  274
  275%!  archive_property(+Handle, ?Property) is nondet.
  276%
  277%   True when Property is a property  of the archive Handle. Defined
  278%   properties are:
  279%
  280%     * filters(List)
  281%     True when the indicated filters are applied before reaching
  282%     the archive format.
  283
  284archive_property(Handle, Property) :-
  285    defined_archive_property(Property),
  286    Property =.. [Name,Value],
  287    archive_property(Handle, Name, Value).
  288
  289defined_archive_property(filter(_)).
  290
  291
  292%!  archive_next_header(+Handle, -Name) is semidet.
  293%
  294%   Forward to the next entry of the  archive for which Name unifies
  295%   with the pathname of the entry. Fails   silently  if the end  of
  296%   the  archive  is  reached  before  success.  Name  is  typically
  297%   specified if a  single  entry  must   be  accessed  and  unbound
  298%   otherwise. The following example opens  a   Prolog  stream  to a
  299%   given archive entry. Note that  _Stream_   must  be closed using
  300%   close/1 and the archive  must   be  closed using archive_close/1
  301%   after the data has been used.   See also setup_call_cleanup/3.
  302%
  303%     ```
  304%     open_archive_entry(ArchiveFile, EntryName, Stream) :-
  305%         open(ArchiveFile, read, In, [type(binary)]),
  306%         archive_open(In, Archive, [close_parent(true)]),
  307%         archive_next_header(Archive, EntryName),
  308%         archive_open_entry(Archive, Stream).
  309%     ```
  310%
  311%   @error permission_error(next_header, archive, Handle) if a
  312%   previously opened entry is not closed.
  313
  314%!  archive_open_entry(+Archive, -Stream) is det.
  315%
  316%   Open the current entry as a stream. Stream must be closed.
  317%   If the stream is not closed before the next call to
  318%   archive_next_header/2, a permission error is raised.
  319
  320
  321%!  archive_set_header_property(+Archive, +Property)
  322%
  323%   Set Property of the current header.  Write-mode only. Defined
  324%   properties are:
  325%
  326%     * filetype(-Type)
  327%     Type is one of =file=, =link=, =socket=, =character_device=,
  328%     =block_device=, =directory= or =fifo=.  It appears that this
  329%     library can also return other values.  These are returned as
  330%     an integer.
  331%     * mtime(-Time)
  332%     True when entry was last modified at time.
  333%     * size(-Bytes)
  334%     True when entry is Bytes long.
  335%     * link_target(-Target)
  336%     Target for a link. Currently only supported for symbolic
  337%     links.
  338
  339%!  archive_header_property(+Archive, ?Property)
  340%
  341%   True when Property is a property of the current header.  Defined
  342%   properties are:
  343%
  344%     * filetype(-Type)
  345%     Type is one of =file=, =link=, =socket=, =character_device=,
  346%     =block_device=, =directory= or =fifo=.  It appears that this
  347%     library can also return other values.  These are returned as
  348%     an integer.
  349%     * mtime(-Time)
  350%     True when entry was last modified at time.
  351%     * size(-Bytes)
  352%     True when entry is Bytes long.
  353%     * link_target(-Target)
  354%     Target for a link. Currently only supported for symbolic
  355%     links.
  356%     * format(-Format)
  357%     Provides the name of the archive format applicable to the
  358%     current entry.  The returned value is the lowercase version
  359%     of the output of archive_format_name().
  360%     * permissions(-Integer)
  361%     True when entry has the indicated permission mask.
  362
  363archive_header_property(Archive, Property) :-
  364    (   nonvar(Property)
  365    ->  true
  366    ;   header_property(Property)
  367    ),
  368    archive_header_prop_(Archive, Property).
  369
  370header_property(filetype(_)).
  371header_property(mtime(_)).
  372header_property(size(_)).
  373header_property(link_target(_)).
  374header_property(format(_)).
  375header_property(permissions(_)).
  376
  377
  378%!  archive_extract(+ArchiveFile, +Dir, +Options)
  379%
  380%   Extract files from the given archive into Dir. Supported
  381%   options:
  382%
  383%     * remove_prefix(+Prefix)
  384%     Strip Prefix from all entries before extracting. If Prefix
  385%     is a list, then each prefix is tried in order, succeding at
  386%     the first one that matches. If no prefixes match, an error
  387%     is reported. If Prefix is an atom, then that prefix is removed.
  388%     * exclude(+ListOfPatterns)
  389%     Ignore members that match one of the given patterns.
  390%     Patterns are handed to wildcard_match/2.
  391%     * include(+ListOfPatterns)
  392%     Include members that match one of the given patterns.
  393%     Patterns are handed to wildcard_match/2. The `exclude`
  394%     options takes preference if a member matches both the `include`
  395%     and the `exclude` option.
  396%
  397%   @error  existence_error(directory, Dir) if Dir does not exist
  398%           or is not a directory.
  399%   @error  domain_error(path_prefix(Prefix), Path) if a path in
  400%           the archive does not start with Prefix
  401%   @tbd    Add options
  402
  403archive_extract(Archive, Dir, Options) :-
  404    (   exists_directory(Dir)
  405    ->  true
  406    ;   existence_error(directory, Dir)
  407    ),
  408    setup_call_cleanup(
  409        archive_open(Archive, Handle, Options),
  410        extract(Handle, Dir, Options),
  411        archive_close(Handle)).
  412
  413extract(Archive, Dir, Options) :-
  414    archive_next_header(Archive, Path),
  415    !,
  416    option(include(InclPatterns), Options, ['*']),
  417    option(exclude(ExclPatterns), Options, []),
  418    (   archive_header_property(Archive, filetype(file)),
  419        \+ matches(ExclPatterns, Path),
  420        matches(InclPatterns, Path)
  421    ->  archive_header_property(Archive, permissions(Perm)),
  422        remove_prefix(Options, Path, ExtractPath),
  423        directory_file_path(Dir, ExtractPath, Target),
  424        file_directory_name(Target, FileDir),
  425        make_directory_path(FileDir),
  426        setup_call_cleanup(
  427            archive_open_entry(Archive, In),
  428            setup_call_cleanup(
  429                open(Target, write, Out, [type(binary)]),
  430                copy_stream_data(In, Out),
  431                close(Out)),
  432            close(In)),
  433        set_permissions(Perm, Target)
  434    ;   true
  435    ),
  436    extract(Archive, Dir, Options).
  437extract(_, _, _).
  438
  439%!  matches(+Patterns, +Path) is semidet.
  440%
  441%   True when Path matches a pattern in Patterns.
  442
  443matches([], _Path) :-
  444    !,
  445    fail.
  446matches(Patterns, Path) :-
  447    split_string(Path, "/", "/", Parts),
  448    member(Segment, Parts),
  449    Segment \== "",
  450    member(Pattern, Patterns),
  451    wildcard_match(Pattern, Segment),
  452    !.
  453
  454remove_prefix(Options, Path, ExtractPath) :-
  455    (   option(remove_prefix(Remove), Options)
  456    ->  (   is_list(Remove)
  457        ->  (   member(P, Remove),
  458                atom_concat(P, ExtractPath, Path)
  459            ->  true
  460            ;   domain_error(path_prefix(Remove), Path)
  461            )
  462        ;   (   atom_concat(Remove, ExtractPath, Path)
  463            ->  true
  464            ;   domain_error(path_prefix(Remove), Path)
  465            )
  466        )
  467    ;   ExtractPath = Path
  468    ).
  469
  470%!  set_permissions(+Perm:integer, +Target:atom)
  471%
  472%   Restore the permissions.  Currently only restores the executable
  473%   permission.
  474
  475set_permissions(Perm, Target) :-
  476    Perm /\ 0o100 =\= 0,
  477    !,
  478    '$mark_executable'(Target).
  479set_permissions(_, _).
  480
  481
  482                 /*******************************
  483                 *    HIGH LEVEL PREDICATES     *
  484                 *******************************/
  485
  486%!  archive_entries(+Archive, -Paths) is det.
  487%
  488%   True when Paths is a list of pathnames appearing in Archive.
  489
  490archive_entries(Archive, Paths) :-
  491    setup_call_cleanup(
  492        archive_open(Archive, Handle, []),
  493        contents(Handle, Paths),
  494        archive_close(Handle)).
  495
  496contents(Handle, [Path|T]) :-
  497    archive_next_header(Handle, Path),
  498    !,
  499    contents(Handle, T).
  500contents(_, []).
  501
  502%!  archive_data_stream(+Archive, -DataStream, +Options) is nondet.
  503%
  504%   True when DataStream  is  a  stream   to  a  data  object inside
  505%   Archive.  This  predicate  transparently   unpacks  data  inside
  506%   _possibly nested_ archives, e.g., a _tar_   file  inside a _zip_
  507%   file. It applies the appropriate  decompression filters and thus
  508%   ensures that Prolog  reads  the   plain  data  from  DataStream.
  509%   DataStream must be closed after the  content has been processed.
  510%   Backtracking opens the next member of the (nested) archive. This
  511%   predicate processes the following options:
  512%
  513%     - meta_data(-Data:list(dict))
  514%     If provided, Data is unified with a list of filters applied to
  515%     the (nested) archive to open the current DataStream. The first
  516%     element describes the outermost archive. Each Data dict
  517%     contains the header properties (archive_header_property/2) as
  518%     well as the keys:
  519%
  520%       - filters(Filters:list(atom))
  521%       Filter list as obtained from archive_property/2
  522%       - name(Atom)
  523%       Name of the entry.
  524%
  525%   Non-archive files are handled as pseudo-archives that hold a
  526%   single stream.  This is implemented by using archive_open/3 with
  527%   the options `[format(all),format(raw)]`.
  528
  529archive_data_stream(Archive, DataStream, Options) :-
  530    option(meta_data(MetaData), Options, _),
  531    archive_content(Archive, DataStream, MetaData, []).
  532
  533archive_content(Archive, Entry, [EntryMetadata|PipeMetadataTail], PipeMetadata2) :-
  534    archive_property(Archive, filter(Filters)),
  535    repeat,
  536    (   archive_next_header(Archive, EntryName)
  537    ->  findall(EntryProperty,
  538                archive_header_property(Archive, EntryProperty),
  539                EntryProperties),
  540        dict_create(EntryMetadata, archive_meta_data,
  541                    [ filters(Filters),
  542                      name(EntryName)
  543                    | EntryProperties
  544                    ]),
  545        (   EntryMetadata.filetype == file
  546        ->  archive_open_entry(Archive, Entry0),
  547            (   EntryName == data,
  548                EntryMetadata.format == raw
  549            ->  % This is the last entry in this nested branch.
  550                % We therefore close the choicepoint created by repeat/0.
  551                % Not closing this choicepoint would cause
  552                % archive_next_header/2 to throw an exception.
  553                !,
  554                PipeMetadataTail = PipeMetadata2,
  555                Entry = Entry0
  556            ;   PipeMetadataTail = PipeMetadata1,
  557                open_substream(Entry0,
  558                               Entry,
  559                               PipeMetadata1,
  560                               PipeMetadata2)
  561            )
  562        ;   fail
  563        )
  564    ;   !,
  565        fail
  566    ).
  567
  568open_substream(In, Entry, ArchiveMetadata, PipeTailMetadata) :-
  569    setup_call_cleanup(
  570        archive_open(stream(In),
  571                     Archive,
  572                     [ close_parent(true),
  573                       format(all),
  574                       format(raw)
  575                     ]),
  576        archive_content(Archive, Entry, ArchiveMetadata, PipeTailMetadata),
  577        archive_close(Archive)).
  578
  579
  580%!  archive_create(+OutputFile, +InputFiles, +Options) is det.
  581%
  582%   Convenience predicate to create an   archive  in OutputFile with
  583%   data from a list of InputFiles and the given Options.
  584%
  585%   Besides  options  supported  by  archive_open/4,  the  following
  586%   options are supported:
  587%
  588%     * directory(+Directory)
  589%     Changes the directory before adding input files. If this is
  590%     specified,   paths of  input  files   must   be relative to
  591%     Directory and archived files will not have Directory
  592%     as leading path. This is to simulate =|-C|= option of
  593%     the =tar= program.
  594%
  595%     * format(+Format)
  596%     Write mode supports the following formats: `7zip`, `cpio`,
  597%     `gnutar`, `iso9660`, `xar` and `zip`.  Note that a particular
  598%     installation may support only a subset of these, depending on
  599%     the configuration of `libarchive`.
  600
  601archive_create(OutputFile, InputFiles, Options) :-
  602    must_be(list(text), InputFiles),
  603    option(directory(BaseDir), Options, '.'),
  604    setup_call_cleanup(
  605        archive_open(OutputFile, write, Archive, Options),
  606        archive_create_1(Archive, BaseDir, BaseDir, InputFiles, top),
  607        archive_close(Archive)).
  608
  609archive_create_1(_, _, _, [], _) :- !.
  610archive_create_1(Archive, Base, Current, ['.'|Files], sub) :-
  611    !,
  612    archive_create_1(Archive, Base, Current, Files, sub).
  613archive_create_1(Archive, Base, Current, ['..'|Files], Where) :-
  614    !,
  615    archive_create_1(Archive, Base, Current, Files, Where).
  616archive_create_1(Archive, Base, Current, [File|Files], Where) :-
  617    directory_file_path(Current, File, Filename),
  618    archive_create_2(Archive, Base, Filename),
  619    archive_create_1(Archive, Base, Current, Files, Where).
  620
  621archive_create_2(Archive, Base, Directory) :-
  622    exists_directory(Directory),
  623    !,
  624    entry_name(Base, Directory, Directory0),
  625    archive_next_header(Archive, Directory0),
  626    time_file(Directory, Time),
  627    archive_set_header_property(Archive, mtime(Time)),
  628    archive_set_header_property(Archive, filetype(directory)),
  629    archive_open_entry(Archive, EntryStream),
  630    close(EntryStream),
  631    directory_files(Directory, Files),
  632    archive_create_1(Archive, Base, Directory, Files, sub).
  633archive_create_2(Archive, Base, Filename) :-
  634    entry_name(Base, Filename, Filename0),
  635    archive_next_header(Archive, Filename0),
  636    size_file(Filename, Size),
  637    time_file(Filename, Time),
  638    archive_set_header_property(Archive, size(Size)),
  639    archive_set_header_property(Archive, mtime(Time)),
  640    setup_call_cleanup(
  641        archive_open_entry(Archive, EntryStream),
  642        setup_call_cleanup(
  643            open(Filename, read, DataStream, [type(binary)]),
  644            copy_stream_data(DataStream, EntryStream),
  645            close(DataStream)),
  646        close(EntryStream)).
  647
  648entry_name('.', Name, Name) :- !.
  649entry_name(Base, Name, EntryName) :-
  650    directory_file_path(Base, EntryName, Name).
  651
  652%!  archive_foldl(:Goal, +Archive, +State0, -State).
  653%
  654%   Operates like foldl/4 but for the entries   in the archive. For each
  655%   member of the archive, Goal called   as `call(:Goal, +Path, +Handle,
  656%   +S0,  -S1).  Here,  `S0`  is  current  state  of  the  _accumulator_
  657%   (starting  with  State0)  and  `S1`  is    the  next  state  of  the
  658%   accumulator, producing State after the last member of the archive.
  659%
  660%   @see archive_header_property/2, archive_open/4.
  661%
  662%   @arg Archive File name or stream to be given to archive_open/[3,4].
  663
  664archive_foldl(Goal, Archive, State0, State) :-
  665    setup_call_cleanup(
  666        archive_open(Archive, Handle, [close_parent(true)]),
  667        archive_foldl_(Goal, Handle, State0, State),
  668        archive_close(Handle)
  669    ).
  670
  671archive_foldl_(Goal, Handle, State0, State) :-
  672    (   archive_next_header(Handle, Path)
  673    ->  call(Goal, Path, Handle, State0, State1),
  674        archive_foldl_(Goal, Handle, State1, State)
  675    ;   State = State0
  676    ).
  677
  678
  679		 /*******************************
  680		 *           MESSAGES		*
  681		 *******************************/
  682
  683:- multifile prolog:error_message//1, prolog:message//1.  684
  685prolog:error_message(archive_error(Code, Message)) -->
  686    [ 'Archive error (code ~p): ~w'-[Code, Message] ].
  687
  688prolog:message(archive(deprecated_repeat(ListName))) -->
  689    [ 'archive_open/4: repeating the filter/format option is deprecated; \c
  690       use ~w(List) instead'-[ListName] ]