"{ 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

! !