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-2016, 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 ]). 50:- use_module(library(error)). 51:- use_module(library(option)). 52:- use_module(library(filesex)).
74:- use_foreign_library(foreign(archive4pl)).80archive_open(Stream, Archive, Options) :- 81 archive_open(Stream, read, Archive, Options). 82 83:- predicate_options(archive_open/4, 4, 84 [ close_parent(boolean), 85 filter(oneof([all,bzip2,compress,gzip,grzip,lrzip, 86 lzip,lzma,lzop,none,rpm,uu,xz])), 87 format(oneof([all,'7zip',ar,cab,cpio,empty,gnutar, 88 iso9660,lha,mtree,rar,raw,tar,xar,zip])) 89 ]). 90:- predicate_options(archive_create/3, 3, 91 [ directory(atom), 92 pass_to(archive_open/4, 4) 93 ]).
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. To open both archive
and non-archive files, both format(all) and
format(raw) 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.
146archive_open(stream(Stream), Mode, Archive, Options) :- 147 !, 148 archive_open_stream(Stream, Mode, Archive, Options). 149archive_open(Stream, Mode, Archive, Options) :- 150 is_stream(Stream), 151 !, 152 archive_open_stream(Stream, Mode, Archive, Options). 153archive_open(File, Mode, Archive, Options) :- 154 open(File, Mode, Stream, [type(binary)]), 155 catch(archive_open_stream(Stream, Mode, Archive, [close_parent(true)|Options]), 156 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).
186archive_property(Handle, Property) :- 187 defined_archive_property(Property), 188 Property =.. [Name,Value], 189 archive_property(Handle, Name, Value). 190 191defined_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().265archive_header_property(Archive, Property) :- 266 ( nonvar(Property) 267 -> true 268 ; header_property(Property) 269 ), 270 archive_header_prop_(Archive, Property). 271 272header_property(filetype(_)). 273header_property(mtime(_)). 274header_property(size(_)). 275header_property(link_target(_)). 276header_property(format(_)). 277header_property(permissions(_)).
297archive_extract(Archive, Dir, Options) :- 298 ( exists_directory(Dir) 299 -> true 300 ; existence_error(directory, Dir) 301 ), 302 setup_call_cleanup( 303 archive_open(Archive, Handle, Options), 304 extract(Handle, Dir, Options), 305 archive_close(Handle)). 306 307extract(Archive, Dir, Options) :- 308 archive_next_header(Archive, Path), 309 !, 310 ( archive_header_property(Archive, filetype(file)), 311 \+ excluded(Path, Options) 312 -> archive_header_property(Archive, permissions(Perm)), 313 ( option(remove_prefix(Remove), Options) 314 -> ( atom_concat(Remove, ExtractPath, Path) 315 -> true 316 ; domain_error(path_prefix(Remove), Path) 317 ) 318 ; ExtractPath = Path 319 ), 320 directory_file_path(Dir, ExtractPath, Target), 321 file_directory_name(Target, FileDir), 322 make_directory_path(FileDir), 323 setup_call_cleanup( 324 archive_open_entry(Archive, In), 325 setup_call_cleanup( 326 open(Target, write, Out, [type(binary)]), 327 copy_stream_data(In, Out), 328 close(Out)), 329 close(In)), 330 set_permissions(Perm, Target) 331 ; true 332 ), 333 extract(Archive, Dir, Options). 334extract(_, _, _). 335 336excluded(Path, Options) :- 337 option(exclude(Patterns), Options), 338 split_string(Path, "/", "/", Parts), 339 member(Segment, Parts), 340 Segment \== "", 341 member(Pattern, Patterns), 342 wildcard_match(Pattern, Segment).
350set_permissions(Perm, Target) :- 351 Perm /\ 0o100 =\= 0, 352 !, 353 '$mark_executable'(Target). 354set_permissions(_, _). 355 356 357 /******************************* 358 * HIGH LEVEL PREDICATES * 359 *******************************/
365archive_entries(Archive, Paths) :- 366 setup_call_cleanup( 367 archive_open(Archive, Handle, []), 368 contents(Handle, Paths), 369 archive_close(Handle)). 370 371contents(Handle, [Path|T]) :- 372 archive_next_header(Handle, Path), 373 !, 374 contents(Handle, T). 375contents(_, []).
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)].
404archive_data_stream(Archive, DataStream, Options) :- 405 option(meta_data(MetaData), Options, _), 406 archive_content(Archive, DataStream, MetaData, []). 407 408archive_content(Archive, Entry, [EntryMetadata|PipeMetadataTail], PipeMetadata2) :- 409 archive_property(Archive, filter(Filters)), 410 repeat, 411 ( archive_next_header(Archive, EntryName) 412 -> findall(EntryProperty, 413 archive_header_property(Archive, EntryProperty), 414 EntryProperties), 415 dict_create(EntryMetadata, archive_meta_data, 416 [ filters(Filters), 417 name(EntryName) 418 | EntryProperties 419 ]), 420 ( EntryMetadata.filetype == file 421 -> archive_open_entry(Archive, Entry0), 422 ( EntryName == data, 423 EntryMetadata.format == raw 424 -> % This is the last entry in this nested branch. 425 % We therefore close the choicepoint created by repeat/0. 426 % Not closing this choicepoint would cause 427 % archive_next_header/2 to throw an exception. 428 !, 429 PipeMetadataTail = PipeMetadata2, 430 Entry = Entry0 431 ; PipeMetadataTail = PipeMetadata1, 432 open_substream(Entry0, 433 Entry, 434 PipeMetadata1, 435 PipeMetadata2) 436 ) 437 ; fail 438 ) 439 ; !, 440 fail 441 ). 442 443open_substream(In, Entry, ArchiveMetadata, PipeTailMetadata) :- 444 setup_call_cleanup( 445 archive_open(stream(In), 446 Archive, 447 [ close_parent(true), 448 format(all), 449 format(raw) 450 ]), 451 archive_content(Archive, Entry, ArchiveMetadata, PipeTailMetadata), 452 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.476archive_create(OutputFile, InputFiles, Options) :- 477 must_be(list(text), InputFiles), 478 option(directory(BaseDir), Options, '.'), 479 setup_call_cleanup( 480 archive_open(OutputFile, write, Archive, Options), 481 archive_create_1(Archive, BaseDir, BaseDir, InputFiles, top), 482 archive_close(Archive)). 483 484archive_create_1(_, _, _, [], _) :- !. 485archive_create_1(Archive, Base, Current, ['.'|Files], sub) :- 486 !, 487 archive_create_1(Archive, Base, Current, Files, sub). 488archive_create_1(Archive, Base, Current, ['..'|Files], Where) :- 489 !, 490 archive_create_1(Archive, Base, Current, Files, Where). 491archive_create_1(Archive, Base, Current, [File|Files], Where) :- 492 directory_file_path(Current, File, Filename), 493 archive_create_2(Archive, Base, Filename), 494 archive_create_1(Archive, Base, Current, Files, Where). 495 496archive_create_2(Archive, Base, Directory) :- 497 exists_directory(Directory), 498 !, 499 entry_name(Base, Directory, Directory0), 500 archive_next_header(Archive, Directory0), 501 time_file(Directory, Time), 502 archive_set_header_property(Archive, mtime(Time)), 503 archive_set_header_property(Archive, filetype(directory)), 504 archive_open_entry(Archive, EntryStream), 505 close(EntryStream), 506 directory_files(Directory, Files), 507 archive_create_1(Archive, Base, Directory, Files, sub). 508archive_create_2(Archive, Base, Filename) :- 509 entry_name(Base, Filename, Filename0), 510 archive_next_header(Archive, Filename0), 511 size_file(Filename, Size), 512 time_file(Filename, Time), 513 archive_set_header_property(Archive, size(Size)), 514 archive_set_header_property(Archive, mtime(Time)), 515 setup_call_cleanup( 516 archive_open_entry(Archive, EntryStream), 517 setup_call_cleanup( 518 open(Filename, read, DataStream, [type(binary)]), 519 copy_stream_data(DataStream, EntryStream), 520 close(DataStream)), 521 close(EntryStream)). 522 523entry_name('.', Name, Name) :- !. 524entry_name(Base, Name, EntryName) :- 525 directory_file_path(Base, EntryName, Name)
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) ).