diff -rcN camlzip-1.01/.depend camlzip-1.01p1/.depend *** camlzip-1.01/.depend Tue Aug 7 08:32:05 2001 --- camlzip-1.01p1/.depend Sat Jan 31 15:26:12 2004 *************** *** 1,6 **** --- 1,12 ---- zlibstubs.o: zlibstubs.c + bzip2.cmo: bzlib.cmi bzip2.cmi + bzip2.cmx: bzlib.cmx bzip2.cmi + bzlib.cmo: bzlib.cmi + bzlib.cmx: bzlib.cmi gzip.cmo: zlib.cmi gzip.cmi gzip.cmx: zlib.cmx gzip.cmi + tar.cmo: bzip2.cmi gzip.cmi tar.cmi + tar.cmx: bzip2.cmx gzip.cmx tar.cmi zip.cmo: zlib.cmi zip.cmi zip.cmx: zlib.cmx zip.cmi zlib.cmo: zlib.cmi diff -rcN camlzip-1.01/META camlzip-1.01p1/META *** camlzip-1.01/META Wed Dec 31 16:00:00 1969 --- camlzip-1.01p1/META Sun Apr 18 11:54:36 2004 *************** *** 0 **** --- 1,6 ---- + requires="unix" + description="Access to gzip and bzip2 compression and zip, jar and tar archives" + version="1.01p1" + archive(byte)="zip.cma" + archive(native)="zip.cmxa" + directory="+zip" diff -rcN camlzip-1.01/Makefile camlzip-1.01p1/Makefile *** camlzip-1.01/Makefile Mon Feb 18 01:12:12 2002 --- camlzip-1.01p1/Makefile Sat Jan 31 15:29:38 2004 *************** *** 1,8 **** --- 1,16 ---- ### Configuration section + CFLAGS=-g + + # Comment out if you don't have bzip2 + CFLAGS+=-DUSE_BZIP2 + # The name of the Zlib library. Usually -lz ZLIB_LIB=-lz + # The name of the Bzip2 library. Usually -lbz2. Comment out if you don't have it. + BZIP2_LIB=-lbz2 + # The directory containing the Zlib library (libz.a or libz.so) ZLIB_LIBDIR=/usr/lib *************** *** 20,26 **** OCAMLDEP=ocamldep OCAMLMKLIB=ocamlmklib ! OBJS=zlib.cmo zip.cmo gzip.cmo C_OBJS=zlibstubs.o all: libcamlzip.a zip.cma --- 28,34 ---- OCAMLDEP=ocamldep OCAMLMKLIB=ocamlmklib ! OBJS=zlib.cmo zip.cmo gzip.cmo bzlib.cmo bzip2.cmo tar.cmo C_OBJS=zlibstubs.o all: libcamlzip.a zip.cma *************** *** 29,43 **** zip.cma: $(OBJS) $(OCAMLMKLIB) -o zip -oc camlzip $(OBJS) \ ! -L$(ZLIB_LIBDIR) $(ZLIB_LIB) zip.cmxa: $(OBJS:.cmo=.cmx) $(OCAMLMKLIB) -o zip -oc camlzip $(OBJS:.cmo=.cmx) \ ! -L$(ZLIB_LIBDIR) $(ZLIB_LIB) libcamlzip.a: $(C_OBJS) $(OCAMLMKLIB) -oc camlzip $(C_OBJS) \ ! -L$(ZLIB_LIBDIR) $(ZLIB_LIB) .SUFFIXES: .mli .ml .cmo .cmi .cmx --- 37,51 ---- zip.cma: $(OBJS) $(OCAMLMKLIB) -o zip -oc camlzip $(OBJS) \ ! -L$(ZLIB_LIBDIR) $(ZLIB_LIB) $(BZIP2_LIB) zip.cmxa: $(OBJS:.cmo=.cmx) $(OCAMLMKLIB) -o zip -oc camlzip $(OBJS:.cmo=.cmx) \ ! -L$(ZLIB_LIBDIR) $(ZLIB_LIB) $(BZIP2_LIB) libcamlzip.a: $(C_OBJS) $(OCAMLMKLIB) -oc camlzip $(C_OBJS) \ ! -L$(ZLIB_LIBDIR) $(ZLIB_LIB) $(BZIP2_LIB) .SUFFIXES: .mli .ml .cmo .cmi .cmx *************** *** 48,62 **** .ml.cmx: $(OCAMLOPT) -c $< .c.o: ! $(OCAMLC) -c -ccopt -g -ccopt -I$(ZLIB_INCLUDE) $< clean: rm -f *.cm* ! rm -f *.o *.a install: mkdir -p $(INSTALLDIR) ! cp zip.cma zip.cmi gzip.cmi zip.mli gzip.mli libcamlzip.a $(INSTALLDIR) if test -f dllcamlzip.so; then \ cp dllcamlzip.so $(INSTALLDIR); \ ldconf=`$(OCAMLC) -where`/ld.conf; \ --- 56,71 ---- .ml.cmx: $(OCAMLOPT) -c $< .c.o: ! $(OCAMLC) -c -ccopt "$(CFLAGS)" -ccopt -I$(ZLIB_INCLUDE) $< clean: rm -f *.cm* ! rm -f *.o *.a *.so install: mkdir -p $(INSTALLDIR) ! cp zip.cma zip.cmi gzip.cmi zip.mli gzip.mli bzip2.mli bzip2.cmi \ ! tar.mli tar.cmi libcamlzip.a $(INSTALLDIR) if test -f dllcamlzip.so; then \ cp dllcamlzip.so $(INSTALLDIR); \ ldconf=`$(OCAMLC) -where`/ld.conf; \ *************** *** 66,72 **** fi installopt: ! cp zip.cmxa zip.a zip.cmx gzip.cmx $(INSTALLDIR) depend: gcc -MM -I$(ZLIB_INCLUDE) *.c > .depend --- 75,81 ---- fi installopt: ! cp zip.cmxa zip.a zip.cmx gzip.cmx bzip2.cmx tar.cmx $(INSTALLDIR) depend: gcc -MM -I$(ZLIB_INCLUDE) *.c > .depend diff -rcN camlzip-1.01/README camlzip-1.01p1/README *** camlzip-1.01/README Mon Feb 18 01:12:13 2002 --- camlzip-1.01p1/README Sun Apr 18 11:49:00 2004 *************** *** 2,10 **** DESCRIPTION: ! This Objective Caml library provides easy access to compressed files in ZIP ! and GZIP format, as well as to Java JAR files. It provides functions ! for reading from and writing to compressed files in these formats. REQUIREMENTS: --- 2,11 ---- DESCRIPTION: ! This Objective Caml library provides easy access to compressed files ! in ZIP, GZIP and BZIP2 formats, as well as to Java JAR files and Unix ! Tar archives. It provides functions for reading from and writing to ! compressed files in these formats. REQUIREMENTS: *************** *** 16,29 **** are that your distribution provides precompiled binaries for this library. INSTALLATION: - If you are using a version of OCaml older than 3.04, replace ! Makefile by Makefile-pre-3.04. ! - Edit the three variables at the beginning of the Makefile to reflect ! the location where Zlib is installed on your system. The defaults ! are OK for Linux. - Do "make all". --- 17,36 ---- are that your distribution provides precompiled binaries for this library. + - [Optional] The BZip2 C library, version 1.0.2. If it is not + installed on your system (Look for libbz2.a or libbz2.so), get it + from http://sources.redhat.com/bzip2/. If you are running Linux or BSD, + chances are that your distribution provides precompiled binaries for + this library. + INSTALLATION: - If you are using a version of OCaml older than 3.04, replace ! Makefile by Makefile-pre-3.04. ! - Edit the six variables at the beginning of the Makefile to reflect ! the locations where Zlib and BZip2 are installed on your system. ! The defaults are OK for Linux. - Do "make all". *************** *** 33,38 **** --- 40,46 ---- - Become super-user if necessary and do make install make installopt # if you did "make allopt" earlier + ocamlfind install zip META # If you use findlib This installs the library in the standard Objective Caml library directory. DOCUMENTATION: *************** *** 43,48 **** --- 51,58 ---- ocamlc linking options: -I +zip zip.cma ocamlopt linking options: -I +zip zip.cmxa + With findlib, use the 'zip' package. + The directory test/ contains examples of using this library. LICENSING: *************** *** 51,57 **** --- 61,70 ---- en Informatique et en Automatique, and distributed under the terms of the GNU Library General Public License (LGPL). + Portions copyright 2004 Shawn Wagner. + BUG REPORTS AND USER FEEDBACK: Please e-mail Xavier.Leroy@inria.fr + Bzip2, Tar and findlib problems should go to shawnw@speakeasy.org diff -rcN camlzip-1.01/bzip2.ml camlzip-1.01p1/bzip2.ml *** camlzip-1.01/bzip2.ml Wed Dec 31 16:00:00 1969 --- camlzip-1.01p1/bzip2.ml Sun Apr 18 12:11:07 2004 *************** *** 0 **** --- 1,177 ---- + + (* Module [Bzip2]: reading and writing to/from [bzip2] compressed files *) + + exception Error of string + + let buffer_size = 1024 + + type in_channel = + { in_chan: Pervasives.in_channel; + in_buffer: string; + mutable in_pos: int; + mutable in_avail: int; + mutable in_eof: bool; + in_stream: Bzlib.stream; + mutable in_size: int32; } + + let open_in_chan ic = + { in_chan = ic; + in_buffer = String.create buffer_size; + in_pos = 0; + in_avail = 0; + in_eof = false; + in_stream = Bzlib.decompress_init 0 false; + in_size = Int32.zero } + + let open_in filename = + open_in_chan (Pervasives.open_in_bin filename) + + let read_byte iz = + if iz.in_avail = 0 then begin + let n = Pervasives.input iz.in_chan iz.in_buffer 0 + (String.length iz.in_buffer) in + if n = 0 then raise End_of_file; + iz.in_pos <- 0; + iz.in_avail <- n + end; + let c = iz.in_buffer.[iz.in_pos] in + iz.in_pos <- iz.in_pos + 1; + iz.in_avail <- iz.in_avail - 1; + Char.code c + + let read_int32 iz = + let b1 = read_byte iz in + let b2 = read_byte iz in + let b3 = read_byte iz in + let b4 = read_byte iz in + Int32.logor (Int32.of_int b1) + (Int32.logor (Int32.shift_left (Int32.of_int b2) 8) + (Int32.logor (Int32.shift_left (Int32.of_int b3) 16) + (Int32.shift_left (Int32.of_int b4) 24))) + + let rec input iz buf pos len = + if pos < 0 || len < 0 || pos + len > String.length buf then + invalid_arg "Bzip2.input"; + if iz.in_eof then 0 else begin + if iz.in_avail = 0 then begin + let n = Pervasives.input iz.in_chan iz.in_buffer 0 + (String.length iz.in_buffer) in + if n = 0 then raise(Error("truncated file")); + iz.in_pos <- 0; + iz.in_avail <- n + end; + let (finished, used_in, used_out) = + try + Bzlib.decompress iz.in_stream iz.in_buffer iz.in_pos iz.in_avail + buf pos len + with Bzlib.Error(_, e) -> + raise(Error(Bzlib.string_of_error e)) in + iz.in_pos <- iz.in_pos + used_in; + iz.in_avail <- iz.in_avail - used_in; + iz.in_size <- Int32.add iz.in_size (Int32.of_int used_out); + if finished then begin + iz.in_eof <- true; + used_out + end else if used_out = 0 then + input iz buf pos len + else + used_out + end + + let rec really_input iz buf pos len = + if len <= 0 then () else begin + let n = input iz buf pos len in + if n = 0 then raise End_of_file; + really_input iz buf (pos + n) (len - n) + end + + let char_buffer = String.create 1 + + let input_char iz = + if input iz char_buffer 0 1 = 0 then raise End_of_file else char_buffer.[0] + + let input_byte iz = + Char.code (input_char iz) + + let dispose iz = + iz.in_eof <- true; + Bzlib.decompress_end iz.in_stream + + let close_in iz = + dispose iz; + Pervasives.close_in iz.in_chan + + type out_channel = + { out_chan: Pervasives.out_channel; + out_buffer: string; + mutable out_pos: int; + mutable out_avail: int; + out_stream: Bzlib.stream; + mutable out_size: int32; } + + let open_out_chan ?(level = 6) oc = + if level < 1 || level > 9 then invalid_arg "Bzip2.open_out: bad level"; + { out_chan = oc; + out_buffer = String.create buffer_size; + out_pos = 0; + out_avail = buffer_size; + out_stream = Bzlib.compress_init level 0 0; + out_size = Int32.zero } + + let open_out ?(level = 6) filename = + open_out_chan ~level (Pervasives.open_out_bin filename) + + let rec output oz buf pos len = + if pos < 0 || len < 0 || pos + len > String.length buf then + invalid_arg "Bzlib2.output"; + (* If output buffer is full, flush it *) + if oz.out_avail = 0 then begin + Printf.printf "Flushing out_avail\n"; + Pervasives.output oz.out_chan oz.out_buffer 0 oz.out_pos; + oz.out_pos <- 0; + oz.out_avail <- String.length oz.out_buffer + end; + let (_, used_in, used_out) = + try + Bzlib.compress oz.out_stream buf pos len + oz.out_buffer oz.out_pos oz.out_avail + Bzlib.BZ_RUN + with Bzlib.Error(f, e) -> + raise (Error(Bzlib.string_of_error e)) in + oz.out_pos <- oz.out_pos + used_out; + oz.out_avail <- oz.out_avail - used_out; + oz.out_size <- Int32.add oz.out_size (Int32.of_int used_in); + if used_in < len then output oz buf (pos + used_in) (len - used_in) + + let output_char oz c = + char_buffer.[0] <- c; + output oz char_buffer 0 1 + + let output_byte oz b = + output_char oz (Char.unsafe_chr b) + + let flush oz = + let rec do_flush () = + (* If output buffer is full, flush it *) + if oz.out_avail = 0 then begin + Pervasives.output oz.out_chan oz.out_buffer 0 oz.out_pos; + oz.out_pos <- 0; + oz.out_avail <- String.length oz.out_buffer + end; + let (finished, _, used_out) = + Bzlib.compress oz.out_stream oz.out_buffer 0 0 + oz.out_buffer oz.out_pos oz.out_avail + Bzlib.BZ_FINISH in + oz.out_pos <- oz.out_pos + used_out; + oz.out_avail <- oz.out_avail - used_out; + if not finished then do_flush() in + do_flush(); + (* Final data flush *) + if oz.out_pos > 0 then + Pervasives.output oz.out_chan oz.out_buffer 0 oz.out_pos; + Bzlib.compress_end oz.out_stream + + let close_out oz = + flush oz; + Pervasives.close_out oz.out_chan + diff -rcN camlzip-1.01/bzip2.mli camlzip-1.01p1/bzip2.mli *** camlzip-1.01/bzip2.mli Wed Dec 31 16:00:00 1969 --- camlzip-1.01p1/bzip2.mli Sun Apr 18 12:11:14 2004 *************** *** 0 **** --- 1,108 ---- + + (* Module [Bzip2]: reading and writing to/from [bzip2] compressed files *) + + (* This module provides functions to read and write compressed data + to/from files in [bzip2] format. *) + + (*** Reading from compressed files *) + + type in_channel + (* Abstract type representing a channel opened for reading + from a compressed file. *) + val open_in: string -> in_channel + (* Open a compressed file for reading. The argument is the file + name. *) + val open_in_chan: Pervasives.in_channel -> in_channel + (* Open a compressed file for reading. The argument is a + regular file channel already opened on the compressed file. *) + val input_char: in_channel -> char + (* Uncompress one character from the given channel, and return it. + Raise [End_of_file] if no more compressed data is available. *) + val input_byte: in_channel -> int + (* Same as [Bzip2.input_char], but return the 8-bit integer representing + the character. + Raise [End_of_file] if no more compressed data is available. *) + val input: in_channel -> string -> int -> int -> int + (* [input ic buf pos len] uncompresses up to [len] characters + from the given channel [ic], + storing them in string [buf], starting at character number [pos]. + It returns the actual number of characters read, between 0 and + [len] (inclusive). + A return value of 0 means that the end of file was reached. + A return value between 0 and [len] exclusive means that + not all requested [len] characters were read, either because + no more characters were available at that time, or because + the implementation found it convenient to do a partial read; + [input] must be called again to read the remaining characters, + if desired. (See also [Bzip2.really_input] for reading + exactly [len] characters.) + Exception [Invalid_argument "Bzip2.input"] is raised if + [pos] and [len] do not designate a valid substring of [buf]. *) + val really_input: in_channel -> string -> int -> int -> unit + (* [really_input ic buf pos len] uncompresses [len] characters + from the given channel, storing them in + string [buf], starting at character number [pos]. + Raise [End_of_file] if fewer than [len] characters can be read. + Raise [Invalid_argument "Bzip2.input"] if + [pos] and [len] do not designate a valid substring of [buf]. *) + val close_in: in_channel -> unit + (* Close the given input channel. If the channel was created with + [Bzip2.open_in_chan], the underlying regular file channel + (of type [Pervasives.in_channel]) is also closed. + Do not apply any of the functions above to a closed channel. *) + val dispose: in_channel -> unit + (* Same as [Bzip2.close_in], but does not close the underlying + regular file channel (of type [Pervasives.in_channel]); + just dispose of the resources associated with the decompression + channel. This can be useful if e.g. the underlying file channel + is a network socket on which more (uncompressed) data + is expected. *) + + (*** Writing to compressed files *) + + type out_channel + (* Abstract type representing a channel opened for writing + to a compressed file. *) + val open_out: ?level:int -> string -> out_channel + (* Open a compressed file for writing. The argument is the file + name. The file is created if it does not exist, or + truncated to zero length if it exists. + The optional [level] argument (an integer between 1 and 9) + indicates the compression level, with 1 being the weakest + (but fastest) compression and 9 being the strongest + (but slowest) compression. The default level is 6 + (medium compression). *) + val open_out_chan: ?level:int -> Pervasives.out_channel -> out_channel + (* Open a compressed file for writing. The argument is a + regular file channel already opened on the compressed file. + The optional [level] argument sets the compression level + as documented for [Bzip2.open_out]. *) + val output_char: out_channel -> char -> unit + (* Output one character to the given compressed channel. *) + val output_byte: out_channel -> int -> unit + (* Same as [Bzip2.output_char], but the output character is given + by its code. The given integer is taken modulo 256. *) + val output: out_channel -> string -> int -> int -> unit + (* [output oc buf pos len] compresses and writes [len] characters + from string [buf], starting at offset [pos], and writes the + compressed data to the channel [oc]. + Raise [Invalid_argument "Bzip2.output"] if + [pos] and [len] do not designate a valid substring of [buf]. *) + val close_out: out_channel -> unit + (* Close the given output channel. If the channel was created with + [Bzip2.open_out_chan], the underlying regular file channel + (of type [Pervasives.out_channel]) is also closed. + Do not apply any of the functions above to a closed channel. *) + val flush: out_channel -> unit + (* Same as [Bzip2.close_out], but do not close the underlying + regular file channel (of type [Pervasives.out_channel]); + just flush all pending compressed data and + dispose of the resources associated with the compression + channel. This can be useful if e.g. the underlying file channel + is a network socket on which more data is to be sent. *) + + (*** Error reporting *) + + exception Error of string + (* Exception raised by the functions above to signal errors during + compression or decompression, or ill-formed input files. *) diff -rcN camlzip-1.01/bzlib.ml camlzip-1.01p1/bzlib.ml *** camlzip-1.01/bzlib.ml Wed Dec 31 16:00:00 1969 --- camlzip-1.01p1/bzlib.ml Fri Jan 30 23:38:41 2004 *************** *** 0 **** --- 1,38 ---- + + type bzlib_error = BZ_CONFIG_ERROR | BZ_SEQUENCE_ERROR | BZ_PARAM_ERROR + | BZ_MEM_ERROR | BZ_DATA_ERROR | BZ_DATA_ERROR_MAGIC + | BZ_UNKNOWN_ERROR + + let string_of_error = function + | BZ_CONFIG_ERROR -> "Configuration Error" + | BZ_SEQUENCE_ERROR -> "Sequence Error" + | BZ_PARAM_ERROR -> "Invalid Parameter" + | BZ_MEM_ERROR -> "Memory Error" + | BZ_DATA_ERROR -> "Data Error in Bzip2 Stream" + | BZ_DATA_ERROR_MAGIC -> "Bad Magic Number" + | BZ_UNKNOWN_ERROR -> "Unknown" + + exception Error of string * bzlib_error + + let _ = + Callback.register_exception "Bzlib.Error" (Error("",BZ_CONFIG_ERROR)) + + type stream + + type action = BZ_RUN | BZ_FLUSH | BZ_FINISH + + external compress_init: int -> int -> int -> stream = "camlzip_bzCompressInit" + external compress: + stream -> string -> int -> int -> string -> int -> int -> action + -> bool * int * int + = "camlzip_bzCompress_bytecode" "camlzip_bzCompress" + external compress_end: stream -> unit = "camlzip_bzCompressEnd" + + + external decompress_init: int -> bool -> stream = "camlzip_bzDecompressInit" + external decompress: + stream -> string -> int -> int -> string -> int -> int -> bool * int * int + = "camlzip_bzDecompress_bytecode" "camlzip_bzDecompress" + external decompress_end: stream -> unit = "camlzip_bzDecompressEnd" + + diff -rcN camlzip-1.01/bzlib.mli camlzip-1.01p1/bzlib.mli *** camlzip-1.01/bzlib.mli Wed Dec 31 16:00:00 1969 --- camlzip-1.01p1/bzlib.mli Fri Jan 30 23:38:31 2004 *************** *** 0 **** --- 1,23 ---- + + type bzlib_error = BZ_CONFIG_ERROR | BZ_SEQUENCE_ERROR | BZ_PARAM_ERROR | BZ_MEM_ERROR | BZ_DATA_ERROR | BZ_DATA_ERROR_MAGIC | BZ_UNKNOWN_ERROR + exception Error of string * bzlib_error + + val string_of_error: bzlib_error -> string + + type stream + + type action = BZ_RUN | BZ_FLUSH | BZ_FINISH + + external compress_init: int -> int -> int -> stream = "camlzip_bzCompressInit" + external compress: + stream -> string -> int -> int -> string -> int -> int -> action + -> bool * int * int + = "camlzip_bzCompress_bytecode" "camlzip_bzCompress" + external compress_end: stream -> unit = "camlzip_bzCompressEnd" + + + external decompress_init: int -> bool -> stream = "camlzip_bzDecompressInit" + external decompress: + stream -> string -> int -> int -> string -> int -> int -> bool * int * int + = "camlzip_bzDecompress_bytecode" "camlzip_bzDecompress" + external decompress_end: stream -> unit = "camlzip_bzDecompressEnd" diff -rcN camlzip-1.01/tar.ml camlzip-1.01p1/tar.ml *** camlzip-1.01/tar.ml Wed Dec 31 16:00:00 1969 --- camlzip-1.01p1/tar.ml Fri Feb 13 09:19:10 2004 *************** *** 0 **** --- 1,423 ---- + + exception Error of string + + (* Types of files recongized by tar *) + type file_type = REGULAR | LINK | SYMLINK | CHRSPEC | BLKSPEC | DIRECTORY | FIFO | CONTIGIOUS | DUMPDIR (** GNU: A dir entry that contains the names of files that were in the dir at the time the dump was made. *) | LONGLINK (** GNU: Identifies the *next* file on the archive as having a long linkname *)| LONGNAME (** GNU: Identifies the *next* file on the tape as having a long name. *) | MULTIVOL (** GNU: The continuation of a file that began on another volume. *) | NAMES (** GNU: For storing filenames tha do not fit into the main header. *) | SPARSE (** GNU: Sparse file *) | VOLHDR (** GNU: This file is a tape/volume header. Ignore it on extraction. *) + + type record_type = POSIX_FORMAT | GNU_FORMAT | OLDGNU_FORMAT | V7_FORMAT + + (* The size of a header block *) + let blocksize = 512 + + (* The metadata for a file in a tar archive *) + type header = { + t_name: string; + t_mode: int; + t_uid: int; + t_gid: int; + t_size: int; + t_mtime: int32; + t_chksum: int; + t_typeflag: file_type; + t_linkname: string; + t_format: record_type; + t_uname: string; + t_gname: string; + t_devmajor: int; + t_devminor: int; + t_prefix: string; + t_gnu: gnu_extras option + } + and gnu_extras = { + t_atime: int32; + t_ctime: int32; + t_offset: int32; + t_realsize: int32; + } + + class in_chan i = object + method really_input str pos len = + try Pervasives.really_input i str pos len with + End_of_file -> raise (Error "Unexpected end of file") + method input str pos len = + try Pervasives.input i str pos len with + End_of_file -> raise (Error "Unexpected end of file") + method dispose () = () + method close () = Pervasives.close_in i + end + + class gzin_chan i = object + method really_input str pos len = + try Gzip.really_input i str pos len with + End_of_file -> raise (Error "Unexpected end of file") + method input str pos len = + try Gzip.input i str pos len with + End_of_file -> raise (Error "Unexpected end of file") + method dispose () = Gzip.dispose i + method close () = Gzip.close_in i + end + + class bzin_chan i = object + method really_input str pos len = + try Bzip2.really_input i str pos len with + End_of_file -> raise (Error "Unexpected end of file") + method input str pos len = + try Bzip2.input i str pos len with + End_of_file -> raise (Error "Unexpected end of file") + method dispose () = Bzip2.dispose i + method close () = Bzip2.close_in i + end + + + let open_inchan comp chan = + match comp with + | `Plain -> new in_chan chan + | `Gzip -> new gzin_chan (Gzip.open_in_chan chan) + | `Bzip2 -> new bzin_chan (Bzip2.open_in_chan chan) + + let pick_comp_type filename = function + | `Gzip -> `Gzip + | `Bzip2 -> `Bzip2 + | `Plain -> `Plain + | `Guess -> + if Filename.check_suffix filename ".tar" then + `Plain + else if Filename.check_suffix filename ".bz2" then + `Bzip2 + else if Filename.check_suffix filename ".gz" + || Filename.check_suffix filename ".Z" + || Filename.check_suffix filename ".tgz" then + `Gzip + else + `Plain + + type t_in = { + chan: in_chan; + rawchan: in_channel; + mutable last_header: header option; + } + + let open_in_chan ?(compress=`Plain) chan = + { + chan = open_inchan compress chan; + rawchan = chan; + last_header = None; + } + + let open_in ?(compress=`Guess) filename = + open_in_chan ~compress:(pick_comp_type filename compress) (open_in_bin filename) + + + let dispose t = t.chan#dispose () + and close_in t = t.chan#close () + + (* Add Error Checking! *) + let c_string raw start = + let nul = String.index_from raw start '\000' in + String.sub raw start (nul - start) + + (* Numbers are /supposed/ to be 0 padded, octal, with a trailing "\000 ". About the only thing that's universal about this is octal. *) + let trim_spaces str pos len = + let start = ref pos + and stop = ref (pos + len - 1) in + while str.[!start] = ' ' do incr start done; + while str.[!stop] = ' ' || str.[!stop] = '\000' do decr stop done; + String.sub str !start (!stop - !start + 1) + + let extract_num raw pos len = + if raw.[pos] = '\000' then 0 + else try + int_of_string ("0o" ^ (trim_spaces raw pos len)) + with Failure x -> raise (Error "Invalid number in header") + + let extract_int32 raw pos len = + if raw.[pos] = '\000' then 0l + else try + Int32.of_string ("0o" ^ trim_spaces raw pos len) + with Failure x -> raise (Error "Invalid number in header") + + let typeflag = function + | '0' | '\000' -> REGULAR + | '1' -> LINK + | '2' -> SYMLINK + | '3' -> CHRSPEC + | '4' -> BLKSPEC + | '5' -> DIRECTORY + | '6' -> FIFO + | '7' -> CONTIGIOUS + | 'D' -> DUMPDIR + | 'K' -> LONGLINK + | 'L' -> LONGNAME + | 'M' -> MULTIVOL + | 'N' -> NAMES + | 'S' -> raise (Error "Sparse files are not supported") + | 'V' -> VOLHDR + | _ -> raise (Error "Unknown file type") + + let align_at_header t = + match t.last_header with + | None -> () + | Some h -> + let entry_size = ((h.t_size/blocksize) + 1) * blocksize + and buf = String.create blocksize + and discarded = ref 0 in + while !discarded < entry_size do + let read = t.chan#input buf 0 blocksize in + discarded := !discarded + read + done; + t.last_header <- None + + let empty_block = String.make blocksize '\000' + + let compute_chksum buf = + let chksum = ref 256 in (* 256 is the sum of 8 ' ' characters for the chksum field *) + for i = 0 to 147 do + chksum := !chksum + Char.code buf.[i] + done; + for i = 156 to 511 do + chksum := !chksum + Char.code buf.[i] + done; + !chksum + + let read_magic header typec = + let magic = String.sub header 257 8 in + match magic with + | "ustar \000" -> OLDGNU_FORMAT + | "ustar\00000" -> begin match typec with + | '0' .. '7' -> POSIX_FORMAT | _ -> GNU_FORMAT + end + | _ -> V7_FORMAT + + let read_oldgnu_header header = + { t_atime = extract_int32 header 345 12; + t_ctime = extract_int32 header 357 12; + t_offset = extract_int32 header 369 12; + t_realsize = extract_int32 header 483 12; + } + + let read_gnu_header t = + let buf = String.create blocksize in + t.chan#really_input buf 0 blocksize; + { t_atime = extract_int32 buf 0 12; + t_ctime = extract_int32 buf 12 12; + t_offset = extract_int32 buf 24 12; + t_realsize = extract_int32 buf 36 12; + } + + let read_header t = + align_at_header t; + let buf = String.create blocksize in + t.chan#really_input buf 0 blocksize; + if buf = empty_block then raise End_of_file; + let head1 = { t_name = c_string buf 0; + t_mode = extract_num buf 100 8; + t_uid = extract_num buf 108 8; + t_gid = extract_num buf 116 8; + t_size = extract_num buf 124 12; + t_mtime = extract_int32 buf 136 12; + t_chksum = extract_num buf 148 8; + t_typeflag = typeflag buf.[156]; + t_linkname = c_string buf 157; + t_format = read_magic buf buf.[156]; + t_uname = c_string buf 265; + t_gname = c_string buf 297; + t_devmajor = extract_num buf 329 8; + t_devminor = extract_num buf 337 8; + t_prefix = String.sub buf 345 155; + t_gnu = None; + } in + let chksum = compute_chksum buf in + if chksum <> head1.t_chksum then + raise (Error (Printf.sprintf "Invalid checksum in tar header. Calculated %d, expected %d" chksum head1.t_chksum)); + let head = + if head1.t_format = OLDGNU_FORMAT then + {head1 with t_gnu = Some (read_oldgnu_header buf) } + else if head1.t_format = GNU_FORMAT then + {head1 with t_gnu = Some (read_gnu_header t) } + else + head1 in + t.last_header <- Some head; + head + + let align_at_body t = + match t.last_header with + | Some _ -> () + | None -> ignore (read_header t) + + let get_header t = + match t.last_header with + | Some h -> h + | None -> raise (Error "Missing tar header?") + + let read_body t = + align_at_body t; + let header = get_header t in + t.last_header <- None; + if header.t_size = 0 then "" + else let buf = String.create header.t_size in + t.chan#really_input buf 0 header.t_size; + let align = blocksize - (header.t_size mod blocksize) in + if align <> blocksize then begin + let leftover = String.create blocksize in + t.chan#really_input leftover 0 align + end; + buf + + let read_entry t = + let head = read_header t in + head, read_body t + + class out_chan o = object + method output str pos len = Pervasives.output o str pos len + method flush () = Pervasives.flush o + method close () = Pervasives.close_out o + end + + class gzout_chan o = object + method output str pos len = Gzip.output o str pos len + method flush () = Gzip.flush o + method close () = Gzip.close_out o + end + + class bzout_chan o = object + method output str pos len = Bzip2.output o str pos len + method flush () = Bzip2.flush o + method close () = Bzip2.close_out o + end + + + let open_outchan comp chan = + match comp with + | `Plain -> new out_chan chan + | `Gzip -> new gzout_chan (Gzip.open_out_chan chan) + | `Bzip2 -> new bzout_chan (Bzip2.open_out_chan chan) + + type t_out = { + ochan: out_chan; + rawochan: out_channel; + } + + let open_out_chan ?(compress=`Plain) chan = + { + ochan = open_outchan compress chan; + rawochan = chan; + } + + let open_out ?(compress=`Plain) filename = + open_out_chan ~compress (open_out_bin filename) + + let write_str buf pos width str = + let len = min (String.length str) (width - 1) in + String.blit str 0 buf pos len + + let write_num8 buf pos n = + let as_str = Printf.sprintf "%07o" n in + String.blit as_str 0 buf pos 7 + + let write_num12 buf pos n = + let as_str = Printf.sprintf "%011o" n in + String.blit as_str 0 buf pos 11 + + let write_int32 buf pos n = + let as_str = Printf.sprintf "%011lo" n in + String.blit as_str 0 buf pos 11 + + let write_padded_num buf pos n = + let as_str = Printf.sprintf "%07o\000 " n in + String.blit as_str 0 buf pos 8 + + let write_magic buf pos magic = + let str = match magic with + | POSIX_FORMAT | GNU_FORMAT -> "ustar\00000" + | OLDGNU_FORMAT -> "ustar \0000" + | V7_FORMAT -> " \000" + in + String.blit str 0 buf pos 8 + + let typeflag_to_char = function + | REGULAR -> '0' + | LINK -> '1' + | SYMLINK -> '2' + | CHRSPEC -> '3' + | BLKSPEC -> '4' + | DIRECTORY -> '5' + | FIFO -> '6' + | CONTIGIOUS -> '7' + | DUMPDIR -> 'D' + | LONGLINK -> 'K' + | LONGNAME -> 'L' + | MULTIVOL -> 'M' + | NAMES -> 'N' + | SPARSE -> raise (Error "Sparse files aren't supported for output") + | VOLHDR -> 'V' + + let isdigit = function '0' .. '9' -> true | _ -> false + + let write_oldgnu_header t buf = + let ext = match t.t_gnu with + | Some e -> e + | None -> raise (Error "OLDGNU_FORMAT record without t_gnu field set") in + write_int32 buf 345 ext.t_atime; + write_int32 buf 356 ext.t_ctime; + write_int32 buf 369 ext.t_offset; + write_int32 buf 483 ext.t_realsize + + let write_gnu_header t buf = + let ext = match t.t_gnu with + | Some e -> e + | None -> raise (Error "GNU_FORMAT record without t_gnu field set") in + write_int32 buf 0 ext.t_atime; + write_int32 buf 12 ext.t_ctime; + write_int32 buf 24 ext.t_offset; + write_int32 buf 36 ext.t_realsize + + let output t head body = + let size = String.length body in + let buf = String.copy empty_block in + write_str buf 0 100 head.t_name; + write_num8 buf 100 head.t_mode; + write_num8 buf 108 head.t_uid; + write_num8 buf 116 head.t_gid; + write_num12 buf 124 size; + write_int32 buf 136 head.t_mtime; + buf.[156] <- typeflag_to_char head.t_typeflag; + write_str buf 157 100 head.t_linkname; + write_magic buf 257 head.t_format; + write_str buf 265 32 head.t_uname; + write_str buf 297 32 head.t_gname; + write_num8 buf 329 head.t_devmajor; + write_num8 buf 337 head.t_devminor; + write_str buf 345 155 head.t_prefix; + if head.t_format = OLDGNU_FORMAT then + write_oldgnu_header head buf; + let chksum = compute_chksum buf in + write_padded_num buf 148 chksum; + t.ochan#output buf 0 blocksize; + if head.t_format = GNU_FORMAT && isdigit buf.[156] then begin + let buf2 = String.copy empty_block in + write_gnu_header head buf2; + t.ochan#output buf2 0 blocksize + end; + if size > 0 then begin + let blocks = size / blocksize in + for n = 0 to blocks do + let pos = n * blocksize in + let len = + if size - pos >= blocksize then + blocksize + else + size - pos in + t.ochan#output body (n * 512) len; + done; + let align = blocksize - (size mod blocksize) in + if align > 0 && align < blocksize then + t.ochan#output empty_block 0 align + end + + let flush t = + t.ochan#output empty_block 0 blocksize; + t.ochan#flush () + + let close_out t = + flush t; + close_out t.rawochan diff -rcN camlzip-1.01/tar.mli camlzip-1.01p1/tar.mli *** camlzip-1.01/tar.mli Wed Dec 31 16:00:00 1969 --- camlzip-1.01p1/tar.mli Sun Apr 18 11:49:16 2004 *************** *** 0 **** --- 1,106 ---- + + (** Reading and writing TAR archives *) + + (** This module provides functions for reading and creating tar + archives. It supports compressed archives, and tries to deal with some + of the extensions to the tar format that various versions of tar + have. It can read POSIX and most gnu-tar format archives, and has a + chance at really old V7-style tar. It cannot yet deal with sparse + files. The good news is that it does read all the typical tarballs + I've thrown at it. *) + + (** Types of files recognized by tar *) + type file_type = REGULAR | LINK | SYMLINK | CHRSPEC | BLKSPEC | DIRECTORY | FIFO | CONTIGIOUS | DUMPDIR (** GNU: A dir entry that contains the names of files that were in the dir at the time the dump was made. *) | LONGLINK (** GNU: Identifies the *next* file on the archive as having a long linkname. The body of this entry is the linkname. *)| LONGNAME (** GNU: Identifies the *next* file on the tape as having a long name. The body of this entry is the filename. *) | MULTIVOL (** GNU: The continuation of a file that began on another volume. *) | NAMES (** GNU: For storing filenames that do not fit into the main header. I haven't yet figured out /where/ they're stored. *) | SPARSE (** GNU: Sparse file. *) | VOLHDR (** GNU: This file is a tape/volume header. Ignore it on extraction. *) + + (** Types of archives supported by this library. POSIX_FORMAT is the + best-supported type. It tries to deal with GNU extensions and the + mish-mash of formats that predate POSIX. If you find something it + breaks with, please tell me so support for it can be added. *) + type record_type = POSIX_FORMAT | GNU_FORMAT | OLDGNU_FORMAT | V7_FORMAT + + (** The metadata for a file in a tar archive *) + type header = { + t_name: string; + t_mode: int; + t_uid: int; + t_gid: int; + t_size: int; + t_mtime: int32; + t_chksum: int; + t_typeflag: file_type; + t_linkname: string; + t_format: record_type; + t_uname: string; + t_gname: string; + t_devmajor: int; + t_devminor: int; + t_prefix: string; + t_gnu: gnu_extras option; (** These aren't always set to meaningful values even with [OLDGNU_FORMAT] and [GNU_FORMAT] records. *) + } + and gnu_extras = { + t_atime: int32; + t_ctime: int32; + t_offset: int32; + t_realsize: int32; + } + + (** Raised on errors involving not being able to parse the tar format + being used *) + exception Error of string + + (** {1 Reading a tar archive} *) + + (** The type of tar files opened for reading *) + type t_in + + (** Open a tar file, optionally compressed with gzip or bzip2. The + default behavior is to guess how the file is compressed based on its + extension. When in doubt, be specific. *) + val open_in: ?compress:[<`Plain|`Gzip|`Bzip2|`Guess>`Guess] -> string -> t_in + + (** Treat an already-opened channel as a tar file, optionally compressed. *) + val open_in_chan: ?compress:[<`Plain|`Gzip|`Bzip2>`Plain] -> in_channel -> t_in + + (** Return the header for the next file in the tar archive *) + val read_header: t_in -> header + + (** Return the contents of the next file in the tar archive. If the + file size is 0, returns an empty string. *) + val read_body: t_in -> string + + (** Return the next file header and body in the archive *) + val read_entry: t_in -> header * string + + (** Clean up and stop processing the archive without closing the input + channel *) + val dispose: t_in -> unit + + (** Clean up and close the archive's input channel. *) + val close_in: t_in -> unit + + (** {1 Writing a tar archive} *) + + (** The type for a tar file opened for reading *) + type t_out + + (** Create a new tar file, optionally compressed with gzip or + bzip2. *) + val open_out: ?compress:[<`Plain|`Gzip|`Bzip2>`Plain] -> string -> t_out + + (** Treat already-opened channel as the sink for a tar file to be + written to, optionally compressed. *) + val open_out_chan: ?compress:[<`Plain|`Gzip|`Bzip2>`Plain] -> out_channel -> t_out + + (** Write a file to the tar archive using the given header and file + body. [header.t_size] is set based on the length of the string that's + used as the file. [header.t_chksum] is also filled in + automatically. *) + val output: t_out -> header -> string -> unit + + (** Flush out the tar archive but don't close the underlying + [out_channel] *) + val flush: t_out -> unit + + (** Closes the tar file *) + val close_out: t_out -> unit + diff -rcN camlzip-1.01/test/Makefile camlzip-1.01p1/test/Makefile *** camlzip-1.01/test/Makefile Tue Aug 7 08:32:08 2001 --- camlzip-1.01p1/test/Makefile Sun Apr 18 11:53:15 2004 *************** *** 1,14 **** ! all: minizip minigzip minigzip: ../zip.cma minigzip.ml ! ocamlc -ccopt -g -g -I .. -o minigzip ../zip.cma minigzip.ml minizip: ../zip.cma minizip.ml ! ocamlc -ccopt -g -g -I .. -o minizip unix.cma ../zip.cma minizip.ml testzlib: ../zip.cma testzlib.ml ! ocamlc -g -I .. -o testzlib ../zip.cma testzlib.ml clean: rm -f *.cm* ! rm -f minigzip minizip testzlib --- 1,22 ---- ! all: minizip minigzip minibzip2 ! ! CAMLFLAGS=-g -I .. -dllpath .. ! ! minibzip2: ../zip.cma minibzip2.ml ! ocamlc $(CAMLFLAGS) -o minibzip2 ../zip.cma minibzip2.ml ! ! testtar: ../zip.cma testtar.ml ! ocamlc $(CAMLFLAGS) -o minitar ../zip.cma testtar.ml minigzip: ../zip.cma minigzip.ml ! ocamlc $(CAMLFLAGS) -o minigzip ../zip.cma minigzip.ml minizip: ../zip.cma minizip.ml ! ocamlc $(CAMLFLAGS) -o minizip unix.cma ../zip.cma minizip.ml testzlib: ../zip.cma testzlib.ml ! ocamlc $(CAMLFLAGS) -o testzlib ../zip.cma testzlib.ml clean: rm -f *.cm* ! rm -f minigzip minizip testzlib minibzip2 testtar diff -rcN camlzip-1.01/test/bigfilename.pl camlzip-1.01p1/test/bigfilename.pl *** camlzip-1.01/test/bigfilename.pl Wed Dec 31 16:00:00 1969 --- camlzip-1.01p1/test/bigfilename.pl Fri Feb 13 09:01:48 2004 *************** *** 0 **** --- 1,7 ---- + #!/usr/bin/perl -w + use strict; + + my $filename = "x" x 120; + open FILE, ">", $filename or die "Couldn't open file: $!\n"; + print FILE "foobie bletch\n"; + close FILE; diff -rcN camlzip-1.01/test/data.txt camlzip-1.01p1/test/data.txt *** camlzip-1.01/test/data.txt Wed Dec 31 16:00:00 1969 --- camlzip-1.01p1/test/data.txt Fri Jan 30 22:26:54 2004 *************** *** 0 **** --- 1 ---- + The quick red fox jumped over the lazy brown dog. diff -rcN camlzip-1.01/test/minibzip2.ml camlzip-1.01p1/test/minibzip2.ml *** camlzip-1.01/test/minibzip2.ml Wed Dec 31 16:00:00 1969 --- camlzip-1.01p1/test/minibzip2.ml Fri Jan 30 22:21:07 2004 *************** *** 0 **** --- 1,18 ---- + let buffer = String.create 4096 + + let _ = + if Array.length Sys.argv >= 2 && Sys.argv.(1) = "-d" then begin + (* decompress *) + let ic = Bzip2.open_in_chan stdin in + let rec decompress () = + let n = Bzip2.input ic buffer 0 (String.length buffer) in + if n = 0 then () else begin output stdout buffer 0 n; decompress() end + in decompress(); Bzip2.dispose ic + end else begin + (* compress *) + let oc = Bzip2.open_out_chan stdout in + let rec compress () = + let n = input stdin buffer 0 (String.length buffer) in + if n = 0 then () else begin Bzip2.output oc buffer 0 n; compress() end + in compress(); Bzip2.flush oc + end diff -rcN camlzip-1.01/test/testtar.ml camlzip-1.01p1/test/testtar.ml *** camlzip-1.01/test/testtar.ml Wed Dec 31 16:00:00 1969 --- camlzip-1.01p1/test/testtar.ml Wed Feb 4 19:55:33 2004 *************** *** 0 **** --- 1,20 ---- + open Tar + let pmagic = function + | V7_FORMAT -> "V7_FORMAT" + | OLDGNU_FORMAT -> "OLDGNU_FORMAT" + | GNU_FORMAT -> "GNU_FORMAT" + | POSIX_FORMAT -> "POSIX_FORMAT";; + + let tar = Tar.open_in_chan stdin in + (* and otar = Tar.open_out ~compress:`Bzip2 "wrote.tar.bz2" *) + try + while true do + let (header, body) = read_entry tar in + Printf.printf "Type: %s " (pmagic header.t_format); + Printf.printf "Filename: %s Bytes: %d\n" header.t_name (String.length body); + (* Tar.output otar header body *) + done + with + End_of_file -> + Tar.close_in tar; + (* Tar.close_out otar *) diff -rcN camlzip-1.01/zlibstubs.c camlzip-1.01p1/zlibstubs.c *** camlzip-1.01/zlibstubs.c Tue Aug 7 08:32:08 2001 --- camlzip-1.01p1/zlibstubs.c Sat Jan 31 17:38:44 2004 *************** *** 16,21 **** --- 16,25 ---- #include + #ifdef USE_BZIP2 + #include + #endif + #include #include #include *************** *** 172,174 **** --- 176,364 ---- Long_val(len))); } + /* Bzip2 interface code */ + + #define BZStream_val(v) ((bz_stream *) (v)) + + static value * camlzip_bzerror_exn = NULL; + + #ifdef USE_BZIP2 + static void camlzip_bzerror(char * fn, int err) + { + char * msg; + value s1 = Val_unit, s2 = Val_unit, bucket = Val_unit; + + if (camlzip_bzerror_exn == NULL) { + camlzip_bzerror_exn = caml_named_value("Bzlib.Error"); + if (camlzip_bzerror_exn == NULL) + invalid_argument("Exception Bzlib.Error not initialized"); + } + Begin_roots3(s1, s2, bucket); + s1 = copy_string(fn); + switch (err) { + case BZ_CONFIG_ERROR: + s2 = Val_int(0); + break; + case BZ_SEQUENCE_ERROR: + s2 = Val_int(1); + break; + case BZ_PARAM_ERROR: + s2 = Val_int(2); + break; + case BZ_MEM_ERROR: + s2 = Val_int(3); + break; + case BZ_DATA_ERROR: + s2 = Val_int(4); + break; + case BZ_DATA_ERROR_MAGIC: + s2 = Val_int(5); + break; + default: + s2 = Val_int(6); + } + bucket = alloc_small(3, 0); + Field(bucket, 0) = *camlzip_bzerror_exn; + Field(bucket, 1) = s1; + Field(bucket, 2) = s2; + End_roots(); + mlraise(bucket); + } + + static value camlzip_new_bzstream(void) + { + value res = alloc((sizeof(bz_stream) + sizeof(value) - 1) / sizeof(value), + Abstract_tag); + ZStream_val(res)->zalloc = NULL; + ZStream_val(res)->zfree = NULL; + ZStream_val(res)->opaque = NULL; + ZStream_val(res)->next_in = NULL; + ZStream_val(res)->next_out = NULL; + return res; + } + + int camlzip_action_table[] = { BZ_RUN, BZ_FLUSH, BZ_FINISH }; + #endif + + + value camlzip_bzCompressInit(value blockSize100k, value verbosity, value workFactor) { + #ifdef USE_BZIP2 + int err; + value vbzs = camlzip_new_bzstream(); + if ((err = BZ2_bzCompressInit(BZStream_val(vbzs), + Int_val(blockSize100k), + Int_val(verbosity), + Int_val(workFactor))) != BZ_OK) + camlzip_bzerror("Zlib.deflateInit", err); + return vbzs; + #else + failwith("Bzip2 compression not supported."); + #endif + } + + value camlzip_bzCompress(value vzs, value srcbuf, value srcpos, value srclen, + value dstbuf, value dstpos, value dstlen, + value vflush) + { + #ifdef USE_BZIP2 + bz_stream * zs = BZStream_val(vzs); + int retcode; + long used_in, used_out; + value res; + + zs->next_in = &Byte(srcbuf, Long_val(srcpos)); + zs->avail_in = Long_val(srclen); + zs->next_out = &Byte(dstbuf, Long_val(dstpos)); + zs->avail_out = Long_val(dstlen); + retcode = BZ2_bzCompress(zs, camlzip_action_table[Int_val(vflush)]); + if (retcode < 0) camlzip_bzerror("Bzlib.compress", retcode); + used_in = Long_val(srclen) - zs->avail_in; + used_out = Long_val(dstlen) - zs->avail_out; + zs->next_in = NULL; /* not required, but cleaner */ + zs->next_out = NULL; /* (avoid dangling pointers into Caml heap) */ + res = alloc_small(3, 0); + Field(res, 0) = Val_bool(retcode == BZ_STREAM_END); + Field(res, 1) = Val_int(used_in); + Field(res, 2) = Val_int(used_out); + return res; + #else + failwith("Bzip2 compression not supported"); + #endif + } + + value camlzip_bzCompress_bytecode(value * arg, int nargs) + { + return camlzip_bzCompress(arg[0], arg[1], arg[2], arg[3], + arg[4], arg[5], arg[6], arg[7]); + } + + value camlzip_bzCompressEnd(value stream) { + #ifdef USE_BZIP2 + int err; + if ((err = BZ2_bzCompressEnd(BZStream_val(stream))) != BZ_OK) + camlzip_bzerror("Bzlib.compress_end", err); + #else + failwith("Bzip2 compression not supported"); + #endif + return Val_unit; + } + + value camlzip_bzDecompressInit(value verbosity, value small) + { + #ifdef USE_BZIP2 + int err; + value vzs = camlzip_new_bzstream(); + if ((err = BZ2_bzDecompressInit(BZStream_val(vzs), Int_val(verbosity), Bool_val(small))) != BZ_OK) + camlzip_bzerror("Bzlib.decompress_init", err); + return vzs; + #else + failwith("Bzip2 compression not supported"); + #endif + } + + value camlzip_bzDecompress(value vzs, value srcbuf, value srcpos, value srclen, + value dstbuf, value dstpos, value dstlen) + { + #ifdef USE_BZIP2 + bz_stream * zs = BZStream_val(vzs); + int retcode; + long used_in, used_out; + value res; + + zs->next_in = &Byte(srcbuf, Long_val(srcpos)); + zs->avail_in = Long_val(srclen); + zs->next_out = &Byte(dstbuf, Long_val(dstpos)); + zs->avail_out = Long_val(dstlen); + retcode = BZ2_bzDecompress(zs); + if (retcode < 0) + camlzip_bzerror("Bzlib.decompress", retcode); + used_in = Long_val(srclen) - zs->avail_in; + used_out = Long_val(dstlen) - zs->avail_out; + zs->next_in = NULL; /* not required, but cleaner */ + zs->next_out = NULL; /* (avoid dangling pointers into Caml heap) */ + res = alloc_small(3, 0); + Field(res, 0) = Val_bool(retcode == BZ_STREAM_END); + Field(res, 1) = Val_int(used_in); + Field(res, 2) = Val_int(used_out); + return res; + #else + failwith("Bzip2 compression not supported"); + #endif + } + + value camlzip_bzDecompress_bytecode(value * arg, int nargs) + { + return camlzip_bzDecompress(arg[0], arg[1], arg[2], arg[3], + arg[4], arg[5], arg[6]); + } + + value camlzip_bzDecompressEnd(value stream) { + #ifdef USE_BZIP2 + int err; + if ((err = BZ2_bzDecompressEnd(BZStream_val(stream))) != BZ_OK) + camlzip_bzerror("Bzlib.decompressEnd", err); + #else + failwith("Bzip2 compression not supported"); + #endif + return Val_unit; + }