summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2008-12-11 01:21:52 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2008-12-11 01:21:52 (GMT)
commit540cbc7ddbd0d20c638a9cc9dbcb1b608b661f0e (patch)
treec49375210a3dc50aed061ef11fbb81eb599dcdad /generic
parent9a623e586804e09002c18013b7e993cf3abfd5fc (diff)
downloadtcl-540cbc7ddbd0d20c638a9cc9dbcb1b608b661f0e.zip
tcl-540cbc7ddbd0d20c638a9cc9dbcb1b608b661f0e.tar.gz
tcl-540cbc7ddbd0d20c638a9cc9dbcb1b608b661f0e.tar.bz2
First hack at TIP#234
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.decls53
-rw-r--r--generic/tcl.h46
-rw-r--r--generic/tclBasic.c6
-rw-r--r--generic/tclInt.h3
-rw-r--r--generic/tclZlib.c2567
5 files changed, 2669 insertions, 6 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 9bf31ff..8f6a438 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: tcl.decls,v 1.158 2008/12/09 20:16:29 dgp Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.159 2008/12/11 01:21:52 dkf Exp $
library tcl
@@ -2198,7 +2198,7 @@ declare 604 generic {
int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv)
}
-# TIP 336 (manipulate the error line)
+# TIP#336 (manipulate the error line)
declare 605 generic {
int Tcl_GetErrorLine(Tcl_Interp *interp)
}
@@ -2217,11 +2217,54 @@ declare 608 generic {
int Tcl_InterpActive(Tcl_Interp *interp)
}
-# TIP 337
+# TIP#337 (log exception for background processing)
declare 609 generic {
void Tcl_BackgroundException(Tcl_Interp *interp, int code)
}
+# TIP#234 (zlib interface)
+declare 610 generic {
+ int Tcl_ZlibDeflate(Tcl_Interp *interp, int format, Tcl_Obj *data,
+ int level);
+}
+declare 611 generic {
+ int Tcl_ZlibInflate(Tcl_Interp *interp, int format, Tcl_Obj *data,
+ int buffersize);
+}
+declare 612 generic {
+ unsigned int Tcl_ZlibCRC32(unsigned int crc, const char *buf,
+ unsigned int len);
+}
+declare 613 generic {
+ unsigned int Tcl_ZlibAdler32(unsigned int adler, const char *buf,
+ unsigned int len);
+}
+declare 614 generic {
+ int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format,
+ int level, Tcl_ZlibStream *zshandle);
+}
+declare 615 generic {
+ Tcl_Obj *Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle);
+}
+declare 616 generic {
+ int Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle);
+}
+declare 617 generic {
+ int Tcl_ZlibStreamAdler32(Tcl_ZlibStream zshandle);
+}
+declare 618 generic {
+ int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush);
+}
+declare 619 generic {
+ int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data, int count);
+}
+declare 620 generic {
+ int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle);
+}
+declare 621 generic {
+ int Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle);
+}
+
##############################################################################
# Define the platform specific public Tcl interface. These functions are only
@@ -2274,3 +2317,7 @@ export {
export {
void Tcl_GetMemoryInfo(Tcl_DString *dsPtr)
}
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/generic/tcl.h b/generic/tcl.h
index c99ad44..7ff25c7 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tcl.h,v 1.280 2008/12/02 19:40:41 dgp Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.281 2008/12/11 01:21:52 dkf Exp $
*/
#ifndef _TCL
@@ -503,6 +503,7 @@ typedef struct Tcl_ThreadId_ *Tcl_ThreadId;
typedef struct Tcl_TimerToken_ *Tcl_TimerToken;
typedef struct Tcl_Trace_ *Tcl_Trace;
typedef struct Tcl_Var_ *Tcl_Var;
+typedef struct Tcl_ZLibStream_ *Tcl_ZlibStream;
typedef void *Tcl_ThreadDataKey;
@@ -2251,6 +2252,49 @@ typedef int (*Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp,
{TCL_ARGV_END}
/*
+ *----------------------------------------------------------------------------
+ * Definitions needed for Tcl_Zlib routines. [TIP #234]
+ *----------------------------------------------------------------------------
+ *
+ * Constants for the format flags describing what sort of data format is
+ * desired/expected for the Tcl_ZlibDeflate, Tcl_ZlibInflate and
+ * Tcl_ZlibStreamInit functions.
+ */
+
+#define TCL_ZLIB_FORMAT_RAW 1
+#define TCL_ZLIB_FORMAT_ZLIB 2
+#define TCL_ZLIB_FORMAT_GZIP 4
+#define TCL_ZLIB_FORMAT_AUTO 8
+
+/*
+ * Constants that describe whether the stream is to operate in compressing or
+ * decompressing mode. The scripted level doesn't use pass-through mode.
+ */
+
+#define TCL_ZLIB_STREAM_PASS 0
+#define TCL_ZLIB_STREAM_DEFLATE 16
+#define TCL_ZLIB_STREAM_INFLATE 32
+
+/*
+ * Constants giving compression levels. Use of TCL_ZLIB_COMPRESS_DEFAULT is
+ * recommended.
+ */
+
+#define TCL_ZLIB_COMPRESS_NONE 0
+#define TCL_ZLIB_COMPRESS_FAST 1
+#define TCL_ZLIB_COMPRESS_BEST 9
+#define TCL_ZLIB_COMPRESS_DEFAULT (-1)
+
+/*
+ * Constants for types of flushing, used with Tcl_ZlibFlush.
+ */
+
+#define TCL_ZLIB_NO_FLUSH 0
+#define TCL_ZLIB_FLUSH 2
+#define TCL_ZLIB_FULLFLUSH 3
+#define TCL_ZLIB_FINALIZE 4
+
+/*
* The following constant is used to test for older versions of Tcl in the
* stubs tables.
*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index cf618c7..c8928ec 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.375 2008/12/05 21:38:47 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.376 2008/12/11 01:21:52 dkf Exp $
*/
#include "tclInt.h"
@@ -914,6 +914,10 @@ Tcl_CreateInterp(void)
Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
}
+ if (TclZlibInit(interp) != TCL_OK) {
+ Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
+ }
+
TOP_CB(iPtr) = NULL;
return interp;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index e373a6c..7e3d1e4 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.409 2008/12/10 18:21:47 ferrieux Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.410 2008/12/11 01:21:52 dkf Exp $
*/
#ifndef _TCLINT
@@ -2847,6 +2847,7 @@ MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
#endif
MODULE_SCOPE Tcl_Obj * TclDisassembleByteCodeObj(Tcl_Obj *objPtr);
+MODULE_SCOPE int TclZlibInit(Tcl_Interp *interp);
MODULE_SCOPE void * TclpThreadCreateKey(void);
MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
new file mode 100644
index 0000000..bdccaeb
--- /dev/null
+++ b/generic/tclZlib.c
@@ -0,0 +1,2567 @@
+/*
+ * tclZlib.c --
+ *
+ * This file provides the interface to the Zlib library.
+ *
+ * Copyright (C) 2004, 2005 Pascal Scheffers <pascal@scheffers.net>
+ * Copyright (C) 2005 Unitas Software B.V.
+ * Copyright (c) 2008 Donal K. Fellows
+ *
+ * Parts written by Jean-Claude Wippler, as part of Tclkit, placed in the
+ * public domain March 2003.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclZlib.c,v 1.1 2008/12/11 01:21:52 dkf Exp $
+ */
+
+#if 0
+#include "tclInt.h"
+#include <zlib.h>
+
+typedef struct {
+ z_stream stream;
+ gz_header header;
+ Tcl_Interp *interp;
+ Tcl_Command cmd;
+
+} StreamInfo;
+typedef struct ThreadSpecificData {
+ int counter;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey tsdKey;
+
+static void ConvertError(Tcl_Interp *interp, int code);
+static int GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
+ gz_header *headerPtr);
+static void ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);
+static int ZlibStream(ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static void DeleteStream(ClientData clientData);
+// TODO: Write streaming C API
+// TODO: Write Tcl API
+
+static void
+ConvertError(
+ Tcl_Interp *interp,
+ int code)
+{
+ if (interp == NULL) {
+ return;
+ }
+
+ if (code == Z_ERRNO) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp),-1));
+ } else {
+ const char *codeStr;
+ char codeStr2[TCL_INTEGER_SPACE];
+
+ switch (code) {
+ case Z_STREAM_ERROR: codeStr = "STREAM"; break;
+ case Z_DATA_ERROR: codeStr = "DATA"; break;
+ case Z_MEM_ERROR: codeStr = "MEM"; break;
+ case Z_BUF_ERROR: codeStr = "BUF"; break;
+ case Z_VERSION_ERROR: codeStr = "VERSION"; break;
+ default:
+ codeStr = "unknown";
+ sprintf(codeStr2, "%d", code);
+ break;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZLIB", codeStr, codeStr2, NULL);
+ }
+}
+
+static inline int
+GetValue(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictObj,
+ const char *nameStr,
+ Tcl_Obj **valuePtrPtr)
+{
+ Tcl_Obj *name = Tcl_NewStringObj(nameStr, -1);
+ int result = Tcl_DictObjGet(interp, dictObj, name, valuePtrPtr);
+
+ TclDecrRefCount(name);
+ return result;
+}
+
+static int
+GenerateHeader(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictObj,
+ gz_header *headerPtr)
+{
+ Tcl_Obj *value;
+ static const char *types[] = {
+ "binary", "text"
+ };
+
+ if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (value != NULL) {
+ headerPtr->comment = (Bytef *) Tcl_GetString(value);
+ }
+
+ if (GetValue(interp, dictObj, "crc", &value) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (value != NULL &&
+ Tcl_GetBooleanFromObj(interp, value, &headerPtr->hcrc)) {
+ return TCL_ERROR;
+ }
+
+ if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (value != NULL) {
+ headerPtr->name = (Bytef *) Tcl_GetString(value);
+ }
+
+ if (GetValue(interp, dictObj, "os", &value) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (value != NULL &&
+ Tcl_GetIntFromObj(interp, value, &headerPtr->os) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Ignore the 'size' field.
+ */
+
+ if (GetValue(interp, dictObj, "time", &value) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (value != NULL && Tcl_GetLongFromObj(interp, value,
+ (long *) &headerPtr->time) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (GetValue(interp, dictObj, "type", &value) != TCL_OK) {
+ return TCL_ERROR;
+ } else if (value != NULL && Tcl_GetIndexFromObj(interp, value, types,
+ "type", TCL_EXACT, &headerPtr->text) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+static inline void
+SetValue(
+ Tcl_Obj *dictObj,
+ const char *key,
+ Tcl_Obj *value)
+{
+ Tcl_Obj *keyObj = Tcl_NewStringObj(key, -1);
+
+ Tcl_IncrRefCount(keyObj);
+ Tcl_DictObjPut(NULL, dictObj, keyObj, value);
+ TclDecrRefCount(keyObj);
+}
+
+static void
+ExtractHeader(
+ gz_header *headerPtr,
+ Tcl_Obj *dictObj)
+{
+ if (headerPtr->comment != Z_NULL) {
+ SetValue(dictObj, "comment",
+ Tcl_NewStringObj((char *) headerPtr->comment, -1));
+ }
+ SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
+ if (headerPtr->name != Z_NULL) {
+ SetValue(dictObj, "filename",
+ Tcl_NewStringObj((char *) headerPtr->name, -1));
+ }
+ if (headerPtr->os != 255) {
+ SetValue(dictObj, "os", Tcl_NewIntObj(headerPtr->os));
+ }
+ if (headerPtr->time != 0 /* magic - no time */) {
+ SetValue(dictObj, "time", Tcl_NewLongObj((long) headerPtr->time));
+ }
+ if (headerPtr->text != Z_UNKNOWN) {
+ SetValue(dictObj, "type",
+ Tcl_NewStringObj(headerPtr->text ? "text" : "binary", -1));
+ }
+}
+
+Tcl_Obj *
+Tcl_ZlibDeflate(
+ Tcl_Interp *interp,
+ int format,
+ Tcl_Obj *dataObj,
+ int level,
+ Tcl_Obj *dictObj)
+{
+ int rawLength;
+ unsigned char *rawBytes = Tcl_GetByteArrayFromObj(dataObj, &rawLength);
+ z_stream stream;
+ gz_header header, *headerPtr = NULL;
+ Tcl_Obj *outObj = Tcl_NewObj();
+ int code, bits;
+
+ switch (format) {
+ case TCL_ZLIB_FORMAT_RAW:
+ bits = -15;
+ break;
+ case TCL_ZLIB_FORMAT_ZLIB:
+ bits = 15;
+ break;
+ case TCL_ZLIB_FORMAT_GZIP:
+ bits = 15 | /* gzip magic */ 16;
+ if (dictObj != NULL) {
+ headerPtr = &header;
+ memset(headerPtr, 0, sizeof(gz_header));
+ if (GenerateHeader(interp, dictObj, headerPtr) != TCL_OK) {
+ Tcl_DecrRefCount(outObj);
+ return NULL;
+ }
+ }
+ break;
+ default:
+ Tcl_Panic("bad compression format: %d", format);
+ return NULL;
+ }
+
+ stream.avail_in = (uInt) rawLength;
+ stream.next_in = rawBytes;
+ stream.avail_out = (uInt) rawLength + rawLength/1000 + 12;
+ stream.next_out = Tcl_SetByteArrayLength(outObj, stream.avail_out);
+ stream.zalloc = NULL;
+ stream.zfree = NULL;
+ stream.opaque = NULL;
+
+ code = deflateInit2(&stream, level, Z_DEFLATED, bits, MAX_MEM_LEVEL,
+ Z_DEFAULT_STRATEGY);
+ if (code != Z_OK) {
+ goto error;
+ }
+ if (headerPtr != NULL) {
+ deflateSetHeader(&stream, headerPtr);
+ if (code != Z_OK) {
+ goto error;
+ }
+ }
+ code = deflate(&stream, Z_FINISH);
+ if (code != Z_STREAM_END) {
+ deflateEnd(&stream);
+ if (code == Z_OK) {
+ code = Z_BUF_ERROR;
+ }
+ } else {
+ code = deflateEnd(&stream);
+ }
+
+ if (code == Z_OK) {
+ Tcl_SetByteArrayLength(outObj, stream.total_out);
+ return outObj;
+ }
+
+ error:
+ Tcl_DecrRefCount(outObj);
+ ConvertError(interp, code);
+ return NULL;
+}
+
+Tcl_Obj *
+Tcl_ZlibInflate(
+ Tcl_Interp *interp,
+ int format,
+ Tcl_Obj *dataObj,
+ Tcl_Obj *dictObj)
+{
+ int compressedLength;
+ unsigned char *compressedBytes =
+ Tcl_GetByteArrayFromObj(dataObj, &compressedLength);
+ z_stream stream;
+ gz_header header, *headerPtr = NULL;
+ Tcl_Obj *outObj = Tcl_NewObj();
+ unsigned int outSize = 16 * 1024;
+ int code = Z_BUF_ERROR, bits;
+ char *nameBuf = NULL, *commentBuf = NULL;
+
+ stream.avail_in = (uInt) compressedLength + 1;
+ stream.next_in = compressedBytes;
+ stream.opaque = NULL;
+
+ switch (format) {
+ case TCL_ZLIB_FORMAT_RAW:
+ bits = -15;
+ break;
+ case TCL_ZLIB_FORMAT_ZLIB:
+ bits = 15;
+ break;
+ case TCL_ZLIB_FORMAT_GZIP:
+ bits = 15 | /* gzip magic */ 16;
+ if (dictObj != NULL) {
+ goto allocHeader;
+ }
+ break;
+ case TCL_ZLIB_FORMAT_AUTO:
+ bits = 15 | /* auto magic */ 32;
+ if (dictObj != NULL) {
+ allocHeader:
+ headerPtr = &header;
+ memset(headerPtr, 0, sizeof(gz_header));
+ nameBuf = ckalloc(PATH_MAX);
+ header.name = (void *) nameBuf;
+ header.name_max = PATH_MAX;
+ commentBuf = ckalloc(256);
+ header.comment = (void *) commentBuf;
+ header.comm_max = 256;
+ }
+ break;
+ default:
+ Tcl_Panic("unrecognized format: %d", format);
+ return NULL;
+ }
+
+ /*
+ * Loop trying to decompress until we've got enough space. Inefficient,
+ * but works.
+ */
+
+ for (; (outSize > 1024) && (code == Z_BUF_ERROR) ; outSize *= 2) {
+ stream.zalloc = NULL;
+ stream.zfree = NULL;
+ stream.avail_out = (uInt) outSize;
+ stream.next_out = Tcl_SetByteArrayLength(outObj, outSize);
+
+ code = inflateInit2(&stream, bits);
+ if (code != Z_OK) {
+ goto error;
+ }
+
+ if (headerPtr != NULL) {
+ inflateGetHeader(&stream, headerPtr);
+ if (code != Z_OK) {
+ goto error;
+ }
+ }
+
+ code = inflate(&stream, Z_FINISH);
+
+ if (code != Z_STREAM_END) {
+ inflateEnd(&stream);
+ if (code == Z_OK) {
+ code = Z_BUF_ERROR;
+ }
+ } else {
+ code = inflateEnd(&stream);
+ }
+ }
+
+ if (code == Z_OK) {
+ if (headerPtr != NULL) {
+ ExtractHeader(headerPtr, dictObj);
+ SetValue(dictObj, "size", Tcl_NewLongObj((long)stream.total_out));
+ ckfree(nameBuf);
+ ckfree(commentBuf);
+ }
+ Tcl_SetByteArrayLength(outObj, stream.total_out);
+ return outObj;
+ }
+
+ error:
+ Tcl_DecrRefCount(outObj);
+ if (headerPtr != NULL) {
+ ckfree(nameBuf);
+ ckfree(commentBuf);
+ }
+ ConvertError(interp, code);
+ return NULL;
+}
+
+unsigned int
+Tcl_ZlibCRC32(
+ const char *bytes,
+ int length)
+{
+ unsigned int initValue = crc32(0, NULL, 0);
+
+ return crc32(initValue, (unsigned char *) bytes, (unsigned) length);
+}
+
+unsigned int
+Tcl_ZlibAdler32(
+ const char *bytes,
+ int length)
+{
+ unsigned int initValue = adler32(0, NULL, 0);
+
+ return adler32(initValue, (unsigned char *) bytes, (unsigned) length);
+}
+
+int
+Tcl_ZlibStreamInit(
+ Tcl_Interp *interp,
+ int mode,
+ int format,
+ int level,
+ Tcl_Obj *dictObj,
+ Tcl_ZlibStream *zshandlePtr)
+{
+ StreamInfo *siPtr = (StreamInfo *) ckalloc(sizeof(StreamInfo));
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tsdKey);
+ char buf[TCL_INTEGER_SPACE+8];
+
+ memset(&siPtr->stream, 0, sizeof(z_stream));
+ memset(&siPtr->header, 0, sizeof(gz_header));
+
+ siPtr->interp = interp;
+ sprintf(buf, "zstream%d", tsdPtr->counter++);
+ siPtr->cmd = Tcl_CreateObjCommand(interp, buf, ZlibStream, siPtr,
+ DeleteStream);
+
+ Tcl_Panic("unimplemented");
+
+ *zshandlePtr = (Tcl_ZlibStream) siPtr;
+ return TCL_OK;
+}
+
+Tcl_Obj *
+Tcl_ZlibStreamGetCommandName(
+ Tcl_ZlibStream zshandle)
+{
+ StreamInfo *siPtr = (StreamInfo *) zshandle;
+ Tcl_Obj *cmdnameObj = Tcl_NewObj();
+
+ Tcl_GetCommandFullName(siPtr->interp, siPtr->cmd, cmdnameObj);
+ return cmdnameObj;
+}
+
+int
+Tcl_ZlibStreamEof(
+ Tcl_ZlibStream zshandle)
+{
+ StreamInfo *siPtr = (StreamInfo *) zshandle;
+ Tcl_Panic("unimplemented");
+ return -1;
+}
+
+int
+Tcl_ZlibStreamClose(
+ Tcl_ZlibStream zshandle)
+{
+ StreamInfo *siPtr = (StreamInfo *) zshandle;
+ int code = -1;
+
+ Tcl_Panic("unimplemented");
+
+ if (siPtr->cmd) {
+ /*
+ * Must be last in this function!
+ */
+
+ register Tcl_Command cmd = siPtr->cmd;
+
+ siPtr->cmd = NULL;
+ Tcl_DeleteCommandFromToken(siPtr->interp, cmd);
+ }
+ return code;
+}
+
+int
+Tcl_ZlibStreamAdler32(
+ Tcl_ZlibStream zshandle)
+{
+ StreamInfo *siPtr = (StreamInfo *) zshandle;
+ Tcl_Panic("unimplemented");
+ return -1;
+}
+
+int
+Tcl_ZlibStreamPut(
+ Tcl_ZlibStream zshandle,
+ const char *bytes,
+ int length,
+ int flush)
+{
+ StreamInfo *siPtr = (StreamInfo *) zshandle;
+ Tcl_Panic("unimplemented");
+ return -1;
+}
+
+int
+Tcl_ZlibStreamGet(
+ Tcl_ZlibStream zshandle,
+ const char *bytes,
+ int length)
+{
+ StreamInfo *siPtr = (StreamInfo *) zshandle;
+ Tcl_Panic("unimplemented");
+ return -1;
+}
+
+static void
+DeleteStream(
+ ClientData clientData)
+{
+ register StreamInfo *siPtr = clientData;
+
+ if (siPtr->cmd) {
+ siPtr->cmd = NULL;
+ Tcl_ZlibStreamClose(clientData);
+ }
+ ckfree(clientData);
+}
+
+static int
+ZlibStream(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ StreamInfo *siPtr = clientData;
+ static const char *subcmds[] = {
+ "adler32", "close", "eof", "finalize", "flush", "fullflush", "get",
+ "put", NULL
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "subcommand ...");
+ return TCL_ERROR;
+ }
+ Tcl_SetResult(interp, "unimplemented", TCL_STATIC);
+ return TCL_ERROR;
+}
+
+#else /* !REIMPLEMENT */
+
+#include "tcl.h"
+#include <zlib.h>
+#include <string.h>
+
+/*
+ * Structure used for the Tcl_ZlibStream* commands and [zlib stream ...]
+ */
+
+typedef struct {
+ Tcl_Interp *interp;
+ z_stream stream;
+ int streamend;
+ Tcl_Obj *indata, *outdata; /* Input / output buffers (lists) */
+ Tcl_Obj *current_input; /* Pointer to what is currently being
+ * inflated. */
+ int inpos, outpos;
+ int mode; /* ZLIB_DEFLATE || ZLIB_INFLATE */
+ int format; /* ZLIB_FORMAT_* */
+ int level; /* Default 5, 0-9 */
+ int flush; /* Stores the flush param for deferred the
+ * decompression. */
+ int wbits;
+ Tcl_Obj *cmdname; /* Name of the associated Tcl command */
+} zlibStreamHandle;
+
+
+/*
+ * Prototypes for private procedures defined later in this file:
+ */
+
+static int ZlibCmd(ClientData dummy, Tcl_Interp *ip, int objc,
+ Tcl_Obj *const objv[]);
+static int ZlibStreamCmd(ClientData cd, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
+static void ZlibStreamCmdDelete(ClientData cd);
+static void ZlibStreamCleanup(zlibStreamHandle *zsh);
+
+/*
+ * Prototypes for private procedures used by channel stacking:
+ */
+
+#ifdef ENABLE_CHANSTACKING
+static int ChanClose(ClientData instanceData,
+ Tcl_Interp *interp);
+static int ChanInput(ClientData instanceData, char *buf,
+ int toRead, int *errorCodePtr);
+static int ChanOutput(ClientData instanceData, const char *buf,
+ int toWrite, int*errorCodePtr);
+static int ChanSeek(ClientData instanceData, long offset,
+ int mode, int *errorCodePtr);
+static int ChanSetOption(ClientData instanceData,
+ Tcl_Interp *interp, const char *optionName,
+ const char *value);
+static int ChanGetOption(ClientData instanceData,
+ Tcl_Interp *interp, const char *optionName,
+ Tcl_DString *dsPtr);
+static void ChanWatch(ClientData instanceData, int mask);
+static int ChanGetHandle(ClientData instanceData, int direction,
+ ClientData *handlePtr);
+static int ChanClose2(ClientData instanceData,
+ Tcl_Interp *interp, int flags);
+static int ChanBlockMode(ClientData instanceData, int mode);
+static int ChanFlush(ClientData instanceData);
+static int ChanHandler(ClientData instanceData,
+ int interestMask);
+static Tcl_WideInt ChanWideSeek(ClientData instanceData,
+ Tcl_WideInt offset, int mode, int *errorCodePtr);
+
+static Tcl_ChannelType zlibChannelType = {
+ "zlib",
+ TCL_CHANNEL_VERSION_3,
+ ChanClose,
+ ChanInput,
+ ChanOutput,
+ NULL, /* ChanSeek, */
+ NULL, /* ChanSetOption, */
+ NULL, /* ChanGetOption, */
+ ChanWatch,
+ ChanGetHandle,
+ NULL, /* ChanClose2, */
+ ChanBlockMode,
+ ChanFlush,
+ ChanHandler,
+ NULL /* ChanWideSeek */
+};
+
+typedef struct {
+ /* Generic channel info */
+ Tcl_Channel channel;
+ Tcl_TimerToken timer;
+ int flags;
+ int mask;
+
+ /* Zlib specific channel state */
+ int inFormat;
+ int outFormat;
+ z_stream instream;
+ z_stream outstream;
+ char *inbuffer;
+ int inAllocated, inUsed, inPos;
+ char *outbuffer;
+ int outAllocated, outUsed, outPos;
+} Zlib_ChannelData;
+
+/* Flag values */
+#define ASYNC 1
+#endif /* ENABLE_CHANSTACKING */
+
+#ifdef TCLKIT_BUILD
+/*
+ * Structure for the old zlib sdeflate/sdecompress commands
+ * Deprecated!
+ */
+
+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 = cd;
+ int count = 0;
+ int e, index;
+ Tcl_Obj *obj;
+
+ static const 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, &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, &zp->stream.avail_out);
+ e = inflate(&zp->stream, Z_NO_FLUSH);
+ if (e != Z_OK && 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;
+}
+
+static void
+zstreamdelproc(
+ ClientData cd)
+{
+ zlibstream *zp = cd;
+
+ inflateEnd(&zp->stream);
+ Tcl_DecrRefCount(zp->indata);
+ ckfree((void*) zp);
+}
+
+static int
+ZlibCmdO(
+ ClientData dummy,
+ Tcl_Interp *ip,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ int e = TCL_OK, index, dlen, wbits = -MAX_WBITS;
+ unsigned flag;
+ Byte *data;
+ z_stream stream;
+ Tcl_Obj *obj = Tcl_GetObjResult(ip);
+
+ static const 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_GetIntFromObj(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 = adler32(0, 0, 0);
+ }
+ Tcl_SetIntObj(obj, adler32(flag, data, dlen));
+ return TCL_OK;
+ case 1: /* crc32 str ?start? -> checksum */
+ if (objc < 4) {
+ flag = crc32(0, 0, 0);
+ }
+ Tcl_SetIntObj(obj, crc32(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, 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 *) ckalloc(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;
+}
+#endif /* TCLKIT_BUILD */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ZlibStreamInit --
+ *
+ * This command initializes a (de)compression context/handle for
+ * (de)compressing data in chunks.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * zshandle is initialised and memory allocated for internal state.
+ * Additionally, if interp is not null, a Tcl command is created and its
+ * name placed in the interp result obj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ZlibStreamInit(
+ Tcl_Interp *interp,
+ int mode, /* ZLIB_INFLATE || ZLIB_DEFLATE */
+ int format, /* ZLIB_FORMAT_* */
+ int level, /* 0-9 or ZLIB_DEFAULT_COMPRESSION */
+ Tcl_ZlibStream *zshandle)
+{
+ int wbits = 0;
+ int e;
+ zlibStreamHandle *zsh = NULL;
+ Tcl_DString cmdname;
+ Tcl_CmdInfo cmdinfo;
+
+ if (mode == TCL_ZLIB_STREAM_DEFLATE) {
+ /*
+ * Compressed format is specified by the wbits parameter. See zlib.h
+ * for details.
+ */
+
+ if (format == TCL_ZLIB_FORMAT_RAW) {
+ wbits = -MAX_WBITS;
+ } else if (format == TCL_ZLIB_FORMAT_GZIP) {
+ wbits = MAX_WBITS+16;
+ } else if (format == TCL_ZLIB_FORMAT_ZLIB) {
+ wbits = MAX_WBITS;
+ } else {
+ Tcl_Panic("incorrect zlib data format, must be "
+ "TCL_ZLIB_FORMAT_ZLIB, TCL_ZLIB_FORMAT_GZIP or "
+ "TCL_ZLIB_FORMAT_RAW");
+ }
+ if (level < -1 || level > 9) {
+ if (interp) {
+ Tcl_SetResult(interp, "Compression level should be between "
+ "0 (no compression) and 9 (best compression) or -1 "
+ "for default compression level.", TCL_STATIC);
+ }
+ return TCL_ERROR;
+ }
+ } else {
+ /*
+ * mode == ZLIB_INFLATE
+ * wbits are the same as DEFLATE, but FORMAT_AUTO is valid too.
+ */
+
+ if (format == TCL_ZLIB_FORMAT_RAW) {
+ wbits = -MAX_WBITS;
+ } else if (format == TCL_ZLIB_FORMAT_GZIP) {
+ wbits = MAX_WBITS+16;
+ } else if (format == TCL_ZLIB_FORMAT_ZLIB) {
+ wbits = MAX_WBITS;
+ } else if (format == TCL_ZLIB_FORMAT_AUTO) {
+ wbits = MAX_WBITS+32;
+ } else {
+ Tcl_Panic("incorrect zlib data format, must be "
+ "TCL_ZLIB_FORMAT_ZLIB, TCL_ZLIB_FORMAT_GZIP, "
+ "TCL_ZLIB_FORMAT_RAW or TCL_ZLIB_FORMAT_AUTO");
+ }
+ }
+
+ zsh = (zlibStreamHandle *) ckalloc(sizeof(zlibStreamHandle));
+ zsh->interp = interp;
+ zsh->mode = mode;
+ zsh->format = format;
+ zsh->level = level;
+ zsh->wbits = wbits;
+ zsh->current_input = NULL;
+ zsh->streamend = 0;
+ zsh->stream.avail_in = 0;
+ zsh->stream.next_in = 0;
+ zsh->stream.zalloc = 0;
+ zsh->stream.zfree = 0;
+ zsh->stream.opaque = 0; /* Must be initialized before calling
+ * (de|in)flateInit2 */
+
+ /*
+ * No output buffer available yet
+ */
+
+ zsh->stream.avail_out = 0;
+ zsh->stream.next_out = NULL;
+
+ if (mode == TCL_ZLIB_STREAM_DEFLATE) {
+ e = deflateInit2(&zsh->stream, level, Z_DEFLATED, wbits,
+ MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
+ } else {
+ e = inflateInit2(&zsh->stream, wbits);
+ }
+
+ if (e != Z_OK) {
+ if (interp) {
+ Tcl_SetResult(interp, (char*) zError(e), TCL_STATIC);
+ }
+ goto error;
+ }
+
+ /*
+ * I could do all this in C, but this is easier.
+ */
+
+ if (interp != NULL) {
+ if (Tcl_Eval(interp, "incr ::zlib::cmdcounter") != TCL_OK) {
+ goto error;
+ }
+ Tcl_DStringInit(&cmdname);
+ Tcl_DStringAppend(&cmdname, "::zlib::streamcmd-", -1);
+ Tcl_DStringAppend(&cmdname, Tcl_GetString(Tcl_GetObjResult(interp)),
+ -1);
+ if (Tcl_GetCommandInfo(interp, Tcl_DStringValue(&cmdname),
+ &cmdinfo) == 1 ) {
+ Tcl_SetResult(interp,
+ "BUG: Stream command name already exists", TCL_STATIC);
+ goto error;
+ }
+ Tcl_ResetResult(interp);
+
+ /*
+ * Create the command.
+ */
+
+ Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdname),
+ ZlibStreamCmd, zsh, ZlibStreamCmdDelete);
+
+ /*
+ * Create the cmdname obj for future reference.
+ */
+
+ zsh->cmdname = Tcl_NewStringObj(Tcl_DStringValue(&cmdname),
+ Tcl_DStringLength(&cmdname));
+ Tcl_IncrRefCount(zsh->cmdname);
+ Tcl_DStringFree(&cmdname);
+ } else {
+ zsh->cmdname = NULL;
+ }
+
+ /*
+ * Prepare the buffers for use.
+ */
+
+ zsh->indata = Tcl_NewListObj(0, NULL);
+ Tcl_IncrRefCount(zsh->indata);
+ zsh->outdata = Tcl_NewListObj(0, NULL);
+ Tcl_IncrRefCount(zsh->outdata);
+
+ zsh->inpos = 0;
+ zsh->outpos = 0;
+
+ /*
+ * Now set the int pointed to by *zshandle to the pointer to the zsh
+ * struct.
+ */
+
+ if (zshandle) {
+ *zshandle = (Tcl_ZlibStream) zsh;
+ }
+
+ return TCL_OK;
+ error:
+ ckfree((char *) zsh);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibStreamCmdDelete --
+ *
+ * This is the delete command which Tcl invokes when a zlibstream command
+ * is deleted from the interpreter (on stream close, usually).
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Invalidates the zlib stream handle as obtained from Tcl_ZlibStreamInit
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ZlibStreamCmdDelete(
+ ClientData cd)
+{
+ zlibStreamHandle *zsh = cd;
+
+ ZlibStreamCleanup(zsh);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ZlibStreamClose --
+ *
+ * This procedure must be called after (de)compression is done to ensure
+ * memory is freed and the command is deleted from the interpreter (if
+ * any).
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Invalidates the zlib stream handle as obtained from Tcl_ZlibStreamInit
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ZlibStreamClose(
+ Tcl_ZlibStream zshandle) /* As obtained from Tcl_ZlibStreamInit. */
+{
+ zlibStreamHandle *zsh = (zlibStreamHandle *) zshandle;
+
+ /*
+ * If the interp is set, deleting the command will trigger
+ * ZlibStreamCleanup in ZlibStreamCmdDelete. If no interp is set, call
+ * ZlibStreamCleanup directly.
+ */
+
+ if (zsh->interp && zsh->cmdname) {
+ Tcl_DeleteCommand(zsh->interp,
+ Tcl_GetStringFromObj(zsh->cmdname, NULL));
+ } else {
+ ZlibStreamCleanup(zsh);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ZlibStreamCleanup --
+ *
+ * This procedure is called by either Tcl_ZlibStreamClose or
+ * ZlibStreamCmdDelete to cleanup the stream context.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Invalidates the zlib stream handle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+ZlibStreamCleanup(
+ zlibStreamHandle *zsh)
+{
+ if (!zsh->streamend) {
+ if (zsh->mode == TCL_ZLIB_STREAM_DEFLATE) {
+ deflateEnd(&zsh->stream);
+ } else {
+ inflateEnd(&zsh->stream);
+ }
+ }
+
+ if (zsh->indata) {
+ Tcl_DecrRefCount(zsh->indata);
+ }
+ if (zsh->outdata) {
+ Tcl_DecrRefCount(zsh->outdata);
+ }
+ if (zsh->cmdname) {
+ Tcl_DecrRefCount(zsh->cmdname);
+ }
+ if (zsh->current_input) {
+ Tcl_DecrRefCount(zsh->current_input);
+ }
+
+ ckfree((void *) zsh);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ZlibStreamReset --
+ *
+ * This procedure will reinitialize an existing stream handle.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Any data left in the (de)compression buffer is lost.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ZlibStreamReset(
+ Tcl_ZlibStream zshandle) /* As obtained from Tcl_ZlibStreamInit */
+{
+ zlibStreamHandle *zsh = (zlibStreamHandle*) zshandle;
+ int e;
+
+ if (!zsh->streamend) {
+ if (zsh->mode == TCL_ZLIB_STREAM_DEFLATE) {
+ deflateEnd(&zsh->stream);
+ } else {
+ inflateEnd(&zsh->stream);
+ }
+ }
+ Tcl_SetByteArrayLength(zsh->indata, 0);
+ Tcl_SetByteArrayLength(zsh->outdata, 0);
+ if (zsh->current_input) {
+ Tcl_DecrRefCount(zsh->current_input);
+ zsh->current_input=NULL;
+ }
+
+ zsh->inpos = 0;
+ zsh->outpos = 0;
+ zsh->streamend = 0;
+ zsh->stream.avail_in = 0;
+ zsh->stream.next_in = 0;
+ zsh->stream.zalloc = 0;
+ zsh->stream.zfree = 0;
+ zsh->stream.opaque = 0; /* Must be initialized before calling
+ * (de|in)flateInit2 */
+
+ /* No output buffer available yet */
+ zsh->stream.avail_out = 0;
+ zsh->stream.next_out = NULL;
+
+ if (zsh->mode == TCL_ZLIB_STREAM_DEFLATE) {
+ e = deflateInit2(&zsh->stream, zsh->level, Z_DEFLATED, zsh->wbits,
+ MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
+ } else {
+ e = inflateInit2(&zsh->stream, zsh->wbits);
+ }
+
+ if ( e != Z_OK ) {
+ if (zsh->interp) {
+ Tcl_SetResult(zsh->interp, (char*) zError(e), TCL_STATIC);
+ }
+ /* TODOcleanup */
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ZlibStreamGetCommandName --
+ *
+ * This procedure will return the command name associated with the
+ * stream.
+ *
+ * Results:
+ * A Tcl_Obj with the name of the Tcl command or NULL if no command is
+ * associated with the stream.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+Tcl_ZlibStreamGetCommandName(
+ Tcl_ZlibStream zshandle) /* as obtained from Tcl_ZlibStreamInit */
+{
+ zlibStreamHandle *zsh = (zlibStreamHandle*) zshandle;
+
+ return zsh->cmdname;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ZlibStreamEof --
+ *
+ * This procedure This function returns 0 or 1 depending on the state of
+ * the (de)compressor. For decompression, eof is reached when the entire
+ * compressed stream has been decompressed. For compression, eof is
+ * reached when the stream has been flushed with ZLIB_FINALIZE.
+ *
+ * Results:
+ * Integer.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_ZlibStreamEof(
+ Tcl_ZlibStream zshandle) /* As obtained from Tcl_ZlibStreamInit */
+{
+ zlibStreamHandle *zsh = (zlibStreamHandle*) zshandle;
+
+ return zsh->streamend;
+}
+
+int
+Tcl_ZlibStreamAdler32(
+ Tcl_ZlibStream zshandle) /* As obtained from Tcl_ZlibStreamInit */
+{
+ zlibStreamHandle *zsh = (zlibStreamHandle*) zshandle;
+
+ return zsh->stream.adler;
+}
+
+#ifdef DISABLED_CODE
+int
+Tcl_ZlibStreamAdd(
+ Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */
+ char *data, /* Data to compress/decompress */
+ int size, /* Byte length of data */
+ int flush, /* 0, ZLIB_FLUSH, ZLIB_FULLFLUSH,
+ * ZLIB_FINALIZE */
+ Tcl_Obj *outdata, /* An object to append the compressed data
+ * to. */
+ int buffersize) /* Hint of the expected output size of
+ * inflate/deflate */
+{
+ zlibStreamHandle *zsh = (zlibStreamHandle*) zshandle;
+ char *datatmp=0, *outptr=0;
+ int e, outsize;
+
+ zsh->stream.next_in = data;
+ zsh->stream.avail_in = size;
+
+ if (zsh->mode == ZLIB_DEFLATE) {
+ if (buffersize < 6) {
+ /*
+ * The 6 comes from the zlib.h description of deflate. If the
+ * suggested buffer size is below 6, use deflateBound to get the
+ * minimum number of bytes needed from zlib.
+ */
+
+ zsh->stream.avail_out =
+ deflateBound(&zsh->stream, zsh->stream.avail_in);
+ } else {
+ zsh->stream.avail_out=buffersize;
+ }
+ datatmp = ckalloc(zsh->stream.avail_out);
+ zsh->stream.next_out = datatmp;
+ e = deflate(&zsh->stream, flush);
+ while ((e==Z_OK || e==Z_BUF_ERROR) && zsh->stream.avail_out==0) {
+ /* Output buffer too small */
+ Tcl_Panic("StreamAdd/Deflate - Buffer growing not implemented yet");
+ }
+
+ /*
+ * Now append the (de)compressed data to outdata.
+ */
+
+ Tcl_GetByteArrayFromObj(outdata, &outsize);
+ outptr = Tcl_SetByteArrayLength(outdata,
+ outsize + zsh->stream.total_out);
+ memcpy(&outptr[outsize], datatmp, zsh->stream.total_out);
+ } else {
+ if (buffersize == 0) {
+ /* Start with a buffer 3 times the size of the input data */
+ /* TODO: integer bounds/overflow check */
+ buffersize = 3*zsh->stream.avail_in;
+ }
+ Tcl_Panic("StreamAdd/Inflate - not implemented yet");
+ }
+ return TCL_OK;
+}
+#endif /* DISABLED_CODE */
+
+int
+Tcl_ZlibStreamPut(
+ Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */
+ Tcl_Obj *data, /* Data to compress/decompress */
+ int flush) /* 0, ZLIB_FLUSH, ZLIB_FULLFLUSH,
+ * ZLIB_FINALIZE */
+{
+ zlibStreamHandle *zsh = (zlibStreamHandle *) zshandle;
+ char *datatmp = 0;
+ int e, size, outsize;
+ Tcl_Obj *obj;
+
+ if (zsh->streamend) {
+ if (zsh->interp) {
+ Tcl_SetResult(zsh->interp, "already past compressed stream end",
+ TCL_STATIC);
+ }
+ return TCL_ERROR;
+ }
+
+ if (zsh->mode == TCL_ZLIB_STREAM_DEFLATE) {
+ zsh->stream.next_in = Tcl_GetByteArrayFromObj(data, &size);
+ zsh->stream.avail_in = size;
+
+ /*
+ * Deflatebound doesn't seem to take various header sizes into
+ * account, so we add 100 extra bytes.
+ */
+
+ outsize = deflateBound(&zsh->stream, zsh->stream.avail_in) + 100;
+ zsh->stream.avail_out = outsize;
+ datatmp = ckalloc(zsh->stream.avail_out);
+ zsh->stream.next_out = (Bytef *) datatmp;
+
+ e = deflate(&zsh->stream, flush);
+ if ((e==Z_OK || e==Z_BUF_ERROR) && (zsh->stream.avail_out == 0)) {
+ if (outsize - zsh->stream.avail_out > 0) {
+ /*
+ * Output buffer too small.
+ */
+
+ obj = Tcl_NewByteArrayObj((unsigned char *) datatmp,
+ outsize - zsh->stream.avail_out);
+ /*
+ * Now append the compressed data to the outbuffer.
+ */
+ Tcl_ListObjAppendElement(zsh->interp, zsh->outdata, obj);
+ }
+ if (outsize < 0xFFFF) {
+ outsize = 0xFFFF; /* There may be *lots* of data left to
+ * output... */
+ ckfree(datatmp);
+ datatmp = ckalloc(outsize);
+ }
+ zsh->stream.avail_out = outsize;
+ zsh->stream.next_out = (Bytef *) datatmp;
+
+ e = deflate(&zsh->stream, flush);
+ }
+
+ /*
+ * And append the final data block.
+ */
+
+ if (outsize - zsh->stream.avail_out > 0) {
+ obj = Tcl_NewByteArrayObj((unsigned char *) datatmp,
+ outsize - zsh->stream.avail_out);
+
+ /*
+ * Now append the compressed data to the outbuffer.
+ */
+
+ Tcl_ListObjAppendElement(zsh->interp, zsh->outdata, obj);
+ }
+ } else {
+ /*
+ * This is easy. Just append to inbuffer.
+ */
+
+ Tcl_ListObjAppendElement(zsh->interp, zsh->indata, data);
+
+ /*
+ * and we'll need the flush parameter for the Inflate call.
+ */
+
+ zsh->flush = flush;
+ }
+
+ return TCL_OK;
+}
+
+int
+Tcl_ZlibStreamGet(
+ Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */
+ Tcl_Obj *data, /* A place to put the data */
+ int count) /* Number of bytes to grab as a maximum, you
+ * may get less! */
+{
+ zlibStreamHandle *zsh = (zlibStreamHandle *) zshandle;
+ int e, i;
+ int llength, itemlen, datapos=0;
+ Tcl_Obj *lobj;
+ unsigned char *dataptr, *itemptr;
+
+ /*
+ * Getting beyond the of stream, just return empty string.
+ */
+
+ if (zsh->streamend) {
+ return TCL_OK;
+ }
+
+ if (zsh->mode == TCL_ZLIB_STREAM_INFLATE) {
+ if (count == -1) {
+ /*
+ * The only safe thing to do is restict to 65k. We might cause a
+ * panic for out of memory if we just kept growing the buffer.
+ */
+
+ count = 65536;
+ }
+
+ /*
+ * Prepare the place to store the data.
+ */
+
+ dataptr = Tcl_SetByteArrayLength(data, count);
+
+ zsh->stream.next_out = dataptr;
+ zsh->stream.avail_out = count;
+ if (zsh->stream.avail_in == 0) {
+ /*
+ * zlib will probably need more data to decompress.
+ */
+
+ if (zsh->current_input) {
+ Tcl_DecrRefCount(zsh->current_input);
+ zsh->current_input=0;
+ }
+ if (Tcl_ListObjLength(zsh->interp, zsh->indata,
+ &llength) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (llength > 0) {
+ /*
+ * There is more input available, get it from the list and
+ * give it to zlib.
+ */
+
+ if (Tcl_ListObjIndex(zsh->interp, zsh->indata, 0,
+ &lobj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ itemptr = Tcl_GetByteArrayFromObj(lobj, &itemlen);
+ Tcl_IncrRefCount(lobj);
+ zsh->current_input = lobj;
+ zsh->stream.next_in = itemptr;
+ zsh->stream.avail_in = itemlen;
+
+ /*
+ * And remove it from the list
+ */
+
+ Tcl_ListObjReplace(NULL, zsh->indata, 0, 1, 0, NULL);
+ llength--;
+ }
+ }
+
+ e = inflate(&zsh->stream, zsh->flush);
+ if (Tcl_ListObjLength(zsh->interp, zsh->indata, &llength) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*printf("llength %d, e==%d, avail_out %d\n", llength, e, zsh->stream.avail_out);*/
+ while ((zsh->stream.avail_out > 0) && (e==Z_OK || e==Z_BUF_ERROR)
+ && (llength > 0)) {
+ /*
+ * State: We have not satisfied the request yet and there may be
+ * more to inflate.
+ */
+
+ if (zsh->stream.avail_in > 0) {
+ if (zsh->interp) {
+ Tcl_SetResult(zsh->interp,
+ "Unexpected zlib internal state during decompression",
+ TCL_STATIC);
+ }
+ return TCL_ERROR;
+ }
+
+ if (zsh->current_input) {
+ Tcl_DecrRefCount(zsh->current_input);
+ zsh->current_input = 0;
+ }
+
+ if (Tcl_ListObjIndex(zsh->interp, zsh->indata, 0,
+ &lobj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ itemptr = Tcl_GetByteArrayFromObj(lobj, &itemlen);
+ Tcl_IncrRefCount(lobj);
+ zsh->current_input = lobj;
+ zsh->stream.next_in = itemptr;
+ zsh->stream.avail_in = itemlen;
+
+ /*
+ * And remove it from the list.
+ */
+
+ Tcl_ListObjReplace(NULL, zsh->indata, 0, 1, 0, NULL);
+ llength--;
+
+ /*
+ * And call inflate again
+ */
+
+ e = inflate(&zsh->stream, zsh->flush);
+ }
+ if (zsh->stream.avail_out > 0) {
+ Tcl_SetByteArrayLength(data, count - zsh->stream.avail_out);
+ }
+ if (!(e==Z_OK || e==Z_STREAM_END || e==Z_BUF_ERROR)) {
+ if (zsh->interp) {
+ Tcl_SetResult(zsh->interp, zsh->stream.msg, TCL_VOLATILE);
+ }
+ return TCL_ERROR;
+ }
+ if (e == Z_STREAM_END) {
+ zsh->streamend = 1;
+ if (zsh->current_input) {
+ Tcl_DecrRefCount(zsh->current_input);
+ zsh->current_input = 0;
+ }
+ inflateEnd(&zsh->stream);
+ }
+ } else {
+ if (Tcl_ListObjLength(zsh->interp, zsh->outdata,
+ &llength) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (count == -1) {
+ count = 0;
+ for (i=0; i<llength; i++) {
+ if (Tcl_ListObjIndex(zsh->interp, zsh->outdata, i,
+ &lobj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ itemptr = Tcl_GetByteArrayFromObj(lobj, &itemlen);
+ if (i == 0) {
+ count += itemlen - zsh->outpos;
+ } else {
+ count += itemlen;
+ }
+ }
+ }
+
+ /*
+ * Prepare the place to store the data.
+ */
+
+ dataptr = Tcl_SetByteArrayLength(data, count);
+
+ while ((count > datapos) && (Tcl_ListObjLength(zsh->interp,
+ zsh->outdata, &llength) == TCL_OK) && (llength > 0)) {
+ Tcl_ListObjIndex(zsh->interp, zsh->outdata, 0, &lobj);
+ itemptr = Tcl_GetByteArrayFromObj(lobj, &itemlen);
+ if (itemlen-zsh->outpos >= count-datapos) {
+ memcpy(dataptr+datapos, itemptr+zsh->outpos, count-datapos);
+ zsh->outpos += count - datapos;
+ datapos += count-datapos;
+ if (zsh->outpos == itemlen) {
+ zsh->outpos = 0;
+ }
+ } else {
+ memcpy(dataptr+datapos, itemptr+zsh->outpos,
+ itemlen-zsh->outpos);
+ datapos += itemlen- zsh->outpos;
+ zsh->outpos = 0;
+ }
+ if (zsh->outpos == 0) {
+ Tcl_ListObjReplace(NULL, zsh->outdata, 0, 1, 0, NULL);
+ }
+ }
+ Tcl_SetByteArrayLength(data, datapos);
+ }
+ return TCL_OK;
+}
+
+/*
+ * Deflate the contents of Tcl_Obj *data with compression level in output
+ * format.
+ */
+
+int
+Tcl_ZlibDeflate(
+ Tcl_Interp *interp,
+ int format,
+ Tcl_Obj *data,
+ int level)
+{
+ int wbits = 0, bdlen = 0, e = 0;
+ Byte *bdata = 0;
+ z_stream stream;
+ Tcl_Obj *obj;
+
+ /*
+ * We pass the data back in the interp result obj...
+ */
+
+ if (!interp) {
+ return TCL_ERROR;
+ }
+ obj = Tcl_GetObjResult(interp);
+
+ /*
+ * Compressed format is specified by the wbits parameter. See zlib.h for
+ * details.
+ */
+
+ if (format == TCL_ZLIB_FORMAT_RAW) {
+ wbits = -MAX_WBITS;
+ } else if (format == TCL_ZLIB_FORMAT_GZIP) {
+ wbits = MAX_WBITS + 16;
+ } else if (format == TCL_ZLIB_FORMAT_ZLIB) {
+ wbits = MAX_WBITS;
+ } else {
+ Tcl_Panic("incorrect zlib data format, must be TCL_ZLIB_FORMAT_ZLIB, "
+ "TCL_ZLIB_FORMAT_GZIP or TCL_ZLIB_FORMAT_ZLIB");
+ }
+
+ if (level < -1 || level > 9) {
+ Tcl_Panic("compression level should be between 0 (uncompressed) and "
+ "9 (best compression) or -1 for default compression level");
+ }
+
+ /*
+ * Obtain the pointer to the byte array, we'll pass this pointer straight
+ * to the deflate command.
+ */
+
+ bdata = Tcl_GetByteArrayFromObj(data, &bdlen);
+ stream.avail_in = (uInt) bdlen;
+ stream.next_in = bdata;
+ stream.zalloc = 0;
+ stream.zfree = 0;
+ stream.opaque = 0; /* Must be initialized before calling
+ * deflateInit2 */
+
+ /*
+ * No output buffer available yet, will alloc after deflateInit2.
+ */
+
+ stream.avail_out = 0;
+ stream.next_out = NULL;
+
+ e = deflateInit2(&stream, level, Z_DEFLATED, wbits, MAX_MEM_LEVEL,
+ Z_DEFAULT_STRATEGY);
+
+ if (e != Z_OK) {
+ Tcl_SetResult(interp, (char*) zError(e), TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Allocate the output buffer from the value of deflateBound(). This is
+ * probably too much space. Before returning to the caller, we will reduce
+ * it back to the actual compressed size.
+ */
+
+ stream.avail_out = deflateBound(&stream, bdlen);
+ /* TODO: What happens if this next call fails? */
+ Tcl_SetByteArrayLength(obj, stream.avail_out);
+
+ /*
+ * And point the output buffer to the obj buffer.
+ */
+
+ stream.next_out = Tcl_GetByteArrayFromObj(obj, NULL);
+
+ /*
+ * Perform the compression, Z_FINISH means do it in one go.
+ */
+
+ e = deflate(&stream, Z_FINISH);
+
+ if (e != Z_STREAM_END) {
+ deflateEnd(&stream);
+
+ /*
+ * deflateEnd() returns Z_OK when there are bytes left to compress, at
+ * this point we consider that an error, although we could continue by
+ * allocating more memory and calling deflate() again.
+ */
+
+ if (e == Z_OK) {
+ e = Z_BUF_ERROR;
+ }
+ } else {
+ e = deflateEnd(&stream);
+ }
+
+ if (e != Z_OK) {
+ Tcl_SetResult(interp, (char*) zError(e), TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Reduce the BA length to the actual data length produced by deflate.
+ */
+
+ Tcl_SetByteArrayLength(obj, stream.total_out);
+
+ return TCL_OK;
+}
+
+int
+Tcl_ZlibInflate(
+ Tcl_Interp *interp,
+ int format,
+ Tcl_Obj *data,
+ int buffersize)
+{
+ int wbits = 0 , inlen = 0, e = 0, newbuffersize;
+ Byte *indata = NULL, *outdata = NULL, *newoutdata = NULL;
+ z_stream stream;
+ Tcl_Obj *obj;
+
+ /*
+ * We pass the data back in the interp result obj...
+ */
+
+ if (!interp) {
+ return TCL_ERROR;
+ }
+ obj = Tcl_GetObjResult(interp);
+
+ /*
+ * Compressed format is specified by the wbits parameter. See zlib.h for
+ * details.
+ */
+
+ if (format == TCL_ZLIB_FORMAT_RAW) {
+ wbits = -MAX_WBITS;
+ } else if (format == TCL_ZLIB_FORMAT_GZIP) {
+ wbits = MAX_WBITS+16;
+ } else if (format == TCL_ZLIB_FORMAT_ZLIB) {
+ wbits = MAX_WBITS;
+ } else if (format == TCL_ZLIB_FORMAT_AUTO) {
+ wbits = MAX_WBITS+32;
+ } else {
+ Tcl_Panic("incorrect zlib data format, must be TCL_ZLIB_FORMAT_ZLIB, "
+ "TCL_ZLIB_FORMAT_GZIP, TCL_ZLIB_FORMAT_RAW or ZLIB_FORMAT_AUTO");
+ }
+
+ indata = Tcl_GetByteArrayFromObj(data,&inlen);
+ if (buffersize == 0) {
+ /*
+ * Start with a buffer 3 times the size of the input data.
+ *
+ * TODO: integer bounds/overflow check
+ */
+
+ buffersize = 3*inlen;
+ }
+
+ outdata = Tcl_SetByteArrayLength(obj, buffersize);
+ stream.zalloc = 0;
+ stream.zfree = 0;
+ stream.avail_in = (uInt) inlen+1; /* +1 because ZLIB can "over-request"
+ * input (but ignore it!) */
+ stream.next_in = indata;
+ stream.avail_out = buffersize;
+ stream.next_out = outdata;
+
+ /*
+ * Start the decompression cycle.
+ */
+
+ e = inflateInit2(&stream, wbits);
+ if (e != Z_OK) {
+ Tcl_SetResult(interp, (char*) zError(e), TCL_STATIC);
+ return TCL_ERROR;
+ }
+ while (1) {
+ e = inflate(&stream, Z_FINISH);
+ if (e != Z_BUF_ERROR) {
+ break;
+ }
+
+ /*
+ * Not enough room in the output buffer. Increase it by five times the
+ * bytes still in the input buffer. (Because 3 times didn't do the
+ * trick before, 5 times is what we do next.) Further optimization
+ * should be done by the user, specify the decompressed size!
+ */
+
+ if ((stream.avail_in == 0) && (stream.avail_out > 0)) {
+ Tcl_SetResult(interp, "decompression failed, input truncated?",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ newbuffersize = buffersize + 5 * stream.avail_in;
+ if (newbuffersize == buffersize) {
+ newbuffersize = buffersize+1000;
+ }
+ newoutdata = Tcl_SetByteArrayLength(obj, newbuffersize);
+
+ /*
+ * Set next out to the same offset in the new location.
+ */
+
+ stream.next_out = newoutdata + stream.total_out;
+
+ /*
+ * And increase avail_out with the number of new bytes allocated.
+ */
+
+ stream.avail_out += newbuffersize - buffersize;
+ outdata = newoutdata;
+ buffersize = newbuffersize;
+ }
+
+ if (e != Z_STREAM_END) {
+ inflateEnd(&stream);
+ Tcl_SetResult(interp, (char*) zError(e), TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ e = inflateEnd(&stream);
+ if (e != Z_OK) {
+ Tcl_SetResult(interp, (char*) zError(e), TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Reduce the BA length to the actual data length produced by deflate.
+ */
+
+ Tcl_SetByteArrayLength(obj, stream.total_out);
+ return TCL_OK;
+}
+
+unsigned int
+Tcl_ZlibCRC32(
+ unsigned int crc,
+ const char *buf,
+ unsigned int len)
+{
+ /* Nothing much to do, just wrap the crc32(). */
+ return crc32(crc, (Bytef *) buf, len);
+}
+
+unsigned int
+Tcl_ZlibAdler32(
+ unsigned int adler,
+ const char *buf,
+ unsigned int len)
+{
+ return adler32(adler, (Bytef *) buf, len);
+}
+
+static int
+ZlibCmd(
+ ClientData notUsed,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ int command, dlen, mode, format;
+#ifdef TCLKIT_BUILD
+ int wbits = -MAX_WBITS;
+#endif
+ unsigned start, level = -1, buffersize = 0;
+ Tcl_ZlibStream zh;
+ Byte *data;
+ Tcl_Obj *obj = Tcl_GetObjResult(interp);
+ static const char *commands[] = {
+ "adler32", "compress", "crc32", "decompress", "deflate", "gunzip",
+ "gzip", "inflate",
+#ifdef TCLKIT_BUILD
+ "sdecompress", "sinflate",
+#endif
+ "stack", "stream", "unstack",
+ NULL
+ };
+ enum zlibCommands {
+ z_adler32, z_compress, z_crc32, z_decompress, z_deflate, z_gunzip,
+ z_gzip, z_inflate,
+#ifdef TCLKIT_BUILD
+ z_sdecompress, z_sinflate,
+#endif
+ z_stack, z_stream, z_unstack
+ };
+ static const char *stream_formats[] = {
+ "compress", "decompress", "deflate", "gunzip", "gzip", "inflate",
+ NULL
+ };
+ enum zlibFormats {
+ f_compress, f_decompress, f_deflate, f_gunzip, f_gzip, f_inflate
+ };
+
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "command arg ?...?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], commands, "command", 0,
+ &command) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum zlibCommands) command) {
+ case z_adler32: /* adler32 str ?startvalue? -> checksum */
+ if (objc>3 && Tcl_GetIntFromObj(interp, objv[3],
+ (int *) &start) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc < 4) {
+ start = Tcl_ZlibAdler32(0, 0, 0);
+ }
+ data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
+ Tcl_SetIntObj(obj, (int)
+ Tcl_ZlibAdler32(start, (const char *) data, dlen));
+ return TCL_OK;
+ case z_crc32: /* crc32 str ?startvalue? -> checksum */
+ if (objc>3 && Tcl_GetIntFromObj(interp, objv[3],
+ (int *) &start) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (objc < 4) {
+ start = Tcl_ZlibCRC32(0, 0, 0);
+ }
+ data = Tcl_GetByteArrayFromObj(objv[2],&dlen);
+ Tcl_SetIntObj(obj, (int)
+ Tcl_ZlibCRC32(start, (const char *) data, dlen));
+ return TCL_OK;
+ case z_deflate: /* deflate data ?level? -> rawCompressedData */
+ if (objc>3 && Tcl_GetIntFromObj(interp, objv[3],
+ (int *) &level) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2], level);
+ case z_compress: /* compress data ?level? -> zlibCompressedData */
+ if (objc>3 && Tcl_GetIntFromObj(interp, objv[3],
+ (int *) &level) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], level);
+ case z_gzip: /* gzip data ?level? -> gzippedCompressedData */
+ if (objc>3 && Tcl_GetIntFromObj(interp, objv[3],
+ (int *) &level) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2], level);
+ case z_inflate: /* inflate rawcomprdata ?bufferSize? -> decompressedData */
+ if (objc>3 && Tcl_GetIntFromObj(interp, objv[3],
+ (int *) &buffersize) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2],
+ buffersize);
+ case z_decompress: /* decompress zlibcomprdata ?bufferSize? -> decompressedData */
+ /* We rely on TCL_ZLIB_FORMAT_AUTO to determine type. */
+ case z_gunzip: /* gunzip gzippeddata ?bufferSize? -> decompressedData */
+ if (objc > 3 && Tcl_GetIntFromObj(interp, objv[3],
+ (int *) &buffersize) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_AUTO, objv[2],
+ buffersize);
+ case z_stream: /* stream deflate/inflate/...gunzip ?level?*/
+ if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats,
+ "stream format", 0, &format) != TCL_OK) {
+ Tcl_AppendResult(interp, "format error: integer", NULL);
+ return TCL_ERROR;
+ }
+ mode = TCL_ZLIB_STREAM_INFLATE;
+ switch ((enum zlibFormats) format) {
+ case f_deflate:
+ mode = TCL_ZLIB_STREAM_DEFLATE;
+ case f_inflate:
+ format = TCL_ZLIB_FORMAT_RAW;
+ break;
+ case f_compress:
+ mode = TCL_ZLIB_STREAM_DEFLATE;
+ case f_decompress:
+ format = TCL_ZLIB_FORMAT_ZLIB;
+ break;
+ case f_gzip:
+ mode = TCL_ZLIB_STREAM_DEFLATE;
+ case f_gunzip:
+ format = TCL_ZLIB_FORMAT_GZIP;
+ break;
+ }
+ if (objc >= 4) {
+ if (Tcl_GetIntFromObj(interp, objv[3],
+ (int *) &level) != TCL_OK) {
+ Tcl_AppendResult(interp, "level error: integer", NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ level = Z_DEFAULT_COMPRESSION;
+ }
+ if (Tcl_ZlibStreamInit(interp, mode, format, level, &zh) != TCL_OK) {
+ Tcl_AppendResult(interp, "stream init error: integer", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_ZlibStreamGetCommandName(zh));
+ return TCL_OK;
+ case z_stack: /* stack */
+ break;
+ case z_unstack: /* unstack */
+ break;
+#ifdef TCLKIT_BUILD
+ case z_sdecompress: /* sdecompress cmdname -> */
+ wbits = MAX_WBITS;
+ case z_sinflate: {/* sinflate cmdname -> */
+ zlibstream *zp = (zlibstream *) ckalloc(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(interp, Tcl_GetStringFromObj(objv[2], 0),
+ zstreamincmd, zp, zstreamdelproc);
+ return TCL_OK;
+ }
+#endif /* TCLKIT_BUILD */
+ };
+
+ return TCL_ERROR;
+}
+
+static int
+ZlibStreamCmd(
+ ClientData cd,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Tcl_ZlibStream zstream = cd;
+ int command, index, count;
+ Tcl_Obj *obj = Tcl_GetObjResult(interp);
+ int buffersize;
+ int flush = -1, i;
+ static const char *cmds[] = {
+ "add", "adler32", "close", "eof", "finalize", "flush",
+ "fullflush", "get", "put", "reset",
+ NULL
+ };
+ enum zlibStreamCommands {
+ zs_add, zs_adler32, zs_close, zs_eof, zs_finalize, zs_flush,
+ zs_fullflush, zs_get, zs_put, zs_reset
+ };
+ static const char *add_options[] = {
+ "-buffer", "-finalize", "-flush", "-fullflush", NULL
+ };
+ enum addOptions {
+ ao_buffer, ao_finalize, ao_flush, ao_fullflush
+ };
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option data ?...?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], cmds, "option", 0,
+ &command) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum zlibStreamCommands) command) {
+ case zs_add: /* add ?-flush|-fullflush|-finalize? /data/ */
+ for (i=2; i<objc-1; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], add_options, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum addOptions) index) {
+ case ao_flush: /* -flush */
+ if (flush > -1) {
+ flush = -2;
+ } else {
+ flush = Z_SYNC_FLUSH;
+ }
+ break;
+ case ao_fullflush: /* -fullflush */
+ if (flush > -1) {
+ flush = -2;
+ } else {
+ flush = Z_FULL_FLUSH;
+ }
+ break;
+ case ao_finalize: /* -finalize */
+ if (flush > -1) {
+ flush = -2;
+ } else {
+ flush = Z_FINISH;
+ }
+ break;
+ case ao_buffer: /* -buffer */
+ if (i == objc-2) {
+ Tcl_AppendResult(interp, "\"-buffer\" option must be "
+ "followed by integer decompression buffersize",
+ NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[i+1],
+ &buffersize) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ if (flush == -2) {
+ Tcl_AppendResult(interp, "\"-flush\", \"-fullflush\" and "
+ "\"-finalize\" options are mutually exclusive", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (flush == -1) {
+ flush = 0;
+ }
+
+ if (Tcl_ZlibStreamPut(zstream, objv[objc-1],
+ flush) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return Tcl_ZlibStreamGet(zstream, obj, -1);
+
+ case zs_put: /* put ?-flush|-fullflush|-finalize? /data/ */
+ for (i=2; i<objc-1; i++) {
+ if (Tcl_GetIndexFromObj(interp, objv[i], add_options, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum addOptions) index) {
+ case ao_flush: /* -flush */
+ if (flush > -1) {
+ flush = -2;
+ } else {
+ flush = Z_SYNC_FLUSH;
+ }
+ break;
+ case ao_fullflush: /* -fullflush */
+ if (flush > -1) {
+ flush = -2;
+ } else {
+ flush = Z_FULL_FLUSH;
+ }
+ break;
+ case ao_finalize: /* -finalize */
+ if (flush > -1) {
+ flush = -2;
+ } else {
+ flush = Z_FINISH;
+ }
+ break;
+ case ao_buffer:
+ Tcl_AppendResult(interp,
+ "\"-buffer\" option not supported here", NULL);
+ return TCL_ERROR;
+ }
+ if (flush == -2) {
+ Tcl_AppendResult(interp, "\"-flush\", \"-fullflush\" and "
+ "\"-finalize\" options are mutually exclusive", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (flush == -1) {
+ flush = 0;
+ }
+ return Tcl_ZlibStreamPut(zstream, objv[objc-1], flush);
+
+ case zs_get: /* get ?count? */
+ count = -1;
+ if (objc >= 3) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &count) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ return Tcl_ZlibStreamGet(zstream, obj, count);
+ case zs_flush: /* flush */
+ Tcl_SetObjLength(obj, 0);
+ return Tcl_ZlibStreamPut(zstream, obj, Z_SYNC_FLUSH);
+ case zs_fullflush: /* fullflush */
+ Tcl_SetObjLength(obj, 0);
+ return Tcl_ZlibStreamPut(zstream, obj, Z_FULL_FLUSH);
+ case zs_finalize: /* finalize */
+ /*
+ * The flush commands slightly abuse the empty result obj as input
+ * data.
+ */
+
+ Tcl_SetObjLength(obj, 0);
+ return Tcl_ZlibStreamPut(zstream, obj, Z_FINISH);
+ case zs_close: /* close */
+ return Tcl_ZlibStreamClose(zstream);
+ case zs_eof: /* eof */
+ Tcl_SetIntObj(obj, Tcl_ZlibStreamEof(zstream));
+ return TCL_OK;
+ case zs_adler32: /* adler32 */
+ Tcl_SetIntObj(obj, Tcl_ZlibStreamAdler32(zstream));
+ return TCL_OK;
+ case zs_reset: /* reset */
+ return Tcl_ZlibStreamReset(zstream);
+ }
+
+ return TCL_OK;
+}
+
+#ifdef ENABLE_CHANSTACKING
+ /*
+ * Set of functions to support channel stacking
+ */
+
+static int
+ChanClose(
+ ClientData instanceData,
+ Tcl_Interp *interp)
+{
+ Zlib_ChannelData *cd = instanceData;
+ Tcl_Channel parent;
+ int e;
+
+ parent = Tcl_GetStackedChannel(cd->channel);
+
+ if (cd->inFormat != ZLIB_PASSTHROUGH) {
+ if (cd->inFormat && ZLIB_INFLATE) {
+ e = inflateEnd(&cd->instream);
+ } else {
+ e = deflateEnd(&cd->instream);
+ }
+ }
+
+ if (cd->outFormat != ZLIB_PASSTHROUGH) {
+ if (cd->outFormat && ZLIB_INFLATE) {
+ e = inflateEnd(&cd->outstream);
+ } else {
+ e = deflateEnd(&cd->outstream);
+ }
+ }
+
+ if (cd->inbuffer) {
+ ckfree(cd->inbuffer);
+ cd->inbuffer = NULL;
+ }
+
+ if (cd->outbuffer) {
+ ckfree(cd->outbuffer);
+ cd->outbuffer = NULL;
+ }
+ return TCL_OK;
+}
+
+static int
+ChanInput(
+ ClientData instanceData,
+ char *buf,
+ int toRead,
+ int *errorCodePtr)
+{
+ Zlib_ChannelData *cd = instanceData;
+
+ return TCL_OK;
+}
+
+static int
+ChanOutput(
+ ClientData instanceData,
+ const char *buf,
+ int toWrite,
+ int *errorCodePtr)
+{
+ Zlib_ChannelData *cd = instanceData;
+
+ return TCL_OK;
+}
+
+static int
+ChanSeek(
+ ClientData instanceData,
+ long offset,
+ int mode,
+ int *errorCodePtr)
+{
+ Zlib_ChannelData *cd = instanceData;
+
+ return TCL_OK;
+}
+
+static int
+ChanSetOption( /* not used */
+ ClientData instanceData,
+ Tcl_Interp *interp,
+ const char *optionName,
+ const char *value)
+{
+ Zlib_ChannelData *cd = instanceData;
+ Tcl_Channel parent = Tcl_GetStackedChannel(cd->channel);
+ Tcl_DriverSetOptionProc *setOptionProc =
+ Tcl_ChannelSetOptionProc(Tcl_GetChannelType(parent));
+
+ if (setOptionProc == NULL) {
+ return TCL_ERROR;
+ }
+
+ return setOptionProc(Tcl_GetChannelInstanceData(parent), interp,
+ optionName, value);
+}
+
+static int
+ChanGetOption( /* not used */
+ ClientData instanceData,
+ Tcl_Interp *interp,
+ const char *optionName,
+ Tcl_DString *dsPtr)
+{
+ return TCL_OK;
+}
+
+static void
+ChanWatch(
+ ClientData instanceData,
+ int mask)
+{
+ return;
+}
+
+static int
+ChanGetHandle(
+ ClientData instanceData,
+ int direction,
+ ClientData *handlePtr)
+{
+ /*
+ * No such thing as an OS handle for Zlib.
+ */
+
+ return 0;
+}
+
+static int
+ChanClose2( /* not used */
+ ClientData instanceData,
+ Tcl_Interp *interp,
+ int flags)
+{
+ return TCL_OK;
+}
+
+static int
+ChanBlockMode(
+ ClientData instanceData,
+ int mode)
+{
+ Zlib_ChannelData *cd = instanceData;
+
+ if (mode == TCL_MODE_NONBLOCKING) {
+ cd->flags |= ASYNC;
+ } else {
+ cd->flags &= ~ASYNC;
+ }
+ return TCL_OK;
+}
+
+static int
+ChanFlush(
+ ClientData instanceData)
+{
+ Zlib_ChannelData *cd = instanceData;
+
+ return TCL_OK;
+}
+
+static int
+ChanHandler(
+ ClientData instanceData,
+ int interestMask)
+{
+ Zlib_ChannelData *cd = instanceData;
+
+ return TCL_OK;
+}
+
+Tcl_WideInt
+ChanWideSeek( /* not used */
+ ClientData instanceData,
+ Tcl_WideInt offset,
+ int mode,
+ int *errorCodePtr)
+{
+ return TCL_OK;
+}
+
+Tcl_Channel
+Tcl_ZlibStackChannel(
+ Tcl_Interp *interp,
+ int inFormat,
+ int inLevel,
+ int outFormat,
+ int outLevel,
+ Tcl_Channel channel)
+{
+ Zlib_ChannelData *cd;
+ int outwbits = 0, inwbits = 0;
+ int e;
+
+ if (inFormat & ZLIB_FORMAT_RAW) {
+ inwbits = -MAX_WBITS;
+ } else if (inFormat & ZLIB_FORMAT_GZIP) {
+ inwbits = MAX_WBITS+16;
+ } else if (inFormat & ZLIB_FORMAT_ZLIB) {
+ inwbits = MAX_WBITS;
+ } else if ((inFormat & ZLIB_FORMAT_AUTO) && (inFormat & ZLIB_INFLATE)) {
+ inwbits = MAX_WBITS+32;
+ } else if (inFormat != ZLIB_PASSTHROUGH) {
+ Tcl_SetResult(interp, "Incorrect zlib read/input data format, must "
+ "be ZLIB_FORMAT_ZLIB, ZLIB_FORMAT_GZIP, ZLIB_FORMAT_RAW or "
+ "ZLIB_FORMAT_AUTO (only for inflate).", TCL_STATIC);
+ return NULL;
+ }
+
+ if (outFormat & ZLIB_FORMAT_RAW) {
+ outwbits = -MAX_WBITS;
+ } else if (outFormat & ZLIB_FORMAT_GZIP) {
+ outwbits = MAX_WBITS+16;
+ } else if (outFormat & ZLIB_FORMAT_ZLIB) {
+ outwbits = MAX_WBITS;
+ } else if ((outFormat & ZLIB_FORMAT_AUTO) && (outFormat & ZLIB_INFLATE)) {
+ outwbits = MAX_WBITS+32;
+ } else if (outFormat != ZLIB_PASSTHROUGH) {
+ Tcl_SetResult(interp, "Incorrect zlib write/output data format, must "
+ "be ZLIB_FORMAT_ZLIB, ZLIB_FORMAT_GZIP, ZLIB_FORMAT_RAW or "
+ "ZLIB_FORMAT_AUTO (only for inflate).", TCL_STATIC);
+ return NULL;
+ }
+
+ cd = (Zlib_ChannelData *) ckalloc(sizeof(Zlib_ChannelData));
+ cd->inFormat = inFormat;
+ cd->outFormat = outFormat;
+
+ cd->instream.zalloc = 0;
+ cd->instream.zfree = 0;
+ cd->instream.opaque = 0;
+ cd->instream.avail_in = 0;
+ cd->instream.next_in = NULL;
+ cd->instream.avail_out = 0;
+ cd->instream.next_out = NULL;
+
+ cd->outstream.zalloc = 0;
+ cd->outstream.zfree = 0;
+ cd->outstream.opaque = 0;
+ cd->outstream.avail_in = 0;
+ cd->outstream.next_in = NULL;
+ cd->outstream.avail_out = 0;
+ cd->outstream.next_out = NULL;
+
+ if (inFormat != ZLIB_PASSTHROUGH) {
+ if (inFormat & ZLIB_INFLATE) {
+ /* Initialize for Inflate */
+ e = inflateInit2(&cd->instream, inwbits);
+ } else {
+ /* Initialize for Deflate */
+ e = deflateInit2(&cd->instream, inLevel, Z_DEFLATED, inwbits,
+ MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
+ }
+ }
+
+ if (outFormat != ZLIB_PASSTHROUGH) {
+ if (outFormat && ZLIB_INFLATE) {
+ /* Initialize for Inflate */
+ e = inflateInit2(&cd->outstream, outwbits);
+ } else {
+ /* Initialize for Deflate */
+ e = deflateInit2(&cd->outstream, outLevel, Z_DEFLATED, outwbits,
+ MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
+ }
+ }
+
+ cd->channel = Tcl_StackChannel(interp, &zlibChannelType, cd,
+ TCL_READABLE | TCL_WRITABLE | TCL_EXCEPTION, channel);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(channel),
+ -1));
+ return channel;
+}
+
+#endif /* ENABLE_CHANSTACKING */
+
+/*
+ * Finaly, the TclZlibInit function. Used to install the zlib API.
+ */
+
+int
+TclZlibInit(
+ Tcl_Interp *interp)
+{
+ Tcl_Eval(interp, "namespace eval ::zlib {variable cmdcounter 0}");
+ Tcl_CreateObjCommand(interp, "zlib", ZlibCmd, 0, 0);
+ return TCL_OK;
+}
+#endif /* REIMPLEMENT */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */