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:- use_module(library(error)). 52:- use_module(library(lists)). 53:- use_module(library(option)). 54:- use_module(library(filesex)). 55 56:- meta_predicate 57 archive_foldl(, , , ).
94:- use_foreign_library(foreign(archive4pl)).100archive_open(Stream, Archive, Options) :- 101 archive_open(Stream, read, Archive, Options). 102 103:- predicate_options(archive_open/4, 4, 104 [ close_parent(boolean), 105 filter(oneof([all,bzip2,compress,gzip,grzip,lrzip, 106 lzip,lzma,lzop,none,rpm,uu,xz])), 107 format(oneof([all,'7zip',ar,cab,cpio,empty,gnutar, 108 iso9660,lha,mtree,rar,raw,tar,xar,zip])) 109 ]). 110:- predicate_options(archive_create/3, 3, 111 [ directory(atom), 112 pass_to(archive_open/4, 4) 113 ]).
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.
166archive_open(stream(Stream), Mode, Archive, Options) :- 167 !, 168 archive_open_stream(Stream, Mode, Archive, Options). 169archive_open(Stream, Mode, Archive, Options) :- 170 is_stream(Stream), 171 !, 172 archive_open_stream(Stream, Mode, Archive, Options). 173archive_open(File, Mode, Archive, Options) :- 174 open(File, Mode, Stream, [type(binary)]), 175 catch(archive_open_stream(Stream, Mode, Archive, [close_parent(true)|Options]), 176 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).
206archive_property(Handle, Property) :- 207 defined_archive_property(Property), 208 Property =.. [Name,Value], 209 archive_property(Handle, Name, Value). 210 211defined_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().285archive_header_property(Archive, Property) :- 286 ( nonvar(Property) 287 -> true 288 ; header_property(Property) 289 ), 290 archive_header_prop_(Archive, Property). 291 292header_property(filetype(_)). 293header_property(mtime(_)). 294header_property(size(_)). 295header_property(link_target(_)). 296header_property(format(_)). 297header_property(permissions(_)).
exclude
options takes preference if a member matches both the include
and the exclude option.325archive_extract(Archive, Dir, Options) :- 326 ( exists_directory(Dir) 327 -> true 328 ; existence_error(directory, Dir) 329 ), 330 setup_call_cleanup( 331 archive_open(Archive, Handle, Options), 332 extract(Handle, Dir, Options), 333 archive_close(Handle)). 334 335extract(Archive, Dir, Options) :- 336 archive_next_header(Archive, Path), 337 !, 338 option(include(InclPatterns), Options, ['*']), 339 option(exclude(ExclPatterns), Options, []), 340 ( archive_header_property(Archive, filetype(file)), 341 \+ matches(ExclPatterns, Path), 342 matches(InclPatterns, Path) 343 -> archive_header_property(Archive, permissions(Perm)), 344 remove_prefix(Options, Path, ExtractPath), 345 directory_file_path(Dir, ExtractPath, Target), 346 file_directory_name(Target, FileDir), 347 make_directory_path(FileDir), 348 setup_call_cleanup( 349 archive_open_entry(Archive, In), 350 setup_call_cleanup( 351 open(Target, write, Out, [type(binary)]), 352 copy_stream_data(In, Out), 353 close(Out)), 354 close(In)), 355 set_permissions(Perm, Target) 356 ; true 357 ), 358 extract(Archive, Dir, Options). 359extract(_, _, _).
365matches([], _Path) :- 366 !, 367 fail. 368matches(Patterns, Path) :- 369 split_string(Path, "/", "/", Parts), 370 member(Segment, Parts), 371 Segment \== "", 372 member(Pattern, Patterns), 373 wildcard_match(Pattern, Segment), 374 !. 375 376remove_prefix(Options, Path, ExtractPath) :- 377 ( option(remove_prefix(Remove), Options) 378 -> ( is_list(Remove) 379 -> ( member(P, Remove), 380 atom_concat(P, ExtractPath, Path) 381 -> true 382 ; domain_error(path_prefix(Remove), Path) 383 ) 384 ; ( atom_concat(Remove, ExtractPath, Path) 385 -> true 386 ; domain_error(path_prefix(Remove), Path) 387 ) 388 ) 389 ; ExtractPath = Path 390 ).
397set_permissions(Perm, Target) :- 398 Perm /\ 0o100 =\= 0, 399 !, 400 '$mark_executable'(Target). 401set_permissions(_, _). 402 403 404 /******************************* 405 * HIGH LEVEL PREDICATES * 406 *******************************/
412archive_entries(Archive, Paths) :- 413 setup_call_cleanup( 414 archive_open(Archive, Handle, []), 415 contents(Handle, Paths), 416 archive_close(Handle)). 417 418contents(Handle, [Path|T]) :- 419 archive_next_header(Handle, Path), 420 !, 421 contents(Handle, T). 422contents(_, []).
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)].
451archive_data_stream(Archive, DataStream, Options) :- 452 option(meta_data(MetaData), Options, _), 453 archive_content(Archive, DataStream, MetaData, []). 454 455archive_content(Archive, Entry, [EntryMetadata|PipeMetadataTail], PipeMetadata2) :- 456 archive_property(Archive, filter(Filters)), 457 repeat, 458 ( archive_next_header(Archive, EntryName) 459 -> findall(EntryProperty, 460 archive_header_property(Archive, EntryProperty), 461 EntryProperties), 462 dict_create(EntryMetadata, archive_meta_data, 463 [ filters(Filters), 464 name(EntryName) 465 | EntryProperties 466 ]), 467 ( EntryMetadata.filetype == file 468 -> archive_open_entry(Archive, Entry0), 469 ( EntryName == data, 470 EntryMetadata.format == raw 471 -> % This is the last entry in this nested branch. 472 % We therefore close the choicepoint created by repeat/0. 473 % Not closing this choicepoint would cause 474 % archive_next_header/2 to throw an exception. 475 !, 476 PipeMetadataTail = PipeMetadata2, 477 Entry = Entry0 478 ; PipeMetadataTail = PipeMetadata1, 479 open_substream(Entry0, 480 Entry, 481 PipeMetadata1, 482 PipeMetadata2) 483 ) 484 ; fail 485 ) 486 ; !, 487 fail 488 ). 489 490open_substream(In, Entry, ArchiveMetadata, PipeTailMetadata) :- 491 setup_call_cleanup( 492 archive_open(stream(In), 493 Archive, 494 [ close_parent(true), 495 format(all), 496 format(raw) 497 ]), 498 archive_content(Archive, Entry, ArchiveMetadata, PipeTailMetadata), 499 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.523archive_create(OutputFile, InputFiles, Options) :- 524 must_be(list(text), InputFiles), 525 option(directory(BaseDir), Options, '.'), 526 setup_call_cleanup( 527 archive_open(OutputFile, write, Archive, Options), 528 archive_create_1(Archive, BaseDir, BaseDir, InputFiles, top), 529 archive_close(Archive)). 530 531archive_create_1(_, _, _, [], _) :- !. 532archive_create_1(Archive, Base, Current, ['.'|Files], sub) :- 533 !, 534 archive_create_1(Archive, Base, Current, Files, sub). 535archive_create_1(Archive, Base, Current, ['..'|Files], Where) :- 536 !, 537 archive_create_1(Archive, Base, Current, Files, Where). 538archive_create_1(Archive, Base, Current, [File|Files], Where) :- 539 directory_file_path(Current, File, Filename), 540 archive_create_2(Archive, Base, Filename), 541 archive_create_1(Archive, Base, Current, Files, Where). 542 543archive_create_2(Archive, Base, Directory) :- 544 exists_directory(Directory), 545 !, 546 entry_name(Base, Directory, Directory0), 547 archive_next_header(Archive, Directory0), 548 time_file(Directory, Time), 549 archive_set_header_property(Archive, mtime(Time)), 550 archive_set_header_property(Archive, filetype(directory)), 551 archive_open_entry(Archive, EntryStream), 552 close(EntryStream), 553 directory_files(Directory, Files), 554 archive_create_1(Archive, Base, Directory, Files, sub). 555archive_create_2(Archive, Base, Filename) :- 556 entry_name(Base, Filename, Filename0), 557 archive_next_header(Archive, Filename0), 558 size_file(Filename, Size), 559 time_file(Filename, Time), 560 archive_set_header_property(Archive, size(Size)), 561 archive_set_header_property(Archive, mtime(Time)), 562 setup_call_cleanup( 563 archive_open_entry(Archive, EntryStream), 564 setup_call_cleanup( 565 open(Filename, read, DataStream, [type(binary)]), 566 copy_stream_data(DataStream, EntryStream), 567 close(DataStream)), 568 close(EntryStream)). 569 570entry_name('.', Name, Name) :- !. 571entry_name(Base, Name, EntryName) :- 572 directory_file_path(Base, EntryName, Name).
586archive_foldl(Goal, Archive, State0, State) :- 587 setup_call_cleanup( 588 archive_open(Archive, Handle, [close_parent(true)]), 589 archive_foldl_(Goal, Handle, State0, State), 590 archive_close(Handle) 591 ). 592 593archive_foldl_(Goal, Handle, State0, State) :- 594 ( archive_next_header(Handle, Path) 595 -> call(Goal, Path, Handle, State0, State1), 596 archive_foldl_(Goal, Handle, State1, State) 597 ; State = State0 598 )
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]).