src/utils/cdk/gzip.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                         The CamlZip library                         *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 2001 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the GNU Library General Public License.         *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id$ *)
  14
  15 (* Module [Gzip]: reading and writing to/from [gzip] compressed files *)
  16
  17 exception Error of string
  18
  19 let buffer_size = 1024
  20
  21 type in_channel =
  22   { in_chan: Pervasives.in_channel;
  23     in_buffer: string;
  24     mutable in_pos: int;
  25     mutable in_avail: int;
  26     mutable in_eof: bool;
  27     in_stream: Zlib.stream;
  28     mutable in_size: int32;
  29     mutable in_crc: int32 }
  30
  31 let open_in_chan ic =
  32   (* Superficial parsing of header *)
  33   begin try
  34     let id1 = input_byte ic in
  35     let id2 = input_byte ic in
  36     if id1 <> 0x1F || id2 <> 0x8B then
  37       raise(Error("bad magic number, not a gzip file"));
  38     let cm = input_byte ic in
  39     if cm <> 8 then
  40       raise(Error("unknown compression method"));
  41     let flags = input_byte ic in
  42     if flags land 0xE0 <> 0 then
  43       raise(Error("bad flags, not a gzip file"));
  44     for i = 1 to 6 do ignore(input_byte ic) done;
  45     if flags land 0x04 <> 0 then begin
  46       (* Skip extra data *)
  47       let len1 = input_byte ic in
  48       let len2 = input_byte ic in
  49       for i = 1 to len1 + len2 lsl 8 do ignore(input_byte ic) done
  50     end;
  51     if flags land 0x08 <> 0 then begin
  52       (* Skip original file name *)
  53       while input_byte ic <> 0 do () done
  54     end;
  55     if flags land 0x10 <> 0 then begin
  56       (* Skip comment *)
  57       while input_byte ic <> 0 do () done
  58     end;
  59     if flags land 0x02 <> 0 then begin
  60       (* Skip header CRC *)
  61       ignore(input_byte ic); ignore(input_byte ic)
  62     end
  63   with End_of_file ->
  64     raise(Error("premature end of file, not a gzip file"))
  65   end;
  66   { in_chan = ic;
  67     in_buffer = String.create buffer_size;
  68     in_pos = 0;
  69     in_avail = 0;
  70     in_eof = false;
  71     in_stream = Zlib.inflate_init false;
  72     in_size = Int32.zero;
  73     in_crc = Int32.zero }
  74
  75 let open_in filename =
  76   let ic = Pervasives.open_in_bin filename in
  77   try
  78     open_in_chan ic
  79   with e -> Pervasives.close_in ic; raise e
  80
  81 let read_byte iz =
  82   if iz.in_avail = 0 then begin
  83     let n = Pervasives.input iz.in_chan iz.in_buffer 0
  84                              (String.length iz.in_buffer) in
  85     if n = 0 then raise End_of_file;
  86     iz.in_pos <- 0;
  87     iz.in_avail <- n
  88   end;
  89   let c = iz.in_buffer.[iz.in_pos] in
  90   iz.in_pos <- iz.in_pos + 1;
  91   iz.in_avail <- iz.in_avail - 1;
  92   Char.code c
  93
  94 let read_int32 iz =
  95   let b1 = read_byte iz in
  96   let b2 = read_byte iz in
  97   let b3 = read_byte iz in
  98   let b4 = read_byte iz in
  99   Int32.logor (Int32.of_int b1)
 100     (Int32.logor (Int32.shift_left (Int32.of_int b2) 8)
 101       (Int32.logor (Int32.shift_left (Int32.of_int b3) 16)
 102                    (Int32.shift_left (Int32.of_int b4) 24)))
 103
 104 let rec input iz buf pos len =
 105   if pos < 0 || len < 0 || pos + len > String.length buf then
 106     invalid_arg "Gzip.input";
 107   if iz.in_eof then 0 else begin
 108     if iz.in_avail = 0 then begin
 109       let n = Pervasives.input iz.in_chan iz.in_buffer 0
 110                                (String.length iz.in_buffer) in
 111       if n = 0 then raise(Error("truncated file"));
 112       iz.in_pos <- 0;
 113       iz.in_avail <- n
 114     end;
 115     let (finished, used_in, used_out) =
 116       try
 117         Zlib.inflate iz.in_stream iz.in_buffer iz.in_pos iz.in_avail
 118                                    buf pos len Zlib.Z_SYNC_FLUSH
 119       with Zlib.Error(_, _) ->
 120         raise(Error("error during decompression")) in
 121     iz.in_pos <- iz.in_pos + used_in;
 122     iz.in_avail <- iz.in_avail - used_in;
 123     iz.in_crc <- Zlib.update_crc iz.in_crc buf pos used_out;
 124     iz.in_size <- Int32.add iz.in_size (Int32.of_int used_out);
 125     if finished then begin
 126       try
 127         let crc = read_int32 iz in
 128         let size = read_int32 iz in
 129         if iz.in_crc <> crc then
 130           raise(Error("CRC mismatch, data corrupted"));
 131         if iz.in_size <> size then
 132           raise(Error("size mismatch, data corrupted"));
 133         iz.in_eof <- true;
 134         used_out
 135       with End_of_file ->
 136         raise(Error("truncated file"))
 137     end
 138     else if used_out = 0 then
 139       input iz buf pos len
 140     else
 141       used_out
 142   end
 143
 144 let rec really_input iz buf pos len =
 145   if len <= 0 then () else begin
 146     let n = input iz buf pos len in
 147     if n = 0 then raise End_of_file;
 148     really_input iz buf (pos + n) (len - n)
 149   end
 150
 151 let char_buffer = String.create 1
 152
 153 let input_char iz =
 154   if input iz char_buffer 0 1 = 0 then raise End_of_file else char_buffer.[0]
 155
 156 let input_byte iz =
 157   Char.code (input_char iz)
 158
 159 let dispose iz =
 160   iz.in_eof <- true;
 161   Zlib.inflate_end iz.in_stream
 162
 163 let close_in iz =
 164   dispose iz;
 165   Pervasives.close_in iz.in_chan
 166
 167 type out_channel =
 168   { out_chan: Pervasives.out_channel;
 169     out_buffer: string;
 170     mutable out_pos: int;
 171     mutable out_avail: int;
 172     out_stream: Zlib.stream;
 173     mutable out_size: int32;
 174     mutable out_crc: int32 }
 175
 176 let open_out_chan ?(level = 6) oc =
 177   if level < 1 || level > 9 then invalid_arg "Gzip.open_out: bad level";
 178   (* Write minimal header *)
 179   output_byte oc 0x1F;                  (* ID1 *)
 180   output_byte oc 0x8B;                  (* ID2 *)
 181   output_byte oc 8;                     (* compression method *)
 182   output_byte oc 0;                     (* flags *)
 183   for i = 1 to 4 do output_byte oc 0 done; (* mtime *)
 184   output_byte oc 0;                     (* xflags *)
 185   output_byte oc 0xFF;                  (* OS (unknown) *)
 186   { out_chan = oc;
 187     out_buffer = String.create buffer_size;
 188     out_pos = 0;
 189     out_avail = buffer_size;
 190     out_stream = Zlib.deflate_init level false;
 191     out_size = Int32.zero;
 192     out_crc = Int32.zero }
 193
 194 let open_out ?(level = 6) filename =
 195   open_out_chan ~level (Pervasives.open_out_bin filename)
 196
 197 let rec output oz buf pos len =
 198   if pos < 0 || len < 0 || pos + len > String.length buf then
 199     invalid_arg "Gzip.output";
 200   (* If output buffer is full, flush it *)
 201   if oz.out_avail = 0 then begin
 202     Pervasives.output oz.out_chan oz.out_buffer 0 oz.out_pos;
 203     oz.out_pos <- 0;
 204     oz.out_avail <- String.length oz.out_buffer
 205   end;
 206   let (_, used_in, used_out) =
 207     try
 208       Zlib.deflate oz.out_stream buf pos len
 209                                  oz.out_buffer oz.out_pos oz.out_avail
 210                                  Zlib.Z_NO_FLUSH
 211     with Zlib.Error(_, _) ->
 212       raise (Error("error during compression")) in
 213   oz.out_pos <- oz.out_pos + used_out;
 214   oz.out_avail <- oz.out_avail - used_out;
 215   oz.out_size <- Int32.add oz.out_size (Int32.of_int used_in);
 216   oz.out_crc <- Zlib.update_crc oz.out_crc buf pos used_in;
 217   if used_in < len then output oz buf (pos + used_in) (len - used_in)
 218
 219 let output_char oz c =
 220   char_buffer.[0] <- c;
 221   output oz char_buffer 0 1
 222
 223 let output_byte oz b =
 224   output_char oz (Char.unsafe_chr b)
 225
 226 let write_int32 oc n =
 227   let r = ref n in
 228   for i = 1 to 4 do
 229     Pervasives.output_byte oc (Int32.to_int !r);
 230     r := Int32.shift_right_logical !r 8
 231   done
 232
 233 let flush oz =
 234   let rec do_flush () =
 235     (* If output buffer is full, flush it *)
 236     if oz.out_avail = 0 then begin
 237       Pervasives.output oz.out_chan oz.out_buffer 0 oz.out_pos;
 238       oz.out_pos <- 0;
 239       oz.out_avail <- String.length oz.out_buffer
 240     end;
 241     let (finished, _, used_out) =
 242       Zlib.deflate oz.out_stream oz.out_buffer 0 0
 243                                  oz.out_buffer oz.out_pos oz.out_avail
 244                                  Zlib.Z_FINISH in
 245     oz.out_pos <- oz.out_pos + used_out;
 246     oz.out_avail <- oz.out_avail - used_out;
 247     if not finished then do_flush() in
 248   do_flush();
 249   (* Final data flush *)
 250   if oz.out_pos > 0 then
 251     Pervasives.output oz.out_chan oz.out_buffer 0 oz.out_pos;
 252   (* Write CRC and size *)
 253   write_int32 oz.out_chan oz.out_crc;
 254   write_int32 oz.out_chan oz.out_size;
 255   (* Dispose of stream *)
 256   Zlib.deflate_end oz.out_stream
 257
 258 let close_out oz =
 259   flush oz;
 260   Pervasives.close_out oz.out_chan
 261