"{ Package: 'stx:libbasic2' }"
HierarchicalURI subclass:#FtpURI
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'Resources'
!
!FtpURI class methodsFor:'accessing'!
schemes
^ #(ftp)
! !
!FtpURI methodsFor:'defaults'!
defaultPassword
^ 'secret@secret'
!
defaultPort
"answer the default command-port here"
^ 21
!
defaultUser
^ 'anonymous'
! !
!FtpURI methodsFor:'ftp requests'!
connectThenDo:aOneArgBlock
"setup a ftp connection and call aOneArgBlock with it"
|ftp|
ftp := FTPClient new.
[
ftp connectTo:self host
port:self port
user:(self user ? self defaultUser)
password:(self password ? self defaultPassword).
aOneArgBlock value:ftp
] ensure:[
ftp notNil ifTrue:[
ftp close.
].
]
!
exists
"does the file represented by this uri exist?
establish a connection for try to get a readStream"
|exists|
self connectThenDo:[:aFtpClient|
exists := self pathExistsFtp:aFtpClient.
].
^ exists ? false
"
|pwd uri|
pwd := Dialog requestPassword:'Password:'.
uri := (URI fromString:('ftp://tm:%1@exept/home/tm/tmp/test.txt' bindWith:pwd) ).
uri pathExists
"
!
pathExists:aPathname ftpClient:aFtpClient
|list|
list := aFtpClient list:aPathname.
^ list contains:[:aLine| (aLine asCollectionOfWords last) = aPathname ]
!
pathExistsFtp:aFtpClient
^ self pathExists:self path ftpClient:aFtpClient
! !
!FtpURI methodsFor:'stream access'!
readStreamDo:aBlock
"use FTPClient for now"
self connectThenDo:[:ftp| |stream path attributes|
[
path := self path.
attributes := self class attributes.
attributes at:#fileSize put:(ftp sizeOf:path).
attributes at:#baseName put:self pathSegments last.
attributes at:#uriInfo put:self printString.
stream := ftp getStreamFor:path.
aBlock value:stream value:attributes.
] ensure:[
stream notNil ifTrue:[
stream close.
].
].
].
"
'ftp://stefan:password@hippo/etc/group' asURI readStreamDo:[:stream :attributes |
self halt
].
"
!
readStreamsDo:aBlock
"evaluate the block with a Collection of streams as first argument
and a dictionary containing attributes as second argument,
- a collection with a stream on a single file,
- or a collection with streams on a directorie's files, but not recursive
The streams are closed after aBlock has been evaluated.
Attributes may be the mime type (key #MIME)"
self readStreamsDo:aBlock skipFilenamesWithSuffix:nil renameBlock:nil
!
readStreamsDo:aBlock renameBlock:renameBlock
"evaluate the block with a Collection of streams as first argument
and a dictionary containing attributes as second argument,
- a collection with a stream on a single file,
- or a collection with streams on a directorie's files, but not recursive
The streams are closed after aBlock has been evaluated.
Attributes may be the mime type (key #MIME)"
self readStreamsDo:aBlock skipFilenamesWithSuffix:nil renameBlock:renameBlock
!
readStreamsDo:aBlock skipFilenamesWithSuffix:skipSuffix renameBlock:renameBlock
"evaluate the block with a Collection of streams as first argument
and a dictionary containing attributes as second argument,
- a collection with a stream on a single file,
- or a collection with streams on a directorie's files, but not recursive
The streams are closed after aBlock has been evaluated.
Attributes may be the mime type (key #MIME)"
|attributes list requestDirectory path dirUri dirPath|
requestDirectory := false.
path := self path.
"kludge"
(path startsWith:'/~') ifTrue:[
path := path copyFrom:2.
].
attributes := self class attributes.
list := OrderedCollection new.
self connectThenDo:[:ftp| |baseName|
"try to change directory to path.
If we get a file error, we know that the directory does not exist"
baseName := self baseName.
(baseName includesAny:'*?[]') ifTrue:[
requestDirectory := true.
dirUri := self directory.
dirPath := dirUri path.
ftp cd:dirPath.
list addAll:
(ftp nlist select:[:filenameString| filenameString matches:baseName]).
] ifFalse:[
[
dirUri := self.
dirPath := path.
ftp cd:dirPath.
requestDirectory := true.
list addAll:ftp nlist.
] on:FTPClient fileErrorSignal do:[:ex|
"no directory, fetch path istSelf"
].
].
requestDirectory ifFalse:[
dirUri := self directory.
dirPath := dirUri path.
ftp cd:dirPath.
list add:self baseName.
].
attributes at:#requestDirectory put:requestDirectory.
"skip all files with skipSuffix aka 'file.old'"
skipSuffix size == 0 ifFalse:[
list := list select:[:baseName| (baseName endsWith:skipSuffix) not]
].
list do:[:eachBaseName| |stream|
"get a stream for the contents of the file"
FTPClient fileErrorSignal handle:[:ex|
"ignore errors -- skip subdirectories"
] do:[
stream := ftp getStreamFor:eachBaseName.
attributes at:#fileSize put:(ftp sizeOf:eachBaseName).
attributes at:#baseName put:eachBaseName.
].
stream notNil ifTrue:[ |srcUri srcPath|
requestDirectory ifTrue:[
"accessing the contents of a directory"
srcUri := dirUri construct:eachBaseName.
] ifFalse:[ |pathSegments|
"accessing a single file"
srcUri := self.
].
attributes at:#uriInfo put:srcUri.
[
aBlock value:stream value:attributes
] ensure:[stream close].
renameBlock notNil ifTrue:[ |renameFilenameString|
renameFilenameString := renameBlock value:eachBaseName.
[
ftp rename:eachBaseName to:renameFilenameString.
] on:FTPClient fileErrorSignal do:[:ex|
"rename failed, maybe file already exists"
renameFilenameString := renameFilenameString, '.',
(AbsoluteTime now printStringFormat:'%(year)%(mon)%(day)%h%m%s').
ftp rename:eachBaseName to:renameFilenameString.
]
].
].
].
].
"
|pwd|
pwd := Dialog requestPassword:''.
(URI fromString:('ftp://tm:%1@exept/~/tmp' bindWith:pwd) )
readStreamsDo:[:stream :attributes |
Transcript showCR:(attributes at:#baseName).
Transcript showCR:(attributes at:#fileSize).
Transcript showCR:(attributes at:#requestDirectory).
Transcript showCR:(attributes at:#uriInfo).
].
"
!
writeStreamDo:aBlock
"use FTPClient for now"
self connectThenDo:[:ftp| |stream|
[
stream := ftp putStreamFor:self path.
aBlock value:stream value:self class attributes.
] ensure:[
stream notNil ifTrue:[
stream close.
].
].
]
"
'ftp://stefan:password@hippo/etc/group' asURI writeStreamDo:[:stream :attributes |
self halt
].
"
!
writeStreamDo:aBlock create:doCreate
^ self writeStreamDo:aBlock create:doCreate atomic:false.
!
writeStreamDo:aBlock create:doCreate atomic:doAtomic
"use FTPClient for now.
If doCreate is true, a nonExistent directory will be created.
If doAtomic is true, files will appear atomically, by using
an intermediate file theat will be renamed"
|path toPath directory|
path := self path.
"kludge"
(path startsWith:'/~') ifTrue:[
path := path copyFrom:2.
].
doAtomic ifTrue:[
toPath := self directoryPath, '/.transferFile'.
"kludge"
(toPath startsWith:'/~') ifTrue:[
toPath := toPath copyFrom:2.
].
] ifFalse:[
toPath := path.
].
self connectThenDo:[:ftp| |stream|
[
[
stream := ftp putStreamFor:toPath.
] on:FTPClient filePutErrorSignal do:[:ex|
doCreate ifFalse:[
ex reject
].
"create the missing directory on the fly"
directory := self directoryPath.
FTPClient fileNotFoundErrorSignal handle:[:ex| ] do:[
ftp mkdir:directory.
].
ftp cd:directory.
stream := ftp putStreamFor:toPath.
].
aBlock value:stream value:self class attributes.
stream close.
doAtomic ifTrue:[
ftp rename:toPath to:path
].
] ifCurtailed:[
stream notNil ifTrue:[
stream close.
].
].
]
! !
!FtpURI methodsFor:'testing'!
isAbsolute
"there is nothing like a relative ftp URI"
^ true
! !
!FtpURI class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic2/FtpURI.st,v 1.9 2003-07-13 22:49:52 stefan Exp $'
! !