FtpURI.st
author tm
Thu, 10 Jul 2003 12:24:21 +0200
changeset 1265 f0ea5f786b16
parent 1264 650132956801
child 1266 4522fd38deef
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1005
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
     1
"{ Package: 'stx:libbasic2' }"
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
     2
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
     3
HierarchicalURI subclass:#FtpURI
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
     4
	instanceVariableNames:''
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
     5
	classVariableNames:''
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
     6
	poolDictionaries:''
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
     7
	category:'Resources'
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
     8
!
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
     9
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    10
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    11
!FtpURI class methodsFor:'accessing'!
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    12
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    13
schemes
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    14
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    15
    ^ #(ftp)
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    16
! !
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    17
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    18
!FtpURI methodsFor:'defaults'!
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    19
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    20
defaultPassword
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    21
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    22
    ^ 'secret@secret'
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    23
!
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    24
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    25
defaultPort
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    26
    "answer the default command-port here"
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    27
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    28
    ^ 21
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    29
!
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    30
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    31
defaultUser
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    32
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    33
    ^ 'anonymous'
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    34
! !
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    35
1258
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    36
!FtpURI methodsFor:'ftp requests'!
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    37
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    38
connectThenDo:aOneArgBlock
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    39
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    40
    |ftp|
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    41
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    42
    ftp := FTPClient new.
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    43
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    44
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    45
    [
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    46
        ftp connectTo:self host 
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    47
            port:self port 
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    48
            user:(self user ? self defaultUser)
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    49
            password:(self password ? self defaultPassword).
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    50
        aOneArgBlock value:ftp
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    51
    ] ensure:[
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    52
        ftp notNil ifTrue:[
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    53
            ftp close.
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    54
        ].
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    55
    ]
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    56
!
1254
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
    57
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
    58
pathExists
1258
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    59
    "establish a connection for try to get a readSteream"
1254
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
    60
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
    61
    |exists|
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
    62
1258
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    63
    self connectThenDo:[:aFtpClient|
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    64
        exists := self pathExistsFtp:aFtpClient.
1254
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
    65
    ].
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
    66
1258
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    67
    ^ exists ? false
1254
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
    68
1258
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    69
"
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    70
    |pwd uri|
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    71
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    72
    pwd := Dialog requestPassword:'Password:'. 
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    73
    uri := (URI fromString:('ftp://tm:%1@exept/home/tm/tmp/test.txt' bindWith:pwd) ).
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    74
    uri pathExists
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    75
"
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    76
!
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    77
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    78
pathExists:aPathname ftpClient:aFtpClient
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    79
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    80
    |list|
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    81
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    82
    list := aFtpClient list:aPathname.
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    83
    ^ list contains:[:aLine| (aLine asCollectionOfWords last) = aPathname ] 
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    84
!
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    85
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    86
pathExistsFtp:aFtpClient
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    87
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    88
    ^ self pathExists:self path ftpClient:aFtpClient
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    89
! !
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
    90
1005
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    91
!FtpURI methodsFor:'stream access'!
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    92
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    93
readStreamDo:aBlock
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    94
    "use FTPClient for now"
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
    95
1254
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
    96
    self connectThenDo:[:ftp| |stream path attributes|
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
    97
        [
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
    98
            path := self path.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
    99
            attributes := self class attributes.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   100
            attributes at:#fileSize put:(ftp sizeOf:path).
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   101
            attributes at:#baseName put:self pathSegements last.  
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   102
            attributes at:#uriInfo  put:self printString.  
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   103
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   104
            stream := ftp getStreamFor:path.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   105
            aBlock value:stream value:attributes.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   106
        ] ensure:[
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   107
            stream notNil ifTrue:[
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   108
                stream close.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   109
            ].
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   110
        ].
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   111
    ].
1005
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
   112
1254
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   113
    "
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   114
     'ftp://stefan:mschrat.14@hippo/etc/group' asURI readStreamDo:[:stream :attributes | 
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   115
         self halt
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   116
      ].
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   117
    "
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   118
!
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   119
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   120
readStreamsDo:aBlock
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   121
    "evaluate the block with a Collection of streams as first argument
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   122
     and a dictionary containing attributes as second argument,
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   123
     - a collection with a stream on a single file,
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   124
     - or a collection with streams on a directorie's files, but not recursive
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   125
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   126
     The streams are closed after aBlock has been evaluated.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   127
     Attributes may be the mime type (key #MIME)"
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   128
1264
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   129
    self readStreamsDo:aBlock skipFilenamesWithSuffix:nil thenRemove:false
1258
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   130
!
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   131
1264
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   132
readStreamsDo:aBlock skipFilenamesWithSuffix:aSuffix thenRemove:doRemoveSource
1258
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   133
    "evaluate the block with a Collection of streams as first argument
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   134
     and a dictionary containing attributes as second argument,
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   135
     - a collection with a stream on a single file,
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   136
     - or a collection with streams on a directorie's files, but not recursive
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   137
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   138
     The streams are closed after aBlock has been evaluated.
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   139
     Attributes may be the mime type (key #MIME)"
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   140
1254
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   141
    |attributes list requestDirectory path|
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   142
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   143
    requestDirectory := false.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   144
    path := self path.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   145
    attributes := self class attributes.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   146
    list := OrderedCollection new.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   147
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   148
    self connectThenDo:[:ftp|
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   149
        FTPClient fileErrorSignal handle:[:ex|
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   150
            list add:path.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   151
            attributes at:#requestDirectory put:false.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   152
        ] do:[
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   153
            ftp cd:path.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   154
            requestDirectory := true.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   155
            attributes at:#requestDirectory put:true.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   156
            list addAll:((ftp list) collect:[:aLine| aLine asCollectionOfWords last]).
1005
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
   157
        ].
1254
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   158
1264
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   159
        requestDirectory ifFalse:[ |bName|
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   160
            bName := self pathSegements last.
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   161
            (bName startsWith:'*') ifTrue:[
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   162
                list removeAll.
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   163
                requestDirectory := true.
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   164
                attributes at:#requestDirectory put:true.
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   165
                ftp cd:(path asFilename directory) pathName.
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   166
                list addAll:((ftp list) collect:[:aLine| aLine asCollectionOfWords last]).
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   167
            ].
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   168
            (bName startsWith:'*.') ifTrue:[ |rest|
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   169
                rest := bName restAfter:$*.
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   170
                (rest includesString:'*') ifTrue:[
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   171
                    self error:'can''t resolve path:', self printString
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   172
                ].
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   173
                list := list select:[:str| str endsWith:rest ]
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   174
            ].
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   175
        ].
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   176
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   177
        aSuffix size ~~ 0 ifTrue:[
1265
f0ea5f786b16 *** empty log message ***
tm
parents: 1264
diff changeset
   178
            list := list select:[:str| (str endsWith:aSuffix) not ]
1264
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   179
        ].
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   180
1254
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   181
        list do:[:aPathName| |baseName stream|
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   182
            FTPClient fileErrorSignal handle:[:ex| 
1258
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   183
                "/ skip subdirectories and the summary of the list
1254
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   184
            ] do:[
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   185
                stream := ftp getStreamFor:aPathName.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   186
                attributes at:#fileSize put:(ftp sizeOf:aPathName).
1258
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   187
                requestDirectory 
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   188
                    ifTrue:[  baseName := aPathName ] 
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   189
                    ifFalse:[ baseName := self pathSegements last ].
1254
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   190
                attributes at:#baseName put:baseName
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   191
            ].
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   192
1258
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   193
            stream notNil ifTrue:[ |src srcPath|
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   194
                (self pathSegements includes:baseName) ifTrue:[ 
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   195
                    srcPath := self path.
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   196
                    attributes at:#uriInfo put:self.  
1254
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   197
                ] ifFalse:[
1258
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   198
                    src := ((self copy) addComponent:baseName).
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   199
                    srcPath := src path.
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   200
                    attributes at:#uriInfo put:src.  
1254
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   201
                ].
1258
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   202
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   203
                [ aBlock value:stream value:attributes ] 
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   204
                    ensure:[ stream close ].
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   205
                doRemoveSource == true ifTrue:[ 
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   206
                    ftp delete:srcPath.
a0eda4db4dad fileTransfer
tm
parents: 1254
diff changeset
   207
                ].
1254
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   208
            ].
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   209
        ].
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   210
    ].
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   211
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   212
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   213
    "
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   214
        |pwd|
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   215
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   216
        pwd := Dialog requestPassword:''. 
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   217
        (URI fromString:('ftp://tm:%1@exept/home/tm/tmp' bindWith:pwd) ) 
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   218
            readStreamsDo:[:stream :attributes | 
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   219
                Transcript showCR:(attributes at:#baseName).
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   220
                Transcript showCR:(attributes at:#fileSize).
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   221
                Transcript showCR:(attributes at:#requestDirectory).
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   222
                Transcript showCR:(attributes at:#uriInfo).
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   223
            ].
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   224
    "
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   225
!
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   226
1264
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   227
readStreamsDo:aBlock thenRemove:doRemoveSource
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   228
    "evaluate the block with a Collection of streams as first argument
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   229
     and a dictionary containing attributes as second argument,
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   230
     - a collection with a stream on a single file,
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   231
     - or a collection with streams on a directorie's files, but not recursive
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   232
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   233
     The streams are closed after aBlock has been evaluated.
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   234
     Attributes may be the mime type (key #MIME)"
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   235
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   236
    self readStreamsDo:aBlock skipFilenamesWithSuffix:nil thenRemove:doRemoveSource
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   237
!
650132956801 allow '*' and '*.' in path
tm
parents: 1258
diff changeset
   238
1254
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   239
writeStreamDo:aBlock
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   240
    "use FTPClient for now"
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   241
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   242
    self connectThenDo:[:ftp| |stream|
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   243
        [
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   244
            ftp connectTo:self host 
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   245
                port:self port 
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   246
                user:(self user ? self defaultUser)
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   247
                password:(self password ? self defaultPassword).
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   248
            stream := ftp putStreamFor:self path.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   249
            aBlock value:stream value:self class attributes.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   250
        ] ensure:[
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   251
            stream notNil ifTrue:[
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   252
                stream close.
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   253
            ].
1005
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
   254
        ].
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
   255
    ]
1254
baf01931b9d6 *** empty log message ***
tm
parents: 1005
diff changeset
   256
1005
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
   257
    "
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
   258
     'ftp://stefan:mschrat.14@hippo/etc/group' asURI readStreamDo:[:stream :attributes | 
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
   259
         self halt
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
   260
      ].
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
   261
    "
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
   262
! !
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
   263
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
   264
!FtpURI class methodsFor:'documentation'!
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
   265
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
   266
version
1265
f0ea5f786b16 *** empty log message ***
tm
parents: 1264
diff changeset
   267
    ^ '$Header: /cvs/stx/stx/libbasic2/FtpURI.st,v 1.5 2003-07-10 10:24:21 tm Exp $'
1005
7ed6fa7ccfba initial checkin
Stefan Vogel <sv@exept.de>
parents:
diff changeset
   268
! !