'From Squeak3.7alpha of ''11 September 2003'' [latest update: #5657] on 7 March 2004 at 7:09:41 pm'! "Change Set: ZipCrcTests Date: 29 February 2004 Author: Andreas Raab Integrates CRC validation at the level of InflateStream thereby avoiding some of the problems when dealing with it in subclasses. With these changes CRC validation is implicit - when we hit the end of a stream (such as upon #contents, #upToEnd or similar) the CRC will be validated automatically. If a missing or wrong crc is encountered a CRCError will be raised. Some tests are provided to show what is expected if a missing/wrong CRC is encountered. 7 March (Ned Konz): Made CRCError actually resumable to correspond with the 'proceed to continue' messages in the verifyCrc methods. Added similar CRC integration for Zip archive stream reading by adding ZipReadStream. Added tests for reading past end of InflateStream subclasses and fixed a potential problem with #next: by returning a partial buffer if the stream is at its end. Added detection for CRC-32 corruption to ZipArchiveMembers, and indication of such corruption in the ArchiveViewer. "! Object subclass: #ArchiveMember instanceVariableNames: 'fileName isCorrupt' classVariableNames: '' poolDictionaries: '' category: 'System-Archives'! Error subclass: #CRCError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Compression'! ReadStream subclass: #InflateStream instanceVariableNames: 'state bitBuf bitPos source sourcePos sourceLimit litTable distTable sourceStream crc ' classVariableNames: 'BlockProceedBit BlockTypes FixedDistCodes FixedLitCodes MaxBits StateNewBlock StateNoMoreData ' poolDictionaries: '' category: 'System-Compression'! FastInflateStream subclass: #ZLibReadStream instanceVariableNames: 'adler32 ' classVariableNames: '' poolDictionaries: '' category: 'System-Compression'! TestCase subclass: #ZipCrcTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Compression'! FastInflateStream subclass: #ZipReadStream instanceVariableNames: 'expectedCrc' classVariableNames: '' poolDictionaries: '' category: 'System-Compression'! !ZipReadStream commentStamp: 'nk 3/7/2004 18:54' prior: 0! ZipReadStream is intended for uncompressing the compressed contents of Zip archive members. Since Zip archive members keep their expected CRC value separately in Zip headers, this class does not attempt to read the CRC from its input stream. Instead, if you want the CRC verification to work you have to call #expectedCrc: with the expected CRC-32 value from the Zip member header.! !ArchiveMember methodsFor: 'accessing' stamp: 'nk 3/7/2004 16:16'! isCorrupt ^isCorrupt ifNil: [ isCorrupt _ false ]! ! !ArchiveMember methodsFor: 'accessing' stamp: 'nk 3/7/2004 16:06'! isCorrupt: aBoolean "Mark this member as being corrupt." isCorrupt := aBoolean! ! !ArchiveMember methodsFor: 'initialization' stamp: 'nk 3/7/2004 16:05'! initialize fileName _ ''. isCorrupt _ false.! ! !ArchiveViewer methodsFor: 'initialization' stamp: 'nk 3/7/2004 16:43'! briefContents "Trim to 5000 characters. If the member is longer, then point out that it is trimmed. Also warn if the member has a corrupt CRC-32." | stream subContents errorMessage | self selectedMember ifNil: [^ '']. errorMessage _ ''. stream _ WriteStream on: (String new: (self selectedMember uncompressedSize min: 5500)). [ self selectedMember uncompressedSize > 5000 ifTrue: [ | lastLineEndingIndex tempIndex | subContents _ self selectedMember contentsFrom: 1 to: 5000. lastLineEndingIndex _ subContents lastIndexOf: Character cr. tempIndex _ subContents lastIndexOf: Character lf. tempIndex > lastLineEndingIndex ifTrue: [lastLineEndingIndex _ tempIndex]. lastLineEndingIndex = 0 ifFalse: [subContents _ subContents copyFrom: 1 to: lastLineEndingIndex]] ifFalse: [ subContents _ self selectedMember contents ]] on: CRCError do: [ :ex | errorMessage _ String streamContents: [ :s | s nextPutAll: '[ '; nextPutAll: (ex messageText copyUpToLast: $( ); nextPutAll: ' ]' ]. ex proceed ]. (errorMessage isEmpty not or: [ self selectedMember isCorrupt ]) ifTrue: [ stream nextPutAll: '********** WARNING!! Member is corrupt!! '; nextPutAll: errorMessage; nextPutAll: ' **********'; cr ]. self selectedMember uncompressedSize > 5000 ifTrue: [ stream nextPutAll: 'File '; print: self selectedMember fileName; nextPutAll: ' is '; print: self selectedMember uncompressedSize; nextPutAll: ' bytes long.'; cr; nextPutAll: 'Click the ''View All Contents'' button above to see the entire file.'; cr; cr; nextPutAll: 'Here are the first '; print: subContents size; nextPutAll: ' characters...'; cr; next: 40 put: $-; cr; nextPutAll: subContents; next: 40 put: $-; cr; nextPutAll: '... end of the first '; print: subContents size; nextPutAll: ' characters.' ] ifFalse: [ stream nextPutAll: self selectedMember contents ]. ^stream contents ! ! !ArchiveViewer methodsFor: 'initialization' stamp: 'nk 3/7/2004 16:45'! contents | contents errorMessage | self selectedMember ifNil: [^ '']. viewAllContents ifFalse: [^ self briefContents]. [ contents _ self selectedMember contents ] on: CRCError do: [ :ex | errorMessage _ String streamContents: [ :stream | stream nextPutAll: '********** WARNING!! Member is corrupt!! [ '; nextPutAll: (ex messageText copyUpToLast: $( ); nextPutAll: '] **********'; cr ]. ex proceed ]. ^self selectedMember isCorrupt ifFalse: [ contents ] ifTrue: [ errorMessage, contents ]! ! !ArchiveViewer methodsFor: 'member operations' stamp: 'nk 3/7/2004 16:47'! changeViewAllContents (viewAllContents not and: [ self selectedMember notNil and: [ self selectedMember uncompressedSize > 50000 ]]) ifTrue: [ (PopUpMenu confirm: 'This member''s size is ', (self selectedMember uncompressedSize asString), '; do you really want to see all that data?') ifFalse: [ ^self ] ]. viewAllContents _ viewAllContents not. self changed: #contents! ! !CRCError methodsFor: 'as yet unclassified' stamp: 'nk 3/7/2004 15:56'! isResumable ^true! ! !InflateStream methodsFor: 'accessing' stamp: 'nk 3/7/2004 18:45'! next: anInteger "Answer the next anInteger elements of my collection. overriden for simplicity" | newArray | "try to do it the fast way" position + anInteger < readLimit ifTrue: [ newArray _ collection copyFrom: position + 1 to: position + anInteger. position _ position + anInteger. ^newArray ]. "oh, well..." newArray _ collection species new: anInteger. 1 to: anInteger do: [:index | newArray at: index put: (self next ifNil: [ ^newArray copyFrom: 1 to: index - 1]) ]. ^newArray! ! !InflateStream methodsFor: 'private' stamp: 'ar 2/29/2004 04:18'! pastEndRead "A client has attempted to read beyond the read limit. Check in what state we currently are and perform the appropriate action" | blockType bp oldLimit | state = StateNoMoreData ifTrue:[^nil]. "Get out early if possible" "Check if we can move decoded data to front" self moveContentsToFront. "Check if we can fetch more source data" self moveSourceToFront. state = StateNewBlock ifTrue:[state _ self getNextBlock]. blockType _ state bitShift: -1. bp _ self bitPosition. oldLimit := readLimit. self perform: (BlockTypes at: blockType+1). "Note: if bit position hasn't advanced then nothing has been decoded." bp = self bitPosition ifTrue:[^self primitiveFailed]. "Update crc for the decoded contents" readLimit > oldLimit ifTrue:[crc _ self updateCrc: crc from: oldLimit+1 to: readLimit in: collection]. state = StateNoMoreData ifTrue:[self verifyCrc]. ^self next! ! !InflateStream methodsFor: 'crc' stamp: 'ar 2/29/2004 04:04'! crcError: aString ^CRCError signal: aString! ! !InflateStream methodsFor: 'crc' stamp: 'ar 2/29/2004 03:49'! updateCrc: oldCrc from: start to: stop in: aCollection "Answer an updated CRC for the range of bytes in aCollection. Subclasses can implement the appropriate means for the check sum they wish to use." ^oldCrc! ! !InflateStream methodsFor: 'crc' stamp: 'ar 2/29/2004 04:22'! verifyCrc "Verify the crc checksum in the input"! ! !GZipReadStream methodsFor: 'initialize' stamp: 'ar 2/29/2004 03:32'! on: aCollection from: firstIndex to: lastIndex "Check the header of the GZIP stream." | method magic flags length | super on: aCollection from: firstIndex to: lastIndex. crc _ 16rFFFFFFFF. magic _ self nextBits: 16. (magic = GZipMagic) ifFalse:[^self error:'Not a GZipped stream']. method _ self nextBits: 8. (method = GZipDeflated) ifFalse:[^self error:'Bad compression method']. flags _ self nextBits: 8. (flags anyMask: GZipEncryptFlag) ifTrue:[^self error:'Cannot decompress encrypted stream']. (flags anyMask: GZipReservedFlags) ifTrue:[^self error:'Cannot decompress stream with unknown flags']. "Ignore stamp, extra flags, OS type" self nextBits: 16; nextBits: 16. "stamp" self nextBits: 8. "extra flags" self nextBits: 8. "OS type" (flags anyMask: GZipContinueFlag) "Number of multi-part archive - ignored" ifTrue:[self nextBits: 16]. (flags anyMask: GZipExtraField) "Extra fields - ignored" ifTrue:[ length _ self nextBits: 16. 1 to: length do:[:i| self nextBits: 8]]. (flags anyMask: GZipNameFlag) "Original file name - ignored" ifTrue:[[(self nextBits: 8) = 0] whileFalse]. (flags anyMask: GZipCommentFlag) "Comment - ignored" ifTrue:[[(self nextBits: 8) = 0] whileFalse]. ! ! !GZipReadStream methodsFor: 'crc' stamp: 'ar 2/29/2004 03:30'! updateCrc: oldCrc from: start to: stop in: aCollection "Answer an updated CRC for the range of bytes in aCollection" ^ZipWriteStream updateCrc: oldCrc from: start to: stop in: aCollection.! ! !GZipReadStream methodsFor: 'crc' stamp: 'ar 2/29/2004 04:20'! verifyCrc | stored | stored := 0. 0 to: 24 by: 8 do: [ :i | sourcePos >= sourceLimit ifTrue: [ ^ self crcError: 'No checksum (proceed to ignore)' ]. stored := stored + (self nextByte bitShift: i) ]. stored := stored bitXor: 16rFFFFFFFF. stored = crc ifFalse: [ ^ self crcError: 'Wrong checksum (proceed to ignore)' ]. ^stored! ! !PNGReadWriter methodsFor: 'accessing' stamp: 'ar 2/29/2004 03:59'! nextImage bigEndian := Smalltalk isBigEndian. filtersSeen _ Bag new. globalDataChunk _ nil. transparentPixelValue _ nil. unknownChunks _ Set new. stream reset. (stream respondsTo: #binary) ifTrue: [ stream binary] . stream skip: 8. [stream atEnd] whileFalse: [self processNextChunk]. "Set up our form" palette ifNotNil:[ "Dump the palette if it's the same as our standard palette" palette = (StandardColors copyFrom: 1 to: palette size) ifTrue:[palette := nil]]. (depth <= 8 and:[palette notNil]) ifTrue:[ form := ColorForm extent: width@height depth: depth. form colors: palette. ] ifFalse:[ form := Form extent: width@height depth: depth. ]. backColor ifNotNil:[form fillColor: backColor]. chunk _ globalDataChunk ifNil:[self error: 'image data is missing']. chunk ifNotNil: [self processIDATChunk]. unknownChunks isEmpty ifFalse: [ "Transcript show: ' ',unknownChunks asSortedCollection asArray printString." ]. self debugging ifTrue: [ Transcript cr; show: 'form = ',form printString. Transcript cr; show: 'colorType = ',colorType printString. Transcript cr; show: 'interlaceMethod = ',interlaceMethod printString. Transcript cr; show: 'filters = ',filtersSeen sortedCounts asArray printString. ]. ^ form ! ! !PNGReadWriter methodsFor: 'chunks' stamp: 'ar 2/29/2004 04:19'! processInterlaced | z filter bytesPerPass startingCol colIncrement rowIncrement startingRow cx sc temp | startingCol _ #(0 4 0 2 0 1 0 ). colIncrement _ #(8 8 4 4 2 2 1 ). rowIncrement _ #(8 8 8 4 4 2 2 ). startingRow _ #(0 0 4 0 2 0 1 ). z _ ZLibReadStream on: chunk from: 1 to: chunk size. 1 to: 7 do: [:pass | (self doPass: pass) ifTrue: [cx _ colIncrement at: pass. sc _ startingCol at: pass. bytesPerPass _ width - sc + cx - 1 // cx * bitsPerPixel + 7 // 8. prevScanline _ ByteArray new: bytesPerPass. thisScanline _ ByteArray new: bytesPerScanline. (startingRow at: pass) to: height - 1 by: (rowIncrement at: pass) do: [:y | filter _ z next. filtersSeen add: filter. (filter isNil or: [(filter between: 0 and: 4) not]) ifTrue: [^ self]. thisScanline _ z next: bytesPerPass into: thisScanline startingAt: 1. self filterScanline: filter count: bytesPerPass. self copyPixels: y at: sc by: cx. temp := prevScanline. prevScanline := thisScanline. thisScanline := temp. ] ] ]. z atEnd ifFalse:[self error:'Unexpected data'].! ! !PNGReadWriter methodsFor: 'chunks' stamp: 'ar 2/29/2004 04:19'! processNonInterlaced | z filter temp copyMethod debug | debug := self debugging. copyMethod _ #(copyPixelsGray: nil copyPixelsRGB: copyPixelsIndexed: copyPixelsGrayAlpha: nil copyPixelsRGBA:) at: colorType+1. debug ifTrue: [ Transcript cr; nextPutAll: 'NI chunk size='; print: chunk size ]. z _ ZLibReadStream on: chunk from: 1 to: chunk size. prevScanline _ ByteArray new: bytesPerScanline. thisScanline := ByteArray new: bytesPerScanline. 0 to: height-1 do: [ :y | filter _ (z next: 1) first. debug ifTrue:[filtersSeen add: filter]. thisScanline _ z next: bytesPerScanline into: thisScanline startingAt: 1. (debug and: [ thisScanline size < bytesPerScanline ]) ifTrue: [ Transcript nextPutAll: ('wanted {1} but only got {2}' format: { bytesPerScanline. thisScanline size }); cr ]. filter = 0 ifFalse:[self filterScanline: filter count: bytesPerScanline]. self perform: copyMethod with: y. temp := prevScanline. prevScanline := thisScanline. thisScanline := temp. ]. z atEnd ifFalse:[self error:'Unexpected data']. debug ifTrue: [Transcript nextPutAll: ' compressed size='; print: z position ]. ! ! !PNGReadWriterTest methodsFor: 'tests' stamp: 'ar 2/29/2004 03:55'! testPngSuite "Requires the suite from ftp://swrinde.nde.swri.edu/pub/png/images/suite/PngSuite.zip to be present as PngSuite.zip" | file zip entries | [file := FileStream readOnlyFileNamed: 'PngSuite.zip'] on: Error do:[:ex| ex return]. file ifNil:[^self]. [zip := ZipArchive new readFrom: file. entries := zip members select:[:mbr| mbr fileName asLowercase endsWith: '.png']. entries do:[:mbr| (mbr fileName asLowercase first = $x) ifTrue: [self encodeAndDecodeWithError: mbr contentStream ] ifFalse: [self encodeAndDecodeStream: mbr contentStream ] ]. ] ensure:[file close].! ! !PNGReadWriterTest methodsFor: 'helpers' stamp: 'ar 2/29/2004 03:55'! encodeAndDecodeWithError: aStream self should:[self encodeAndDecodeStream: aStream] raise: Error! ! !ZLibReadStream methodsFor: 'initialize' stamp: 'ar 2/29/2004 03:31'! on: aCollection from: firstIndex to: lastIndex "Check the header of the ZLib stream." | method byte | super on: aCollection from: firstIndex to: lastIndex. crc _ 1. method _ self nextBits: 8. (method bitAnd: 15) = 8 ifFalse:[^self error:'Unknown compression method']. (method bitShift: -4) + 8 > 15 ifTrue:[^self error:'Invalid window size']. byte _ self nextBits: 8. (method bitShift: 8) + byte \\ 31 = 0 ifFalse:[^self error:'Incorrect header']. (byte anyMask: 32) ifTrue:[^self error:'Need preset dictionary']. ! ! !ZLibReadStream methodsFor: 'crc' stamp: 'ar 2/29/2004 03:30'! updateCrc: oldCrc from: start to: stop in: aCollection "Answer an updated CRC for the range of bytes in aCollection" ^ZLibWriteStream updateAdler32: oldCrc from: start to: stop in: aCollection.! ! !ZLibReadStream methodsFor: 'crc' stamp: 'ar 2/29/2004 04:21'! verifyCrc | stored | stored := 0. 24 to: 0 by: -8 do: [ :i | sourcePos >= sourceLimit ifTrue: [ ^ self crcError: 'No checksum (proceed to ignore)' ]. stored := stored + (self nextByte bitShift: i) ]. stored = crc ifFalse: [ ^ self crcError: 'Wrong checksum (proceed to ignore)' ]. ^stored! ! !ZLibWriteStream methodsFor: 'initialize-release' stamp: 'ar 2/29/2004 04:40'! writeFooter "Store the Adler32 checksum as the last 4 bytes." 3 to: 0 by: -1 do:[:i| encoder nextBytePut: (crc >> (i*8) bitAnd: 255)].! ! !ZLibWriteStream class methodsFor: 'crc' stamp: 'ar 2/29/2004 04:40'! updateAdler32: adler from: start to: stop in: aCollection "Update crc using the Adler32 checksum technique from RFC1950" " unsigned long s1 = adler & 0xffff; unsigned long s2 = (adler >> 16) & 0xffff; int n; for (n = 0; n < len; n++) { s1 = (s1 + buf[n]) % BASE; s2 = (s2 + s1) % BASE; } return (s2 << 16) + s1; " | s1 s2 | s1 := adler bitAnd: 16rFFFF. s2 := (adler bitShift: -16) bitAnd: 16rFFFF. start to: stop do: [ :n | | b | b := aCollection byteAt: n. s1 := (s1 + b) \\ 65521. s2 := (s2 + s1) \\ 65521. ]. ^(s2 bitShift: 16) + s1! ! !ZipArchiveMember methodsFor: 'TODO' stamp: 'nk 3/7/2004 15:42'! copyDataWithCRCTo: aStream "Copy my data to aStream. Also set the CRC-32. Only used when compressionMethod = desiredCompressionMethod = CompressionStored" uncompressedSize _ compressedSize _ readDataRemaining. crc32 _ 16rFFFFFFFF. [ readDataRemaining > 0 ] whileTrue: [ | data | data _ self readRawChunk: (4096 min: readDataRemaining). aStream nextPutAll: data. crc32 _ ZipWriteStream updateCrc: crc32 from: 1 to: data size in: data. readDataRemaining _ readDataRemaining - data size. ]. crc32 _ crc32 bitXor: 16rFFFFFFFF. ! ! !ZipCrcTests methodsFor: 'tests' stamp: 'ar 2/29/2004 04:43'! testInvalidGZipCrc "See that a wrong CRC raises an appropriate error" | reader writer bytes crcByte | writer := GZipWriteStream on: String new. writer nextPutAll: 'Hello World'. writer close. bytes := writer encodedStream contents. crcByte := bytes byteAt: bytes size-5. "before the length" bytes byteAt: bytes size-5 put: (crcByte + 1 bitAnd: 255). reader := GZipReadStream on: bytes. self should:[reader upToEnd] raise: CRCError. reader := GZipReadStream on: bytes. self should:[reader contents] raise: CRCError. reader := GZipReadStream on: bytes. self should:[reader next: 100] raise: CRCError. ! ! !ZipCrcTests methodsFor: 'tests' stamp: 'ar 2/29/2004 04:43'! testInvalidZLibCrc "See that a wrong CRC raises an appropriate error" | reader writer bytes crcByte | writer := ZLibWriteStream on: String new. writer nextPutAll: 'Hello World'. writer close. bytes := writer encodedStream contents. crcByte := bytes byteAt: bytes size-2. bytes byteAt: bytes size-2 put: (crcByte + 1 bitAnd: 255). reader := ZLibReadStream on: bytes. self should:[reader upToEnd] raise: CRCError. reader := ZLibReadStream on: bytes. self should:[reader contents] raise: CRCError. reader := ZLibReadStream on: bytes. self should:[reader next: 100] raise: CRCError. ! ! !ZipCrcTests methodsFor: 'tests' stamp: 'nk 3/7/2004 18:37'! testInvalidZipCrc "See that a wrong CRC raises an appropriate error" | reader writer bytes | writer := ZipWriteStream on: String new. writer nextPutAll: 'Hello World'. writer close. bytes := writer encodedStream contents. reader := ZipReadStream on: bytes. reader expectedCrc: writer crc - 1. self should:[reader upToEnd] raise: CRCError. reader := ZipReadStream on: bytes. reader expectedCrc: writer crc - 1. self should:[reader contents] raise: CRCError. reader := ZipReadStream on: bytes. reader expectedCrc: writer crc - 1. self should:[reader next: 100] raise: CRCError. ! ! !ZipCrcTests methodsFor: 'tests' stamp: 'ar 2/29/2004 04:42'! testMissingGZipCrc "See that the lack of a CRC raises an appropriate error" | reader writer bytes | writer := GZipWriteStream on: String new. writer nextPutAll: 'Hello World'. writer close. bytes := writer encodedStream contents. bytes := bytes copyFrom: 1 to: bytes size-6. reader := GZipReadStream on: bytes. self should:[reader upToEnd] raise: CRCError. reader := GZipReadStream on: bytes. self should:[reader contents] raise: CRCError. reader := GZipReadStream on: bytes. self should:[reader next: 100] raise: CRCError. ! ! !ZipCrcTests methodsFor: 'tests' stamp: 'ar 2/29/2004 04:42'! testMissingZLibCrc "See that the lack of a CRC raises an appropriate error" | reader writer bytes | writer := ZLibWriteStream on: String new. writer nextPutAll: 'Hello World'. writer close. bytes := writer encodedStream contents. bytes := bytes copyFrom: 1 to: bytes size-2. reader := ZLibReadStream on: bytes. self should:[reader upToEnd] raise: CRCError. reader := ZLibReadStream on: bytes. self should:[reader contents] raise: CRCError. reader := ZLibReadStream on: bytes. self should:[reader next: 100] raise: CRCError. ! ! !ZipCrcTests methodsFor: 'tests' stamp: 'nk 3/7/2004 18:49'! testMissingZipCrc "See that the lack of a CRC does not raise an error" | reader writer bytes readBytes | writer := ZipWriteStream on: String new. writer nextPutAll: 'Hello World'. writer close. bytes := writer encodedStream contents. reader := ZipReadStream on: bytes. self shouldnt:[readBytes _ reader upToEnd] raise: CRCError. self assert: readBytes = 'Hello World'. reader := ZipReadStream on: bytes. self shouldnt:[reader contents] raise: CRCError. reader := ZipReadStream on: bytes. self shouldnt:[reader next: 100] raise: CRCError. ! ! !ZipCrcTests methodsFor: 'tests' stamp: 'ar 2/29/2004 04:42'! testValidGZipCrc | reader writer bytes | writer := GZipWriteStream on: String new. writer nextPutAll: 'Hello World'. writer close. bytes := writer encodedStream contents. reader := GZipReadStream on: bytes. self assert: reader upToEnd = 'Hello World'.! ! !ZipCrcTests methodsFor: 'tests' stamp: 'nk 3/7/2004 18:46'! testValidZLibCrc | reader writer bytes | writer := ZLibWriteStream on: String new. writer nextPutAll: 'Hello World'. writer close. bytes := writer encodedStream contents. reader := ZLibReadStream on: bytes. self assert: reader upToEnd = 'Hello World'. bytes := writer encodedStream contents. reader := ZLibReadStream on: bytes. self assert: (reader next: 100) = 'Hello World'.! ! !ZipCrcTests methodsFor: 'tests' stamp: 'nk 3/7/2004 18:43'! testValidZipCrc "See that a correct CRC does not raise an error and that we can read what we wrote." | reader writer bytes readBytes | writer := ZipWriteStream on: String new. writer nextPutAll: 'Hello World'. writer close. bytes := writer encodedStream contents. reader := ZipReadStream on: bytes. reader expectedCrc: writer crc. self shouldnt:[ readBytes _ reader upToEnd] raise: CRCError. self assert: readBytes = 'Hello World'. reader := ZipReadStream on: bytes. reader expectedCrc: writer crc. self shouldnt:[ readBytes _ reader contents] raise: CRCError. self assert: readBytes = 'Hello World'. reader := ZipReadStream on: bytes. reader expectedCrc: writer crc. self shouldnt:[ readBytes _ reader next: 11 ] raise: CRCError. self assert: readBytes = 'Hello World'. reader := ZipReadStream on: bytes. reader expectedCrc: writer crc. self shouldnt:[ readBytes _ reader next: 100 ] raise: CRCError. self assert: readBytes = 'Hello World'.! ! !ZipFileMember methodsFor: 'private-writing' stamp: 'nk 3/7/2004 16:08'! uncompressDataTo: aStream | decoder buffer chunkSize crcErrorMessage | decoder _ ZipReadStream on: stream. decoder expectedCrc: self crc32. buffer _ ByteArray new: (32768 min: readDataRemaining). crcErrorMessage _ nil. [[ readDataRemaining > 0 ] whileTrue: [ chunkSize _ 32768 min: readDataRemaining. buffer _ decoder next: chunkSize into: buffer startingAt: 1. aStream next: chunkSize putAll: buffer startingAt: 1. readDataRemaining _ readDataRemaining - chunkSize. ]] on: CRCError do: [ :ex | crcErrorMessage _ ex messageText. ex proceed ]. crcErrorMessage ifNotNil: [ self isCorrupt: true. CRCError signal: crcErrorMessage ] ! ! !ZipReadStream methodsFor: 'initialize' stamp: 'nk 3/7/2004 15:31'! on: aCollection from: firstIndex to: lastIndex super on: aCollection from: firstIndex to: lastIndex. crc _ 16rFFFFFFFF. expectedCrc _ nil.! ! !ZipReadStream methodsFor: 'crc' stamp: 'nk 3/7/2004 18:55'! expectedCrc: aNumberOrNil "If expectedCrc is set, it will be compared against the calculated CRC32 in verifyCrc. This number should be the number read from the Zip header (which is the bitwise complement of my crc if all is working correctly)" expectedCrc _ aNumberOrNil! ! !ZipReadStream methodsFor: 'crc' stamp: 'nk 3/7/2004 15:32'! updateCrc: oldCrc from: start to: stop in: aCollection ^ZipWriteStream updateCrc: oldCrc from: start to: stop in: aCollection! ! !ZipReadStream methodsFor: 'crc' stamp: 'nk 3/7/2004 15:58'! verifyCrc "Verify the CRC-32 checksum calculated from the input against the expected CRC-32, if any. Answer the calculated CRC-32 in any case. Note that the CRC-32 used in Zip files is actually the bit inverse of the calculated value, so that is what is returned." | invertedCrc | invertedCrc _ crc bitXor: 16rFFFFFFFF. (expectedCrc notNil and: [ expectedCrc ~= invertedCrc ]) ifTrue: [ ^ self crcError: ('Wrong CRC-32 (expected {1} got {2}) (proceed to ignore)' translated format: { expectedCrc hex. invertedCrc hex }) ]. ^invertedCrc! ! !ZipReadStream reorganize! ('initialize' on:from:to:) ('crc' expectedCrc: updateCrc:from:to:in: verifyCrc) ! ZLibReadStream removeSelector: #pastEndRead! ZLibReadStream removeSelector: #verifyAdler32! FastInflateStream subclass: #ZLibReadStream instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Compression'! ReadStream subclass: #InflateStream instanceVariableNames: 'state bitBuf bitPos source sourcePos sourceLimit litTable distTable sourceStream crc' classVariableNames: 'BlockProceedBit BlockTypes FixedDistCodes FixedLitCodes MaxBits StateNewBlock StateNoMoreData' poolDictionaries: '' category: 'System-Compression'!