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

list_archive(File) :-
    setup_call_cleanup(
        archive_open(File, Archive, []),
        (   repeat,
            (   archive_next_header(Archive, Path)
            ->  format('~w~n', [Path]),
                fail
            ;   !
            )
        ),
        archive_close(Archive)).

list_archive2(File) :-
    list_archive(File, Headers),
    maplist(writeln, Headers).

list_archive2(File, Headers) :-
    archive_foldl(add_header, File, Headers, []).

add_header(Path, _, [Path|Paths], Paths).

print_entry(Path, Handle, Cnt0, Cnt1) :-
    archive_header_property(Handle, filetype(Type)),
    format('File ~w is of type ~w~n', [Path, Type]),
    Cnt1 is Cnt0 + 1.

list_archive_headers(File) :-
    archive_foldl(print_entry, File, 0, FileCount),
    format('We have ~w files', [FileCount]).

  111:- use_foreign_library(foreign(archive4pl)).

 archive_open(+Data, -Archive, +Options) is det

Wrapper around archive_open/4 that opens the archive in read mode.

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

 archive_open(+Data, +Mode, -Archive, +Options) is det

Open the archive in Data and unify Archive with a handle to the opened archive. Data is either a file name (as accepted by open/4) or a stream that has been opened with the option type(binary). If Data is an already open stream, the caller is responsible for closing it (but see option close_parent(true)) and must not close the stream until after archive_close/1 is called. Mode is either read or write. Details are controlled by Options. Typically, the option close_parent(true) is used to also close the Data stream if the archive is closed using archive_close/1. For other options when reading, the defaults are typically fine - for writing, a valid format and optional filters must be specified. The option format(raw) must be used to process compressed streams that do not contain explicit entries (e.g., gzip'ed data) unambibuously. The raw format creates a pseudo archive holding a single member named data.

close_parent(+Boolean)

If this option is true (default false), Data stream is closed when archive_close/1 is called on Archive. If Data is a file name, the default is true.

filters(+Filters)

Support the filters in the list Filters. In read mode, if no filter is provided, all is assumed. In write mode, none is assumed and at most one filter is allowed. Supported values are all, bzip2, compress, gzip, grzip, lrzip, lzip, lzma, lzop, none, rpm, uu and xz.

formats(+Formats)

Support the formats in the list Formats. In write mode, you must supply a single format. If no format is provided, all is assumed for read mode. Note that all does not include raw and mtree. To open both archive and non-archive files, all together with raw and/or mtree must be specified. Supported values are all, 7zip, ar, cab, cpio, empty, gnutar, iso9660, lha, mtree, rar, raw, tar, xar and zip.

filter(+Filter)

format(+Format)

compression(+Filter)

Deprecated. Add a single filter or format. Repeating these options to support multiple filters/formats is deprecated in favour of filters/1 and formats/1. compression/1 is a synonym for filter/1.

Note that the actually supported compression types and formats may vary depending on the version and installation options of the underlying libarchive library. This predicate raises a domain or permission error if the (explicitly) requested format or filter is not supported.

Errors

- domain_error(filter, Filter) if the requested filter is invalid (e.g., all for writing).

- domain_error(format, Format) if the requested format type is not supported.

- permission_error(set, filter, Filter) if the requested filter is not supported.

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

 archive_open_stream(+Stream, +Mode, -Archive, +Options) is det

Wrapper around the foreign '$archive_open_stream'/4 that canonicalises the options: multiple filter/compression and format options are folded into a single filters(List) and formats(List) option.

  217archive_open_stream(Stream, Mode, Archive, Options0) :-
  218    archive_options(Options0, Options),
  219    '$archive_open_stream'(Stream, Mode, Archive, Options).

 archive_options(+Options0, -Options) is det

Fold the (possibly repeated) filter/1, compression/1 and format/1 options into a single filters/1 and formats/1 list option, as expected by the foreign code. Repeating filter or format is deprecated in favour of the list form.

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

 archive_close(+Archive) is det

Close the archive. If close_parent(true) was specified in archive_open/4, the underlying entry stream is closed too. If there is an entry opened with archive_open_entry/2, actually closing the archive is delayed until the stream associated with the entry is closed. This can be used to open a stream to an archive entry without having to worry about closing the archive:

archive_open_named(ArchiveFile, EntryName, Stream) :-
    archive_open(ArchiveFile, Archive, []),
    archive_next_header(Archive, EntryName),
    archive_open_entry(Archive, Stream),
    archive_close(Archive).

 archive_property(+Handle, ?Property) is nondet

True when Property is a property of the archive Handle. Defined properties are:

filters(List)

True when the indicated filters are applied before reaching the archive format.

  284archive_property(Handle, Property) :-
  285    defined_archive_property(Property),
  286    Property =.. [Name,Value],
  287    archive_property(Handle, Name, Value).
  288
  289defined_archive_property(filter(_)).

 archive_next_header(+Handle, -Name) is semidet

Forward to the next entry of the archive for which Name unifies with the pathname of the entry. Fails silently if the end of the archive is reached before success. Name is typically specified if a single entry must be accessed and unbound otherwise. The following example opens a Prolog stream to a given archive entry. Note that Stream must be closed using close/1 and the archive must be closed using archive_close/1 after the data has been used. See also setup_call_cleanup/3.

open_archive_entry(ArchiveFile, EntryName, Stream) :-
    open(ArchiveFile, read, In, [type(binary)]),
    archive_open(In, Archive, [close_parent(true)]),
    archive_next_header(Archive, EntryName),
    archive_open_entry(Archive, Stream).

Errors

- permission_error(next_header, archive, Handle) if a previously opened entry is not closed.

 archive_open_entry(+Archive, -Stream) is det

Open the current entry as a stream. Stream must be closed. If the stream is not closed before the next call to archive_next_header/2, a permission error is raised.

 archive_set_header_property(+Archive, +Property)

Set Property of the current header. Write-mode only. Defined properties are:

filetype(-Type)

Type is one of file, link, socket, character_device, block_device, directory or fifo. It appears that this library can also return other values. These are returned as an integer.

mtime(-Time)

True when entry was last modified at time.

size(-Bytes)

True when entry is Bytes long.

link_target(-Target)

Target for a link. Currently only supported for symbolic links.

 archive_header_property(+Archive, ?Property)

True when Property is a property of the current header. Defined properties are:

filetype(-Type)

Type is one of file, link, socket, character_device, block_device, directory or fifo. It appears that this library can also return other values. These are returned as an integer.

mtime(-Time)

True when entry was last modified at time.

size(-Bytes)

True when entry is Bytes long.

link_target(-Target)

Target for a link. Currently only supported for symbolic links.

format(-Format)

Provides the name of the archive format applicable to the current entry. The returned value is the lowercase version of the output of archive_format_name().

permissions(-Integer)

True when entry has the indicated permission mask.

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

 archive_extract(+ArchiveFile, +Dir, +Options)

Extract files from the given archive into Dir. Supported options:

remove_prefix(+Prefix)

Strip Prefix from all entries before extracting. If Prefix is a list, then each prefix is tried in order, succeding at the first one that matches. If no prefixes match, an error is reported. If Prefix is an atom, then that prefix is removed.

exclude(+ListOfPatterns)

Ignore members that match one of the given patterns. Patterns are handed to wildcard_match/2.

include(+ListOfPatterns)

Include members that match one of the given patterns. Patterns are handed to wildcard_match/2. The exclude options takes preference if a member matches both the include and the exclude option.

Errors

- existence_error(directory, Dir) if Dir does not exist or is not a directory.

- domain_error(path_prefix(Prefix), Path) if a path in the archive does not start with Prefix

To be done

- Add options

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

 matches(+Patterns, +Path) is semidet

True when Path matches a pattern in Patterns.

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

 set_permissions(+Perm:integer, +Target:atom)

Restore the permissions. Currently only restores the executable permission.

  475set_permissions(Perm, Target) :-
  476    Perm /\ 0o100 =\= 0,
  477    !,
  478    '$mark_executable'(Target).
  479set_permissions(_, _).
  480
  481
  482                 /*******************************
  483                 *    HIGH LEVEL PREDICATES     *
  484                 *******************************/

 archive_entries(+Archive, -Paths) is det

True when Paths is a list of pathnames appearing in Archive.

  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(_, []).

 archive_data_stream(+Archive, -DataStream, +Options) is nondet

True when DataStream is a stream to a data object inside Archive. This predicate transparently unpacks data inside possibly nested archives, e.g., a tar file inside a zip file. It applies the appropriate decompression filters and thus ensures that Prolog reads the plain data from DataStream. DataStream must be closed after the content has been processed. Backtracking opens the next member of the (nested) archive. This predicate processes the following options:

meta_data(-Data:list(dict))

If provided, Data is unified with a list of filters applied to the (nested) archive to open the current DataStream. The first element describes the outermost archive. Each Data dict contains the header properties (archive_header_property/2) as well as the keys:

filters(Filters:list(atom))

Filter list as obtained from archive_property/2

name(Atom)

Name of the entry.

Non-archive files are handled as pseudo-archives that hold a single stream. This is implemented by using archive_open/3 with the options [format(all),format(raw)].

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

 archive_create(+OutputFile, +InputFiles, +Options) is det

Convenience predicate to create an archive in OutputFile with data from a list of InputFiles and the given Options.

Besides options supported by archive_open/4, the following options are supported:

directory(+Directory)

Changes the directory before adding input files. If this is specified, paths of input files must be relative to Directory and archived files will not have Directory as leading path. This is to simulate -C option of the tar program.

format(+Format)

Write mode supports the following formats: `7zip`, cpio, gnutar, iso9660, xar and zip. Note that a particular installation may support only a subset of these, depending on the configuration of libarchive.

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

 archive_foldl(:Goal, +Archive, +State0, -State)

Operates like foldl/4 but for the entries in the archive. For each member of the archive, Goal called as `call(:Goal, +Path, +Handle, +S0, -S1). Here, S0 is current state of the accumulator (starting with State0) and S1 is the next state of the accumulator, producing State after the last member of the archive.

Arguments:

Archive

- File name or stream to be given to archive_open/[3,4].

See also

- archive_header_property/2, archive_open/4.

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