1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker and Matt Lilley 4 E-mail: J.Wielemaker@cs.vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2012-2019, VU University Amsterdam 7 All rights reserved. 8 9 Redistribution and use in source and binary forms, with or without 10 modification, are permitted provided that the following conditions 11 are met: 12 13 1. Redistributions of source code must retain the above copyright 14 notice, this list of conditions and the following disclaimer. 15 16 2. Redistributions in binary form must reproduce the above copyright 17 notice, this list of conditions and the following disclaimer in 18 the documentation and/or other materials provided with the 19 distribution. 20 21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 32 POSSIBILITY OF SUCH DAMAGE. 33*/ 34 35:- module(archive, 36 [ archive_open/3, % +Stream, -Archive, +Options 37 archive_open/4, % +Stream, +Mode, -Archive, +Options 38 archive_create/3, % +OutputFile, +InputFileList, +Options 39 archive_close/1, % +Archive 40 archive_property/2, % +Archive, ?Property 41 archive_next_header/2, % +Archive, -Name 42 archive_open_entry/2, % +Archive, -EntryStream 43 archive_header_property/2, % +Archive, ?Property 44 archive_set_header_property/2, % +Archive, +Property 45 archive_extract/3, % +Archive, +Dir, +Options 46 47 archive_entries/2, % +Archive, -Entries 48 archive_data_stream/3, % +Archive, -DataStream, +Options 49 archive_foldl/4 % :Goal, +Archive, +State0, -State 50 ]). 51:- autoload(library(error), 52 [existence_error/2,domain_error/2,must_be/2]). 53:- autoload(library(filesex), 54 [directory_file_path/3,make_directory_path/1]). 55:- autoload(library(lists),[member/2]). 56:- autoload(library(option),[option/3,option/2]). 57 58:- meta_predicate 59 archive_foldl(, , , ).
111:- use_foreign_library(foreign(archive4pl)).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 filter(oneof([all,bzip2,compress,gzip,grzip,lrzip, 123 lzip,lzma,lzop,none,rpm,uu,xz])), 124 format(oneof([all,'7zip',ar,cab,cpio,empty,gnutar, 125 iso9660,lha,mtree,rar,raw,tar,xar,zip])) 126 ]). 127:- predicate_options(archive_create/3, 3, 128 [ directory(atom), 129 pass_to(archive_open/4, 4) 130 ]).
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.
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.filter(Compression). Deprecated.all is assumed. In write
mode, none is assumed.
Supported values are all, bzip2, compress, gzip,
grzip, lrzip, lzip, lzma, lzop, none, rpm, uu
and xz. The value all is default for read, none for write.all is assumed for read mode. Note that
all does not include raw and mtree. To open both archive
and non-archive files, both format(all) and
format(raw) and/or format(mtree) must be specified. Supported
values are: all, 7zip, ar, cab, cpio, empty, gnutar,
iso9660, lha, mtree, rar, raw, tar, xar and zip.
The value all is default for read.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.
192archive_open(stream(Stream), Mode, Archive, Options) :- 193 !, 194 archive_open_stream(Stream, Mode, Archive, Options). 195archive_open(Stream, Mode, Archive, Options) :- 196 is_stream(Stream), 197 !, 198 archive_open_stream(Stream, Mode, Archive, Options). 199archive_open(File, Mode, Archive, Options) :- 200 open(File, Mode, Stream, [type(binary)]), 201 catch(archive_open_stream(Stream, Mode, Archive, [close_parent(true)|Options]), 202 E, (close(Stream, [force(true)]), throw(E))).
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).
232archive_property(Handle, Property) :- 233 defined_archive_property(Property), 234 Property =.. [Name,Value], 235 archive_property(Handle, Name, Value). 236 237defined_archive_property(filter(_)).
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).
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.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.archive_format_name().311archive_header_property(Archive, Property) :- 312 ( nonvar(Property) 313 -> true 314 ; header_property(Property) 315 ), 316 archive_header_prop_(Archive, Property). 317 318header_property(filetype(_)). 319header_property(mtime(_)). 320header_property(size(_)). 321header_property(link_target(_)). 322header_property(format(_)). 323header_property(permissions(_)).
exclude
options takes preference if a member matches both the include
and the exclude option.351archive_extract(Archive, Dir, Options) :- 352 ( exists_directory(Dir) 353 -> true 354 ; existence_error(directory, Dir) 355 ), 356 setup_call_cleanup( 357 archive_open(Archive, Handle, Options), 358 extract(Handle, Dir, Options), 359 archive_close(Handle)). 360 361extract(Archive, Dir, Options) :- 362 archive_next_header(Archive, Path), 363 !, 364 option(include(InclPatterns), Options, ['*']), 365 option(exclude(ExclPatterns), Options, []), 366 ( archive_header_property(Archive, filetype(file)), 367 \+ matches(ExclPatterns, Path), 368 matches(InclPatterns, Path) 369 -> archive_header_property(Archive, permissions(Perm)), 370 remove_prefix(Options, Path, ExtractPath), 371 directory_file_path(Dir, ExtractPath, Target), 372 file_directory_name(Target, FileDir), 373 make_directory_path(FileDir), 374 setup_call_cleanup( 375 archive_open_entry(Archive, In), 376 setup_call_cleanup( 377 open(Target, write, Out, [type(binary)]), 378 copy_stream_data(In, Out), 379 close(Out)), 380 close(In)), 381 set_permissions(Perm, Target) 382 ; true 383 ), 384 extract(Archive, Dir, Options). 385extract(_, _, _).
391matches([], _Path) :- 392 !, 393 fail. 394matches(Patterns, Path) :- 395 split_string(Path, "/", "/", Parts), 396 member(Segment, Parts), 397 Segment \== "", 398 member(Pattern, Patterns), 399 wildcard_match(Pattern, Segment), 400 !. 401 402remove_prefix(Options, Path, ExtractPath) :- 403 ( option(remove_prefix(Remove), Options) 404 -> ( is_list(Remove) 405 -> ( member(P, Remove), 406 atom_concat(P, ExtractPath, Path) 407 -> true 408 ; domain_error(path_prefix(Remove), Path) 409 ) 410 ; ( atom_concat(Remove, ExtractPath, Path) 411 -> true 412 ; domain_error(path_prefix(Remove), Path) 413 ) 414 ) 415 ; ExtractPath = Path 416 ).
423set_permissions(Perm, Target) :- 424 Perm /\ 0o100 =\= 0, 425 !, 426 '$mark_executable'(Target). 427set_permissions(_, _). 428 429 430 /******************************* 431 * HIGH LEVEL PREDICATES * 432 *******************************/
438archive_entries(Archive, Paths) :- 439 setup_call_cleanup( 440 archive_open(Archive, Handle, []), 441 contents(Handle, Paths), 442 archive_close(Handle)). 443 444contents(Handle, [Path|T]) :- 445 archive_next_header(Handle, Path), 446 !, 447 contents(Handle, T). 448contents(_, []).
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)].
477archive_data_stream(Archive, DataStream, Options) :- 478 option(meta_data(MetaData), Options, _), 479 archive_content(Archive, DataStream, MetaData, []). 480 481archive_content(Archive, Entry, [EntryMetadata|PipeMetadataTail], PipeMetadata2) :- 482 archive_property(Archive, filter(Filters)), 483 repeat, 484 ( archive_next_header(Archive, EntryName) 485 -> findall(EntryProperty, 486 archive_header_property(Archive, EntryProperty), 487 EntryProperties), 488 dict_create(EntryMetadata, archive_meta_data, 489 [ filters(Filters), 490 name(EntryName) 491 | EntryProperties 492 ]), 493 ( EntryMetadata.filetype == file 494 -> archive_open_entry(Archive, Entry0), 495 ( EntryName == data, 496 EntryMetadata.format == raw 497 -> % This is the last entry in this nested branch. 498 % We therefore close the choicepoint created by repeat/0. 499 % Not closing this choicepoint would cause 500 % archive_next_header/2 to throw an exception. 501 !, 502 PipeMetadataTail = PipeMetadata2, 503 Entry = Entry0 504 ; PipeMetadataTail = PipeMetadata1, 505 open_substream(Entry0, 506 Entry, 507 PipeMetadata1, 508 PipeMetadata2) 509 ) 510 ; fail 511 ) 512 ; !, 513 fail 514 ). 515 516open_substream(In, Entry, ArchiveMetadata, PipeTailMetadata) :- 517 setup_call_cleanup( 518 archive_open(stream(In), 519 Archive, 520 [ close_parent(true), 521 format(all), 522 format(raw) 523 ]), 524 archive_content(Archive, Entry, ArchiveMetadata, PipeTailMetadata), 525 archive_close(Archive)).
Besides options supported by archive_open/4, the following options are supported:
-C option of
the tar program.cpio,
gnutar, iso9660, xar and zip. Note that a particular
installation may support only a subset of these, depending on
the configuration of libarchive.549archive_create(OutputFile, InputFiles, Options) :- 550 must_be(list(text), InputFiles), 551 option(directory(BaseDir), Options, '.'), 552 setup_call_cleanup( 553 archive_open(OutputFile, write, Archive, Options), 554 archive_create_1(Archive, BaseDir, BaseDir, InputFiles, top), 555 archive_close(Archive)). 556 557archive_create_1(_, _, _, [], _) :- !. 558archive_create_1(Archive, Base, Current, ['.'|Files], sub) :- 559 !, 560 archive_create_1(Archive, Base, Current, Files, sub). 561archive_create_1(Archive, Base, Current, ['..'|Files], Where) :- 562 !, 563 archive_create_1(Archive, Base, Current, Files, Where). 564archive_create_1(Archive, Base, Current, [File|Files], Where) :- 565 directory_file_path(Current, File, Filename), 566 archive_create_2(Archive, Base, Filename), 567 archive_create_1(Archive, Base, Current, Files, Where). 568 569archive_create_2(Archive, Base, Directory) :- 570 exists_directory(Directory), 571 !, 572 entry_name(Base, Directory, Directory0), 573 archive_next_header(Archive, Directory0), 574 time_file(Directory, Time), 575 archive_set_header_property(Archive, mtime(Time)), 576 archive_set_header_property(Archive, filetype(directory)), 577 archive_open_entry(Archive, EntryStream), 578 close(EntryStream), 579 directory_files(Directory, Files), 580 archive_create_1(Archive, Base, Directory, Files, sub). 581archive_create_2(Archive, Base, Filename) :- 582 entry_name(Base, Filename, Filename0), 583 archive_next_header(Archive, Filename0), 584 size_file(Filename, Size), 585 time_file(Filename, Time), 586 archive_set_header_property(Archive, size(Size)), 587 archive_set_header_property(Archive, mtime(Time)), 588 setup_call_cleanup( 589 archive_open_entry(Archive, EntryStream), 590 setup_call_cleanup( 591 open(Filename, read, DataStream, [type(binary)]), 592 copy_stream_data(DataStream, EntryStream), 593 close(DataStream)), 594 close(EntryStream)). 595 596entry_name('.', Name, Name) :- !. 597entry_name(Base, Name, EntryName) :- 598 directory_file_path(Base, EntryName, Name).
612archive_foldl(Goal, Archive, State0, State) :- 613 setup_call_cleanup( 614 archive_open(Archive, Handle, [close_parent(true)]), 615 archive_foldl_(Goal, Handle, State0, State), 616 archive_close(Handle) 617 ). 618 619archive_foldl_(Goal, Handle, State0, State) :- 620 ( archive_next_header(Handle, Path) 621 -> call(Goal, Path, Handle, State0, State1), 622 archive_foldl_(Goal, Handle, State1, State) 623 ; State = State0 624 ). 625 626 627 /******************************* 628 * MESSAGES * 629 *******************************/ 630 631:- multifile prolog:error_message//1. 632 633prologerror_message(archive_error(Code, Message)) --> 634 [ 'Archive error (code ~p): ~w'-[Code, Message] ]
Access several archive formats
This library uses libarchive to access a variety of archive formats. The following example lists the entries in an archive:
list_archive(File) :- setup_call_cleanup( archive_open(File, Archive, []), ( repeat, ( archive_next_header(Archive, Path) -> format('~w~n', [Path]), fail ; ! ) ), archive_close(Archive)).Here is an alternative way of doing this, using archive_foldl/4, a higher level predicate.
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).Here is another example which counts the files in the archive and prints file type information, also using archive_foldl/4:
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]).