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