Commit 56f38e2f authored by Samuel Mimram's avatar Samuel Mimram

Imported Upstream version 1.04

parent c827815f
Release 1.04:
- Added function Zip.add_entry_generator. (Contributed by A. Frisch.)
- The "level" optional argument was sometimes not honored; fixed.
- Relicensed under LGPL 2.1 or above, with Caml's special exception
for static linking.
Release 1.03:
- Fixed bug in Zlib.uncompress that could cause it to loop infinitely.
- Documentation comments in .mli files converted to ocamldoc format.
......
This diff is collapsed.
......@@ -44,11 +44,12 @@ The directory test/ contains examples of using this library.
LICENSING:
This library is copyright 2001, 2002, 2006, 2007 Institut National de
Recherche en Informatique et en Automatique, and distributed under the
terms of the GNU Library General Public License (LGPL) with a special
exception concerning static linking. See the file LICENSE for the
exact licensing terms.
This library is copyright 2001, 2002, 2006, 2007, 2008
Institut National de Recherche en Informatique et en Automatique (INRIA),
and distributed under the terms of the GNU Lesser General Public
License (LGPL) version 2.1 or above, with a special exception
concerning static linking. See the file LICENSE for the exact
licensing terms.
BUG REPORTS AND USER FEEDBACK:
......
......@@ -6,12 +6,12 @@
(* *)
(* Copyright 2001 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* under the terms of the GNU Lesser General Public License, with *)
(* the special exception on linking described in file LICENSE. *)
(* *)
(***********************************************************************)
(* $Id: zip.ml,v 1.4 2006/04/04 08:28:44 xleroy Exp $ *)
(* $Id: zip.ml,v 1.5 2008/12/07 09:23:08 xleroy Exp $ *)
(* Module [Zip]: reading and writing ZIP archives *)
......@@ -482,7 +482,7 @@ let add_entry data ofile ?(extra = "") ?(comment = "")
let in_pos = ref 0 in
let out_pos = ref 0 in
try
Zlib.compress ~header:false
Zlib.compress ~level ~header:false
(fun buf ->
let n = min (String.length data - !in_pos)
(String.length buf) in
......@@ -521,7 +521,7 @@ let copy_channel_to_entry ic ofile ?(extra = "") ?(comment = "")
let in_pos = ref 0 in
let out_pos = ref 0 in
try
Zlib.compress ~header:false
Zlib.compress ~level ~header:false
(fun buf ->
let r = input ic buf 0 (String.length buf) in
crc := Zlib.update_crc !crc buf 0 r;
......@@ -554,3 +554,56 @@ let copy_file_to_entry infilename ofile ?(extra = "") ?(comment = "")
Pervasives.close_in ic; raise x
(* Add an entry whose content will be produced by the caller *)
let add_entry_generator ofile ?(extra = "") ?(comment = "")
?(level = 6) ?(mtime = Unix.time()) name =
let e = add_entry_header ofile extra comment level mtime name in
let crc = ref Int32.zero in
let compr_size = ref 0 in
let uncompr_size = ref 0 in
let finished = ref false in
let check () =
if !finished then
raise (Error(ofile.of_filename, name, "entry already finished"))
in
let finish () =
finished := true;
let e' = add_data_descriptor ofile !crc !compr_size !uncompr_size e in
ofile.of_entries <- e' :: ofile.of_entries
in
match level with
| 0 ->
(fun buf pos len ->
check ();
output ofile.of_channel buf pos len;
compr_size := !compr_size + len;
uncompr_size := !uncompr_size + len
),
(fun () ->
check ();
finish ()
)
| _ ->
let (send, flush) = Zlib.compress_direct ~level ~header:false
(fun buf n ->
output ofile.of_channel buf 0 n;
compr_size := !compr_size + n)
in
(fun buf pos len ->
check ();
try
send buf pos len;
uncompr_size := !uncompr_size + len;
crc := Zlib.update_crc !crc buf pos len
with Zlib.Error(_, _) ->
raise (Error(ofile.of_filename, name, "compression error"))
),
(fun () ->
check ();
try
flush ();
finish ()
with Zlib.Error(_, _) ->
raise (Error(ofile.of_filename, name, "compression error"))
)
......@@ -6,12 +6,12 @@
(* *)
(* Copyright 2001 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* under the terms of the GNU Lesser General Public License, with *)
(* the special exception on linking described in file LICENSE. *)
(* *)
(***********************************************************************)
(* $Id: zip.mli,v 1.6 2007/01/21 15:12:55 xleroy Exp $ *)
(* $Id: zip.mli,v 1.7 2008/12/07 09:23:08 xleroy Exp $ *)
(** Reading and writing ZIP archives
......@@ -143,6 +143,23 @@ val copy_file_to_entry:
argument. Also, the default value for the [mtime]
optional parameter is the time of last modification of the
file. *)
val add_entry_generator:
out_file ->
?extra: string -> ?comment: string -> ?level: int ->
?mtime: float -> string -> (string -> int -> int -> unit) * (unit -> unit)
(** [Zip.add_entry_generator zf name] returns a pair of functions
[(add, finish)]. It adds a new entry to the
ZIP file [zf]. The file name stored along with this entry
is [name]. Initially, no data is stored in this entry.
To store data in this entry, the program must repeatedly call
the [add] function returned by [Zip.add_entry_generator].
An invocation [add s ofs len] stores [len] characters of
string [s] starting at offset [ofs] in the ZIP entry.
When all the data forming the entry has been sent, the
program must call the [finish] function returned by
[Zip.add_entry_generator]. [finish] must be called exactly once.
The optional arguments to [Zip.add_entry_generator]
are as described in {!Zip.add_entry}. *)
val close_out: out_file -> unit
(** Finish writing the ZIP archive by adding the table of
contents, and close it. *)
......
(***********************************************************************)
(* *)
(* The CamlZip library *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2001 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Lesser General Public License, with *)
(* the special exception on linking described in file LICENSE. *)
(* *)
(***********************************************************************)
(* $Id: zlib.ml,v 1.4 2008/12/07 09:23:08 xleroy Exp $ *)
exception Error of string * string
let _ =
......@@ -53,6 +68,24 @@ let compress ?(level = 6) ?(header = true) refill flush =
compr 0 0;
deflate_end zs
let compress_direct ?(level = 6) ?(header = true) flush =
let outbuf = String.create buffer_size in
let zs = deflate_init level header in
let rec compr inbuf inpos inavail =
if inavail = 0 then ()
else begin
let (_, used_in, used_out) =
deflate zs inbuf inpos inavail outbuf 0 buffer_size Z_NO_FLUSH in
flush outbuf used_out;
compr inbuf (inpos + used_in) (inavail - used_in)
end
and compr_finish () =
let (finished, _, used_out) =
deflate zs "" 0 0 outbuf 0 buffer_size Z_FINISH in
flush outbuf used_out;
if not finished then compr_finish()
in
compr, compr_finish
let uncompress ?(header = true) refill flush =
let inbuf = String.create buffer_size
......
(***********************************************************************)
(* *)
(* The CamlZip library *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2001 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Lesser General Public License, with *)
(* the special exception on linking described in file LICENSE. *)
(* *)
(***********************************************************************)
(* $Id: zlib.mli,v 1.2 2008/12/07 09:23:08 xleroy Exp $ *)
exception Error of string * string
val compress:
?level: int -> ?header: bool ->
(string -> int) -> (string -> int -> unit) -> unit
val compress_direct:
?level: int -> ?header: bool -> (string -> int -> unit) ->
(string -> int -> int -> unit) * (unit -> unit)
val uncompress:
?header: bool -> (string -> int) -> (string -> int -> unit) -> unit
......
......@@ -6,12 +6,12 @@
/* */
/* Copyright 2001 Institut National de Recherche en Informatique et */
/* en Automatique. All rights reserved. This file is distributed */
/* under the terms of the GNU Library General Public License, with */
/* under the terms of the GNU Lesser General Public License, with */
/* the special exception on linking described in file LICENSE. */
/* */
/***********************************************************************/
/* $Id: zlibstubs.c,v 1.3 2006/04/04 08:29:07 xleroy Exp $ */
/* $Id: zlibstubs.c,v 1.4 2008/12/07 09:23:08 xleroy Exp $ */
/* Stub code to interface with Zlib */
......@@ -37,22 +37,22 @@ static void camlzip_error(char * fn, value vzs)
if (camlzip_error_exn == NULL) {
camlzip_error_exn = caml_named_value("Zlib.Error");
if (camlzip_error_exn == NULL)
invalid_argument("Exception Zlib.Error not initialized");
caml_invalid_argument("Exception Zlib.Error not initialized");
}
Begin_roots3(s1, s2, bucket);
s1 = copy_string(fn);
s2 = copy_string(msg);
bucket = alloc_small(3, 0);
s1 = caml_copy_string(fn);
s2 = caml_copy_string(msg);
bucket = caml_alloc_small(3, 0);
Field(bucket, 0) = *camlzip_error_exn;
Field(bucket, 1) = s1;
Field(bucket, 2) = s2;
End_roots();
mlraise(bucket);
caml_raise(bucket);
}
static value camlzip_new_stream(void)
{
value res = alloc((sizeof(z_stream) + sizeof(value) - 1) / sizeof(value),
value res = caml_alloc((sizeof(z_stream) + sizeof(value) - 1) / sizeof(value),
Abstract_tag);
ZStream_val(res)->zalloc = NULL;
ZStream_val(res)->zfree = NULL;
......@@ -97,7 +97,7 @@ value camlzip_deflate(value vzs, value srcbuf, value srcpos, value srclen,
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);
res = caml_alloc_small(3, 0);
Field(res, 0) = Val_bool(retcode == Z_STREAM_END);
Field(res, 1) = Val_int(used_in);
Field(res, 2) = Val_int(used_out);
......@@ -146,7 +146,7 @@ value camlzip_inflate(value vzs, value srcbuf, value srcpos, value srclen,
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);
res = caml_alloc_small(3, 0);
Field(res, 0) = Val_bool(retcode == Z_STREAM_END);
Field(res, 1) = Val_int(used_in);
Field(res, 2) = Val_int(used_out);
......@@ -168,7 +168,7 @@ value camlzip_inflateEnd(value vzs)
value camlzip_update_crc32(value crc, value buf, value pos, value len)
{
return copy_int32(crc32((uint32) Int32_val(crc),
return caml_copy_int32(crc32((uint32) Int32_val(crc),
&Byte_u(buf, Long_val(pos)),
Long_val(len)));
}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment