Hi,

I've wanted to set up a SqueakSource, but that instance should not run
at the root URL. Changing the Root URL in the Repository Settings just
change it in some links.

So I introduced SSRepository class>>defaultPath which returns
'/squeaksource' for example. In that case, the whole repository would be
accessible from http://www.example.org/squeaksource/.

The change set containing my changes is attached to this mail.

I've also modified SSRepository>>superUserEmail. It did not work if no
superuser is in the repository and no superUserEmail is set in the
properties.

The changes were made to SqueakSource-lr.1016.mcz from
http://www.squeaksource.com/ss.html

Maybe it's helpful for some others or will be adapted in further versions.

Regards,
  David

-------------- next part --------------
'From Squeak3.9 of 7 November 2006 [latest update: #7067] on 29 April 2007 at 9:36:09 pm'!
SSModel subclass: #SSRepository
	instanceVariableNames: 'title members projects groups properties tags '
	classVariableNames: 'Current Statistics StatisticsThread Storage RootUrl '
	poolDictionaries: ''
	category: 'SqueakSource-Model'!

!SSFrame methodsFor: 'accessing' stamp: 'dt 4/29/2007 21:14'!
actions
	| controller path |
	controller _ self component activeController.
	path _ SSRepository defaultPath, '/feed.rss'.
	^ Array streamContents: [ :stream |
		self isHome ifTrue: [ 
			stream nextPutAll: (Array with: 'RSS feed' with: path);
				nextPutAll: #(
					'Register Member' #registerMember
					'Register Group' #registerGroup
					'Register Project' #registerProject ).
			self session isSuperUser ifTrue: [
				stream nextPutAll: #('Edit Settings' #editSettings)]].
		(controller respondsTo: #actions)
			ifTrue: [ stream nextPutAll: controller actions ] ]! !


!SSKom class methodsFor: 'accessing' stamp: 'dt 4/29/2007 18:04'!
default
	| application |
	application _ (WAApplication path: SSRepository defaultPath )
		sessionClass: SSSession;
		preferenceAt: #entryPoint put: SSFrame;
		preferenceAt: #showToolbar put: false;
		preferenceAt: #errorPage put: WAEmailErrorPage;
		yourself.
	^self handler: application! !


!SSRepository methodsFor: 'accessing-settings' stamp: 'dt 4/29/2007 19:47'!
superUserEmail
	
	^ self properties
		at: #superUserEmail
		ifAbsent: [String streamContents: [:strm |
			self members ifNotEmpty: [
				self members do: [:ea |
					ea isSuperUser ifTrue: [
						strm nextPutAll: ea email; nextPut: $,]].
				strm skip: -1]]].
! !


!SSRepository class methodsFor: 'private' stamp: 'dt 4/29/2007 21:32'!
defaultPath
	^'/squeaksource'! !

!SSRepository class methodsFor: 'private' stamp: 'dt 4/29/2007 19:16'!
defaultRootUrl
	| hostName |
	hostName _ NetNameResolver nameForAddress: (NetNameResolver localHostAddress) timeout: 5.
	hostName ifNil: [hostName _ NetNameResolver localAddressString].
	^'http://', hostName, ':', self defaultPort asString, self defaultPath, '/'! !


!SSSession methodsFor: 'private' stamp: 'dt 4/29/2007 21:30'!
getFile: aProject
	| fileName accessPath |
	accessPath _ self request accessPath.
	(SSRepository defaultPath count: [:each | each = $/]) timesRepeat: [
		accessPath ifNotEmpty: [accessPath removeFirst]].
	fileName _ accessPath second.

	"rss feed"
	fileName = 'feed.rss'
		ifTrue: [ ^self getRss: aProject ].

	"robots.txt"
	fileName = 'robots.txt'
		ifTrue: [ ^self getRobotsTxt ].

	aProject configs at: fileName
		ifPresent: [:aConfig | ^ self getConfig: aConfig].

	fileName = 'blessed'
		ifTrue:	[ accessPath size > 2
					ifTrue: [fileName _ accessPath third]
					ifFalse: [^ self getBlessed: aProject]].

	"mc diff"
	(fileName endsWith: MCMcdReader extension)
		ifTrue: [^self getDiff: fileName from: aProject].

	"ancestory graph"
	SSGraphBuilder formats do: [ :each |
		(fileName endsWith: '.' , each)
			ifTrue: [ ^self getFile: fileName for: aProject ] ].
	
	"mcz"
	self getVersion: fileName from: aProject! !

!SSSession methodsFor: 'actions' stamp: 'dt 4/29/2007 21:30'!
getRequest: aProject
	| accessPath |
	self expire.
	accessPath _ self request accessPath.
	(SSRepository defaultPath count: [:each | each = $/]) timesRepeat: [
		accessPath ifNotEmpty: [accessPath removeFirst]].
	
	accessPath size > 1
		ifTrue: [ self getFile: aProject ]
		ifFalse: [ self getListing: aProject ] ! !

!SSSession methodsFor: 'actions' stamp: 'dt 4/29/2007 21:30'!
putRequest: aProject
	| author data version response blessed accessPath |
	self expire.
	accessPath _ self request accessPath.
	(SSRepository defaultPath count: [:each | each = $/]) timesRepeat: [
		accessPath ifNotEmpty: [accessPath removeFirst]].
	
	(self isAllowed: SSAccessPolicy write in: aProject)
		ifFalse: [ self authentificateProject: aProject ].
	author _ self user ifNil: [ SSMember anonymousMember ].
	self storage log: 'PUT ', self request url, ' (', author initials, ')'.
	data _ self request at: 'PUTData'.

	(self request url endsWith: '.mcm')
		ifTrue: [aProject addConfig: data author: author url: self request url]
		ifFalse: [version _ aProject addVersion: data author: author].

	(version notNil and: [ accessPath second = 'blessed'])
		ifTrue: [blessed _ true.
				aProject
					blessVersion: version
					ifForbidden: [ blessed _ false] ].
	self save.
	response _ SSCreatedResponse new.
	blessed ifNotNil: [
		blessed
			ifTrue: [ response nextPutAll: 'Version blessed' ]
			ifFalse: [ response nextPutAll: 'Version NOT blessed' ] ].
	self returnResponse: response! !

!SSSession methodsFor: 'request handling' stamp: 'dt 4/29/2007 21:30'!
createRootFromRequest: aRequest
	"Make a project home page for projectname.html"
	| accessPath frame |
	frame _ super createRootFromRequest: aRequest.
	accessPath _ self request accessPath.
	(SSRepository defaultPath count: [:each | each = $/]) timesRepeat: [
		accessPath ifNotEmpty: [accessPath removeFirst]].
	accessPath isEmpty ifFalse: [
		(self projectNamed: (accessPath first copyUpToLast: $.))
			ifNotNilDo: [:project | frame setComponent: project view]].
	^ frame! !

!SSSession methodsFor: 'request handling' stamp: 'dt 4/29/2007 21:30'!
handleProject: aSymbol 
	" This method looks-up the project if outside a seaside-session and if successfull initializes a stateless environment with error-handler and escape continuation that can be used similarly while while inside a session. "

	| actionDictionary |
	^self withErrorHandler: [
		self withEscapeContinuation: [
			| accessPath project |
				accessPath _ self request accessPath.
				(SSRepository defaultPath count: [:each | each = $/]) timesRepeat: [
					accessPath ifNotEmpty: [accessPath removeFirst]].
				project _ self
				projectNamed: accessPath first
				ifNotAllowed: [ :pjct | self authentificateProject: pjct ].
			project isNil 
				ifTrue: [ 
					actionDictionary _ Dictionary new
						at: 'feed.rss' put: [ self getRss ];
						at: 'sitemap.xml.gz' put: [ self getSitemapZipped ];
						at: 'robots.txt' put: [ self getRobotsTxt ];
						at: self repository faviconFilename put: [ self getFavicon ];
						yourself.
					(actionDictionary
						at: accessPath first
						ifAbsent: [ self errorNotFound: accessPath first ]) value ]
				ifFalse: [ self perform: aSymbol with: project ] ] ]! !

!SSSession methodsFor: 'request handling' stamp: 'dt 4/29/2007 21:30'!
wantsSessionForRequest: aRequest
	"We want to start a regular session if the path is empty or a project home page (projectname.html)"
	| accessPath fileName baseName |
	accessPath _ self request accessPath.
	(SSRepository defaultPath count: [:each | each = $/]) timesRepeat: [
		accessPath ifNotEmpty: [accessPath removeFirst]].
	
	"first visit, a url without a path"
	accessPath isEmpty ifTrue: [^true].
	
	"project listing"
	accessPath size > 1 ifTrue: [^false].
	
	fileName _ accessPath first.
	(fileName endsWith: '.html') ifFalse: [^false].
	baseName _ fileName copyUpToLast: $. .
	^ (self projectNamed: baseName) notNil! !

SSModel subclass: #SSRepository
	instanceVariableNames: 'title members projects groups properties tags'
	classVariableNames: 'Current RootUrl Statistics StatisticsThread Storage'
	poolDictionaries: ''
	category: 'SqueakSource-Model'!