[SqueakSource] Changing the Root URL

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


'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'!

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

Why not directly commit to the repository with your mail as the commit
comment? Like this your changes are easy to find later on.

Cheers,
Lukas

--
Lukas Renggli
http://www.lukas-renggli.ch