A new version of Rio-Grande was added to project Rio: http://www.squeaksource.com/Rio/Rio-Grande-kph.44.mcz
==================== Summary ====================
Name: Rio-Grande-kph.44 Author: kph Time: 9 November 2008, 7:31:49 pm UUID: 36b650df-52dd-45f7-bf61-27ccfede14c9 Ancestors: Rio-Grande-kph.43
Refactored Instanciation
=============== Diff against Rio-Grande-kph.43 ===============
Item was added: + ----- Method: RioArchiveExecutive>>startAt:recursively:select:into: (in category 'as yet unclassified') ----- + startAt: rioOrString recursively: beRecursive select: selectBlock into: results + + "this unpleasent method repackages the flat archive as a hierarchical structure that + can be recursively traversed like a normal directory." + + | membersBelow subDirs dir | + + membersBelow := self members. + + rioOrString isEmpty + ifTrue: [ + dir := ''. + ] + ifFalse: [ + dir := rioOrString value. + dir last ~= $/ ifTrue: [ dir := dir , '/' ]. + membersBelow := membersBelow select: [ :member | + (member fileName ~= dir) and: [member fileName beginsWith: dir] + ]. + ]. + + subDirs := membersBelow select: [ :member | + | pathBelow entryRio | + pathBelow := member fileName allButFirst: dir size. + pathBelow last = $/ ifTrue: [ pathBelow := pathBelow allButLast ]. + (pathBelow includes: $/) + ifFalse: [ + entryRio := self class makeNewRioFrom: member fileName. + entryRio setStatFromDir: rioOrString andEntryArray: + (Array + with: pathBelow + with: "member lastModTime" 0 + with: "member lastModTime" 0 + with: member isDirectory). + (selectBlock value: entryRio) ifTrue: [ results add: entryRio ]. + false + ] + ifTrue: [ true ]. + ]. + + beRecursive ifTrue: [ + subDirs do: [ :aDir | + self startAt: aDir fileName recursively: beRecursive select: selectBlock into: results + ]. + ]. + + ^ results!
Item was added: + ----- Method: RioFtpExecutive>>isFile: (in category 'Rio-Grande') ----- + isFile: aRio + + self ftpDo: [ :ftp | ftp getFileSize: home, aRio asVmPathName ] ifError: [ :ex | ^ false ]. + + ^ true.!
Item was added: + ----- Method: RioFtpExecutive>>ftpOpenForWrite: (in category 'as yet unclassified') ----- + ftpOpenForWrite: aRio + + self ftpClient openPassiveDataConnection. + self ftpClient sendCommand: 'STOR ', home , aRio asVmPathName. + + "we will wrap a socket for writing" + rw := #write. + + ^ SocketStream on: self.!
Item was added: + ----- Method: RioFtpExecutive>>ftpParseEntryOld: (in category 'as yet unclassified') ----- + ftpParseEntryOld: ftpEntry + | tokens longy dateInSeconds thisYear thisMonth | + thisYear := Date today year. + thisMonth := Date today monthIndex. + tokens := ftpEntry findTokens: ' '. + + tokens size = 8 ifTrue: + [((tokens at: 6) size ~= 3 and: [(tokens at: 5) size = 3]) ifTrue: + ["Fix for case that group is blank (relies on month being 3 chars)" + tokens _ tokens copyReplaceFrom: 4 to: 3 with: {'blank'}]]. + tokens size >= 9 ifFalse:[^nil]. + + ((tokens at: 6) size ~= 3 and: [(tokens at: 5) size = 3]) ifTrue: + ["Fix for case that group is blank (relies on month being 3 chars)" + tokens := tokens copyReplaceFrom: 4 to: 3 with: {'blank'}]. + + tokens size > 9 ifTrue: + [longy := tokens at: 9. + 10 to: tokens size do: [:i | longy := longy , ' ' , (tokens at: i)]. + tokens at: 9 put: longy]. + dateInSeconds := self + secondsForDay: (tokens at: 7) + month: (tokens at: 6) + yearOrTime: (tokens at: 8) + thisMonth: thisMonth + thisYear: thisYear. + + ^Array with: (tokens last) "file name" + with: dateInSeconds "creation date" + with: dateInSeconds "modification time" + with: ( (tokens first first) = $d or: [tokens first first =$l]) "is-a-directory flag" + with: tokens fifth asNumber "file size" + !
Item was added: + ----- Method: RioArchiveExecutive>>setFile: (in category 'as yet unclassified') ----- + setFile: aRio + + file := aRio!
Item was added: + ----- Method: RioFtpExecutive>>createDirectory: (in category 'Rio-Grande') ----- + createDirectory: aRio + + self ftpDo: [ :ftp | + + ftp makeDirectory: home, aRio asVmPathName. + + ]. + + aRio statIsNowInvalid.!
Item was added: + ----- Method: RioFtpExecutive>>isDirectory: (in category 'Rio-Grande') ----- + isDirectory: aRio + + self ftpDo: [ :ftp | ftp changeDirectoryTo: home, aRio asVmPathName ] ifError: [ :ex | ^ false ]. + + ^ true.!
Item was added: + ----- Method: RioHttpExecutive class>>canInstanciateRioFrom: (in category 'as yet unclassified') ----- + canInstanciateRioFrom: aPathString + + ^ aPathString beginsWith: 'http:'!
Item was added: + ----- Method: RioFtpExecutive>>secondsForDay:month:yearOrTime:thisMonth:thisYear: (in category 'as yet unclassified') ----- + secondsForDay: dayToken month: monthToken yearOrTime: ytToken + thisMonth: thisMonth thisYear: thisYear + + | ftpDay ftpMonth pickAYear jDateToday trialJulianDate | + + ftpDay := dayToken asNumber. + ftpMonth := Date indexOfMonth: monthToken. + (ytToken includes: $:) ifFalse: [ + ^(Date newDay: ftpDay month: ftpMonth year: ytToken asNumber) asSeconds + ]. + jDateToday := Date today dayOfYear. + trialJulianDate := (Date newDay: ftpDay month: ftpMonth year: thisYear) dayOfYear. + + "Date has no year if within six months (do we need to check the day, too?)" + + "Well it appear to be pickier than that... it isn't just 6 months or 6 months and the day of the month, put perhaps the julian date AND the time as well. I don't know what the precise standard is, but this seems to produce better results" + + pickAYear := (jDateToday - trialJulianDate) > 182 ifTrue: [ + thisYear + 1 "his clock could be ahead of ours??" + ] ifFalse: [ + pickAYear := (trialJulianDate - jDateToday) > 182 ifTrue: [ + thisYear - 1 + ] ifFalse: [ + thisYear + ]. + ]. + ^(Date newDay: ftpDay month: ftpMonth year: pickAYear) asSeconds + + (Time readFrom: (ReadStream on: ytToken)) asSeconds + + !
Item was added: + ----- Method: RioFtpExecutive>>receiveDataSignallingTimeout:into:startingAt: (in category 'wrap socket') ----- + receiveDataSignallingTimeout: timeout + into: inBuffer startingAt: inNextToWrite + + ^ ftpClient dataSocket receiveDataSignallingTimeout: timeout + into: inBuffer startingAt: inNextToWrite!
Item was added: + ----- Method: RioFtpExecutive>>rootString (in category 'as yet unclassified') ----- + rootString + + ^ '/'!
Item was added: + RioRemoteExecutive subclass: #RioHttpExecutive + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Rio-Grande'!
Item was added: + ----- Method: RioFtpExecutive>>isOtherEndClosed (in category 'wrap socket') ----- + isOtherEndClosed + + ^ (ftpClient dataSocket ifNil: [ ^ true ]) isOtherEndClosed!
Item was added: + ----- Method: RioFtpExecutive>>password (in category 'as yet unclassified') ----- + password + + ^ url password ifNil: [ (self MCPasswordManager default queryPasswordAt: url asString user: (self user ifNil:[^'squeak'])) ] + + + !
Item was changed: ----- Method: PositionableStream>>copyTo:size:withProgress: (in category '*rio-grande') ----- copyTo: out size: aSize withProgress: label
| buffer barPos read first | self atEnd ifTrue: [ ^ self ]. first := self next. buffer := (first isCharacter + ifTrue: [ out ascii. String ] - ifTrue: [ String ] ifFalse: [ out binary. ByteArray ]) new: 50000. out nextPut: first.
label asString displayProgressAt: Sensor cursorPoint + from: (barPos := 0) to: (aSize) - from: (barPos := 0) to: (self size) during: [:bar | [ self atEnd ] whileFalse: [ bar value: barPos. out nextPutAll: (read := self nextInto: buffer). barPos := barPos + read size ]. ].!
Item was added: + ----- Method: RioFtpExecutive>>ftpClient (in category 'as yet unclassified') ----- + ftpClient + + ftpClient ifNotNil: [ftpClient isConnected ifTrue: [ ^ ftpClient ] ]. + + ^ ftpClient := self ftpOpenClient!
Item was added: + ----- Method: RioFtpExecutive>>in:select: (in category 'as yet unclassified') ----- + in: aRio select: selectBlock + + ^ self ftpDo: [ :c | super in: aRio select: selectBlock ]!
Item was added: + ----- Method: RioArchiveExecutive>>setArchive: (in category 'as yet unclassified') ----- + setArchive: anArchive + + archive := anArchive !
Item was added: + ----- Method: RioFtpExecutive>>sendData:count: (in category 'wrap socket') ----- + sendData: outBuffer count: n + + ftpClient dataSocket sendData: outBuffer count: n!
Item was added: + ----- Method: RioArchiveExecutive>>isFile: (in category 'as yet unclassified') ----- + isFile: aRio + + ^ (self isDirectory: aRio) not!
Item was added: + ----- Method: RioFtpExecutive>>basicReader: (in category 'as yet unclassified') ----- + basicReader: aRio + + ^ self ftpOpenForRead: aRio!
Item was added: + ----- Method: RioFtpExecutive>>closeAndDestroy: (in category 'wrap socket') ----- + closeAndDestroy: timeout + + ftpClient closeDataSocket. + ftpClient checkResponse. + + rw = #write ifTrue: [ ftpClient checkResponse ].!
Item was added: + ----- Method: RioFtpExecutive>>startAt:recursively:select:into: (in category 'as yet unclassified') ----- + startAt: rioOrString recursively: beRecursive select: selectBlock into: results + + "Return a collection of rio's selected by passing + the directoryEntry array to the selectBlock. + + This can be called with startAt: aString, but if so beRecursive must be false. + + See primLookupEntryIn:index: for further details." + + | entryRio | + + (self ftpGetDirectory: home, rioOrString asVmPathName) keysAndValuesDo: [ :index :entryArray | + + (entryRio := rioOrString / (entryArray at: 1)) + setStatFromDir: rioOrString andEntryArray:entryArray. + + (selectBlock value: entryRio) ifTrue: [ results add: entryRio ]. + + (beRecursive and: [ entryArray at: 4]) + ifTrue: [ + self + startAt: entryRio + recursively: beRecursive + select: selectBlock + into: results + ]. + + ]. + + ^ results!
Item was added: + ----- Method: RioArchiveExecutive class>>file: (in category 'as yet unclassified') ----- + file: aRio + + ^ (self new) setFile: aRio; yourself!
Item was added: + ----- Method: RioFtpExecutive>>touch: (in category 'Rio-Grande') ----- + touch: aRio + + self ftpDo: [ :dtp | + + ftp putFileStreamContents: (WriteStream with: String new) as: home , aRio asVmPathName + + ]!
Item was added: + RioLocalExecutive subclass: #RioArchiveExecutive + instanceVariableNames: 'file archive members' + classVariableNames: '' + poolDictionaries: '' + category: 'Rio-Grande'!
Item was added: + ----- Method: RioFtpExecutive>>ftpDo:ifError: (in category 'as yet unclassified') ----- + ftpDo: aBlock ifError: errBlock + + [ self ftpDo: aBlock. + ] on: TelnetProtocolError do: errBlock !
Item was added: + ----- Method: RioFtpExecutive>>rioClass (in category 'as yet unclassified') ----- + rioClass + + ^ RioFtp!
Item was added: + ----- Method: RioFtpExecutive>>host (in category 'as yet unclassified') ----- + host + + ^ url authority!
Item was added: + ----- Method: RioFtpExecutive>>mkpath: (in category 'Rio-Grande') ----- + mkpath: aRio + self ftpDo: [ :ftp | super mkpath: aRio ] !
Item was added: + ----- Method: RioFtpExecutive>>password: (in category 'as yet unclassified') ----- + password: passwordString + + | pwd | + + self user = 'ftp' ifTrue: [ ^ self ]. + + passwordString isEmpty ifTrue:[pwd := nil] ifFalse:[pwd := passwordString]. + + self MCPasswordManager default passwordAt: url asString user: self user put: pwd. + !
Item was added: + ----- Method: RioArchiveExecutive>>members (in category 'as yet unclassified') ----- + members + + ^ members ifNil: [ + file reader: [ :str | archive readFrom: str ]. + members := archive members. + ]!
Item was added: + ----- Method: RioRemoteExecutive>>setUrl: (in category 'as yet unclassified') ----- + setUrl: aUrl + + url := aUrl. + !
Item was added: + ----- Method: RioFtpExecutive>>deleteFile: (in category 'Rio-Grande') ----- + deleteFile: aRio + + self ftpDo: [ :ftp | + + (self isFile: aRio) ifTrue: [ ftp deleteFileNamed: home , aRio asVmPathName ] + + ]. + + aRio statIsNowInvalid.!
Item was added: + ----- Method: RioFtpExecutive>>fileSize: (in category 'Rio-Grande') ----- + fileSize: aRio + + ^ self ftpDo: [ :ftp | ftp getFileSize: home, aRio asVmPathName ] !
Item was added: + ----- Method: RioFtpExecutive>>ftpDo: (in category 'as yet unclassified') ----- + ftpDo: aBlock + + | tmp result | + + tmp := isKeepAlive. + isKeepAlive := true. + + [ result := aBlock value: self ftpClient. ] + + ensure: [ (isKeepAlive := tmp) ifFalse: [ ftpClient ifNotNil: [ ftpClient quit ] ] ]. + + ^ result!
Item was added: + ----- Method: RioFtpExecutive>>setUrl: (in category 'as yet unclassified') ----- + setUrl: aUrl + + url := aUrl. + !
Item was added: + RioRemoteExecutive subclass: #RioFtpExecutive + instanceVariableNames: 'home isKeepAlive rw' + classVariableNames: '' + poolDictionaries: '' + category: 'Rio-Grande'!
Item was added: + ----- Method: RioFtpExecutive>>delete: (in category 'Rio-Grande') ----- + delete: aRio + self ftpDo: [ :ftp | super delete: aRio ] !
Item was added: + ----- Method: RioHttpExecutive class>>makeNewRioFrom: (in category 'as yet unclassified') ----- + makeNewRioFrom: aString + + | exec path theUrl | + + theUrl := aString asUrl. + + path := String new writeStream. + + theUrl path do: [ :pathElem | + path nextPut: $/. + path nextPutAll: pathElem ]. + + theUrl path: #(). + + exec := self executiveForUrl: theUrl. + + ^ exec rioClass executive: exec value: path contents.!
Item was added: + ----- Method: RioArchiveExecutive>>fullFor: (in category 'as yet unclassified') ----- + fullFor: aRio + + ^ aRio + !
Item was added: + ----- Method: RioFtpExecutive class>>canInstanciateRioFrom: (in category 'as yet unclassified') ----- + canInstanciateRioFrom: aPathString + + ^ aPathString beginsWith: 'ftp:'!
Item was added: + ----- Method: RioFtpExecutive>>dataAvailable (in category 'wrap socket') ----- + dataAvailable + + ^ ftpClient dataSocket dataAvailable!
Item was added: + RioArchiveExecutive subclass: #RioZipArchiveExecutive + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Rio-Grande'!
Item was added: + ----- Method: RioArchiveExecutive>>printId (in category 'as yet unclassified') ----- + printId + + ^ self file asString!
Item was added: + ----- Method: RioFtpExecutive>>ftpKeepAliveDuring: (in category 'as yet unclassified') ----- + ftpKeepAliveDuring: aBlock + + | tmp | + + tmp := isKeepAlive. + isKeepAlive := true. + aBlock ensure: [ isKeepAlive := tmp ] + !
Item was added: + ----- Method: RioArchiveExecutive>>root (in category 'as yet unclassified') ----- + root + + ^ self pathDelimiter + !
Item was added: + ----- Method: RioFtpExecutive>>deleteDirectory: (in category 'Rio-Grande') ----- + deleteDirectory: aRio + + self ftpDo: [ :ftp | + + ftp deleteDirectory: home, aRio asVmPathName. + + ]. + + aRio statIsNowInvalid.!
Item was added: + ----- Method: RioFtpExecutive>>isKeepAlive (in category 'as yet unclassified') ----- + isKeepAlive + + ^ true!
Item was added: + ----- Method: RioFtpExecutive>>isConnected (in category 'wrap socket') ----- + isConnected + + ^ (ftpClient dataSocket ifNil: [ ^ false ]) isConnected!
Item was added: + ----- Method: RioFtpExecutive>>mkdir: (in category 'Rio-Grande') ----- + mkdir: aRio + self ftpDo: [ :ftp | super mkdir: aRio ] !
Item was added: + RioExecutive subclass: #RioRemoteExecutive + instanceVariableNames: 'url client' + classVariableNames: '' + poolDictionaries: '' + category: 'Rio-Grande'!
Item was added: + ----- Method: RioArchiveExecutive>>isDirectory: (in category 'as yet unclassified') ----- + isDirectory: aRio + + | dir | + + dir := aRio value, '/'. + + ^ (archive members detect: [ :member | dir = member fileName ] ifNone: [ ^false ]) isDirectory!
Item was added: + ----- Method: RioFtpExecutive>>ftpOpenClient (in category 'as yet unclassified') ----- + ftpOpenClient + + | loginSuccessful what client | + + client := self FTPClient openOnHostNamed: self host. + loginSuccessful := false. + [loginSuccessful] + whileFalse: [ + [loginSuccessful := true. + client loginUser: self user password: self password] + on: LoginFailedException + do: [:ex | + what := UIManager default + chooseFrom: #('enter password' 'give up') + title: 'Would you like to try another password?'. + what = 1 ifFalse: [self error: 'Login failed.'. ^nil] + ifTrue: [ self password: nil ]. + loginSuccessful := false]]. + + home := client pwd. + + ^client!
Item was added: + ----- Method: RioArchiveExecutive>>archive (in category 'as yet unclassified') ----- + archive + + ^ archive!
Item was added: + ----- Method: RioArchiveExecutive>>file (in category 'as yet unclassified') ----- + file + + ^ file !
Item was added: + ----- Method: RioFtpExecutive>>receiveAvailableDataInto:startingAt: (in category 'wrap socket') ----- + receiveAvailableDataInto: inBuffer startingAt: n + + ^ ftpClient dataSocket receiveAvailableDataInto: inBuffer startingAt: n!
Item was added: + ----- Method: RioFtpExecutive>>basicWriter: (in category 'as yet unclassified') ----- + basicWriter: aRio + + ^ self ftpOpenForWrite: aRio!
Item was added: + ----- Method: RioFtpExecutive>>initialize (in category 'as yet unclassified') ----- + initialize + + isKeepAlive := false.!
Item was changed: ----- Method: RioAdaptorArchive>>setRio: (in category 'accessing') ----- setRio: aRio
super setRio: aRio. + aRio executive: (RioArchiveExecutive file: aRio copy). - aRio executive: (RioArchiveFileSystem file: aRio copy). aRio value: ''. "aRio executive root value."!
Item was added: + ----- Method: RioFtpExecutive>>user (in category 'as yet unclassified') ----- + user + + ^ url username ifNil: [ 'ftp' ] + !
Item was added: + ----- Method: RioFtpExecutive>>ftpOpenForRead: (in category 'as yet unclassified') ----- + ftpOpenForRead: aRio + + self ftpClient openPassiveDataConnection. + self ftpClient sendCommand: 'RETR ', home , aRio asVmPathName. + + [ftpClient checkResponse] + on: TelnetProtocolError + do: [:ex | + ftpClient closeDataSocket. + ex pass]. + + "we will wrap a socket for writing" + rw := #read. + + ^ SocketStream on: self.!
Item was added: + ----- Method: RioRemoteExecutive class>>executiveForUrl: (in category 'as yet unclassified') ----- + executiveForUrl: aUrl + + ^ self basicNew setUrl: aUrl; initialize!
Item was added: + ----- Method: RioFtpExecutive>>ftpGetDirectory: (in category 'Rio-Grande') ----- + ftpGetDirectory: dirString + "Return a stream with a listing of the current server directory. (Later -- Use a proxy server if one has been registered.)" + + | listing str ftpEntries | + + self ftpDo: [ :ftp | + ftp changeDirectoryTo: dirString. + listing := ftp getDirectory ]. + + str := ReadStream on: listing. + + (str respondsTo: #contentsOfEntireFile) ifFalse: [^ #()]. + + ftpEntries := str contentsOfEntireFile findTokens: String crlf. + + ^ ftpEntries + collect:[:ftpEntry | self ftpParseEntry: ftpEntry ] + thenSelect: [:entry | entry notNil]!
Item was added: + ----- Method: RioFtpExecutive>>rename:to: (in category 'Rio-Grande') ----- + rename: aRio to: bRio + + self ftpDo: [ :ftp | ftp renameFileNamed: home, aRio asVmPathName to: home, bRio asVmPathName ] + ifError: [ + + aRio exists ifFalse:[ self error:'Attempt to rename a non-existent file or dir:' , aRio]. + + bRio exists ifTrue:[ self error: 'Failed to rename, ', bRio,' already exists.' ]. + + ]. + + aRio statIsNowInvalid. + + + ^ bRio + + !
Item was added: + ----- Method: RioFtpExecutive>>FTPClient (in category 'as yet unclassified') ----- + FTPClient + + ^ FTPClient"Debug"!
Item was added: + ----- Method: RioFtpExecutive>>ftpParseEntry: (in category 'as yet unclassified') ----- + ftpParseEntry: ftpEntry + | permissions rs dateInSeconds thisYear thisMonth unkown user group size month day time filename | + thisYear := Date today year. + thisMonth := Date today monthIndex. + + rs := ftpEntry readStream. + + permissions := rs upToSeparator. + + permissions size < 10 ifTrue: [ ^ nil ]. + + rs skipSeparators. + + unkown := rs upToSeparator. + + rs skipSeparators. + + user := rs upToSeparator. + + rs skipSeparators. + + group := rs upToSeparator. + + rs skipSeparators. + + size := rs upToSeparator. + + rs skipSeparators. + + month := rs upToSeparator. + + rs skipSeparators. + + "Fix for case that group is blank (relies on month being 3 chars)" + (size size = 3 and: [ size asNumber = 0 ]) ifTrue: [ + + month := size. + size := group. + group := 'blank'. + + ]. + + day := rs upToSeparator. + + rs skipSeparators. + + time := rs upToSeparator. + + rs skipSeparators. + + filename := rs upToEnd. + + dateInSeconds := self + secondsForDay: day + month: month + yearOrTime: time + thisMonth: thisMonth + thisYear: thisYear. + + ^Array with: filename "file name" + with: dateInSeconds "creation date" + with: dateInSeconds "modification time" + with: ( (permissions first) = $d or: [permissions first =$l]) "is-a-directory flag" + with: size asNumber "file size" + !
Item was added: + ----- Method: RioRemoteExecutive class>>makeNewRioFrom: (in category 'as yet unclassified') ----- + makeNewRioFrom: aString + + | exec path theUrl | + + theUrl := aString asUrl. + + path := String new writeStream. + + theUrl path do: [ :pathElem | + path nextPut: $/. + path nextPutAll: pathElem ]. + + theUrl path: #(). + + exec := self executiveForUrl: theUrl. + + ^ exec rioClass executive: exec value: path contents.!
Item was removed: - ----- Method: RioArchiveFileSystem>>startAt:recursively:select:into: (in category 'as yet unclassified') ----- - startAt: rioOrString recursively: beRecursive select: selectBlock into: results - - "this unpleasent method repackages the flat archive as a hierarchical structure that - can be recursively traversed like a normal directory." - - | membersBelow subDirs dir | - - membersBelow := self members. - - rioOrString isEmpty - ifTrue: [ - dir := ''. - ] - ifFalse: [ - dir := rioOrString value. - dir last ~= $/ ifTrue: [ dir := dir , '/' ]. - membersBelow := membersBelow select: [ :member | - (member fileName ~= dir) and: [member fileName beginsWith: dir] - ]. - ]. - - subDirs := membersBelow select: [ :member | - | pathBelow entryRio | - pathBelow := member fileName allButFirst: dir size. - pathBelow last = $/ ifTrue: [ pathBelow := pathBelow allButLast ]. - (pathBelow includes: $/) - ifFalse: [ - entryRio := self makeNewRioOfClass: Rio fromString: member fileName. - entryRio setStatFromDir: rioOrString andEntryArray: - (Array - with: pathBelow - with: "member lastModTime" 0 - with: "member lastModTime" 0 - with: member isDirectory). - (selectBlock value: entryRio) ifTrue: [ results add: entryRio ]. - false - ] - ifTrue: [ true ]. - ]. - - beRecursive ifTrue: [ - subDirs do: [ :aDir | - self startAt: aDir fileName recursively: beRecursive select: selectBlock into: results - ]. - ]. - - ^ results!
Item was removed: - ----- Method: RioFtpFileSystem>>isDirectory: (in category 'as yet unclassified') ----- - isDirectory: aRio - - self ftpDo: [ :client | client changeDirectoryTo: home, aRio asVmPathName ] ifError: [ :ex | ^ false ]. - - ^ true.!
Item was removed: - ----- Method: RioFtpFileSystem>>secondsForDay:month:yearOrTime:thisMonth:thisYear: (in category 'as yet unclassified') ----- - secondsForDay: dayToken month: monthToken yearOrTime: ytToken - thisMonth: thisMonth thisYear: thisYear - - | ftpDay ftpMonth pickAYear jDateToday trialJulianDate | - - ftpDay := dayToken asNumber. - ftpMonth := Date indexOfMonth: monthToken. - (ytToken includes: $:) ifFalse: [ - ^(Date newDay: ftpDay month: ftpMonth year: ytToken asNumber) asSeconds - ]. - jDateToday := Date today dayOfYear. - trialJulianDate := (Date newDay: ftpDay month: ftpMonth year: thisYear) dayOfYear. - - "Date has no year if within six months (do we need to check the day, too?)" - - "Well it appear to be pickier than that... it isn't just 6 months or 6 months and the day of the month, put perhaps the julian date AND the time as well. I don't know what the precise standard is, but this seems to produce better results" - - pickAYear := (jDateToday - trialJulianDate) > 182 ifTrue: [ - thisYear + 1 "his clock could be ahead of ours??" - ] ifFalse: [ - pickAYear := (trialJulianDate - jDateToday) > 182 ifTrue: [ - thisYear - 1 - ] ifFalse: [ - thisYear - ]. - ]. - ^(Date newDay: ftpDay month: ftpMonth year: pickAYear) asSeconds + - (Time readFrom: (ReadStream on: ytToken)) asSeconds - - !
Item was removed: - ----- Method: RioFtpFileSystem>>receiveDataSignallingTimeout:into:startingAt: (in category 'wrap socket') ----- - receiveDataSignallingTimeout: timeout - into: inBuffer startingAt: inNextToWrite - - ^ ftpClient dataSocket receiveDataSignallingTimeout: timeout - into: inBuffer startingAt: inNextToWrite!
Item was removed: - ----- Method: RioFtpFileSystem>>rootString (in category 'as yet unclassified') ----- - rootString - - ^ '/'!
Item was removed: - ----- Method: RioFtpFileSystem>>deleteFile: (in category 'as yet unclassified') ----- - deleteFile: aRio - - self ftpDo: [ :client | - - (self isFile: aRio) ifTrue: [ client deleteFileNamed: home , aRio asVmPathName ] - - ]. - - aRio statIsNowInvalid.!
Item was removed: - ----- Method: RioFtpFileSystem>>isOtherEndClosed (in category 'wrap socket') ----- - isOtherEndClosed - - ^ (ftpClient dataSocket ifNil: [ ^ true ]) isOtherEndClosed!
Item was removed: - ----- Method: RioFtpFileSystem>>ftpDo: (in category 'as yet unclassified') ----- - ftpDo: aBlock - - | tmp result | - - tmp := isKeepAlive. - isKeepAlive := true. - - [ result := aBlock value: self ftpClient. ] - - ensure: [ (isKeepAlive := tmp) ifFalse: [ ftpClient ifNotNil: [ ftpClient quit ] ] ]. - - ^ result!
Item was removed: - ----- Method: RioFtpFileSystem>>password (in category 'as yet unclassified') ----- - password - - ^ url password ifNil: [ (self MCPasswordManager default queryPasswordAt: url asString user: (self user ifNil:[^'squeak'])) ] - - - !
Item was removed: - ----- Method: RioFtpFileSystem>>ftpClient (in category 'as yet unclassified') ----- - ftpClient - - ftpClient ifNotNil: [ftpClient isConnected ifTrue: [ ^ ftpClient ] ]. - - ^ ftpClient := self ftpOpenClient!
Item was removed: - ----- Method: RioFtpFileSystem>>in:select: (in category 'as yet unclassified') ----- - in: aRio select: selectBlock - - ^ self ftpDo: [ :c | super in: aRio select: selectBlock ]!
Item was removed: - ----- Method: RioArchiveFileSystem>>file (in category 'as yet unclassified') ----- - file - - ^ file !
Item was removed: - ----- Method: RioFtpFileSystem>>sendData:count: (in category 'wrap socket') ----- - sendData: outBuffer count: n - - ftpClient dataSocket sendData: outBuffer count: n!
Item was removed: - ----- Method: RioFtpFileSystem>>basicReader: (in category 'as yet unclassified') ----- - basicReader: aRio - - ^ self ftpOpenForRead: aRio!
Item was removed: - ----- Method: RioFtpFileSystem>>closeAndDestroy: (in category 'wrap socket') ----- - closeAndDestroy: timeout - - ftpClient closeDataSocket. - ftpClient checkResponse. - - rw = #write ifTrue: [ ftpClient checkResponse ].!
Item was removed: - ----- Method: RioFtpFileSystem>>startAt:recursively:select:into: (in category 'as yet unclassified') ----- - startAt: rioOrString recursively: beRecursive select: selectBlock into: results - - "Return a collection of rio's selected by passing - the directoryEntry array to the selectBlock. - - This can be called with startAt: aString, but if so beRecursive must be false. - - See primLookupEntryIn:index: for further details." - - | entryRio | - - (self ftpGetDirectory: home, rioOrString asVmPathName) keysAndValuesDo: [ :index :entryArray | - - (entryRio := rioOrString / (entryArray at: 1)) - setStatFromDir: rioOrString andEntryArray:entryArray. - - (selectBlock value: entryRio) ifTrue: [ results add: entryRio ]. - - (beRecursive and: [ entryArray at: 4]) - ifTrue: [ - self - startAt: entryRio - recursively: beRecursive - select: selectBlock - into: results - ]. - - ]. - - ^ results!
Item was removed: - ----- Method: RioArchiveFileSystem>>setArchive: (in category 'as yet unclassified') ----- - setArchive: anArchive - - archive := anArchive !
Item was removed: - ----- Method: RioFtp class>>defaultExecutive (in category 'as yet unclassified') ----- - defaultExecutive - - ^ RioFtpFileSystem new!
Item was removed: - ----- Method: RioFtpFileSystem>>ftpDo:ifError: (in category 'as yet unclassified') ----- - ftpDo: aBlock ifError: errBlock - - [ self ftpDo: aBlock. - ] on: TelnetProtocolError do: errBlock !
Item was removed: - ----- Method: RioFtpFileSystem>>mkpath: (in category 'as yet unclassified') ----- - mkpath: aRio - self ftpDo: [ :client | super mkpath: aRio ] !
Item was removed: - ----- Method: RioFtpFileSystem>>makeNewRioOfClass:fromString: (in category 'as yet unclassified') ----- - makeNewRioOfClass: aRioClass fromString: aString - - | exec path theUrl | - - theUrl := aString asUrl. - - path := String new writeStream. - - theUrl path do: [ :pathElem | - path nextPut: $/. - path nextPutAll: pathElem ]. - - theUrl path: #(). - - exec := self executiveForUrl: theUrl. - - ^ aRioClass executive: exec value: path contents.!
Item was removed: - ----- Method: RioFtpFileSystem>>rioClass (in category 'as yet unclassified') ----- - rioClass - - ^ RioFtp!
Item was removed: - ----- Method: RioFtpFileSystem>>host (in category 'as yet unclassified') ----- - host - - ^ url authority!
Item was removed: - ----- Method: RioArchiveFileSystem class>>file: (in category 'as yet unclassified') ----- - file: aRio - - ^ (self new) setFile: aRio; yourself!
Item was removed: - ----- Method: RioFtpFileSystem>>password: (in category 'as yet unclassified') ----- - password: passwordString - - | pwd | - - self user = 'ftp' ifTrue: [ ^ self ]. - - passwordString isEmpty ifTrue:[pwd := nil] ifFalse:[pwd := passwordString]. - - self MCPasswordManager default passwordAt: url asString user: self user put: pwd. - !
Item was removed: - ----- Method: RioFtpFileSystem>>ftpOpenClient (in category 'as yet unclassified') ----- - ftpOpenClient - - | loginSuccessful what client | - - client := self FTPClient openOnHostNamed: self host. - loginSuccessful := false. - [loginSuccessful] - whileFalse: [ - [loginSuccessful := true. - client loginUser: self user password: self password] - on: LoginFailedException - do: [:ex | - what := UIManager default - chooseFrom: #('enter password' 'give up') - title: 'Would you like to try another password?'. - what = 1 ifFalse: [self error: 'Login failed.'. ^nil] - ifTrue: [ self password: nil ]. - loginSuccessful := false]]. - - home := client pwd. - - ^client!
Item was removed: - ----- Method: RioArchiveFileSystem>>setFile: (in category 'as yet unclassified') ----- - setFile: aRio - - file := aRio!
Item was removed: - ----- Method: RioFtpFileSystem>>fileSize: (in category 'as yet unclassified') ----- - fileSize: aRio - - ^ self ftpDo: [ :client | client getFileSize: home, aRio asVmPathName ] !
Item was removed: - ----- Method: RioFtpFileSystem>>delete: (in category 'as yet unclassified') ----- - delete: aRio - self ftpDo: [ :client | super delete: aRio ] !
Item was removed: - ----- Method: RioFtpFileSystem>>ftpParseEntry: (in category 'as yet unclassified') ----- - ftpParseEntry: ftpEntry - | permissions rs dateInSeconds thisYear thisMonth unkown user group size month day time filename | - thisYear := Date today year. - thisMonth := Date today monthIndex. - - rs := ftpEntry readStream. - - permissions := rs upToSeparator. - - permissions size < 10 ifTrue: [ ^ nil ]. - - rs skipSeparators. - - unkown := rs upToSeparator. - - rs skipSeparators. - - user := rs upToSeparator. - - rs skipSeparators. - - group := rs upToSeparator. - - rs skipSeparators. - - size := rs upToSeparator. - - rs skipSeparators. - - month := rs upToSeparator. - - rs skipSeparators. - - "Fix for case that group is blank (relies on month being 3 chars)" - (size size = 3 and: [ size asNumber = 0 ]) ifTrue: [ - - month := size. - size := group. - group := 'blank'. - - ]. - - day := rs upToSeparator. - - rs skipSeparators. - - time := rs upToSeparator. - - rs skipSeparators. - - filename := rs upToEnd. - - dateInSeconds := self - secondsForDay: day - month: month - yearOrTime: time - thisMonth: thisMonth - thisYear: thisYear. - - ^Array with: filename "file name" - with: dateInSeconds "creation date" - with: dateInSeconds "modification time" - with: ( (permissions first) = $d or: [permissions first =$l]) "is-a-directory flag" - with: size asNumber "file size" - !
Item was removed: - ----- Method: RioFtpFileSystem>>FTPClient (in category 'as yet unclassified') ----- - FTPClient - - ^ FTPClient"Debug"!
Item was removed: - ----- Method: RioFtpFileSystem>>dataAvailable (in category 'wrap socket') ----- - dataAvailable - - ^ ftpClient dataSocket dataAvailable!
Item was removed: - ----- Method: RioFtpFileSystem>>ftpKeepAliveDuring: (in category 'as yet unclassified') ----- - ftpKeepAliveDuring: aBlock - - | tmp | - - tmp := isKeepAlive. - isKeepAlive := true. - aBlock ensure: [ isKeepAlive := tmp ] - !
Item was removed: - ----- Method: RioFtpFileSystem>>deleteDirectory: (in category 'as yet unclassified') ----- - deleteDirectory: aRio - - self ftpDo: [ :client | - - client deleteDirectory: home, aRio asVmPathName. - - ]. - - aRio statIsNowInvalid.!
Item was removed: - ----- Method: RioArchiveFileSystem>>isFile: (in category 'as yet unclassified') ----- - isFile: aRio - - ^ (self isDirectory: aRio) not!
Item was removed: - ----- Method: RioArchiveFileSystem>>printId (in category 'as yet unclassified') ----- - printId - - ^ self file asString!
Item was removed: - ----- Method: RioFtpFileSystem>>isConnected (in category 'wrap socket') ----- - isConnected - - ^ (ftpClient dataSocket ifNil: [ ^ false ]) isConnected!
Item was removed: - ----- Method: RioFtpFileSystem>>isKeepAlive (in category 'as yet unclassified') ----- - isKeepAlive - - ^ true!
Item was removed: - ----- Method: RioArchiveFileSystem>>root (in category 'as yet unclassified') ----- - root - - ^ self pathDelimiter - !
Item was removed: - ----- Method: RioFtpFileSystem>>mkdir: (in category 'as yet unclassified') ----- - mkdir: aRio - self ftpDo: [ :client | super mkdir: aRio ] !
Item was removed: - ----- Method: RioFtpFileSystem>>createDirectory: (in category 'as yet unclassified') ----- - createDirectory: aRio - - self ftpDo: [ :client | - - client makeDirectory: home, aRio asVmPathName. - - ]. - - aRio statIsNowInvalid.!
Item was removed: - RioExecutive subclass: #RioFtpFileSystem - instanceVariableNames: 'url home ftpClient isKeepAlive rw' - classVariableNames: 'Servers' - poolDictionaries: '' - category: 'Rio-Grande'!
Item was removed: - ----- Method: RioFtpFileSystem>>receiveAvailableDataInto:startingAt: (in category 'wrap socket') ----- - receiveAvailableDataInto: inBuffer startingAt: n - - ^ ftpClient dataSocket receiveAvailableDataInto: inBuffer startingAt: n!
Item was removed: - ----- Method: RioFtpFileSystem>>basicWriter: (in category 'as yet unclassified') ----- - basicWriter: aRio - - ^ self ftpOpenForWrite: aRio!
Item was removed: - ----- Method: RioFtpFileSystem>>executiveForUrl: (in category 'as yet unclassified') ----- - executiveForUrl: aUrl - - url := aUrl. - !
Item was removed: - ----- Method: RioFtpFileSystem>>initialize (in category 'as yet unclassified') ----- - initialize - - isKeepAlive := false.!
Item was removed: - ----- Method: RioArchiveFileSystem>>isDirectory: (in category 'as yet unclassified') ----- - isDirectory: aRio - - | dir | - - dir := aRio value, '/'. - - ^ (archive members detect: [ :member | dir = member fileName ] ifNone: [ ^false ]) isDirectory!
Item was removed: - ----- Method: RioArchiveFileSystem>>members (in category 'as yet unclassified') ----- - members - - ^ members ifNil: [ - file reader: [ :str | archive readFrom: str ]. - members := archive members. - ]!
Item was removed: - ----- Method: RioFtpFileSystem>>user (in category 'as yet unclassified') ----- - user - - ^ url username ifNil: [ 'ftp' ] - !
Item was removed: - ----- Method: RioArchiveFileSystem>>archive (in category 'as yet unclassified') ----- - archive - - ^ archive!
Item was removed: - ----- Method: RioFtpFileSystem>>MCPasswordManager (in category 'as yet unclassified') ----- - MCPasswordManager - - ^ MCPasswordManager!
Item was removed: - ----- Method: RioFtpFileSystem>>ftpOpenForRead: (in category 'as yet unclassified') ----- - ftpOpenForRead: aRio - - self ftpClient openPassiveDataConnection. - self ftpClient sendCommand: 'RETR ', home , aRio asVmPathName. - - [ftpClient checkResponse] - on: TelnetProtocolError - do: [:ex | - ftpClient closeDataSocket. - ex pass]. - - "we will wrap a socket for writing" - rw := #read. - - ^ SocketStream on: self.!
Item was removed: - RioArchiveFileSystem subclass: #RioZipArchiveFileSystem - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Rio-Grande'!
Item was removed: - ----- Method: RioFtpFileSystem>>ftpGetDirectory: (in category 'as yet unclassified') ----- - ftpGetDirectory: dirString - "Return a stream with a listing of the current server directory. (Later -- Use a proxy server if one has been registered.)" - - | listing str ftpEntries | - - self ftpDo: [ :client | - client changeDirectoryTo: dirString. - listing := client getDirectory ]. - - str := ReadStream on: listing. - - (str respondsTo: #contentsOfEntireFile) ifFalse: [^ #()]. - - ftpEntries := str contentsOfEntireFile findTokens: String crlf. - - ^ ftpEntries - collect:[:ftpEntry | self ftpParseEntry: ftpEntry ] - thenSelect: [:entry | entry notNil]!
Item was removed: - ----- Method: RioFtpFileSystem>>rename:to: (in category 'as yet unclassified') ----- - rename: aRio to: bRio - - self ftpDo: [ :client | client renameFileNamed: home, aRio asVmPathName to: home, bRio asVmPathName ] - ifError: [ - - aRio exists ifFalse:[ self error:'Attempt to rename a non-existent file or dir:' , aRio]. - - bRio exists ifTrue:[ self error: 'Failed to rename, ', bRio,' already exists.' ]. - - ]. - - aRio statIsNowInvalid. - - - ^ bRio - - !
Item was removed: - ----- Method: RioFtpFileSystem>>isFile: (in category 'as yet unclassified') ----- - isFile: aRio - - self ftpDo: [ :client | client getFileSize: home, aRio asVmPathName ] ifError: [ :ex | ^ false ]. - - ^ true.!
Item was removed: - ----- Method: RioFtpFileSystem>>ftpOpenForWrite: (in category 'as yet unclassified') ----- - ftpOpenForWrite: aRio - - self ftpClient openPassiveDataConnection. - self ftpClient sendCommand: 'STOR ', home , aRio asVmPathName. - - "we will wrap a socket for writing" - rw := #write. - - ^ SocketStream on: self.!
Item was removed: - ----- Method: RioArchiveFileSystem>>fullFor: (in category 'as yet unclassified') ----- - fullFor: aRio - - ^ aRio - !
Item was removed: - ----- Method: RioFtpFileSystem>>touch: (in category 'as yet unclassified') ----- - touch: aRio - - self ftpDo: [ :client | - - client putFileStreamContents: (WriteStream with: String new) as: home , aRio asVmPathName - - ]!
Item was removed: - RioLocalFileSystem subclass: #RioArchiveFileSystem - instanceVariableNames: 'file archive members' - classVariableNames: '' - poolDictionaries: '' - category: 'Rio-Grande'!
Item was removed: - ----- Method: RioFtpFileSystem>>ftpParseEntryOld: (in category 'as yet unclassified') ----- - ftpParseEntryOld: ftpEntry - | tokens longy dateInSeconds thisYear thisMonth | - thisYear := Date today year. - thisMonth := Date today monthIndex. - tokens := ftpEntry findTokens: ' '. - - tokens size = 8 ifTrue: - [((tokens at: 6) size ~= 3 and: [(tokens at: 5) size = 3]) ifTrue: - ["Fix for case that group is blank (relies on month being 3 chars)" - tokens _ tokens copyReplaceFrom: 4 to: 3 with: {'blank'}]]. - tokens size >= 9 ifFalse:[^nil]. - - ((tokens at: 6) size ~= 3 and: [(tokens at: 5) size = 3]) ifTrue: - ["Fix for case that group is blank (relies on month being 3 chars)" - tokens := tokens copyReplaceFrom: 4 to: 3 with: {'blank'}]. - - tokens size > 9 ifTrue: - [longy := tokens at: 9. - 10 to: tokens size do: [:i | longy := longy , ' ' , (tokens at: i)]. - tokens at: 9 put: longy]. - dateInSeconds := self - secondsForDay: (tokens at: 7) - month: (tokens at: 6) - yearOrTime: (tokens at: 8) - thisMonth: thisMonth - thisYear: thisYear. - - ^Array with: (tokens last) "file name" - with: dateInSeconds "creation date" - with: dateInSeconds "modification time" - with: ( (tokens first first) = $d or: [tokens first first =$l]) "is-a-directory flag" - with: tokens fifth asNumber "file size" - !
packages@lists.squeakfoundation.org