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(, , , ).
96:- use_foreign_library(foreign(archive4pl)).102archive_open(Stream, Archive, Options) :- 103 archive_open(Stream, read, Archive, Options). 104 105:- predicate_options(archive_open/4, 4, 106 [ close_parent(boolean), 107 filter(oneof([all,bzip2,compress,gzip,grzip,lrzip, 108 lzip,lzma,lzop,none,rpm,uu,xz])), 109 format(oneof([all,'7zip',ar,cab,cpio,empty,gnutar, 110 iso9660,lha,mtree,rar,raw,tar,xar,zip])) 111 ]). 112:- predicate_options(archive_create/3, 3, 113 [ directory(atom), 114 pass_to(archive_open/4, 4) 115 ]).
close_parent(true) is used to close stream if the
archive is closed using archive_close/1. For other options, the
defaults are typically fine. 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), Stream is closed
if archive_close/1 is called on Archive.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 error if the (explicitly) requested format is not supported.
168archive_open(stream(Stream), Mode, Archive, Options) :- 169 !, 170 archive_open_stream(Stream, Mode, Archive, Options). 171archive_open(Stream, Mode, Archive, Options) :- 172 is_stream(Stream), 173 !, 174 archive_open_stream(Stream, Mode, Archive, Options). 175archive_open(File, Mode, Archive, Options) :- 176 open(File, Mode, Stream, [type(binary)]), 177 catch(archive_open_stream(Stream, Mode, Archive, [close_parent(true)|Options]), 178 E, (close(Stream, [force(true)]), throw(E))).
close_parent(true) is specified, the
underlying 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, Handle, []),
archive_next_header(Handle, Name),
archive_open_entry(Handle, Stream),
archive_close(Archive).
208archive_property(Handle, Property) :- 209 defined_archive_property(Property), 210 Property =.. [Name,Value], 211 archive_property(Handle, Name, Value). 212 213defined_archive_property(filter(_)).
open_archive_entry(ArchiveFile, Entry, Stream) :-
open(ArchiveFile, read, In, [type(binary)]),
archive_open(In, Archive, [close_parent(true)]),
archive_next_header(Archive, Entry),
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().287archive_header_property(Archive, Property) :- 288 ( nonvar(Property) 289 -> true 290 ; header_property(Property) 291 ), 292 archive_header_prop_(Archive, Property). 293 294header_property(filetype(_)). 295header_property(mtime(_)). 296header_property(size(_)). 297header_property(link_target(_)). 298header_property(format(_)). 299header_property(permissions(_)).
exclude
options takes preference if a member matches both the include
and the exclude option.327archive_extract(Archive, Dir, Options) :- 328 ( exists_directory(Dir) 329 -> true 330 ; existence_error(directory, Dir) 331 ), 332 setup_call_cleanup( 333 archive_open(Archive, Handle, Options), 334 extract(Handle, Dir, Options), 335 archive_close(Handle)). 336 337extract(Archive, Dir, Options) :- 338 archive_next_header(Archive, Path), 339 !, 340 option(include(InclPatterns), Options, ['*']), 341 option(exclude(ExclPatterns), Options, []), 342 ( archive_header_property(Archive, filetype(file)), 343 \+ matches(ExclPatterns, Path), 344 matches(InclPatterns, Path) 345 -> archive_header_property(Archive, permissions(Perm)), 346 remove_prefix(Options, Path, ExtractPath), 347 directory_file_path(Dir, ExtractPath, Target), 348 file_directory_name(Target, FileDir), 349 make_directory_path(FileDir), 350 setup_call_cleanup( 351 archive_open_entry(Archive, In), 352 setup_call_cleanup( 353 open(Target, write, Out, [type(binary)]), 354 copy_stream_data(In, Out), 355 close(Out)), 356 close(In)), 357 set_permissions(Perm, Target) 358 ; true 359 ), 360 extract(Archive, Dir, Options). 361extract(_, _, _).
367matches([], _Path) :- 368 !, 369 fail. 370matches(Patterns, Path) :- 371 split_string(Path, "/", "/", Parts), 372 member(Segment, Parts), 373 Segment \== "", 374 member(Pattern, Patterns), 375 wildcard_match(Pattern, Segment), 376 !. 377 378remove_prefix(Options, Path, ExtractPath) :- 379 ( option(remove_prefix(Remove), Options) 380 -> ( is_list(Remove) 381 -> ( member(P, Remove), 382 atom_concat(P, ExtractPath, Path) 383 -> true 384 ; domain_error(path_prefix(Remove), Path) 385 ) 386 ; ( atom_concat(Remove, ExtractPath, Path) 387 -> true 388 ; domain_error(path_prefix(Remove), Path) 389 ) 390 ) 391 ; ExtractPath = Path 392 ).
399set_permissions(Perm, Target) :- 400 Perm /\ 0o100 =\= 0, 401 !, 402 '$mark_executable'(Target). 403set_permissions(_, _). 404 405 406 /******************************* 407 * HIGH LEVEL PREDICATES * 408 *******************************/
414archive_entries(Archive, Paths) :- 415 setup_call_cleanup( 416 archive_open(Archive, Handle, []), 417 contents(Handle, Paths), 418 archive_close(Handle)). 419 420contents(Handle, [Path|T]) :- 421 archive_next_header(Handle, Path), 422 !, 423 contents(Handle, T). 424contents(_, []).
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)].
453archive_data_stream(Archive, DataStream, Options) :- 454 option(meta_data(MetaData), Options, _), 455 archive_content(Archive, DataStream, MetaData, []). 456 457archive_content(Archive, Entry, [EntryMetadata|PipeMetadataTail], PipeMetadata2) :- 458 archive_property(Archive, filter(Filters)), 459 repeat, 460 ( archive_next_header(Archive, EntryName) 461 -> findall(EntryProperty, 462 archive_header_property(Archive, EntryProperty), 463 EntryProperties), 464 dict_create(EntryMetadata, archive_meta_data, 465 [ filters(Filters), 466 name(EntryName) 467 | EntryProperties 468 ]), 469 ( EntryMetadata.filetype == file 470 -> archive_open_entry(Archive, Entry0), 471 ( EntryName == data, 472 EntryMetadata.format == raw 473 -> % This is the last entry in this nested branch. 474 % We therefore close the choicepoint created by repeat/0. 475 % Not closing this choicepoint would cause 476 % archive_next_header/2 to throw an exception. 477 !, 478 PipeMetadataTail = PipeMetadata2, 479 Entry = Entry0 480 ; PipeMetadataTail = PipeMetadata1, 481 open_substream(Entry0, 482 Entry, 483 PipeMetadata1, 484 PipeMetadata2) 485 ) 486 ; fail 487 ) 488 ; !, 489 fail 490 ). 491 492open_substream(In, Entry, ArchiveMetadata, PipeTailMetadata) :- 493 setup_call_cleanup( 494 archive_open(stream(In), 495 Archive, 496 [ close_parent(true), 497 format(all), 498 format(raw) 499 ]), 500 archive_content(Archive, Entry, ArchiveMetadata, PipeTailMetadata), 501 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.525archive_create(OutputFile, InputFiles, Options) :- 526 must_be(list(text), InputFiles), 527 option(directory(BaseDir), Options, '.'), 528 setup_call_cleanup( 529 archive_open(OutputFile, write, Archive, Options), 530 archive_create_1(Archive, BaseDir, BaseDir, InputFiles, top), 531 archive_close(Archive)). 532 533archive_create_1(_, _, _, [], _) :- !. 534archive_create_1(Archive, Base, Current, ['.'|Files], sub) :- 535 !, 536 archive_create_1(Archive, Base, Current, Files, sub). 537archive_create_1(Archive, Base, Current, ['..'|Files], Where) :- 538 !, 539 archive_create_1(Archive, Base, Current, Files, Where). 540archive_create_1(Archive, Base, Current, [File|Files], Where) :- 541 directory_file_path(Current, File, Filename), 542 archive_create_2(Archive, Base, Filename), 543 archive_create_1(Archive, Base, Current, Files, Where). 544 545archive_create_2(Archive, Base, Directory) :- 546 exists_directory(Directory), 547 !, 548 entry_name(Base, Directory, Directory0), 549 archive_next_header(Archive, Directory0), 550 time_file(Directory, Time), 551 archive_set_header_property(Archive, mtime(Time)), 552 archive_set_header_property(Archive, filetype(directory)), 553 archive_open_entry(Archive, EntryStream), 554 close(EntryStream), 555 directory_files(Directory, Files), 556 archive_create_1(Archive, Base, Directory, Files, sub). 557archive_create_2(Archive, Base, Filename) :- 558 entry_name(Base, Filename, Filename0), 559 archive_next_header(Archive, Filename0), 560 size_file(Filename, Size), 561 time_file(Filename, Time), 562 archive_set_header_property(Archive, size(Size)), 563 archive_set_header_property(Archive, mtime(Time)), 564 setup_call_cleanup( 565 archive_open_entry(Archive, EntryStream), 566 setup_call_cleanup( 567 open(Filename, read, DataStream, [type(binary)]), 568 copy_stream_data(DataStream, EntryStream), 569 close(DataStream)), 570 close(EntryStream)). 571 572entry_name('.', Name, Name) :- !. 573entry_name(Base, Name, EntryName) :- 574 directory_file_path(Base, EntryName, Name).
588archive_foldl(Goal, Archive, State0, State) :- 589 setup_call_cleanup( 590 archive_open(Archive, Handle, [close_parent(true)]), 591 archive_foldl_(Goal, Handle, State0, State), 592 archive_close(Handle) 593 ). 594 595archive_foldl_(Goal, Handle, State0, State) :- 596 ( archive_next_header(Handle, Path) 597 -> call(Goal, Path, Handle, State0, State1), 598 archive_foldl_(Goal, Handle, State1, State) 599 ; State = State0 600 ). 601 602 603 /******************************* 604 * MESSAGES * 605 *******************************/ 606 607:- multifile prolog:error_message//1. 608 609prologerror_message(archive_error(Code, Message)) --> 610 [ '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) :- archive_open(File, Archive, []), repeat, ( archive_next_header(Archive, Path) -> format('~w~n', [Path]), fail ; !, archive_close(Archive) ).Here is another example which counts the files in the archive and prints file type information. It uses archive_foldl/4, a higher level predicate:
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(File) :- archive_foldl(print_entry, File, 0, FileCount), format('We have ~w files', [FileCount]).