SystemOrganization addCategory: #'FTP-Server'! SystemOrganization addCategory: #'FTP-Command'! SystemOrganization addCategory: #'FTP-Command-Session'! SystemOrganization addCategory: #'FTP-Command-Navigation'! SystemOrganization addCategory: #'FTP-Command-Transfer'! SystemOrganization addCategory: #'FTP-Command-Information'! SystemOrganization addCategory: #'FTP-Command-Settings'! SystemOrganization addCategory: #'FTP-Context'! SystemOrganization addCategory: #'FTP-Context-Filestystem'! SystemOrganization addCategory: #'FTP-Context-Image'! SystemOrganization addCategory: #'FTP-Tests'! Notification subclass: #FTPCurrentSession instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Server'! !FTPCurrentSession class methodsFor: 'as yet unclassified' stamp: 'lr 8/20/2005 15:46'! value ^ self signal.! ! !FTPCurrentSession class methodsFor: 'as yet unclassified' stamp: 'lr 8/20/2005 15:46'! use: aSession during: aBlock ^ aBlock on: self do: [ :err | err resume: aSession ].! ! TestCase subclass: #FTPTestCase instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Tests'! FTPTestCase subclass: #FTPRequestTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Tests'! !FTPRequestTest methodsFor: 'testing' stamp: 'lr 8/18/2005 10:27'! testCommand self assert: (FTPRequest readFrom: 'foo') command = 'foo'. self assert: (FTPRequest readFrom: 'Foo') command = 'foo'. self assert: (FTPRequest readFrom: 'FOO') command = 'foo'.! ! !FTPRequestTest methodsFor: 'testing' stamp: 'lr 8/18/2005 10:22'! testParseLinefeed self assert: (FTPRequest readFrom: 'a b') command = 'a'. self assert: (FTPRequest readFrom: 'a b') argument = 'b'. self assert: (FTPRequest readFrom: 'a b' , String lf) command = 'a'. self assert: (FTPRequest readFrom: 'a b' , String lf) argument = 'b'. self assert: (FTPRequest readFrom: 'a b' , String crlf) command = 'a'. self assert: (FTPRequest readFrom: 'a b' , String crlf) argument = 'b'.! ! !FTPRequestTest methodsFor: 'testing' stamp: 'lr 8/18/2005 10:27'! testNoArgument self assert: (FTPRequest readFrom: 'a') command = 'a'. self assert: (FTPRequest readFrom: 'a') argument = ''.! ! FTPTestCase subclass: #FTPResponseTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Tests'! !FTPResponseTest methodsFor: 'testing' stamp: 'lr 8/19/2005 10:58'! testCode self assert: (FTPResponse code: 201) code = 201. self assert: (FTPResponse code: 202 description: 'FTP') code = 202.! ! !FTPResponseTest methodsFor: 'testing' stamp: 'lr 8/19/2005 11:04'! testStream self assertStreamOutput: [ :s | (FTPResponse code: 201) writeOn: s ] equals: '201 OK' , String crlf. self assertStreamOutput: [ :s | (FTPResponse code: 202 description: 'FTP') writeOn: s ] equals: '202 FTP' , String crlf. self assertStreamOutput: [ :s | (FTPResponse code: 203 lines: #( 'foo' 'bar' 'zrk' )) writeOn: s ] equals: '203-foo' , String crlf , '203-bar' , String crlf , '203 zrk' , String crlf.! ! !FTPResponseTest methodsFor: 'testing' stamp: 'lr 8/19/2005 11:02'! testLines self assert: (FTPResponse code: 201) lines = #( 'OK' ). self assert: (FTPResponse code: 202 description: 'FTP') lines = #( 'FTP' ). self assert: (FTPResponse code: 203 lines: #( 'foo' 'bar' )) lines = #( 'foo' 'bar' ).! ! !FTPTestCase methodsFor: 'comparing' stamp: 'lr 8/18/2005 10:16'! assertStreamOutput: aBlock equals: aString | stream | aBlock value: (stream := String new writeStream). self assert: stream contents = aString.! ! Object subclass: #FTPMessage instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Server'! FTPMessage subclass: #FTPRequest instanceVariableNames: 'command argument' classVariableNames: '' poolDictionaries: '' category: 'FTP-Server'! !FTPRequest methodsFor: 'accessing' stamp: 'lr 8/18/2005 09:49'! command ^ command! ! !FTPRequest methodsFor: 'initialization' stamp: 'lr 8/19/2005 13:34'! setCommand: aString command := aString asUppercase.! ! !FTPRequest methodsFor: 'printing' stamp: 'lr 8/19/2005 13:36'! writeOn: aStream ident: aString aStream nextPutAll: aString; nextPutAll: command. aStream space; nextPutAll: self argument. aStream nextPutAll: String crlf; flush.! ! !FTPRequest class methodsFor: 'instance creation' stamp: 'lr 8/19/2005 13:34'! readFrom: aStream | line | line := aStream upTo: Character lf. (line notEmpty and: [ line last = Character cr ]) ifTrue: [ line := line allButLast ]. ^ self new setCommand: (line copyUpTo: $ ); setArgument: (line copyAfter: $ ); yourself.! ! !FTPRequest methodsFor: 'accessing' stamp: 'lr 8/18/2005 09:49'! argument ^ argument! ! !FTPRequest methodsFor: 'printing' stamp: 'lr 8/19/2005 13:31'! logOn: aStream self writeOn: aStream ident: '>> '.! ! !FTPRequest methodsFor: 'accessing-dynamic' stamp: 'lr 8/19/2005 14:33'! normalized ^ self argument withBlanksTrimmed asUppercase.! ! !FTPRequest methodsFor: 'printing' stamp: 'lr 8/18/2005 09:51'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' command: '; print: self command. aStream nextPutAll: ' argument: '; print: self argument.! ! !FTPRequest methodsFor: 'initialization' stamp: 'lr 8/19/2005 14:31'! setArgument: aString argument := aString! ! !FTPMessage methodsFor: 'printing' stamp: 'lr 8/19/2005 13:30'! writeOn: aStream self writeOn: aStream ident: String new.! ! FTPMessage subclass: #FTPResponse instanceVariableNames: 'code lines' classVariableNames: '' poolDictionaries: '' category: 'FTP-Server'! !FTPResponse class methodsFor: 'rejecting' stamp: 'lr 8/19/2005 18:28'! invalidParamter "The server does not like the format of the parameter." ^ self code: 501 line: 'Invalid parameter format'.! ! !FTPResponse class methodsFor: 'instance creation' stamp: 'lr 8/19/2005 14:19'! code: anInteger line: aString ^ self code: anInteger lines: (Array with: aString).! ! !FTPResponse class methodsFor: 'instance creation' stamp: 'lr 8/19/2005 10:56'! code: anInteger lines: aCollection ^ self new setCode: anInteger; setLines: aCollection; yourself.! ! !FTPResponse class methodsFor: 'rejecting' stamp: 'lr 8/19/2005 18:27'! unsupportedCommand "The server recognized the verb but does not support it." ^ self code: 502 line: 'Unsupported command'.! ! !FTPResponse methodsFor: 'actions' stamp: 'lr 8/19/2005 10:54'! add: aString self lines add: aString.! ! !FTPResponse class methodsFor: 'instance creation' stamp: 'lr 8/19/2005 14:19'! code: anInteger ^ self code: anInteger line: 'OK'. ! ! !FTPResponse class methodsFor: 'errors' stamp: 'lr 8/19/2005 18:29'! notFound ^ self code: 550 line: 'No such file or directory'.! ! !FTPResponse class methodsFor: 'rejecting' stamp: 'lr 8/19/2005 18:28'! invalidCommand "The server does not like the command." ^ self code: 500 line: 'Invalid command'.! ! !FTPResponse class methodsFor: 'instance creation' stamp: 'lr 8/19/2005 19:21'! code: anInteger string: aString ^ self code: anInteger lines: (aString findTokens: Character cr).! ! !FTPResponse class methodsFor: 'errors' stamp: 'lr 8/19/2005 14:21'! error: aString "The request violated some internal parsing rule in the server." ^ self code: 500 line: aString.! ! !FTPResponse methodsFor: 'printing' stamp: 'lr 8/19/2005 13:31'! logOn: aStream self writeOn: aStream ident: '<< '.! ! !FTPResponse class methodsFor: 'accepting' stamp: 'lr 8/19/2005 14:22'! ready ^ self code: 220 line: 'SqueakFTP ready'.! ! !FTPResponse methodsFor: 'printing' stamp: 'lr 8/19/2005 13:20'! writeOn: aStream ident: aString 1 to: self lines size do: [ :index | aStream nextPutAll: aString; print: self code. aStream nextPut: (self lines size = index ifTrue: [ $ ] ifFalse: [ $- ]). aStream nextPutAll: (self lines at: index). aStream nextPutAll: String crlf ]. aStream flush.! ! !FTPResponse methodsFor: 'printing' stamp: 'lr 8/19/2005 10:54'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' code: '; print: self code. aStream nextPutAll: ' lines: '; print: self lines.! ! !FTPResponse methodsFor: 'initialization' stamp: 'lr 8/19/2005 10:54'! setCode: aNumber code := aNumber! ! !FTPResponse class methodsFor: 'accepting' stamp: 'lr 8/18/2005 09:21'! okay ^ self code: 200.! ! !FTPResponse methodsFor: 'accessing' stamp: 'lr 8/19/2005 10:49'! code ^ code! ! !FTPResponse methodsFor: 'initialization' stamp: 'lr 8/19/2005 10:53'! setLines: aCollection lines := aCollection! ! !FTPResponse class methodsFor: 'rejecting' stamp: 'lr 8/19/2005 14:22'! unsupportedParameter "The server supports the verb but does not support the parameter." ^ self code: 504 line: 'Unsupported parameter'.! ! !FTPResponse methodsFor: 'accessing' stamp: 'lr 8/19/2005 10:49'! lines ^ lines! ! !FTPMessage methodsFor: 'printing' stamp: 'lr 8/19/2005 13:30'! writeOn: aStream ident: aString self subclassResponsibility.! ! !FTPMessage methodsFor: 'printing' stamp: 'lr 8/19/2005 13:29'! logOn: aStream self subclassResponsibility.! ! Object subclass: #FTPCommand instanceVariableNames: 'session request' classVariableNames: 'Commands' poolDictionaries: '' category: 'FTP-Command'! FTPCommand subclass: #FTPHelpCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Information'! !FTPHelpCommand commentStamp: 'lr 8/19/2005 19:35' prior: 0! A HELP request asks for human-readable information from the server. The server may accept this request with code 211 or 214, or reject it with code 502.! !FTPHelpCommand methodsFor: 'processing' stamp: 'lr 8/19/2005 19:35'! execute self return: (FTPResponse code: 214 string: self context help).! ! !FTPHelpCommand class methodsFor: 'accessing' stamp: 'lr 8/19/2005 19:49'! command ^ 'HELP'! ! FTPCommand subclass: #FTPPwdCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Navigation'! !FTPPwdCommand methodsFor: 'processing' stamp: 'lr 8/23/2005 23:19'! execute self return: (FTPResponse code: 257 line: self context pathString).! ! !FTPPwdCommand class methodsFor: 'accessing' stamp: 'lr 8/19/2005 19:54'! command ^ 'PWD'! ! !FTPCommand methodsFor: 'accessing-dynamic' stamp: 'lr 8/19/2005 14:08'! state ^ self session state.! ! FTPCommand subclass: #FTPStatCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Information'! !FTPStatCommand commentStamp: 'lr 8/19/2005 19:27' prior: 0! A STAT request asks for human-readable information about the server's status. The server normally accepts this request with code 211.! !FTPStatCommand methodsFor: 'processing' stamp: 'lr 8/19/2005 19:27'! execute self return: (FTPResponse code: 211 string: self context statistics).! ! !FTPStatCommand class methodsFor: 'accessing' stamp: 'lr 8/19/2005 19:48'! command ^ 'STAT'! ! FTPCommand subclass: #FTPAlloCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command'! FTPCommand subclass: #FTPTypeCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Settings'! !FTPTypeCommand commentStamp: 'lr 8/19/2005 14:13' prior: 0! The server keeps track of a binary flag for the client. At any moment, the binary flag is either on or off. At the beginning of the FTP connection, the binary flag is off. A - Turn the binary flag off. A N - Turn the binary flag off. I - Turn the binary flag on. L 8 - Turn the binary flag on.! !FTPTypeCommand methodsFor: 'accessing' stamp: 'lr 8/19/2005 14:17'! binaryArguments ^ #( 'I' 'L 8' )! ! !FTPTypeCommand methodsFor: 'processing' stamp: 'lr 8/19/2005 14:34'! execute (self binaryArguments includes: self request normalized) ifTrue: [ self binary ]. (self asciiArguments includes: self request normalized) ifTrue: [ self ascii ]. self return: FTPResponse invalidParamter.! ! !FTPTypeCommand methodsFor: 'processing' stamp: 'lr 8/19/2005 14:19'! binary self state binary: true. self return: (FTPResponse code: 200 line: 'set to binary').! ! !FTPTypeCommand methodsFor: 'accessing' stamp: 'lr 8/19/2005 14:17'! asciiArguments ^ #( 'A' 'A N' )! ! !FTPTypeCommand class methodsFor: 'accessing' stamp: 'lr 8/19/2005 19:51'! command ^ 'TYPE'! ! !FTPTypeCommand methodsFor: 'processing' stamp: 'lr 8/19/2005 14:20'! ascii self state binary: false. self return: (FTPResponse code: 200 line: 'set to ascii').! ! !FTPCommand methodsFor: 'initialization' stamp: 'lr 8/19/2005 13:54'! setRequest: aRequest request := aRequest! ! FTPCommand subclass: #FTPRmdCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command'! FTPCommand subclass: #FTPPassCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Session'! !FTPPassCommand commentStamp: '' prior: 0! A PASS request has a parameter called a password. The client must not send a PASS request except immediately after a USER request. The server may accept PASS with code 230, meaning that permission to access files under this username has been granted; or with code 202, meaning that permission was already granted in response to USER; or with code 332, meaning that permission might be granted after an ACCT request. The server may reject PASS with code 503 if the previous request was not USER or with code 530 if this username and password are jointly unacceptable.! !FTPPassCommand class methodsFor: 'accessing' stamp: 'lr 8/19/2005 19:50'! command ^ 'PASS'! ! !FTPPassCommand methodsFor: 'processing' stamp: 'lr 8/20/2005 16:15'! execute self state password: self request argument. self context updateAuthentication. self return: (FTPResponse code: 230).! ! FTPCommand subclass: #FTPCdupCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Navigation'! !FTPCdupCommand commentStamp: 'lr 8/19/2005 18:05' prior: 0! A CDUP request asks the server to remove the last slash, and everything following it, from the name prefix. If this produces an empty name prefix, the new name prefix is a single slash. CDUP parameters are prohibited. The server may accept a CDUP request using code 200 or 250. (RFC 959 says that code 200 is required; but it also says that CDUP uses the same codes as CWD.) The server may reject a CDUP request using code 550.! !FTPCdupCommand methodsFor: 'processing' stamp: 'lr 8/19/2005 18:29'! execute self context hasParent ifFalse: [ self return: FTPResponse notFound ]. self context: self context parent. self return: FTPResponse okay.! ! !FTPCdupCommand class methodsFor: 'accessing' stamp: 'lr 8/19/2005 19:52'! command ^ 'CDUP'! ! FTPCommand subclass: #FTPStruCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Settings'! !FTPStruCommand commentStamp: 'lr 8/19/2005 13:58' prior: 0! STRU is obsolete. The server should accept STRU F (in any combination of lowercase and uppercase) with code 200, and reject all other STRU attempts with code 504.! !FTPStruCommand methodsFor: 'processing' stamp: 'lr 8/19/2005 14:34'! execute self session returnResponse: (self request normalized = 'F' ifFalse: [ FTPResponse unsupportedParameter ] ifTrue: [ FTPResponse okay ]).! ! !FTPStruCommand class methodsFor: 'accessing' stamp: 'lr 8/19/2005 19:51'! command ^ 'STRU'! ! FTPCommand subclass: #FTPPortCommand instanceVariableNames: 'numbers' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Settings'! !FTPPortCommand class methodsFor: 'accessing' stamp: 'lr 8/19/2005 19:51'! command ^ 'PORT'! ! !FTPPortCommand methodsFor: 'private' stamp: 'lr 8/19/2005 19:12'! parseArgument numbers := self request argument findTokens: $,. (numbers size = 6 and: [ numbers allSatisfy: [ :each | each isAllDigits ] ]) ifFalse: [ self return: FTPResponse unsupportedParameter ]. numbers := numbers collect: [ :each | each asInteger ]. (numbers allSatisfy: [ :each | each between: 0 and: 256 ]) ifFalse: [ self return: FTPResponse invalidParamter ].! ! !FTPPortCommand methodsFor: 'processing' stamp: 'lr 8/19/2005 19:13'! execute self parseArgument. self state passive: false; ip: (ByteArray with: numbers first with: numbers second with: numbers third with: numbers fourth); port: numbers fifth * 256 + numbers sixth. self return: FTPResponse okay.! ! FTPCommand subclass: #FTPFileCommand instanceVariableNames: 'target' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command'! FTPFileCommand subclass: #FTPCwdCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Navigation'! !FTPCwdCommand commentStamp: 'lr 8/19/2005 18:33' prior: 0! A CWD request has a nonempty parameter giving an encoded pathname. It asks the server to set the name prefix to this pathname, or to another pathname that will have the same effect as this pathname if the filesystem does not change. The server may accept a CWD request using code 200 or 250. The server may reject a CWD request using code 550.! !FTPCwdCommand methodsFor: 'processing' stamp: 'lr 8/23/2005 23:16'! execute self checkTarget: #isDirectoryContext. self context: self target; return: FTPResponse okay.! ! !FTPCwdCommand class methodsFor: 'accessing' stamp: 'lr 8/19/2005 19:51'! command ^ 'CWD'! ! !FTPFileCommand methodsFor: 'initialization' stamp: 'lr 8/23/2005 23:11'! setRequest: aRequest super setRequest: aRequest. self setTarget: (self context lookup: aRequest argument).! ! !FTPFileCommand methodsFor: 'initialization' stamp: 'lr 8/23/2005 22:44'! setTarget: aContext target := aContext! ! !FTPFileCommand methodsFor: 'checking' stamp: 'lr 8/23/2005 23:15'! checkTarget: aSelector (self target notNil and: [ self target perform: aSelector ]) ifFalse: [ self return: FTPResponse notFound ].! ! FTPFileCommand subclass: #FTPRetrCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Transfer'! !FTPRetrCommand commentStamp: 'lr 8/23/2005 22:00' prior: 0! A RETR request asks the server to send the contents of a file over the data connection already established by the client. The RETR parameter is an encoded pathname of the file. The file is either a binary file or a text file, depending on the most recent TYPE request. Normally the server responds with a mark using code 150. It then stops accepting new connections, attempts to send the contents of the file over the data connection, and closes the data connection. Finally it - accepts the RETR request with code 226 if the entire file was successfully written to the server's TCP buffers; - rejects the RETR request with code 425 if no TCP connection was established; - rejects the RETR request with code 426 if the TCP connection was established but then broken by the client or by network failure; or rejects the RETR request with code 451 or 551 if the server had trouble reading the file from disk. The server is obliged to close the data connection in each of these cases. The client is not expected to look for a response from the server until the client sees that the data connection is closed.! !FTPRetrCommand methodsFor: 'processing' stamp: 'lr 8/23/2005 23:17'! execute self checkTarget: #isFileContext. (FTPResponse code: 150) writeOn: self connection stream. self session withStreamDo: [ :stream | stream nextPutAll: target contents; flush ]. self return: (FTPResponse code: 226).! ! !FTPRetrCommand class methodsFor: 'accessing' stamp: 'lr 8/23/2005 22:50'! command ^ 'RETR'! ! FTPFileCommand subclass: #FTPStorCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Transfer'! !FTPStorCommand commentStamp: 'lr 8/23/2005 23:28' prior: 0! A STOR request asks the server to read the contents of a file from the data connection already established by the client. The STOR parameter is an encoded pathname of the file. The file is either a binary file or a text file, depending on the most recent TYPE request. If the server is willing to create a new file under that name, or replace an existing file under that name, it responds with a mark using code 150. It then stops accepting new connections, attempts to read the contents of the file from the data connection, and closes the data connection. Finally it - accepts the STOR request with code 226 if the entire file was successfully received and stored; - rejects the STOR request with code 425 if no TCP connection was established; - rejects the STOR request with code 426 if the TCP connection was established but then broken by the client or by network failure; or - rejects the STOR request with code 451, 452, or 552 if the server had trouble saving the file to disk. The server may reject the STOR request (code 450, 452, or 553) without first responding with a mark. In this case the server does not touch the data connection.! !FTPStorCommand class methodsFor: 'accessing' stamp: 'lr 8/23/2005 22:50'! command ^ 'STOR'! ! !FTPStorCommand methodsFor: 'processing' stamp: 'lr 8/23/2005 23:17'! execute self checkTarget: #isFileContext. (FTPResponse code: 150) writeOn: self connection stream. self session withStreamDo: [ :stream | target contents: stream upToEnd ]. self return: (FTPResponse code: 226).! ! !FTPFileCommand methodsFor: 'accessing' stamp: 'lr 8/23/2005 23:12'! target ^ target! ! FTPCommand subclass: #FTPMkdCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command'! !FTPCommand class methodsFor: 'instance-creation' stamp: 'lr 8/19/2005 19:52'! in: aSession for: aRequest ifAbsent: aBlock | class | class := self allSubclasses detect: [ :each | aRequest command = each command ] ifNone: [ ^ aBlock value ]. ^ class new setSession: aSession; setRequest: aRequest; yourself.! ! FTPCommand subclass: #FTPNlstCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Navigation'! !FTPNlstCommand commentStamp: 'lr 8/19/2005 19:04' prior: 0! A directory is a list of files. It typically includes a name, type, size, and modification time of each file. The difference between LIST and NLST is that NLST returns a compressed form of the directory, showing only the name of each file, while LIST returns the entire directory.! !FTPNlstCommand methodsFor: 'printing' stamp: 'lr 8/22/2005 09:16'! printChild: aContext on: aStream aStream nextPutAll: aContext name.! ! !FTPNlstCommand methodsFor: 'processing' stamp: 'lr 8/22/2005 09:15'! execute (FTPResponse code: 150) writeOn: self connection stream. self session withStreamDo: [ :stream | self context children do: [ :each | self printChild: each on: stream. stream crlf ]. stream flush ]. self return: (FTPResponse code: 226).! ! !FTPNlstCommand class methodsFor: 'accessing' stamp: 'lr 8/19/2005 19:51'! command ^ 'NLST'! ! FTPNlstCommand subclass: #FTPListCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Navigation'! !FTPListCommand methodsFor: 'printing' stamp: 'lr 8/23/2005 23:45'! printChild: aContext on: aStream aStream nextPut: $+; nextPut: $s; print: aContext size. aContext isDirectoryContext ifTrue: [ aStream nextPutAll: ',/' ]. aContext isFileContext ifTrue: [ aStream nextPutAll: ',r' ]. aStream nextPut: Character tab. super printChild: aContext on: aStream.! ! !FTPListCommand class methodsFor: 'accessing' stamp: 'lr 8/19/2005 19:51'! command ^ 'LIST' ! ! !FTPCommand methodsFor: 'accessing-dynamic' stamp: 'lr 8/19/2005 18:52'! context: aContext ^ self session context: aContext.! ! !FTPCommand methodsFor: 'accessing-dynamic' stamp: 'lr 8/19/2005 14:08'! context ^ self session context.! ! FTPCommand subclass: #FTPModeCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Settings'! !FTPModeCommand commentStamp: 'lr 8/19/2005 13:57' prior: 0! MODE is obsolete. The server should accept MODE S (in any combination of lowercase and uppercase) with code 200, and reject all other MODE attempts with code 504.! !FTPModeCommand methodsFor: 'processing' stamp: 'lr 8/19/2005 14:34'! execute self session returnResponse: (self request normalized = 'S' ifFalse: [ FTPResponse unsupportedParameter ] ifTrue: [ FTPResponse okay ]).! ! FTPCommand subclass: #FTPNoopCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Information'! !FTPNoopCommand commentStamp: 'lr 8/19/2005 13:53' prior: 0! This command does not affect any parameters or previously entered commands. It specifies no action other than that the server send an OK reply.! !FTPNoopCommand class methodsFor: 'accessing' stamp: 'lr 8/19/2005 19:48'! command ^ 'NOOP'! ! !FTPNoopCommand methodsFor: 'processing' stamp: 'lr 8/21/2005 14:32'! execute self return: FTPResponse okay.! ! FTPCommand subclass: #FTPRntoCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command'! FTPCommand subclass: #FTPDeleCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command'! !FTPCommand methodsFor: 'initialization' stamp: 'lr 8/19/2005 13:54'! setSession: aSession session := aSession! ! !FTPCommand methodsFor: 'accessing-dynamic' stamp: 'lr 8/20/2005 16:11'! connection ^ self session connection.! ! FTPCommand subclass: #FTPQuitCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Session'! !FTPQuitCommand commentStamp: 'lr 8/19/2005 13:45' prior: 0! This command terminates a USER and if file transfer is not in progress, the server closes the control connection. If file transfer is in progress, the connection will remain open for result response and the server will then close it. If the user-process is transferring files for several USERs but does not wish to close and then reopen connections for each, then the REIN command should be used instead of QUIT. An unexpected close on the control connection will cause the server to take the effective action of an abort (ABOR) and a logout (QUIT).! !FTPQuitCommand class methodsFor: 'accessing' stamp: 'lr 8/19/2005 19:50'! command ^ 'QUIT'! ! !FTPQuitCommand methodsFor: 'processing' stamp: 'lr 8/19/2005 14:37'! execute self session connection close.! ! FTPCommand subclass: #FTPSystCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Information'! !FTPSystCommand commentStamp: 'lr 8/19/2005 19:26' prior: 0! A SYST request asks for information about the server's operating system. The server accepts this request with code 215.! !FTPSystCommand class methodsFor: 'accessing' stamp: 'lr 8/19/2005 19:48'! command ^ 'SYST'! ! !FTPSystCommand methodsFor: 'processing' stamp: 'lr 8/19/2005 19:28'! execute self return: (FTPResponse code: 215 string: self context system).! ! !FTPCommand methodsFor: 'accessing' stamp: 'lr 8/19/2005 10:39'! request ^ request! ! FTPCommand subclass: #FTPStouCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command'! FTPCommand subclass: #FTPRnfrCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command'! !FTPCommand methodsFor: 'commands' stamp: 'lr 8/19/2005 10:44'! return: aResponse ^ self session returnResponse: aResponse.! ! FTPCommand subclass: #FTPAppeCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command'! !FTPCommand class methodsFor: 'accessing' stamp: 'lr 8/19/2005 19:50'! command ^ nil! ! !FTPCommand methodsFor: 'processing' stamp: 'lr 8/19/2005 17:56'! execute self subclassResponsibility.! ! !FTPCommand methodsFor: 'accessing-dynamic' stamp: 'lr 8/19/2005 14:44'! server ^ self session server.! ! FTPCommand subclass: #FTPUserCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Session'! !FTPUserCommand commentStamp: '' prior: 0! A USER request has a parameter showing a username. Subsequent pathnames are interpreted relative to this username. The server may accept USER with code 230, meaning that the client has permission to access files under that username; or with code 331 or 332, meaning that permission might be granted after a PASS request. In theory, the server may reject USER with code 530, meaning that the username is unacceptable. In practice, the server does not check the username until after a PASS request.! !FTPUserCommand methodsFor: 'processing' stamp: 'lr 8/20/2005 16:15'! execute self state username: self request argument. self context updateAuthentication. self return: (FTPResponse code: 230).! ! !FTPUserCommand class methodsFor: 'accessing' stamp: 'lr 8/19/2005 19:50'! command ^ 'USER'! ! !FTPCommand methodsFor: 'accessing' stamp: 'lr 8/19/2005 10:45'! session ^ session! ! FTPCommand subclass: #FTPPasvCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Command-Settings'! !FTPPasvCommand commentStamp: '' prior: 0! A PASV request asks the server to accept a data connection on a new TCP port selected by the server. PASV parameters are prohibited. The server normally accepts PASV with code 227. Its response is a single line showing the IP address of the server and the TCP port number where the server is accepting connections. Normally the client will connect to this TCP port, from the same IP address that the client is using for the FTP connection, and then send a RETR request. However, the client may send some other requests first, such as REST. The server must continue to read and respond to requests while it accepts connections. Most operating systems handle this automatically. If the client sends another PASV request, the server normally accepts the new request with a new TCP port. It stops listening for connections on the old port, and drops any connections already made. ! !FTPPasvCommand methodsFor: 'processing' stamp: 'lr 8/20/2005 16:29'! execute self request argument notEmpty ifTrue: [ self return: FTPResponse unsupportedParameter ]. self state passive: true; ip: NetNameResolver localHostAddress; port: 34558. self return: (FTPResponse code: 227 line: (String streamContents: [ :stream | self state ip do: [ :each | stream print: each; nextPut: $, ]. stream print: self state port // 256; nextPut: $,; print: self state port \\ 256 ])).! ! !FTPPasvCommand class methodsFor: 'accessing' stamp: 'lr 8/20/2005 16:24'! command ^ 'PASV'! ! Object subclass: #FTPState instanceVariableNames: 'username password ip port passive binary' classVariableNames: '' poolDictionaries: '' category: 'FTP-Server'! !FTPState methodsFor: 'accessing-transfer' stamp: 'lr 8/17/2005 16:14'! ip: anArray ip := anArray! ! !FTPState methodsFor: 'accessing-transfer' stamp: 'lr 8/17/2005 16:14'! port ^ port! ! !FTPState methodsFor: 'accessing-transfer' stamp: 'lr 8/17/2005 16:14'! port: anInteger port := anInteger! ! !FTPState methodsFor: 'accessing-transfer' stamp: 'lr 8/17/2005 16:14'! ip ^ ip! ! !FTPState methodsFor: 'testing' stamp: 'lr 8/17/2005 18:42'! isBinary ^ self binary.! ! !FTPState methodsFor: 'accessing-authentication' stamp: 'lr 8/17/2005 15:50'! username ^ username! ! !FTPState methodsFor: 'accessing-transfer' stamp: 'lr 8/17/2005 15:55'! binary ^ binary ifNil: [ binary := false ].! ! !FTPState methodsFor: 'accessing-transfer' stamp: 'lr 8/17/2005 18:20'! passive ^ passive ifFalse: [ passive := false ].! ! !FTPState methodsFor: 'accessing-authentication' stamp: 'lr 8/17/2005 15:50'! password: aString password := aString! ! !FTPState methodsFor: 'accessing-transfer' stamp: 'lr 8/17/2005 15:55'! binary: aBoolean binary := aBoolean! ! !FTPState methodsFor: 'accessing-authentication' stamp: 'lr 8/17/2005 15:50'! password ^ password! ! !FTPState methodsFor: 'accessing-authentication' stamp: 'lr 8/17/2005 15:50'! username: aString username := aString! ! !FTPState methodsFor: 'testing' stamp: 'lr 8/17/2005 18:42'! isPassive ^ self passive.! ! !FTPState methodsFor: 'accessing-transfer' stamp: 'lr 8/17/2005 17:50'! passive: aBoolean passive := aBoolean! ! Object subclass: #FTPConnection instanceVariableNames: 'stream' classVariableNames: '' poolDictionaries: '' category: 'FTP-Server'! !FTPConnection methodsFor: 'accessing' stamp: 'lr 8/16/2005 13:54'! stream ^ stream! ! FTPConnection subclass: #FTPActiveConnection instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Server'! !FTPActiveConnection methodsFor: 'actions' stamp: 'lr 8/20/2005 15:30'! run: aBlock aBlock ensure: [ self close ].! ! !FTPConnection methodsFor: 'actions' stamp: 'lr 8/20/2005 14:22'! run: aBlock self subclassResponsibility.! ! !FTPConnection methodsFor: 'actions' stamp: 'lr 8/18/2005 10:30'! close self stream close.! ! !FTPConnection class methodsFor: 'instance-creation' stamp: 'lr 8/20/2005 14:09'! tcp ^ self on: Socket newTCP.! ! !FTPConnection methodsFor: 'actions' stamp: 'lr 8/20/2005 14:16'! open self subclassResponsibility.! ! !FTPConnection methodsFor: 'testing' stamp: 'lr 8/16/2005 14:36'! isConnected ^ self socket isValid and: [ self socket isConnected ].! ! !FTPConnection methodsFor: 'accessing' stamp: 'lr 8/18/2005 10:33'! socket ^ self stream socket.! ! !FTPConnection class methodsFor: 'instance-creation' stamp: 'lr 8/20/2005 14:08'! on: aSocket ^ self new setSocket: aSocket; yourself.! ! FTPConnection subclass: #FTPPassiveConnection instanceVariableNames: 'process' classVariableNames: '' poolDictionaries: '' category: 'FTP-Server'! !FTPPassiveConnection methodsFor: 'actions' stamp: 'lr 8/20/2005 15:25'! run: aBlock process := [ self socket waitForConnectionFor: 60. aBlock ensure: [ self close ] ] fork.! ! !FTPPassiveConnection class methodsFor: 'instance creation' stamp: 'lr 8/19/2005 11:18'! on: aSocket do: aBlock ^ (self on: aSocket) do: aBlock; yourself.! ! !FTPPassiveConnection methodsFor: 'actions' stamp: 'lr 8/20/2005 14:30'! close process terminate. super close.! ! !FTPConnection methodsFor: 'initialization' stamp: 'lr 8/18/2005 10:30'! setSocket: aSocket stream := SocketStream on: aSocket.! ! Object subclass: #FTPServer instanceVariableNames: 'process port priority context listener' classVariableNames: 'Servers' poolDictionaries: '' category: 'FTP-Server'! !FTPServer commentStamp: 'ijp 1/14/2005 19:09' prior: 0! An FTP Server.! !FTPServer class methodsFor: 'instance creation' stamp: 'lr 8/17/2005 17:01'! start ^ self new start; yourself.! ! !FTPServer methodsFor: 'private' stamp: 'lr 11/21/2004 23:16'! destroyListener listener destroy. listener := nil.! ! !FTPServer methodsFor: 'accessing-configuration' stamp: 'lr 8/17/2005 17:00'! defaultBacklog ^ 10.! ! !FTPServer methodsFor: 'accessing-configuration' stamp: 'lr 8/17/2005 17:00'! defaultPort ^ 21.! ! !FTPServer class methodsFor: 'private' stamp: 'lr 11/21/2004 21:35'! addServer: aServer self servers add: aServer.! ! !FTPServer methodsFor: 'accessing' stamp: 'lr 11/21/2004 20:29'! context context isNil ifTrue: [ context := self defaultContext ]. ^context! ! !FTPServer methodsFor: 'accessing-configuration' stamp: 'lr 8/17/2005 17:00'! defaultAcceptTimeout ^ 10.! ! !FTPServer methodsFor: 'accessing' stamp: 'lr 11/21/2004 19:43'! priority: aNumber priority := aNumber. self isRunning ifTrue: [ process priority: aNumber ].! ! !FTPServer class methodsFor: 'private' stamp: 'lr 11/21/2004 21:35'! startUp self servers do: [ :each | each restart ].! ! !FTPServer methodsFor: 'private' stamp: 'lr 11/21/2004 20:53'! destroyProcess process := nil.! ! !FTPServer methodsFor: 'private' stamp: 'lr 11/21/2004 23:56'! createProcess process := Process forContext: [ [ self serverLoop ] ensure: [ self destroyServer ] ] priority: self priority.! ! !FTPServer methodsFor: 'accessing-configuration' stamp: 'lr 8/17/2005 17:00'! defaultPriority ^ Processor userBackgroundPriority.! ! !FTPServer methodsFor: 'private' stamp: 'lr 8/19/2005 10:21'! createSession: aSocket FTPSession new setServer: self; setContext: self context copy; setSocket: aSocket.! ! !FTPServer methodsFor: 'testing' stamp: 'lr 8/16/2005 14:44'! isRunning ^ self process notNil.! ! !FTPServer class methodsFor: 'private' stamp: 'lr 8/17/2005 17:04'! servers ^ Servers ifNil: [ Servers := Set new ].! ! !FTPServer methodsFor: 'private' stamp: 'lr 11/21/2004 21:08'! createServer self createProcess. self createListener.! ! !FTPServer methodsFor: 'accessing-configuration' stamp: 'lr 8/17/2005 17:00'! defaultSessionTimeout ^ 320.! ! !FTPServer class methodsFor: 'instance creation' stamp: 'lr 8/17/2005 17:01'! startOn: aNumber context: aContext ^ self new port: aNumber; context: aContext; start; yourself.! ! !FTPServer methodsFor: 'accessing-readonly' stamp: 'lr 11/21/2004 20:56'! process ^process! ! !FTPServer methodsFor: 'testing' stamp: 'lr 8/16/2005 14:44'! isConnected ^ self listener notNil and: [ self listener isValid ] and: [ self listener isWaitingForConnection ].! ! !FTPServer methodsFor: 'private' stamp: 'lr 11/21/2004 23:16'! createListener listener := Socket newTCP. listener listenOn: self port backlogSize: self defaultBacklog.! ! !FTPServer class methodsFor: 'private' stamp: 'lr 11/21/2004 19:56'! removeServer: aServer self servers remove: aServer.! ! !FTPServer methodsFor: 'accessing' stamp: 'lr 11/21/2004 19:44'! port: aNumber port := aNumber. self isRunning ifTrue: [ self restart ].! ! !FTPServer methodsFor: 'actions' stamp: 'lr 11/21/2004 19:45'! restart self stop; start.! ! !FTPServer methodsFor: 'private' stamp: 'lr 11/21/2004 21:08'! destroyServer self destroyProcess. self destroyListener.! ! !FTPServer methodsFor: 'testing' stamp: 'lr 8/19/2005 11:45'! isLogging ^ true! ! !FTPServer methodsFor: 'accessing' stamp: 'lr 11/21/2004 20:29'! context: aContext context := aContext.! ! !FTPServer class methodsFor: 'instance creation' stamp: 'lr 8/17/2005 17:01'! startOn: aNumber ^ self new port: aNumber; start; yourself.! ! !FTPServer methodsFor: 'actions' stamp: 'lr 11/21/2004 20:56'! stop self isRunning ifFalse: [ ^self ]. self process terminate. self class removeServer: self.! ! !FTPServer methodsFor: 'private' stamp: 'lr 8/20/2005 15:52'! serverLoop [ self serverLoopBody ] repeat.! ! !FTPServer methodsFor: 'actions' stamp: 'lr 11/21/2004 20:56'! start self isRunning ifTrue: [ ^self ]. self createServer. self process resume. self class addServer: self.! ! !FTPServer methodsFor: 'private' stamp: 'lr 11/22/2004 10:19'! serverLoopBody | socket | self isConnected ifFalse: [ self destroyListener; createListener ]. socket := listener waitForAcceptFor: self defaultAcceptTimeout ifTimedOut: [ nil ]. socket notNil ifTrue: [ socket isConnected ifTrue: [ self createSession: socket ] ifFalse: [ socket destroy ] ]. ! ! !FTPServer methodsFor: 'accessing' stamp: 'lr 11/21/2004 19:52'! priority priority isNil ifTrue: [ priority := self defaultPriority ]. ^priority! ! !FTPServer methodsFor: 'accessing' stamp: 'lr 11/21/2004 19:51'! port port isNil ifTrue: [ port := self defaultPort ]. ^port! ! !FTPServer methodsFor: 'printing' stamp: 'lr 8/17/2005 17:47'! printOn: aStream super printOn: aStream. aStream space; nextPutAll: 'port: '; print: self port.! ! !FTPServer class methodsFor: 'class initialization' stamp: 'lr 11/21/2004 21:35'! initialize Smalltalk addToStartUpList: self.! ! !FTPServer methodsFor: 'accessing-configuration' stamp: 'lr 8/17/2005 17:00'! defaultContext ^ FTPFilesystemContext on: (FileDirectory default).! ! !FTPServer methodsFor: 'accessing-readonly' stamp: 'lr 11/21/2004 22:11'! listener ^listener! ! Object subclass: #FTPContext instanceVariableNames: 'parent' classVariableNames: '' poolDictionaries: '' category: 'FTP-Context'! !FTPContext methodsFor: 'accessing' stamp: 'lr 8/19/2005 18:08'! parent ^ parent! ! !FTPContext methodsFor: 'accessing-dynamic' stamp: 'lr 8/20/2005 15:47'! session ^ FTPCurrentSession value.! ! !FTPContext methodsFor: 'convenience' stamp: 'lr 8/22/2005 08:13'! find: aCollection self subclassResponsibility.! ! !FTPContext methodsFor: 'initialization' stamp: 'lr 8/19/2005 18:09'! setParent: aContext parent := aContext! ! !FTPContext methodsFor: 'testing' stamp: 'lr 8/19/2005 18:08'! hasParent ^ self parent notNil.! ! !FTPContext methodsFor: 'convenience' stamp: 'lr 8/23/2005 23:07'! pathString ^ String streamContents: [ :stream | stream nextPut: $"; nextPut: $/. self path allButFirst do: [ :each | stream nextPutAll: each name ] separatedBy: [ stream nextPut: $/ ]. stream nextPut: $" ].! ! !FTPContext methodsFor: 'testing' stamp: 'lr 8/21/2005 15:25'! isFileContext ^ false! ! !FTPContext methodsFor: 'accessing' stamp: 'lr 8/22/2005 09:29'! name self subclassResponsibility.! ! !FTPContext methodsFor: 'testing' stamp: 'lr 8/21/2005 15:25'! isDirectoryContext ^ false! ! !FTPContext methodsFor: 'convenience' stamp: 'lr 8/23/2005 23:25'! lookup: aString | stream name next | aString isEmpty ifTrue: [ ^ self ]. aString first = $/ ifTrue: [ ^ self root lookup: aString allButFirst ]. stream := aString readStream. name := stream upTo: $/. next := name = '..' ifTrue: [ self parent ] ifFalse: [ self at: name ifAbsent: nil ]. ^ next notNil ifTrue: [ next lookup: stream upToEnd ].! ! !FTPContext methodsFor: 'accessing' stamp: 'lr 8/22/2005 09:28'! size self subclassResponsibility.! ! !FTPContext methodsFor: 'accessing-dynamic' stamp: 'lr 8/19/2005 18:15'! path ^ self hasParent ifTrue: [ self parent path add: self; yourself ] ifFalse: [ OrderedCollection with: self ].! ! !FTPContext class methodsFor: 'instance-creation' stamp: 'lr 8/22/2005 08:29'! parent: aContext ^ self new setParent: aContext; yourself.! ! FTPContext subclass: #FTPDirectoryContext instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Context'! !FTPDirectoryContext methodsFor: 'accessing' stamp: 'lr 8/22/2005 08:08'! children self subclassResponsibility.! ! !FTPDirectoryContext methodsFor: 'accessing-information' stamp: 'lr 8/22/2005 08:06'! system ^ SystemVersion current printString.! ! !FTPDirectoryContext methodsFor: 'convenience' stamp: 'lr 8/22/2005 08:53'! find: aCollection aCollection isEmpty ifTrue: [ ^ self ]. ^ (self at: aCollection first ifAbsent: [ ^ nil ]) find: aCollection allButFirst.! ! !FTPDirectoryContext methodsFor: 'events' stamp: 'lr 8/22/2005 08:10'! unknownRequest: aRequest " This message will be sent for any unknown command, sublcasses might override the default implementation to handle additional user defined verbs. " self session returnResponse: FTPResponse invalidCommand.! ! !FTPDirectoryContext methodsFor: 'testing' stamp: 'lr 8/22/2005 09:16'! isDirectoryContext ^ true! ! !FTPDirectoryContext methodsFor: 'accessing-information' stamp: 'lr 8/22/2005 08:06'! statistics ^ SmalltalkImage current vmStatisticsReportString.! ! FTPDirectoryContext subclass: #FTPFilesystemDirectoryContext instanceVariableNames: 'directory' classVariableNames: '' poolDictionaries: '' category: 'FTP-Context-Filestystem'! !FTPFilesystemDirectoryContext methodsFor: 'accessing' stamp: 'lr 8/22/2005 09:36'! timestamp ^ nil! ! !FTPFilesystemDirectoryContext methodsFor: 'accessing' stamp: 'lr 8/22/2005 08:40'! name ^ FileDirectory localNameFor: self directory pathName.! ! !FTPFilesystemDirectoryContext methodsFor: 'accessing' stamp: 'lr 8/22/2005 08:41'! children ^ self directory entries collect: [ :each | each fourth ifTrue: [ (FTPFilesystemDirectoryContext parent: self) setDirectory: (self directory directoryNamed: each first); yourself ] ifFalse: [ (FTPFilesystemFileContext parent: self) setDirectory: self directory; setArray: each; yourself ] ].! ! !FTPFilesystemDirectoryContext methodsFor: 'accessing' stamp: 'lr 8/22/2005 08:37'! directory ^ directory ifNil: [ directory := FileDirectory default ].! ! !FTPFilesystemDirectoryContext methodsFor: 'initialization' stamp: 'lr 8/22/2005 08:21'! setDirectory: aDirectory directory := aDirectory! ! !FTPDirectoryContext methodsFor: 'events' stamp: 'lr 8/22/2005 08:11'! updateAuthentication " This message will be sent whenever a new username or password is given. "! ! !FTPDirectoryContext methodsFor: 'accessing' stamp: 'lr 8/22/2005 09:29'! size ^ 0! ! FTPDirectoryContext subclass: #FTPClassContext instanceVariableNames: 'actualClass' classVariableNames: '' poolDictionaries: '' category: 'FTP-Context-Image'! !FTPClassContext methodsFor: 'accessing-dynamic' stamp: 'lr 8/23/2005 22:38'! timestamp ^ TimeStamp now.! ! !FTPClassContext methodsFor: 'accessing-dynamic' stamp: 'lr 8/23/2005 23:19'! children ^ Array streamContents: [ :stream | self actualClass subclasses do: [ :each | stream nextPut: ((FTPClassContext parent: self) actualClass: each; yourself) ]. self actualClass selectors do: [ :each | stream nextPut: ((FTPMethodContext parent: self) actualClass: self actualClass; selector: each; yourself) ] ].! ! !FTPClassContext methodsFor: 'accessing-dynamic' stamp: 'lr 8/23/2005 23:30'! name ^ self actualClass name.! ! !FTPClassContext methodsFor: 'accessing' stamp: 'lr 8/23/2005 23:19'! actualClass ^ actualClass ifNil: [ actualClass := ProtoObject ].! ! !FTPClassContext methodsFor: 'events' stamp: 'lr 8/20/2005 15:42'! unknownRequest: aRequest aRequest command = 'EVAL' ifTrue: [ self session returnResponse: (FTPResponse code: 200 string: (Compiler evaluate: aRequest argument) asString) ]. super unknownRequest: aRequest. ! ! !FTPClassContext methodsFor: 'accessing' stamp: 'ijp 8/15/2005 17:14'! actualClass: aClass actualClass := aClass! ! !FTPDirectoryContext methodsFor: 'accessing-information' stamp: 'lr 8/22/2005 08:06'! help ^ self class comment.! ! !FTPDirectoryContext methodsFor: 'convenience' stamp: 'lr 8/22/2005 08:08'! at: aString ifAbsent: aBlock ^ self children detect: [ :each | aString = each name ] ifNone: aBlock.! ! !FTPDirectoryContext methodsFor: 'convenience' stamp: 'lr 8/22/2005 08:09'! at: aString ^ self at: aString ifAbsent: [ self error: 'File not found.' ].! ! !FTPContext methodsFor: 'accessing' stamp: 'lr 8/22/2005 09:35'! timestamp self subclassResponsibility.! ! FTPContext subclass: #FTPFileContext instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Context'! !FTPFileContext methodsFor: 'accessing-dynamic' stamp: 'lr 8/23/2005 22:36'! size ^ self contents size.! ! !FTPFileContext methodsFor: 'accessing' stamp: 'lr 8/23/2005 22:16'! contents self subclassResponsibility.! ! !FTPFileContext methodsFor: 'testing' stamp: 'lr 8/21/2005 15:26'! isFileContext ^ true! ! FTPFileContext subclass: #FTPFilesystemFileContext instanceVariableNames: 'directory array' classVariableNames: '' poolDictionaries: '' category: 'FTP-Context-Filestystem'! !FTPFilesystemFileContext methodsFor: 'initialization' stamp: 'lr 8/22/2005 08:30'! setArray: anArray array := anArray! ! !FTPFilesystemFileContext methodsFor: 'accessing' stamp: 'lr 8/22/2005 09:30'! size ^ array fifth.! ! !FTPFilesystemFileContext methodsFor: 'accessing' stamp: 'lr 8/22/2005 09:36'! timestamp ^ TimeStamp fromSeconds: array third.! ! !FTPFilesystemFileContext methodsFor: 'accessing' stamp: 'lr 8/23/2005 22:18'! contents | stream | stream := self directory readOnlyFileNamed: self name. ^ [ stream upToEnd ] ensure: [ stream close ].! ! !FTPFilesystemFileContext methodsFor: 'initialization' stamp: 'lr 8/22/2005 08:21'! setDirectory: aDirectory directory := aDirectory! ! !FTPFilesystemFileContext methodsFor: 'accessing' stamp: 'lr 8/22/2005 08:41'! name ^ array first! ! !FTPFilesystemFileContext methodsFor: 'accessing' stamp: 'lr 8/23/2005 22:18'! contents: aString | stream | stream := self directory forceNewFileNamed: self name. [ stream nextPutAll: aString ] ensure: [ stream close ].! ! !FTPFileContext methodsFor: 'accessing' stamp: 'lr 8/23/2005 22:11'! contents: aString self subclassResponsibility.! ! !FTPFileContext methodsFor: 'convenience' stamp: 'lr 8/22/2005 08:17'! find: aCollection ^ aCollection isEmpty ifTrue: [ self ].! ! FTPFileContext subclass: #FTPMethodContext instanceVariableNames: 'actualClass selector' classVariableNames: '' poolDictionaries: '' category: 'FTP-Context-Image'! !FTPMethodContext methodsFor: 'accessing' stamp: 'lr 8/23/2005 22:24'! selector: aSelector selector := aSelector! ! !FTPMethodContext methodsFor: 'accessing' stamp: 'lr 8/23/2005 22:24'! selector ^ selector! ! !FTPMethodContext methodsFor: 'accessing-dynamic' stamp: 'lr 8/23/2005 22:36'! timestamp ^ VersionsBrowser timeStampFor: self selector class: self actualClass reverseOrdinal: 1.! ! !FTPMethodContext methodsFor: 'accessing-dynamic' stamp: 'lr 8/23/2005 23:30'! name ^ '#' , self selector asString.! ! !FTPMethodContext methodsFor: 'accessing' stamp: 'lr 8/23/2005 22:28'! contents ^ self actualClass sourceCodeAt: self selector.! ! !FTPMethodContext methodsFor: 'accessing' stamp: 'lr 8/23/2005 22:29'! contents: aString self actualClass compile: aString.! ! !FTPMethodContext methodsFor: 'accessing' stamp: 'lr 8/23/2005 22:24'! actualClass: aClass actualClass := aClass! ! !FTPMethodContext methodsFor: 'accessing' stamp: 'lr 8/23/2005 22:24'! actualClass ^ actualClass! ! !FTPContext methodsFor: 'accessing-dynamic' stamp: 'lr 8/22/2005 08:19'! root ^ self hasParent ifTrue: [ self parent root ] ifFalse: [ self ].! ! Object subclass: #FTPSession instanceVariableNames: 'server context state connection data escaper' classVariableNames: '' poolDictionaries: '' category: 'FTP-Server'! !FTPSession methodsFor: 'commands-file-transfer' stamp: 'lr 8/17/2005 14:53'! list: aString self connection status: 150. self context listDirectory. self connection status: 226.! ! !FTPSession methodsFor: 'initialization' stamp: 'lr 8/18/2005 12:14'! initialize super initialize. state := FTPState new.! ! !FTPSession methodsFor: 'processing' stamp: 'lr 8/18/2005 11:58'! returnResponse: aResponse ^ escaper value: aResponse.! ! !FTPSession methodsFor: 'initialization' stamp: 'lr 8/20/2005 15:11'! setSocket: aSocket connection := FTPPassiveConnection on: aSocket. connection run: [ self handlerLoop ].! ! !FTPSession methodsFor: 'commands-file-transfer' stamp: 'lr 8/17/2005 15:41'! rnto: aString self connection errorUnsupportedCommand.! ! !FTPSession methodsFor: 'accessing-reading' stamp: 'lr 8/19/2005 10:19'! server ^ server! ! !FTPSession methodsFor: 'commands-file-actions' stamp: 'lr 11/22/2004 00:12'! stor: aString self halt.! ! !FTPSession methodsFor: 'testing' stamp: 'lr 8/20/2005 13:42'! isDataConnected ^ self data notNil and: [ self data isConnected ].! ! !FTPSession methodsFor: 'processing' stamp: 'lr 8/23/2005 22:10'! withStreamDo: aBlock self isDataConnected ifTrue: [ self data close ]. self setData: (self state passive ifTrue: [ FTPPassiveConnection ] ifFalse: [ FTPActiveConnection ]) tcp. self state passive ifFalse: [ self data socket connectTo: self state ip port: self state port ] ifTrue: [ self data socket listenOn: self state port backlogSize: self server defaultBacklog ]. self data run: [ aBlock value: self data stream ].! ! !FTPSession class methodsFor: 'instance creation' stamp: 'lr 8/18/2005 12:12'! on: aSocket context: aContext ^ self new setSocket: aSocket; setContext: aContext; yourself.! ! !FTPSession methodsFor: 'commands-file-transfer' stamp: 'lr 8/17/2005 15:29'! appe: aString self connection errorNotImplemented.! ! !FTPSession methodsFor: 'processing' stamp: 'lr 8/20/2005 15:44'! responseForRequest: aRequest ^ self withEscaperDo: [ self withSessionDo: [ self withHandlerDo: [ self performRequest: aRequest ] ] ].! ! !FTPSession methodsFor: 'commands-file-transfer' stamp: 'lr 8/17/2005 14:33'! pwd: aString self connection status: 257 description: '"' , self context workingDirectory , '"'.! ! !FTPSession methodsFor: 'commands-file-transfer' stamp: 'lr 8/17/2005 15:41'! rmd: aString self connection errorUnsupportedCommand.! ! !FTPSession methodsFor: 'commands-parameters' stamp: 'lr 8/17/2005 18:36'! pasv: aString aString notEmpty ifTrue: [ ^ self errorInArguments ]. self state passive: true; ip: NetNameResolver localHostAddress; port: 345. self connection status: 227 description: (String streamContents: [ :stream | self state ip do: [ :each | stream print: each; nextPut: $, ]. stream print: self state port // 256; nextPut: $,; print: self state port \\ 256 ]).! ! !FTPSession methodsFor: 'commands-file-transfer' stamp: 'lr 8/17/2005 15:41'! mkd: aString self connection errorUnsupportedCommand.! ! !FTPSession methodsFor: 'accessing' stamp: 'lr 8/15/2005 18:25'! context ^ context! ! !FTPSession methodsFor: 'commands-file-transfer' stamp: 'lr 8/17/2005 15:41'! rnfr: aString self connection errorUnsupportedCommand.! ! !FTPSession methodsFor: 'commands-login' stamp: 'lr 8/17/2005 15:41'! smnt: aString "This command allows the user to mount a different file system data structure without altering his login or accounting information. Transfer parameters are similarly unchanged. The argument is a pathname specifying a directory or other system dependent file group designator." self connection errorUnsupportedCommand.! ! !FTPSession methodsFor: 'accessing' stamp: 'lr 8/16/2005 10:19'! context: aContext context := aContext! ! !FTPSession methodsFor: 'processing' stamp: 'lr 8/19/2005 19:48'! handlerLoop | request response | FTPResponse ready writeOn: self connection stream. [ self connection isConnected ] whileTrue: [ request := FTPRequest readFrom: self connection stream. request command notEmpty ifTrue: [ self server isLogging ifTrue: [ request logOn: Transcript ]. response := self responseForRequest: request. self server isLogging ifTrue: [ response logOn: Transcript ]. response writeOn: self connection stream ] ].! ! !FTPSession methodsFor: 'accessing-reading' stamp: 'lr 8/19/2005 10:23'! data ^ data! ! !FTPSession methodsFor: 'commands-file-transfer' stamp: 'lr 8/16/2005 14:40'! nlst: aString self list: aString.! ! !FTPSession methodsFor: 'initialization' stamp: 'lr 8/20/2005 13:50'! setData: aConnection data := aConnection! ! !FTPSession methodsFor: 'accessing-reading' stamp: 'lr 8/17/2005 15:59'! state ^ state! ! !FTPSession methodsFor: 'accessing-reading' stamp: 'lr 8/17/2005 14:27'! connection ^ connection! ! !FTPSession methodsFor: 'commands-file-actions' stamp: 'lr 11/22/2004 00:12'! retr: aString self halt.! ! !FTPSession methodsFor: 'initialization' stamp: 'lr 8/16/2005 14:56'! setContext: aContext context := aContext! ! !FTPSession methodsFor: 'processing' stamp: 'lr 8/20/2005 15:47'! withSessionDo: aBlock ^ FTPCurrentSession use: self during: aBlock.! ! !FTPSession methodsFor: 'processing' stamp: 'lr 8/20/2005 15:44'! performRequest: aRequest | command | aRequest command isEmpty ifTrue: [ self returnResponse: nil ]. command := FTPCommand in: self for: aRequest ifAbsent: [ self context unknownRequest: aRequest ]. command execute.! ! !FTPSession methodsFor: 'processing' stamp: 'lr 8/18/2005 09:45'! withHandlerDo: aBlock ^ aBlock on: Error do: [ :err | self returnResponse: (FTPResponse error: err messageText) ].! ! !FTPSession methodsFor: 'commands-file-actions' stamp: 'lr 8/17/2005 15:41'! rest: aString self connection errorUnsupportedCommand.! ! !FTPSession methodsFor: 'commands-login' stamp: 'lr 8/17/2005 15:29'! acct: aString "The argument field is a Telnet string identifying the user's account. The command is not necessarily related to the USER command, as some sites may require an account for login and others only for specific access, such as storing files. In the latter case the command may arrive at any time. There are reply codes to differentiate these cases for the automation: when account information is required for login, the response to a successful PASSword command is reply code 332. On the other hand, if account information is NOT required for login, the reply to a successful PASSword command is 230; and if the account information is needed for a command issued later in the dialogue, the server should return a 332 or 532 reply depending on whether it stores (pending receipt of the ACCounT command) or discards the command, respectively." self connection errorNotImplemented.! ! !FTPSession methodsFor: 'commands-parameters' stamp: 'lr 8/17/2005 17:49'! port: aString | numbers | numbers := aString findTokens: $,. (numbers size = 6 and: [ numbers allSatisfy: [ :each | each isAllDigits ] ]) ifFalse: [ ^ self connection errorUnsupportedParameter ]. numbers := numbers collect: [ :each | each asInteger ]. (numbers allSatisfy: [ :each | each between: 0 and: 256 ]) ifFalse: [ ^ self connection errorInvalidParamter ]. self state passive: false; ip: (ByteArray with: numbers first with: numbers second with: numbers third with: numbers fourth); port: numbers fifth * 256 + numbers sixth. self connection statusOkay.! ! !FTPSession methodsFor: 'commands-logout' stamp: 'lr 8/17/2005 16:01'! rein: aString "This command terminates a USER, flushing all I/O and account information, except to allow any transfer in progress to be completed. All parameters are reset to the default settings and the control connection is left open. This is identical to the state in which a user finds himself immediately after the control connection is opened. A USER command may be expected to follow." self state: self defaultState. self connection statusOkay.! ! !FTPSession methodsFor: 'commands-file-transfer' stamp: 'lr 8/17/2005 15:29'! dele: aString self self connection errorNotImplemented.! ! !FTPSession methodsFor: 'commands-file-transfer' stamp: 'lr 8/17/2005 15:28'! abor: aString self connection errorNotImplemented.! ! !FTPSession methodsFor: 'commands-file-actions' stamp: 'lr 8/17/2005 15:29'! allo: aString self connection errorNotImplemented.! ! !FTPSession methodsFor: 'testing' stamp: 'lr 8/17/2005 15:01'! isConnected ^ self connection notNil and: [ self connection isConnected ].! ! !FTPSession methodsFor: 'commands-file-actions' stamp: 'lr 8/17/2005 14:35'! stou: aString self connection status: 502.! ! !FTPSession methodsFor: 'initialization' stamp: 'lr 8/19/2005 10:20'! setServer: aServer server := aServer! ! !FTPSession methodsFor: 'processing' stamp: 'lr 8/18/2005 09:44'! withEscaperDo: aBlock escaper := [ :value | ^ value ]. ^ aBlock value.! ! TestResource subclass: #FTPServerClientResource instanceVariableNames: 'server client' classVariableNames: '' poolDictionaries: '' category: 'FTP-Tests'! !FTPServerClientResource methodsFor: 'running' stamp: 'lr 8/17/2005 16:54'! tearDown self client isConnected ifTrue: [ self client close ]. self server isConnected ifTrue: [ self server stop ].! ! !FTPServerClientResource methodsFor: 'running' stamp: 'lr 8/17/2005 16:57'! setUp server := FTPServer startOn: self port. client := FTPClient openOnHost: self ip port: self port.! ! !FTPServerClientResource methodsFor: 'running' stamp: 'lr 8/17/2005 17:26'! connect ! ! !FTPServerClientResource methodsFor: 'accessing' stamp: 'lr 8/17/2005 16:42'! client ^ client! ! !FTPServerClientResource methodsFor: 'accessing-config' stamp: 'lr 8/17/2005 16:47'! port ^ 31415! ! !FTPServerClientResource methodsFor: 'accessing' stamp: 'lr 8/17/2005 16:42'! server ^ server! ! !FTPServerClientResource methodsFor: 'accessing-config' stamp: 'lr 8/17/2005 16:47'! ip ^ ByteArray with: 127 with: 0 with: 0 with: 1.! ! FTPServer initialize!