src/utils/cdk/zlibstubs.c

   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 /*
  14 This library is free software; you can redistribute it and/or
  15 modify it under the terms of the GNU Library General Public
  16 License as published by the Free Software Foundation; either
  17 version 2 of the License, or (at your option) any later version.
  18
  19 This library is distributed in the hope that it will be useful,
  20 but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 Library General Public License for more details.
  23
  24 You should have received a copy of the GNU Library General Public
  25 License along with this library; if not, write to the
  26 Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  27 Boston, MA  02110-1301, USA.
  28 */
  29
  30 /* $Id$ */
  31
  32 /* Stub code to interface with Zlib */
  33
  34 #include "../../../config/config.h"
  35
  36 #include <zlib.h>
  37
  38 #ifdef USE_BZIP2
  39 #include <bzlib.h>
  40 #endif
  41
  42 #include <caml/mlvalues.h>
  43 #include <caml/alloc.h>
  44 #include <caml/callback.h>
  45 #include <caml/fail.h>
  46 #include <caml/memory.h>
  47
  48 #define ZStream_val(v) ((z_stream *) (v))
  49
  50 static value * camlzip_error_exn = NULL;
  51
  52 static void camlzip_error(char * fn, value vzs)
  53 {
  54   char * msg;
  55   value s1 = Val_unit, s2 = Val_unit, bucket = Val_unit;
  56
  57   msg = ZStream_val(vzs)->msg;
  58   if (msg == NULL) msg = "";
  59   if (camlzip_error_exn == NULL) {
  60     camlzip_error_exn = caml_named_value("Zlib.Error");
  61     if (camlzip_error_exn == NULL)
  62       invalid_argument("Exception Zlib.Error not initialized");
  63   }
  64   Begin_roots3(s1, s2, bucket);
  65     s1 = copy_string(fn);
  66     s2 = copy_string(msg);
  67     bucket = alloc_small(3, 0);
  68     Field(bucket, 0) = *camlzip_error_exn;
  69     Field(bucket, 1) = s1;
  70     Field(bucket, 2) = s2;
  71   End_roots();
  72   mlraise(bucket);
  73 }
  74
  75 static value camlzip_new_stream(void)
  76 {
  77   z_stream * zs = (z_stream *) malloc(sizeof(z_stream));
  78   zs->zalloc = NULL;
  79   zs->zfree = NULL;
  80   zs->opaque = NULL;
  81   zs->next_in = NULL;
  82   zs->next_out = NULL;
  83   return (value) zs;
  84 }
  85
  86 value camlzip_deflateInit(value vlevel, value expect_header)
  87 {
  88   value vzs = camlzip_new_stream();
  89   if (deflateInit2(ZStream_val(vzs),
  90                    Int_val(vlevel),
  91                    Z_DEFLATED,
  92                    Bool_val(expect_header) ? MAX_WBITS : -MAX_WBITS,
  93                    8,
  94                    Z_DEFAULT_STRATEGY) != Z_OK)
  95     camlzip_error("Zlib.deflateInit", vzs);
  96   return vzs;
  97 }
  98
  99 static int camlzip_flush_table[] =
 100 { Z_NO_FLUSH, Z_SYNC_FLUSH, Z_FULL_FLUSH, Z_FINISH };
 101
 102 value camlzip_deflate(value vzs, value srcbuf, value srcpos, value srclen,
 103                       value dstbuf, value dstpos, value dstlen,
 104                       value vflush)
 105 {
 106   z_stream * zs = ZStream_val(vzs);
 107   int retcode;
 108   long used_in, used_out;
 109   value res;
 110
 111   zs->next_in = &Byte_u(srcbuf, Long_val(srcpos));
 112   zs->avail_in = Long_val(srclen);
 113   zs->next_out = &Byte_u(dstbuf, Long_val(dstpos));
 114   zs->avail_out = Long_val(dstlen);
 115   retcode = deflate(zs, camlzip_flush_table[Int_val(vflush)]);
 116   if (retcode < 0) camlzip_error("Zlib.deflate", vzs);
 117   used_in = Long_val(srclen) - zs->avail_in;
 118   used_out = Long_val(dstlen) - zs->avail_out;
 119   zs->next_in = NULL;         /* not required, but cleaner */
 120   zs->next_out = NULL;        /* (avoid dangling pointers into Caml heap) */
 121   res = alloc_small(3, 0);
 122   Field(res, 0) = Val_bool(retcode == Z_STREAM_END);
 123   Field(res, 1) = Val_int(used_in);
 124   Field(res, 2) = Val_int(used_out);
 125   return res;
 126 }
 127
 128 value camlzip_deflate_bytecode(value * arg, int nargs)
 129 {
 130   return camlzip_deflate(arg[0], arg[1], arg[2], arg[3],
 131                          arg[4], arg[5], arg[6], arg[7]);
 132 }
 133
 134 value camlzip_deflateEnd(value vzs)
 135 {
 136   if (deflateEnd(ZStream_val(vzs)) != Z_OK)
 137     camlzip_error("Zlib.deflateEnd", vzs);
 138   free(ZStream_val(vzs));
 139   return Val_unit;
 140 }
 141
 142 value camlzip_inflateInit(value expect_header)
 143 {
 144   value vzs = camlzip_new_stream();
 145   if (inflateInit2(ZStream_val(vzs),
 146                    Bool_val(expect_header) ? MAX_WBITS : -MAX_WBITS) != Z_OK)
 147     camlzip_error("Zlib.inflateInit", vzs);
 148   return vzs;
 149 }
 150
 151 value camlzip_inflate(value vzs, value srcbuf, value srcpos, value srclen,
 152                       value dstbuf, value dstpos, value dstlen,
 153                       value vflush)
 154 {
 155   z_stream * zs = ZStream_val(vzs);
 156   int retcode;
 157   long used_in, used_out;
 158   value res;
 159
 160   zs->next_in = &Byte_u(srcbuf, Long_val(srcpos));
 161   zs->avail_in = Long_val(srclen);
 162   zs->next_out = &Byte_u(dstbuf, Long_val(dstpos));
 163   zs->avail_out = Long_val(dstlen);
 164   retcode = inflate(zs, camlzip_flush_table[Int_val(vflush)]);
 165   if (retcode < 0 || retcode == Z_NEED_DICT)
 166     camlzip_error("Zlib.inflate", vzs);
 167   used_in = Long_val(srclen) - zs->avail_in;
 168   used_out = Long_val(dstlen) - zs->avail_out;
 169   zs->next_in = NULL;           /* not required, but cleaner */
 170   zs->next_out = NULL;          /* (avoid dangling pointers into Caml heap) */
 171   res = alloc_small(3, 0);
 172   Field(res, 0) = Val_bool(retcode == Z_STREAM_END);
 173   Field(res, 1) = Val_int(used_in);
 174   Field(res, 2) = Val_int(used_out);
 175   return res;
 176 }
 177
 178 value camlzip_inflate_bytecode(value * arg, int nargs)
 179 {
 180   return camlzip_inflate(arg[0], arg[1], arg[2], arg[3],
 181                          arg[4], arg[5], arg[6], arg[7]);
 182 }
 183
 184 value camlzip_inflateEnd(value vzs)
 185 {
 186   if (inflateEnd(ZStream_val(vzs)) != Z_OK)
 187     camlzip_error("Zlib.inflateEnd", vzs);
 188   free(ZStream_val(vzs));
 189   return Val_unit;
 190 }
 191
 192 value camlzip_update_crc32(value crc, value buf, value pos, value len)
 193 {
 194   return copy_int32(crc32((uint32) Int32_val(crc),
 195                           &Byte_u(buf, Long_val(pos)),
 196                           Long_val(len)));
 197 }
 198
 199 /* Bzip2 interface code */
 200
 201 #define BZStream_val(v) ((bz_stream *) (v))
 202
 203 static value * camlzip_bzerror_exn = NULL;
 204
 205 #ifdef USE_BZIP2
 206 static void camlzip_bzerror(char * fn, int err)
 207 {
 208   char * msg;
 209   value s1 = Val_unit, s2 = Val_unit, bucket = Val_unit;
 210
 211   if (camlzip_bzerror_exn == NULL) {
 212     camlzip_bzerror_exn = caml_named_value("Bzlib.Error");
 213     if (camlzip_bzerror_exn == NULL)
 214       invalid_argument("Exception Bzlib.Error not initialized");
 215   }
 216   Begin_roots3(s1, s2, bucket);
 217     s1 = copy_string(fn);
 218     switch (err) {
 219     case BZ_CONFIG_ERROR:
 220       s2 = Val_int(0);
 221       break;
 222     case BZ_SEQUENCE_ERROR:
 223       s2 = Val_int(1);
 224       break;
 225     case BZ_PARAM_ERROR:
 226       s2 = Val_int(2);
 227       break;
 228     case BZ_MEM_ERROR:
 229       s2 = Val_int(3);
 230       break;
 231     case BZ_DATA_ERROR:
 232       s2 = Val_int(4);
 233       break;
 234     case BZ_DATA_ERROR_MAGIC:
 235       s2 = Val_int(5);
 236       break;
 237     default:
 238       s2 = Val_int(6);
 239     }
 240     bucket = alloc_small(3, 0);
 241     Field(bucket, 0) = *camlzip_bzerror_exn;
 242     Field(bucket, 1) = s1;
 243     Field(bucket, 2) = s2;
 244   End_roots();
 245   mlraise(bucket);
 246 }
 247
 248 static value camlzip_new_bzstream(void)
 249 {
 250   bz_stream * bzs = (bz_stream *) malloc(sizeof(bz_stream));
 251   bzs->bzalloc = NULL;
 252   bzs->bzfree = NULL;
 253   bzs->opaque = NULL;
 254   bzs->next_in = NULL;
 255   bzs->next_out = NULL;
 256   return (value) bzs;
 257 }
 258
 259 int camlzip_action_table[] = { BZ_RUN, BZ_FLUSH, BZ_FINISH };
 260 #endif
 261
 262
 263 value camlzip_bzCompressInit(value blockSize100k, value verbosity, value workFactor) {
 264 #ifdef USE_BZIP2
 265   int err;
 266   value vbzs = camlzip_new_bzstream();
 267   if ((err = BZ2_bzCompressInit(BZStream_val(vbzs),
 268                          Int_val(blockSize100k),
 269                          Int_val(verbosity),
 270                          Int_val(workFactor))) != BZ_OK)
 271     camlzip_bzerror("Zlib.deflateInit", err);
 272   return vbzs;
 273 #else
 274   failwith("Bzip2 compression not supported.");
 275 #endif
 276 }
 277
 278 value camlzip_bzCompress(value vzs, value srcbuf, value srcpos, value srclen,
 279                       value dstbuf, value dstpos, value dstlen,
 280                       value vflush)
 281 {
 282 #ifdef USE_BZIP2
 283   bz_stream * zs = BZStream_val(vzs);
 284   int retcode;
 285   long used_in, used_out;
 286   value res;
 287
 288   zs->next_in = &Byte(srcbuf, Long_val(srcpos));
 289   zs->avail_in = Long_val(srclen);
 290   zs->next_out = &Byte(dstbuf, Long_val(dstpos));
 291   zs->avail_out = Long_val(dstlen);
 292   retcode = BZ2_bzCompress(zs, camlzip_action_table[Int_val(vflush)]);
 293   if (retcode < 0) camlzip_bzerror("Bzlib.compress", retcode);
 294   used_in = Long_val(srclen) - zs->avail_in;
 295   used_out = Long_val(dstlen) - zs->avail_out;
 296   zs->next_in = NULL;         /* not required, but cleaner */
 297   zs->next_out = NULL;        /* (avoid dangling pointers into Caml heap) */
 298   res = alloc_small(3, 0);
 299   Field(res, 0) = Val_bool(retcode == BZ_STREAM_END);
 300   Field(res, 1) = Val_int(used_in);
 301   Field(res, 2) = Val_int(used_out);
 302   return res;
 303 #else
 304   failwith("Bzip2 compression not supported");
 305 #endif
 306 }
 307
 308 value camlzip_bzCompress_bytecode(value * arg, int nargs)
 309 {
 310   return camlzip_bzCompress(arg[0], arg[1], arg[2], arg[3],
 311                          arg[4], arg[5], arg[6], arg[7]);
 312 }
 313
 314 value camlzip_bzCompressEnd(value stream) {
 315 #ifdef USE_BZIP2
 316   int err;
 317   if ((err = BZ2_bzCompressEnd(BZStream_val(stream))) != BZ_OK)
 318     camlzip_bzerror("Bzlib.compress_end", err);
 319   free(BZStream_val(stream));
 320 #else
 321   failwith("Bzip2 compression not supported");
 322 #endif
 323   return Val_unit;
 324 }
 325
 326 value camlzip_bzDecompressInit(value verbosity, value small)
 327 {
 328 #ifdef USE_BZIP2
 329   int err;
 330   value vzs = camlzip_new_bzstream();
 331   if ((err = BZ2_bzDecompressInit(BZStream_val(vzs), Int_val(verbosity), Bool_val(small))) != BZ_OK)
 332     camlzip_bzerror("Bzlib.decompress_init", err);
 333   return vzs;
 334 #else
 335   failwith("Bzip2 compression not supported");
 336 #endif
 337 }
 338
 339 value camlzip_bzDecompress(value vzs, value srcbuf, value srcpos, value srclen,
 340                            value dstbuf, value dstpos, value dstlen)
 341 {
 342 #ifdef USE_BZIP2
 343   bz_stream * zs = BZStream_val(vzs);
 344   int retcode;
 345   long used_in, used_out;
 346   value res;
 347
 348   zs->next_in = &Byte(srcbuf, Long_val(srcpos));
 349   zs->avail_in = Long_val(srclen);
 350   zs->next_out = &Byte(dstbuf, Long_val(dstpos));
 351   zs->avail_out = Long_val(dstlen);
 352   retcode = BZ2_bzDecompress(zs);
 353   if (retcode < 0)
 354     camlzip_bzerror("Bzlib.decompress", retcode);
 355   used_in = Long_val(srclen) - zs->avail_in;
 356   used_out = Long_val(dstlen) - zs->avail_out;
 357   zs->next_in = NULL;           /* not required, but cleaner */
 358   zs->next_out = NULL;          /* (avoid dangling pointers into Caml heap) */
 359   res = alloc_small(3, 0);
 360   Field(res, 0) = Val_bool(retcode == BZ_STREAM_END);
 361   Field(res, 1) = Val_int(used_in);
 362   Field(res, 2) = Val_int(used_out);
 363   return res;
 364 #else
 365   failwith("Bzip2 compression not supported");
 366 #endif
 367 }
 368
 369 value camlzip_bzDecompress_bytecode(value * arg, int nargs)
 370 {
 371   return camlzip_bzDecompress(arg[0], arg[1], arg[2], arg[3],
 372                          arg[4], arg[5], arg[6]);
 373 }
 374
 375 value camlzip_bzDecompressEnd(value stream) {
 376 #ifdef USE_BZIP2
 377   int err;
 378   if ((err = BZ2_bzDecompressEnd(BZStream_val(stream))) != BZ_OK)
 379     camlzip_bzerror("Bzlib.decompressEnd", err);
 380   free(BZStream_val(stream));
 381 #else
 382   failwith("Bzip2 compression not supported");
 383 #endif
 384   return Val_unit;
 385 }
 386
 387 int camlzip_zlibversion(void)
 388 {
 389   CAMLparam0 ();
 390   CAMLlocal1 (v);
 391 #ifdef HAVE_ZLIBVERSION
 392   v = copy_string (zlibVersion());
 393   CAMLreturn (v);
 394 #else
 395   failwith("zlibVersion not found");
 396 #endif
 397 }
 398
 399 int camlzip_bzlibversion(void)
 400 {
 401   CAMLparam0 ();
 402   CAMLlocal1 (v);
 403 #ifdef HAVE_BZLIBVERSION
 404   v = copy_string (BZ2_bzlibVersion());
 405   CAMLreturn (v);
 406 #else
 407   failwith("bzlibVersion not found");
 408 #endif
 409 }