/* Written by Jean-Claude Wippler, as part of Tclkit. * March 2003 - placed in the public domain by the author. * * Interface to the "zlib" compression library */ #include #if 10 * TCL_MAJOR_VERSION + TCL_MINOR_VERSION < 86 #include "zlib.h" typedef struct { z_stream stream; Tcl_Obj *indata; } zlibstream; static int zstreamincmd(ClientData cd, Tcl_Interp *ip, int objc, Tcl_Obj *CONST objv[]) { zlibstream *zp = (zlibstream*) cd; int count = 0; int e, index; Tcl_Obj *obj; static CONST84 char* cmds[] = { "fill", "drain", NULL, }; if (Tcl_GetIndexFromObj(ip, objv[1], cmds, "option", 0, &index) != TCL_OK) return TCL_ERROR; switch (index) { case 0: /* fill ?data? */ if (objc >= 3) { Tcl_IncrRefCount(objv[2]); Tcl_DecrRefCount(zp->indata); zp->indata = objv[2]; zp->stream.next_in = Tcl_GetByteArrayFromObj(zp->indata, (int*) &zp->stream.avail_in); } Tcl_SetObjResult(ip, Tcl_NewIntObj(zp->stream.avail_in)); break; case 1: /* drain count */ if (objc != 3) { Tcl_WrongNumArgs(ip, 2, objv, "count"); return TCL_ERROR; } if (Tcl_GetIntFromObj(ip, objv[2], &count) != TCL_OK) return TCL_ERROR; obj = Tcl_GetObjResult(ip); Tcl_SetByteArrayLength(obj, count); zp->stream.next_out = Tcl_GetByteArrayFromObj(obj, (int*) &zp->stream.avail_out); e = inflate(&zp->stream, Z_NO_FLUSH); if (e != 0 && e != Z_STREAM_END) { Tcl_SetResult(ip, (char*) zError(e), TCL_STATIC); return TCL_ERROR; } Tcl_SetByteArrayLength(obj, count - zp->stream.avail_out); break; } return TCL_OK; } void zstreamdelproc(ClientData cd) { zlibstream *zp = (zlibstream*) cd; inflateEnd(&zp->stream); Tcl_DecrRefCount(zp->indata); Tcl_Free((void*) zp); } static int ZlibCmd(ClientData dummy, Tcl_Interp *ip, int objc, Tcl_Obj *CONST objv[]) { int e = TCL_OK, index, dlen, wbits = -MAX_WBITS; long flag; Byte *data; z_stream stream; Tcl_Obj *obj = Tcl_GetObjResult(ip); static CONST84 char* cmds[] = { "adler32", "crc32", "compress", "deflate", "decompress", "inflate", "sdecompress", "sinflate", NULL, }; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(ip, 1, objv, "option data ?...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(ip, objv[1], cmds, "option", 0, &index) != TCL_OK || objc > 3 && Tcl_GetLongFromObj(ip, objv[3], &flag) != TCL_OK) return TCL_ERROR; data = Tcl_GetByteArrayFromObj(objv[2], &dlen); switch (index) { case 0: /* adler32 str ?start? -> checksum */ if (objc < 4) flag = (long) adler32(0, 0, 0); Tcl_SetLongObj(obj, (long) adler32((uLong) flag, data, dlen)); return TCL_OK; case 1: /* crc32 str ?start? -> checksum */ if (objc < 4) flag = (long) crc32(0, 0, 0); Tcl_SetLongObj(obj, (long) crc32((uLong) flag, data, dlen)); return TCL_OK; case 2: /* compress data ?level? -> data */ wbits = MAX_WBITS; case 3: /* deflate data ?level? -> data */ if (objc < 4) flag = Z_DEFAULT_COMPRESSION; stream.avail_in = (uInt) dlen; stream.next_in = data; stream.avail_out = (uInt) dlen + dlen / 1000 + 12; Tcl_SetByteArrayLength(obj, stream.avail_out); stream.next_out = Tcl_GetByteArrayFromObj(obj, NULL); stream.zalloc = 0; stream.zfree = 0; stream.opaque = 0; e = deflateInit2(&stream, (int) flag, Z_DEFLATED, wbits, MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY); if (e != Z_OK) break; e = deflate(&stream, Z_FINISH); if (e != Z_STREAM_END) { deflateEnd(&stream); if (e == Z_OK) e = Z_BUF_ERROR; } else e = deflateEnd(&stream); break; case 4: /* decompress data ?bufsize? -> data */ wbits = MAX_WBITS; case 5: /* inflate data ?bufsize? -> data */ { if (objc < 4) flag = 16 * 1024; for (;;) { stream.zalloc = 0; stream.zfree = 0; /* +1 because ZLIB can "over-request" input (but ignore it) */ stream.avail_in = (uInt) dlen + 1; stream.next_in = data; stream.avail_out = (uInt) flag; Tcl_SetByteArrayLength(obj, stream.avail_out); stream.next_out = Tcl_GetByteArrayFromObj(obj, NULL); /* Negative value suppresses ZLIB header */ e = inflateInit2(&stream, wbits); if (e == Z_OK) { e = inflate(&stream, Z_FINISH); if (e != Z_STREAM_END) { inflateEnd(&stream); if (e == Z_OK) e = Z_BUF_ERROR; } else e = inflateEnd(&stream); } if (e == Z_OK || e != Z_BUF_ERROR) break; Tcl_SetByteArrayLength(obj, 0); flag *= 2; } break; } case 6: /* sdecompress cmdname -> */ wbits = MAX_WBITS; case 7: /* sinflate cmdname -> */ { zlibstream *zp = (zlibstream*) Tcl_Alloc(sizeof (zlibstream)); zp->indata = Tcl_NewObj(); Tcl_IncrRefCount(zp->indata); zp->stream.zalloc = 0; zp->stream.zfree = 0; zp->stream.opaque = 0; zp->stream.next_in = 0; zp->stream.avail_in = 0; inflateInit2(&zp->stream, wbits); Tcl_CreateObjCommand(ip, Tcl_GetStringFromObj(objv[2], 0), zstreamincmd, (ClientData) zp, zstreamdelproc); return TCL_OK; } } if (e != Z_OK) { Tcl_SetResult(ip, (char*) zError(e), TCL_STATIC); return TCL_ERROR; } Tcl_SetByteArrayLength(obj, stream.total_out); return TCL_OK; } int Zlib_Init(Tcl_Interp *interp) { Tcl_CreateObjCommand(interp, "zlib", ZlibCmd, 0, 0); return Tcl_PkgProvide( interp, "zlib", "1.1"); } #endif /* Tcl version less than 8.6 */