[squeak-dev] The Inbox: Compression-ct.56.mczcommits at source.squeak.org commits at source.squeak.orgMon Jan 3 18:07:40 UTC 2022
A new version of Compression was added to project The Inbox: http://source.squeak.org/inbox/Compression-ct.56.mcz ==================== Summary ==================== Name: Compression-ct.56 Author: ct Time: 3 January 2022, 7:07:37.018703 pm UUID: af841abb-44db-044e-b8d8-a6e8231c690e Ancestors: Compression-dtl.55 Makes the Compression package 100% multilingual. Rewrites ZipArchiveMember >> #extractInDirectory:overwrite: to use new UIManager >> #chooseFromLabeledValues:title: and avoid infinite loops if the user closes the dialog window or #valueSuppressingAllMessages is used. Also includes some recategorizations. =============== Diff against Compression-dtl.55 =============== Item was changed: ----- Method: Archive>>writeToFileNamed: (in category 'archive operations') ----- writeToFileNamed: aFileName | stream | "Catch attempts to overwrite existing zip file" (self canWriteToFileNamed: aFileName) + ifFalse: [ ^self error: ('{1} is needed by one or more members in this archive' translated format: {aFileName}) ]. - ifFalse: [ ^self error: (aFileName, ' is needed by one or more members in this archive') ]. stream := StandardFileStream forceNewFileNamed: aFileName. self writeTo: stream. stream close.! Item was changed: + ----- Method: ArchiveMember class>>newDirectoryNamed: (in category 'instance creation') ----- - ----- Method: ArchiveMember class>>newDirectoryNamed: (in category 'as yet unclassified') ----- newDirectoryNamed: aString self subclassResponsibility! Item was changed: + ----- Method: ArchiveMember class>>newFromFile: (in category 'instance creation') ----- - ----- Method: ArchiveMember class>>newFromFile: (in category 'as yet unclassified') ----- newFromFile: aFileName self subclassResponsibility! Item was changed: + ----- Method: ArchiveMember class>>newFromString: (in category 'instance creation') ----- - ----- Method: ArchiveMember class>>newFromString: (in category 'as yet unclassified') ----- newFromString: aString self subclassResponsibility! Item was changed: + ----- Method: CRCError>>isResumable (in category 'priv handling') ----- - ----- Method: CRCError>>isResumable (in category 'as yet unclassified') ----- isResumable ^true! Item was changed: + ----- Method: CompressedSourceStream class>>on: (in category 'instance creation') ----- - ----- Method: CompressedSourceStream class>>on: (in category 'as yet unclassified') ----- on: aFile ^ self basicNew openOn: aFile! Item was changed: ----- Method: CompressedSourceStream>>binary (in category 'open/close') ----- binary + self error: 'Compressed source files are ascii to the user (though binary underneath)' translated! - self error: 'Compressed source files are ascii to the user (though binary underneath)'! Item was changed: ----- Method: CompressedSourceStream>>position: (in category 'access') ----- position: newPosition | compressedBuffer newSegmentIndex | newPosition > endOfFile ifTrue: + [self error: 'Attempt to position beyond the end of file' translated]. - [self error: 'Attempt to position beyond the end of file']. newSegmentIndex := (newPosition // segmentSize) + 1. newSegmentIndex ~= segmentIndex ifTrue: [self flush. segmentIndex := newSegmentIndex. newSegmentIndex > nSegments ifTrue: + [self error: 'file size limit exceeded' translated]. - [self error: 'file size limit exceeded']. segmentFile position: (segmentTable at: segmentIndex). (segmentTable at: segmentIndex+1) = 0 ifTrue: [newPosition ~= endOfFile ifTrue: + [self error: 'Internal logic error' translated]. - [self error: 'Internal logic error']. collection size = segmentSize ifFalse: + [self error: 'Internal logic error' translated]. - [self error: 'Internal logic error']. "just leave garbage beyond end of file"] ifFalse: [compressedBuffer := segmentFile next: ((segmentTable at: segmentIndex+1) - (segmentTable at: segmentIndex)). collection := (GZipReadStream on: compressedBuffer) upToEnd asString]. readLimit := collection size min: endOfFile - self segmentOffset]. + position := newPosition \\ segmentSize.! - position := newPosition \\ segmentSize. - ! Item was changed: ----- Method: CompressedSourceStream>>readHeaderInfo (in category 'open/close') ----- readHeaderInfo | valid a b | segmentFile position: 0. segmentSize := segmentFile nextNumber: 4. nSegments := segmentFile nextNumber: 4. endOfFile := segmentFile nextNumber: 4. segmentFile size < (nSegments+1 + 3 * 4) ifTrue: "Check for reasonable segment info" + [self error: 'This file is not in valid compressed source format' translated]. - [self error: 'This file is not in valid compressed source format']. segmentTable := (1 to: nSegments+1) collect: [:x | segmentFile nextNumber: 4]. segmentTable first ~= self firstSegmentLoc ifTrue: + [self error: 'This file is not in valid compressed source format' translated]. - [self error: 'This file is not in valid compressed source format']. valid := true. 1 to: nSegments do: "Check that segment offsets are ascending" [:i | a := segmentTable at: i. b := segmentTable at: i+1. (a = 0 and: [b ~= 0]) ifTrue: [valid := false]. (a ~= 0 and: [b ~= 0]) ifTrue: [b <= a ifTrue: [valid := false]]]. valid ifFalse: + [self error: 'This file is not in valid compressed source format' translated]. - [self error: 'This file is not in valid compressed source format']. dirty := false. self position: 0.! Item was changed: ----- Method: CompressedSourceStream>>segmentSize:maxSize: (in category 'private') ----- segmentSize: segSize maxSize: maxSize "Note that this method can be called after the initial open, provided that no writing has yet taken place. This is how to override the default segmentation." + self size = 0 ifFalse: [self error: 'Cannot set parameters after the first write' translated]. - self size = 0 ifFalse: [self error: 'Cannot set parameters after the first write']. segmentFile position: 0. segmentFile nextNumber: 4 put: (segmentSize := segSize). segmentFile nextNumber: 4 put: (nSegments := maxSize // segSize + 2). segmentFile nextNumber: 4 put: (endOfFile := 0). segmentTable := Array new: nSegments+1 withAll: 0. segmentTable at: 1 put: self firstSegmentLoc. "Loc of first segment, always." segmentTable do: [:i | segmentFile nextNumber: 4 put: i]. segmentIndex := 1. collection := String new: segmentSize. writeLimit := segmentSize. readLimit := 0. position := 0. endOfFile := 0. + self writeSegment.! - self writeSegment. - ! Item was changed: ----- Method: DeflateStream>>validateMatchAt:from:to: (in category 'deflating') ----- validateMatchAt: pos from: startPos to: endPos | here | here := pos. startPos+1 to: endPos+1 do:[:i| (collection at: i) = (collection at: (here := here + 1)) + ifFalse:[^self error: 'Not a match' translated]]. - ifFalse:[^self error:'Not a match']]. ^true! Item was changed: ----- Method: GZipReadStream class>>saveContents: (in category 'fileIn/Out') ----- saveContents: fullFileName "Save the contents of a gzipped file" | zipped buffer unzipped newName | newName := fullFileName copyUpToLast: FileDirectory extensionDelimiter. unzipped := FileStream newFileNamed: newName. unzipped binary. zipped := GZipReadStream on: (FileStream readOnlyFileNamed: fullFileName). buffer := ByteArray new: 50000. + ('Extracting {1}' translated format: {fullFileName}) - 'Extracting ' , fullFileName displayProgressFrom: 0 to: zipped sourceStream size during: [:bar | [zipped atEnd] whileFalse: [bar value: zipped sourceStream position. unzipped nextPutAll: (zipped nextInto: buffer)]. zipped close. unzipped close]. ^ newName! Item was changed: ----- Method: GZipReadStream>>on:from:to: (in category 'initialize') ----- 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' translated]. - ifFalse:[^self error:'Not a GZipped stream']. method := self nextBits: 8. (method = GZipDeflated) + ifFalse:[^self error: 'Bad compression method' translated]. - ifFalse:[^self error:'Bad compression method']. flags := self nextBits: 8. (flags anyMask: GZipEncryptFlag) + ifTrue:[^self error: 'Cannot decompress encrypted stream' translated]. - ifTrue:[^self error:'Cannot decompress encrypted stream']. (flags anyMask: GZipReservedFlags) + ifTrue:[^self error: 'Cannot decompress stream with unknown flags' translated]. - 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].! - ifTrue:[[(self nextBits: 8) = 0] whileFalse]. - ! Item was changed: ----- Method: GZipReadStream>>verifyCrc (in category 'crc') ----- verifyCrc | stored | stored := 0. 0 to: 24 by: 8 do: [ :i | + sourcePos >= sourceLimit ifTrue: [ ^ self crcError: 'No checksum (proceed to ignore)' translated ]. - 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)' translated ]. - stored = crc ifFalse: [ ^ self crcError: 'Wrong checksum (proceed to ignore)' ]. ^stored! Item was changed: + ----- Method: GZipSurrogateStream class>>newFileNamed:inDirectory: (in category 'instance creation') ----- - ----- Method: GZipSurrogateStream class>>newFileNamed:inDirectory: (in category 'as yet unclassified') ----- newFileNamed: fName inDirectory: aDirectory ^self new newFileNamed: fName inDirectory: aDirectory! Item was changed: ----- Method: InflateStream>>decodeDynamicTable:from: (in category 'huffman trees') ----- decodeDynamicTable: nItems from: aHuffmanTable "Decode the code length of the literal/length and distance table in a block compressed with dynamic huffman trees" | values index value repCount theValue | values := Array new: nItems. index := 1. theValue := 0. [index <= nItems] whileTrue:[ value := self decodeValueFrom: aHuffmanTable. value < 16 ifTrue:[ "Immediate values" theValue := value. values at: index put: value. index := index+1. ] ifFalse:[ "Repeated values" value = 16 ifTrue:[ "Repeat last value" repCount := (self nextBits: 2) + 3. ] ifFalse:[ "Repeat zero value" theValue := 0. value = 17 ifTrue:[repCount := (self nextBits: 3) + 3] ifFalse:[value = 18 ifTrue:[repCount := (self nextBits: 7) + 11] + ifFalse:[^self error: 'Invalid bits tree value' translated]]]. - ifFalse:[^self error:'Invalid bits tree value']]]. 0 to: repCount-1 do:[:i| values at: index+i put: theValue]. index := index + repCount]. ]. ^values! Item was changed: ----- Method: InflateStream>>decodeValueFrom: (in category 'inflating') ----- decodeValueFrom: table "Decode the next value in the receiver using the given huffman table." | bits bitsNeeded tableIndex value | bitsNeeded := (table at: 1) bitShift: -24. "Initial bits needed" tableIndex := 2. "First real table" [bits := self nextSingleBits: bitsNeeded. "Get bits" value := table at: (tableIndex + bits). "Lookup entry in table" (value bitAnd: 16r3F000000) = 0] "Check if it is a non-leaf node" whileFalse:["Fetch sub table" tableIndex := value bitAnd: 16rFFFF. "Table offset in low 16 bit" bitsNeeded := (value bitShift: -24) bitAnd: 255. "Additional bits in high 8 bit" + bitsNeeded > MaxBits ifTrue:[^self error: 'Invalid huffman table entry' translated]]. - bitsNeeded > MaxBits ifTrue:[^self error:'Invalid huffman table entry']]. ^value! Item was changed: ----- Method: InflateStream>>proceedStoredBlock (in category 'inflating') ----- proceedStoredBlock "Proceed decompressing a stored (e.g., uncompressed) block" | length decoded | "Literal table must be nil for a stored block" + litTable == nil ifFalse:[^self error: 'Bad state' translated]. - litTable == nil ifFalse:[^self error:'Bad state']. length := distTable. [length > 0 and:[readLimit < collection size and:[sourcePos < sourceLimit]]] whileTrue:[ collection at: (readLimit := readLimit + 1) put: (source at: (sourcePos := sourcePos + 1)). length := length - 1]. length = 0 ifTrue:[state := state bitAnd: StateNoMoreData]. decoded := length - distTable. distTable := length. ^decoded! Item was changed: ----- Method: InflateStream>>processStoredBlock (in category 'inflating') ----- processStoredBlock | chkSum length | "Skip to byte boundary" self nextBits: (bitPos bitAnd: 7). length := self nextBits: 16. chkSum := self nextBits: 16. (chkSum bitXor: 16rFFFF) = length + ifFalse:[^self error: 'Bad block length' translated]. - ifFalse:[^self error:'Bad block length']. litTable := nil. distTable := length. state := state bitOr: BlockProceedBit. ^self proceedStoredBlock! Item was changed: ----- Method: ZLibReadStream>>on:from:to: (in category 'initialize') ----- 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' translated]. + (method bitShift: -4) + 8 > 15 ifTrue:[^self error: 'Invalid window size' translated]. - (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' translated]. + (byte anyMask: 32) ifTrue:[^self error: 'Need preset dictionary' translated].! - (method bitShift: 8) + byte \\ 31 = 0 ifFalse:[^self error:'Incorrect header']. - (byte anyMask: 32) ifTrue:[^self error:'Need preset dictionary']. - ! Item was changed: ----- Method: ZLibReadStream>>verifyCrc (in category 'crc') ----- verifyCrc | stored | stored := 0. 24 to: 0 by: -8 do: [ :i | + sourcePos >= sourceLimit ifTrue: [ ^ self crcError: 'No checksum (proceed to ignore)' translated ]. - 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)' translated ]. - stored = crc ifFalse: [ ^ self crcError: 'Wrong checksum (proceed to ignore)' ]. ^stored! Item was changed: ----- Method: ZipArchive class>>findEndOfCentralDirectoryFrom: (in category 'constants') ----- findEndOfCentralDirectoryFrom: stream "Seek in the given stream to the end, then read backwards until we find the signature of the central directory record. Leave the file positioned right before the signature. Answers the file position of the EOCD, or 0 if not found." | data fileLength seekOffset pos maxOffset | stream setToEnd. fileLength := stream position. "If the file length is less than 18 for the EOCD length plus 4 for the signature, we have a problem" + fileLength < 22 ifTrue: [^ self error: ('file is too short: {1}' translated format: {stream name})]. - fileLength < 22 ifTrue: [^ self error: 'file is too short: ', stream name]. seekOffset := 0. pos := 0. data := ByteArray new: 4100. maxOffset := 40960 min: fileLength. "limit search range to 40K" [ seekOffset := (seekOffset + 4096) min: fileLength. stream position: fileLength - seekOffset. data := stream next: (4100 min: seekOffset) into: data startingAt: 1. pos := self lastIndexOfPKSignature: EndOfCentralDirectorySignature in: data. pos = 0 and: [seekOffset < maxOffset] ] whileTrue. ^ pos > 0 ifTrue: [ | newPos | stream position: (newPos := (stream position + pos - seekOffset - 1)). newPos] ifFalse: [0]! Item was changed: ----- Method: ZipArchive>>extractAllTo:informing:overwrite: (in category 'archive operations') ----- extractAllTo: aDirectory informing: bar overwrite: allOverwrite "Extract all elements to the given directory" | overwriteAll | overwriteAll := allOverwrite. self members do:[:entry| | dir | entry isDirectory ifTrue:[ + bar ifNotNil: [bar value: ('Creating {1}' translated format: {entry fileName})]. - bar ifNotNil:[bar value: 'Creating ', entry fileName]. dir := (entry fileName findTokens:'/') inject: aDirectory into:[:base :part| base directoryNamed: part]. dir assureExistence. ]. ]. self members do:[:entry| | response | entry isDirectory ifFalse:[ + bar ifNotNil: [bar value: ('Extracting {1}' translated format: {entry fileName})]. - bar ifNotNil:[bar value: 'Extracting ', entry fileName]. response := entry extractInDirectory: aDirectory overwrite: overwriteAll. response == #retryWithOverwrite ifTrue:[ overwriteAll := true. response := entry extractInDirectory: aDirectory overwrite: overwriteAll. ]. response == #abort ifTrue:[^self]. response == #failed ifTrue:[ + (self confirm: ('Failed to extract {1}. Proceed?' translated format: {entry fileName})) ifFalse: [^self]. - (self confirm: 'Failed to extract ', entry fileName, '. Proceed?') ifFalse:[^self]. ]. ]. + ].! - ]. - ! Item was changed: ----- Method: ZipArchive>>readEndOfCentralDirectoryFrom: (in category 'private') ----- readEndOfCentralDirectoryFrom: aStream "Read EOCD, starting from position before signature." | signature zipFileCommentLength | signature := self readSignatureFrom: aStream. + signature = EndOfCentralDirectorySignature ifFalse: [ ^self error: ('bad signature at {1}' translated format: {aStream position}) ]. - signature = EndOfCentralDirectorySignature ifFalse: [ ^self error: 'bad signature at ', aStream position printString ]. aStream nextLittleEndianNumber: 2. "# of this disk" aStream nextLittleEndianNumber: 2. "# of disk with central dir start" aStream nextLittleEndianNumber: 2. "# of entries in central dir on this disk" aStream nextLittleEndianNumber: 2. "total # of entries in central dir" centralDirectorySize := aStream nextLittleEndianNumber: 4. "size of central directory" centralDirectoryOffsetWRTStartingDiskNumber := aStream nextLittleEndianNumber: 4. "offset of start of central directory" zipFileCommentLength := aStream nextLittleEndianNumber: 2. "zip file comment" + zipFileComment := aStream next: zipFileCommentLength.! - zipFileComment := aStream next: zipFileCommentLength. - ! Item was changed: ----- Method: ZipArchive>>readFrom: (in category 'reading') ----- readFrom: aStreamOrFileName | stream name eocdPosition | stream := aStreamOrFileName isStream ifTrue: [name := aStreamOrFileName name. aStreamOrFileName] ifFalse: [StandardFileStream readOnlyFileNamed: (name := aStreamOrFileName)]. stream binary. eocdPosition := self class findEndOfCentralDirectoryFrom: stream. + eocdPosition <= 0 ifTrue: [self error: ('{1} cannot find EOCD position in {2}' translated format: {self class name. aStreamOrFileName name})]. - eocdPosition <= 0 ifTrue: [self error: self class name, ' cannot find EOCD position in ', aStreamOrFileName name]. self readEndOfCentralDirectoryFrom: stream. stream position: eocdPosition - centralDirectorySize. self readMembersFrom: stream named: name! Item was changed: ----- Method: ZipArchive>>readMembersFrom:named: (in category 'private') ----- readMembersFrom: stream named: fileName [ | newMember signature | newMember := self memberClass newFromZipFile: stream named: fileName. signature := self readSignatureFrom: stream. signature = EndOfCentralDirectorySignature ifTrue: [ ^self ]. signature = CentralDirectoryFileHeaderSignature + ifFalse: [ self error: ('bad CD signature at {1}' translated format: {(stream position - 4) printStringHex}) ]. - ifFalse: [ self error: 'bad CD signature at ', (stream position - 4) printStringHex ]. newMember readFrom: stream. newMember looksLikeDirectory ifTrue: [ newMember := newMember asDirectory ]. self addMember: newMember. ] repeat.! Item was changed: ----- Method: ZipArchive>>readSignatureFrom: (in category 'private') ----- readSignatureFrom: stream "Returns next signature from given stream, leaves stream positioned afterwards." | signatureData | signatureData := ByteArray new: 4. stream next: 4 into: signatureData. ({ CentralDirectoryFileHeaderSignature . LocalFileHeaderSignature . EndOfCentralDirectorySignature } includes: signatureData) + ifFalse: [ ^self error: ('bad signature {1} at position {2}' translated format: {signatureData asString asHex. stream position - 4}) ]. - ifFalse: [ ^self error: 'bad signature ', signatureData asString asHex, ' at position ', (stream position - 4) asString ]. ^signatureData ! Item was changed: ----- Method: ZipArchive>>writeToFileNamed:prepending: (in category 'writing') ----- writeToFileNamed: aFileName prepending: aString | stream | "Catch attempts to overwrite existing zip file" (self canWriteToFileNamed: aFileName) + ifFalse: [ ^self error: ('{1} is needed by one or more members in this archive' translated format: {aFileName}) ]. - ifFalse: [ ^self error: (aFileName, ' is needed by one or more members in this archive') ]. stream := StandardFileStream forceNewFileNamed: aFileName. self writeTo: stream prepending: aString. stream close.! Item was changed: ----- Method: ZipArchive>>writeToFileNamed:prependingFileNamed: (in category 'writing') ----- writeToFileNamed: aFileName prependingFileNamed: anotherFileName | stream | "Catch attempts to overwrite existing zip file" (self canWriteToFileNamed: aFileName) + ifFalse: [ ^self error: ('{1} is needed by one or more members in this archive' translated format: {aFileName}) ]. - ifFalse: [ ^self error: (aFileName, ' is needed by one or more members in this archive') ]. stream := StandardFileStream forceNewFileNamed: aFileName. self writeTo: stream prependingFileNamed: anotherFileName. stream close.! Item was changed: ----- Method: ZipArchiveMember>>extractInDirectory:overwrite: (in category 'extraction') ----- extractInDirectory: aDirectory overwrite: overwriteAll "Extract this entry into the given directory. Answer #okay, #failed, #abort, or #retryWithOverwrite." + | path fileDir file localName | + path := fileName findTokens: '/'. - | path fileDir file index localName | - path := fileName findTokens:'/'. localName := path last. + fileDir := path allButLast inject: aDirectory into: [:base :part | base directoryNamed: part]. - fileDir := path allButLast inject: aDirectory into:[:base :part| base directoryNamed: part]. fileDir assureExistence. + + overwriteAll ifFalse: [ + [file := fileDir newFileNamed: localName] + on: FileExistsException + do: [ + (Project uiManager + chooseFromLabeledValues: (OrderedDictionary new + at: 'Yes, overwrite' translated put: [#overwrite]; + at: 'No, don''t overwrite' translated put: [^ #okay]; + at: 'Overwrite ALL files' translated put: [^ #retryWithOverwrite]; + at: 'Cancel operation' translated put: []; + yourself) + title: ('{1} already exists. Overwrite?' translated format: {fileName})) value + ifNil: [^ #abort]]]. + file ifNil: [ + file := ([fileDir forceNewFileNamed: localName] + on: Error do: []) + ifNil: [^ #failed]]. + - file := [fileDir newFileNamed: localName] on: FileExistsException do:[:ex| ex return: nil]. - file ifNil:[ - overwriteAll ifFalse:[ - [index := UIManager default chooseFrom: { - 'Yes, overwrite'. - 'No, don''t overwrite'. - 'Overwrite ALL files'. - 'Cancel operation' - } lines: #(2) title: fileName, ' already exists. Overwrite?'. - index == nil] whileTrue. - index = 4 ifTrue:[^#abort]. - index = 3 ifTrue:[^#retryWithOverwrite]. - index = 2 ifTrue:[^#okay]. - ]. - file := [fileDir forceNewFileNamed: localName] on: Error do:[:ex| ex return]. - file ifNil:[^#failed]. - ]. self extractTo: file. file close. + ^ #okay! - ^#okay! Item was changed: ----- Method: ZipArchiveMember>>extractTo: (in category 'extraction') ----- extractTo: aStream | oldCompression | + self isEncrypted ifTrue: [ self error: 'encryption is unsupported' translated ]. - self isEncrypted ifTrue: [ self error: 'encryption is unsupported' ]. aStream binary. oldCompression := self desiredCompressionMethod: CompressionStored. self rewindData. self writeDataTo: aStream. self desiredCompressionMethod: oldCompression. self endRead.! Item was changed: ----- Method: ZipArchiveMember>>extractTo:from:to: (in category 'extraction') ----- extractTo: aStream from: start to: finish | oldCompression | + self isEncrypted ifTrue: [ self error: 'encryption is unsupported' translated ]. - self isEncrypted ifTrue: [ self error: 'encryption is unsupported' ]. aStream binary. oldCompression := self desiredCompressionMethod: CompressionStored. self rewindData. self writeDataTo: aStream from: start to: finish. self desiredCompressionMethod: oldCompression. self endRead.! Item was changed: ----- Method: ZipArchiveMember>>extractToFileNamed:inDirectory: (in category 'accessing') ----- extractToFileNamed: aLocalFileName inDirectory: dir | stream fullName fullDir | + self isEncrypted ifTrue: [ ^self error: 'encryption unsupported' translated ]. - self isEncrypted ifTrue: [ ^self error: 'encryption unsupported' ]. fullName := dir fullNameFor: aLocalFileName. fullDir := FileDirectory forFileName: fullName. fullDir assureExistence. self isDirectory ifFalse: [ stream := fullDir forceNewFileNamed: (FileDirectory localNameFor: fullName). self extractTo: stream. stream close. ] ifTrue: [ fullDir assureExistence ] ! Item was changed: ----- Method: ZipArchiveMember>>writeDataTo:from:to: (in category 'private-writing') ----- writeDataTo: aStream from: start to: finish "Copy my (possibly inflated or deflated) data to the given stream. But only the specified byte range. This might do decompression, or straight copying, depending on the values of compressionMethod and desiredCompressionMethod" uncompressedSize = 0 ifTrue: [ ^self ]. "nothing to do because no data" start > finish ifTrue: [ ^self ]. start > uncompressedSize ifTrue: [ ^self ]. (compressionMethod = CompressionStored and: [ desiredCompressionMethod = CompressionDeflated ]) + ifTrue: [ ^self error: 'only supports uncompression or copying right now' translated ]. - ifTrue: [ ^self error: 'only supports uncompression or copying right now' ]. (compressionMethod = CompressionDeflated and: [ desiredCompressionMethod = CompressionStored ]) ifTrue: [ ^self uncompressDataTo: aStream from: start to: finish ]. self copyRawDataTo: aStream from: start to: finish.! Item was changed: + ----- Method: ZipDirectoryMember class>>newNamed: (in category 'instance creation') ----- - ----- Method: ZipDirectoryMember class>>newNamed: (in category 'as yet unclassified') ----- newNamed: aFileName ^(self new) localFileName: aFileName; yourself! Item was changed: ----- Method: ZipEncoderNode>>encodeBitLength:from: (in category 'encoding') ----- encodeBitLength: blCounts from: aTree | index | "Note: If bitLength is not nil then the tree must be broken" + bitLength ifNotNil: [self error: 'Huffman tree is broken' translated]. - bitLength ifNotNil: [self error:'Huffman tree is broken']. parent ifNil: [bitLength := 0] ifNotNil: [bitLength := parent bitLength + 1]. self isLeaf ifTrue:[ index := bitLength + 1. blCounts at: index put: (blCounts at: index) + 1. ] ifFalse:[ left encodeBitLength: blCounts from: aTree. right encodeBitLength: blCounts from: aTree. ].! Item was changed: ----- Method: ZipEncoderTree>>buildTree:maxDepth: (in category 'encoding') ----- buildTree: nodeList maxDepth: depth "Build either the literal or the distance tree" | heap rootNode blCounts | heap := Heap new: nodeList size // 3. heap sortBlock: self nodeSortBlock. "Find all nodes with non-zero frequency and add to heap" maxCode := 0. nodeList do:[:dNode| dNode frequency = 0 ifFalse:[ maxCode := dNode value. heap add: dNode]]. "The pkzip format requires that at least one distance code exists, and that at least one bit should be sent even if there is only one possible code. So to avoid special checks later on we force at least two codes of non zero frequency." heap size = 0 ifTrue:[ self assert:[maxCode = 0]. heap add: nodeList first. heap add: nodeList second. maxCode := 1]. heap size = 1 ifTrue:[ nodeList first frequency = 0 ifTrue:[heap add: nodeList first] ifFalse:[heap add: nodeList second]. maxCode := maxCode max: 1]. rootNode := self buildHierarchyFrom: heap. rootNode height > depth ifTrue:[ rootNode := rootNode rotateToHeight: depth. + rootNode height > depth ifTrue: [self error: 'Cannot encode tree' translated]]. - rootNode height > depth ifTrue:[self error:'Cannot encode tree']]. blCounts := WordArray new: depth+1. rootNode encodeBitLength: blCounts from: self. self buildCodes: nodeList counts: blCounts maxDepth: depth. self setValuesFrom: nodeList.! Item was changed: + ----- Method: ZipFileMember class>>newFrom:named: (in category 'instance creation') ----- - ----- Method: ZipFileMember class>>newFrom:named: (in category 'as yet unclassified') ----- newFrom: stream named: fileName ^(self new) stream: stream externalFileName: fileName! Item was changed: ----- Method: ZipFileMember>>readLocalDirectoryFileHeaderFrom: (in category 'private-reading') ----- readLocalDirectoryFileHeaderFrom: aStream "Positions stream as necessary. Will return stream to its original position" | fileNameLength extraFieldLength xcrc32 xcompressedSize xuncompressedSize sig oldPos | oldPos := aStream position. aStream position: localHeaderRelativeOffset. sig := aStream next: 4. sig = LocalFileHeaderSignature asByteArray ifFalse: [ aStream position: oldPos. + ^self error: ('bad LH signature at {1}' translated format: {localHeaderRelativeOffset printStringHex}) ]. - ^self error: 'bad LH signature at ', localHeaderRelativeOffset printStringHex ]. versionNeededToExtract := aStream nextLittleEndianNumber: 2. bitFlag := aStream nextLittleEndianNumber: 2. compressionMethod := aStream nextLittleEndianNumber: 2. lastModFileDateTime := aStream nextLittleEndianNumber: 4. xcrc32 := aStream nextLittleEndianNumber: 4. xcompressedSize := aStream nextLittleEndianNumber: 4. xuncompressedSize := aStream nextLittleEndianNumber: 4. fileNameLength := aStream nextLittleEndianNumber: 2. extraFieldLength := aStream nextLittleEndianNumber: 2. fileName := (aStream next: fileNameLength) asString asSqueakPathName. localExtraField := (aStream next: extraFieldLength) asByteArray. dataOffset := aStream position. "Don't trash these fields if we already got them from the central directory" self hasDataDescriptor ifFalse: [ crc32 := xcrc32. compressedSize := xcompressedSize. uncompressedSize := xuncompressedSize. ]. aStream position: oldPos.! Item was changed: ----- Method: ZipFileMember>>rewindData (in category 'private-reading') ----- rewindData super rewindData. (stream isNil or: [ stream closed ]) + ifTrue: [ self error: 'stream missing or closed' translated ]. - ifTrue: [ self error: 'stream missing or closed' ]. stream position: (localHeaderRelativeOffset + 4). self skipLocalDirectoryFileHeaderFrom: stream.! Item was changed: + ----- Method: ZipStringMember class>>newFrom:named: (in category 'instance creation') ----- - ----- Method: ZipStringMember class>>newFrom:named: (in category 'as yet unclassified') ----- newFrom: aString named: aFileName ^(self new) contents: aString; localFileName: aFileName; yourself! Item was changed: ----- Method: ZipWriteStream>>encodeMatch:distance: (in category 'encoding') ----- encodeMatch: length distance: dist "Encode the given match of length length starting at dist bytes ahead" | literal distance | dist > 0 + ifFalse: [^self error: 'Distance must be positive' translated]. - ifFalse:[^self error:'Distance must be positive']. length < MinMatch + ifTrue: [^self error: ('Match length must be at least {1}' translated format: {MinMatch})]. - ifTrue:[^self error:'Match length must be at least ', MinMatch printString]. litCount := litCount + 1. matchCount := matchCount + 1. literals at: litCount put: length - MinMatch. distances at: litCount put: dist. literal := (MatchLengthCodes at: length - MinMatch + 1). literalFreq at: literal+1 put: (literalFreq at: literal+1) + 1. dist < 257 ifTrue:[distance := DistanceCodes at: dist] ifFalse:[distance := DistanceCodes at: 257 + (dist - 1 bitShift: -7)]. distanceFreq at: distance+1 put: (distanceFreq at: distance+1) + 1. ^self shouldFlush! Item was changed: ----- Method: ZipWriteStream>>flushBlock: (in category 'encoding') ----- flushBlock: lastBlock "Send the current block" | lastFlag bitsRequired method bitsSent storedLength fixedLength dynamicLength blTree lTree dTree blBits blFreq | lastFlag := lastBlock ifTrue:[1] ifFalse:[0]. "Compute the literal/length and distance tree" lTree := ZipEncoderTree buildTreeFrom: literalFreq maxDepth: MaxBits. dTree := ZipEncoderTree buildTreeFrom: distanceFreq maxDepth: MaxBits. "Compute the bit length tree" blBits := lTree bitLengths, dTree bitLengths. blFreq := WordArray new: MaxBitLengthCodes. self scanBitLengths: blBits into: blFreq. blTree := ZipEncoderTree buildTreeFrom: blFreq maxDepth: MaxBitLengthBits. "Compute the bit length for the current block. Note: Most of this could be computed on the fly but it's getting really ugly in this case so we do it afterwards." storedLength := self storedBlockSize. fixedLength := self fixedBlockSizeFor: lTree and: dTree. dynamicLength := self dynamicBlockSizeFor: lTree and: dTree using: blTree and: blFreq. VerboseLevel > 1 ifTrue:[ Transcript cr; show:'Block sizes (S/F/D):'; space; print: storedLength // 8; nextPut:$/; print: fixedLength // 8; nextPut:$/; print: dynamicLength // 8; space; endEntry]. "Check which method to use" method := self forcedMethod. method ifNil:[ method := (storedLength < fixedLength and:[storedLength < dynamicLength]) ifTrue:[#stored] ifFalse:[fixedLength < dynamicLength ifTrue:[#fixed] ifFalse:[#dynamic]]]. (method == #stored and:[blockStart < 0]) ifTrue:[ "Cannot use #stored if the block is not available" method := fixedLength < dynamicLength ifTrue:[#fixed] ifFalse:[#dynamic]]. bitsSent := encoder bitPosition. "# of bits sent before this block" bitsRequired := nil. (method == #stored) ifTrue:[ VerboseLevel > 0 ifTrue:[Transcript show:'S']. bitsRequired := storedLength. encoder nextBits: 3 put: StoredBlock << 1 + lastFlag. self sendStoredBlock]. (method == #fixed) ifTrue:[ VerboseLevel > 0 ifTrue:[Transcript show:'F']. bitsRequired := fixedLength. encoder nextBits: 3 put: FixedBlock << 1 + lastFlag. self sendFixedBlock]. (method == #dynamic) ifTrue:[ VerboseLevel > 0 ifTrue:[Transcript show:'D']. bitsRequired := dynamicLength. encoder nextBits: 3 put: DynamicBlock << 1 + lastFlag. self sendDynamicBlock: blTree literalTree: lTree distanceTree: dTree bitLengths: blBits]. bitsRequired = (encoder bitPosition - bitsSent) + ifFalse:[self error: 'Bits size mismatch' translated]. - ifFalse:[self error:'Bits size mismatch']. lastBlock ifTrue:[self release] ifFalse:[self initializeNewBlock].! Item was changed: ----- Method: ZipWriteStream>>sendCompressedBlock:with: (in category 'dynamic blocks') ----- sendCompressedBlock: litTree with: distTree "Send the current block using the encodings from the given literal/length and distance tree" | sum | sum := encoder sendBlock: (ReadStream on: literals from: 1 to: litCount) with: (ReadStream on: distances from: 1 to: litCount) with: litTree with: distTree. + sum = (blockPosition - blockStart) ifFalse:[self error: 'Wrong number of bytes' translated].! - sum = (blockPosition - blockStart) ifFalse:[self error:'Wrong number of bytes'].!
More information about the Squeak-dev mailing list |