'From Squeak3.2 of 11 July 2002 [latest update: #4956] on 28 November 2002 at 10:36:06 am'!
Object subclass: #ChieftainModule
instanceVariableNames: 'urlMap urlPrefixMap urlSuffixMap '
classVariableNames: ''
poolDictionaries: ''
category: 'Kom-Kishi'!
!ChieftainModule commentStamp: 'BP 11/28/2002 10:35' prior: 0!
ChieftainModule
bolot 6/21/2001 03:08
bp 28/11/2002
- decides which app/module/obj handles a given URL
- urlMap is for mapping a single URL to a single object
-- e.g., cached objects
- urlPrefixMap is for mapping a URL prefix to an application
- urlSuffixMap is for mapping a URL suffix to an application (module).
----
- todo: cached objects
-- timeout
-- duplication (e.g., what if registering same object again?)
- todo: urlPrefix mapping
-- fast determination which module needs to run
- todo: session management
- todo: form processing!
ArrayedCollection subclass: #DirectoryEntry
instanceVariableNames: 'name creationTime modificationTime dirFlag fileSize '
classVariableNames: 'EntryDescriptions '
poolDictionaries: ''
category: 'System-Files'!
Object subclass: #SqueakServerPage
instanceVariableNames: 'fileName compiledMethod '
classVariableNames: ''
poolDictionaries: ''
category: 'Kom-Modules'!
!SqueakServerPage commentStamp: 'BP 11/28/2002 10:30' prior: 0!
I represent a compiled Squeak Server Page
A Squeak Server Page allows Smalltalk code to be embedded in an HTML document ala ASP, JSP, PHP.
I translate the SSP code into a compiled method. When invoked from DynamicFileModule the code is compiled and evaluated in the context of the Comanche HttpRequest.
Features:
1. Arbitrary Smalltalk code is embedded in <% ... %> tags.
2. The #printString result of some embedded code can be embedded in <%= ... %> tags.
3. Other files can be included using the <%include: filename %> tag.
4. Local variables can be decalred and refernced by subsequent tags. See issues.
5. Psuedo variable self is the Comanche HttpRequest and can be referenced.
Examples:
1. Collecting garbage.. <% Smalltalk garbage collect. %>
done.
2.
The time is: <%= Time now %>
3. <%include 'banner.ssp' %>
4. <% f _ [ :n | n factorial ] %> 5 Factorial is: <%= f value: 5 %>
4. URL is <%= self url %>
Issues
Because the Compiler class has user interface code embedded inside it, it is not trivial to declare local variables using the preferred #declareTempAndPaste:.
As such all tempoary variables are declared in Undeclared, so two SSP pages declaring the same local variable will overwrite each other.
!
Object subclass: #StaticFileModule
instanceVariableNames: 'folder slashXlat directory '
classVariableNames: ''
poolDictionaries: ''
category: 'Kom-Modules'!
StaticFileModule subclass: #DirectoryListingModule
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Kom-Modules'!
!DirectoryListingModule commentStamp: 'BP 11/28/2002 10:32' prior: 0!
I return an HTML document with the contents of the directory referenced in the HttpRequest URL.
I am instanciated on a particular FileDirectory and will only serve directories in this subtree.
See StaticFileModule !
StaticFileModule subclass: #DynamicFileModule
instanceVariableNames: 'cache mustCache '
classVariableNames: ''
poolDictionaries: ''
category: 'Kom-Modules'!
!DynamicFileModule commentStamp: 'BP 11/28/2002 10:33' prior: 0!
I am responsible for processing requests for SqueakServerPages.
A SqueakServerPage is a text file, useually with suffix .ssp which is similar to an ASP, JSP, or PSP file, in that Smalltalk code can be embedded in <% ... %> tags.
I am instanciated on a particular FileDirectory and will only serve documents in this subtree.
See StaticFileModule I maintain a cache of SqueakServerPages.
!
!ChieftainModule methodsFor: 'accessing' stamp: 'BP 11/27/2002 21:23'!
initialize
urlMap _ Dictionary new.
urlPrefixMap _ Dictionary new.
urlSuffixMap _ Dictionary new.
! !
!ChieftainModule methodsFor: 'accessing' stamp: 'BP 11/27/2002 21:24'!
mapSuffix: aString to: aModule
"make a given prefix map to the module"
urlSuffixMap at: aString put: aModule! !
!ChieftainModule methodsFor: 'accessing' stamp: 'BP 11/27/2002 22:11'!
process: request
"first, check if any cached objects are referenced"
(urlMap includesKey: request url)
ifTrue: [^urlMap at: request url].
"then check if any application's prefix matches"
urlPrefixMap keysAndValuesDo: [:urlPrefix :module |
(request url beginsWith: urlPrefix) ifTrue: [^module process: request]].
"then check if any application's suffix matches"
urlSuffixMap keysAndValuesDo: [:urlSuffix :module |
(request url endsWith: urlSuffix) ifTrue: [^module process: request]].
"otherwise, the default response"
^nil! !
!ChieftainModule class methodsFor: 'examples' stamp: 'BP 11/28/2002 08:43'!
basicExample
"ChieftainModule basicExample"
| service chief |
chief _ self new initialize.
chief
mapPrefix: '/displaycam' to: DisplayCamModule new;
mapPrefix: '/helloworld' to: HelloWorldModule new;
mapPrefix: '/turtlegraphics' to:
(TurtleGraphicsModule new initialize urlPrefix: '/turtlegraphics');
mapPrefix: '/turtleframe' to:
(TurtleFrameGraphicsModule new initialize urlPrefix: '/turtleframe').
chief
mapSuffix: '/' to: DirectoryListingModule new;
mapSuffix: '.html' to: StaticFileModule new;
mapSuffix: '.ssp' to: DynamicFileModule new.
service := ComancheNetService named: 'basicExample' onPort: 8017.
service module: chief.
service start
! !
!DirectoryEntry methodsFor: 'access' stamp: 'BP 11/28/2002 01:25'!
description
"Return a sort description of this entry. Initialize with DirectoryEntry initialize. "
^ self isDirectory
ifTrue: [ 'directory' ]
ifFalse:
[
EntryDescriptions
at: ([self suffix asLowercase] on: MessageNotUnderstood do: [nil])
ifAbsent: [ 'unknown' ].
].! !
!DirectoryEntry methodsFor: 'access' stamp: 'BP 11/28/2002 00:25'!
suffix
"return the entry name suffix"
| i |
^ (i _ name indexOf: FileDirectory extensionDelimiter) > 0
ifTrue: [ (name copyFrom: i to: name size) ]
ifFalse: [ nil ]! !
!DirectoryEntry class methodsFor: 'class initialization' stamp: 'BP 11/28/2002 01:40'!
initialize
EntryDescriptions _ Dictionary new
at: '.txt' put: 'Text file';
at: '.cs' put: 'Squeak Change Set';
at: '.cs.gz' put: 'GZipped Squeak Change Set';
at: '.st' put: 'Squeak Script file';
at: '.image' put: 'Squeak Image file';
at: '.gz' put: 'GZipped file';
at: '.html' put: 'HTML file';
at: '.htm' put: 'HTML file';
at: '.asp' put: 'Active Server Page';
at: '.jsp' put: 'Java Server Page';
at: '.ssp' put: 'Squeak Server Page';
at: '.exe' put: 'Executable File';
at: '.jpg' put: 'JPEG Image';
at: '.jpeg' put: 'JPEG Image';
at: '.pdf' put: 'Adobe Portable Document';
at: '.ps' put: 'Postscpipt file';
at: '.sar' put: 'Squeak Archive';
at: '.seg' put: 'Squeak Image Segment';
at: '.pr' put: 'Squeak Project';
yourself.
! !
!HttpRequest methodsFor: 'accessing' stamp: 'BP 11/27/2002 23:47'!
parentUrl
"useful for finding the directory above this url"
| lru i |
lru _ self url reverse.
^ (i _ lru indexOf: $/ startingAt: 2) > 0
ifTrue: [ (lru copyFrom: i to: lru size) reverse. ]
ifFalse: [ nil ]! !
!SqueakServerPage methodsFor: 'compiling' stamp: 'BP 11/28/2002 09:21'!
compileIn: aClass
"Compiles the receiver's template in aClass and returns aCompiledMethod"
| methodNode aFileStream aWriteStream |
aFileStream _ (FileStream readOnlyFileNamed: self fileName).
aWriteStream _ WriteStream on: (String new: aFileStream size + 512).
aWriteStream
nextPutAll: '| out |';
cr;
nextPutAll: 'out _ String new writeStream.';
cr.
self smalltalkFrom: aFileStream on: aWriteStream.
aWriteStream
nextPutAll: '^ out contents';
cr.
methodNode _ Compiler new
compileNoPattern: aWriteStream contents
in: aClass
context: nil
notifying: nil
ifFail: [ self error ].
^ compiledMethod _ methodNode generate: #(0 0 0 0).! !
!SqueakServerPage methodsFor: 'compiling' stamp: 'BP 11/27/2002 19:29'!
smalltalkFrom: aFileStream on: aWriteStream
"Returns the equivalent version of the receiver as Smalltalk source code"
| sspText sspOpenIndex sspCloseIndex lastIndex sspCodeIndex smalltalkExpression sspOpenTag sspCloseTag |
sspOpenTag _ '<%'. sspCloseTag _ '%>'.
sspText _ aFileStream contentsOfEntireFile.
lastIndex _ 1.
[ (sspOpenIndex _ sspText indexOfSubCollection: sspOpenTag startingAt: lastIndex) > 0]
whileTrue:
[
(sspOpenIndex - 1) > lastIndex ifTrue:
[
aWriteStream nextPutAll: 'out nextPutAll: '.
(sspText copyFrom: lastIndex to: sspOpenIndex - 1) storeOn: aWriteStream.
aWriteStream nextPut: $.; cr.
].
sspCloseIndex _ sspText
indexOfSubCollection: sspCloseTag
startingAt: sspOpenIndex
ifAbsent: [ ^ self error: 'Missing closing tag' ].
sspCodeIndex _ sspOpenIndex + (sspOpenTag size).
(sspText findString: 'include:' startingAt: sspCodeIndex caseSensitive: false) = sspCodeIndex
ifTrue:
[
| includeFile includeFileStream |
includeFile _ (sspText copyFrom: sspCodeIndex + 8 to: sspCloseIndex - 1) withBlanksTrimmed withoutQuoting.
includeFileStream _ (aFileStream directory readOnlyFileNamed: includeFile).
self smalltalkFrom: includeFileStream on: aWriteStream.
includeFileStream close.
]
ifFalse:
[
| isResultTag |
(isResultTag _ (sspText at: sspCodeIndex) = $=) ifTrue:
[
aWriteStream nextPutAll: 'out nextPutAll: ('.
sspCodeIndex _ sspCodeIndex + 1.
].
smalltalkExpression _ (sspText copyFrom: sspCodeIndex to: sspCloseIndex - 1) withBlanksTrimmed.
aWriteStream nextPutAll: smalltalkExpression.
isResultTag ifTrue: [ aWriteStream nextPutAll: ') printString'. ].
(smalltalkExpression endsWithAnyOf: #('|', '[', '(', '{', '.')) ifFalse: [ aWriteStream nextPut: $. ].
].
aWriteStream cr.
lastIndex _ sspCloseIndex + (sspCloseTag size).
].
aWriteStream nextPutAll: 'out nextPutAll: '.
(sspText copyFrom: lastIndex to: sspText size) storeOn: aWriteStream.
aWriteStream nextPut: $.; cr.
^ aWriteStream
! !
!SqueakServerPage methodsFor: 'evaluating' stamp: 'BP 11/27/2002 16:37'!
evaluateFor: anObject
"Evaluates the server page as if it was a compiled method with receiver anObject"
| cm |
cm _ self compiledMethod ifNil: [ self compileIn: anObject class ].
^ cm valueWithReceiver: anObject arguments: #().
! !
!SqueakServerPage methodsFor: 'accessing' stamp: 'BP 11/27/2002 16:33'!
compiledMethod
^ compiledMethod! !
!SqueakServerPage methodsFor: 'accessing' stamp: 'BP 11/27/2002 16:33'!
fileName
^ fileName! !
!SqueakServerPage methodsFor: 'accessing' stamp: 'BP 11/27/2002 16:32'!
fileName: aFullFileName
fileName _ aFullFileName! !
!SqueakServerPage class methodsFor: 'instance creation' stamp: 'BP 11/27/2002 16:35'!
fileNamed: aFullFileName
^self new fileName: aFullFileName; yourself.! !
!StaticFileModule methodsFor: 'comanche' stamp: 'BP 11/27/2002 13:51'!
directory
^ directory ifNil: [ directory _ self class defaultDirectory ].! !
!StaticFileModule methodsFor: 'comanche' stamp: 'BP 11/27/2002 13:52'!
directory: aFileDirectory
directory _ aFileDirectory! !
!StaticFileModule methodsFor: 'comanche' stamp: 'BP 11/27/2002 14:32'!
initialize
"Do nothing."! !
!StaticFileModule methodsFor: 'comanche' stamp: 'BP 11/27/2002 13:52'!
process: request
| filePath |
filePath _ (request url copyFrom: 2 to: request url size) translateWith: self slashXlat.
^self directory fileNamed: filePath.! !
!DirectoryListingModule methodsFor: 'as yet unclassified' stamp: 'BP 11/28/2002 01:36'!
entrySortBlock
"Sort directories first, then on name"
^ [ :a :b |
(a isDirectory & b isDirectory)
ifTrue: [ a name < b name ]
ifFalse:
[
a isDirectory
ifTrue: [ true ]
ifFalse:
[
b isDirectory
ifTrue: [ false ]
ifFalse: [ a name < b name ].
].
].
].! !
!DirectoryListingModule methodsFor: 'as yet unclassified' stamp: 'BP 11/28/2002 01:37'!
process: request
| dirPath dir stream |
dirPath _ (request url copyFrom: 2 to: request url size) translateWith: self slashXlat.
dir _self directory directoryNamed: dirPath.
stream _ WriteStream on: (String new: 512).
stream
nextPutAll: ''; cr;
nextPutAll: ' '; cr;
nextPutAll: ' '; nextPutAll: 'Index of '; nextPutAll: request url; nextPutAll: ''; cr;
nextPutAll: ' '; cr;
nextPutAll: ' '; cr;
nextPutAll: ' Index of '; nextPutAll: request url; nextPutAll: '
'; cr;
nextPutAll: '
'; cr;
nextPutAll: '
'; cr;
nextPutAll: ' Name | '; cr;
nextPutAll: ' LastModified | '; cr;
nextPutAll: ' Size | '; cr;
nextPutAll: ' Description | '; cr;
nextPutAll: '
'; cr.
request parentUrl ifNotNil:
[
stream
nextPutAll: '';
nextPutAll: '';
nextPutAll: '../'; nextPutAll: ' | ';
nextPutAll: '
'; cr.
].
(dir entries asSortedCollection: self entrySortBlock) do:
[ :e |
stream
nextPutAll: '';
nextPutAll: '';
nextPutAll: e name. e isDirectory ifTrue: [ stream nextPut: $/. ].
stream
nextPutAll: ' | '; space;
nextPutAll: ''; nextPutAll:
((Date fromSeconds: e modificationTime) printFormat: #(3 2 1 $/ 1 1 2));
space.
(Time fromSeconds: (e modificationTime) \\ 86400) print24: true on: stream.
stream
nextPutAll: ' | '; space;
nextPutAll: ''; nextPutAll: e fileSize printString; nextPutAll: ' | '; space;
nextPutAll: ''; nextPutAll: e description; nextPutAll: ' | ';
nextPutAll: '
';
cr.
].
stream
nextPutAll: '
'; cr;
nextPutAll: '
'; cr;
nextPutAll: 'Served by Comanche on ';
nextPutAll: SystemVersion current printString;
nextPutAll: ''; cr;
nextPutAll: ' '; cr;
nextPutAll: ''; cr.
^ stream contents
! !
!DynamicFileModule methodsFor: 'accessing' stamp: 'BP 11/27/2002 15:49'!
cache
"Returns the receiver's dictionary of compiled pages"
^ cache ifNil: [ cache _ Dictionary new ].! !
!DynamicFileModule methodsFor: 'accessing' stamp: 'BP 11/27/2002 16:01'!
initialize
cache _ nil.
mustCache _ true.! !
!DynamicFileModule methodsFor: 'accessing' stamp: 'BP 11/27/2002 14:21'!
mustCache
^ mustCache! !
!DynamicFileModule methodsFor: 'accessing' stamp: 'BP 11/27/2002 14:21'!
mustCache: aBoolean
mustCache _ aBoolean.! !
!DynamicFileModule methodsFor: 'accessing' stamp: 'BP 11/27/2002 17:35'!
process: aRequest
"Process request, expected to point to an STT template resource"
| filePath newSSPBlock ssp |
filePath _ (aRequest url copyFrom: 2 to: aRequest url size) translateWith: self slashXlat.
newSSPBlock _ [ SqueakServerPage fileNamed: (self directory fullNameFor: filePath) ].
ssp _ self mustCache
ifTrue: [ self cache at: filePath ifAbsentPut: newSSPBlock ]
ifFalse: newSSPBlock.
^ ssp evaluateFor: aRequest
! !
!DynamicFileModule methodsFor: 'private' stamp: 'BP 11/28/2002 09:09'!
squeakServerPageFor: aRequest
"Return a SqueakServerPage"
| filePath newSSPBlock |
filePath _ (aRequest url copyFrom: 2 to: aRequest url size) translateWith: self slashXlat.
newSSPBlock _ [ SqueakServerPage fileNamed: (self directory fileNamed: filePath) fullName ].
^ self mustCache
ifTrue: [ self cache at: filePath ifAbsentPut: newSSPBlock ]
ifFalse: newSSPBlock.
! !
!StaticFileModule class methodsFor: 'as yet unclassified' stamp: 'BP 11/27/2002 13:51'!
defaultDirectory
^ FileDirectory default directoryNamed: 'htdocs'.! !
!StaticFileModule class methodsFor: 'as yet unclassified' stamp: 'BP 11/27/2002 21:38'!
directory: aFileDirectory
^ self new
directory: aFileDirectory;
yourself.! !
!StaticFileModule class methodsFor: 'as yet unclassified' stamp: 'BP 11/27/2002 14:34'!
new
^ super new initialize! !
!DynamicFileModule reorganize!
('accessing' cache initialize mustCache mustCache: process:)
('comanche')
('private' squeakServerPageFor:)
!
StaticFileModule removeSelector: #folder!
Object subclass: #StaticFileModule
instanceVariableNames: 'directory slashXlat '
classVariableNames: ''
poolDictionaries: ''
category: 'Kom-Modules'!
!StaticFileModule reorganize!
('comanche' directory directory: initialize process: slashXlat)
!
DirectoryEntry initialize!