SystemOrganization addCategory: #'FTP-Server'! SystemOrganization addCategory: #'FTP-Context'! SystemOrganization addCategory: #'FTP-Tests'! Notification subclass: #FTPCurrentSession instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Server'! !FTPCurrentSession class methodsFor: 'as yet unclassified' stamp: 'lr 8/16/2005 09:48'! use: aSession during: aBlock ^ aBlock on: self do: [ :n | n resume: aSession ].! ! !FTPCurrentSession class methodsFor: 'as yet unclassified' stamp: 'lr 8/16/2005 09:50'! value ^ self signal! ! 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.! ! Object subclass: #FTPConnection instanceVariableNames: 'server socket stream' classVariableNames: '' poolDictionaries: '' category: 'FTP-Server'! !FTPConnection methodsFor: 'initialization' stamp: 'lr 8/16/2005 14:22'! setServer: aServer server := aServer.! ! !FTPConnection methodsFor: 'state-conveniance' stamp: 'lr 8/17/2005 15:33'! errorInvalidCommand "The server does not like the command." self status: 500 description: 'Invalid Command'.! ! !FTPConnection methodsFor: 'state-conveniance' stamp: 'lr 8/16/2005 14:54'! statusReady self status: 220 description: 'SqueakFtp ready'.! ! !FTPConnection methodsFor: 'state' stamp: 'lr 8/17/2005 14:06'! status: anInteger self status: anInteger description: 'OK'.! ! !FTPConnection methodsFor: 'state' stamp: 'lr 8/17/2005 14:06'! status: anInteger description: aString self status: anInteger description: aString last: true.! ! !FTPConnection methodsFor: 'actions' stamp: 'lr 8/16/2005 14:24'! close self stream close. self socket destroy.! ! !FTPConnection methodsFor: 'accessing-io' stamp: 'lr 8/16/2005 14:30'! readLine | line | line := self stream upTo: Character lf. (line notEmpty and: [ line last = Character cr ]) ifTrue: [ line := line allButLast ]. self isLogging ifTrue: [ Transcript show: '>>'; space; show: line; cr ]. ^ line.! ! !FTPConnection methodsFor: 'state-conveniance' stamp: 'lr 8/17/2005 15:25'! errorInvalidParamter "The server does not like the format of the parameter." self status: 501 description: 'Invalid Parameter Format'.! ! !FTPConnection methodsFor: 'testing' stamp: 'lr 8/16/2005 14:09'! isLogging ^ true! ! !FTPConnection methodsFor: 'state-conveniance' stamp: 'lr 8/17/2005 15:23'! error: aString "The request violated some internal parsing rule in the server." self status: 500 description: aString.! ! !FTPConnection methodsFor: 'accessing' stamp: 'lr 8/16/2005 13:54'! stream ^ stream! ! !FTPConnection methodsFor: 'state' stamp: 'lr 8/17/2005 14:04'! status: anInteger description: aString last: aBoolean self writeLine: (String streamContents: [ :s | s print: anInteger; nextPut: (aBoolean ifTrue: [ $ ] ifFalse: [ $- ]). s nextPutAll: aString ]).! ! !FTPConnection methodsFor: 'testing' stamp: 'lr 8/16/2005 14:36'! isConnected ^ self socket isValid and: [ self socket isConnected ].! ! !FTPConnection methodsFor: 'state-conveniance' stamp: 'lr 8/17/2005 14:21'! statusOkay self status: 200.! ! !FTPConnection methodsFor: 'initialization' stamp: 'lr 8/16/2005 14:23'! setSocket: aSocket socket := aSocket. stream := SocketStream on: aSocket.! ! !FTPConnection methodsFor: 'accessing' stamp: 'lr 8/16/2005 13:54'! socket ^ socket! ! !FTPConnection methodsFor: 'state' stamp: 'lr 8/17/2005 14:09'! status: anInteger descriptions: aCollection aCollection withIndexDo: [ :each :index | self status: anInteger description: each last: aCollection size = index ].! ! !FTPConnection methodsFor: 'accessing' stamp: 'lr 8/16/2005 13:53'! server ^ server! ! !FTPConnection methodsFor: 'state-conveniance' stamp: 'lr 8/17/2005 15:24'! errorUnsupportedParameter "The server supports the verb but does not support the parameter." self status: 504 description: 'Unsupported parameter'.! ! !FTPConnection methodsFor: 'state-conveniance' stamp: 'lr 8/17/2005 15:32'! errorUnsupportedCommand "The server recognized the verb but does not support it." self status: 502 description: 'Unsupported command'.! ! !FTPConnection methodsFor: 'accessing-io' stamp: 'lr 8/17/2005 14:13'! writeLine: aString self isLogging ifTrue: [ Transcript show: '<< '; show: aString; cr ]. self stream nextPutAll: aString; nextPutAll: String crlf; flush.! ! 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: 'private' stamp: 'lr 8/17/2005 15:00'! createSession: aSocket FTPSession new setContext: self context copy; setConnection: (FTPConnection new setServer: self; setSocket: aSocket); start.! ! !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: '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: '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: '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:51'! port port isNil ifTrue: [ port := self defaultPort ]. ^port! ! !FTPServer methodsFor: 'accessing' stamp: 'lr 11/21/2004 19:52'! priority priority isNil ifTrue: [ priority := self defaultPriority ]. ^priority! ! !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: 'private' stamp: 'lr 11/21/2004 20:55'! serverLoop [ self serverLoopBody ] repeat.! ! !FTPServer methodsFor: 'accessing-readonly' stamp: 'lr 11/21/2004 22:11'! listener ^listener! ! 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: #FTPContext instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FTP-Server'! !FTPContext methodsFor: 'navigation' stamp: 'lr 8/16/2005 09:56'! changeDirectoryToParent self subclassResponsibility.! ! !FTPContext methodsFor: 'navigation' stamp: 'lr 8/16/2005 09:55'! workingDirectory self subclassResponsibility.! ! !FTPContext methodsFor: 'accessing-information' stamp: 'lr 8/16/2005 09:54'! help ^ self class comment.! ! !FTPContext methodsFor: 'navigation' stamp: 'lr 8/16/2005 09:55'! listDirectory self subclassResponsibility.! ! !FTPContext methodsFor: 'navigation' stamp: 'lr 8/16/2005 09:56'! changeDirectoryTo: aString self subclassResponsibility.! ! !FTPContext methodsFor: 'accessing' stamp: 'lr 8/16/2005 09:51'! session ^ FTPCurrentSession value.! ! FTPContext subclass: #FTPFilesystemContext instanceVariableNames: 'parent directory' classVariableNames: '' poolDictionaries: '' category: 'FTP-Context'! !FTPFilesystemContext methodsFor: 'accessing' stamp: 'lr 8/16/2005 11:04'! directory: aDirectory directory := aDirectory! ! !FTPFilesystemContext methodsFor: 'accessing' stamp: 'lr 8/16/2005 11:19'! directory ^ directory ifNil: [ directory := FileDirectory default ].! ! !FTPFilesystemContext methodsFor: 'navigation' stamp: 'lr 8/16/2005 11:10'! workingDirectory ^ String streamContents: [ :stream | stream nextPut: $/. self withAllParents do: [ :each | stream nextPutAll: each ] separatedBy: [ stream nextPut: $/ ] ].! ! !FTPFilesystemContext methodsFor: 'accessing' stamp: 'lr 8/16/2005 11:05'! parent: aContext parent := aContext! ! !FTPFilesystemContext methodsFor: 'navigation' stamp: 'lr 8/16/2005 11:05'! changeDirectoryToParent ^ self parent isNil ifFalse: [ self parent ] ifTrue: [ self ].! ! !FTPFilesystemContext methodsFor: 'navigation' stamp: 'lr 8/16/2005 11:20'! changeDirectoryTo: aString ^ self copy directory: (self directory on: self directory pathName , self directory pathNameDelimiter asString , aString); parent: self; yourself.! ! !FTPFilesystemContext methodsFor: 'accessing' stamp: 'lr 8/16/2005 11:04'! parent ^ parent! ! !FTPFilesystemContext methodsFor: 'accessing-dynamic' stamp: 'lr 8/16/2005 11:22'! withAllParents ^ self parent isNil ifTrue: [ OrderedCollection new ] ifFalse: [ self parent withAllParents add: self directory pathParts last; yourself ].! ! !FTPContext methodsFor: 'accessing-information' stamp: 'lr 8/16/2005 09:54'! system ^ SmalltalkImage current vmVersion.! ! FTPContext subclass: #FTPClassContext instanceVariableNames: 'actualClass' classVariableNames: '' poolDictionaries: '' category: 'FTP-Context'! !FTPClassContext methodsFor: 'navigation' stamp: 'ijp 8/15/2005 17:26'! workingDirectory ^ String streamContents: [ :stream | stream nextPut: $/. self actualClass withAllSuperclasses allButLast reverse do: [ :each | stream nextPutAll: each asString ] separatedBy: [ stream nextPut: $/ ] ].! ! !FTPClassContext methodsFor: 'navigation' stamp: 'lr 8/16/2005 09:57'! changeDirectoryToParent ^ self species new actualClass: self actualClass superclass; yourself.! ! !FTPClassContext methodsFor: 'navigation' stamp: 'lr 8/17/2005 18:16'! listDirectory self session transferWith: [ :stream | self actualClass subclasses do: [ :each | stream nextPutAll: each name; crlf ]. self actualClass selectors do: [ :each | stream nextPutAll: each; crlf ] ].! ! !FTPClassContext methodsFor: 'accessing' stamp: 'ijp 8/15/2005 17:14'! actualClass: aClass actualClass := aClass! ! !FTPClassContext methodsFor: 'accessing-dynamic' stamp: 'lr 8/16/2005 15:08'! subclasses ^ self actualClass subclasses! ! !FTPClassContext methodsFor: 'navigation' stamp: 'lr 8/16/2005 09:57'! changeDirectoryTo: aString ^ self species new actualClass: (Smalltalk at: aString asSymbol); yourself.! ! !FTPClassContext methodsFor: 'accessing' stamp: 'lr 8/17/2005 16:59'! actualClass ^ actualClass ifNil: [ actualClass := ProtoObject ]! ! !FTPContext methodsFor: 'accessing-information' stamp: 'lr 8/16/2005 09:54'! statistics ^ SmalltalkImage current vmStatisticsReportString.! ! Object subclass: #FTPSession instanceVariableNames: 'process context state connection' 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: 'commands-file-transfer' stamp: 'lr 8/17/2005 15:41'! rnto: aString self connection errorUnsupportedCommand.! ! !FTPSession methodsFor: 'private-server' stamp: 'lr 8/17/2005 16:01'! createServer state := self defaultState. process := Process forContext: [ [ self sessionLoop ] ensure: [ self destroyServer ] ] priority: self connection server priority.! ! !FTPSession methodsFor: 'private-handlers' stamp: 'lr 8/16/2005 10:17'! withSessionHandlerDo: aBlock FTPCurrentSession use: self during: aBlock.! ! !FTPSession methodsFor: 'private-server' stamp: 'lr 8/17/2005 14:34'! sessionLoop self withErrorHandlerDo: [ self withSessionHandlerDo: [ [ self isConnected ] whileTrue: [ self execute: self connection readLine ] ] ].! ! !FTPSession methodsFor: 'private-server' stamp: 'lr 8/17/2005 18:26'! transferWith: aBlock passive: aStream self halt. aStream socket listenOn: self state port. (aStream waitForConnectionUntil: 5) ifFalse: [ ^ self ]. [ aBlock value: aStream ] ensure: [ aStream close ].! ! !FTPSession methodsFor: 'commands-file-actions' stamp: 'lr 11/22/2004 00:12'! stor: aString self halt.! ! !FTPSession methodsFor: 'accessing-configuration' stamp: 'lr 8/17/2005 16:02'! defaultState ^ FTPState new.! ! !FTPSession methodsFor: 'commands-file-transfer' stamp: 'lr 8/17/2005 15:29'! appe: aString self connection errorNotImplemented.! ! !FTPSession methodsFor: 'commands-file-transfer' stamp: 'lr 8/17/2005 14:33'! pwd: aString self connection status: 257 description: '"' , self context workingDirectory , '"'.! ! !FTPSession methodsFor: 'actions' stamp: 'lr 8/17/2005 14:34'! start self isRunning ifTrue: [ ^ self ]. self createServer. self connection statusReady. self process resume.! ! !FTPSession methodsFor: 'commands-file-transfer' stamp: 'lr 8/17/2005 15:41'! rmd: aString self connection errorUnsupportedCommand.! ! !FTPSession methodsFor: 'commands-miscellaneous' stamp: 'lr 8/17/2005 14:33'! noop: aString "This command does not affect any parameters or previously entered commands. It specifies no action other than that the server send an OK reply." self connection statusOkay.! ! !FTPSession methodsFor: 'actions' stamp: 'lr 8/17/2005 14:35'! stop self isRunning ifFalse: [ ^ self ]. self process terminate. self connection close.! ! !FTPSession methodsFor: 'private-server' stamp: 'lr 8/17/2005 15:37'! execute: aString | selector argument | aString isEmptyOrNil ifTrue: [ self connection statusOkay ] ifFalse: [ selector := ((aString copyUpTo: $ ) asLowercase copyWith: $:) asSymbol. (self isValidCommand: selector) ifFalse: [ self connection errorInvalidCommand ] ifTrue: [ argument := aString copyAfter: $ . self perform: selector with: argument ] ].! ! !FTPSession methodsFor: 'commands-miscellaneous' stamp: 'lr 8/17/2005 15:41'! site: 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: 'private-server' stamp: 'lr 8/17/2005 15:59'! destroyServer self connection close. self process terminate. process := connection := state := nil.! ! !FTPSession methodsFor: 'commands-file-transfer' stamp: 'lr 8/17/2005 15:41'! rnfr: aString self connection errorUnsupportedCommand.! ! !FTPSession methodsFor: 'accessing' stamp: 'lr 8/16/2005 10:19'! context: aContext context := aContext! ! !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: 'commands-parameters' stamp: 'lr 8/17/2005 17:37'! mode: aString "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." aString asLowercase = 's' ifTrue: [ ^ self connection statusOkay ]. self connection errorUnsupportedParameter.! ! !FTPSession methodsFor: 'commands-informational' stamp: 'lr 8/17/2005 14:32'! help: aString self connection writeLine: self context help.! ! !FTPSession methodsFor: 'commands-login' stamp: 'lr 8/17/2005 16:00'! pass: aString "The argument field is a Telnet string specifying the user's password. This command must be immediately preceded by the user name command, and, for some sites, completes the user's identification for access control. Since password information is quite sensitive, it is desirable in general to 'mask' it or suppress typeout. It appears that the server has no foolproof way to achieve this. It is therefore the responsibility of the user-FTP process to hide the sensitive password information." self state password: aString. self connection statusOkay.! ! !FTPSession methodsFor: 'commands-login' stamp: 'lr 8/17/2005 14:31'! cwd: aString "This command allows the user to work with a different directory or dataset for file storage or retrieval 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 context: (self context changeDirectoryTo: aString). self connection status: 250.! ! !FTPSession methodsFor: 'private-server' stamp: 'lr 8/17/2005 18:39'! transferWith: aBlock active: aStream aStream socket connectTo: self state ip port: self state port. [ aBlock value: aStream ] ensure: [ aStream close ].! ! !FTPSession methodsFor: 'accessing' stamp: 'lr 8/17/2005 16:01'! state: aState state := aState! ! !FTPSession methodsFor: 'commands-file-transfer' stamp: 'lr 8/16/2005 14:40'! nlst: aString self list: aString.! ! !FTPSession methodsFor: 'testing' stamp: 'lr 8/16/2005 14:07'! isRunning ^ self process notNil.! ! !FTPSession methodsFor: 'commands-logout' stamp: 'lr 11/21/2004 23:45'! quit: aString "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)." self stop.! ! !FTPSession methodsFor: 'commands-parameters' stamp: 'lr 8/17/2005 17:36'! type: aString aString asLowercase = 'a' ifTrue: [ self state binary: false. ^ self connection statusOkay ]. aString asLowercase = 'i' ifTrue: [ self state binary: true. ^ self connection statusOkay ]. self connection errorInvalidParamter.! ! !FTPSession methodsFor: 'accessing-reading' stamp: 'lr 8/17/2005 14:27'! connection ^ connection! ! !FTPSession methodsFor: 'private-server' stamp: 'lr 8/17/2005 18:29'! transferWith: aBlock | stream | stream := SocketStream on: Socket newTCP. self state passive ifTrue: [ self transferWith: aBlock passive: stream ] ifFalse: [ self transferWith: aBlock active: stream ]. ! ! !FTPSession methodsFor: 'commands-file-actions' stamp: 'lr 11/22/2004 00:12'! retr: aString self halt.! ! !FTPSession methodsFor: 'testing' stamp: 'lr 8/16/2005 10:53'! isValidCommand: aSelector | category | category := self class whichCategoryIncludesSelector: aSelector. ^ category notNil and: [ category beginsWith: 'commands' ].! ! !FTPSession methodsFor: 'initialization' stamp: 'lr 8/16/2005 14:56'! setContext: aContext context := aContext! ! !FTPSession methodsFor: 'initialization' stamp: 'lr 8/17/2005 15:00'! setConnection: aConnection connection := aConnection! ! !FTPSession methodsFor: 'commands-login' stamp: 'lr 8/17/2005 14:47'! cdup: aString "This command is a special case of CWD, and is included to simplify the implementation of programs for transferring directory trees between operating systems having different syntaxes for naming the parent directory. The reply codes shall be identical to the reply codes of CWD." self context: (self context changeDirectoryToParent). self connection statusOkay.! ! !FTPSession methodsFor: 'accessing' stamp: 'lr 8/17/2005 15:59'! state ^ state! ! !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-file-transfer' stamp: 'lr 8/17/2005 15:29'! dele: aString self self connection errorNotImplemented.! ! !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: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: 'commands-parameters' stamp: 'lr 8/17/2005 17:36'! stru: aString "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." aString asLowercase = 'f' ifTrue: [ ^ self connection statusOkay ]. self connection errorUnsupportedParameter.! ! !FTPSession methodsFor: 'commands-file-actions' stamp: 'lr 8/17/2005 14:35'! stou: aString self connection status: 502.! ! !FTPSession methodsFor: 'commands-informational' stamp: 'lr 8/17/2005 14:35'! syst: aString self connection writeLine: self context system.! ! !FTPSession methodsFor: 'accessing-reading' stamp: 'lr 8/16/2005 10:24'! process ^ process! ! !FTPSession methodsFor: 'commands-login' stamp: 'lr 8/17/2005 15:59'! user: aString "The argument field is a Telnet string identifying the user. The user identification is that which is required by the server for access to its file system. This command will normally be the first command transmitted by the user after the control connections are made (some servers may require this). Additional identification information in the form of a password and/or an account command may also be required by some servers. Servers may allow a new USER command to be entered at any point in order to change the access control and/or accounting information. This has the effect of flushing any user, password, and account information already supplied and beginning the login sequence again. All transfer parameters are unchanged and any file transfer in progress is completed under the old access control parameters." self state username: aString. self connection statusOkay.! ! !FTPSession methodsFor: 'testing' stamp: 'lr 8/17/2005 15:01'! isConnected ^ self connection notNil and: [ self connection isConnected ].! ! !FTPSession methodsFor: 'private-handlers' stamp: 'lr 8/17/2005 15:03'! withErrorHandlerDo: aBlock aBlock on: Error do: [ :ex | self connection status: 500 description: ex defaultAction messageText ].! ! !FTPSession methodsFor: 'commands-informational' stamp: 'lr 8/17/2005 14:35'! stat: aString self connection writeLine: self context statistics.! ! FTPServer initialize!