[squeak-dev] The Inbox: Compression-ct.56.mczchristoph.thiede at student.hpi.uni-potsdam.de christoph.thiede at student.hpi.uni-potsdam.deMon Jan 3 18:09:50 UTC 2022
Inbox because ZipArchiveMember >> #extractInDirectory:overwrite: is a breaking change that *hypothetically* could break any of your automated extraction workflows, even though I do not really expect that. Please check. If no one objects, I will move this to the Trunk after one week or so. :-) Best, Christoph --- Sent from Squeak Inbox Talk On 2022-01-03T18:07:40+00:00, commits at source.squeak.org wrote: > 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'].! > > -------------- next part -------------- An HTML attachment was scrubbed... URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20220103/7b65e49b/attachment-0001.html>
More information about the Squeak-dev mailing list |