MCFtpRepository.st
author Claus Gittinger <cg@exept.de>
Sat, 01 Sep 2018 17:32:13 +0200
changeset 1086 efc5221435a5
parent 1051 793db72fde39
permissions -rw-r--r--
initial checkin

"{ Encoding: utf8 }"

"{ Package: 'stx:goodies/monticello' }"

"{ NameSpace: Smalltalk }"

MCFileBasedRepository subclass:#MCFtpRepository
	instanceVariableNames:'host directory user password connection'
	classVariableNames:''
	poolDictionaries:''
	category:'SCM-Monticello-RemoteRepositories'
!

!MCFtpRepository class methodsFor:'documentation'!

documentation
"
    I am an monticello repository implementation for the FTP protocol.
"
! !

!MCFtpRepository class methodsFor:'instance creation'!

basicFromUrl: aZnUrl
	^ self
		host: (aZnUrl hasPort ifTrue: [ aZnUrl host, ':', aZnUrl port asString ] ifFalse: [ aZnUrl host ])
		directory: aZnUrl path "MCFtpRepository assumes NO prefixed / in the path"
		user: (aZnUrl username ifNil: [ '' ])
		password: (aZnUrl password ifNil: [ '' ])
!

host: host directory: directory user: user password: password
	^ self new
		host: host;
		directory: directory;
		user: user;
		password: password
! !

!MCFtpRepository class methodsFor:'*MonticelloGUI'!

fillInTheBlankRequest
	^ 'FTP Repository:'

	
!

morphicConfigure
	^ self fillInTheBlankConfigure
! !

!MCFtpRepository class methodsFor:'accessing'!

urlSchemes
	^ #(ftp)
! !

!MCFtpRepository class methodsFor:'queries'!

creationTemplate
	^
'MCFtpRepository
	host: ''modules.squeakfoundation.org''
	directory: ''mc''
	user: ''squeak''
	password: ''squeak'''
	
!

description
	^ 'FTP'
!

templateCreationSelector
	^ #host:directory:user:password: 
! !

!MCFtpRepository methodsFor:'*Komitter-Models'!

isRemote
	^ true
!

koRemote
	
	^ KomitFtpRemote new
		remote: self;
		yourself
! !

!MCFtpRepository methodsFor:'*metacello-pharocommonplatform'!

asRepositorySpecFor: aMetacelloMCProject
	| dir |
	dir := directory.
	(directory at: 1) = $/
		ifFalse: [ dir := '/', dir ].
	^(aMetacelloMCProject repositorySpec)
		description:  'ftp://', host, dir;
	 	type: 'ftp';
		username: user;
		password: password;
		yourself
! !

!MCFtpRepository methodsFor:'*metacello-testsplatform'!

directory

	^directory
!

host

	^host
! !

!MCFtpRepository methodsFor:'accessing'!

directory: dirPath
	directory := dirPath
!

host: hostname
	host := hostname
!

password: passwordString
	password := passwordString
!

user: userString
	user := userString
! !

!MCFtpRepository methodsFor:'as yet unclassified'!

clientDo: aBlock
        | client |

        NVTClient loginFailedSignal handle:[:ex |
            | answer |

            answer := Dialog 
                requestPassword:('FTP-Login failed (',ex description,'\\Try again with password:') withCRs
                initialAnswer:password.
            answer isEmptyOrNil ifTrue:[ AbortOperationRequest raise].
            password := answer.
            ex restart
        ] do:[
            client := FTPClient openOnHostNamed: host.
            client loginUser: user password: password.
            directory isEmpty ifFalse: [client changeDirectoryTo: directory].
        ].
        ^ [aBlock value: client] ensure: [client close]
!

parseDirectoryListing: aString
	| stream files line tokens |
	stream := aString readStream.
	files := OrderedCollection new.
	[stream atEnd] whileFalse:
		[line := stream nextLine.
		tokens := line findTokens: ' '.
		tokens size > 2 ifTrue: [files add: tokens last]].
	^ files
! !

!MCFtpRepository methodsFor:'displaying'!

displayString
    ^ self description

    "Created: / 14-09-2010 / 23:20:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Created: / 25-11-2011 / 11:29:31 / cg"
! !

!MCFtpRepository methodsFor:'interface'!

loadAllFileNames
	^ self clientDo:
		[:client |
		self parseDirectoryListing: client getDirectory]
! !

!MCFtpRepository methodsFor:'required'!

allFileNames
	^ self clientDo:
		[:client |
		self parseDirectoryListing: client getDirectory]
!

description
    user notNil ifTrue:[
        ^ 'ftp://', user, '@', host, '/', directory
    ].
    ^ 'ftp://', host, '/', directory

    "Modified: / 26-08-2018 / 12:35:25 / Claus Gittinger"
!

readStreamForFileNamed: aString do: aBlock
	
	^ self clientDo:
		[:client | | stream |
		client binary.
		stream := RWBinaryOrTextStream on: String new.
		stream nextPutAll: (client getFileNamed: aString).
		aBlock value: stream reset]
!

writeStreamForFileNamed: aString replace: ignoreBoolean do: aBlock
	| stream |
	stream := RWBinaryOrTextStream on: String new.
	aBlock value: stream.
	self clientDo:
		[:client |
		client binary.
		client putFileStreamContents: stream reset as: aString]
! !

!MCFtpRepository class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
!

version_SVN
    ^ '$Id$'
! !