diff options
Diffstat (limited to 'generic/tclZlib.c')
| -rw-r--r-- | generic/tclZlib.c | 3985 |
1 files changed, 0 insertions, 3985 deletions
diff --git a/generic/tclZlib.c b/generic/tclZlib.c deleted file mode 100644 index 956e3f9..0000000 --- a/generic/tclZlib.c +++ /dev/null @@ -1,3985 +0,0 @@ -/* - * 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-2012 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. - */ - -#include "tclInt.h" -#ifdef HAVE_ZLIB -#include <zlib.h> -#include "tclIO.h" - -/* - * The version of the zlib "package" that this implements. Note that this - * thoroughly supersedes the versions included with tclkit, which are "1.1", - * so this is at least "2.0" (there's no general *commitment* to have the same - * interface, even if that is mostly true). - */ - -#define TCL_ZLIB_VERSION "2.0.1" - -/* - * Magic flags used with wbits fields to indicate that we're handling the gzip - * format or automatic detection of format. Putting it here is slightly less - * gross! - */ - -#define WBITS_RAW (-MAX_WBITS) -#define WBITS_ZLIB (MAX_WBITS) -#define WBITS_GZIP (MAX_WBITS | 16) -#define WBITS_AUTODETECT (MAX_WBITS | 32) - -/* - * Structure used for handling gzip headers that are generated from a - * dictionary. It comprises the header structure itself plus some working - * space that it is very convenient to have attached. - */ - -#define MAX_COMMENT_LEN 256 - -typedef struct { - gz_header header; - char nativeFilenameBuf[MAXPATHLEN]; - char nativeCommentBuf[MAX_COMMENT_LEN]; -} GzipHeader; - -/* - * Structure used for the Tcl_ZlibStream* commands and [zlib stream ...] - */ - -typedef struct { - Tcl_Interp *interp; - z_stream stream; /* The interface to the zlib library. */ - int streamEnd; /* If we've got to end-of-stream. */ - Tcl_Obj *inData, *outData; /* Input / output buffers (lists) */ - Tcl_Obj *currentInput; /* Pointer to what is currently being - * inflated. */ - int outPos; - int mode; /* Either TCL_ZLIB_STREAM_DEFLATE or - * TCL_ZLIB_STREAM_INFLATE. */ - int format; /* Flags from the TCL_ZLIB_FORMAT_* */ - int level; /* Default 5, 0-9 */ - int flush; /* Stores the flush param for deferred the - * decompression. */ - int wbits; /* The encoded compression mode, so we can - * restart the stream if necessary. */ - Tcl_Command cmd; /* Token for the associated Tcl command. */ - Tcl_Obj *compDictObj; /* Byte-array object containing compression - * dictionary (not dictObj!) to use if - * necessary. */ - int flags; /* Miscellaneous flag bits. */ - GzipHeader *gzHeaderPtr; /* If we've allocated a gzip header - * structure. */ -} ZlibStreamHandle; - -#define DICT_TO_SET 0x1 /* If we need to set a compression dictionary - * in the low-level engine at the next - * opportunity. */ - -/* - * Macros to make it clearer in some of the twiddlier accesses what is - * happening. - */ - -#define IsRawStream(zshPtr) ((zshPtr)->format == TCL_ZLIB_FORMAT_RAW) -#define HaveDictToSet(zshPtr) ((zshPtr)->flags & DICT_TO_SET) -#define DictWasSet(zshPtr) ((zshPtr)->flags |= ~DICT_TO_SET) - -/* - * Structure used for stacked channel compression and decompression. - */ - -typedef struct { - Tcl_Channel chan; /* Reference to the channel itself. */ - Tcl_Channel parent; /* The underlying source and sink of bytes. */ - int flags; /* General flag bits, see below... */ - int mode; /* Either the value TCL_ZLIB_STREAM_DEFLATE - * for compression on output, or - * TCL_ZLIB_STREAM_INFLATE for decompression - * on input. */ - int format; /* What format of data is going on the wire. - * Needed so that the correct [fconfigure] - * options can be enabled. */ - int readAheadLimit; /* The maximum number of bytes to read from - * the underlying stream in one go. */ - z_stream inStream; /* Structure used by zlib for decompression of - * input. */ - z_stream outStream; /* Structure used by zlib for compression of - * output. */ - char *inBuffer, *outBuffer; /* Working buffers. */ - int inAllocated, outAllocated; - /* Sizes of working buffers. */ - GzipHeader inHeader; /* Header read from input stream, when - * decompressing a gzip stream. */ - GzipHeader outHeader; /* Header to write to an output stream, when - * compressing a gzip stream. */ - Tcl_TimerToken timer; /* Timer used for keeping events fresh. */ - Tcl_DString decompressed; /* Buffer for decompression results. */ - Tcl_Obj *compDictObj; /* Byte-array object containing compression - * dictionary (not dictObj!) to use if - * necessary. */ -} ZlibChannelData; - -/* - * Value bits for the flags field. Definitions are: - * ASYNC - Whether this is an asynchronous channel. - * IN_HEADER - Whether the inHeader field has been registered with - * the input compressor. - * OUT_HEADER - Whether the outputHeader field has been registered - * with the output decompressor. - */ - -#define ASYNC 0x1 -#define IN_HEADER 0x2 -#define OUT_HEADER 0x4 - -/* - * Size of buffers allocated by default, and the range it can be set to. The - * same sorts of values apply to streams, except with different limits (they - * permit byte-level activity). Channels always use bytes unless told to use - * larger buffers. - */ - -#define DEFAULT_BUFFER_SIZE 4096 -#define MIN_NONSTREAM_BUFFER_SIZE 16 -#define MAX_BUFFER_SIZE 65536 - -/* - * Prototypes for private procedures defined later in this file: - */ - -static Tcl_CmdDeleteProc ZlibStreamCmdDelete; -static Tcl_DriverBlockModeProc ZlibTransformBlockMode; -static Tcl_DriverCloseProc ZlibTransformClose; -static Tcl_DriverGetHandleProc ZlibTransformGetHandle; -static Tcl_DriverGetOptionProc ZlibTransformGetOption; -static Tcl_DriverHandlerProc ZlibTransformEventHandler; -static Tcl_DriverInputProc ZlibTransformInput; -static Tcl_DriverOutputProc ZlibTransformOutput; -static Tcl_DriverSetOptionProc ZlibTransformSetOption; -static Tcl_DriverWatchProc ZlibTransformWatch; -static Tcl_ObjCmdProc ZlibCmd; -static Tcl_ObjCmdProc ZlibStreamCmd; -static Tcl_ObjCmdProc ZlibStreamAddCmd; -static Tcl_ObjCmdProc ZlibStreamHeaderCmd; -static Tcl_ObjCmdProc ZlibStreamPutCmd; - -static void ConvertError(Tcl_Interp *interp, int code, - uLong adler); -static Tcl_Obj * ConvertErrorToList(int code, uLong adler); -static void ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj); -static int GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj, - GzipHeader *headerPtr, int *extraSizePtr); -static int ZlibPushSubcmd(Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static inline int ResultCopy(ZlibChannelData *cd, char *buf, - int toRead); -static int ResultGenerate(ZlibChannelData *cd, int n, int flush, - int *errorCodePtr); -static Tcl_Channel ZlibStackChannelTransform(Tcl_Interp *interp, - int mode, int format, int level, int limit, - Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr, - Tcl_Obj *compDictObj); -static void ZlibStreamCleanup(ZlibStreamHandle *zshPtr); -static int ZlibStreamSubcmd(Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); -static inline void ZlibTransformEventTimerKill(ZlibChannelData *cd); -static void ZlibTransformTimerRun(ClientData clientData); - -/* - * Type of zlib-based compressing and decompressing channels. - */ - -static const Tcl_ChannelType zlibChannelType = { - "zlib", - TCL_CHANNEL_VERSION_3, - ZlibTransformClose, - ZlibTransformInput, - ZlibTransformOutput, - NULL, /* seekProc */ - ZlibTransformSetOption, - ZlibTransformGetOption, - ZlibTransformWatch, - ZlibTransformGetHandle, - NULL, /* close2Proc */ - ZlibTransformBlockMode, - NULL, /* flushProc */ - ZlibTransformEventHandler, - NULL, /* wideSeekProc */ - NULL, - NULL -}; - -/* - *---------------------------------------------------------------------- - * - * ConvertError -- - * - * Utility function for converting a zlib error into a Tcl error. - * - * Results: - * None. - * - * Side effects: - * Updates the interpreter result and errorcode. - * - *---------------------------------------------------------------------- - */ - -static void -ConvertError( - Tcl_Interp *interp, /* Interpreter to store the error in. May be - * NULL, in which case nothing happens. */ - int code, /* The zlib error code. */ - uLong adler) /* The checksum expected (for Z_NEED_DICT) */ -{ - const char *codeStr, *codeStr2 = NULL; - char codeStrBuf[TCL_INTEGER_SPACE]; - - if (interp == NULL) { - return; - } - - switch (code) { - /* - * Firstly, the case that is *different* because it's really coming - * from the OS and is just being reported via zlib. It should be - * really uncommon because Tcl handles all I/O rather than delegating - * it to zlib, but proving it can't happen is hard. - */ - - case Z_ERRNO: - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp),-1)); - return; - - /* - * Normal errors/conditions, some of which have additional detail and - * some which don't. (This is not defined by array lookup because zlib - * error codes are sometimes negative.) - */ - - 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; - case Z_NEED_DICT: - codeStr = "NEED_DICT"; - codeStr2 = codeStrBuf; - sprintf(codeStrBuf, "%lu", adler); - break; - - /* - * These should _not_ happen! This function is for dealing with error - * cases, not non-errors! - */ - - case Z_OK: - Tcl_Panic("unexpected zlib result in error handler: Z_OK"); - case Z_STREAM_END: - Tcl_Panic("unexpected zlib result in error handler: Z_STREAM_END"); - - /* - * Anything else is bad news; it's unexpected. Convert to generic - * error. - */ - - default: - codeStr = "UNKNOWN"; - codeStr2 = codeStrBuf; - sprintf(codeStrBuf, "%d", code); - break; - } - Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), -1)); - - /* - * Tricky point! We might pass NULL twice here (and will when the error - * type is known). - */ - - Tcl_SetErrorCode(interp, "TCL", "ZLIB", codeStr, codeStr2, NULL); -} - -static Tcl_Obj * -ConvertErrorToList( - int code, /* The zlib error code. */ - uLong adler) /* The checksum expected (for Z_NEED_DICT) */ -{ - Tcl_Obj *objv[4]; - - TclNewLiteralStringObj(objv[0], "TCL"); - TclNewLiteralStringObj(objv[1], "ZLIB"); - switch (code) { - case Z_STREAM_ERROR: - TclNewLiteralStringObj(objv[2], "STREAM"); - return Tcl_NewListObj(3, objv); - case Z_DATA_ERROR: - TclNewLiteralStringObj(objv[2], "DATA"); - return Tcl_NewListObj(3, objv); - case Z_MEM_ERROR: - TclNewLiteralStringObj(objv[2], "MEM"); - return Tcl_NewListObj(3, objv); - case Z_BUF_ERROR: - TclNewLiteralStringObj(objv[2], "BUF"); - return Tcl_NewListObj(3, objv); - case Z_VERSION_ERROR: - TclNewLiteralStringObj(objv[2], "VERSION"); - return Tcl_NewListObj(3, objv); - case Z_ERRNO: - TclNewLiteralStringObj(objv[2], "POSIX"); - objv[3] = Tcl_NewStringObj(Tcl_ErrnoId(), -1); - return Tcl_NewListObj(4, objv); - case Z_NEED_DICT: - TclNewLiteralStringObj(objv[2], "NEED_DICT"); - objv[3] = Tcl_NewWideIntObj((Tcl_WideInt) adler); - return Tcl_NewListObj(4, objv); - - /* - * These should _not_ happen! This function is for dealing with error - * cases, not non-errors! - */ - - case Z_OK: - Tcl_Panic("unexpected zlib result in error handler: Z_OK"); - case Z_STREAM_END: - Tcl_Panic("unexpected zlib result in error handler: Z_STREAM_END"); - - /* - * Catch-all. Should be unreachable because all cases are already - * listed above. - */ - - default: - TclNewLiteralStringObj(objv[2], "UNKNOWN"); - TclNewIntObj(objv[3], code); - return Tcl_NewListObj(4, objv); - } -} - -/* - *---------------------------------------------------------------------- - * - * GenerateHeader -- - * - * Function for creating a gzip header from the contents of a dictionary - * (as described in the documentation). GetValue is a helper function. - * - * Results: - * A Tcl result code. - * - * Side effects: - * Updates the fields of the given gz_header structure. Adds amount of - * extra space required for the header to the variable referenced by the - * extraSizePtr argument. - * - *---------------------------------------------------------------------- - */ - -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, /* Where to put error messages. */ - Tcl_Obj *dictObj, /* The dictionary whose contents are to be - * parsed. */ - GzipHeader *headerPtr, /* Where to store the parsed-out values. */ - int *extraSizePtr) /* Variable to add the length of header - * strings (filename, comment) to. */ -{ - Tcl_Obj *value; - int len, result = TCL_ERROR; - const char *valueStr; - Tcl_Encoding latin1enc; - static const char *const types[] = { - "binary", "text" - }; - - /* - * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1). - */ - - latin1enc = Tcl_GetEncoding(NULL, "iso8859-1"); - if (latin1enc == NULL) { - Tcl_Panic("no latin-1 encoding"); - } - - if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) { - goto error; - } else if (value != NULL) { - valueStr = Tcl_GetStringFromObj(value, &len); - Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL, - headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len, - NULL); - headerPtr->nativeCommentBuf[len] = '\0'; - headerPtr->header.comment = (Bytef *) headerPtr->nativeCommentBuf; - if (extraSizePtr != NULL) { - *extraSizePtr += len; - } - } - - if (GetValue(interp, dictObj, "crc", &value) != TCL_OK) { - goto error; - } else if (value != NULL && - Tcl_GetBooleanFromObj(interp, value, &headerPtr->header.hcrc)) { - goto error; - } - - if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) { - goto error; - } else if (value != NULL) { - valueStr = Tcl_GetStringFromObj(value, &len); - Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL, - headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL); - headerPtr->nativeFilenameBuf[len] = '\0'; - headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf; - if (extraSizePtr != NULL) { - *extraSizePtr += len; - } - } - - if (GetValue(interp, dictObj, "os", &value) != TCL_OK) { - goto error; - } else if (value != NULL && Tcl_GetIntFromObj(interp, value, - &headerPtr->header.os) != TCL_OK) { - goto error; - } - - /* - * Ignore the 'size' field, since that is controlled by the size of the - * input data. - */ - - if (GetValue(interp, dictObj, "time", &value) != TCL_OK) { - goto error; - } else if (value != NULL && Tcl_GetLongFromObj(interp, value, - (long *) &headerPtr->header.time) != TCL_OK) { - goto error; - } - - if (GetValue(interp, dictObj, "type", &value) != TCL_OK) { - goto error; - } else if (value != NULL && Tcl_GetIndexFromObj(interp, value, types, - "type", TCL_EXACT, &headerPtr->header.text) != TCL_OK) { - goto error; - } - - result = TCL_OK; - error: - Tcl_FreeEncoding(latin1enc); - return result; -} - -/* - *---------------------------------------------------------------------- - * - * ExtractHeader -- - * - * Take the values out of a gzip header and store them in a dictionary. - * SetValue is a helper macro. - * - * Results: - * None. - * - * Side effects: - * Updates the dictionary, which must be writable (i.e. refCount < 2). - * - *---------------------------------------------------------------------- - */ - -#define SetValue(dictObj, key, value) \ - Tcl_DictObjPut(NULL, (dictObj), Tcl_NewStringObj((key), -1), (value)) - -static void -ExtractHeader( - gz_header *headerPtr, /* The gzip header to extract from. */ - Tcl_Obj *dictObj) /* The dictionary to store in. */ -{ - Tcl_Encoding latin1enc = NULL; - Tcl_DString tmp; - - if (headerPtr->comment != Z_NULL) { - if (latin1enc == NULL) { - /* - * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1). - */ - - latin1enc = Tcl_GetEncoding(NULL, "iso8859-1"); - if (latin1enc == NULL) { - Tcl_Panic("no latin-1 encoding"); - } - } - - Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, -1, - &tmp); - SetValue(dictObj, "comment", TclDStringToObj(&tmp)); - } - SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc)); - if (headerPtr->name != Z_NULL) { - if (latin1enc == NULL) { - /* - * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1). - */ - - latin1enc = Tcl_GetEncoding(NULL, "iso8859-1"); - if (latin1enc == NULL) { - Tcl_Panic("no latin-1 encoding"); - } - } - - Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, -1, - &tmp); - SetValue(dictObj, "filename", TclDStringToObj(&tmp)); - } - 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)); - } - - if (latin1enc != NULL) { - Tcl_FreeEncoding(latin1enc); - } -} - -static int -SetInflateDictionary( - z_streamp strm, - Tcl_Obj *compDictObj) -{ - if (compDictObj != NULL) { - int length; - unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); - - return inflateSetDictionary(strm, bytes, (unsigned) length); - } - return Z_OK; -} - -static int -SetDeflateDictionary( - z_streamp strm, - Tcl_Obj *compDictObj) -{ - if (compDictObj != NULL) { - int length; - unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length); - - return deflateSetDictionary(strm, bytes, (unsigned) length); - } - return Z_OK; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_ZlibStreamInit -- - * - * This command initializes a (de)compression context/handle for - * (de)compressing data in chunks. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * The variable pointed to by zshandlePtr 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. - * - * Note: - * At least one of interp and zshandlePtr should be non-NULL or the - * reference to the stream will be completely lost. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_ZlibStreamInit( - Tcl_Interp *interp, - int mode, /* Either TCL_ZLIB_STREAM_INFLATE or - * TCL_ZLIB_STREAM_DEFLATE. */ - int format, /* Flags from the TCL_ZLIB_FORMAT_* set. */ - int level, /* 0-9 or TCL_ZLIB_COMPRESS_DEFAULT. */ - Tcl_Obj *dictObj, /* Dictionary containing headers for gzip. */ - Tcl_ZlibStream *zshandlePtr) -{ - int wbits = 0; - int e; - ZlibStreamHandle *zshPtr = NULL; - Tcl_DString cmdname; - GzipHeader *gzHeaderPtr = NULL; - - switch (mode) { - case TCL_ZLIB_STREAM_DEFLATE: - /* - * Compressed format is specified by the wbits parameter. See zlib.h - * for details. - */ - - switch (format) { - case TCL_ZLIB_FORMAT_RAW: - wbits = WBITS_RAW; - break; - case TCL_ZLIB_FORMAT_GZIP: - wbits = WBITS_GZIP; - if (dictObj) { - gzHeaderPtr = ckalloc(sizeof(GzipHeader)); - memset(gzHeaderPtr, 0, sizeof(GzipHeader)); - if (GenerateHeader(interp, dictObj, gzHeaderPtr, - NULL) != TCL_OK) { - ckfree(gzHeaderPtr); - return TCL_ERROR; - } - } - break; - case TCL_ZLIB_FORMAT_ZLIB: - wbits = WBITS_ZLIB; - break; - default: - 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) { - Tcl_Panic("compression level should be between 0 (no compression)" - " and 9 (best compression) or -1 for default compression " - "level"); - } - break; - case TCL_ZLIB_STREAM_INFLATE: - /* - * wbits are the same as DEFLATE, but FORMAT_AUTO is valid too. - */ - - switch (format) { - case TCL_ZLIB_FORMAT_RAW: - wbits = WBITS_RAW; - break; - case TCL_ZLIB_FORMAT_GZIP: - wbits = WBITS_GZIP; - gzHeaderPtr = ckalloc(sizeof(GzipHeader)); - memset(gzHeaderPtr, 0, sizeof(GzipHeader)); - gzHeaderPtr->header.name = (Bytef *) - gzHeaderPtr->nativeFilenameBuf; - gzHeaderPtr->header.name_max = MAXPATHLEN - 1; - gzHeaderPtr->header.comment = (Bytef *) - gzHeaderPtr->nativeCommentBuf; - gzHeaderPtr->header.name_max = MAX_COMMENT_LEN - 1; - break; - case TCL_ZLIB_FORMAT_ZLIB: - wbits = WBITS_ZLIB; - break; - case TCL_ZLIB_FORMAT_AUTO: - wbits = WBITS_AUTODETECT; - break; - default: - 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"); - } - break; - default: - Tcl_Panic("bad mode, must be TCL_ZLIB_STREAM_DEFLATE or" - " TCL_ZLIB_STREAM_INFLATE"); - } - - zshPtr = ckalloc(sizeof(ZlibStreamHandle)); - zshPtr->interp = interp; - zshPtr->mode = mode; - zshPtr->format = format; - zshPtr->level = level; - zshPtr->wbits = wbits; - zshPtr->currentInput = NULL; - zshPtr->streamEnd = 0; - zshPtr->compDictObj = NULL; - zshPtr->flags = 0; - zshPtr->gzHeaderPtr = gzHeaderPtr; - memset(&zshPtr->stream, 0, sizeof(z_stream)); - zshPtr->stream.adler = 1; - - /* - * No output buffer available yet - */ - - if (mode == TCL_ZLIB_STREAM_DEFLATE) { - e = deflateInit2(&zshPtr->stream, level, Z_DEFLATED, wbits, - MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY); - if (e == Z_OK && zshPtr->gzHeaderPtr) { - e = deflateSetHeader(&zshPtr->stream, - &zshPtr->gzHeaderPtr->header); - } - } else { - e = inflateInit2(&zshPtr->stream, wbits); - if (e == Z_OK && zshPtr->gzHeaderPtr) { - e = inflateGetHeader(&zshPtr->stream, - &zshPtr->gzHeaderPtr->header); - } - } - - if (e != Z_OK) { - ConvertError(interp, e, zshPtr->stream.adler); - goto error; - } - - /* - * I could do all this in C, but this is easier. - */ - - if (interp != NULL) { - if (Tcl_Eval(interp, "::incr ::tcl::zlib::cmdcounter") != TCL_OK) { - goto error; - } - Tcl_DStringInit(&cmdname); - TclDStringAppendLiteral(&cmdname, "::tcl::zlib::streamcmd_"); - TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp)); - if (Tcl_FindCommand(interp, Tcl_DStringValue(&cmdname), - NULL, 0) != NULL) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "BUG: Stream command name already exists", -1)); - Tcl_SetErrorCode(interp, "TCL", "BUG", "EXISTING_CMD", NULL); - Tcl_DStringFree(&cmdname); - goto error; - } - Tcl_ResetResult(interp); - - /* - * Create the command. - */ - - zshPtr->cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdname), - ZlibStreamCmd, zshPtr, ZlibStreamCmdDelete); - Tcl_DStringFree(&cmdname); - if (zshPtr->cmd == NULL) { - goto error; - } - } else { - zshPtr->cmd = NULL; - } - - /* - * Prepare the buffers for use. - */ - - zshPtr->inData = Tcl_NewListObj(0, NULL); - Tcl_IncrRefCount(zshPtr->inData); - zshPtr->outData = Tcl_NewListObj(0, NULL); - Tcl_IncrRefCount(zshPtr->outData); - - zshPtr->outPos = 0; - - /* - * Now set the variable pointed to by *zshandlePtr to the pointer to the - * zsh struct. - */ - - if (zshandlePtr) { - *zshandlePtr = (Tcl_ZlibStream) zshPtr; - } - - return TCL_OK; - - error: - if (zshPtr->compDictObj) { - Tcl_DecrRefCount(zshPtr->compDictObj); - } - if (zshPtr->gzHeaderPtr) { - ckfree(zshPtr->gzHeaderPtr); - } - ckfree(zshPtr); - 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 *zshPtr = cd; - - zshPtr->cmd = NULL; - ZlibStreamCleanup(zshPtr); -} - -/* - *---------------------------------------------------------------------- - * - * 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 *zshPtr = (ZlibStreamHandle *) zshandle; - - /* - * If the interp is set, deleting the command will trigger - * ZlibStreamCleanup in ZlibStreamCmdDelete. If no interp is set, call - * ZlibStreamCleanup directly. - */ - - if (zshPtr->interp && zshPtr->cmd) { - Tcl_DeleteCommandFromToken(zshPtr->interp, zshPtr->cmd); - } else { - ZlibStreamCleanup(zshPtr); - } - 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 *zshPtr) -{ - if (!zshPtr->streamEnd) { - if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { - deflateEnd(&zshPtr->stream); - } else { - inflateEnd(&zshPtr->stream); - } - } - - if (zshPtr->inData) { - Tcl_DecrRefCount(zshPtr->inData); - } - if (zshPtr->outData) { - Tcl_DecrRefCount(zshPtr->outData); - } - if (zshPtr->currentInput) { - Tcl_DecrRefCount(zshPtr->currentInput); - } - if (zshPtr->compDictObj) { - Tcl_DecrRefCount(zshPtr->compDictObj); - } - if (zshPtr->gzHeaderPtr) { - ckfree(zshPtr->gzHeaderPtr); - } - - ckfree(zshPtr); -} - -/* - *---------------------------------------------------------------------- - * - * 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 *zshPtr = (ZlibStreamHandle *) zshandle; - int e; - - if (!zshPtr->streamEnd) { - if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { - deflateEnd(&zshPtr->stream); - } else { - inflateEnd(&zshPtr->stream); - } - } - Tcl_SetByteArrayLength(zshPtr->inData, 0); - Tcl_SetByteArrayLength(zshPtr->outData, 0); - if (zshPtr->currentInput) { - Tcl_DecrRefCount(zshPtr->currentInput); - zshPtr->currentInput = NULL; - } - - zshPtr->outPos = 0; - zshPtr->streamEnd = 0; - memset(&zshPtr->stream, 0, sizeof(z_stream)); - - /* - * No output buffer available yet. - */ - - if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { - e = deflateInit2(&zshPtr->stream, zshPtr->level, Z_DEFLATED, - zshPtr->wbits, MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY); - if (e == Z_OK && HaveDictToSet(zshPtr)) { - e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj); - if (e == Z_OK) { - DictWasSet(zshPtr); - } - } - } else { - e = inflateInit2(&zshPtr->stream, zshPtr->wbits); - if (IsRawStream(zshPtr) && HaveDictToSet(zshPtr) && e == Z_OK) { - e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj); - if (e == Z_OK) { - DictWasSet(zshPtr); - } - } - } - - if (e != Z_OK) { - ConvertError(zshPtr->interp, e, zshPtr->stream.adler); - /* TODO:cleanup */ - 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 *zshPtr = (ZlibStreamHandle *) zshandle; - Tcl_Obj *objPtr; - - if (!zshPtr->interp) { - return NULL; - } - - TclNewObj(objPtr); - Tcl_GetCommandFullName(zshPtr->interp, zshPtr->cmd, objPtr); - return objPtr; -} - -/* - *---------------------------------------------------------------------- - * - * 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 TCL_ZLIB_FINALIZE. - * - * Results: - * Integer. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_ZlibStreamEof( - Tcl_ZlibStream zshandle) /* As obtained from Tcl_ZlibStreamInit */ -{ - ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; - - return zshPtr->streamEnd; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_ZlibStreamChecksum -- - * - * Return the checksum of the uncompressed data seen so far by the - * stream. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_ZlibStreamChecksum( - Tcl_ZlibStream zshandle) /* As obtained from Tcl_ZlibStreamInit */ -{ - ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; - - return zshPtr->stream.adler; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_ZlibStreamSetCompressionDictionary -- - * - * Sets the compression dictionary for a stream. This will be used as - * appropriate for the next compression or decompression action performed - * on the stream. - * - *---------------------------------------------------------------------- - */ - -void -Tcl_ZlibStreamSetCompressionDictionary( - Tcl_ZlibStream zshandle, - Tcl_Obj *compressionDictionaryObj) -{ - ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; - - if (compressionDictionaryObj != NULL) { - if (Tcl_IsShared(compressionDictionaryObj)) { - compressionDictionaryObj = - Tcl_DuplicateObj(compressionDictionaryObj); - } - Tcl_IncrRefCount(compressionDictionaryObj); - zshPtr->flags |= DICT_TO_SET; - } else { - zshPtr->flags &= ~DICT_TO_SET; - } - if (zshPtr->compDictObj != NULL) { - Tcl_DecrRefCount(zshPtr->compDictObj); - } - zshPtr->compDictObj = compressionDictionaryObj; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_ZlibStreamPut -- - * - * Add data to the stream for compression or decompression from a - * bytearray Tcl_Obj. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_ZlibStreamPut( - Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */ - Tcl_Obj *data, /* Data to compress/decompress */ - int flush) /* TCL_ZLIB_NO_FLUSH, TCL_ZLIB_FLUSH, - * TCL_ZLIB_FULLFLUSH, or TCL_ZLIB_FINALIZE */ -{ - ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; - char *dataTmp = NULL; - int e, size, outSize; - Tcl_Obj *obj; - - if (zshPtr->streamEnd) { - if (zshPtr->interp) { - Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( - "already past compressed stream end", -1)); - Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL); - } - return TCL_ERROR; - } - - if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { - zshPtr->stream.next_in = Tcl_GetByteArrayFromObj(data, &size); - zshPtr->stream.avail_in = size; - - if (HaveDictToSet(zshPtr)) { - e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj); - if (e != Z_OK) { - if (zshPtr->interp) { - ConvertError(zshPtr->interp, e, zshPtr->stream.adler); - } - return TCL_ERROR; - } - DictWasSet(zshPtr); - } - - /* - * Deflatebound doesn't seem to take various header sizes into - * account, so we add 100 extra bytes. - */ - - outSize = deflateBound(&zshPtr->stream, zshPtr->stream.avail_in)+100; - zshPtr->stream.avail_out = outSize; - dataTmp = ckalloc(zshPtr->stream.avail_out); - zshPtr->stream.next_out = (Bytef *) dataTmp; - - e = deflate(&zshPtr->stream, flush); - if ((e==Z_OK || e==Z_BUF_ERROR) && (zshPtr->stream.avail_out == 0)) { - if (outSize - zshPtr->stream.avail_out > 0) { - /* - * Output buffer too small. - */ - - obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp, - outSize - zshPtr->stream.avail_out); - - /* - * Now append the compressed data to the outData list. - */ - - Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj); - } - if (outSize < 0xFFFF) { - outSize = 0xFFFF; /* There may be *lots* of data left to - * output... */ - ckfree(dataTmp); - dataTmp = ckalloc(outSize); - } - zshPtr->stream.avail_out = outSize; - zshPtr->stream.next_out = (Bytef *) dataTmp; - - e = deflate(&zshPtr->stream, flush); - } - if (e != Z_OK && !(flush==Z_FINISH && e==Z_STREAM_END)) { - if (zshPtr->interp) { - ConvertError(zshPtr->interp, e, zshPtr->stream.adler); - } - return TCL_ERROR; - } - - /* - * And append the final data block. - */ - - if (outSize - zshPtr->stream.avail_out > 0) { - obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp, - outSize - zshPtr->stream.avail_out); - - /* - * Now append the compressed data to the outData list. - */ - - Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj); - } - - if (dataTmp) { - ckfree(dataTmp); - } - } else { - /* - * This is easy. Just append to the inData list. - */ - - Tcl_ListObjAppendElement(NULL, zshPtr->inData, data); - - /* - * and we'll need the flush parameter for the Inflate call. - */ - - zshPtr->flush = flush; - } - - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_ZlibStreamGet -- - * - * Retrieve data (now compressed or decompressed) from the stream into a - * bytearray Tcl_Obj. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_ZlibStreamGet( - Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */ - Tcl_Obj *data, /* A place to append the data. */ - int count) /* Number of bytes to grab as a maximum, you - * may get less! */ -{ - ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; - int e, i, listLen, itemLen, dataPos = 0; - Tcl_Obj *itemObj; - unsigned char *dataPtr, *itemPtr; - int existing; - - /* - * Getting beyond the of stream, just return empty string. - */ - - if (zshPtr->streamEnd) { - return TCL_OK; - } - - (void) Tcl_GetByteArrayFromObj(data, &existing); - - if (zshPtr->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 = MAX_BUFFER_SIZE; - } - - /* - * Prepare the place to store the data. - */ - - dataPtr = Tcl_SetByteArrayLength(data, existing+count); - dataPtr += existing; - - zshPtr->stream.next_out = dataPtr; - zshPtr->stream.avail_out = count; - if (zshPtr->stream.avail_in == 0) { - /* - * zlib will probably need more data to decompress. - */ - - if (zshPtr->currentInput) { - Tcl_DecrRefCount(zshPtr->currentInput); - zshPtr->currentInput = NULL; - } - Tcl_ListObjLength(NULL, zshPtr->inData, &listLen); - if (listLen > 0) { - /* - * There is more input available, get it from the list and - * give it to zlib. At this point, the data must not be shared - * since we require the bytearray representation to not vanish - * under our feet. [Bug 3081008] - */ - - Tcl_ListObjIndex(NULL, zshPtr->inData, 0, &itemObj); - if (Tcl_IsShared(itemObj)) { - itemObj = Tcl_DuplicateObj(itemObj); - } - itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); - Tcl_IncrRefCount(itemObj); - zshPtr->currentInput = itemObj; - zshPtr->stream.next_in = itemPtr; - zshPtr->stream.avail_in = itemLen; - - /* - * And remove it from the list - */ - - Tcl_ListObjReplace(NULL, zshPtr->inData, 0, 1, 0, NULL); - } - } - - /* - * When dealing with a raw stream, we set the dictionary here, once. - * (You can't do it in response to getting Z_NEED_DATA as raw streams - * don't ever issue that.) - */ - - if (IsRawStream(zshPtr) && HaveDictToSet(zshPtr)) { - e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj); - if (e != Z_OK) { - if (zshPtr->interp) { - ConvertError(zshPtr->interp, e, zshPtr->stream.adler); - } - return TCL_ERROR; - } - DictWasSet(zshPtr); - } - e = inflate(&zshPtr->stream, zshPtr->flush); - if (e == Z_NEED_DICT && HaveDictToSet(zshPtr)) { - e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj); - if (e == Z_OK) { - DictWasSet(zshPtr); - e = inflate(&zshPtr->stream, zshPtr->flush); - } - }; - Tcl_ListObjLength(NULL, zshPtr->inData, &listLen); - - while ((zshPtr->stream.avail_out > 0) - && (e == Z_OK || e == Z_BUF_ERROR) && (listLen > 0)) { - /* - * State: We have not satisfied the request yet and there may be - * more to inflate. - */ - - if (zshPtr->stream.avail_in > 0) { - if (zshPtr->interp) { - Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( - "unexpected zlib internal state during" - " decompression", -1)); - Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "STATE", - NULL); - } - Tcl_SetByteArrayLength(data, existing); - return TCL_ERROR; - } - - if (zshPtr->currentInput) { - Tcl_DecrRefCount(zshPtr->currentInput); - zshPtr->currentInput = 0; - } - - /* - * Get the next block of data to go to inflate. At this point, the - * data must not be shared since we require the bytearray - * representation to not vanish under our feet. [Bug 3081008] - */ - - Tcl_ListObjIndex(zshPtr->interp, zshPtr->inData, 0, &itemObj); - if (Tcl_IsShared(itemObj)) { - itemObj = Tcl_DuplicateObj(itemObj); - } - itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); - Tcl_IncrRefCount(itemObj); - zshPtr->currentInput = itemObj; - zshPtr->stream.next_in = itemPtr; - zshPtr->stream.avail_in = itemLen; - - /* - * Remove it from the list. - */ - - Tcl_ListObjReplace(NULL, zshPtr->inData, 0, 1, 0, NULL); - listLen--; - - /* - * And call inflate again. - */ - - do { - e = inflate(&zshPtr->stream, zshPtr->flush); - if (e != Z_NEED_DICT || !HaveDictToSet(zshPtr)) { - break; - } - e = SetInflateDictionary(&zshPtr->stream,zshPtr->compDictObj); - DictWasSet(zshPtr); - } while (e == Z_OK); - } - if (zshPtr->stream.avail_out > 0) { - Tcl_SetByteArrayLength(data, - existing + count - zshPtr->stream.avail_out); - } - if (!(e==Z_OK || e==Z_STREAM_END || e==Z_BUF_ERROR)) { - Tcl_SetByteArrayLength(data, existing); - ConvertError(zshPtr->interp, e, zshPtr->stream.adler); - return TCL_ERROR; - } - if (e == Z_STREAM_END) { - zshPtr->streamEnd = 1; - if (zshPtr->currentInput) { - Tcl_DecrRefCount(zshPtr->currentInput); - zshPtr->currentInput = 0; - } - inflateEnd(&zshPtr->stream); - } - } else { - Tcl_ListObjLength(NULL, zshPtr->outData, &listLen); - if (count == -1) { - count = 0; - for (i=0; i<listLen; i++) { - Tcl_ListObjIndex(NULL, zshPtr->outData, i, &itemObj); - itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); - if (i == 0) { - count += itemLen - zshPtr->outPos; - } else { - count += itemLen; - } - } - } - - /* - * Prepare the place to store the data. - */ - - dataPtr = Tcl_SetByteArrayLength(data, existing + count); - dataPtr += existing; - - while ((count > dataPos) && - (Tcl_ListObjLength(NULL, zshPtr->outData, &listLen) == TCL_OK) - && (listLen > 0)) { - /* - * Get the next chunk off our list of chunks and grab the data out - * of it. - */ - - Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj); - itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen); - if (itemLen-zshPtr->outPos >= count-dataPos) { - unsigned len = count - dataPos; - - memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len); - zshPtr->outPos += len; - dataPos += len; - if (zshPtr->outPos == itemLen) { - zshPtr->outPos = 0; - } - } else { - unsigned len = itemLen - zshPtr->outPos; - - memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len); - dataPos += len; - zshPtr->outPos = 0; - } - if (zshPtr->outPos == 0) { - Tcl_ListObjReplace(NULL, zshPtr->outData, 0, 1, 0, NULL); - listLen--; - } - } - Tcl_SetByteArrayLength(data, existing + dataPos); - } - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_ZlibDeflate -- - * - * Compress the contents of Tcl_Obj *data with compression level in - * output format, producing the compressed data in the interpreter - * result. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_ZlibDeflate( - Tcl_Interp *interp, - int format, - Tcl_Obj *data, - int level, - Tcl_Obj *gzipHeaderDictObj) -{ - int wbits = 0, inLen = 0, e = 0, extraSize = 0; - Byte *inData = NULL; - z_stream stream; - GzipHeader header; - gz_header *headerPtr = NULL; - Tcl_Obj *obj; - - if (!interp) { - return TCL_ERROR; - } - - /* - * Compressed format is specified by the wbits parameter. See zlib.h for - * details. - */ - - if (format == TCL_ZLIB_FORMAT_RAW) { - wbits = WBITS_RAW; - } else if (format == TCL_ZLIB_FORMAT_GZIP) { - wbits = WBITS_GZIP; - - /* - * Need to allocate extra space for the gzip header and footer. The - * amount of space is (a bit less than) 32 bytes, plus a byte for each - * byte of string that we add. Note that over-allocation is not a - * problem. [Bug 2419061] - */ - - extraSize = 32; - if (gzipHeaderDictObj) { - headerPtr = &header.header; - memset(headerPtr, 0, sizeof(gz_header)); - if (GenerateHeader(interp, gzipHeaderDictObj, &header, - &extraSize) != TCL_OK) { - return TCL_ERROR; - } - } - } else if (format == TCL_ZLIB_FORMAT_ZLIB) { - wbits = WBITS_ZLIB; - } 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"); - } - - /* - * Allocate some space to store the output. - */ - - TclNewObj(obj); - - /* - * Obtain the pointer to the byte array, we'll pass this pointer straight - * to the deflate command. - */ - - inData = Tcl_GetByteArrayFromObj(data, &inLen); - memset(&stream, 0, sizeof(z_stream)); - stream.avail_in = (uInt) inLen; - stream.next_in = inData; - - /* - * No output buffer available yet, will alloc after deflateInit2. - */ - - e = deflateInit2(&stream, level, Z_DEFLATED, wbits, MAX_MEM_LEVEL, - Z_DEFAULT_STRATEGY); - if (e != Z_OK) { - goto error; - } - - if (headerPtr != NULL) { - e = deflateSetHeader(&stream, headerPtr); - if (e != Z_OK) { - goto 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, inLen) + extraSize; - stream.next_out = Tcl_SetByteArrayLength(obj, stream.avail_out); - - /* - * Perform the compression, Z_FINISH means do it in one go. - */ - - e = deflate(&stream, Z_FINISH); - - if (e != Z_STREAM_END) { - e = 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) { - goto error; - } - - /* - * Reduce the bytearray length to the actual data length produced by - * deflate. - */ - - Tcl_SetByteArrayLength(obj, stream.total_out); - Tcl_SetObjResult(interp, obj); - return TCL_OK; - - error: - ConvertError(interp, e, stream.adler); - TclDecrRefCount(obj); - return TCL_ERROR; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_ZlibInflate -- - * - * Decompress data in an object into the interpreter result. - * - *---------------------------------------------------------------------- - */ - -int -Tcl_ZlibInflate( - Tcl_Interp *interp, - int format, - Tcl_Obj *data, - int bufferSize, - Tcl_Obj *gzipHeaderDictObj) -{ - int wbits = 0, inLen = 0, e = 0, newBufferSize; - Byte *inData = NULL, *outData = NULL, *newOutData = NULL; - z_stream stream; - gz_header header, *headerPtr = NULL; - Tcl_Obj *obj; - char *nameBuf = NULL, *commentBuf = NULL; - - if (!interp) { - return TCL_ERROR; - } - - /* - * Compressed format is specified by the wbits parameter. See zlib.h for - * details. - */ - - switch (format) { - case TCL_ZLIB_FORMAT_RAW: - wbits = WBITS_RAW; - gzipHeaderDictObj = NULL; - break; - case TCL_ZLIB_FORMAT_ZLIB: - wbits = WBITS_ZLIB; - gzipHeaderDictObj = NULL; - break; - case TCL_ZLIB_FORMAT_GZIP: - wbits = WBITS_GZIP; - break; - case TCL_ZLIB_FORMAT_AUTO: - wbits = WBITS_AUTODETECT; - break; - default: - 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"); - } - - if (gzipHeaderDictObj) { - headerPtr = &header; - memset(headerPtr, 0, sizeof(gz_header)); - nameBuf = ckalloc(MAXPATHLEN); - header.name = (Bytef *) nameBuf; - header.name_max = MAXPATHLEN - 1; - commentBuf = ckalloc(MAX_COMMENT_LEN); - header.comment = (Bytef *) commentBuf; - header.comm_max = MAX_COMMENT_LEN - 1; - } - - inData = Tcl_GetByteArrayFromObj(data, &inLen); - if (bufferSize < 1) { - /* - * Start with a buffer (up to) 3 times the size of the input data. - */ - - if (inLen < 32*1024*1024) { - bufferSize = 3*inLen; - } else if (inLen < 256*1024*1024) { - bufferSize = 2*inLen; - } else { - bufferSize = inLen; - } - } - - TclNewObj(obj); - outData = Tcl_SetByteArrayLength(obj, bufferSize); - memset(&stream, 0, sizeof(z_stream)); - 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; - - /* - * Initialize zlib for decompression. - */ - - e = inflateInit2(&stream, wbits); - if (e != Z_OK) { - goto error; - } - if (headerPtr) { - e = inflateGetHeader(&stream, headerPtr); - if (e != Z_OK) { - goto error; - } - } - - /* - * Start the decompression cycle. - */ - - 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)) { - e = Z_STREAM_ERROR; - goto 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); - goto error; - } - - e = inflateEnd(&stream); - if (e != Z_OK) { - goto error; - } - - /* - * Reduce the BA length to the actual data length produced by deflate. - */ - - Tcl_SetByteArrayLength(obj, stream.total_out); - if (headerPtr != NULL) { - ExtractHeader(&header, gzipHeaderDictObj); - SetValue(gzipHeaderDictObj, "size", - Tcl_NewLongObj((long) stream.total_out)); - ckfree(nameBuf); - ckfree(commentBuf); - } - Tcl_SetObjResult(interp, obj); - return TCL_OK; - - error: - TclDecrRefCount(obj); - ConvertError(interp, e, stream.adler); - if (nameBuf) { - ckfree(nameBuf); - } - if (commentBuf) { - ckfree(commentBuf); - } - return TCL_ERROR; -} - -/* - *---------------------------------------------------------------------- - * - * Tcl_ZlibCRC32, Tcl_ZlibAdler32 -- - * - * Access to the checksumming engines. - * - *---------------------------------------------------------------------- - */ - -unsigned int -Tcl_ZlibCRC32( - unsigned int crc, - const unsigned char *buf, - int len) -{ - /* Nothing much to do, just wrap the crc32(). */ - return crc32(crc, (Bytef *) buf, (unsigned) len); -} - -unsigned int -Tcl_ZlibAdler32( - unsigned int adler, - const unsigned char *buf, - int len) -{ - return adler32(adler, (Bytef *) buf, (unsigned) len); -} - -/* - *---------------------------------------------------------------------- - * - * ZlibCmd -- - * - * Implementation of the [zlib] command. - * - *---------------------------------------------------------------------- - */ - -static int -ZlibCmd( - ClientData notUsed, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - int command, dlen, i, option, level = -1; - unsigned start, buffersize = 0; - Byte *data; - Tcl_Obj *headerDictObj; - const char *extraInfoStr = NULL; - static const char *const commands[] = { - "adler32", "compress", "crc32", "decompress", "deflate", "gunzip", - "gzip", "inflate", "push", "stream", - NULL - }; - enum zlibCommands { - CMD_ADLER, CMD_COMPRESS, CMD_CRC, CMD_DECOMPRESS, CMD_DEFLATE, - CMD_GUNZIP, CMD_GZIP, CMD_INFLATE, CMD_PUSH, CMD_STREAM - }; - - if (objc < 2) { - 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 CMD_ADLER: /* adler32 str ?startvalue? - * -> checksum */ - if (objc < 3 || objc > 4) { - Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?"); - return TCL_ERROR; - } - if (objc>3 && Tcl_GetIntFromObj(interp, objv[3], - (int *) &start) != TCL_OK) { - return TCL_ERROR; - } - if (objc < 4) { - start = Tcl_ZlibAdler32(0, NULL, 0); - } - data = Tcl_GetByteArrayFromObj(objv[2], &dlen); - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) - (uLong) Tcl_ZlibAdler32(start, data, dlen))); - return TCL_OK; - case CMD_CRC: /* crc32 str ?startvalue? - * -> checksum */ - if (objc < 3 || objc > 4) { - Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?"); - return TCL_ERROR; - } - if (objc>3 && Tcl_GetIntFromObj(interp, objv[3], - (int *) &start) != TCL_OK) { - return TCL_ERROR; - } - if (objc < 4) { - start = Tcl_ZlibCRC32(0, NULL, 0); - } - data = Tcl_GetByteArrayFromObj(objv[2], &dlen); - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) - (uLong) Tcl_ZlibCRC32(start, data, dlen))); - return TCL_OK; - case CMD_DEFLATE: /* deflate data ?level? - * -> rawCompressedData */ - if (objc < 3 || objc > 4) { - Tcl_WrongNumArgs(interp, 2, objv, "data ?level?"); - return TCL_ERROR; - } - if (objc > 3) { - if (Tcl_GetIntFromObj(interp, objv[3], &level) != TCL_OK) { - return TCL_ERROR; - } - if (level < 0 || level > 9) { - goto badLevel; - } - } - return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2], level, - NULL); - case CMD_COMPRESS: /* compress data ?level? - * -> zlibCompressedData */ - if (objc < 3 || objc > 4) { - Tcl_WrongNumArgs(interp, 2, objv, "data ?level?"); - return TCL_ERROR; - } - if (objc > 3) { - if (Tcl_GetIntFromObj(interp, objv[3], &level) != TCL_OK) { - return TCL_ERROR; - } - if (level < 0 || level > 9) { - goto badLevel; - } - } - return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], level, - NULL); - case CMD_GZIP: /* gzip data ?level? - * -> gzippedCompressedData */ - headerDictObj = NULL; - - /* - * Legacy argument format support. - */ - - if (objc == 4 - && Tcl_GetIntFromObj(interp, objv[3], &level) == TCL_OK) { - if (level < 0 || level > 9) { - extraInfoStr = "\n (in -level option)"; - goto badLevel; - } - return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2], - level, NULL); - } - - if (objc < 3 || objc > 7 || ((objc & 1) == 0)) { - Tcl_WrongNumArgs(interp, 2, objv, - "data ?-level level? ?-header header?"); - return TCL_ERROR; - } - for (i=3 ; i<objc ; i+=2) { - static const char *const gzipopts[] = { - "-header", "-level", NULL - }; - - if (Tcl_GetIndexFromObj(interp, objv[i], gzipopts, "option", 0, - &option) != TCL_OK) { - return TCL_ERROR; - } - switch (option) { - case 0: - headerDictObj = objv[i+1]; - break; - case 1: - if (Tcl_GetIntFromObj(interp, objv[i+1], - &level) != TCL_OK) { - return TCL_ERROR; - } - if (level < 0 || level > 9) { - extraInfoStr = "\n (in -level option)"; - goto badLevel; - } - break; - } - } - return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2], level, - headerDictObj); - case CMD_INFLATE: /* inflate rawcomprdata ?bufferSize? - * -> decompressedData */ - if (objc < 3 || objc > 4) { - Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?"); - return TCL_ERROR; - } - if (objc > 3) { - if (Tcl_GetIntFromObj(interp, objv[3], - (int *) &buffersize) != TCL_OK) { - return TCL_ERROR; - } - if (buffersize < MIN_NONSTREAM_BUFFER_SIZE - || buffersize > MAX_BUFFER_SIZE) { - goto badBuffer; - } - } - return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2], - buffersize, NULL); - case CMD_DECOMPRESS: /* decompress zlibcomprdata \ - * ?bufferSize? - * -> decompressedData */ - if (objc < 3 || objc > 4) { - Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?"); - return TCL_ERROR; - } - if (objc > 3) { - if (Tcl_GetIntFromObj(interp, objv[3], - (int *) &buffersize) != TCL_OK) { - return TCL_ERROR; - } - if (buffersize < MIN_NONSTREAM_BUFFER_SIZE - || buffersize > MAX_BUFFER_SIZE) { - goto badBuffer; - } - } - return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], - buffersize, NULL); - case CMD_GUNZIP: { /* gunzip gzippeddata ?bufferSize? - * -> decompressedData */ - Tcl_Obj *headerVarObj; - - if (objc < 3 || objc > 5 || ((objc & 1) == 0)) { - Tcl_WrongNumArgs(interp, 2, objv, "data ?-headerVar varName?"); - return TCL_ERROR; - } - headerDictObj = headerVarObj = NULL; - for (i=3 ; i<objc ; i+=2) { - static const char *const gunzipopts[] = { - "-buffersize", "-headerVar", NULL - }; - - if (Tcl_GetIndexFromObj(interp, objv[i], gunzipopts, "option", 0, - &option) != TCL_OK) { - return TCL_ERROR; - } - switch (option) { - case 0: - if (Tcl_GetIntFromObj(interp, objv[i+1], - (int *) &buffersize) != TCL_OK) { - return TCL_ERROR; - } - if (buffersize < MIN_NONSTREAM_BUFFER_SIZE - || buffersize > MAX_BUFFER_SIZE) { - goto badBuffer; - } - break; - case 1: - headerVarObj = objv[i+1]; - headerDictObj = Tcl_NewObj(); - break; - } - } - if (Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2], - buffersize, headerDictObj) != TCL_OK) { - if (headerDictObj) { - TclDecrRefCount(headerDictObj); - } - return TCL_ERROR; - } - if (headerVarObj != NULL && Tcl_ObjSetVar2(interp, headerVarObj, NULL, - headerDictObj, TCL_LEAVE_ERR_MSG) == NULL) { - return TCL_ERROR; - } - return TCL_OK; - } - case CMD_STREAM: /* stream deflate/inflate/...gunzip \ - * ?options...? - * -> handleCmd */ - return ZlibStreamSubcmd(interp, objc, objv); - case CMD_PUSH: /* push mode channel options... - * -> channel */ - return ZlibPushSubcmd(interp, objc, objv); - }; - - return TCL_ERROR; - - badLevel: - Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL); - if (extraInfoStr) { - Tcl_AddErrorInfo(interp, extraInfoStr); - } - return TCL_ERROR; - badBuffer: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "buffer size must be %d to %d", - MIN_NONSTREAM_BUFFER_SIZE, MAX_BUFFER_SIZE)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL); - return TCL_ERROR; -} - -/* - *---------------------------------------------------------------------- - * - * ZlibStreamSubcmd -- - * - * Implementation of the [zlib stream] subcommand. - * - *---------------------------------------------------------------------- - */ - -static int -ZlibStreamSubcmd( - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - static const char *const stream_formats[] = { - "compress", "decompress", "deflate", "gunzip", "gzip", "inflate", - NULL - }; - enum zlibFormats { - FMT_COMPRESS, FMT_DECOMPRESS, FMT_DEFLATE, FMT_GUNZIP, FMT_GZIP, - FMT_INFLATE - }; - int i, format, mode = 0, option, level; - enum objIndices { - OPT_COMPRESSION_DICTIONARY = 0, - OPT_GZIP_HEADER = 1, - OPT_COMPRESSION_LEVEL = 2, - OPT_END = -1 - }; - Tcl_Obj *obj[3] = { NULL, NULL, NULL }; -#define compDictObj obj[OPT_COMPRESSION_DICTIONARY] -#define gzipHeaderObj obj[OPT_GZIP_HEADER] -#define levelObj obj[OPT_COMPRESSION_LEVEL] - typedef struct { - const char *name; - enum objIndices offset; - } OptDescriptor; - static const OptDescriptor compressionOpts[] = { - { "-dictionary", OPT_COMPRESSION_DICTIONARY }, - { "-level", OPT_COMPRESSION_LEVEL }, - { NULL, OPT_END } - }; - static const OptDescriptor gzipOpts[] = { - { "-header", OPT_GZIP_HEADER }, - { "-level", OPT_COMPRESSION_LEVEL }, - { NULL, OPT_END } - }; - static const OptDescriptor expansionOpts[] = { - { "-dictionary", OPT_COMPRESSION_DICTIONARY }, - { NULL, OPT_END } - }; - static const OptDescriptor gunzipOpts[] = { - { NULL, OPT_END } - }; - const OptDescriptor *desc = NULL; - Tcl_ZlibStream zh; - - if (objc < 3 || !(objc & 1)) { - Tcl_WrongNumArgs(interp, 2, objv, "mode ?-option value...?"); - return TCL_ERROR; - } - if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0, - &format) != TCL_OK) { - return TCL_ERROR; - } - - /* - * The format determines the compression mode and the options that may be - * specified. - */ - - switch ((enum zlibFormats) format) { - case FMT_DEFLATE: - desc = compressionOpts; - mode = TCL_ZLIB_STREAM_DEFLATE; - format = TCL_ZLIB_FORMAT_RAW; - break; - case FMT_INFLATE: - desc = expansionOpts; - mode = TCL_ZLIB_STREAM_INFLATE; - format = TCL_ZLIB_FORMAT_RAW; - break; - case FMT_COMPRESS: - desc = compressionOpts; - mode = TCL_ZLIB_STREAM_DEFLATE; - format = TCL_ZLIB_FORMAT_ZLIB; - break; - case FMT_DECOMPRESS: - desc = expansionOpts; - mode = TCL_ZLIB_STREAM_INFLATE; - format = TCL_ZLIB_FORMAT_ZLIB; - break; - case FMT_GZIP: - desc = gzipOpts; - mode = TCL_ZLIB_STREAM_DEFLATE; - format = TCL_ZLIB_FORMAT_GZIP; - break; - case FMT_GUNZIP: - desc = gunzipOpts; - mode = TCL_ZLIB_STREAM_INFLATE; - format = TCL_ZLIB_FORMAT_GZIP; - break; - default: - Tcl_Panic("should be unreachable"); - } - - /* - * Parse the options. - */ - - for (i=3 ; i<objc ; i+=2) { - if (Tcl_GetIndexFromObjStruct(interp, objv[i], desc, - sizeof(OptDescriptor), "option", 0, &option) != TCL_OK) { - return TCL_ERROR; - } - obj[desc[option].offset] = objv[i+1]; - } - - /* - * If a compression level was given, parse it (integral: 0..9). Otherwise - * use the default. - */ - - if (levelObj == NULL) { - level = Z_DEFAULT_COMPRESSION; - } else if (Tcl_GetIntFromObj(interp, levelObj, &level) != TCL_OK) { - return TCL_ERROR; - } else if (level < 0 || level > 9) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9",-1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL); - Tcl_AddErrorInfo(interp, "\n (in -level option)"); - return TCL_ERROR; - } - - /* - * Construct the stream now we know its configuration. - */ - - if (Tcl_ZlibStreamInit(interp, mode, format, level, gzipHeaderObj, - &zh) != TCL_OK) { - return TCL_ERROR; - } - if (compDictObj != NULL) { - Tcl_ZlibStreamSetCompressionDictionary(zh, compDictObj); - } - Tcl_SetObjResult(interp, Tcl_ZlibStreamGetCommandName(zh)); - return TCL_OK; -#undef compDictObj -#undef gzipHeaderObj -#undef levelObj -} - -/* - *---------------------------------------------------------------------- - * - * ZlibPushSubcmd -- - * - * Implementation of the [zlib push] subcommand. - * - *---------------------------------------------------------------------- - */ - -static int -ZlibPushSubcmd( - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - static const char *const stream_formats[] = { - "compress", "decompress", "deflate", "gunzip", "gzip", "inflate", - NULL - }; - enum zlibFormats { - FMT_COMPRESS, FMT_DECOMPRESS, FMT_DEFLATE, FMT_GUNZIP, FMT_GZIP, - FMT_INFLATE - }; - Tcl_Channel chan; - int chanMode, format, mode = 0, level, i, option; - static const char *const pushCompressOptions[] = { - "-dictionary", "-header", "-level", NULL - }; - static const char *const pushDecompressOptions[] = { - "-dictionary", "-header", "-level", "-limit", NULL - }; - const char *const *pushOptions = pushDecompressOptions; - enum pushOptions {poDictionary, poHeader, poLevel, poLimit}; - Tcl_Obj *headerObj = NULL, *compDictObj = NULL; - int limit = 1, dummy; - - if (objc < 4) { - Tcl_WrongNumArgs(interp, 2, objv, "mode channel ?options...?"); - return TCL_ERROR; - } - - if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0, - &format) != TCL_OK) { - return TCL_ERROR; - } - switch ((enum zlibFormats) format) { - case FMT_DEFLATE: - mode = TCL_ZLIB_STREAM_DEFLATE; - format = TCL_ZLIB_FORMAT_RAW; - pushOptions = pushCompressOptions; - break; - case FMT_INFLATE: - mode = TCL_ZLIB_STREAM_INFLATE; - format = TCL_ZLIB_FORMAT_RAW; - break; - case FMT_COMPRESS: - mode = TCL_ZLIB_STREAM_DEFLATE; - format = TCL_ZLIB_FORMAT_ZLIB; - pushOptions = pushCompressOptions; - break; - case FMT_DECOMPRESS: - mode = TCL_ZLIB_STREAM_INFLATE; - format = TCL_ZLIB_FORMAT_ZLIB; - break; - case FMT_GZIP: - mode = TCL_ZLIB_STREAM_DEFLATE; - format = TCL_ZLIB_FORMAT_GZIP; - pushOptions = pushCompressOptions; - break; - case FMT_GUNZIP: - mode = TCL_ZLIB_STREAM_INFLATE; - format = TCL_ZLIB_FORMAT_GZIP; - break; - default: - Tcl_Panic("should be unreachable"); - } - - if (TclGetChannelFromObj(interp, objv[3], &chan, &chanMode, 0) != TCL_OK){ - return TCL_ERROR; - } - - /* - * Sanity checks. - */ - - if (mode == TCL_ZLIB_STREAM_DEFLATE && !(chanMode & TCL_WRITABLE)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "compression may only be applied to writable channels", -1)); - Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNWRITABLE", NULL); - return TCL_ERROR; - } - if (mode == TCL_ZLIB_STREAM_INFLATE && !(chanMode & TCL_READABLE)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "decompression may only be applied to readable channels",-1)); - Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNREADABLE", NULL); - return TCL_ERROR; - } - - /* - * Parse options. - */ - - level = Z_DEFAULT_COMPRESSION; - for (i=4 ; i<objc ; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], pushOptions, "option", 0, - &option) != TCL_OK) { - return TCL_ERROR; - } - if (++i > objc-1) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "value missing for %s option", pushOptions[option])); - Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL); - return TCL_ERROR; - } - switch ((enum pushOptions) option) { - case poHeader: - headerObj = objv[i]; - if (Tcl_DictObjSize(interp, headerObj, &dummy) != TCL_OK) { - goto genericOptionError; - } - break; - case poLevel: - if (Tcl_GetIntFromObj(interp, objv[i], (int*) &level) != TCL_OK) { - goto genericOptionError; - } - if (level < 0 || level > 9) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "level must be 0 to 9", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", - NULL); - goto genericOptionError; - } - break; - case poLimit: - if (Tcl_GetIntFromObj(interp, objv[i], (int*) &limit) != TCL_OK) { - goto genericOptionError; - } - if (limit < 1 || limit > MAX_BUFFER_SIZE) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "read ahead limit must be 1 to %d", - MAX_BUFFER_SIZE)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL); - goto genericOptionError; - } - break; - case poDictionary: - if (format == TCL_ZLIB_FORMAT_GZIP) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "a compression dictionary may not be set in the " - "gzip format", -1)); - Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOPT", NULL); - goto genericOptionError; - } - compDictObj = objv[i]; - break; - } - } - - if (ZlibStackChannelTransform(interp, mode, format, level, limit, chan, - headerObj, compDictObj) == NULL) { - return TCL_ERROR; - } - Tcl_SetObjResult(interp, objv[3]); - return TCL_OK; - - genericOptionError: - Tcl_AddErrorInfo(interp, "\n (in "); - Tcl_AddErrorInfo(interp, pushOptions[option]); - Tcl_AddErrorInfo(interp, " option)"); - return TCL_ERROR; -} - -/* - *---------------------------------------------------------------------- - * - * ZlibStreamCmd -- - * - * Implementation of the commands returned by [zlib stream]. - * - *---------------------------------------------------------------------- - */ - -static int -ZlibStreamCmd( - ClientData cd, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - Tcl_ZlibStream zstream = cd; - int command, count, code; - Tcl_Obj *obj; - static const char *const cmds[] = { - "add", "checksum", "close", "eof", "finalize", "flush", - "fullflush", "get", "header", "put", "reset", - NULL - }; - enum zlibStreamCommands { - zs_add, zs_checksum, zs_close, zs_eof, zs_finalize, zs_flush, - zs_fullflush, zs_get, zs_header, zs_put, zs_reset - }; - - 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: /* $strm add ?$flushopt? $data */ - return ZlibStreamAddCmd(zstream, interp, objc, objv); - case zs_header: /* $strm header */ - return ZlibStreamHeaderCmd(zstream, interp, objc, objv); - case zs_put: /* $strm put ?$flushopt? $data */ - return ZlibStreamPutCmd(zstream, interp, objc, objv); - - case zs_get: /* $strm get ?count? */ - if (objc > 3) { - Tcl_WrongNumArgs(interp, 2, objv, "?count?"); - return TCL_ERROR; - } - - count = -1; - if (objc >= 3) { - if (Tcl_GetIntFromObj(interp, objv[2], &count) != TCL_OK) { - return TCL_ERROR; - } - } - TclNewObj(obj); - code = Tcl_ZlibStreamGet(zstream, obj, count); - if (code == TCL_OK) { - Tcl_SetObjResult(interp, obj); - } else { - TclDecrRefCount(obj); - } - return code; - case zs_flush: /* $strm flush */ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return TCL_ERROR; - } - TclNewObj(obj); - Tcl_IncrRefCount(obj); - code = Tcl_ZlibStreamPut(zstream, obj, Z_SYNC_FLUSH); - TclDecrRefCount(obj); - return code; - case zs_fullflush: /* $strm fullflush */ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return TCL_ERROR; - } - TclNewObj(obj); - Tcl_IncrRefCount(obj); - code = Tcl_ZlibStreamPut(zstream, obj, Z_FULL_FLUSH); - TclDecrRefCount(obj); - return code; - case zs_finalize: /* $strm finalize */ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return TCL_ERROR; - } - - /* - * The flush commands slightly abuse the empty result obj as input - * data. - */ - - TclNewObj(obj); - Tcl_IncrRefCount(obj); - code = Tcl_ZlibStreamPut(zstream, obj, Z_FINISH); - TclDecrRefCount(obj); - return code; - case zs_close: /* $strm close */ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return TCL_ERROR; - } - return Tcl_ZlibStreamClose(zstream); - case zs_eof: /* $strm eof */ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return TCL_ERROR; - } - Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_ZlibStreamEof(zstream))); - return TCL_OK; - case zs_checksum: /* $strm checksum */ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return TCL_ERROR; - } - Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) - (uLong) Tcl_ZlibStreamChecksum(zstream))); - return TCL_OK; - case zs_reset: /* $strm reset */ - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return TCL_ERROR; - } - return Tcl_ZlibStreamReset(zstream); - } - - return TCL_OK; -} - -static int -ZlibStreamAddCmd( - ClientData cd, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - Tcl_ZlibStream zstream = cd; - int index, code, buffersize = -1, flush = -1, i; - Tcl_Obj *obj, *compDictObj = NULL; - static const char *const add_options[] = { - "-buffer", "-dictionary", "-finalize", "-flush", "-fullflush", NULL - }; - enum addOptions { - ao_buffer, ao_dictionary, ao_finalize, ao_flush, ao_fullflush - }; - - 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_SetObjResult(interp, Tcl_NewStringObj( - "\"-buffer\" option must be followed by integer " - "decompression buffersize", -1)); - Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL); - return TCL_ERROR; - } - if (Tcl_GetIntFromObj(interp, objv[++i], &buffersize) != TCL_OK) { - return TCL_ERROR; - } - if (buffersize < 1 || buffersize > MAX_BUFFER_SIZE) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "buffer size must be 1 to %d", - MAX_BUFFER_SIZE)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL); - return TCL_ERROR; - } - break; - case ao_dictionary: - if (i == objc-2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "\"-dictionary\" option must be followed by" - " compression dictionary bytes", -1)); - Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL); - return TCL_ERROR; - } - compDictObj = objv[++i]; - break; - } - - if (flush == -2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "\"-flush\", \"-fullflush\" and \"-finalize\" options" - " are mutually exclusive", -1)); - Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL); - return TCL_ERROR; - } - } - if (flush == -1) { - flush = 0; - } - - /* - * Set the compression dictionary if requested. - */ - - if (compDictObj != NULL) { - int len; - - (void) Tcl_GetByteArrayFromObj(compDictObj, &len); - if (len == 0) { - compDictObj = NULL; - } - Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj); - } - - /* - * Send the data to the stream core, along with any flushing directive. - */ - - if (Tcl_ZlibStreamPut(zstream, objv[objc-1], flush) != TCL_OK) { - return TCL_ERROR; - } - - /* - * Get such data out as we can (up to the requested length). - */ - - TclNewObj(obj); - code = Tcl_ZlibStreamGet(zstream, obj, buffersize); - if (code == TCL_OK) { - Tcl_SetObjResult(interp, obj); - } else { - TclDecrRefCount(obj); - } - return code; -} - -static int -ZlibStreamPutCmd( - ClientData cd, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - Tcl_ZlibStream zstream = cd; - int index, flush = -1, i; - Tcl_Obj *compDictObj = NULL; - static const char *const put_options[] = { - "-dictionary", "-finalize", "-flush", "-fullflush", NULL - }; - enum putOptions { - po_dictionary, po_finalize, po_flush, po_fullflush - }; - - for (i=2; i<objc-1; i++) { - if (Tcl_GetIndexFromObj(interp, objv[i], put_options, "option", 0, - &index) != TCL_OK) { - return TCL_ERROR; - } - - switch ((enum putOptions) index) { - case po_flush: /* -flush */ - if (flush > -1) { - flush = -2; - } else { - flush = Z_SYNC_FLUSH; - } - break; - case po_fullflush: /* -fullflush */ - if (flush > -1) { - flush = -2; - } else { - flush = Z_FULL_FLUSH; - } - break; - case po_finalize: /* -finalize */ - if (flush > -1) { - flush = -2; - } else { - flush = Z_FINISH; - } - break; - case po_dictionary: - if (i == objc-2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "\"-dictionary\" option must be followed by" - " compression dictionary bytes", -1)); - Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL); - return TCL_ERROR; - } - compDictObj = objv[++i]; - break; - } - if (flush == -2) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "\"-flush\", \"-fullflush\" and \"-finalize\" options" - " are mutually exclusive", -1)); - Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL); - return TCL_ERROR; - } - } - if (flush == -1) { - flush = 0; - } - - /* - * Set the compression dictionary if requested. - */ - - if (compDictObj != NULL) { - int len; - - (void) Tcl_GetByteArrayFromObj(compDictObj, &len); - if (len == 0) { - compDictObj = NULL; - } - Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj); - } - - /* - * Send the data to the stream core, along with any flushing directive. - */ - - return Tcl_ZlibStreamPut(zstream, objv[objc-1], flush); -} - -static int -ZlibStreamHeaderCmd( - ClientData cd, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - ZlibStreamHandle *zshPtr = cd; - Tcl_Obj *resultObj; - - if (objc != 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return TCL_ERROR; - } else if (zshPtr->mode != TCL_ZLIB_STREAM_INFLATE - || zshPtr->format != TCL_ZLIB_FORMAT_GZIP) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "only gunzip streams can produce header information", -1)); - Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOP", NULL); - return TCL_ERROR; - } - - TclNewObj(resultObj); - ExtractHeader(&zshPtr->gzHeaderPtr->header, resultObj); - Tcl_SetObjResult(interp, resultObj); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * Set of functions to support channel stacking. - *---------------------------------------------------------------------- - * - * ZlibTransformClose -- - * - * How to shut down a stacked compressing/decompressing transform. - * - *---------------------------------------------------------------------- - */ - -static int -ZlibTransformClose( - ClientData instanceData, - Tcl_Interp *interp) -{ - ZlibChannelData *cd = instanceData; - int e, result = TCL_OK; - - /* - * Delete the support timer. - */ - - ZlibTransformEventTimerKill(cd); - - /* - * Flush any data waiting to be compressed. - */ - - if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { - cd->outStream.avail_in = 0; - do { - cd->outStream.next_out = (Bytef *) cd->outBuffer; - cd->outStream.avail_out = (unsigned) cd->outAllocated; - e = deflate(&cd->outStream, Z_FINISH); - if (e != Z_OK && e != Z_STREAM_END) { - /* TODO: is this the right way to do errors on close? */ - if (!TclInThreadExit()) { - ConvertError(interp, e, cd->outStream.adler); - } - result = TCL_ERROR; - break; - } - if (cd->outStream.avail_out != (unsigned) cd->outAllocated) { - if (Tcl_WriteRaw(cd->parent, cd->outBuffer, - cd->outAllocated - cd->outStream.avail_out) < 0) { - /* TODO: is this the right way to do errors on close? - * Note: when close is called from FinalizeIOSubsystem - * then interp may be NULL */ - if (!TclInThreadExit() && interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "error while finalizing file: %s", - Tcl_PosixError(interp))); - } - result = TCL_ERROR; - break; - } - } - } while (e != Z_STREAM_END); - e = deflateEnd(&cd->outStream); - } else { - e = inflateEnd(&cd->inStream); - } - - /* - * Release all memory. - */ - - if (cd->compDictObj) { - Tcl_DecrRefCount(cd->compDictObj); - cd->compDictObj = NULL; - } - Tcl_DStringFree(&cd->decompressed); - - if (cd->inBuffer) { - ckfree(cd->inBuffer); - cd->inBuffer = NULL; - } - if (cd->outBuffer) { - ckfree(cd->outBuffer); - cd->outBuffer = NULL; - } - ckfree(cd); - return result; -} - -/* - *---------------------------------------------------------------------- - * - * ZlibTransformInput -- - * - * Reader filter that does decompression. - * - *---------------------------------------------------------------------- - */ - -static int -ZlibTransformInput( - ClientData instanceData, - char *buf, - int toRead, - int *errorCodePtr) -{ - ZlibChannelData *cd = instanceData; - Tcl_DriverInputProc *inProc = - Tcl_ChannelInputProc(Tcl_GetChannelType(cd->parent)); - int readBytes, gotBytes, copied; - - if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { - return inProc(Tcl_GetChannelInstanceData(cd->parent), buf, toRead, - errorCodePtr); - } - - gotBytes = 0; - while (toRead > 0) { - /* - * Loop until the request is satisfied (or no data available from - * below, possibly EOF). - */ - - copied = ResultCopy(cd, buf, toRead); - toRead -= copied; - buf += copied; - gotBytes += copied; - - if (toRead == 0) { - return gotBytes; - } - - /* - * The buffer is exhausted, but the caller wants even more. We now - * have to go to the underlying channel, get more bytes and then - * transform them for delivery. We may not get what we want (full EOF - * or temporarily out of data). - * - * Length (cd->decompressed) == 0, toRead > 0 here. - * - * The zlib transform allows us to read at most one character from the - * underlying channel to properly identify Z_STREAM_END without - * reading over the border. - */ - - readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, cd->readAheadLimit); - - /* - * Three cases here: - * 1. Got some data from the underlying channel (readBytes > 0) so - * it should be fed through the decompression engine. - * 2. Got an error (readBytes < 0) which we should report up except - * for the case where we can convert it to a short read. - * 3. Got an end-of-data from EOF or blocking (readBytes == 0). If - * it is EOF, try flushing the data out of the decompressor. - */ - - if (readBytes < 0) { - - /* See ReflectInput() in tclIORTrans.c */ - if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) { - return gotBytes; - } - - *errorCodePtr = Tcl_GetErrno(); - return -1; - } - if (readBytes == 0) { - /* - * Eof in parent. - * - * Now this is a bit different. The partial data waiting is - * converted and returned. - */ - - if (ResultGenerate(cd, 0, Z_SYNC_FLUSH, errorCodePtr) != TCL_OK) { - return -1; - } - - if (Tcl_DStringLength(&cd->decompressed) == 0) { - /* - * The drain delivered nothing. Time to deliver what we've - * got. - */ - - return gotBytes; - } - } else /* readBytes > 0 */ { - /* - * Transform the read chunk, which was not empty. Anything we get - * back is a transformation result to be put into our buffers, and - * the next iteration will put it into the result. - */ - - if (ResultGenerate(cd, readBytes, Z_NO_FLUSH, - errorCodePtr) != TCL_OK) { - return -1; - } - } - } - return gotBytes; -} - -/* - *---------------------------------------------------------------------- - * - * ZlibTransformOutput -- - * - * Writer filter that does compression. - * - *---------------------------------------------------------------------- - */ - -static int -ZlibTransformOutput( - ClientData instanceData, - const char *buf, - int toWrite, - int *errorCodePtr) -{ - ZlibChannelData *cd = instanceData; - Tcl_DriverOutputProc *outProc = - Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent)); - int e, produced; - Tcl_Obj *errObj; - - if (cd->mode == TCL_ZLIB_STREAM_INFLATE) { - return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite, - errorCodePtr); - } - - cd->outStream.next_in = (Bytef *) buf; - cd->outStream.avail_in = toWrite; - do { - cd->outStream.next_out = (Bytef *) cd->outBuffer; - cd->outStream.avail_out = cd->outAllocated; - - e = deflate(&cd->outStream, Z_NO_FLUSH); - produced = cd->outAllocated - cd->outStream.avail_out; - - if (e == Z_OK && produced > 0) { - if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) { - *errorCodePtr = Tcl_GetErrno(); - return -1; - } - } - } while (e == Z_OK && produced > 0 && cd->outStream.avail_in > 0); - - if (e == Z_OK) { - return toWrite - cd->outStream.avail_in; - } - - errObj = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1)); - Tcl_ListObjAppendElement(NULL, errObj, - ConvertErrorToList(e, cd->outStream.adler)); - Tcl_ListObjAppendElement(NULL, errObj, - Tcl_NewStringObj(cd->outStream.msg, -1)); - Tcl_SetChannelError(cd->parent, errObj); - *errorCodePtr = EINVAL; - return -1; -} - -/* - *---------------------------------------------------------------------- - * - * ZlibTransformSetOption -- - * - * Writing side of [fconfigure] on our channel. - * - *---------------------------------------------------------------------- - */ - -static int -ZlibTransformSetOption( /* not used */ - ClientData instanceData, - Tcl_Interp *interp, - const char *optionName, - const char *value) -{ - ZlibChannelData *cd = instanceData; - Tcl_DriverSetOptionProc *setOptionProc = - Tcl_ChannelSetOptionProc(Tcl_GetChannelType(cd->parent)); - static const char *compressChanOptions = "dictionary flush"; - static const char *gzipChanOptions = "flush"; - static const char *decompressChanOptions = "dictionary limit"; - static const char *gunzipChanOptions = "flush limit"; - int haveFlushOpt = (cd->mode == TCL_ZLIB_STREAM_DEFLATE); - - if (optionName && (strcmp(optionName, "-dictionary") == 0) - && (cd->format != TCL_ZLIB_FORMAT_GZIP)) { - Tcl_Obj *compDictObj; - int code; - - TclNewStringObj(compDictObj, value, strlen(value)); - Tcl_IncrRefCount(compDictObj); - (void) Tcl_GetByteArrayFromObj(compDictObj, NULL); - if (cd->compDictObj) { - TclDecrRefCount(cd->compDictObj); - } - cd->compDictObj = compDictObj; - code = Z_OK; - if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { - code = SetDeflateDictionary(&cd->outStream, compDictObj); - if (code != Z_OK) { - ConvertError(interp, code, cd->outStream.adler); - return TCL_ERROR; - } - } else if (cd->format == TCL_ZLIB_FORMAT_RAW) { - code = SetInflateDictionary(&cd->inStream, compDictObj); - if (code != Z_OK) { - ConvertError(interp, code, cd->inStream.adler); - return TCL_ERROR; - } - } - return TCL_OK; - } - - if (haveFlushOpt) { - if (optionName && strcmp(optionName, "-flush") == 0) { - int flushType; - - if (value[0] == 'f' && strcmp(value, "full") == 0) { - flushType = Z_FULL_FLUSH; - } else if (value[0] == 's' && strcmp(value, "sync") == 0) { - flushType = Z_SYNC_FLUSH; - } else { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown -flush type \"%s\": must be full or sync", - value)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "FLUSH", NULL); - return TCL_ERROR; - } - - /* - * Try to actually do the flush now. - */ - - cd->outStream.avail_in = 0; - while (1) { - int e; - - cd->outStream.next_out = (Bytef *) cd->outBuffer; - cd->outStream.avail_out = cd->outAllocated; - - e = deflate(&cd->outStream, flushType); - if (e == Z_BUF_ERROR) { - break; - } else if (e != Z_OK) { - ConvertError(interp, e, cd->outStream.adler); - return TCL_ERROR; - } else if (cd->outStream.avail_out == 0) { - break; - } - - if (Tcl_WriteRaw(cd->parent, cd->outBuffer, - cd->outStream.next_out - (Bytef *) cd->outBuffer)<0) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "problem flushing channel: %s", - Tcl_PosixError(interp))); - return TCL_ERROR; - } - } - return TCL_OK; - } - } else { - if (optionName && strcmp(optionName, "-limit") == 0) { - int newLimit; - - if (Tcl_GetInt(interp, value, &newLimit) != TCL_OK) { - return TCL_ERROR; - } else if (newLimit < 1 || newLimit > MAX_BUFFER_SIZE) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "-limit must be between 1 and 65536", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "READLIMIT", NULL); - return TCL_ERROR; - } - } - } - - if (setOptionProc == NULL) { - if (cd->format == TCL_ZLIB_FORMAT_GZIP) { - return Tcl_BadChannelOption(interp, optionName, - (cd->mode == TCL_ZLIB_STREAM_DEFLATE) - ? gzipChanOptions : gunzipChanOptions); - } else { - return Tcl_BadChannelOption(interp, optionName, - (cd->mode == TCL_ZLIB_STREAM_DEFLATE) - ? compressChanOptions : decompressChanOptions); - } - } - - /* - * Pass all unknown options down, to deeper transforms and/or the base - * channel. - */ - - return setOptionProc(Tcl_GetChannelInstanceData(cd->parent), interp, - optionName, value); -} - -/* - *---------------------------------------------------------------------- - * - * ZlibTransformGetOption -- - * - * Reading side of [fconfigure] on our channel. - * - *---------------------------------------------------------------------- - */ - -static int -ZlibTransformGetOption( - ClientData instanceData, - Tcl_Interp *interp, - const char *optionName, - Tcl_DString *dsPtr) -{ - ZlibChannelData *cd = instanceData; - Tcl_DriverGetOptionProc *getOptionProc = - Tcl_ChannelGetOptionProc(Tcl_GetChannelType(cd->parent)); - static const char *compressChanOptions = "checksum dictionary"; - static const char *gzipChanOptions = "checksum"; - static const char *decompressChanOptions = "checksum dictionary limit"; - static const char *gunzipChanOptions = "checksum header limit"; - - /* - * The "crc" option reports the current CRC (calculated with the Adler32 - * or CRC32 algorithm according to the format) given the data that has - * been processed so far. - */ - - if (optionName == NULL || strcmp(optionName, "-checksum") == 0) { - uLong crc; - char buf[12]; - - if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { - crc = cd->outStream.adler; - } else { - crc = cd->inStream.adler; - } - - sprintf(buf, "%lu", crc); - if (optionName == NULL) { - Tcl_DStringAppendElement(dsPtr, "-checksum"); - Tcl_DStringAppendElement(dsPtr, buf); - } else { - Tcl_DStringAppend(dsPtr, buf, -1); - return TCL_OK; - } - } - - if ((cd->format != TCL_ZLIB_FORMAT_GZIP) && - (optionName == NULL || strcmp(optionName, "-dictionary") == 0)) { - /* - * Embedded NUL bytes are ok; they'll be C080-encoded. - */ - - if (optionName == NULL) { - Tcl_DStringAppendElement(dsPtr, "-dictionary"); - if (cd->compDictObj) { - Tcl_DStringAppendElement(dsPtr, - Tcl_GetString(cd->compDictObj)); - } else { - Tcl_DStringAppendElement(dsPtr, ""); - } - } else { - int len; - const char *str = Tcl_GetStringFromObj(cd->compDictObj, &len); - - Tcl_DStringAppend(dsPtr, str, len); - } - } - - /* - * The "header" option, which is only valid on inflating gzip channels, - * reports the header that has been read from the start of the stream. - */ - - if ((cd->flags & IN_HEADER) && ((optionName == NULL) || - (strcmp(optionName, "-header") == 0))) { - Tcl_Obj *tmpObj = Tcl_NewObj(); - - ExtractHeader(&cd->inHeader.header, tmpObj); - if (optionName == NULL) { - Tcl_DStringAppendElement(dsPtr, "-header"); - Tcl_DStringAppendElement(dsPtr, Tcl_GetString(tmpObj)); - Tcl_DecrRefCount(tmpObj); - } else { - TclDStringAppendObj(dsPtr, tmpObj); - Tcl_DecrRefCount(tmpObj); - return TCL_OK; - } - } - - /* - * Now we do the standard processing of the stream we wrapped. - */ - - if (getOptionProc) { - return getOptionProc(Tcl_GetChannelInstanceData(cd->parent), - interp, optionName, dsPtr); - } - if (optionName == NULL) { - return TCL_OK; - } - if (cd->format == TCL_ZLIB_FORMAT_GZIP) { - return Tcl_BadChannelOption(interp, optionName, - (cd->mode == TCL_ZLIB_STREAM_DEFLATE) - ? gzipChanOptions : gunzipChanOptions); - } else { - return Tcl_BadChannelOption(interp, optionName, - (cd->mode == TCL_ZLIB_STREAM_DEFLATE) - ? compressChanOptions : decompressChanOptions); - } -} - -/* - *---------------------------------------------------------------------- - * - * ZlibTransformWatch, ZlibTransformEventHandler -- - * - * If we have data pending, trigger a readable event after a short time - * (in order to allow a real event to catch up). - * - *---------------------------------------------------------------------- - */ - -static void -ZlibTransformWatch( - ClientData instanceData, - int mask) -{ - ZlibChannelData *cd = instanceData; - Tcl_DriverWatchProc *watchProc; - - /* - * This code is based on the code in tclIORTrans.c - */ - - watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(cd->parent)); - watchProc(Tcl_GetChannelInstanceData(cd->parent), mask); - - if (!(mask & TCL_READABLE) || Tcl_DStringLength(&cd->decompressed) == 0) { - ZlibTransformEventTimerKill(cd); - } else if (cd->timer == NULL) { - cd->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ZlibTransformTimerRun, cd); - } -} - -static int -ZlibTransformEventHandler( - ClientData instanceData, - int interestMask) -{ - ZlibChannelData *cd = instanceData; - - ZlibTransformEventTimerKill(cd); - return interestMask; -} - -static inline void -ZlibTransformEventTimerKill( - ZlibChannelData *cd) -{ - if (cd->timer != NULL) { - Tcl_DeleteTimerHandler(cd->timer); - cd->timer = NULL; - } -} - -static void -ZlibTransformTimerRun( - ClientData clientData) -{ - ZlibChannelData *cd = clientData; - - cd->timer = NULL; - Tcl_NotifyChannel(cd->chan, TCL_READABLE); -} - -/* - *---------------------------------------------------------------------- - * - * ZlibTransformGetHandle -- - * - * Anything that needs the OS handle is told to get it from what we are - * stacked on top of. - * - *---------------------------------------------------------------------- - */ - -static int -ZlibTransformGetHandle( - ClientData instanceData, - int direction, - ClientData *handlePtr) -{ - ZlibChannelData *cd = instanceData; - - return Tcl_GetChannelHandle(cd->parent, direction, handlePtr); -} - -/* - *---------------------------------------------------------------------- - * - * ZlibTransformBlockMode -- - * - * We need to keep track of the blocking mode; it changes our behavior. - * - *---------------------------------------------------------------------- - */ - -static int -ZlibTransformBlockMode( - ClientData instanceData, - int mode) -{ - ZlibChannelData *cd = instanceData; - - if (mode == TCL_MODE_NONBLOCKING) { - cd->flags |= ASYNC; - } else { - cd->flags &= ~ASYNC; - } - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * ZlibStackChannelTransform -- - * - * Stacks either compression or decompression onto a channel. - * - * Results: - * The stacked channel, or NULL if there was an error. - * - *---------------------------------------------------------------------- - */ - -static Tcl_Channel -ZlibStackChannelTransform( - Tcl_Interp *interp, /* Where to write error messages. */ - int mode, /* Whether this is a compressing transform - * (TCL_ZLIB_STREAM_DEFLATE) or a - * decompressing transform - * (TCL_ZLIB_STREAM_INFLATE). Note that - * compressing transforms require that the - * channel is writable, and decompressing - * transforms require that the channel is - * readable. */ - int format, /* One of the TCL_ZLIB_FORMAT_* values that - * indicates what compressed format to allow. - * TCL_ZLIB_FORMAT_AUTO is only supported for - * decompressing transforms. */ - int level, /* What compression level to use. Ignored for - * decompressing transforms. */ - int limit, /* The limit on the number of bytes to read - * ahead; always at least 1. */ - Tcl_Channel channel, /* The channel to attach to. */ - Tcl_Obj *gzipHeaderDictPtr, /* A description of header to use, or NULL to - * use a default. Ignored if not compressing - * to produce gzip-format data. */ - Tcl_Obj *compDictObj) /* Byte-array object containing compression - * dictionary (not dictObj!) to use if - * necessary. */ -{ - ZlibChannelData *cd = ckalloc(sizeof(ZlibChannelData)); - Tcl_Channel chan; - int wbits = 0; - int e; - - if (mode != TCL_ZLIB_STREAM_DEFLATE && mode != TCL_ZLIB_STREAM_INFLATE) { - Tcl_Panic("unknown mode: %d", mode); - } - - memset(cd, 0, sizeof(ZlibChannelData)); - cd->mode = mode; - cd->format = format; - cd->readAheadLimit = limit; - - if (format == TCL_ZLIB_FORMAT_GZIP || format == TCL_ZLIB_FORMAT_AUTO) { - if (mode == TCL_ZLIB_STREAM_DEFLATE) { - if (gzipHeaderDictPtr) { - cd->flags |= OUT_HEADER; - if (GenerateHeader(interp, gzipHeaderDictPtr, &cd->outHeader, - NULL) != TCL_OK) { - goto error; - } - } - } else { - cd->flags |= IN_HEADER; - cd->inHeader.header.name = (Bytef *) - &cd->inHeader.nativeFilenameBuf; - cd->inHeader.header.name_max = MAXPATHLEN - 1; - cd->inHeader.header.comment = (Bytef *) - &cd->inHeader.nativeCommentBuf; - cd->inHeader.header.comm_max = MAX_COMMENT_LEN - 1; - } - } - - if (compDictObj != NULL) { - cd->compDictObj = Tcl_DuplicateObj(compDictObj); - Tcl_IncrRefCount(cd->compDictObj); - Tcl_GetByteArrayFromObj(cd->compDictObj, NULL); - } - - if (format == TCL_ZLIB_FORMAT_RAW) { - wbits = WBITS_RAW; - } else if (format == TCL_ZLIB_FORMAT_ZLIB) { - wbits = WBITS_ZLIB; - } else if (format == TCL_ZLIB_FORMAT_GZIP) { - wbits = WBITS_GZIP; - } else if (format == TCL_ZLIB_FORMAT_AUTO) { - wbits = WBITS_AUTODETECT; - } else { - Tcl_Panic("bad format: %d", format); - } - - /* - * Initialize input inflater or the output deflater. - */ - - if (mode == TCL_ZLIB_STREAM_INFLATE) { - e = inflateInit2(&cd->inStream, wbits); - if (e != Z_OK) { - goto error; - } - cd->inAllocated = DEFAULT_BUFFER_SIZE; - cd->inBuffer = ckalloc(cd->inAllocated); - if (cd->flags & IN_HEADER) { - e = inflateGetHeader(&cd->inStream, &cd->inHeader.header); - if (e != Z_OK) { - goto error; - } - } - if (cd->format == TCL_ZLIB_FORMAT_RAW && cd->compDictObj) { - e = SetInflateDictionary(&cd->inStream, cd->compDictObj); - if (e != Z_OK) { - goto error; - } - TclDecrRefCount(cd->compDictObj); - cd->compDictObj = NULL; - } - } else { - e = deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits, - MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY); - if (e != Z_OK) { - goto error; - } - cd->outAllocated = DEFAULT_BUFFER_SIZE; - cd->outBuffer = ckalloc(cd->outAllocated); - if (cd->flags & OUT_HEADER) { - e = deflateSetHeader(&cd->outStream, &cd->outHeader.header); - if (e != Z_OK) { - goto error; - } - } - if (cd->compDictObj) { - e = SetDeflateDictionary(&cd->outStream, cd->compDictObj); - if (e != Z_OK) { - goto error; - } - } - } - - Tcl_DStringInit(&cd->decompressed); - - chan = Tcl_StackChannel(interp, &zlibChannelType, cd, - Tcl_GetChannelMode(channel), channel); - if (chan == NULL) { - goto error; - } - cd->chan = chan; - cd->parent = Tcl_GetStackedChannel(chan); - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); - return chan; - - error: - if (cd->inBuffer) { - ckfree(cd->inBuffer); - inflateEnd(&cd->inStream); - } - if (cd->outBuffer) { - ckfree(cd->outBuffer); - deflateEnd(&cd->outStream); - } - if (cd->compDictObj) { - Tcl_DecrRefCount(cd->compDictObj); - } - ckfree(cd); - return NULL; -} - -/* - *---------------------------------------------------------------------- - * - * ResultCopy -- - * - * Copies the requested number of bytes from the buffer into the - * specified array and removes them from the buffer afterward. Copies - * less if there is not enough data in the buffer. - * - * Side effects: - * See above. - * - * Result: - * The number of actually copied bytes, possibly less than 'toRead'. - * - *---------------------------------------------------------------------- - */ - -static inline int -ResultCopy( - ZlibChannelData *cd, /* The location of the buffer to read from. */ - char *buf, /* The buffer to copy into */ - int toRead) /* Number of requested bytes */ -{ - int have = Tcl_DStringLength(&cd->decompressed); - - if (have == 0) { - /* - * Nothing to copy in the case of an empty buffer. - */ - - return 0; - } else if (have > toRead) { - /* - * The internal buffer contains more than requested. Copy the - * requested subset to the caller, shift the remaining bytes down, and - * truncate. - */ - - char *src = Tcl_DStringValue(&cd->decompressed); - - memcpy(buf, src, toRead); - memmove(src, src + toRead, have - toRead); - - Tcl_DStringSetLength(&cd->decompressed, have - toRead); - return toRead; - } else /* have <= toRead */ { - /* - * There is just or not enough in the buffer to fully satisfy the - * caller, so take everything as best effort. - */ - - memcpy(buf, Tcl_DStringValue(&cd->decompressed), have); - TclDStringClear(&cd->decompressed); - return have; - } -} - -/* - *---------------------------------------------------------------------- - * - * ResultGenerate -- - * - * Extract uncompressed bytes from the compression engine and store them - * in our working buffer. - * - * Result: - * TCL_OK/TCL_ERROR (with *errorCodePtr updated with reason). - * - * Side effects: - * See above. - * - *---------------------------------------------------------------------- - */ - -static int -ResultGenerate( - ZlibChannelData *cd, - int n, - int flush, - int *errorCodePtr) -{ -#define MAXBUF 1024 - unsigned char buf[MAXBUF]; - int e, written; - Tcl_Obj *errObj; - - cd->inStream.next_in = (Bytef *) cd->inBuffer; - cd->inStream.avail_in = n; - - while (1) { - cd->inStream.next_out = (Bytef *) buf; - cd->inStream.avail_out = MAXBUF; - - e = inflate(&cd->inStream, flush); - if (e == Z_NEED_DICT && cd->compDictObj) { - e = SetInflateDictionary(&cd->inStream, cd->compDictObj); - if (e == Z_OK) { - /* - * A repetition of Z_NEED_DICT is just an error. - */ - - cd->inStream.next_out = (Bytef *) buf; - cd->inStream.avail_out = MAXBUF; - e = inflate(&cd->inStream, flush); - } - } - - /* - * avail_out is now the left over space in the output. Therefore - * "MAXBUF - avail_out" is the amount of bytes generated. - */ - - written = MAXBUF - cd->inStream.avail_out; - if (written) { - Tcl_DStringAppend(&cd->decompressed, (char *) buf, written); - } - - /* - * The cases where we're definitely done. - */ - - if (((flush == Z_SYNC_FLUSH) && (e == Z_BUF_ERROR)) - || (e == Z_STREAM_END) - || (e == Z_OK && cd->inStream.avail_out == 0)) { - return TCL_OK; - } - - /* - * Z_BUF_ERROR can be ignored as per http://www.zlib.net/zlib_how.html - * - * Just indicates that the zlib couldn't consume input/produce output, - * and is fixed by supplying more input. - * - * Otherwise, we've got errors and need to report to higher-up. - */ - - if ((e != Z_OK) && (e != Z_BUF_ERROR)) { - goto handleError; - } - - /* - * Check if the inflate stopped early. - */ - - if (cd->inStream.avail_in <= 0 && flush != Z_SYNC_FLUSH) { - return TCL_OK; - } - } - - handleError: - errObj = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1)); - Tcl_ListObjAppendElement(NULL, errObj, - ConvertErrorToList(e, cd->inStream.adler)); - Tcl_ListObjAppendElement(NULL, errObj, - Tcl_NewStringObj(cd->inStream.msg, -1)); - Tcl_SetChannelError(cd->parent, errObj); - *errorCodePtr = EINVAL; - return TCL_ERROR; -} - -/* - *---------------------------------------------------------------------- - * Finally, the TclZlibInit function. Used to install the zlib API. - *---------------------------------------------------------------------- - */ - -int -TclZlibInit( - Tcl_Interp *interp) -{ - Tcl_Config cfg[2]; - - /* - * This does two things. It creates a counter used in the creation of - * stream commands, and it creates the namespace that will contain those - * commands. - */ - - Tcl_Eval(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}"); - - /* - * Create the public scripted interface to this file's functionality. - */ - - Tcl_CreateObjCommand(interp, "zlib", ZlibCmd, 0, 0); - - /* - * Store the underlying configuration information. - * - * TODO: Describe whether we're using the system version of the library or - * a compatibility version built into Tcl? - */ - - cfg[0].key = "zlibVersion"; - cfg[0].value = zlibVersion(); - cfg[1].key = NULL; - Tcl_RegisterConfig(interp, "zlib", cfg, "iso8859-1"); - - /* - * Formally provide the package as a Tcl built-in. - */ - - return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION); -} - -/* - *---------------------------------------------------------------------- - * Stubs used when a suitable zlib installation was not found during - * configure. - *---------------------------------------------------------------------- - */ - -#else /* !HAVE_ZLIB */ -int -Tcl_ZlibStreamInit( - Tcl_Interp *interp, - int mode, - int format, - int level, - Tcl_Obj *dictObj, - Tcl_ZlibStream *zshandle) -{ - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); - Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); - } - return TCL_ERROR; -} - -int -Tcl_ZlibStreamClose( - Tcl_ZlibStream zshandle) -{ - return TCL_OK; -} - -int -Tcl_ZlibStreamReset( - Tcl_ZlibStream zshandle) -{ - return TCL_OK; -} - -Tcl_Obj * -Tcl_ZlibStreamGetCommandName( - Tcl_ZlibStream zshandle) -{ - return NULL; -} - -int -Tcl_ZlibStreamEof( - Tcl_ZlibStream zshandle) -{ - return 1; -} - -int -Tcl_ZlibStreamChecksum( - Tcl_ZlibStream zshandle) -{ - return 0; -} - -int -Tcl_ZlibStreamPut( - Tcl_ZlibStream zshandle, - Tcl_Obj *data, - int flush) -{ - return TCL_OK; -} - -int -Tcl_ZlibStreamGet( - Tcl_ZlibStream zshandle, - Tcl_Obj *data, - int count) -{ - return TCL_OK; -} - -int -Tcl_ZlibDeflate( - Tcl_Interp *interp, - int format, - Tcl_Obj *data, - int level, - Tcl_Obj *gzipHeaderDictObj) -{ - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); - Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); - } - return TCL_ERROR; -} - -int -Tcl_ZlibInflate( - Tcl_Interp *interp, - int format, - Tcl_Obj *data, - int bufferSize, - Tcl_Obj *gzipHeaderDictObj) -{ - if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); - Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL); - } - return TCL_ERROR; -} - -unsigned int -Tcl_ZlibCRC32( - unsigned int crc, - const char *buf, - int len) -{ - return 0; -} - -unsigned int -Tcl_ZlibAdler32( - unsigned int adler, - const char *buf, - int len) -{ - return 0; -} - -void -Tcl_ZlibStreamSetCompressionDictionary( - Tcl_ZlibStream zshandle, - Tcl_Obj *compressionDictionaryObj) -{ - /* Do nothing. */ -} -#endif /* HAVE_ZLIB */ - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ |