SystemOrganization addCategory: #'FS-Curl'! FSFilesystem subclass: #FSCurlFilesystem instanceVariableNames: 'curl base' classVariableNames: '' poolDictionaries: '' category: 'FS-Curl'! FSCurlFilesystem class instanceVariableNames: 'protocols'! FSCurlFilesystem class instanceVariableNames: 'protocols'! !FSCurlFilesystem class methodsFor: 'initialization' stamp: 'lr 2/1/2010 18:49'! initialize protocols := Dictionary new. protocols at: 'ftp' put: FSFtpFilesystem; at: 'ftps' put: FSFtpFilesystem! ! !FSCurlFilesystem class methodsFor: 'instance creation' stamp: 'lr 2/1/2010 18:52'! url: anUrlString | protocol class | protocol := anUrlString copyUpTo: $:. class := protocols at: protocol ifAbsent: [ FSCurlFilesystem ]. ^ class basicNew initializeUrl: anUrlString! ! !FSCurlFilesystem methodsFor: 'accessing' stamp: 'lr 1/31/2010 14:21'! base "Answer the base of this filesystem, that is the protocols, the hostname and port." ^ base! ! !FSCurlFilesystem methodsFor: 'public' stamp: 'lr 2/1/2010 19:37'! childrenAt: anObject | path | path := self resolve: anObject. ^ Array streamContents: [ :out | self directoryAt: path ifAbsent: [ self directoryDoesNotExist: path ] nodesDo: [ :entry | out nextPut: (self referenceTo: path / entry last) ] ]! ! !FSCurlFilesystem methodsFor: 'public' stamp: 'lr 1/31/2010 13:34'! close super close. curl isNil ifTrue: [ ^ self ]. curl destroy. curl := nil! ! !FSCurlFilesystem methodsFor: 'public' stamp: 'lr 2/1/2010 19:37'! createDirectory: aPath self error: self printString , ' does not support directory creation'! ! !FSCurlFilesystem methodsFor: 'accessing' stamp: 'lr 1/30/2010 20:05'! curl "Answer the low-level Curl implementation." ^ curl! ! !FSCurlFilesystem methodsFor: 'public' stamp: 'lr 2/1/2010 19:38'! delete: aPath self error: self printString , ' does not support file deletion'! ! !FSCurlFilesystem methodsFor: 'public' stamp: 'lr 1/30/2010 16:46'! delimiter ^ $/! ! !FSCurlFilesystem methodsFor: 'private' stamp: 'lr 2/1/2010 19:00'! directoryAt: aPath ifAbsent: absentBlock nodesDo: aBlock "Most protocols do not support enumerating files and directories. Ignore the request."! ! !FSCurlFilesystem methodsFor: 'public' stamp: 'lr 2/1/2010 19:38'! entriesAt: anObject | path entry | path := self resolve: anObject. ^ Array streamContents: [ :out | self directoryAt: path ifAbsent: [ self directoryDoesNotExist: path ] nodesDo: [ :node | entry := self entryFromNode: node atPath: path / node last. out nextPut: entry ] ]! ! !FSCurlFilesystem methodsFor: 'printing' stamp: 'lr 1/31/2010 14:21'! forReferencePrintOn: aStream aStream nextPutAll: self base! ! !FSCurlFilesystem methodsFor: 'initialization' stamp: 'lr 2/1/2010 18:57'! initializeCurl curl := Curl new! ! !FSCurlFilesystem methodsFor: 'initialization' stamp: 'lr 2/1/2010 18:57'! initializeUrl: anUrlString | matcher | self initialize. self initializeCurl. matcher := '(.*\://[^/]*)(.*)$' asRegex. (matcher matchesPrefix: anUrlString) ifFalse: [ self error: 'Invalid URL ' , anUrlString printString ]. base := matcher subexpression: 2. self changeDirectory: (matcher subexpression: 3)! ! !FSCurlFilesystem methodsFor: 'public' stamp: 'lr 1/30/2010 23:09'! open: aPath writable: aBoolean | path | path := self resolve: aPath. ^ FSCurlHandle open: (self referenceTo: path) writable: aBoolean ! ! !FSCurlFilesystem methodsFor: 'converting' stamp: 'lr 1/31/2010 13:19'! stringFromPath: aPath ^ String streamContents: [ :stream | self forReferencePrintOn: stream. aPath printOn: stream delimiter: self delimiter ]! ! FSCurlFilesystem subclass: #FSFtpFilesystem instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Curl'! !FSFtpFilesystem methodsFor: 'private' stamp: 'lr 2/14/2010 10:22'! basicIsDirectory: anEntry ^ anEntry first = 'd'! ! !FSFtpFilesystem methodsFor: 'private' stamp: 'lr 2/1/2010 19:31'! directoryAt: aPath ifAbsent: absentBlock nodesDo: aBlock "For directory listings FTP requires the path to end with a slash." | stream | stream := [ self readStreamOn: (self directoryFromPath: aPath) ] on: FSFileDoesNotExist do: [ :err | ^ absentBlock value ]. self parseListing: stream directoryAt: aPath ifAbsent: absentBlock nodesDo: aBlock! ! !FSFtpFilesystem methodsFor: 'private' stamp: 'lr 2/1/2010 19:31'! directoryFromPath: aPath "FTP expects a tailing slash when referring to directories." ^ aPath basename isEmpty ifTrue: [ aPath ] ifFalse: [ aPath / '' ]! ! !FSFtpFilesystem methodsFor: 'private' stamp: 'lr 1/31/2010 14:32'! entryFromNode: aNode atPath: aPath ^ FSDirectoryEntry filesystem: self path: aPath creation: (Date fromString: aNode seventh) modification: (Date fromString: aNode seventh) isDir: aNode first = 'd' size: aNode sixth asInteger! ! !FSFtpFilesystem methodsFor: 'private' stamp: 'lr 1/31/2010 14:33'! nodeAt: aPath ifPresent: presentBlock ifAbsent: absentBlock | name | aPath isRoot ifTrue: [ ^ presentBlock value: self rootNode ]. name := aPath basename. self directoryAt: aPath parent ifAbsent: absentBlock nodesDo: [ :entry | entry last = name ifTrue: [ ^ presentBlock value: entry ] ]. ^ absentBlock value! ! !FSFtpFilesystem methodsFor: 'private' stamp: 'lr 1/31/2010 14:27'! parseListing: aStream directoryAt: aPath ifAbsent: absentBlock nodesDo: aBlock | regex | regex := '([\-ld])([\-rwxs]+)\s+(\d+)\s+([\-\w]+)\s+([\-\w]+)\s+(\d+)\s+((\w+\s+\d+\s+\d+\:\d+)|(\w+\s+\d+\s+\d+))\s+(.+)$' asRegex. [ aStream atEnd ] whileFalse: [ | line | line := String withAll: aStream nextLine. (regex matchesPrefix: line) ifTrue: [ | data | data := (2 to: regex subexpressionCount) collect: [ :index | regex subexpression: index ]. (data last = '.' or: [ data last = '..' ]) ifFalse: [ aBlock value: data ] ] ]! ! !FSFtpFilesystem methodsFor: 'private' stamp: 'lr 1/31/2010 14:43'! rootNode ^ #('d' 'rwxr-xr-x' '0' '-' '-' '0' 'Jan 1 1970' nil nil '')! ! FSMemoryHandle subclass: #FSCurlHandle instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'FS-Curl'! !FSCurlHandle methodsFor: 'public' stamp: 'lr 2/1/2010 19:56'! close self flush. bytes := nil! ! !FSCurlHandle methodsFor: 'accessing' stamp: 'lr 2/1/2010 19:56'! filesystem ^ reference filesystem! ! !FSCurlHandle methodsFor: 'public' stamp: 'lr 2/14/2010 10:17'! flush writable ifFalse: [ ^ self ]. reference filesystem curl putContents: (bytes first: size) url: self url! ! !FSCurlHandle methodsFor: 'public' stamp: 'lr 2/1/2010 19:59'! growTo: anInteger | grown | grown := bytes class new: anInteger + self sizeIncrement. grown replaceFrom: 1 to: bytes size with: bytes. bytes := grown! ! !FSCurlHandle methodsFor: 'public' stamp: 'lr 2/14/2010 10:18'! open bytes := writable ifTrue: [ ByteArray new ] ifFalse: [ (reference filesystem curl getContentsUrl: self url) asByteArray ]. size := bytes size! ! !FSCurlHandle methodsFor: 'accessing' stamp: 'lr 2/14/2010 10:16'! url ^ reference filesystem stringFromPath: reference path! ! FSCurlFilesystem initialize!