Last-Modified: Tue, 22 Oct 2024 07:43:04 GMT
Expires: Fri, 20 Oct 2034 07:43:04 GMT
tcl.git - Tcl is a high-level, general-purpose, interpreted, dynamic programming language. It was designed with the goal of being very simple but powerful.
# Commands covered: llength
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: llength.test,v 1.5 2000/04/10 17:19:01 ericm Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
test llength-1.1 {length of list} {
llength {a b c d}
} 4
test llength-1.2 {length of list} {
llength {a b c {a b {c d}} d}
} 5
test llength-1.3 {length of list} {
llength {}
} 0
test llength-2.1 {error conditions} {
list [catch {llength} msg] $msg
} {1 {wrong # args: should be "llength list"}}
test llength-2.2 {error conditions} {
list [catch {llength 123 2} msg] $msg
} {1 {wrong # args: should be "llength list"}}
test llength-2.3 {error conditions} {
list [catch {llength "a b c \{"} msg] $msg
} {1 {unmatched open brace in list}}
# cleanup
::tcltest::cleanupTests
return
/* * 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 256typedefstruct{
gz_header header;char nativeFilenameBuf[MAXPATHLEN];char nativeCommentBuf[MAX_COMMENT_LEN];} GzipHeader;/* * Structure used for the Tcl_ZlibStream* commands and [zlib stream ...] */typedefstruct{
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. */typedefstruct{
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 voidConvertError(Tcl_Interp *interp,int code,
uLong adler);static Tcl_Obj *ConvertErrorToList(int code, uLong adler);static voidExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);static intGenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
GzipHeader *headerPtr,int*extraSizePtr);static intZlibPushSubcmd(Tcl_Interp *interp,int objc,
Tcl_Obj *const objv[]);staticinlineintResultCopy(ZlibChannelData *cd,char*buf,int toRead);static intResultGenerate(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 voidZlibStreamCleanup(ZlibStreamHandle *zshPtr);static intZlibStreamSubcmd(Tcl_Interp *interp,int objc,
Tcl_Obj *const objv[]);staticinlinevoidZlibTransformEventTimerKill(ZlibChannelData *cd);static voidZlibTransformTimerRun(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 voidConvertError(
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");returnTcl_NewListObj(3, objv);case Z_DATA_ERROR:TclNewLiteralStringObj(objv[2],"DATA");returnTcl_NewListObj(3, objv);case Z_MEM_ERROR:TclNewLiteralStringObj(objv[2],"MEM");returnTcl_NewListObj(3, objv);case Z_BUF_ERROR:TclNewLiteralStringObj(objv[2],"BUF");returnTcl_NewListObj(3, objv);case Z_VERSION_ERROR:TclNewLiteralStringObj(objv[2],"VERSION");returnTcl_NewListObj(3, objv);case Z_ERRNO:TclNewLiteralStringObj(objv[2],"POSIX");
objv[3] =Tcl_NewStringObj(Tcl_ErrnoId(), -1);returnTcl_NewListObj(4, objv);case Z_NEED_DICT:TclNewLiteralStringObj(objv[2],"NEED_DICT");
objv[3] =Tcl_NewWideIntObj((Tcl_WideInt) adler);returnTcl_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);returnTcl_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. * *---------------------------------------------------------------------- */staticinlineintGetValue(
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 intGenerateHeader(
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 voidExtractHeader(
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 intSetInflateDictionary(
z_streamp strm,
Tcl_Obj *compDictObj){if(compDictObj != NULL) {int length;unsigned char*bytes =Tcl_GetByteArrayFromObj(compDictObj, &length);returninflateSetDictionary(strm, bytes, (unsigned) length);}return Z_OK;}static intSetDeflateDictionary(
z_streamp strm,
Tcl_Obj *compDictObj){if(compDictObj != NULL) {int length;unsigned char*bytes =Tcl_GetByteArrayFromObj(compDictObj, &length);returndeflateSetDictionary(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. * *---------------------------------------------------------------------- */intTcl_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 voidZlibStreamCmdDelete(
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 * *---------------------------------------------------------------------- */intTcl_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. * *---------------------------------------------------------------------- */voidZlibStreamCleanup(
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. * *---------------------------------------------------------------------- */intTcl_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. * *---------------------------------------------------------------------- */intTcl_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. * *---------------------------------------------------------------------- */intTcl_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. * *---------------------------------------------------------------------- */voidTcl_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. * *---------------------------------------------------------------------- */intTcl_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. * *---------------------------------------------------------------------- */intTcl_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. * *---------------------------------------------------------------------- */intTcl_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. * *---------------------------------------------------------------------- */intTcl_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) {inflateEnd(&stream);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;break;}
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 intTcl_ZlibCRC32(unsigned int crc,const unsigned char*buf,int len){/* Nothing much to do, just wrap the crc32(). */returncrc32(crc, (Bytef *) buf, (unsigned) len);}unsigned intTcl_ZlibAdler32(unsigned int adler,const unsigned char*buf,int len){returnadler32(adler, (Bytef *) buf, (unsigned) len);}/* *---------------------------------------------------------------------- * * ZlibCmd -- * * Implementation of the [zlib] command. * *---------------------------------------------------------------------- */static intZlibCmd(
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;}}returnTcl_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;}}returnTcl_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;}returnTcl_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) {case0:
headerDictObj = objv[i+1];break;case1: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;}}returnTcl_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;}}returnTcl_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;}}returnTcl_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) {case0: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;case1:
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 */returnZlibStreamSubcmd(interp, objc, objv);case CMD_PUSH:/* push mode channel options... * -> channel */returnZlibPushSubcmd(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 intZlibStreamSubcmd(
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]typedefstruct{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 intZlibPushSubcmd(
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 intZlibStreamCmd(
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 */returnZlibStreamAddCmd(zstream, interp, objc, objv);case zs_header:/* $strm header */returnZlibStreamHeaderCmd(zstream, interp, objc, objv);case zs_put:/* $strm put ?$flushopt? $data */returnZlibStreamPutCmd(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;}returnTcl_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;}returnTcl_ZlibStreamReset(zstream);}return TCL_OK;}static intZlibStreamAddCmd(
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 intZlibStreamPutCmd(
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. */returnTcl_ZlibStreamPut(zstream, objv[objc-1], flush);}static intZlibStreamHeaderCmd(
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 intZlibTransformClose(
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 intZlibTransformInput(
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) {returninProc(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 intZlibTransformOutput(
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) {returnoutProc(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 intZlibTransformSetOption(/* 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) {returnTcl_BadChannelOption(interp, optionName,(cd->mode == TCL_ZLIB_STREAM_DEFLATE)
? gzipChanOptions : gunzipChanOptions);}else{returnTcl_BadChannelOption(interp, optionName,(cd->mode == TCL_ZLIB_STREAM_DEFLATE)
? compressChanOptions : decompressChanOptions);}}/* * Pass all unknown options down, to deeper transforms and/or the base * channel. */returnsetOptionProc(Tcl_GetChannelInstanceData(cd->parent), interp,
optionName, value);}/* *---------------------------------------------------------------------- * * ZlibTransformGetOption -- * * Reading side of [fconfigure] on our channel. * *---------------------------------------------------------------------- */static intZlibTransformGetOption(
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) {returngetOptionProc(Tcl_GetChannelInstanceData(cd->parent),
interp, optionName, dsPtr);}if(optionName == NULL) {return TCL_OK;}if(cd->format == TCL_ZLIB_FORMAT_GZIP) {returnTcl_BadChannelOption(interp, optionName,(cd->mode == TCL_ZLIB_STREAM_DEFLATE)
? gzipChanOptions : gunzipChanOptions);}else{returnTcl_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 voidZlibTransformWatch(
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 intZlibTransformEventHandler(
ClientData instanceData,int interestMask){
ZlibChannelData *cd = instanceData;ZlibTransformEventTimerKill(cd);return interestMask;}staticinlinevoidZlibTransformEventTimerKill(
ZlibChannelData *cd){if(cd->timer != NULL) {Tcl_DeleteTimerHandler(cd->timer);
cd->timer = NULL;}}static voidZlibTransformTimerRun(
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 intZlibTransformGetHandle(
ClientData instanceData,int direction,
ClientData *handlePtr){
ZlibChannelData *cd = instanceData;returnTcl_GetChannelHandle(cd->parent, direction, handlePtr);}/* *---------------------------------------------------------------------- * * ZlibTransformBlockMode -- * * We need to keep track of the blocking mode; it changes our behavior. * *---------------------------------------------------------------------- */static intZlibTransformBlockMode(
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'. * *---------------------------------------------------------------------- */staticinlineintResultCopy(
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. */return0;}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 intResultGenerate(
ZlibChannelData *cd,int n,int flush,int*errorCodePtr){#define MAXBUF 1024unsigned 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. *---------------------------------------------------------------------- */intTclZlibInit(
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. */returnTcl_PkgProvide(interp,"zlib", TCL_ZLIB_VERSION);}/* *---------------------------------------------------------------------- * Stubs used when a suitable zlib installation was not found during * configure. *---------------------------------------------------------------------- */#else/* !HAVE_ZLIB */intTcl_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;}intTcl_ZlibStreamClose(
Tcl_ZlibStream zshandle){return TCL_OK;}intTcl_ZlibStreamReset(
Tcl_ZlibStream zshandle){return TCL_OK;}
Tcl_Obj *Tcl_ZlibStreamGetCommandName(
Tcl_ZlibStream zshandle){return NULL;}intTcl_ZlibStreamEof(
Tcl_ZlibStream zshandle){return1;}intTcl_ZlibStreamChecksum(
Tcl_ZlibStream zshandle){return0;}intTcl_ZlibStreamPut(
Tcl_ZlibStream zshandle,
Tcl_Obj *data,int flush){return TCL_OK;}intTcl_ZlibStreamGet(
Tcl_ZlibStream zshandle,
Tcl_Obj *data,int count){return TCL_OK;}intTcl_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;}intTcl_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 intTcl_ZlibCRC32(unsigned int crc,const char*buf,int len){return0;}unsigned intTcl_ZlibAdler32(unsigned int adler,const char*buf,int len){return0;}voidTcl_ZlibStreamSetCompressionDictionary(
Tcl_ZlibStream zshandle,
Tcl_Obj *compressionDictionaryObj){/* Do nothing. */}#endif/* HAVE_ZLIB *//* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */