Tcl Source Code

Changes On Branch tip-400-impl
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch tip-400-impl Excluding Merge-Ins

This is equivalent to a diff from 6d7a7b3eb9 to 006482c0ff

2012-10-16
13:04
Implementation of TIP #400. check-in: b6e98440db user: dkf tags: trunk
12:50
merge trunk Closed-Leaf check-in: 006482c0ff user: dkf tags: tip-400-impl
2012-10-14
19:02
Bug 3576509: Better fix, which helps for all Tcl_DictObjGet() calls in Tcl's source code. check-in: 6d7a7b3eb9 user: jan.nijtmans tags: trunk
19:00
Bug 357650: Better fix, which helps for all Tcl_DictObjGet() calls in Tcl's source code. check-in: 4f28137715 user: jan.nijtmans tags: core-8-5-branch
2012-10-13
20:29
Bug 3576509: tcl::Bgerror crashes with invalid arguments check-in: 70a5908228 user: jan.nijtmans tags: trunk
2012-10-04
08:25
merge trunk check-in: 81346a2dc2 user: dkf tags: tip-400-impl, tip-vote

Changes to doc/TclZlib.3.

    45     45   \fBTcl_ZlibStreamChecksum\fR(\fIzshandle\fR)
    46     46   .sp
    47     47   int
    48     48   \fBTcl_ZlibStreamPut\fR(\fIzshandle, dataObj, flush\fR)
    49     49   .sp
    50     50   int
    51     51   \fBTcl_ZlibStreamGet\fR(\fIzshandle, dataObj, count\fR)
           52  +.sp
           53  +\fBTcl_ZlibStreamSetCompressionDictionary\fR(\fIzshandle, compDict\fR)
    52     54   .fi
    53     55   .SH ARGUMENTS
    54         -.AS Tcl_ZlibStream *zshandlePtr out
           56  +.AS Tcl_ZlibStream zshandle in
    55     57   .AP Tcl_Interp *interp in
    56     58   The interpreter to store resulting compressed or uncompressed data in. Also
    57     59   where any error messages are written. For \fBTcl_ZlibStreamInit\fR, this can
    58     60   be NULL to create a stream that is not bound to a command.
    59     61   .AP int format in
    60     62   What format of compressed data to work with. Must be one of
    61     63   \fBTCL_ZLIB_FORMAT_ZLIB\fR for zlib-format data, \fBTCL_ZLIB_FORMAT_GZIP\fR
................................................................................
   104    106   \fBTcl_ZlibStreamGet\fR, \fBTCL_ZLIB_FULLFLUSH\fR if the stream must be put
   105    107   into a state where the decompressor can recover from on corruption, or
   106    108   \fBTCL_ZLIB_FINALIZE\fR to ensure that the stream is finished and that any
   107    109   trailer demanded by the format is written.
   108    110   .AP int count in
   109    111   The maximum number of bytes to get from the stream, or -1 to get all remaining
   110    112   bytes from the stream's buffers.
          113  +.AP Tcl_Obj *compDict in
          114  +A byte array object that is the compression dictionary to use with the stream.
          115  +Note that this is \fInot a Tcl dictionary\fR, and it is recommended that this
          116  +only ever be used with streams that were created with their \fIformat\fR set
          117  +to \fBTCL_ZLIB_FORMAT_ZLIB\fR because the other formats have no mechanism to
          118  +indicate whether a compression dictionary was present other than to fail on
          119  +decompression.
   111    120   .BE
   112    121   .SH DESCRIPTION
   113    122   These functions form the interface from the Tcl library to the Zlib
   114    123   library by Jean-loup Gailly and Mark Adler.
   115    124   .PP
   116    125   \fBTcl_ZlibDeflate\fR and \fBTcl_ZlibInflate\fR respectively compress and
   117    126   decompress the data contained in the \fIdataObj\fR argument, according to the
................................................................................
   167    176   passed to it will have the data bytes appended to it. Internally to the
   168    177   stream, data is kept compressed so as to minimize the cost of buffer space.
   169    178   .PP
   170    179   \fBTcl_ZlibStreamChecksum\fR returns the checksum computed over the
   171    180   uncompressed data according to the format, and \fBTcl_ZlibStreamEof\fR returns
   172    181   a boolean value indicating whether the end of the uncompressed data has been
   173    182   reached.
          183  +.PP
          184  +\fBTcl_ZlibStreamSetCompressionDictionary\fR is used to control the
          185  +compression dictionary used with the stream, a compression dictionary being an
          186  +array of bytes (such as might be created with \fBTcl_NewByteArrayObj\fR) that
          187  +is used to initialize the compression engine rather than leaving it to create
          188  +it on the fly from the data being compressed. Setting a compression dictionary
          189  +allows for more efficient compression in the case where the start of the data
          190  +is highly regular, but it does require both the compressor and the
          191  +decompressor to agreee on the value to use. Compression dictionaries are only
          192  +fully supported for zlib-format data; on compression, they must be set before
          193  +any data is sent in with \fBTcl_ZlibStreamPut\fR, and on decompression they
          194  +should be set when \fBTcl_ZlibStreamGet\fR produces an \fBerror\fR with its
          195  +\fB\-errorcode\fR set to
          196  +.QW "\fBZLIB NEED_DICT\fI code\fR" ;
          197  +the \fIcode\fR will be the Adler-32 checksum (see \fBTcl_ZlibAdler32\fR) of
          198  +the compression dictionary sought. (Note that this is only true for
          199  +zlib-format streams; gzip streams ignore compression dictionaries as the
          200  +format specification doesn't permit them, and raw streams just produce a data
          201  +error if the compression dictionary is missing or incorrect.)
   174    202   .PP
   175    203   If you wish to clear a stream and reuse it for a new compression or
   176    204   decompression action, \fBTcl_ZlibStreamReset\fR will do this and return a
   177    205   normal Tcl result code to indicate whether it was successful; if the stream is
   178    206   registered with an interpreter, an error message will be left in the
   179    207   interpreter result when this function returns TCL_ERROR.
   180    208   Finally, \fBTcl_ZlibStreamClose\fR will clean up the stream and delete the

Changes to doc/zlib.n.

     1      1   '\"
     2         -'\" Copyright (c) 2008 Donal K. Fellows
            2  +'\" Copyright (c) 2008-2012 Donal K. Fellows
     3      3   '\"
     4      4   '\" See the file "license.terms" for information on usage and redistribution
     5      5   '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
     6      6   '\" 
     7      7   .so man.macros
     8      8   .TH zlib n 8.6 Tcl "Tcl Built-In Commands"
     9      9   .BS
................................................................................
   165    165   The transformation will be a decompressing transformation that reads raw
   166    166   compressed data from \fIchannel\fR, which must be readable.
   167    167   .PP
   168    168   The following options may be set when creating a transformation via
   169    169   the
   170    170   .QW "\fIoptions ...\fR"
   171    171   to the \fBzlib push\fR command:
          172  +.TP
          173  +\fB\-dictionary\fI binData\fR
          174  +.VS "TIP 400"
          175  +Sets the compression dictionary to use when working with compressing or
          176  +decompressing the data to be \fIbinData\fR. Not valid for transformations that
          177  +work with gzip-format data.
          178  +.VE
   172    179   .TP
   173    180   \fB\-header\fI dictionary\fR
   174    181   .
   175    182   Passes a description of the gzip header to create, in the same format that
   176    183   \fBzlib gzip\fR understands.
   177    184   .TP
   178    185   \fB\-level\fI compressionLevel\fR
   179    186   .
   180    187   How hard to compress the data. Must be an integer from 0 (uncompressed) to 9
   181    188   (maximally compressed).
   182         -'\".TP
   183         -'\"\fB\-limit\fI readaheadLimit\fR
   184         -'\".
   185         -'\"The maximum number of bytes ahead to read.
   186         -'\"\fITODO: not yet implemented!\fR
          189  +.TP
          190  +\fB\-limit\fI readaheadLimit\fR
          191  +.
          192  +The maximum number of bytes ahead to read when decompressing. This defaults to
          193  +1, which ensures that data is always decompressed correctly, but may be
          194  +increased to improve performance. This is more useful when the channel is
          195  +non-blocking.
   187    196   .PP
   188    197   Both compressing and decompressing channel transformations add extra
   189         -configuration options that may be accessed through \fBchan configure\fR. Each
   190         -option is either a read-only or a write-only option. The options are:
          198  +configuration options that may be accessed through \fBchan configure\fR. The
          199  +options are:
          200  +.TP
          201  +\fB\-checksum\fI checksum\fR
          202  +.
          203  +This read-only option gets the current checksum for the uncompressed data that
          204  +the compression engine has seen so far. It is valid for both compressing and
          205  +decompressing transforms, but not for the raw inflate and deflate formats. The
          206  +compression algorithm depends on what format is being produced or consumed.
          207  +.TP
          208  +\fB\-dictionary\fI binData\fR
          209  +.VS "TIP 400"
          210  +This read-write options gets or sets the compression dictionary to use when
          211  +working with compressing or decompressing the data to be \fIbinData\fR. It is
          212  +not valid for transformations that work with gzip-format data, and should not
          213  +normally be set on compressing transformations other than at the point where
          214  +the transformation is stacked.
          215  +.VE
   191    216   .TP
   192    217   \fB\-flush\fI type\fR
   193    218   .
   194    219   This write-only operation flushes the current state of the compressor to the
   195    220   underlying channel. It is only valid for compressing transformations. The
   196    221   \fItype\fR must be either \fBsync\fR or \fBfull\fR for a normal flush or an
   197    222   expensive flush respectively. Flushing degrades the compression ratio, but
   198    223   makes it easier for a decompressor to recover more of the file in the case of
   199    224   data corruption.
   200    225   .TP
   201         -\fB\-checksum\fR
   202         -.
   203         -This read-only option gets the current checksum for the uncompressed data
   204         -that the compression engine has seen so far. It is valid for both
   205         -compressing and decompressing transforms, but not for the raw inflate
   206         -and deflate formats. The compression algorithm depends on what
   207         -format is being produced or consumed.
   208         -.TP
   209         -\fB\-header\fR
          226  +\fB\-header\fI dictionary\fR
   210    227   .
   211    228   This read-only option, only valid for decompressing transforms that are
   212    229   processing gzip-format data, returns the dictionary describing the header read
   213    230   off the data stream.
          231  +.TP
          232  +\fB\-limit\fI readaheadLimit\fR
          233  +.
          234  +This read-write option is used by decompressing channels to control the
          235  +maximum number of bytes ahead to read from the underlying data source. This
          236  +defaults to 1, which ensures that data is always decompressed correctly, but
          237  +may be increased to improve performance. This is more useful when the channel
          238  +is non-blocking.
   214    239   .RE
   215    240   .SS "STREAMING SUBCOMMAND"
   216    241   .TP
   217         -\fBzlib stream\fI mode\fR ?\fIlevel\fR?
          242  +\fBzlib stream\fI mode\fR ?\fIoptions\fR?
   218    243   .
   219    244   Creates a streaming compression or decompression command based on the
   220    245   \fImode\fR, and return the name of the command. For a description of how that
   221    246   command works, see \fBSTREAMING INSTANCE COMMAND\fR below. The following modes
   222         -are supported:
          247  +and \fIoptions\fR are supported:
   223    248   .RS
   224    249   .TP
   225         -\fBzlib stream compress\fR ?\fIlevel\fR?
          250  +\fBzlib stream compress\fR ?\fB\-dictionary \fIbindata\fR? ?\fB\-level \fIlevel\fR?
   226    251   .
   227    252   The stream will be a compressing stream that produces zlib-format output,
   228    253   using compression level \fIlevel\fR (if specified) which will be an integer
   229         -from 0 to 9.
          254  +from 0 to 9,
          255  +.VS "TIP 400"
          256  +and the compression dictionary \fIbindata\fR (if specified).
          257  +.VE
   230    258   .TP
   231         -\fBzlib stream decompress\fR
          259  +\fBzlib stream decompress\fR ?\fB\-dictionary \fIbindata\fR?
   232    260   .
   233    261   The stream will be a decompressing stream that takes zlib-format input and
   234    262   produces uncompressed output.
          263  +.VS "TIP 400"
          264  +If \fIbindata\fR is supplied, it is a compression dictionary to use if
          265  +required.
          266  +.VE
   235    267   .TP
   236         -\fBzlib stream deflate\fR ?\fIlevel\fR?
          268  +\fBzlib stream deflate\fR ?\fB\-dictionary \fIbindata\fR? ?\fB\-level \fIlevel\fR?
   237    269   .
   238    270   The stream will be a compressing stream that produces raw output, using
   239    271   compression level \fIlevel\fR (if specified) which will be an integer from 0
   240         -to 9.
          272  +to 9,
          273  +.VS "TIP 400"
          274  +and the compression dictionary \fIbindata\fR (if specified). Note that
          275  +the raw compressed data includes no metadata about what compression
          276  +dictionary was used, if any; that is a feature of the zlib-format data.
          277  +.VE
   241    278   .TP
   242    279   \fBzlib stream gunzip\fR
   243    280   .
   244    281   The stream will be a decompressing stream that takes gzip-format input and
   245    282   produces uncompressed output.
   246    283   .TP
   247         -\fBzlib stream gzip\fR ?\fIlevel\fR?
          284  +\fBzlib stream gzip\fR ?\fB\-header \fIheader\fR? ?\fB\-level \fIlevel\fR?
   248    285   .
   249    286   The stream will be a compressing stream that produces gzip-format output,
   250    287   using compression level \fIlevel\fR (if specified) which will be an integer
   251         -from 0 to 9.
   252         -'\" TODO: Header dictionary!
          288  +from 0 to 9, and the header descriptor dictionary \fIheader\fR (if specified;
          289  +for keys see \fBzlib gzip\fR).
   253    290   .TP
   254         -\fBzlib stream inflate\fR
          291  +\fBzlib stream inflate\fR ?\fB\-dictionary \fIbindata\fR?
   255    292   .
   256    293   The stream will be a decompressing stream that takes raw compressed input and
   257    294   produces uncompressed output.
          295  +.VS "TIP 400"
          296  +If \fIbindata\fR is supplied, it is a compression dictionary to use. Note that
          297  +there are no checks in place to determine whether the compression dictionary
          298  +is correct.
          299  +.VE
   258    300   .RE
   259    301   .SS "CHECKSUMMING SUBCOMMANDS"
   260    302   .TP
   261    303   \fBzlib adler32\fI string\fR ?\fIinitValue\fR?
   262    304   .
   263    305   Compute a checksum of binary string \fIstring\fR using the Adler-32 algorithm.
   264    306   If given, \fIinitValue\fR is used to initialize the checksum engine.
................................................................................
   273    315   command. They are used by calling their \fBput\fR subcommand one or more times
   274    316   to load data in, and their \fBget\fR subcommand one or more times to extract
   275    317   the transformed data.
   276    318   .PP
   277    319   The full set of subcommands supported by a streaming instance command,
   278    320   \fIstream\fR, is as follows:
   279    321   .TP
   280         -\fIstream \fBadd\fR ?\fIoption\fR? \fIdata\fR
          322  +\fIstream \fBadd\fR ?\fIoption...\fR? \fIdata\fR
   281    323   .
   282    324   A short-cut for
   283         -.QW "\fIstream \fBput \fIoption data\fR"
          325  +.QW "\fIstream \fBput \fR?\fIoption...\fR? \fIdata\fR"
   284    326   followed by
   285    327   .QW "\fIstream \fBget\fR" .
   286    328   .TP
   287    329   \fIstream \fBchecksum\fR
   288    330   .
   289    331   Returns the checksum of the uncompressed data seen so far by this stream.
   290    332   .TP
................................................................................
   314    356   .QW "\fIstream \fBput \-fullflush {}\fR" .
   315    357   .TP
   316    358   \fIstream \fBget \fR?\fIcount\fR?
   317    359   .
   318    360   Return up to \fIcount\fR bytes from \fIstream\fR's internal buffers with the
   319    361   transformation applied. If \fIcount\fR is omitted, the entire contents of the
   320    362   buffers are returned.
          363  +.
          364  +\fIstream \fBheader\fR
          365  +.
          366  +Return the gzip header description dictionary extracted from the stream. Only
          367  +supported for streams created with their \fImode\fR parameter set to
          368  +\fBgunzip\fR.
   321    369   .TP
   322         -\fIstream \fBput\fR ?\fIoption\fR? \fIdata\fR
          370  +\fIstream \fBput\fR ?\fIoption...\fR? \fIdata\fR
   323    371   .
   324    372   Append the contents of the binary string \fIdata\fR to \fIstream\fR's internal
   325         -buffers while applying the transformation. If present, \fIoption\fR must be
   326         -one of the following (or an unambiguous prefix) which are used to modify the
          373  +buffers while applying the transformation. The following \fIoption\fRs are
          374  +supported (or an unambiguous prefix of them), which are used to modify the
   327    375   way in which the transformation is applied:
   328    376   .RS
          377  +.TP
          378  +\fB\-dictionary\fI binData\fR
          379  +.VS "TIP 400"
          380  +Sets the compression dictionary to use when working with compressing or
          381  +decompressing the data to be \fIbinData\fR.
          382  +.VE
   329    383   .TP
   330    384   \fB\-finalize\fR
   331    385   .
   332    386   Mark the stream as finished, ensuring that all bytes have been wholly
   333    387   compressed or decompressed. For gzip streams, this also ensures that the
   334    388   footer is written to the stream. The stream will need to be reset before
   335    389   having more data written to it after this, though data can still be read out
   336    390   of the stream with the \fBget\fR subcommand.
          391  +.RS
          392  +.PP
          393  +This option is mutually exclusive with the \fB\-flush\fR and \fB\-fullflush\fR
          394  +options.
          395  +.RE
   337    396   .TP
   338    397   \fB\-flush\fR
   339    398   .
   340    399   Ensure that a decompressor consuming the bytes that the current (compressing)
   341    400   stream is producing will be able to produce all the bytes that have been
   342    401   compressed so far, at some performance penalty.
          402  +.RS
          403  +.PP
          404  +This option is mutually exclusive with the \fB\-finalize\fR and
          405  +\fB\-fullflush\fR options.
          406  +.RE
   343    407   .TP
   344    408   \fB\-fullflush\fR
   345    409   .
   346    410   Ensure that not only can a decompressor handle all the bytes produced so far
   347    411   (as with \fB\-flush\fR above) but also that it can restart from this point if
   348    412   it detects that the stream is partially corrupt. This incurs a substantial
   349    413   performance penalty.
          414  +.RS
          415  +.PP
          416  +This option is mutually exclusive with the \fB\-finalize\fR and \fB\-flush\fR
          417  +options.
          418  +.RE
   350    419   .RE
   351    420   .TP
   352    421   \fIstream \fBreset\fR
   353    422   .
   354    423   Puts any stream, including those that have been finalized or that have reached
   355    424   eof, back into a state where it can process more data. Throws away all
   356    425   internally buffered data.

Changes to generic/tcl.decls.

  2313   2313   declare 628 {
  2314   2314       void *Tcl_FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle handle,
  2315   2315   			 const char *symbol)
  2316   2316   }
  2317   2317   declare 629 {
  2318   2318       int Tcl_FSUnloadFile(Tcl_Interp *interp, Tcl_LoadHandle handlePtr)
  2319   2319   }
         2320  +
         2321  +# TIP #400
         2322  +declare 630 {
         2323  +    void Tcl_ZlibStreamSetCompressionDictionary(Tcl_ZlibStream zhandle,
         2324  +	    Tcl_Obj *compressionDictionaryObj)
         2325  +}
  2320   2326   
  2321   2327   # ----- BASELINE -- FOR -- 8.6.0 ----- #
  2322   2328   
  2323   2329   ##############################################################################
  2324   2330   
  2325   2331   # Define the platform specific public Tcl interface. These functions are only
  2326   2332   # available on the designated platform.

Changes to generic/tclDecls.h.

  1803   1803   				void *procPtrs, Tcl_LoadHandle *handlePtr);
  1804   1804   /* 628 */
  1805   1805   EXTERN void *		Tcl_FindSymbol(Tcl_Interp *interp,
  1806   1806   				Tcl_LoadHandle handle, const char *symbol);
  1807   1807   /* 629 */
  1808   1808   EXTERN int		Tcl_FSUnloadFile(Tcl_Interp *interp,
  1809   1809   				Tcl_LoadHandle handlePtr);
         1810  +/* 630 */
         1811  +EXTERN void		Tcl_ZlibStreamSetCompressionDictionary(
         1812  +				Tcl_ZlibStream zhandle,
         1813  +				Tcl_Obj *compressionDictionaryObj);
  1810   1814   
  1811   1815   typedef struct TclStubHooks {
  1812   1816       const struct TclPlatStubs *tclPlatStubs;
  1813   1817       const struct TclIntStubs *tclIntStubs;
  1814   1818       const struct TclIntPlatStubs *tclIntPlatStubs;
  1815   1819   } TclStubHooks;
  1816   1820   
................................................................................
  2468   2472       Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingPtr); /* 623 */
  2469   2473       int (*tcl_CloseEx) (Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 624 */
  2470   2474       int (*tcl_NRExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 625 */
  2471   2475       int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */
  2472   2476       int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */
  2473   2477       void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
  2474   2478       int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
         2479  +    void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
  2475   2480   } TclStubs;
  2476   2481   
  2477   2482   #ifdef __cplusplus
  2478   2483   extern "C" {
  2479   2484   #endif
  2480   2485   extern const TclStubs *tclStubsPtr;
  2481   2486   #ifdef __cplusplus
................................................................................
  3760   3765   	(tclStubsPtr->tcl_NRSubstObj) /* 626 */
  3761   3766   #define Tcl_LoadFile \
  3762   3767   	(tclStubsPtr->tcl_LoadFile) /* 627 */
  3763   3768   #define Tcl_FindSymbol \
  3764   3769   	(tclStubsPtr->tcl_FindSymbol) /* 628 */
  3765   3770   #define Tcl_FSUnloadFile \
  3766   3771   	(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
         3772  +#define Tcl_ZlibStreamSetCompressionDictionary \
         3773  +	(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
  3767   3774   
  3768   3775   #endif /* defined(USE_TCL_STUBS) */
  3769   3776   
  3770   3777   /* !END!: Do not edit above this line. */
  3771   3778   
  3772   3779   #if defined(USE_TCL_STUBS)
  3773   3780   #   undef Tcl_CreateInterp

Changes to generic/tclStubInit.c.

  1283   1283       Tcl_GetStartupScript, /* 623 */
  1284   1284       Tcl_CloseEx, /* 624 */
  1285   1285       Tcl_NRExprObj, /* 625 */
  1286   1286       Tcl_NRSubstObj, /* 626 */
  1287   1287       Tcl_LoadFile, /* 627 */
  1288   1288       Tcl_FindSymbol, /* 628 */
  1289   1289       Tcl_FSUnloadFile, /* 629 */
         1290  +    Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
  1290   1291   };
  1291   1292   
  1292   1293   /* !END!: Do not edit above this line. */

Changes to generic/tclZlib.c.

     1      1   /*
     2      2    * tclZlib.c --
     3      3    *
     4      4    *	This file provides the interface to the Zlib library.
     5      5    *
     6      6    * Copyright (C) 2004-2005 Pascal Scheffers <[email protected]>
     7      7    * Copyright (C) 2005 Unitas Software B.V.
     8         - * Copyright (c) 2008-2009 Donal K. Fellows
            8  + * Copyright (c) 2008-2012 Donal K. Fellows
     9      9    *
    10     10    * Parts written by Jean-Claude Wippler, as part of Tclkit, placed in the
    11     11    * public domain March 2003.
    12     12    *
    13     13    * See the file "license.terms" for information on usage and redistribution of
    14     14    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    15     15    */
................................................................................
    70     70       int format;			/* Flags from the TCL_ZLIB_FORMAT_* */
    71     71       int level;			/* Default 5, 0-9 */
    72     72       int flush;			/* Stores the flush param for deferred the
    73     73   				 * decompression. */
    74     74       int wbits;			/* The encoded compression mode, so we can
    75     75   				 * restart the stream if necessary. */
    76     76       Tcl_Command cmd;		/* Token for the associated Tcl command. */
           77  +    Tcl_Obj *compDictObj;	/* Byte-array object containing compression
           78  +				 * dictionary (not dictObj!) to use if
           79  +				 * necessary. */
           80  +    int flags;			/* Miscellaneous flag bits. */
           81  +    GzipHeader *gzHeaderPtr;	/* If we've allocated a gzip header
           82  +				 * structure. */
    77     83   } ZlibStreamHandle;
           84  +
           85  +#define DICT_TO_SET	0x1	/* If we need to set a compression dictionary
           86  +				 * in the low-level engine at the next
           87  +				 * opportunity. */
           88  +
           89  +/*
           90  + * Macros to make it clearer in some of the twiddlier accesses what is
           91  + * happening.
           92  + */
           93  +
           94  +#define IsRawStream(zshPtr)	((zshPtr)->format == TCL_ZLIB_FORMAT_RAW)
           95  +#define HaveDictToSet(zshPtr)	((zshPtr)->flags & DICT_TO_SET)
           96  +#define DictWasSet(zshPtr)	((zshPtr)->flags |= ~DICT_TO_SET)
    78     97   
    79     98   /*
    80     99    * Structure used for stacked channel compression and decompression.
    81    100    */
    82    101   
    83    102   typedef struct {
    84    103       Tcl_Channel chan;		/* Reference to the channel itself. */
    85    104       Tcl_Channel parent;		/* The underlying source and sink of bytes. */
    86    105       int flags;			/* General flag bits, see below... */
    87    106       int mode;			/* Either the value TCL_ZLIB_STREAM_DEFLATE
    88    107   				 * for compression on output, or
    89    108   				 * TCL_ZLIB_STREAM_INFLATE for decompression
    90    109   				 * on input. */
          110  +    int format;			/* What format of data is going on the wire.
          111  +				 * Needed so that the correct [fconfigure]
          112  +				 * options can be enabled. */
          113  +    int readAheadLimit;		/* The maximum number of bytes to read from
          114  +				 * the underlying stream in one go. */
    91    115       z_stream inStream;		/* Structure used by zlib for decompression of
    92    116   				 * input. */
    93    117       z_stream outStream;		/* Structure used by zlib for compression of
    94    118   				 * output. */
    95    119       char *inBuffer, *outBuffer;	/* Working buffers. */
    96    120       int inAllocated, outAllocated;
    97    121   				/* Sizes of working buffers. */
    98    122       GzipHeader inHeader;	/* Header read from input stream, when
    99    123   				 * decompressing a gzip stream. */
   100    124       GzipHeader outHeader;	/* Header to write to an output stream, when
   101    125   				 * compressing a gzip stream. */
   102    126       Tcl_TimerToken timer;	/* Timer used for keeping events fresh. */
   103    127       Tcl_DString decompressed;	/* Buffer for decompression results. */
          128  +    Tcl_Obj *compDictObj;	/* Byte-array object containing compression
          129  +				 * dictionary (not dictObj!) to use if
          130  +				 * necessary. */
   104    131   } ZlibChannelData;
   105    132   
   106    133   /*
   107    134    * Value bits for the flags field. Definitions are:
   108    135    *	ASYNC -		Whether this is an asynchronous channel.
   109    136    *	IN_HEADER -	Whether the inHeader field has been registered with
   110    137    *			the input compressor.
................................................................................
   113    140    */
   114    141   
   115    142   #define ASYNC			0x1
   116    143   #define IN_HEADER		0x2
   117    144   #define OUT_HEADER		0x4
   118    145   
   119    146   /*
   120         - * Size of buffers allocated by default. Should be enough...
          147  + * Size of buffers allocated by default, and the range it can be set to.  The
          148  + * same sorts of values apply to streams, except with different limits (they
          149  + * permit byte-level activity). Channels always use bytes unless told to use
          150  + * larger buffers.
   121    151    */
   122    152   
   123    153   #define DEFAULT_BUFFER_SIZE	4096
          154  +#define MIN_NONSTREAM_BUFFER_SIZE 16
          155  +#define MAX_BUFFER_SIZE		65536
   124    156   
   125    157   /*
   126    158    * Prototypes for private procedures defined later in this file:
   127    159    */
   128    160   
   129    161   static Tcl_CmdDeleteProc	ZlibStreamCmdDelete;
   130    162   static Tcl_DriverBlockModeProc	ZlibTransformBlockMode;
................................................................................
   134    166   static Tcl_DriverHandlerProc	ZlibTransformEventHandler;
   135    167   static Tcl_DriverInputProc	ZlibTransformInput;
   136    168   static Tcl_DriverOutputProc	ZlibTransformOutput;
   137    169   static Tcl_DriverSetOptionProc	ZlibTransformSetOption;
   138    170   static Tcl_DriverWatchProc	ZlibTransformWatch;
   139    171   static Tcl_ObjCmdProc		ZlibCmd;
   140    172   static Tcl_ObjCmdProc		ZlibStreamCmd;
          173  +static Tcl_ObjCmdProc		ZlibStreamAddCmd;
          174  +static Tcl_ObjCmdProc		ZlibStreamHeaderCmd;
          175  +static Tcl_ObjCmdProc		ZlibStreamPutCmd;
   141    176   
   142         -static void		ConvertError(Tcl_Interp *interp, int code);
          177  +static void		ConvertError(Tcl_Interp *interp, int code,
          178  +			    uLong adler);
          179  +static Tcl_Obj *	ConvertErrorToList(int code, uLong adler);
   143    180   static void		ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);
   144    181   static int		GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
   145    182   			    GzipHeader *headerPtr, int *extraSizePtr);
          183  +static int		ZlibPushSubcmd(Tcl_Interp *interp, int objc,
          184  +			    Tcl_Obj *const objv[]);
   146    185   static inline int	ResultCopy(ZlibChannelData *cd, char *buf,
   147    186   			    int toRead);
   148    187   static int		ResultGenerate(ZlibChannelData *cd, int n, int flush,
   149    188   			    int *errorCodePtr);
   150    189   static Tcl_Channel	ZlibStackChannelTransform(Tcl_Interp *interp,
   151         -			    int mode, int format, int level,
   152         -			    Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr);
          190  +			    int mode, int format, int level, int limit,
          191  +			    Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr,
          192  +			    Tcl_Obj *compDictObj);
   153    193   static void		ZlibStreamCleanup(ZlibStreamHandle *zshPtr);
          194  +static int		ZlibStreamSubcmd(Tcl_Interp *interp, int objc,
          195  +			    Tcl_Obj *const objv[]);
   154    196   static inline void	ZlibTransformEventTimerKill(ZlibChannelData *cd);
   155    197   static void		ZlibTransformTimerRun(ClientData clientData);
   156    198   
   157    199   /*
   158    200    * Type of zlib-based compressing and decompressing channels.
   159    201    */
   160    202   
................................................................................
   194    236    *----------------------------------------------------------------------
   195    237    */
   196    238   
   197    239   static void
   198    240   ConvertError(
   199    241       Tcl_Interp *interp,		/* Interpreter to store the error in. May be
   200    242   				 * NULL, in which case nothing happens. */
   201         -    int code)			/* The zlib error code. */
          243  +    int code,			/* The zlib error code. */
          244  +    uLong adler)		/* The checksum expected (for Z_NEED_DICT) */
   202    245   {
          246  +    const char *codeStr, *codeStr2 = NULL;
          247  +    char codeStrBuf[TCL_INTEGER_SPACE];
          248  +
   203    249       if (interp == NULL) {
   204    250   	return;
   205    251       }
   206    252   
   207         -    if (code == Z_ERRNO) {
          253  +    switch (code) {
          254  +	/*
          255  +	 * Firstly, the case that is *different* because it's really coming
          256  +	 * from the OS and is just being reported via zlib. It should be
          257  +	 * really uncommon because Tcl handles all I/O rather than delegating
          258  +	 * it to zlib, but proving it can't happen is hard.
          259  +	 */
          260  +
          261  +    case Z_ERRNO:
   208    262   	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp),-1));
   209         -    } else {
   210         -	const char *codeStr, *codeStr2 = NULL;
   211         -	char codeStrBuf[TCL_INTEGER_SPACE];
   212         -
   213         -	switch (code) {
   214         -	case Z_STREAM_ERROR:	codeStr = "STREAM";	break;
   215         -	case Z_DATA_ERROR:	codeStr = "DATA";	break;
   216         -	case Z_MEM_ERROR:	codeStr = "MEM";	break;
   217         -	case Z_BUF_ERROR:	codeStr = "BUF";	break;
   218         -	case Z_VERSION_ERROR:	codeStr = "VERSION";	break;
   219         -	default:
   220         -	    codeStr = "unknown";
   221         -	    codeStr2 = codeStrBuf;
   222         -	    sprintf(codeStrBuf, "%d", code);
   223         -	    break;
   224         -	}
   225         -	Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), -1));
   226         -
   227         -	/*
   228         -	 * Tricky point! We might pass NULL twice here (and will when the
   229         -	 * error type is known).
   230         -	 */
   231         -
   232         -	Tcl_SetErrorCode(interp, "TCL", "ZLIB", codeStr, codeStr2, NULL);
          263  +	return;
          264  +
          265  +	/*
          266  +	 * Normal errors/conditions, some of which have additional detail and
          267  +	 * some which don't. (This is not defined by array lookup because zlib
          268  +	 * error codes are sometimes negative.)
          269  +	 */
          270  +
          271  +    case Z_STREAM_ERROR:
          272  +	codeStr = "STREAM";
          273  +	break;
          274  +    case Z_DATA_ERROR:
          275  +	codeStr = "DATA";
          276  +	break;
          277  +    case Z_MEM_ERROR:
          278  +	codeStr = "MEM";
          279  +	break;
          280  +    case Z_BUF_ERROR:
          281  +	codeStr = "BUF";
          282  +	break;
          283  +    case Z_VERSION_ERROR:
          284  +	codeStr = "VERSION";
          285  +	break;
          286  +    case Z_NEED_DICT:
          287  +	codeStr = "NEED_DICT";
          288  +	codeStr2 = codeStrBuf;
          289  +	sprintf(codeStrBuf, "%lu", adler);
          290  +	break;
          291  +
          292  +	/*
          293  +	 * These should _not_ happen! This function is for dealing with error
          294  +	 * cases, not non-errors!
          295  +	 */
          296  +
          297  +    case Z_OK:
          298  +	Tcl_Panic("unexpected zlib result in error handler: Z_OK");
          299  +    case Z_STREAM_END:
          300  +	Tcl_Panic("unexpected zlib result in error handler: Z_STREAM_END");
          301  +
          302  +	/*
          303  +	 * Anything else is bad news; it's unexpected. Convert to generic
          304  +	 * error.
          305  +	 */
          306  +
          307  +    default:
          308  +	codeStr = "UNKNOWN";
          309  +	codeStr2 = codeStrBuf;
          310  +	sprintf(codeStrBuf, "%d", code);
          311  +	break;
          312  +    }
          313  +    Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), -1));
          314  +
          315  +    /*
          316  +     * Tricky point! We might pass NULL twice here (and will when the error
          317  +     * type is known).
          318  +     */
          319  +
          320  +    Tcl_SetErrorCode(interp, "TCL", "ZLIB", codeStr, codeStr2, NULL);
          321  +}
          322  +
          323  +static Tcl_Obj *
          324  +ConvertErrorToList(
          325  +    int code,			/* The zlib error code. */
          326  +    uLong adler)		/* The checksum expected (for Z_NEED_DICT) */
          327  +{
          328  +    Tcl_Obj *objv[4];
          329  +
          330  +    TclNewLiteralStringObj(objv[0], "TCL");
          331  +    TclNewLiteralStringObj(objv[1], "ZLIB");
          332  +    switch (code) {
          333  +    case Z_STREAM_ERROR:
          334  +	TclNewLiteralStringObj(objv[2], "STREAM");
          335  +	return Tcl_NewListObj(3, objv);
          336  +    case Z_DATA_ERROR:
          337  +	TclNewLiteralStringObj(objv[2], "DATA");
          338  +	return Tcl_NewListObj(3, objv);
          339  +    case Z_MEM_ERROR:
          340  +	TclNewLiteralStringObj(objv[2], "MEM");
          341  +	return Tcl_NewListObj(3, objv);
          342  +    case Z_BUF_ERROR:
          343  +	TclNewLiteralStringObj(objv[2], "BUF");
          344  +	return Tcl_NewListObj(3, objv);
          345  +    case Z_VERSION_ERROR:
          346  +	TclNewLiteralStringObj(objv[2], "VERSION");
          347  +	return Tcl_NewListObj(3, objv);
          348  +    case Z_ERRNO:
          349  +	TclNewLiteralStringObj(objv[2], "POSIX");
          350  +	objv[3] = Tcl_NewStringObj(Tcl_ErrnoId(), -1);
          351  +	return Tcl_NewListObj(4, objv);
          352  +    case Z_NEED_DICT:
          353  +	TclNewLiteralStringObj(objv[2], "NEED_DICT");
          354  +	objv[3] = Tcl_NewWideIntObj((Tcl_WideInt) adler);
          355  +	return Tcl_NewListObj(4, objv);
          356  +
          357  +	/*
          358  +	 * These should _not_ happen! This function is for dealing with error
          359  +	 * cases, not non-errors!
          360  +	 */
          361  +
          362  +    case Z_OK:
          363  +	Tcl_Panic("unexpected zlib result in error handler: Z_OK");
          364  +    case Z_STREAM_END:
          365  +	Tcl_Panic("unexpected zlib result in error handler: Z_STREAM_END");
          366  +
          367  +	/*
          368  +	 * Catch-all. Should be unreachable because all cases are already
          369  +	 * listed above.
          370  +	 */
          371  +
          372  +    default:
          373  +	TclNewLiteralStringObj(objv[2], "UNKNOWN");
          374  +	TclNewIntObj(objv[3], code);
          375  +	return Tcl_NewListObj(4, objv);
   233    376       }
   234    377   }
   235    378   
   236    379   /*
   237    380    *----------------------------------------------------------------------
   238    381    *
   239    382    * GenerateHeader --
................................................................................
   297    440       } else if (value != NULL) {
   298    441   	valueStr = Tcl_GetStringFromObj(value, &len);
   299    442   	Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL,
   300    443   		headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len,
   301    444   		NULL);
   302    445   	headerPtr->nativeCommentBuf[len] = '\0';
   303    446   	headerPtr->header.comment = (Bytef *) headerPtr->nativeCommentBuf;
   304         -	*extraSizePtr += len;
          447  +	if (extraSizePtr != NULL) {
          448  +	    *extraSizePtr += len;
          449  +	}
   305    450       }
   306    451   
   307    452       if (GetValue(interp, dictObj, "crc", &value) != TCL_OK) {
   308    453   	goto error;
   309    454       } else if (value != NULL &&
   310    455   	    Tcl_GetBooleanFromObj(interp, value, &headerPtr->header.hcrc)) {
   311    456   	goto error;
................................................................................
   315    460   	goto error;
   316    461       } else if (value != NULL) {
   317    462   	valueStr = Tcl_GetStringFromObj(value, &len);
   318    463   	Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL,
   319    464   		headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL);
   320    465   	headerPtr->nativeFilenameBuf[len] = '\0';
   321    466   	headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf;
   322         -	*extraSizePtr += len;
          467  +	if (extraSizePtr != NULL) {
          468  +	    *extraSizePtr += len;
          469  +	}
   323    470       }
   324    471   
   325    472       if (GetValue(interp, dictObj, "os", &value) != TCL_OK) {
   326    473   	goto error;
   327    474       } else if (value != NULL && Tcl_GetIntFromObj(interp, value,
   328    475   	    &headerPtr->header.os) != TCL_OK) {
   329    476   	goto error;
................................................................................
   436    583   		Tcl_NewStringObj(headerPtr->text ? "text" : "binary", -1));
   437    584       }
   438    585   
   439    586       if (latin1enc != NULL) {
   440    587   	Tcl_FreeEncoding(latin1enc);
   441    588       }
   442    589   }
          590  +
          591  +static int
          592  +SetInflateDictionary(
          593  +    z_streamp strm,
          594  +    Tcl_Obj *compDictObj)
          595  +{
          596  +    if (compDictObj != NULL) {
          597  +	int length;
          598  +	unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);
          599  +
          600  +	return inflateSetDictionary(strm, bytes, (unsigned) length);
          601  +    }
          602  +    return Z_OK;
          603  +}
          604  +
          605  +static int
          606  +SetDeflateDictionary(
          607  +    z_streamp strm,
          608  +    Tcl_Obj *compDictObj)
          609  +{
          610  +    if (compDictObj != NULL) {
          611  +	int length;
          612  +	unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);
          613  +
          614  +	return deflateSetDictionary(strm, bytes, (unsigned) length);
          615  +    }
          616  +    return Z_OK;
          617  +}
   443    618   
   444    619   /*
   445    620    *----------------------------------------------------------------------
   446    621    *
   447    622    * Tcl_ZlibStreamInit --
   448    623    *
   449    624    *	This command initializes a (de)compression context/handle for
................................................................................
   475    650       Tcl_ZlibStream *zshandlePtr)
   476    651   {
   477    652       int wbits = 0;
   478    653       int e;
   479    654       ZlibStreamHandle *zshPtr = NULL;
   480    655       Tcl_DString cmdname;
   481    656       Tcl_CmdInfo cmdinfo;
          657  +    GzipHeader *gzHeaderPtr = NULL;
   482    658   
   483    659       switch (mode) {
   484    660       case TCL_ZLIB_STREAM_DEFLATE:
   485    661   	/*
   486    662   	 * Compressed format is specified by the wbits parameter. See zlib.h
   487    663   	 * for details.
   488    664   	 */
................................................................................
   489    665   
   490    666   	switch (format) {
   491    667   	case TCL_ZLIB_FORMAT_RAW:
   492    668   	    wbits = WBITS_RAW;
   493    669   	    break;
   494    670   	case TCL_ZLIB_FORMAT_GZIP:
   495    671   	    wbits = WBITS_GZIP;
          672  +	    if (dictObj) {
          673  +		gzHeaderPtr = ckalloc(sizeof(GzipHeader));
          674  +		memset(gzHeaderPtr, 0, sizeof(GzipHeader));
          675  +		if (GenerateHeader(interp, dictObj, gzHeaderPtr,
          676  +			NULL) != TCL_OK) {
          677  +		    ckfree(gzHeaderPtr);
          678  +		    return TCL_ERROR;
          679  +		}
          680  +	    }
   496    681   	    break;
   497    682   	case TCL_ZLIB_FORMAT_ZLIB:
   498    683   	    wbits = WBITS_ZLIB;
   499    684   	    break;
   500    685   	default:
   501    686   	    Tcl_Panic("incorrect zlib data format, must be "
   502    687   		    "TCL_ZLIB_FORMAT_ZLIB, TCL_ZLIB_FORMAT_GZIP or "
................................................................................
   515    700   
   516    701   	switch (format) {
   517    702   	case TCL_ZLIB_FORMAT_RAW:
   518    703   	    wbits = WBITS_RAW;
   519    704   	    break;
   520    705   	case TCL_ZLIB_FORMAT_GZIP:
   521    706   	    wbits = WBITS_GZIP;
          707  +	    gzHeaderPtr = ckalloc(sizeof(GzipHeader));
          708  +	    memset(gzHeaderPtr, 0, sizeof(GzipHeader));
          709  +	    gzHeaderPtr->header.name = (Bytef *)
          710  +		    gzHeaderPtr->nativeFilenameBuf;
          711  +	    gzHeaderPtr->header.name_max = MAXPATHLEN - 1;
          712  +	    gzHeaderPtr->header.comment = (Bytef *)
          713  +		    gzHeaderPtr->nativeCommentBuf;
          714  +	    gzHeaderPtr->header.name_max = MAX_COMMENT_LEN - 1;
   522    715   	    break;
   523    716   	case TCL_ZLIB_FORMAT_ZLIB:
   524    717   	    wbits = WBITS_ZLIB;
   525    718   	    break;
   526    719   	case TCL_ZLIB_FORMAT_AUTO:
   527    720   	    wbits = WBITS_AUTODETECT;
   528    721   	    break;
................................................................................
   541    734       zshPtr->interp = interp;
   542    735       zshPtr->mode = mode;
   543    736       zshPtr->format = format;
   544    737       zshPtr->level = level;
   545    738       zshPtr->wbits = wbits;
   546    739       zshPtr->currentInput = NULL;
   547    740       zshPtr->streamEnd = 0;
          741  +    zshPtr->compDictObj = NULL;
          742  +    zshPtr->flags = 0;
          743  +    zshPtr->gzHeaderPtr = gzHeaderPtr;
   548    744       memset(&zshPtr->stream, 0, sizeof(z_stream));
   549    745       zshPtr->stream.adler = 1;
   550    746   
   551    747       /*
   552    748        * No output buffer available yet
   553    749        */
   554    750   
   555    751       if (mode == TCL_ZLIB_STREAM_DEFLATE) {
   556    752   	e = deflateInit2(&zshPtr->stream, level, Z_DEFLATED, wbits,
   557    753   		MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
          754  +	if (e == Z_OK && zshPtr->gzHeaderPtr) {
          755  +	    e = deflateSetHeader(&zshPtr->stream,
          756  +		    &zshPtr->gzHeaderPtr->header);
          757  +	}
   558    758       } else {
   559    759   	e = inflateInit2(&zshPtr->stream, wbits);
          760  +	if (e == Z_OK && zshPtr->gzHeaderPtr) {
          761  +	    e = inflateGetHeader(&zshPtr->stream,
          762  +		    &zshPtr->gzHeaderPtr->header);
          763  +	}
   560    764       }
   561    765   
   562    766       if (e != Z_OK) {
   563         -	ConvertError(interp, e);
          767  +	ConvertError(interp, e, zshPtr->stream.adler);
   564    768   	goto error;
   565    769       }
   566    770   
   567    771       /*
   568    772        * I could do all this in C, but this is easier.
   569    773        */
   570    774   
................................................................................
   616    820        */
   617    821   
   618    822       if (zshandlePtr) {
   619    823   	*zshandlePtr = (Tcl_ZlibStream) zshPtr;
   620    824       }
   621    825   
   622    826       return TCL_OK;
   623         - error:
          827  +
          828  +  error:
          829  +    if (zshPtr->compDictObj) {
          830  +	Tcl_DecrRefCount(zshPtr->compDictObj);
          831  +    }
          832  +    if (zshPtr->gzHeaderPtr) {
          833  +	ckfree(zshPtr->gzHeaderPtr);
          834  +    }
   624    835       ckfree(zshPtr);
   625    836       return TCL_ERROR;
   626    837   }
   627    838   
   628    839   /*
   629    840    *----------------------------------------------------------------------
   630    841    *
................................................................................
   724    935       }
   725    936       if (zshPtr->outData) {
   726    937   	Tcl_DecrRefCount(zshPtr->outData);
   727    938       }
   728    939       if (zshPtr->currentInput) {
   729    940   	Tcl_DecrRefCount(zshPtr->currentInput);
   730    941       }
          942  +    if (zshPtr->compDictObj) {
          943  +	Tcl_DecrRefCount(zshPtr->compDictObj);
          944  +    }
          945  +    if (zshPtr->gzHeaderPtr) {
          946  +	ckfree(zshPtr->gzHeaderPtr);
          947  +    }
   731    948   
   732    949       ckfree(zshPtr);
   733    950   }
   734    951   
   735    952   /*
   736    953    *----------------------------------------------------------------------
   737    954    *
................................................................................
   776    993       /*
   777    994        * No output buffer available yet.
   778    995        */
   779    996   
   780    997       if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) {
   781    998   	e = deflateInit2(&zshPtr->stream, zshPtr->level, Z_DEFLATED,
   782    999   		zshPtr->wbits, MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
         1000  +	if (e == Z_OK && HaveDictToSet(zshPtr)) {
         1001  +	    e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
         1002  +	    if (e == Z_OK) {
         1003  +		DictWasSet(zshPtr);
         1004  +	    }
         1005  +	}
   783   1006       } else {
   784   1007   	e = inflateInit2(&zshPtr->stream, zshPtr->wbits);
         1008  +	if (IsRawStream(zshPtr) && HaveDictToSet(zshPtr) && e == Z_OK) {
         1009  +	    e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
         1010  +	    if (e == Z_OK) {
         1011  +		DictWasSet(zshPtr);
         1012  +	    }
         1013  +	}
   785   1014       }
   786   1015   
   787   1016       if (e != Z_OK) {
   788         -	ConvertError(zshPtr->interp, e);
         1017  +	ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
   789   1018   	/* TODO:cleanup */
   790   1019   	return TCL_ERROR;
   791   1020       }
   792   1021   
   793   1022       return TCL_OK;
   794   1023   }
   795   1024   
................................................................................
   874   1103   
   875   1104       return zshPtr->stream.adler;
   876   1105   }
   877   1106   
   878   1107   /*
   879   1108    *----------------------------------------------------------------------
   880   1109    *
         1110  + * Tcl_ZlibStreamSetCompressionDictionary --
         1111  + *
         1112  + *	Sets the compression dictionary for a stream. This will be used as
         1113  + *	appropriate for the next compression or decompression action performed
         1114  + *	on the stream.
         1115  + *
         1116  + *----------------------------------------------------------------------
         1117  + */
         1118  +
         1119  +void
         1120  +Tcl_ZlibStreamSetCompressionDictionary(
         1121  +    Tcl_ZlibStream zshandle,
         1122  +    Tcl_Obj *compressionDictionaryObj)
         1123  +{
         1124  +    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
         1125  +
         1126  +    if (compressionDictionaryObj != NULL) {
         1127  +	if (Tcl_IsShared(compressionDictionaryObj)) {
         1128  +	    compressionDictionaryObj =
         1129  +		    Tcl_DuplicateObj(compressionDictionaryObj);
         1130  +	}
         1131  +	Tcl_IncrRefCount(compressionDictionaryObj);
         1132  +	zshPtr->flags |= DICT_TO_SET;
         1133  +    } else {
         1134  +	zshPtr->flags &= ~DICT_TO_SET;
         1135  +    }
         1136  +    if (zshPtr->compDictObj != NULL) {
         1137  +	Tcl_DecrRefCount(zshPtr->compDictObj);
         1138  +    }
         1139  +    zshPtr->compDictObj = compressionDictionaryObj;
         1140  +}
         1141  +
         1142  +/*
         1143  + *----------------------------------------------------------------------
         1144  + *
   881   1145    * Tcl_ZlibStreamPut --
   882   1146    *
   883   1147    *	Add data to the stream for compression or decompression from a
   884   1148    *	bytearray Tcl_Obj.
   885   1149    *
   886   1150    *----------------------------------------------------------------------
   887   1151    */
................................................................................
   906   1170   	}
   907   1171   	return TCL_ERROR;
   908   1172       }
   909   1173   
   910   1174       if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) {
   911   1175   	zshPtr->stream.next_in = Tcl_GetByteArrayFromObj(data, &size);
   912   1176   	zshPtr->stream.avail_in = size;
         1177  +
         1178  +	if (HaveDictToSet(zshPtr)) {
         1179  +	    e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
         1180  +	    if (e != Z_OK) {
         1181  +		if (zshPtr->interp) {
         1182  +		    ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
         1183  +		}
         1184  +		return TCL_ERROR;
         1185  +	    }
         1186  +	    DictWasSet(zshPtr);
         1187  +	}
   913   1188   
   914   1189   	/*
   915   1190   	 * Deflatebound doesn't seem to take various header sizes into
   916   1191   	 * account, so we add 100 extra bytes.
   917   1192   	 */
   918   1193   
   919   1194   	outSize = deflateBound(&zshPtr->stream, zshPtr->stream.avail_in)+100;
................................................................................
   943   1218   		ckfree(dataTmp);
   944   1219   		dataTmp = ckalloc(outSize);
   945   1220   	    }
   946   1221   	    zshPtr->stream.avail_out = outSize;
   947   1222   	    zshPtr->stream.next_out = (Bytef *) dataTmp;
   948   1223   
   949   1224   	    e = deflate(&zshPtr->stream, flush);
         1225  +	}
         1226  +	if (e != Z_OK && !(flush==Z_FINISH && e==Z_STREAM_END)) {
         1227  +	    if (zshPtr->interp) {
         1228  +		ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
         1229  +	    }
         1230  +	    return TCL_ERROR;
   950   1231   	}
   951   1232   
   952   1233   	/*
   953   1234   	 * And append the final data block.
   954   1235   	 */
   955   1236   
   956   1237   	if (outSize - zshPtr->stream.avail_out > 0) {
................................................................................
  1021   1302       if (zshPtr->mode == TCL_ZLIB_STREAM_INFLATE) {
  1022   1303   	if (count == -1) {
  1023   1304   	    /*
  1024   1305   	     * The only safe thing to do is restict to 65k. We might cause a
  1025   1306   	     * panic for out of memory if we just kept growing the buffer.
  1026   1307   	     */
  1027   1308   
  1028         -	    count = 65536;
         1309  +	    count = MAX_BUFFER_SIZE;
  1029   1310   	}
  1030   1311   
  1031   1312   	/*
  1032   1313   	 * Prepare the place to store the data.
  1033   1314   	 */
  1034   1315   
  1035   1316   	dataPtr = Tcl_SetByteArrayLength(data, existing+count);
................................................................................
  1069   1350   		 * And remove it from the list
  1070   1351   		 */
  1071   1352   
  1072   1353   		Tcl_ListObjReplace(NULL, zshPtr->inData, 0, 1, 0, NULL);
  1073   1354   	    }
  1074   1355   	}
  1075   1356   
         1357  +	/*
         1358  +	 * When dealing with a raw stream, we set the dictionary here, once.
         1359  +	 * (You can't do it in response to getting Z_NEED_DATA as raw streams
         1360  +	 * don't ever issue that.)
         1361  +	 */
         1362  +
         1363  +	if (IsRawStream(zshPtr) && HaveDictToSet(zshPtr)) {
         1364  +	    e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
         1365  +	    if (e != Z_OK) {
         1366  +		if (zshPtr->interp) {
         1367  +		    ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
         1368  +		}
         1369  +		return TCL_ERROR;
         1370  +	    }
         1371  +	    DictWasSet(zshPtr);
         1372  +	}
  1076   1373   	e = inflate(&zshPtr->stream, zshPtr->flush);
         1374  +	if (e == Z_NEED_DICT && HaveDictToSet(zshPtr)) {
         1375  +	    e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
         1376  +	    if (e == Z_OK) {
         1377  +		DictWasSet(zshPtr);
         1378  +		e = inflate(&zshPtr->stream, zshPtr->flush);
         1379  +	    }
         1380  +	};
  1077   1381   	Tcl_ListObjLength(NULL, zshPtr->inData, &listLen);
  1078   1382   
  1079   1383   	while ((zshPtr->stream.avail_out > 0)
  1080   1384   		&& (e == Z_OK || e == Z_BUF_ERROR) && (listLen > 0)) {
  1081   1385   	    /*
  1082   1386   	     * State: We have not satisfied the request yet and there may be
  1083   1387   	     * more to inflate.
................................................................................
  1123   1427   	    Tcl_ListObjReplace(NULL, zshPtr->inData, 0, 1, 0, NULL);
  1124   1428   	    listLen--;
  1125   1429   
  1126   1430   	    /*
  1127   1431   	     * And call inflate again.
  1128   1432   	     */
  1129   1433   
  1130         -	    e = inflate(&zshPtr->stream, zshPtr->flush);
         1434  +	    do {
         1435  +		e = inflate(&zshPtr->stream, zshPtr->flush);
         1436  +		if (e != Z_NEED_DICT || !HaveDictToSet(zshPtr)) {
         1437  +		    break;
         1438  +		}
         1439  +		e = SetInflateDictionary(&zshPtr->stream,zshPtr->compDictObj);
         1440  +		DictWasSet(zshPtr);
         1441  +	    } while (e == Z_OK);
  1131   1442   	}
  1132   1443   	if (zshPtr->stream.avail_out > 0) {
  1133   1444   	    Tcl_SetByteArrayLength(data,
  1134   1445   		    existing + count - zshPtr->stream.avail_out);
  1135   1446   	}
  1136   1447   	if (!(e==Z_OK || e==Z_STREAM_END || e==Z_BUF_ERROR)) {
  1137   1448   	    Tcl_SetByteArrayLength(data, existing);
  1138         -	    ConvertError(zshPtr->interp, e);
         1449  +	    ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
  1139   1450   	    return TCL_ERROR;
  1140   1451   	}
  1141   1452   	if (e == Z_STREAM_END) {
  1142   1453   	    zshPtr->streamEnd = 1;
  1143   1454   	    if (zshPtr->currentInput) {
  1144   1455   		Tcl_DecrRefCount(zshPtr->currentInput);
  1145   1456   		zshPtr->currentInput = 0;
................................................................................
  1347   1658        */
  1348   1659   
  1349   1660       Tcl_SetByteArrayLength(obj, stream.total_out);
  1350   1661       Tcl_SetObjResult(interp, obj);
  1351   1662       return TCL_OK;
  1352   1663   
  1353   1664     error:
  1354         -    ConvertError(interp, e);
         1665  +    ConvertError(interp, e, stream.adler);
  1355   1666       TclDecrRefCount(obj);
  1356   1667       return TCL_ERROR;
  1357   1668   }
  1358   1669   
  1359   1670   /*
  1360   1671    *----------------------------------------------------------------------
  1361   1672    *
................................................................................
  1526   1837   	ckfree(commentBuf);
  1527   1838       }
  1528   1839       Tcl_SetObjResult(interp, obj);
  1529   1840       return TCL_OK;
  1530   1841   
  1531   1842     error:
  1532   1843       TclDecrRefCount(obj);
  1533         -    ConvertError(interp, e);
         1844  +    ConvertError(interp, e, stream.adler);
  1534   1845       if (nameBuf) {
  1535   1846   	ckfree(nameBuf);
  1536   1847       }
  1537   1848       if (commentBuf) {
  1538   1849   	ckfree(commentBuf);
  1539   1850       }
  1540   1851       return TCL_ERROR;
................................................................................
  1582   1893   static int
  1583   1894   ZlibCmd(
  1584   1895       ClientData notUsed,
  1585   1896       Tcl_Interp *interp,
  1586   1897       int objc,
  1587   1898       Tcl_Obj *const objv[])
  1588   1899   {
  1589         -    int command, dlen, mode, format, i, option, level = -1;
         1900  +    int command, dlen, i, option, level = -1;
  1590   1901       unsigned start, buffersize = 0;
  1591         -    Tcl_ZlibStream zh;
  1592   1902       Byte *data;
  1593         -    Tcl_Obj *headerDictObj, *headerVarObj;
         1903  +    Tcl_Obj *headerDictObj;
  1594   1904       const char *extraInfoStr = NULL;
  1595   1905       static const char *const commands[] = {
  1596   1906   	"adler32", "compress", "crc32", "decompress", "deflate", "gunzip",
  1597   1907   	"gzip", "inflate", "push", "stream",
  1598   1908   	NULL
  1599   1909       };
  1600   1910       enum zlibCommands {
  1601   1911   	CMD_ADLER, CMD_COMPRESS, CMD_CRC, CMD_DECOMPRESS, CMD_DEFLATE,
  1602   1912   	CMD_GUNZIP, CMD_GZIP, CMD_INFLATE, CMD_PUSH, CMD_STREAM
  1603   1913       };
  1604         -    static const char *const stream_formats[] = {
  1605         -	"compress", "decompress", "deflate", "gunzip", "gzip", "inflate",
  1606         -	NULL
  1607         -    };
  1608         -    enum zlibFormats {
  1609         -	FMT_COMPRESS, FMT_DECOMPRESS, FMT_DEFLATE, FMT_GUNZIP, FMT_GZIP,
  1610         -	FMT_INFLATE
  1611         -    };
  1612   1914   
  1613   1915       if (objc < 2) {
  1614   1916   	Tcl_WrongNumArgs(interp, 1, objv, "command arg ?...?");
  1615   1917   	return TCL_ERROR;
  1616   1918       }
  1617   1919       if (Tcl_GetIndexFromObj(interp, objv[1], commands, "command", 0,
  1618   1920   	    &command) != TCL_OK) {
................................................................................
  1631   1933   	    return TCL_ERROR;
  1632   1934   	}
  1633   1935   	if (objc < 4) {
  1634   1936   	    start = Tcl_ZlibAdler32(0, NULL, 0);
  1635   1937   	}
  1636   1938   	data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
  1637   1939   	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
  1638         -		Tcl_ZlibAdler32(start, data, dlen)));
         1940  +		(uLong) Tcl_ZlibAdler32(start, data, dlen)));
  1639   1941   	return TCL_OK;
  1640   1942       case CMD_CRC:			/* crc32 str ?startvalue?
  1641   1943   					 * -> checksum */
  1642   1944   	if (objc < 3 || objc > 4) {
  1643   1945   	    Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?");
  1644   1946   	    return TCL_ERROR;
  1645   1947   	}
................................................................................
  1648   1950   	    return TCL_ERROR;
  1649   1951   	}
  1650   1952   	if (objc < 4) {
  1651   1953   	    start = Tcl_ZlibCRC32(0, NULL, 0);
  1652   1954   	}
  1653   1955   	data = Tcl_GetByteArrayFromObj(objv[2], &dlen);
  1654   1956   	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
  1655         -		Tcl_ZlibCRC32(start, data, dlen)));
         1957  +		(uLong) Tcl_ZlibCRC32(start, data, dlen)));
  1656   1958   	return TCL_OK;
  1657   1959       case CMD_DEFLATE:			/* deflate data ?level?
  1658   1960   					 * -> rawCompressedData */
  1659   1961   	if (objc < 3 || objc > 4) {
  1660   1962   	    Tcl_WrongNumArgs(interp, 2, objv, "data ?level?");
  1661   1963   	    return TCL_ERROR;
  1662   1964   	}
................................................................................
  1684   1986   		goto badLevel;
  1685   1987   	    }
  1686   1988   	}
  1687   1989   	return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], level,
  1688   1990   		NULL);
  1689   1991       case CMD_GZIP:			/* gzip data ?level?
  1690   1992   					 * -> gzippedCompressedData */
         1993  +	headerDictObj = NULL;
         1994  +
         1995  +	/*
         1996  +	 * Legacy argument format support.
         1997  +	 */
         1998  +
         1999  +	if (objc == 4
         2000  +		&& Tcl_GetIntFromObj(interp, objv[3], &level) == TCL_OK) {
         2001  +	    if (level < 0 || level > 9) {
         2002  +		extraInfoStr = "\n    (in -level option)";
         2003  +		goto badLevel;
         2004  +	    }
         2005  +	    return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2],
         2006  +		    level, NULL);
         2007  +	}
         2008  +
  1691   2009   	if (objc < 3 || objc > 7 || ((objc & 1) == 0)) {
  1692   2010   	    Tcl_WrongNumArgs(interp, 2, objv,
  1693   2011   		    "data ?-level level? ?-header header?");
  1694   2012   	    return TCL_ERROR;
  1695   2013   	}
  1696         -	headerDictObj = NULL;
  1697   2014   	for (i=3 ; i<objc ; i+=2) {
  1698   2015   	    static const char *const gzipopts[] = {
  1699   2016   		"-header", "-level", NULL
  1700   2017   	    };
  1701   2018   
  1702   2019   	    if (Tcl_GetIndexFromObj(interp, objv[i], gzipopts, "option", 0,
  1703   2020   		    &option) != TCL_OK) {
................................................................................
  1728   2045   	    return TCL_ERROR;
  1729   2046   	}
  1730   2047   	if (objc > 3) {
  1731   2048   	    if (Tcl_GetIntFromObj(interp, objv[3],
  1732   2049   		    (int *) &buffersize) != TCL_OK) {
  1733   2050   		return TCL_ERROR;
  1734   2051   	    }
  1735         -	    if (buffersize < 16 || buffersize > 65536) {
         2052  +	    if (buffersize < MIN_NONSTREAM_BUFFER_SIZE
         2053  +		    || buffersize > MAX_BUFFER_SIZE) {
  1736   2054   		goto badBuffer;
  1737   2055   	    }
  1738   2056   	}
  1739   2057   	return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2],
  1740   2058   		buffersize, NULL);
  1741   2059       case CMD_DECOMPRESS:		/* decompress zlibcomprdata \
  1742   2060   					 *    ?bufferSize?
................................................................................
  1746   2064   	    return TCL_ERROR;
  1747   2065   	}
  1748   2066   	if (objc > 3) {
  1749   2067   	    if (Tcl_GetIntFromObj(interp, objv[3],
  1750   2068   		    (int *) &buffersize) != TCL_OK) {
  1751   2069   		return TCL_ERROR;
  1752   2070   	    }
  1753         -	    if (buffersize < 16 || buffersize > 65536) {
         2071  +	    if (buffersize < MIN_NONSTREAM_BUFFER_SIZE
         2072  +		    || buffersize > MAX_BUFFER_SIZE) {
  1754   2073   		goto badBuffer;
  1755   2074   	    }
  1756   2075   	}
  1757   2076   	return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2],
  1758   2077   		buffersize, NULL);
  1759         -    case CMD_GUNZIP:			/* gunzip gzippeddata ?bufferSize?
         2078  +    case CMD_GUNZIP: {			/* gunzip gzippeddata ?bufferSize?
  1760   2079   					 *	-> decompressedData */
         2080  +	Tcl_Obj *headerVarObj;
         2081  +
  1761   2082   	if (objc < 3 || objc > 5 || ((objc & 1) == 0)) {
  1762   2083   	    Tcl_WrongNumArgs(interp, 2, objv, "data ?-headerVar varName?");
  1763   2084   	    return TCL_ERROR;
  1764   2085   	}
  1765   2086   	headerDictObj = headerVarObj = NULL;
  1766   2087   	for (i=3 ; i<objc ; i+=2) {
  1767   2088   	    static const char *const gunzipopts[] = {
................................................................................
  1774   2095   	    }
  1775   2096   	    switch (option) {
  1776   2097   	    case 0:
  1777   2098   		if (Tcl_GetIntFromObj(interp, objv[i+1],
  1778   2099   			(int *) &buffersize) != TCL_OK) {
  1779   2100   		    return TCL_ERROR;
  1780   2101   		}
  1781         -		if (buffersize < 16 || buffersize > 65536) {
         2102  +		if (buffersize < MIN_NONSTREAM_BUFFER_SIZE
         2103  +			|| buffersize > MAX_BUFFER_SIZE) {
  1782   2104   		    goto badBuffer;
  1783   2105   		}
  1784   2106   		break;
  1785   2107   	    case 1:
  1786   2108   		headerVarObj = objv[i+1];
  1787   2109   		headerDictObj = Tcl_NewObj();
  1788   2110   		break;
................................................................................
  1799   2121   		headerDictObj, TCL_LEAVE_ERR_MSG) == NULL) {
  1800   2122   	    if (headerDictObj) {
  1801   2123   		TclDecrRefCount(headerDictObj);
  1802   2124   	    }
  1803   2125   	    return TCL_ERROR;
  1804   2126   	}
  1805   2127   	return TCL_OK;
         2128  +    }
  1806   2129       case CMD_STREAM:			/* stream deflate/inflate/...gunzip \
  1807         -					 *    ?level?
         2130  +					 *    ?options...?
  1808   2131   					 *	-> handleCmd */
  1809         -	if (objc < 3 || objc > 4) {
  1810         -	    Tcl_WrongNumArgs(interp, 2, objv, "mode ?level?");
  1811         -	    return TCL_ERROR;
  1812         -	}
  1813         -	if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0,
  1814         -		&format) != TCL_OK) {
  1815         -	    return TCL_ERROR;
  1816         -	}
  1817         -	mode = TCL_ZLIB_STREAM_INFLATE;
  1818         -	switch ((enum zlibFormats) format) {
  1819         -	case FMT_DEFLATE:
  1820         -	    mode = TCL_ZLIB_STREAM_DEFLATE;
  1821         -	case FMT_INFLATE:
  1822         -	    format = TCL_ZLIB_FORMAT_RAW;
  1823         -	    break;
  1824         -	case FMT_COMPRESS:
  1825         -	    mode = TCL_ZLIB_STREAM_DEFLATE;
  1826         -	case FMT_DECOMPRESS:
  1827         -	    format = TCL_ZLIB_FORMAT_ZLIB;
  1828         -	    break;
  1829         -	case FMT_GZIP:
  1830         -	    mode = TCL_ZLIB_STREAM_DEFLATE;
  1831         -	case FMT_GUNZIP:
  1832         -	    format = TCL_ZLIB_FORMAT_GZIP;
  1833         -	    break;
  1834         -	}
  1835         -	if (objc == 4) {
  1836         -	    if (Tcl_GetIntFromObj(interp, objv[3],
  1837         -		    (int *) &level) != TCL_OK) {
  1838         -		return TCL_ERROR;
  1839         -	    }
  1840         -	    if (level < 0 || level > 9) {
  1841         -		goto badLevel;
  1842         -	    }
  1843         -	} else {
  1844         -	    level = Z_DEFAULT_COMPRESSION;
  1845         -	}
  1846         -	if (Tcl_ZlibStreamInit(interp, mode, format, level, NULL,
  1847         -		&zh) != TCL_OK) {
  1848         -	    return TCL_ERROR;
  1849         -	}
  1850         -	Tcl_SetObjResult(interp, Tcl_ZlibStreamGetCommandName(zh));
  1851         -	return TCL_OK;
  1852         -    case CMD_PUSH: {			/* push mode channel options...
         2132  +	return ZlibStreamSubcmd(interp, objc, objv);
         2133  +    case CMD_PUSH:			/* push mode channel options...
  1853   2134   					 *	-> channel */
  1854         -	Tcl_Channel chan;
  1855         -	int chanMode;
  1856         -	static const char *const pushOptions[] = {
  1857         -	    "-header", "-level", "-limit",
  1858         -	    NULL
  1859         -	};
  1860         -	enum pushOptions {poHeader, poLevel, poLimit};
  1861         -	Tcl_Obj *headerObj = NULL;
  1862         -	int limit = 1, dummy;
  1863         -
  1864         -	if (objc < 4) {
  1865         -	    Tcl_WrongNumArgs(interp, 2, objv, "mode channel ?options...?");
  1866         -	    return TCL_ERROR;
  1867         -	}
  1868         -
  1869         -	if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0,
  1870         -		&format) != TCL_OK) {
  1871         -	    return TCL_ERROR;
  1872         -	}
  1873         -	switch ((enum zlibFormats) format) {
  1874         -	case FMT_DEFLATE:
  1875         -	    mode = TCL_ZLIB_STREAM_DEFLATE;
  1876         -	    format = TCL_ZLIB_FORMAT_RAW;
  1877         -	    break;
  1878         -	case FMT_INFLATE:
  1879         -	    mode = TCL_ZLIB_STREAM_INFLATE;
  1880         -	    format = TCL_ZLIB_FORMAT_RAW;
  1881         -	    break;
  1882         -	case FMT_COMPRESS:
  1883         -	    mode = TCL_ZLIB_STREAM_DEFLATE;
  1884         -	    format = TCL_ZLIB_FORMAT_ZLIB;
  1885         -	    break;
  1886         -	case FMT_DECOMPRESS:
  1887         -	    mode = TCL_ZLIB_STREAM_INFLATE;
  1888         -	    format = TCL_ZLIB_FORMAT_ZLIB;
  1889         -	    break;
  1890         -	case FMT_GZIP:
  1891         -	    mode = TCL_ZLIB_STREAM_DEFLATE;
  1892         -	    format = TCL_ZLIB_FORMAT_GZIP;
  1893         -	    break;
  1894         -	case FMT_GUNZIP:
  1895         -	    mode = TCL_ZLIB_STREAM_INFLATE;
  1896         -	    format = TCL_ZLIB_FORMAT_GZIP;
  1897         -	    break;
  1898         -	default:
  1899         -	    Tcl_SetObjResult(interp, Tcl_NewStringObj("impossible!", -1));
  1900         -	    return TCL_ERROR;
  1901         -	}
  1902         -
  1903         -	if (TclGetChannelFromObj(interp, objv[3], &chan, &chanMode,
  1904         -		0) != TCL_OK) {
  1905         -	    return TCL_ERROR;
  1906         -	}
  1907         -
  1908         -	/*
  1909         -	 * Sanity checks.
  1910         -	 */
  1911         -
  1912         -	if (mode == TCL_ZLIB_STREAM_DEFLATE && !(chanMode & TCL_WRITABLE)) {
  1913         -	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
  1914         -		    "compression may only be applied to writable channels",
  1915         -		    -1));
  1916         -	    Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNWRITABLE", NULL);
  1917         -	    return TCL_ERROR;
  1918         -	}
  1919         -	if (mode == TCL_ZLIB_STREAM_INFLATE && !(chanMode & TCL_READABLE)) {
  1920         -	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
  1921         -		    "decompression may only be applied to readable channels",
  1922         -		    -1));
  1923         -	    Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNREADABLE", NULL);
  1924         -	    return TCL_ERROR;
  1925         -	}
  1926         -
  1927         -	/*
  1928         -	 * Parse options.
  1929         -	 */
  1930         -
  1931         -	level = Z_DEFAULT_COMPRESSION;
  1932         -	for (i=4 ; i<objc ; i++) {
  1933         -	    if (Tcl_GetIndexFromObj(interp, objv[i], pushOptions, "option", 0,
  1934         -		    &option) != TCL_OK) {
  1935         -		return TCL_ERROR;
  1936         -	    }
  1937         -	    switch ((enum pushOptions) option) {
  1938         -	    case poHeader:
  1939         -		if (++i > objc-1) {
  1940         -		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
  1941         -			    "value missing for -header option", -1));
  1942         -		    Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
  1943         -		    return TCL_ERROR;
  1944         -		}
  1945         -		headerObj = objv[i];
  1946         -		if (Tcl_DictObjSize(interp, headerObj, &dummy) != TCL_OK) {
  1947         -		    Tcl_AddErrorInfo(interp, "\n    (in -header option)");
  1948         -		    return TCL_ERROR;
  1949         -		}
  1950         -		break;
  1951         -	    case poLevel:
  1952         -		if (++i > objc-1) {
  1953         -		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
  1954         -			    "value missing for -level option", -1));
  1955         -		    Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
  1956         -		    return TCL_ERROR;
  1957         -		}
  1958         -		if (Tcl_GetIntFromObj(interp, objv[i],
  1959         -			(int *) &level) != TCL_OK) {
  1960         -		    Tcl_AddErrorInfo(interp, "\n    (in -level option)");
  1961         -		    return TCL_ERROR;
  1962         -		}
  1963         -		if (level < 0 || level > 9) {
  1964         -		    extraInfoStr = "\n    (in -level option)";
  1965         -		    goto badLevel;
  1966         -		}
  1967         -		break;
  1968         -	    case poLimit:
  1969         -		if (++i > objc-1) {
  1970         -		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
  1971         -			    "value missing for -limit option", -1));
  1972         -		    Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
  1973         -		    return TCL_ERROR;
  1974         -		}
  1975         -		if (Tcl_GetIntFromObj(interp, objv[i],
  1976         -			(int *) &limit) != TCL_OK) {
  1977         -		    Tcl_AddErrorInfo(interp, "\n    (in -limit option)");
  1978         -		    return TCL_ERROR;
  1979         -		}
  1980         -		if (limit < 1) {
  1981         -		    limit = 1;
  1982         -		}
  1983         -		break;
  1984         -	    }
  1985         -	}
  1986         -
  1987         -	if (ZlibStackChannelTransform(interp, mode, format, level, chan,
  1988         -		headerObj) == NULL) {
  1989         -	    return TCL_ERROR;
  1990         -	}
  1991         -	Tcl_SetObjResult(interp, objv[3]);
  1992         -	return TCL_OK;
  1993         -    }
         2135  +	return ZlibPushSubcmd(interp, objc, objv);
  1994   2136       };
  1995   2137   
  1996   2138       return TCL_ERROR;
  1997   2139   
  1998   2140     badLevel:
  1999   2141       Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9", -1));
  2000   2142       Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL);
  2001   2143       if (extraInfoStr) {
  2002   2144   	Tcl_AddErrorInfo(interp, extraInfoStr);
  2003   2145       }
  2004   2146       return TCL_ERROR;
  2005   2147     badBuffer:
  2006         -    Tcl_SetObjResult(interp, Tcl_NewStringObj(
  2007         -	    "buffer size must be 32 to 65536", -1));
         2148  +    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
         2149  +	    "buffer size must be %d to %d",
         2150  +	    MIN_NONSTREAM_BUFFER_SIZE, MAX_BUFFER_SIZE));
  2008   2151       Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
  2009   2152       return TCL_ERROR;
  2010   2153   }
         2154  +
         2155  +/*
         2156  + *----------------------------------------------------------------------
         2157  + *
         2158  + * ZlibStreamSubcmd --
         2159  + *
         2160  + *	Implementation of the [zlib stream] subcommand.
         2161  + *
         2162  + *----------------------------------------------------------------------
         2163  + */
         2164  +
         2165  +static int
         2166  +ZlibStreamSubcmd(
         2167  +    Tcl_Interp *interp,
         2168  +    int objc,
         2169  +    Tcl_Obj *const objv[])
         2170  +{
         2171  +    static const char *const stream_formats[] = {
         2172  +	"compress", "decompress", "deflate", "gunzip", "gzip", "inflate",
         2173  +	NULL
         2174  +    };
         2175  +    enum zlibFormats {
         2176  +	FMT_COMPRESS, FMT_DECOMPRESS, FMT_DEFLATE, FMT_GUNZIP, FMT_GZIP,
         2177  +	FMT_INFLATE
         2178  +    };
         2179  +    int i, format, mode = 0, option, level;
         2180  +    typedef struct {
         2181  +	const char *name;
         2182  +	Tcl_Obj **valueVar;
         2183  +    } OptDescriptor;
         2184  +    Tcl_Obj *compDictObj = NULL;
         2185  +    Tcl_Obj *gzipHeaderObj = NULL;
         2186  +    Tcl_Obj *levelObj = NULL;
         2187  +    const OptDescriptor compressionOpts[] = {
         2188  +	{ "-dictionary", &compDictObj },
         2189  +	{ "-level", &levelObj },
         2190  +	{ NULL, NULL }
         2191  +    };
         2192  +    const OptDescriptor gzipOpts[] = {
         2193  +	{ "-header", &gzipHeaderObj },
         2194  +	{ "-level", &levelObj },
         2195  +	{ NULL, NULL }
         2196  +    };
         2197  +    const OptDescriptor expansionOpts[] = {
         2198  +	{ "-dictionary", &compDictObj },
         2199  +	{ NULL, NULL }
         2200  +    };
         2201  +    const OptDescriptor gunzipOpts[] = {
         2202  +	{ NULL, NULL }
         2203  +    };
         2204  +    const OptDescriptor *desc = NULL;
         2205  +    Tcl_ZlibStream zh;
         2206  +
         2207  +    if (objc < 3 || !(objc & 1)) {
         2208  +	Tcl_WrongNumArgs(interp, 2, objv, "mode ?-option value...?");
         2209  +	return TCL_ERROR;
         2210  +    }
         2211  +    if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0,
         2212  +	    &format) != TCL_OK) {
         2213  +	return TCL_ERROR;
         2214  +    }
         2215  +
         2216  +    /*
         2217  +     * The format determines the compression mode and the options that may be
         2218  +     * specified.
         2219  +     */
         2220  +
         2221  +    switch ((enum zlibFormats) format) {
         2222  +    case FMT_DEFLATE:
         2223  +	desc = compressionOpts;
         2224  +	mode = TCL_ZLIB_STREAM_DEFLATE;
         2225  +	format = TCL_ZLIB_FORMAT_RAW;
         2226  +	break;
         2227  +    case FMT_INFLATE:
         2228  +	desc = expansionOpts;
         2229  +	mode = TCL_ZLIB_STREAM_INFLATE;
         2230  +	format = TCL_ZLIB_FORMAT_RAW;
         2231  +	break;
         2232  +    case FMT_COMPRESS:
         2233  +	desc = compressionOpts;
         2234  +	mode = TCL_ZLIB_STREAM_DEFLATE;
         2235  +	format = TCL_ZLIB_FORMAT_ZLIB;
         2236  +	break;
         2237  +    case FMT_DECOMPRESS:
         2238  +	desc = expansionOpts;
         2239  +	mode = TCL_ZLIB_STREAM_INFLATE;
         2240  +	format = TCL_ZLIB_FORMAT_ZLIB;
         2241  +	break;
         2242  +    case FMT_GZIP:
         2243  +	desc = gzipOpts;
         2244  +	mode = TCL_ZLIB_STREAM_DEFLATE;
         2245  +	format = TCL_ZLIB_FORMAT_GZIP;
         2246  +	break;
         2247  +    case FMT_GUNZIP:
         2248  +	desc = gunzipOpts;
         2249  +	mode = TCL_ZLIB_STREAM_INFLATE;
         2250  +	format = TCL_ZLIB_FORMAT_GZIP;
         2251  +	break;
         2252  +    default:
         2253  +	Tcl_Panic("should be unreachable");
         2254  +    }
         2255  +
         2256  +    /*
         2257  +     * Parse the options.
         2258  +     */
         2259  +
         2260  +    for (i=3 ; i<objc ; i+=2) {
         2261  +	if (Tcl_GetIndexFromObjStruct(interp, objv[i], desc,
         2262  +		sizeof(OptDescriptor), "option", 0, &option) != TCL_OK) {
         2263  +	    return TCL_ERROR;
         2264  +	}
         2265  +	*desc[option].valueVar = objv[i+1];
         2266  +
         2267  +	/*
         2268  +	 * Drop the cache on the option name; table address not constant.
         2269  +	 */
         2270  +
         2271  +	TclFreeIntRep(objv[i]);
         2272  +    }
         2273  +
         2274  +    /*
         2275  +     * If a compression level was given, parse it (integral: 0..9). Otherwise
         2276  +     * use the default.
         2277  +     */
         2278  +
         2279  +    if (levelObj == NULL) {
         2280  +	level = Z_DEFAULT_COMPRESSION;
         2281  +    } else if (Tcl_GetIntFromObj(interp, levelObj, &level) != TCL_OK) {
         2282  +	return TCL_ERROR;
         2283  +    } else if (level < 0 || level > 9) {
         2284  +	Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9",-1));
         2285  +	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL);
         2286  +	Tcl_AddErrorInfo(interp, "\n    (in -level option)");
         2287  +	return TCL_ERROR;
         2288  +    }
         2289  +
         2290  +    /*
         2291  +     * Construct the stream now we know its configuration.
         2292  +     */
         2293  +
         2294  +    if (Tcl_ZlibStreamInit(interp, mode, format, level, gzipHeaderObj,
         2295  +	    &zh) != TCL_OK) {
         2296  +	return TCL_ERROR;
         2297  +    }
         2298  +    if (compDictObj != NULL) {
         2299  +	Tcl_ZlibStreamSetCompressionDictionary(zh, compDictObj);
         2300  +    }
         2301  +    Tcl_SetObjResult(interp, Tcl_ZlibStreamGetCommandName(zh));
         2302  +    return TCL_OK;
         2303  +}
         2304  +
         2305  +/*
         2306  + *----------------------------------------------------------------------
         2307  + *
         2308  + * ZlibPushSubcmd --
         2309  + *
         2310  + *	Implementation of the [zlib push] subcommand.
         2311  + *
         2312  + *----------------------------------------------------------------------
         2313  + */
         2314  +
         2315  +static int
         2316  +ZlibPushSubcmd(
         2317  +    Tcl_Interp *interp,
         2318  +    int objc,
         2319  +    Tcl_Obj *const objv[])
         2320  +{
         2321  +    static const char *const stream_formats[] = {
         2322  +	"compress", "decompress", "deflate", "gunzip", "gzip", "inflate",
         2323  +	NULL
         2324  +    };
         2325  +    enum zlibFormats {
         2326  +	FMT_COMPRESS, FMT_DECOMPRESS, FMT_DEFLATE, FMT_GUNZIP, FMT_GZIP,
         2327  +	FMT_INFLATE
         2328  +    };
         2329  +    Tcl_Channel chan;
         2330  +    int chanMode, format, mode = 0, level, i, option;
         2331  +    static const char *const pushCompressOptions[] = {
         2332  +	"-dictionary", "-header", "-level", NULL
         2333  +    };
         2334  +    static const char *const pushDecompressOptions[] = {
         2335  +	"-dictionary", "-header", "-level", "-limit", NULL
         2336  +    };
         2337  +    const char *const *pushOptions = pushDecompressOptions;
         2338  +    enum pushOptions {poDictionary, poHeader, poLevel, poLimit};
         2339  +    Tcl_Obj *headerObj = NULL, *compDictObj = NULL;
         2340  +    int limit = 1, dummy;
         2341  +
         2342  +    if (objc < 4) {
         2343  +	Tcl_WrongNumArgs(interp, 2, objv, "mode channel ?options...?");
         2344  +	return TCL_ERROR;
         2345  +    }
         2346  +
         2347  +    if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0,
         2348  +	    &format) != TCL_OK) {
         2349  +	return TCL_ERROR;
         2350  +    }
         2351  +    switch ((enum zlibFormats) format) {
         2352  +    case FMT_DEFLATE:
         2353  +	mode = TCL_ZLIB_STREAM_DEFLATE;
         2354  +	format = TCL_ZLIB_FORMAT_RAW;
         2355  +	pushOptions = pushCompressOptions;
         2356  +	break;
         2357  +    case FMT_INFLATE:
         2358  +	mode = TCL_ZLIB_STREAM_INFLATE;
         2359  +	format = TCL_ZLIB_FORMAT_RAW;
         2360  +	break;
         2361  +    case FMT_COMPRESS:
         2362  +	mode = TCL_ZLIB_STREAM_DEFLATE;
         2363  +	format = TCL_ZLIB_FORMAT_ZLIB;
         2364  +	pushOptions = pushCompressOptions;
         2365  +	break;
         2366  +    case FMT_DECOMPRESS:
         2367  +	mode = TCL_ZLIB_STREAM_INFLATE;
         2368  +	format = TCL_ZLIB_FORMAT_ZLIB;
         2369  +	break;
         2370  +    case FMT_GZIP:
         2371  +	mode = TCL_ZLIB_STREAM_DEFLATE;
         2372  +	format = TCL_ZLIB_FORMAT_GZIP;
         2373  +	pushOptions = pushCompressOptions;
         2374  +	break;
         2375  +    case FMT_GUNZIP:
         2376  +	mode = TCL_ZLIB_STREAM_INFLATE;
         2377  +	format = TCL_ZLIB_FORMAT_GZIP;
         2378  +	break;
         2379  +    default:
         2380  +	Tcl_Panic("should be unreachable");
         2381  +    }
         2382  +
         2383  +    if (TclGetChannelFromObj(interp, objv[3], &chan, &chanMode, 0) != TCL_OK){
         2384  +	return TCL_ERROR;
         2385  +    }
         2386  +
         2387  +    /*
         2388  +     * Sanity checks.
         2389  +     */
         2390  +
         2391  +    if (mode == TCL_ZLIB_STREAM_DEFLATE && !(chanMode & TCL_WRITABLE)) {
         2392  +	Tcl_SetObjResult(interp, Tcl_NewStringObj(
         2393  +		"compression may only be applied to writable channels", -1));
         2394  +	Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNWRITABLE", NULL);
         2395  +	return TCL_ERROR;
         2396  +    }
         2397  +    if (mode == TCL_ZLIB_STREAM_INFLATE && !(chanMode & TCL_READABLE)) {
         2398  +	Tcl_SetObjResult(interp, Tcl_NewStringObj(
         2399  +		"decompression may only be applied to readable channels",-1));
         2400  +	Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNREADABLE", NULL);
         2401  +	return TCL_ERROR;
         2402  +    }
         2403  +
         2404  +    /*
         2405  +     * Parse options.
         2406  +     */
         2407  +
         2408  +    level = Z_DEFAULT_COMPRESSION;
         2409  +    for (i=4 ; i<objc ; i++) {
         2410  +	if (Tcl_GetIndexFromObj(interp, objv[i], pushOptions, "option", 0,
         2411  +		&option) != TCL_OK) {
         2412  +	    return TCL_ERROR;
         2413  +	}
         2414  +	if (++i > objc-1) {
         2415  +	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
         2416  +		    "value missing for %s option", pushOptions[option]));
         2417  +	    Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
         2418  +	    return TCL_ERROR;
         2419  +	}
         2420  +	switch ((enum pushOptions) option) {
         2421  +	case poHeader:
         2422  +	    headerObj = objv[i];
         2423  +	    if (Tcl_DictObjSize(interp, headerObj, &dummy) != TCL_OK) {
         2424  +		goto genericOptionError;
         2425  +	    }
         2426  +	    break;
         2427  +	case poLevel:
         2428  +	    if (Tcl_GetIntFromObj(interp, objv[i], (int*) &level) != TCL_OK) {
         2429  +		goto genericOptionError;
         2430  +	    }
         2431  +	    if (level < 0 || level > 9) {
         2432  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(
         2433  +			"level must be 0 to 9", -1));
         2434  +		Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL",
         2435  +			NULL);
         2436  +		goto genericOptionError;
         2437  +	    }
         2438  +	    break;
         2439  +	case poLimit:
         2440  +	    if (Tcl_GetIntFromObj(interp, objv[i], (int*) &limit) != TCL_OK) {
         2441  +		goto genericOptionError;
         2442  +	    }
         2443  +	    if (limit < 1 || limit > MAX_BUFFER_SIZE) {
         2444  +		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
         2445  +			"read ahead limit must be 1 to %d",
         2446  +			MAX_BUFFER_SIZE));
         2447  +		Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
         2448  +		goto genericOptionError;
         2449  +	    }
         2450  +	    break;
         2451  +	case poDictionary:
         2452  +	    if (format == TCL_ZLIB_FORMAT_GZIP) {
         2453  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(
         2454  +			"a compression dictionary may not be set in the "
         2455  +			"gzip format", -1));
         2456  +		Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOPT", NULL);
         2457  +		goto genericOptionError;
         2458  +	    }
         2459  +	    compDictObj = objv[i];
         2460  +	    break;
         2461  +	}
         2462  +    }
         2463  +
         2464  +    if (ZlibStackChannelTransform(interp, mode, format, level, limit, chan,
         2465  +	    headerObj, compDictObj) == NULL) {
         2466  +	return TCL_ERROR;
         2467  +    }
         2468  +    Tcl_SetObjResult(interp, objv[3]);
         2469  +    return TCL_OK;
         2470  +
         2471  +  genericOptionError:
         2472  +    Tcl_AddErrorInfo(interp, "\n    (in ");
         2473  +    Tcl_AddErrorInfo(interp, pushOptions[option]);
         2474  +    Tcl_AddErrorInfo(interp, " option)");
         2475  +    return TCL_ERROR;
         2476  +}
  2011   2477   
  2012   2478   /*
  2013   2479    *----------------------------------------------------------------------
  2014   2480    *
  2015   2481    * ZlibStreamCmd --
  2016   2482    *
  2017   2483    *	Implementation of the commands returned by [zlib stream].
................................................................................
  2023   2489   ZlibStreamCmd(
  2024   2490       ClientData cd,
  2025   2491       Tcl_Interp *interp,
  2026   2492       int objc,
  2027   2493       Tcl_Obj *const objv[])
  2028   2494   {
  2029   2495       Tcl_ZlibStream zstream = cd;
  2030         -    int command, index, count, code, buffersize = -1, flush = -1, i;
         2496  +    int command, count, code;
  2031   2497       Tcl_Obj *obj;
  2032   2498       static const char *const cmds[] = {
  2033   2499   	"add", "checksum", "close", "eof", "finalize", "flush",
  2034         -	"fullflush", "get", "put", "reset",
         2500  +	"fullflush", "get", "header", "put", "reset",
  2035   2501   	NULL
  2036   2502       };
  2037   2503       enum zlibStreamCommands {
  2038   2504   	zs_add, zs_checksum, zs_close, zs_eof, zs_finalize, zs_flush,
  2039         -	zs_fullflush, zs_get, zs_put, zs_reset
  2040         -    };
  2041         -    static const char *const add_options[] = {
  2042         -	"-buffer", "-finalize", "-flush", "-fullflush", NULL
  2043         -    };
  2044         -    enum addOptions {
  2045         -	ao_buffer, ao_finalize, ao_flush, ao_fullflush
         2505  +	zs_fullflush, zs_get, zs_header, zs_put, zs_reset
  2046   2506       };
  2047   2507   
  2048   2508       if (objc < 2) {
  2049   2509   	Tcl_WrongNumArgs(interp, 1, objv, "option data ?...?");
  2050   2510   	return TCL_ERROR;
  2051   2511       }
  2052   2512   
................................................................................
  2053   2513       if (Tcl_GetIndexFromObj(interp, objv[1], cmds, "option", 0,
  2054   2514   	    &command) != TCL_OK) {
  2055   2515   	return TCL_ERROR;
  2056   2516       }
  2057   2517   
  2058   2518       switch ((enum zlibStreamCommands) command) {
  2059   2519       case zs_add:		/* $strm add ?$flushopt? $data */
  2060         -	for (i=2; i<objc-1; i++) {
  2061         -	    if (Tcl_GetIndexFromObj(interp, objv[i], add_options, "option", 0,
  2062         -		    &index) != TCL_OK) {
  2063         -		return TCL_ERROR;
  2064         -	    }
  2065         -
  2066         -	    switch ((enum addOptions) index) {
  2067         -	    case ao_flush: /* -flush */
  2068         -		if (flush > -1) {
  2069         -		    flush = -2;
  2070         -		} else {
  2071         -		    flush = Z_SYNC_FLUSH;
  2072         -		}
  2073         -		break;
  2074         -	    case ao_fullflush: /* -fullflush */
  2075         -		if (flush > -1) {
  2076         -		    flush = -2;
  2077         -		} else {
  2078         -		    flush = Z_FULL_FLUSH;
  2079         -		}
  2080         -		break;
  2081         -	    case ao_finalize: /* -finalize */
  2082         -		if (flush > -1) {
  2083         -		    flush = -2;
  2084         -		} else {
  2085         -		    flush = Z_FINISH;
  2086         -		}
  2087         -		break;
  2088         -	    case ao_buffer: /* -buffer */
  2089         -		if (i == objc-2) {
  2090         -		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
  2091         -			    "\"-buffer\" option must be followed by integer"
  2092         -			    " decompression buffersize", -1));
  2093         -		    Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
  2094         -		    return TCL_ERROR;
  2095         -		}
  2096         -		if (Tcl_GetIntFromObj(interp, objv[i+1],
  2097         -			&buffersize) != TCL_OK) {
  2098         -		    return TCL_ERROR;
  2099         -		}
  2100         -		if (buffersize < 1 || buffersize > 65536) {
  2101         -		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
  2102         -			    "buffer size must be 32 to 65536", -1));
  2103         -		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE",
  2104         -			    NULL);
  2105         -		    return TCL_ERROR;
  2106         -		}
  2107         -	    }
  2108         -
  2109         -	    if (flush == -2) {
  2110         -		Tcl_SetObjResult(interp, Tcl_NewStringObj(
  2111         -			"\"-flush\", \"-fullflush\" and \"-finalize\" options"
  2112         -			" are mutually exclusive", -1));
  2113         -		Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL);
  2114         -		return TCL_ERROR;
  2115         -	    }
  2116         -	}
  2117         -	if (flush == -1) {
  2118         -	    flush = 0;
  2119         -	}
  2120         -
  2121         -	if (Tcl_ZlibStreamPut(zstream, objv[objc-1], flush) != TCL_OK) {
  2122         -	    return TCL_ERROR;
  2123         -	}
  2124         -	TclNewObj(obj);
  2125         -	code = Tcl_ZlibStreamGet(zstream, obj, buffersize);
  2126         -	if (code == TCL_OK) {
  2127         -	    Tcl_SetObjResult(interp, obj);
  2128         -	} else {
  2129         -	    TclDecrRefCount(obj);
  2130         -	}
  2131         -	return code;
  2132         -
         2520  +	return ZlibStreamAddCmd(zstream, interp, objc, objv);
         2521  +    case zs_header:		/* $strm header */
         2522  +	return ZlibStreamHeaderCmd(zstream, interp, objc, objv);
  2133   2523       case zs_put:		/* $strm put ?$flushopt? $data */
  2134         -	for (i=2; i<objc-1; i++) {
  2135         -	    if (Tcl_GetIndexFromObj(interp, objv[i], add_options, "option", 0,
  2136         -		    &index) != TCL_OK) {
  2137         -		return TCL_ERROR;
  2138         -	    }
  2139         -
  2140         -	    switch ((enum addOptions) index) {
  2141         -	    case ao_flush: /* -flush */
  2142         -		if (flush > -1) {
  2143         -		    flush = -2;
  2144         -		} else {
  2145         -		    flush = Z_SYNC_FLUSH;
  2146         -		}
  2147         -		break;
  2148         -	    case ao_fullflush: /* -fullflush */
  2149         -		if (flush > -1) {
  2150         -		    flush = -2;
  2151         -		} else {
  2152         -		    flush = Z_FULL_FLUSH;
  2153         -		}
  2154         -		break;
  2155         -	    case ao_finalize: /* -finalize */
  2156         -		if (flush > -1) {
  2157         -		    flush = -2;
  2158         -		} else {
  2159         -		    flush = Z_FINISH;
  2160         -		}
  2161         -		break;
  2162         -	    case ao_buffer:
  2163         -		Tcl_SetObjResult(interp, Tcl_NewStringObj(
  2164         -			"\"-buffer\" option not supported here", -1));
  2165         -		return TCL_ERROR;
  2166         -	    }
  2167         -	    if (flush == -2) {
  2168         -		Tcl_SetObjResult(interp, Tcl_NewStringObj(
  2169         -			"\"-flush\", \"-fullflush\" and \"-finalize\" options"
  2170         -			" are mutually exclusive", -1));
  2171         -		Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL);
  2172         -		return TCL_ERROR;
  2173         -	    }
  2174         -	}
  2175         -	if (flush == -1) {
  2176         -	    flush = 0;
  2177         -	}
  2178         -	return Tcl_ZlibStreamPut(zstream, objv[objc-1], flush);
         2524  +	return ZlibStreamPutCmd(zstream, interp, objc, objv);
  2179   2525   
  2180   2526       case zs_get:		/* $strm get ?count? */
  2181   2527   	if (objc > 3) {
  2182   2528   	    Tcl_WrongNumArgs(interp, 2, objv, "?count?");
  2183   2529   	    return TCL_ERROR;
  2184   2530   	}
  2185   2531   
................................................................................
  2248   2594   	return TCL_OK;
  2249   2595       case zs_checksum:		/* $strm checksum */
  2250   2596   	if (objc != 2) {
  2251   2597   	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
  2252   2598   	    return TCL_ERROR;
  2253   2599   	}
  2254   2600   	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
  2255         -		Tcl_ZlibStreamChecksum(zstream)));
         2601  +		(uLong) Tcl_ZlibStreamChecksum(zstream)));
  2256   2602   	return TCL_OK;
  2257   2603       case zs_reset:		/* $strm reset */
  2258   2604   	if (objc != 2) {
  2259   2605   	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
  2260   2606   	    return TCL_ERROR;
  2261   2607   	}
  2262   2608   	return Tcl_ZlibStreamReset(zstream);
  2263   2609       }
  2264   2610   
  2265   2611       return TCL_OK;
  2266   2612   }
         2613  +
         2614  +static int
         2615  +ZlibStreamAddCmd(
         2616  +    ClientData cd,
         2617  +    Tcl_Interp *interp,
         2618  +    int objc,
         2619  +    Tcl_Obj *const objv[])
         2620  +{
         2621  +    Tcl_ZlibStream zstream = cd;
         2622  +    int index, code, buffersize = -1, flush = -1, i;
         2623  +    Tcl_Obj *obj, *compDictObj = NULL;
         2624  +    static const char *const add_options[] = {
         2625  +	"-buffer", "-dictionary", "-finalize", "-flush", "-fullflush", NULL
         2626  +    };
         2627  +    enum addOptions {
         2628  +	ao_buffer, ao_dictionary, ao_finalize, ao_flush, ao_fullflush
         2629  +    };
         2630  +
         2631  +    for (i=2; i<objc-1; i++) {
         2632  +	if (Tcl_GetIndexFromObj(interp, objv[i], add_options, "option", 0,
         2633  +		&index) != TCL_OK) {
         2634  +	    return TCL_ERROR;
         2635  +	}
         2636  +
         2637  +	switch ((enum addOptions) index) {
         2638  +	case ao_flush: /* -flush */
         2639  +	    if (flush > -1) {
         2640  +		flush = -2;
         2641  +	    } else {
         2642  +		flush = Z_SYNC_FLUSH;
         2643  +	    }
         2644  +	    break;
         2645  +	case ao_fullflush: /* -fullflush */
         2646  +	    if (flush > -1) {
         2647  +		flush = -2;
         2648  +	    } else {
         2649  +		flush = Z_FULL_FLUSH;
         2650  +	    }
         2651  +	    break;
         2652  +	case ao_finalize: /* -finalize */
         2653  +	    if (flush > -1) {
         2654  +		flush = -2;
         2655  +	    } else {
         2656  +		flush = Z_FINISH;
         2657  +	    }
         2658  +	    break;
         2659  +	case ao_buffer: /* -buffer */
         2660  +	    if (i == objc-2) {
         2661  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(
         2662  +			"\"-buffer\" option must be followed by integer "
         2663  +			"decompression buffersize", -1));
         2664  +		Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
         2665  +		return TCL_ERROR;
         2666  +	    }
         2667  +	    if (Tcl_GetIntFromObj(interp, objv[++i], &buffersize) != TCL_OK) {
         2668  +		return TCL_ERROR;
         2669  +	    }
         2670  +	    if (buffersize < 1 || buffersize > MAX_BUFFER_SIZE) {
         2671  +		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
         2672  +			"buffer size must be 1 to %d",
         2673  +			MAX_BUFFER_SIZE));
         2674  +		Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
         2675  +		return TCL_ERROR;
         2676  +	    }
         2677  +	    break;
         2678  +	case ao_dictionary:
         2679  +	    if (i == objc-2) {
         2680  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(
         2681  +			"\"-dictionary\" option must be followed by"
         2682  +			" compression dictionary bytes", -1));
         2683  +		Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
         2684  +		return TCL_ERROR;
         2685  +	    }
         2686  +	    compDictObj = objv[++i];
         2687  +	    break;
         2688  +	}
         2689  +
         2690  +	if (flush == -2) {
         2691  +	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
         2692  +		    "\"-flush\", \"-fullflush\" and \"-finalize\" options"
         2693  +		    " are mutually exclusive", -1));
         2694  +	    Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL);
         2695  +	    return TCL_ERROR;
         2696  +	}
         2697  +    }
         2698  +    if (flush == -1) {
         2699  +	flush = 0;
         2700  +    }
         2701  +
         2702  +    /*
         2703  +     * Set the compression dictionary if requested.
         2704  +     */
         2705  +
         2706  +    if (compDictObj != NULL) {
         2707  +	int len;
         2708  +
         2709  +	(void) Tcl_GetByteArrayFromObj(compDictObj, &len);
         2710  +	if (len == 0) {
         2711  +	    compDictObj = NULL;
         2712  +	}
         2713  +	Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj);
         2714  +    }
         2715  +
         2716  +    /*
         2717  +     * Send the data to the stream core, along with any flushing directive.
         2718  +     */
         2719  +
         2720  +    if (Tcl_ZlibStreamPut(zstream, objv[objc-1], flush) != TCL_OK) {
         2721  +	return TCL_ERROR;
         2722  +    }
         2723  +
         2724  +    /*
         2725  +     * Get such data out as we can (up to the requested length).
         2726  +     */
         2727  +
         2728  +    TclNewObj(obj);
         2729  +    code = Tcl_ZlibStreamGet(zstream, obj, buffersize);
         2730  +    if (code == TCL_OK) {
         2731  +	Tcl_SetObjResult(interp, obj);
         2732  +    } else {
         2733  +	TclDecrRefCount(obj);
         2734  +    }
         2735  +    return code;
         2736  +}
         2737  +
         2738  +static int
         2739  +ZlibStreamPutCmd(
         2740  +    ClientData cd,
         2741  +    Tcl_Interp *interp,
         2742  +    int objc,
         2743  +    Tcl_Obj *const objv[])
         2744  +{
         2745  +    Tcl_ZlibStream zstream = cd;
         2746  +    int index, flush = -1, i;
         2747  +    Tcl_Obj *compDictObj = NULL;
         2748  +    static const char *const put_options[] = {
         2749  +	"-dictionary", "-finalize", "-flush", "-fullflush", NULL
         2750  +    };
         2751  +    enum putOptions {
         2752  +	po_dictionary, po_finalize, po_flush, po_fullflush
         2753  +    };
         2754  +
         2755  +    for (i=2; i<objc-1; i++) {
         2756  +	if (Tcl_GetIndexFromObj(interp, objv[i], put_options, "option", 0,
         2757  +		&index) != TCL_OK) {
         2758  +	    return TCL_ERROR;
         2759  +	}
         2760  +
         2761  +	switch ((enum putOptions) index) {
         2762  +	case po_flush: /* -flush */
         2763  +	    if (flush > -1) {
         2764  +		flush = -2;
         2765  +	    } else {
         2766  +		flush = Z_SYNC_FLUSH;
         2767  +	    }
         2768  +	    break;
         2769  +	case po_fullflush: /* -fullflush */
         2770  +	    if (flush > -1) {
         2771  +		flush = -2;
         2772  +	    } else {
         2773  +		flush = Z_FULL_FLUSH;
         2774  +	    }
         2775  +	    break;
         2776  +	case po_finalize: /* -finalize */
         2777  +	    if (flush > -1) {
         2778  +		flush = -2;
         2779  +	    } else {
         2780  +		flush = Z_FINISH;
         2781  +	    }
         2782  +	    break;
         2783  +	case po_dictionary:
         2784  +	    if (i == objc-2) {
         2785  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(
         2786  +			"\"-dictionary\" option must be followed by"
         2787  +			" compression dictionary bytes", -1));
         2788  +		Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
         2789  +		return TCL_ERROR;
         2790  +	    }
         2791  +	    compDictObj = objv[++i];
         2792  +	    break;
         2793  +	}
         2794  +	if (flush == -2) {
         2795  +	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
         2796  +		    "\"-flush\", \"-fullflush\" and \"-finalize\" options"
         2797  +		    " are mutually exclusive", -1));
         2798  +	    Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL);
         2799  +	    return TCL_ERROR;
         2800  +	}
         2801  +    }
         2802  +    if (flush == -1) {
         2803  +	flush = 0;
         2804  +    }
         2805  +
         2806  +    /*
         2807  +     * Set the compression dictionary if requested.
         2808  +     */
         2809  +
         2810  +    if (compDictObj != NULL) {
         2811  +	int len;
         2812  +
         2813  +	(void) Tcl_GetByteArrayFromObj(compDictObj, &len);
         2814  +	if (len == 0) {
         2815  +	    compDictObj = NULL;
         2816  +	}
         2817  +	Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj);
         2818  +    }
         2819  +
         2820  +    /*
         2821  +     * Send the data to the stream core, along with any flushing directive.
         2822  +     */
         2823  +
         2824  +    return Tcl_ZlibStreamPut(zstream, objv[objc-1], flush);
         2825  +}
         2826  +
         2827  +static int
         2828  +ZlibStreamHeaderCmd(
         2829  +    ClientData cd,
         2830  +    Tcl_Interp *interp,
         2831  +    int objc,
         2832  +    Tcl_Obj *const objv[])
         2833  +{
         2834  +    ZlibStreamHandle *zshPtr = cd;
         2835  +    Tcl_Obj *resultObj;
         2836  +
         2837  +    if (objc != 2) {
         2838  +	Tcl_WrongNumArgs(interp, 2, objv, NULL);
         2839  +	return TCL_ERROR;
         2840  +    } else if (zshPtr->mode != TCL_ZLIB_STREAM_INFLATE
         2841  +	    || zshPtr->format != TCL_ZLIB_FORMAT_GZIP) {
         2842  +	Tcl_SetObjResult(interp, Tcl_NewStringObj(
         2843  +		"only gunzip streams can produce header information", -1));
         2844  +	Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOP", NULL);
         2845  +	return TCL_ERROR;
         2846  +    }
         2847  +
         2848  +    TclNewObj(resultObj);
         2849  +    ExtractHeader(&zshPtr->gzHeaderPtr->header, resultObj);
         2850  +    Tcl_SetObjResult(interp, resultObj);
         2851  +    return TCL_OK;
         2852  +}
  2267   2853   
  2268   2854   /*
  2269   2855    *----------------------------------------------------------------------
  2270   2856    *	Set of functions to support channel stacking.
  2271   2857    *----------------------------------------------------------------------
  2272   2858    *
  2273   2859    * ZlibTransformClose --
................................................................................
  2300   2886   	do {
  2301   2887   	    cd->outStream.next_out = (Bytef *) cd->outBuffer;
  2302   2888   	    cd->outStream.avail_out = (unsigned) cd->outAllocated;
  2303   2889   	    e = deflate(&cd->outStream, Z_FINISH);
  2304   2890   	    if (e != Z_OK && e != Z_STREAM_END) {
  2305   2891   		/* TODO: is this the right way to do errors on close? */
  2306   2892   		if (!TclInThreadExit()) {
  2307         -		    ConvertError(interp, e);
         2893  +		    ConvertError(interp, e, cd->outStream.adler);
  2308   2894   		}
  2309   2895   		result = TCL_ERROR;
  2310   2896   		break;
  2311   2897   	    }
  2312   2898   	    if (cd->outStream.avail_out != (unsigned) cd->outAllocated) {
  2313   2899   		if (Tcl_WriteRaw(cd->parent, cd->outBuffer,
  2314   2900   			cd->outAllocated - cd->outStream.avail_out) < 0) {
  2315   2901   		    /* TODO: is this the right way to do errors on close?
  2316   2902   		     * Note: when close is called from FinalizeIOSubsystem
  2317   2903   		     * then interp may be NULL */
  2318         -		    if (!TclInThreadExit()) {
  2319         -			if (interp) {
  2320         -			    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
  2321         -				    "error while finalizing file: %s",
  2322         -				    Tcl_PosixError(interp)));
  2323         -			}
         2904  +		    if (!TclInThreadExit() && interp) {
         2905  +			Tcl_SetObjResult(interp, Tcl_ObjPrintf(
         2906  +				"error while finalizing file: %s",
         2907  +				Tcl_PosixError(interp)));
  2324   2908   		    }
  2325   2909   		    result = TCL_ERROR;
  2326   2910   		    break;
  2327   2911   		}
  2328   2912   	    }
  2329   2913   	} while (e != Z_STREAM_END);
  2330   2914   	e = deflateEnd(&cd->outStream);
................................................................................
  2402   2986   	 * Length (cd->decompressed) == 0, toRead > 0 here.
  2403   2987   	 *
  2404   2988   	 * The zlib transform allows us to read at most one character from the
  2405   2989   	 * underlying channel to properly identify Z_STREAM_END without
  2406   2990   	 * reading over the border.
  2407   2991   	 */
  2408   2992   
  2409         -	readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, 1);
         2993  +	readBytes = Tcl_ReadRaw(cd->parent, cd->inBuffer, cd->readAheadLimit);
  2410   2994   
  2411   2995   	/*
  2412   2996   	 * Three cases here:
  2413   2997   	 *  1.	Got some data from the underlying channel (readBytes > 0) so
  2414   2998   	 *	it should be fed through the decompression engine.
  2415   2999   	 *  2.	Got an error (readBytes < 0) which we should report up except
  2416   3000   	 *	for the case where we can convert it to a short read.
................................................................................
  2516   3100       int toWrite,
  2517   3101       int *errorCodePtr)
  2518   3102   {
  2519   3103       ZlibChannelData *cd = instanceData;
  2520   3104       Tcl_DriverOutputProc *outProc =
  2521   3105   	    Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent));
  2522   3106       int e, produced;
         3107  +    Tcl_Obj *errObj;
  2523   3108   
  2524   3109       if (cd->mode == TCL_ZLIB_STREAM_INFLATE) {
  2525   3110   	return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite,
  2526   3111   		errorCodePtr);
  2527   3112       }
  2528   3113   
  2529   3114       cd->outStream.next_in = (Bytef *) buf;
................................................................................
  2539   3124   	    if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) {
  2540   3125   		*errorCodePtr = Tcl_GetErrno();
  2541   3126   		return -1;
  2542   3127   	    }
  2543   3128   	}
  2544   3129       } while (e == Z_OK && produced > 0 && cd->outStream.avail_in > 0);
  2545   3130   
  2546         -    if (e != Z_OK) {
  2547         -	Tcl_SetChannelError(cd->parent,
  2548         -		Tcl_NewStringObj(cd->outStream.msg, -1));
  2549         -	*errorCodePtr = EINVAL;
  2550         -	return -1;
         3131  +    if (e == Z_OK) {
         3132  +	return toWrite - cd->outStream.avail_in;
  2551   3133       }
  2552   3134   
  2553         -    return toWrite - cd->outStream.avail_in;
         3135  +    errObj = Tcl_NewListObj(0, NULL);
         3136  +    Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1));
         3137  +    Tcl_ListObjAppendElement(NULL, errObj,
         3138  +	    ConvertErrorToList(e, cd->outStream.adler));
         3139  +    Tcl_ListObjAppendElement(NULL, errObj,
         3140  +	    Tcl_NewStringObj(cd->outStream.msg, -1));
         3141  +    Tcl_SetChannelError(cd->parent, errObj);
         3142  +    *errorCodePtr = EINVAL;
         3143  +    return -1;
  2554   3144   }
  2555   3145   
  2556   3146   /*
  2557   3147    *----------------------------------------------------------------------
  2558   3148    *
  2559   3149    * ZlibTransformSetOption --
  2560   3150    *
................................................................................
  2569   3159       Tcl_Interp *interp,
  2570   3160       const char *optionName,
  2571   3161       const char *value)
  2572   3162   {
  2573   3163       ZlibChannelData *cd = instanceData;
  2574   3164       Tcl_DriverSetOptionProc *setOptionProc =
  2575   3165   	    Tcl_ChannelSetOptionProc(Tcl_GetChannelType(cd->parent));
  2576         -    static const char *chanOptions = "flush";
         3166  +    static const char *compressChanOptions = "dictionary flush";
         3167  +    static const char *gzipChanOptions = "flush";
         3168  +    static const char *decompressChanOptions = "dictionary limit";
         3169  +    static const char *gunzipChanOptions = "flush limit";
  2577   3170       int haveFlushOpt = (cd->mode == TCL_ZLIB_STREAM_DEFLATE);
  2578   3171   
  2579         -    if (haveFlushOpt && optionName && strcmp(optionName, "-flush") == 0) {
  2580         -	int flushType;
  2581         -
  2582         -	if (value[0] == 'f' && strcmp(value, "full") == 0) {
  2583         -	    flushType = Z_FULL_FLUSH;
  2584         -	} else if (value[0] == 's' && strcmp(value, "sync") == 0) {
  2585         -	    flushType = Z_SYNC_FLUSH;
  2586         -	} else {
  2587         -	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
  2588         -		    "unknown -flush type \"%s\": must be full or sync",
  2589         -		    value));
  2590         -	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "FLUSH", NULL);
  2591         -	    return TCL_ERROR;
  2592         -	}
  2593         -
  2594         -	/*
  2595         -	 * Try to actually do the flush now.
  2596         -	 */
  2597         -
  2598         -	cd->outStream.avail_in = 0;
  2599         -	while (1) {
  2600         -	    int e;
  2601         -
  2602         -	    cd->outStream.next_out = (Bytef *) cd->outBuffer;
  2603         -	    cd->outStream.avail_out = cd->outAllocated;
  2604         -
  2605         -	    e = deflate(&cd->outStream, flushType);
  2606         -	    if (e == Z_BUF_ERROR) {
  2607         -		break;
  2608         -	    } else if (e != Z_OK) {
  2609         -		ConvertError(interp, e);
         3172  +    if (optionName && (strcmp(optionName, "-dictionary") == 0)
         3173  +	    && (cd->format != TCL_ZLIB_FORMAT_GZIP)) {
         3174  +	Tcl_Obj *compDictObj;
         3175  +	int code;
         3176  +
         3177  +	TclNewStringObj(compDictObj, value, strlen(value));
         3178  +	Tcl_IncrRefCount(compDictObj);
         3179  +	(void) Tcl_GetByteArrayFromObj(compDictObj, NULL);
         3180  +	if (cd->compDictObj) {
         3181  +	    TclDecrRefCount(cd->compDictObj);
         3182  +	}
         3183  +	cd->compDictObj = compDictObj;
         3184  +	code = Z_OK;
         3185  +	if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
         3186  +	    code = SetDeflateDictionary(&cd->outStream, compDictObj);
         3187  +	    if (code != Z_OK) {
         3188  +		ConvertError(interp, code, cd->outStream.adler);
  2610   3189   		return TCL_ERROR;
  2611         -	    } else if (cd->outStream.avail_out == 0) {
  2612         -		break;
  2613   3190   	    }
  2614         -
  2615         -	    if (Tcl_WriteRaw(cd->parent, cd->outBuffer,
  2616         -		    cd->outStream.next_out - (Bytef *) cd->outBuffer) < 0) {
  2617         -		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
  2618         -			"problem flushing channel: %s",
  2619         -			Tcl_PosixError(interp)));
         3191  +	} else if (cd->format == TCL_ZLIB_FORMAT_RAW) {
         3192  +	    code = SetInflateDictionary(&cd->inStream, compDictObj);
         3193  +	    if (code != Z_OK) {
         3194  +		ConvertError(interp, code, cd->inStream.adler);
  2620   3195   		return TCL_ERROR;
  2621   3196   	    }
  2622   3197   	}
  2623   3198   	return TCL_OK;
  2624   3199       }
         3200  +
         3201  +    if (haveFlushOpt) {
         3202  +	if (optionName && strcmp(optionName, "-flush") == 0) {
         3203  +	    int flushType;
         3204  +
         3205  +	    if (value[0] == 'f' && strcmp(value, "full") == 0) {
         3206  +		flushType = Z_FULL_FLUSH;
         3207  +	    } else if (value[0] == 's' && strcmp(value, "sync") == 0) {
         3208  +		flushType = Z_SYNC_FLUSH;
         3209  +	    } else {
         3210  +		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
         3211  +			"unknown -flush type \"%s\": must be full or sync",
         3212  +			value));
         3213  +		Tcl_SetErrorCode(interp, "TCL", "VALUE", "FLUSH", NULL);
         3214  +		return TCL_ERROR;
         3215  +	    }
         3216  +
         3217  +	    /*
         3218  +	     * Try to actually do the flush now.
         3219  +	     */
         3220  +
         3221  +	    cd->outStream.avail_in = 0;
         3222  +	    while (1) {
         3223  +		int e;
         3224  +
         3225  +		cd->outStream.next_out = (Bytef *) cd->outBuffer;
         3226  +		cd->outStream.avail_out = cd->outAllocated;
         3227  +
         3228  +		e = deflate(&cd->outStream, flushType);
         3229  +		if (e == Z_BUF_ERROR) {
         3230  +		    break;
         3231  +		} else if (e != Z_OK) {
         3232  +		    ConvertError(interp, e, cd->outStream.adler);
         3233  +		    return TCL_ERROR;
         3234  +		} else if (cd->outStream.avail_out == 0) {
         3235  +		    break;
         3236  +		}
         3237  +
         3238  +		if (Tcl_WriteRaw(cd->parent, cd->outBuffer,
         3239  +			cd->outStream.next_out - (Bytef *) cd->outBuffer)<0) {
         3240  +		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
         3241  +			    "problem flushing channel: %s",
         3242  +			    Tcl_PosixError(interp)));
         3243  +		    return TCL_ERROR;
         3244  +		}
         3245  +	    }
         3246  +	    return TCL_OK;
         3247  +	}
         3248  +    } else {
         3249  +	if (optionName && strcmp(optionName, "-limit") == 0) {
         3250  +	    int newLimit;
         3251  +
         3252  +	    if (Tcl_GetInt(interp, value, &newLimit) != TCL_OK) {
         3253  +		return TCL_ERROR;
         3254  +	    } else if (newLimit < 1 || newLimit > MAX_BUFFER_SIZE) {
         3255  +		Tcl_SetObjResult(interp, Tcl_NewStringObj(
         3256  +			"-limit must be between 1 and 65536", -1));
         3257  +		Tcl_SetErrorCode(interp, "TCL", "VALUE", "READLIMIT", NULL);
         3258  +		return TCL_ERROR;
         3259  +	    }
         3260  +	}
         3261  +    }
  2625   3262   
  2626   3263       if (setOptionProc == NULL) {
  2627         -	return Tcl_BadChannelOption(interp, optionName, chanOptions);
         3264  +	if (cd->format == TCL_ZLIB_FORMAT_GZIP) {
         3265  +	    return Tcl_BadChannelOption(interp, optionName,
         3266  +		    (cd->mode == TCL_ZLIB_STREAM_DEFLATE)
         3267  +		    ? gzipChanOptions : gunzipChanOptions);
         3268  +	} else {
         3269  +	    return Tcl_BadChannelOption(interp, optionName,
         3270  +		    (cd->mode == TCL_ZLIB_STREAM_DEFLATE)
         3271  +		    ? compressChanOptions : decompressChanOptions);
         3272  +	}
  2628   3273       }
  2629   3274   
  2630   3275       /*
  2631   3276        * Pass all unknown options down, to deeper transforms and/or the base
  2632   3277        * channel.
  2633   3278        */
  2634   3279   
................................................................................
  2652   3297       Tcl_Interp *interp,
  2653   3298       const char *optionName,
  2654   3299       Tcl_DString *dsPtr)
  2655   3300   {
  2656   3301       ZlibChannelData *cd = instanceData;
  2657   3302       Tcl_DriverGetOptionProc *getOptionProc =
  2658   3303   	    Tcl_ChannelGetOptionProc(Tcl_GetChannelType(cd->parent));
  2659         -    static const char *chanOptions = "checksum header";
         3304  +    static const char *compressChanOptions = "checksum dictionary";
         3305  +    static const char *gzipChanOptions = "checksum";
         3306  +    static const char *decompressChanOptions = "checksum dictionary limit";
         3307  +    static const char *gunzipChanOptions = "checksum header limit";
  2660   3308   
  2661   3309       /*
  2662   3310        * The "crc" option reports the current CRC (calculated with the Adler32
  2663   3311        * or CRC32 algorithm according to the format) given the data that has
  2664   3312        * been processed so far.
  2665   3313        */
  2666   3314   
................................................................................
  2679   3327   	    Tcl_DStringAppendElement(dsPtr, "-checksum");
  2680   3328   	    Tcl_DStringAppendElement(dsPtr, buf);
  2681   3329   	} else {
  2682   3330   	    Tcl_DStringAppend(dsPtr, buf, -1);
  2683   3331   	    return TCL_OK;
  2684   3332   	}
  2685   3333       }
         3334  +
         3335  +    if ((cd->format != TCL_ZLIB_FORMAT_GZIP) &&
         3336  +	    (optionName == NULL || strcmp(optionName, "-dictionary") == 0)) {
         3337  +	/*
         3338  +	 * Embedded NUL bytes are ok; they'll be C080-encoded.
         3339  +	 */
         3340  +
         3341  +	if (optionName == NULL) {
         3342  +	    Tcl_DStringAppendElement(dsPtr, "-dictionary");
         3343  +	    if (cd->compDictObj) {
         3344  +		Tcl_DStringAppendElement(dsPtr,
         3345  +			Tcl_GetString(cd->compDictObj));
         3346  +	    } else {
         3347  +		Tcl_DStringAppendElement(dsPtr, "");
         3348  +	    }
         3349  +	} else {
         3350  +	    int len;
         3351  +	    const char *str = Tcl_GetStringFromObj(cd->compDictObj, &len);
         3352  +
         3353  +	    Tcl_DStringAppend(dsPtr, str, len);
         3354  +	}
         3355  +    }
  2686   3356   
  2687   3357       /*
  2688   3358        * The "header" option, which is only valid on inflating gzip channels,
  2689   3359        * reports the header that has been read from the start of the stream.
  2690   3360        */
  2691   3361   
  2692   3362       if ((cd->flags & IN_HEADER) && ((optionName == NULL) ||
................................................................................
  2712   3382       if (getOptionProc) {
  2713   3383   	return getOptionProc(Tcl_GetChannelInstanceData(cd->parent),
  2714   3384   		interp, optionName, dsPtr);
  2715   3385       }
  2716   3386       if (optionName == NULL) {
  2717   3387   	return TCL_OK;
  2718   3388       }
  2719         -    return Tcl_BadChannelOption(interp, optionName, chanOptions);
         3389  +    if (cd->format == TCL_ZLIB_FORMAT_GZIP) {
         3390  +	return Tcl_BadChannelOption(interp, optionName,
         3391  +		(cd->mode == TCL_ZLIB_STREAM_DEFLATE)
         3392  +		? gzipChanOptions : gunzipChanOptions);
         3393  +    } else {
         3394  +	return Tcl_BadChannelOption(interp, optionName,
         3395  +		(cd->mode == TCL_ZLIB_STREAM_DEFLATE)
         3396  +		? compressChanOptions : decompressChanOptions);
         3397  +    }
  2720   3398   }
  2721   3399   
  2722   3400   /*
  2723   3401    *----------------------------------------------------------------------
  2724   3402    *
  2725   3403    * ZlibTransformWatch, ZlibTransformEventHandler --
  2726   3404    *
................................................................................
  2857   3535   				 * readable. */
  2858   3536       int format,			/* One of the TCL_ZLIB_FORMAT_* values that
  2859   3537   				 * indicates what compressed format to allow.
  2860   3538   				 * TCL_ZLIB_FORMAT_AUTO is only supported for
  2861   3539   				 * decompressing transforms. */
  2862   3540       int level,			/* What compression level to use. Ignored for
  2863   3541   				 * decompressing transforms. */
         3542  +    int limit,			/* The limit on the number of bytes to read
         3543  +				 * ahead; always at least 1. */
  2864   3544       Tcl_Channel channel,	/* The channel to attach to. */
  2865         -    Tcl_Obj *gzipHeaderDictPtr)	/* A description of header to use, or NULL to
         3545  +    Tcl_Obj *gzipHeaderDictPtr,	/* A description of header to use, or NULL to
  2866   3546   				 * use a default. Ignored if not compressing
  2867   3547   				 * to produce gzip-format data. */
         3548  +    Tcl_Obj *compDictObj)	/* Byte-array object containing compression
         3549  +				 * dictionary (not dictObj!) to use if
         3550  +				 * necessary. */
  2868   3551   {
  2869   3552       ZlibChannelData *cd = ckalloc(sizeof(ZlibChannelData));
  2870   3553       Tcl_Channel chan;
  2871   3554       int wbits = 0;
  2872   3555       int e;
  2873   3556   
  2874   3557       if (mode != TCL_ZLIB_STREAM_DEFLATE && mode != TCL_ZLIB_STREAM_INFLATE) {
  2875   3558   	Tcl_Panic("unknown mode: %d", mode);
  2876   3559       }
  2877   3560   
  2878   3561       memset(cd, 0, sizeof(ZlibChannelData));
  2879   3562       cd->mode = mode;
         3563  +    cd->format = format;
         3564  +    cd->readAheadLimit = limit;
  2880   3565   
  2881   3566       if (format == TCL_ZLIB_FORMAT_GZIP || format == TCL_ZLIB_FORMAT_AUTO) {
  2882   3567   	if (mode == TCL_ZLIB_STREAM_DEFLATE) {
  2883   3568   	    if (gzipHeaderDictPtr) {
  2884         -		int dummy = 0;
  2885         -
  2886   3569   		cd->flags |= OUT_HEADER;
  2887   3570   		if (GenerateHeader(interp, gzipHeaderDictPtr, &cd->outHeader,
  2888         -			&dummy) != TCL_OK) {
         3571  +			NULL) != TCL_OK) {
  2889   3572   		    goto error;
  2890   3573   		}
  2891   3574   	    }
  2892   3575   	} else {
  2893   3576   	    cd->flags |= IN_HEADER;
  2894   3577   	    cd->inHeader.header.name = (Bytef *)
  2895   3578   		    &cd->inHeader.nativeFilenameBuf;
  2896   3579   	    cd->inHeader.header.name_max = MAXPATHLEN - 1;
  2897   3580   	    cd->inHeader.header.comment = (Bytef *)
  2898   3581   		    &cd->inHeader.nativeCommentBuf;
  2899   3582   	    cd->inHeader.header.comm_max = MAX_COMMENT_LEN - 1;
  2900   3583   	}
  2901   3584       }
         3585  +
         3586  +    if (compDictObj != NULL) {
         3587  +	cd->compDictObj = Tcl_DuplicateObj(compDictObj);
         3588  +	Tcl_IncrRefCount(cd->compDictObj);
         3589  +	Tcl_GetByteArrayFromObj(cd->compDictObj, NULL);
         3590  +    }
  2902   3591   
  2903   3592       if (format == TCL_ZLIB_FORMAT_RAW) {
  2904   3593   	wbits = WBITS_RAW;
  2905   3594       } else if (format == TCL_ZLIB_FORMAT_ZLIB) {
  2906   3595   	wbits = WBITS_ZLIB;
  2907   3596       } else if (format == TCL_ZLIB_FORMAT_GZIP) {
  2908   3597   	wbits = WBITS_GZIP;
................................................................................
  2925   3614   	cd->inBuffer = ckalloc(cd->inAllocated);
  2926   3615   	if (cd->flags & IN_HEADER) {
  2927   3616   	    e = inflateGetHeader(&cd->inStream, &cd->inHeader.header);
  2928   3617   	    if (e != Z_OK) {
  2929   3618   		goto error;
  2930   3619   	    }
  2931   3620   	}
         3621  +	if (cd->format == TCL_ZLIB_FORMAT_RAW && cd->compDictObj) {
         3622  +	    e = SetInflateDictionary(&cd->inStream, cd->compDictObj);
         3623  +	    if (e != Z_OK) {
         3624  +		goto error;
         3625  +	    }
         3626  +	    TclDecrRefCount(cd->compDictObj);
         3627  +	    cd->compDictObj = NULL;
         3628  +	}
  2932   3629       } else {
  2933   3630   	e = deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits,
  2934   3631   		MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
  2935   3632   	if (e != Z_OK) {
  2936   3633   	    goto error;
  2937   3634   	}
  2938   3635   	cd->outAllocated = DEFAULT_BUFFER_SIZE;
  2939   3636   	cd->outBuffer = ckalloc(cd->outAllocated);
  2940   3637   	if (cd->flags & OUT_HEADER) {
  2941   3638   	    e = deflateSetHeader(&cd->outStream, &cd->outHeader.header);
  2942   3639   	    if (e != Z_OK) {
  2943   3640   		goto error;
  2944   3641   	    }
         3642  +	}
         3643  +	if (cd->compDictObj) {
         3644  +	    e = SetDeflateDictionary(&cd->outStream, cd->compDictObj);
         3645  +	    if (e != Z_OK) {
         3646  +		goto error;
         3647  +	    }
  2945   3648   	}
  2946   3649       }
  2947   3650   
  2948   3651       Tcl_DStringInit(&cd->decompressed);
  2949   3652   
  2950   3653       chan = Tcl_StackChannel(interp, &zlibChannelType, cd,
  2951   3654   	    Tcl_GetChannelMode(channel), channel);
................................................................................
  2962   3665   	ckfree(cd->inBuffer);
  2963   3666   	inflateEnd(&cd->inStream);
  2964   3667       }
  2965   3668       if (cd->outBuffer) {
  2966   3669   	ckfree(cd->outBuffer);
  2967   3670   	deflateEnd(&cd->outStream);
  2968   3671       }
         3672  +    if (cd->compDictObj) {
         3673  +	Tcl_DecrRefCount(cd->compDictObj);
         3674  +    }
  2969   3675       ckfree(cd);
  2970   3676       return NULL;
  2971   3677   }
  2972   3678   
  2973   3679   /*
  2974   3680    *----------------------------------------------------------------------
  2975   3681    *
................................................................................
  3051   3757       int n,
  3052   3758       int flush,
  3053   3759       int *errorCodePtr)
  3054   3760   {
  3055   3761   #define MAXBUF	1024
  3056   3762       unsigned char buf[MAXBUF];
  3057   3763       int e, written;
         3764  +    Tcl_Obj *errObj;
  3058   3765   
  3059   3766       cd->inStream.next_in = (Bytef *) cd->inBuffer;
  3060   3767       cd->inStream.avail_in = n;
  3061   3768   
  3062   3769       while (1) {
  3063   3770   	cd->inStream.next_out = (Bytef *) buf;
  3064   3771   	cd->inStream.avail_out = MAXBUF;
  3065   3772   
  3066   3773   	e = inflate(&cd->inStream, flush);
         3774  +	if (e == Z_NEED_DICT && cd->compDictObj) {
         3775  +	    e = SetInflateDictionary(&cd->inStream, cd->compDictObj);
         3776  +	    if (e == Z_OK) {
         3777  +		/*
         3778  +		 * A repetition of Z_NEED_DICT is just an error.
         3779  +		 */
         3780  +
         3781  +		cd->inStream.next_out = (Bytef *) buf;
         3782  +		cd->inStream.avail_out = MAXBUF;
         3783  +		e = inflate(&cd->inStream, flush);
         3784  +	    }
         3785  +	}
  3067   3786   
  3068   3787   	/*
  3069   3788   	 * avail_out is now the left over space in the output.  Therefore
  3070   3789   	 * "MAXBUF - avail_out" is the amount of bytes generated.
  3071   3790   	 */
  3072   3791   
  3073   3792   	written = MAXBUF - cd->inStream.avail_out;
................................................................................
  3091   3810   	 * Just indicates that the zlib couldn't consume input/produce output,
  3092   3811   	 * and is fixed by supplying more input.
  3093   3812   	 *
  3094   3813   	 * Otherwise, we've got errors and need to report to higher-up.
  3095   3814   	 */
  3096   3815   
  3097   3816   	if ((e != Z_OK) && (e != Z_BUF_ERROR)) {
  3098         -	    Tcl_Obj *errObj = Tcl_NewListObj(0, NULL);
  3099         -
  3100         -	    Tcl_ListObjAppendElement(NULL, errObj,
  3101         -		    Tcl_NewStringObj(cd->inStream.msg, -1));
  3102         -	    Tcl_SetChannelError(cd->parent, errObj);
  3103         -	    *errorCodePtr = EINVAL;
  3104         -	    return TCL_ERROR;
         3817  +	    goto handleError;
  3105   3818   	}
  3106   3819   
  3107   3820   	/*
  3108   3821   	 * Check if the inflate stopped early.
  3109   3822   	 */
  3110   3823   
  3111   3824   	if (cd->inStream.avail_in <= 0 && flush != Z_SYNC_FLUSH) {
  3112   3825   	    return TCL_OK;
  3113   3826   	}
  3114   3827       }
         3828  +
         3829  +  handleError:
         3830  +    errObj = Tcl_NewListObj(0, NULL);
         3831  +    Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1));
         3832  +    Tcl_ListObjAppendElement(NULL, errObj,
         3833  +	    ConvertErrorToList(e, cd->inStream.adler));
         3834  +    Tcl_ListObjAppendElement(NULL, errObj,
         3835  +	    Tcl_NewStringObj(cd->inStream.msg, -1));
         3836  +    Tcl_SetChannelError(cd->parent, errObj);
         3837  +    *errorCodePtr = EINVAL;
         3838  +    return TCL_ERROR;
  3115   3839   }
  3116   3840   
  3117   3841   /*
  3118   3842    *----------------------------------------------------------------------
  3119   3843    *	Finally, the TclZlibInit function. Used to install the zlib API.
  3120   3844    *----------------------------------------------------------------------
  3121   3845    */
  3122   3846   
  3123   3847   int
  3124   3848   TclZlibInit(
  3125   3849       Tcl_Interp *interp)
  3126   3850   {
         3851  +    Tcl_Config cfg[2];
         3852  +
  3127   3853       /*
  3128   3854        * This does two things. It creates a counter used in the creation of
  3129   3855        * stream commands, and it creates the namespace that will contain those
  3130   3856        * commands.
  3131   3857        */
  3132   3858   
  3133   3859       Tcl_Eval(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}");
  3134   3860   
  3135   3861       /*
  3136   3862        * Create the public scripted interface to this file's functionality.
  3137   3863        */
  3138   3864   
  3139   3865       Tcl_CreateObjCommand(interp, "zlib", ZlibCmd, 0, 0);
         3866  +
         3867  +    /*
         3868  +     * Store the underlying configuration information.
         3869  +     *
         3870  +     * TODO: Describe whether we're using the system version of the library or
         3871  +     * a compatibility version built into Tcl?
         3872  +     */
         3873  +
         3874  +    cfg[0].key = "zlibVersion";
         3875  +    cfg[0].value = zlibVersion();
         3876  +    cfg[1].key = NULL;
         3877  +    Tcl_RegisterConfig(interp, "zlib", cfg, "ascii");
         3878  +
         3879  +    /*
         3880  +     * Formally provide the package as a Tcl built-in.
         3881  +     */
         3882  +
  3140   3883       return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
  3141   3884   }
  3142   3885   
  3143   3886   /*
  3144   3887    *----------------------------------------------------------------------
  3145   3888    *	Stubs used when a suitable zlib installation was not found during
  3146   3889    *	configure.
................................................................................
  3254   3997   Tcl_ZlibAdler32(
  3255   3998       unsigned int adler,
  3256   3999       const char *buf,
  3257   4000       int len)
  3258   4001   {
  3259   4002       return 0;
  3260   4003   }
         4004  +
         4005  +void
         4006  +Tcl_ZlibStreamSetCompressionDictionary(
         4007  +    Tcl_ZlibStream zshandle,
         4008  +    Tcl_Obj *compressionDictionaryObj)
         4009  +{
         4010  +    /* Do nothing. */
         4011  +}
  3261   4012   #endif /* HAVE_ZLIB */
  3262   4013   
  3263   4014   /*
  3264   4015    * Local Variables:
  3265   4016    * mode: c
  3266   4017    * c-basic-offset: 4
  3267   4018    * fill-column: 78
  3268   4019    * End:
  3269   4020    */

Changes to tests/zlib.test.

     6      6   #
     7      7   # Copyright (c) 1996-1998 by Sun Microsystems, Inc.
     8      8   # Copyright (c) 1998-1999 by Scriptics Corporation.
     9      9   #
    10     10   # See the file "license.terms" for information on usage and redistribution of
    11     11   # this file, and for a DISCLAIMER OF ALL WARRANTIES.
    12     12   
    13         -if {[lsearch [namespace children] ::tcltest] == -1} {
           13  +if {"::tcltest" ni [namespace children]} {
    14     14       package require tcltest 2.1
    15     15       namespace import -force ::tcltest::*
    16     16   }
    17     17   
    18     18   testConstraint zlib [llength [info commands zlib]]
    19     19   
    20     20   test zlib-1.1 {zlib basics} -constraints zlib -returnCodes error -body {
    21     21       zlib
    22     22   } -result {wrong # args: should be "zlib command arg ?...?"}
    23     23   test zlib-1.2 {zlib basics} -constraints zlib -returnCodes error -body {
    24     24       zlib ? {}
    25     25   } -result {bad command "?": must be adler32, compress, crc32, decompress, deflate, gunzip, gzip, inflate, push, or stream}
           26  +test zlib-1.3 {zlib basics} -constraints zlib -body {
           27  +    zlib::pkgconfig list
           28  +} -result zlibVersion
           29  +test zlib-1.4 {zlib basics} -constraints zlib -body {
           30  +    package present zlib
           31  +} -result 2.0
    26     32   
    27     33   test zlib-2.1 {zlib compress/decompress} zlib {
    28     34       zlib decompress [zlib compress abcdefghijklm]
    29     35   } abcdefghijklm
    30     36   
    31     37   test zlib-3.1 {zlib deflate/inflate} zlib {
    32     38       zlib inflate [zlib deflate abcdefghijklm]
................................................................................
    66     72   
    67     73   test zlib-7.0 {zlib stream} -constraints zlib -returnCodes error -setup {
    68     74       set s [zlib stream compress]
    69     75   } -body {
    70     76       $s ?
    71     77   } -cleanup {
    72     78       $s close
    73         -} -result {bad option "?": must be add, checksum, close, eof, finalize, flush, fullflush, get, put, or reset}
           79  +} -result {bad option "?": must be add, checksum, close, eof, finalize, flush, fullflush, get, header, put, or reset}
    74     80   test zlib-7.1 {zlib stream} zlib {
    75     81       set s [zlib stream compress]
    76     82       $s put -finalize abcdeEDCBA
    77     83       set data [$s get]
    78     84       set result [list [$s get] [format %x [$s checksum]]]
    79     85       $s close
    80     86       lappend result [zlib decompress $data]
................................................................................
   199    205       fileevent $r readable {set msg [read $r];lappend ::res $msg;if {[eof $r]} {set ::done 1}}
   200    206       after 250 {lappend ::res MIDDLE}
   201    207       vwait ::done
   202    208       set ::res
   203    209   } -cleanup {
   204    210       catch {close $r}
   205    211   } -result {qwertyuiop MIDDLE asdfghjkl}
          212  +test zlib-8.6 {transformation and fconfigure} -setup {
          213  +    set file [makeFile {} test.z]
          214  +    set fd [open $file wb]
          215  +} -constraints zlib -body {
          216  +    list [fconfigure $fd] [zlib push compress $fd; fconfigure $fd] \
          217  +	[chan pop $fd; fconfigure $fd]
          218  +} -cleanup {
          219  +    catch {close $fd}
          220  +    removeFile $file
          221  +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
          222  +test zlib-8.7 {transformation and fconfigure} -setup {
          223  +    set file [makeFile {} test.gz]
          224  +    set fd [open $file wb]
          225  +} -constraints zlib -body {
          226  +    list [fconfigure $fd] [zlib push gzip $fd; fconfigure $fd] \
          227  +	[chan pop $fd; fconfigure $fd]
          228  +} -cleanup {
          229  +    catch {close $fd}
          230  +    removeFile $file
          231  +} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
          232  +# Input is headers from fetching SPDY draft
          233  +# Dictionary is that which is proposed _in_ SPDY draft
          234  +set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n"
          235  +set spdyDict "optionsgetheadpostputdeletetraceacceptaccept-charsetaccept-encodingaccept-languageauthorizationexpectfromhostif-modified-sinceif-matchif-none-matchif-rangeif-unmodifiedsincemax-forwardsproxy-authorizationrangerefererteuser-agent100101200201202203204205206300301302303304305306307400401402403404405406407408409410411412413414415416417500501502503504505accept-rangesageetaglocationproxy-authenticatepublicretry-afterservervarywarningwww-authenticateallowcontent-basecontent-encodingcache-controlconnectiondatetrailertransfer-encodingupgradeviawarningcontent-languagecontent-lengthcontent-locationcontent-md5content-rangecontent-typeetagexpireslast-modifiedset-cookieMondayTuesdayWednesdayThursdayFridaySaturdaySundayJanFebMarAprMayJunJulAugSepOctNovDecchunkedtext/htmlimage/pngimage/jpgimage/gifapplication/xmlapplication/xhtmltext/plainpublicmax-agecharset=iso-8859-1utf-8gzipdeflateHTTP/1.1statusversionurl"
          236  +test zlib-8.8 {transformtion and fconfigure} -setup {
          237  +    lassign [chan pipe] inSide outSide
          238  +} -constraints zlib -body {
          239  +    zlib push compress $outSide -dictionary $spdyDict
          240  +    fconfigure $outSide -blocking 0 -translation binary -buffering none
          241  +    fconfigure $inSide -blocking 0 -translation binary
          242  +    puts -nonewline $outSide $spdyHeaders
          243  +    chan pop $outSide
          244  +    set compressed [read $inSide]
          245  +    catch {zlib decompress $compressed} err opt
          246  +    list [string length [zlib compress $spdyHeaders]] \
          247  +	[string length $compressed] \
          248  +	$err [dict get $opt -errorcode] [zlib adler32 $spdyDict]
          249  +} -cleanup {
          250  +    catch {close $outSide}
          251  +    catch {close $inSide}
          252  +} -result {260 222 {need dictionary} {TCL ZLIB NEED_DICT 2381337010} 2381337010}
          253  +test zlib-8.9 {transformtion and fconfigure} -setup {
          254  +    lassign [chan pipe] inSide outSide
          255  +    set strm [zlib stream decompress]
          256  +} -constraints zlib -body {
          257  +    zlib push compress $outSide -dictionary $spdyDict
          258  +    fconfigure $outSide -blocking 0 -translation binary -buffering none
          259  +    fconfigure $inSide -blocking 0 -translation binary
          260  +    puts -nonewline $outSide $spdyHeaders
          261  +    set result [fconfigure $outSide -checksum]
          262  +    chan pop $outSide
          263  +    $strm put -dictionary $spdyDict [read $inSide]
          264  +    lappend result [string length $spdyHeaders] [string length [$strm get]]
          265  +} -cleanup {
          266  +    catch {close $outSide}
          267  +    catch {close $inSide}
          268  +    catch {$strm close}
          269  +} -result {3064818174 358 358}
          270  +test zlib-8.10 {transformtion and fconfigure} -setup {
          271  +    lassign [chan pipe] inSide outSide
          272  +} -constraints zlib -body {
          273  +    zlib push deflate $outSide -dictionary $spdyDict
          274  +    fconfigure $outSide -blocking 0 -translation binary -buffering none
          275  +    fconfigure $inSide -blocking 0 -translation binary
          276  +    puts -nonewline $outSide $spdyHeaders
          277  +    chan pop $outSide
          278  +    set compressed [read $inSide]
          279  +    catch {zlib inflate $compressed} err opt
          280  +    list [string length [zlib deflate $spdyHeaders]] \
          281  +	[string length $compressed] \
          282  +	$err [dict get $opt -errorcode]
          283  +} -cleanup {
          284  +    catch {close $outSide}
          285  +    catch {close $inSide}
          286  +} -result {254 212 {data error} {TCL ZLIB DATA}}
          287  +test zlib-8.11 {transformtion and fconfigure} -setup {
          288  +    lassign [chan pipe] inSide outSide
          289  +    set strm [zlib stream inflate]
          290  +} -constraints zlib -body {
          291  +    zlib push deflate $outSide -dictionary $spdyDict
          292  +    fconfigure $outSide -blocking 0 -translation binary -buffering none
          293  +    fconfigure $inSide -blocking 0 -translation binary
          294  +    puts -nonewline $outSide $spdyHeaders
          295  +    chan pop $outSide
          296  +    $strm put -dictionary $spdyDict [read $inSide]
          297  +    list [string length $spdyHeaders] [string length [$strm get]]
          298  +} -cleanup {
          299  +    catch {close $outSide}
          300  +    catch {close $inSide}
          301  +    catch {$strm close}
          302  +} -result {358 358}
          303  +test zlib-8.12 {transformtion and fconfigure} -setup {
          304  +    lassign [chan pipe] inSide outSide
          305  +    set strm [zlib stream compress]
          306  +} -constraints zlib -body {
          307  +    $strm put -dictionary $spdyDict -finalize $spdyHeaders
          308  +    zlib push decompress $inSide
          309  +    fconfigure $outSide -blocking 0 -translation binary
          310  +    fconfigure $inSide -translation binary -dictionary $spdyDict
          311  +    puts -nonewline $outSide [$strm get]
          312  +    close $outSide
          313  +    list [string length $spdyHeaders] [string length [read $inSide]] \
          314  +	[fconfigure $inSide -checksum]
          315  +} -cleanup {
          316  +    catch {close $outSide}
          317  +    catch {close $inSide}
          318  +    catch {$strm close}
          319  +} -result {358 358 3064818174}
          320  +test zlib-8.13 {transformtion and fconfigure} -setup {
          321  +    lassign [chan pipe] inSide outSide
          322  +    set strm [zlib stream compress]
          323  +} -constraints zlib -body {
          324  +    $strm put -dictionary $spdyDict -finalize $spdyHeaders
          325  +    zlib push decompress $inSide -dictionary $spdyDict
          326  +    fconfigure $outSide -blocking 0 -translation binary
          327  +    fconfigure $inSide -translation binary
          328  +    puts -nonewline $outSide [$strm get]
          329  +    close $outSide
          330  +    list [string length $spdyHeaders] [string length [read $inSide]] \
          331  +	[fconfigure $inSide -checksum]
          332  +} -cleanup {
          333  +    catch {close $outSide}
          334  +    catch {close $inSide}
          335  +    catch {$strm close}
          336  +} -result {358 358 3064818174}
          337  +test zlib-8.14 {transformtion and fconfigure} -setup {
          338  +    lassign [chan pipe] inSide outSide
          339  +    set strm [zlib stream deflate]
          340  +} -constraints zlib -body {
          341  +    $strm put -finalize -dictionary $spdyDict $spdyHeaders
          342  +    zlib push inflate $inSide
          343  +    fconfigure $outSide -blocking 0 -buffering none -translation binary
          344  +    fconfigure $inSide -translation binary -dictionary $spdyDict
          345  +    puts -nonewline $outSide [$strm get]
          346  +    close $outSide
          347  +    list [string length $spdyHeaders] [string length [read $inSide]]
          348  +} -cleanup {
          349  +    catch {close $outSide}
          350  +    catch {close $inSide}
          351  +    catch {$strm close}
          352  +} -result {358 358}
          353  +test zlib-8.15 {transformtion and fconfigure} -setup {
          354  +    lassign [chan pipe] inSide outSide
          355  +    set strm [zlib stream deflate]
          356  +} -constraints zlib -body {
          357  +    $strm put -finalize -dictionary $spdyDict $spdyHeaders
          358  +    zlib push inflate $inSide -dictionary $spdyDict
          359  +    fconfigure $outSide -blocking 0 -buffering none -translation binary
          360  +    fconfigure $inSide -translation binary
          361  +    puts -nonewline $outSide [$strm get]
          362  +    close $outSide
          363  +    list [string length $spdyHeaders] [string length [read $inSide]]
          364  +} -cleanup {
          365  +    catch {close $outSide}
          366  +    catch {close $inSide}
          367  +    catch {$strm close}
          368  +} -result {358 358}
   206    369   
   207    370   test zlib-9.1 "check fcopy with push" -constraints zlib -setup {
   208    371       set sfile [makeFile {} testsrc.gz]
   209    372       set file [makeFile {} test.gz]
   210    373       set f [open $sfile wb]
   211    374       puts -nonewline $f [zlib gzip [string repeat a 81920]]
   212    375       close $f