[Pkg] Rio: Rio-Grande-kph.44.mcz
squeak-dev-noreply at lists.squeakfoundation.org
squeak-dev-noreply at lists.squeakfoundation.org
Sun Nov 9 19:31:52 UTC 2008
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"
- !
More information about the Packages
mailing list