Object subclass: #Authorizer
	instanceVariableNames: 'users realm '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PluggableWebServer'!
Authorizer comment:
'The Authorizer does user authorization checking. Each instance of authorizer keeps track of the realm that it is authorizing for and the users table of authorized users. An authorizer can be asked to return the user name/symbol associated with a userID (which concatenates the username and password from the HTTP request) with the user: method.
'!

!Authorizer methodsFor: 'realms' stamp: 'mjg 11/3/97 12:33'!
realm
	^realm! !

!Authorizer methodsFor: 'realms' stamp: 'mjg 11/3/97 12:33'!
realm: aString
	realm := aString
! !


!Authorizer methodsFor: 'authentication' stamp: 'mjg 11/3/97 13:01'!
encode: nameString password: pwdString
	"Encode per RFC1421 of the username:password combination."

	| clear code clearSize idx map |
	clear := (nameString, ':', pwdString) asByteArray.
	clearSize := clear size.
	[ clear size \\ 3 ~= 0 ] whileTrue: [ clear := clear, #(0) ].
	idx := 1.
	map := 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'.
	code := WriteStream on: ''.
	[ idx < clear size ] whileTrue: [ code 
		nextPut: (map at: (clear at: idx) // 4 + 1);
		nextPut: (map at: (clear at: idx) \\ 4 * 16 + ((clear at: idx + 1) // 16) + 1);
   		nextPut: (map at: (clear at: idx + 1) \\ 16 * 4 + ((clear at: idx + 2) // 64) + 1);
   		nextPut: (map at: (clear at: idx + 2) \\ 64 + 1).
		idx := idx + 3 ].
	code := code contents.
	idx := code size.
	clear size - clearSize timesRepeat: [ code at: idx put: $=. idx := idx - 1].
	^code! !

!Authorizer methodsFor: 'authentication' stamp: 'mjg 11/3/97 12:31'!
mapFrom: aKey to: aPerson
	"Establish a mapping from a RFC 1421 key to a user."

	users isNil ifTrue: [ users := Dictionary new ].
	aPerson
	 isNil ifTrue: [ users removeKey: aKey ]
	 ifFalse: [
		users removeKey: (users keyAtValue: aPerson ifAbsent: []) ifAbsent: [].
		users at: aKey put: aPerson ]
! !

!Authorizer methodsFor: 'authentication' stamp: 'mjg 11/3/97 13:02'!
mapName: nameString password: pwdString to: aPerson
	"Insert/remove the encoding per RFC1421 of the username:password combination 
	 into/from the UserMap."

	self mapFrom: (self encode: nameString password: pwdString) to: aPerson
! !

!Authorizer methodsFor: 'authentication' stamp: 'mjg 11/17/97 13:07'!
user: userId
	"Return the requesting user."
	^users at: userId ifAbsent: [ self error: (PWS unauthorizedFor: realm) ]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Authorizer class
	instanceVariableNames: ''!


Object subclass: #Comment
	instanceVariableNames: ''
	classVariableNames: 'CommentsTable '
	poolDictionaries: ''
	category: 'PluggableWebServer'!
Comment comment:
'A Comment space for a Web page.'!

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Comment class
	instanceVariableNames: ''!

!Comment class methodsFor: 'initialization' stamp: 'mjg 11/10/97 10:44'!
initialize
	CommentsTable := Dictionary new.! !

!Comment class methodsFor: 'initialization' stamp: 'mjg 11/24/97 15:20'!
readIn: filename
	|f|
	f _ ReferenceStream fileNamed: filename.
	CommentsTable _ f next.
	f close.! !

!Comment class methodsFor: 'initialization' stamp: 'mjg 11/24/97 15:20'!
saveTo: filename
	|f|
	f _ ReferenceStream fileNamed: filename.
	f nextPut: CommentsTable.
	f close.! !

!Comment class methodsFor: 'initialization' stamp: 'mjg 11/17/97 14:52'!
setUpExample
	| newDiscussion |
	newDiscussion _ Discussion new.
	newDiscussion title: 'pws'.
	newDiscussion description: 'Here is a space for talking about the Pluggable Web Server.'.
	CommentsTable at: 'pws' put: newDiscussion.

! !


!Comment class methodsFor: 'URL processing' stamp: 'mjg 11/10/97 11:18'!
comments
	^CommentsTable! !

!Comment class methodsFor: 'URL processing' stamp: 'mjg 1/12/98 13:05'!
createComment: request 
	"Create a new comment from a Web request"
	| newNote newMap |
	request fields isNil ifTrue: [self error: 'No request to create a comment from!!'].
	newNote _ Note new.
	newMap _ URLmap new.
	newNote author: (request fields at: 'author' ifAbsent: ['Anonymous']).
	newNote title: (request fields at: 'title' ifAbsent: ['Untitled']).
	newNote text: (HTMLformatter swikify: (request fields at: 'text' ifAbsent: ['Nothing much to say'])
			linkhandler: [:phrase | newMap
					linkFor: phrase
					from: request peerName
					storingTo: OrderedCollection new]).
	newNote timestamp: Date today printString , ' ' , Time now printString.
	newNote children: OrderedCollection new.
	"For later addition of threaded comments"
	^ newNote! !

!Comment class methodsFor: 'URL processing' stamp: 'mjg 12/8/97 11:38'!
process: request 
	"URLs are of the form Comment.commentKey or 
	Comment.commentKey.note of Comment.commentKey.gif.
	
	If commentKey is accessed but not created, 
	create an empty one.
	If note is accessed, display it."
	| commentKey noteIndex newNote |
	commentKey _ request message at: 2.
	(CommentsTable includesKey: commentKey)
		ifFalse: 
			[CommentsTable at: commentKey put: Discussion new.
			(CommentsTable at: commentKey)
				title: commentKey.
			(CommentsTable at: commentKey)
				description: 'Discussion on ' , commentKey].
	request fields isNil
		ifFalse: 
			["Are there input fields?"
			newNote _ self createComment: request.
			newNote parent: commentKey.
			(CommentsTable at: commentKey)
				addNote: newNote.
			newNote url: ('Comment.',commentKey,'.',
				(CommentsTable at: commentKey) notes size printString)].
	request message size > 2
		ifTrue: 
			["There's a note reference or a request for a status image"
			noteIndex _ request message at: 3.
			noteIndex asUppercase = 'GIF'
			ifTrue: [
			request reply: (PWS success),(PWS content: 'image/gif').
			request reply: (HTMLformatter textToGIF: 
				(CommentsTable at: commentKey) status)]
			ifFalse: [request reply: (self showNote: ((CommentsTable at: commentKey)
						at: noteIndex asNumber))]]
		ifFalse: [request reply: (self showComment: (CommentsTable at: commentKey))]! !

!Comment class methodsFor: 'URL processing' stamp: 'mjg 11/18/97 10:28'!
showComment: aComment
	| fileName |
	fileName := (ServerAction serverDirectory) , 'ShowComment.html'.
	^HTMLformatter evalEmbedded: (FileStream fileNamed: fileName) contentsOfEntireFile with: aComment.

! !

!Comment class methodsFor: 'URL processing' stamp: 'mjg 11/18/97 10:28'!
showNote: aNote
	| fileName |
	fileName := (ServerAction serverDirectory) , 'ShowNote.html'.
	^HTMLformatter evalEmbedded: (FileStream fileNamed: fileName) contentsOfEntireFile with: aNote.
! !


Comment initialize!


Object subclass: #Discussion
	instanceVariableNames: 'notes title description relatedURL '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PluggableWebServer'!
Discussion comment:
'A Discussion has some header information and a collection of related notes.'!

!Discussion methodsFor: 'access' stamp: 'mjg 11/17/97 14:25'!
addNote: aNote
	notes isNil ifTrue: [notes _ OrderedCollection new.].
	notes add: aNote.
	^notes size
! !

!Discussion methodsFor: 'access' stamp: 'mjg 11/17/97 14:29'!
at: aKey
	^notes at: aKey! !

!Discussion methodsFor: 'access' stamp: 'mjg 11/17/97 14:24'!
at: aKey addNote: aNote
	notes isNil ifTrue: [notes _ Dictionary new.].
	notes at: aKey put: aNote.
! !

!Discussion methodsFor: 'access' stamp: 'mjg 11/17/97 14:21'!
description
	^description! !

!Discussion methodsFor: 'access' stamp: 'mjg 11/17/97 14:21'!
description: aString
	description _ aString! !

!Discussion methodsFor: 'access' stamp: 'mjg 11/17/97 14:20'!
notes
	^notes
! !

!Discussion methodsFor: 'access' stamp: 'mjg 11/17/97 14:21'!
relatedURL
	^relatedURL! !

!Discussion methodsFor: 'access' stamp: 'mjg 11/17/97 14:21'!
relatedURL: aString
	relatedURL _ aString! !

!Discussion methodsFor: 'access' stamp: 'mjg 12/8/97 11:11'!
status
	| reply |
	reply _ WriteStream on: String new.
	reply nextPutAll: 'Number of notes: ', (notes size printString).
	notes size > 0
		ifTrue: [reply nextPutAll: '. Last note: ',(notes last timestamp).].
	^reply contents! !

!Discussion methodsFor: 'access' stamp: 'mjg 11/17/97 14:20'!
title
	^title! !

!Discussion methodsFor: 'access' stamp: 'mjg 11/17/97 14:21'!
title: aString
	title _ aString! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Discussion class
	instanceVariableNames: ''!


Object subclass: #HTMLformatter
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PluggableWebServer'!
HTMLformatter comment:
'HTMLformatter class (instances don''t know anything) knows alot about HTML formatting: Creating forms, pages, different widgets, etc.  It also knows how to process Smalltalk embedded within an HTML document.
'!

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

HTMLformatter class
	instanceVariableNames: ''!

!HTMLformatter class methodsFor: 'pages and forms' stamp: 'mjg 10/31/97 16:00'!
endForm
	^ '</FORM>'
! !

!HTMLformatter class methodsFor: 'pages and forms' stamp: 'mjg 10/31/97 15:58'!
endPage
	| stream |
	stream _ WriteStream on: ''.
	stream nextPutAll: '</BODY>';cr;
	 nextPutAll: '</HTML>';cr.
	^stream contents! !

!HTMLformatter class methodsFor: 'pages and forms' stamp: 'mjg 10/31/97 15:59'!
startForm: action
	| stream |
	stream _ WriteStream on: ''.
	stream nextPutAll: '<FORM METHOD="POST" ACTION="', action, '">';
	 cr.
	^ stream contents! !

!HTMLformatter class methodsFor: 'pages and forms' stamp: 'mjg 10/31/97 15:57'!
startPage: title
	| stream |
	stream _ WriteStream on: ''.
	stream nextPutAll: '<!!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">'; cr;
	 nextPutAll: '<HTML>';cr;
	 nextPutAll: '<HEAD>';cr;
	 nextPutAll: '<TITLE>'; nextPutAll: title; nextPutAll: '</TITLE>';cr;
	 nextPutAll: '<BODY>'; cr. 
	^ stream contents! !


!HTMLformatter class methodsFor: 'translating' stamp: 'mjg 11/4/97 16:23'!
evalEmbedded: stringOrStream with: request
	| sourceStream targetStream evalStream currentStream evalValue peekValue ch |
	(stringOrStream isKindOf: Stream)
		ifTrue: [sourceStream := stringOrStream]
		ifFalse: [sourceStream := ReadStream on: stringOrStream].
	targetStream := WriteStream on: String new.
	currentStream := targetStream. 
	[sourceStream atEnd] whileFalse: 
		[ch := sourceStream next.
		ch = $< ifTrue:
			[ peekValue := sourceStream peek. (peekValue = $?) ifTrue:
				[evalStream := WriteStream on: String new.
				currentStream := evalStream.
				sourceStream next. "Eat the ?"
				ch := sourceStream next.]].
		((currentStream = evalStream) and: [ch = $?]) ifTrue:
			[ peekValue := sourceStream peek. (peekValue = $>) ifTrue:
				[sourceStream next. "Eat the >"
				currentStream := targetStream.
				evalValue := (Compiler new evaluate: (evalStream contents) 
					in: thisContext to: self notifying: nil ifFail: [^nil]).
				(evalValue isKindOf: String)
				ifFalse: [evalValue := evalValue printString].
				currentStream nextPutAll: evalValue.]]
			ifFalse: [currentStream nextPut: ch].].
	^targetStream contents

! !

!HTMLformatter class methodsFor: 'translating' stamp: 'mjg 11/25/97 11:50'!
fixEndings: aStringOrStream
	| sourceStream targetStream aLine |
	(aStringOrStream isKindOf: Stream)
		ifTrue: [sourceStream := aStringOrStream]
		ifFalse: [sourceStream := ReadStream on: aStringOrStream].
	targetStream := ReadWriteStream on: String new. 
	[sourceStream atEnd] whileFalse:
	[aLine := sourceStream upTo: (Character linefeed).
	targetStream nextPutAll: aLine.
	targetStream nextPut: Character cr.].
	^targetStream
! !

!HTMLformatter class methodsFor: 'translating' stamp: 'mjg 11/10/97 12:38'!
simpleProcess: aStringOrStream
	| sourceStream targetStream ch |
	(aStringOrStream isKindOf: Stream)
		ifTrue: [sourceStream := aStringOrStream]
		ifFalse: [sourceStream := ReadStream on: aStringOrStream].
	targetStream := WriteStream on: String new. 
	[sourceStream atEnd] whileFalse:
	[ch := sourceStream next.
	(ch = Character linefeed) ifTrue:
		[(sourceStream peek) = (Character linefeed)
		ifTrue: [sourceStream next. targetStream nextPutAll: '<p>']
		ifFalse: [targetStream nextPutAll: '<br>']].
	targetStream nextPut: ch].
	^targetStream contents.
! !

!HTMLformatter class methodsFor: 'translating' stamp: 'mjg 1/5/98 12:53'!
swikify: aStringOrStream linkhandler: aBlock 
	| sourceStream aLine targetStream start end |
	(aStringOrStream isKindOf: Stream)
		ifTrue: [sourceStream _ aStringOrStream]
		ifFalse: [sourceStream _ ReadStream on: aStringOrStream].
	targetStream _ WriteStream on: String new.
	[sourceStream atEnd]
		whileFalse: 
			[aLine _ sourceStream upTo: Character linefeed.
			" Now, look for links"
			start _ 1.
			[(start _ aLine
						indexOfSubCollection: '*'
						startingAt: start
						ifAbsent: [0]) ~= 0 and: [start < aLine size]]
				whileTrue: [(aLine at: start + 1)
						= $*
						ifTrue: 
							[aLine _ aLine
										copyReplaceFrom: start
										to: start + 1
										with: '*'.
							start _ start + 1]
						ifFalse: [(end _ aLine
										indexOfSubCollection: '*'
										startingAt: start + 1
										ifAbsent: [0]) ~= 0
								ifTrue: [aLine _ aLine
												copyReplaceFrom: start
												to: end
												with: (aBlock value: (aLine copyFrom: start + 1 to: end - 1))]
								ifFalse: [start _ start + 1]]].
			"If it's at least 4 dashes, make it a horizontal rule"
			(aLine indexOfSubCollection: '----' startingAt: 1)
				= 1
				ifTrue: [targetStream nextPutAll: '<hr>']
				ifFalse: [targetStream nextPutAll: aLine].
			sourceStream peek = $<
				ifFalse: ["If just before a tag, ignore the newline"
					sourceStream peek = Character linefeed
						ifTrue: 
							[sourceStream next.
							targetStream nextPutAll: '<p>']
						ifFalse: [targetStream nextPutAll: '<br>']]].
	^ targetStream contents! !

!HTMLformatter class methodsFor: 'translating' stamp: 'mjg 12/8/97 11:37'!
textToGIF: oneLineString
	| form filename |
	form _ (Form extent: 400@20 depth: Display depth) fillWhite.
	oneLineString displayOn: form at: 2@0. "form display."
	filename _ 'f',(SmallInteger maxVal atRandom) printString,'.gif'.
	GIFReadWriter putForm: form onFileNamed: filename.
	^(FileStream fileNamed: filename) contentsOfEntireFile

	! !


!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 10/31/97 15:48'!
checkbox: buttonname value: b 
	^ '<INPUT TYPE="checkbox" NAME="' , buttonname , '"' , (b
			ifTrue: [' CHECKED ']
			ifFalse: ['']) , '>'! !

!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 10/24/97 16:56'!
formFooter
	"Write the standard footer for a form."

	self reply: '<hr><input type=reset value="Reset"> <input type=submit value="OK"></form>'
! !

!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 10/24/97 16:58'!
formHeader: title For: aReference
	"Write the standard header for a page and form for editing anObject."

	self
		title: title;
		reply: '<form action="',aReference,'" method=post><table>'
! !

!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 10/31/97 15:54'!
graphic: f
	^self graphic: f standIn: 'Picture' alignment: 'right'! !

!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 10/31/97 15:53'!
graphic: f standIn: s alignment: a 
	^ '<IMG SRC="' , f , '" ALT="' , s , '" ALIGN=' , a printString , '>'! !

!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 10/31/97 15:55'!
hiddenName: n value: v 
	^ '<INPUT TYPE="hidden" NAME="' , n , '" VALUE="' , v asString , '">'! !

!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 10/31/97 16:02'!
linkTo: url label: label
	^'<A HREF="',url,'">',label,'</A>'.! !

!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 10/31/97 15:50'!
select: n values: values selection: selection size: size 
	^ self
		select: n
		values: values
		selections: (Array with: selection)
		size: size
		multiple: false! !

!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 10/31/97 15:49'!
select: buttonname values: values selections: selections size: size multiple: multiple 
	| stream |
	stream _ WriteStream on: ''.
	stream nextPutAll: '<SELECT NAME="' , buttonname , '"' , (multiple
				ifTrue: [' MULTIPLE']
				ifFalse: ['']) , ' SIZE=' , size printString , '>';
	 cr.
	values do: 
		[:value | 
		stream nextPutAll: '<OPTION'.
		(selections includes: value)
			ifTrue: [stream nextPutAll: ' SELECTED'].
		stream nextPutAll: '>'.
		stream nextPutAll: value;
		 cr].
	stream nextPutAll: '</SELECT>'.
	^ stream contents! !

!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 10/31/97 15:53'!
submit: label
	^ self submit: 'submit' label: label! !

!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 10/31/97 15:52'!
submit: buttonName label: v 
	^ '<INPUT TYPE="submit" NAME="' , buttonName , '" VALUE="' , v , '">'! !

!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 10/31/97 15:51'!
text: fieldName
	^ self text: fieldName value: '' length: 80.
! !

!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 10/31/97 15:51'!
text: fieldName value: v length: l 
	^ '<INPUT TYPE="text" NAME="' , fieldName , '" VALUE="' , v , '" MAXLENGTH=' , l printString , '>'! !

!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 11/4/97 14:30'!
textArea: fieldName
	^ (self textAreaStart: fieldName rows: 15 cols: 70), self textAreaEnd! !

!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 11/4/97 14:30'!
textArea: fieldName value: value
	^ (self textAreaStart: fieldName rows: 15 cols: 70), value, self textAreaEnd! !

!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 11/4/97 14:28'!
textAreaEnd
	^ '</TEXTAREA>'
! !

!HTMLformatter class methodsFor: 'formatting' stamp: 'mjg 11/4/97 14:28'!
textAreaStart: fieldName rows: rows cols: cols 
	^ '<TEXTAREA NAME="', fieldName, ' ROWS=',rows,' COLS=',cols,'>'
! !


!HTMLformatter class methodsFor: 'note support' stamp: 'mjg 11/18/97 09:38'!
show: aCollection
	"Return an HTML list to reference an ordered collection of text. Used in Chat application"
	| ret |
	ret _ WriteStream on: String new.
	ret nextPutAll: '<ul>' ; cr.
	1 to: aCollection size do: [:each |
		ret nextPutAll: '<li>'.
		ret nextPutAll: (aCollection at: each).].
	ret nextPutAll: '</ul>'.
	^ret contents
! !

!HTMLformatter class methodsFor: 'note support' stamp: 'mjg 11/19/97 10:48'!
showList: aCollection
	"Return an HTML list to reference an ordered collection of notes. 
	prefix.index will be the reference URL for the note. Used in Comment 
	application. "
	| ret aNote |
	ret _ WriteStream on: String new.
	ret nextPutAll: '<ul>';
	 cr.
	1 to: aCollection size do: 
		[:each | 
		ret nextPutAll: '<li>'.
		aNote _ aCollection at: each.
		ret nextPutAll: (self linkTo: (aNote url) label: aNote title).
		ret nextPutAll: ' ' , aNote author , ' ' , aNote timestamp;
		 cr.
		aNote children size > 0 ifTrue: [ret nextPutAll: (self showList: aNote children)]].
	ret nextPutAll: '</ul>'.
	^ ret contents! !

!HTMLformatter class methodsFor: 'note support' stamp: 'mjg 11/18/97 09:38'!
showList: aCollection parentPrefix: prefix
	"Return an HTML list to reference an ordered collection of notes. prefix.parent.index will be the reference URL for the note."
	| ret aNote |
	ret _ WriteStream on: String new.
	ret nextPutAll: '<ul>' ; cr.
	1 to: aCollection size do: [:each |
		ret nextPutAll: '<li>'.
		aNote := aCollection at: each.
		ret nextPutAll: (self linkTo: (prefix , aNote parent, '.', each printString) label: (aNote title)), '-'.
		ret nextPutAll: (self linkTo: (aNote author homepage) label: aNote author name)
			,'-',aNote timestamp ; cr.
		aNote children size > 0 ifTrue: 
			[ret nextPutAll: (self showList: aNote children prefix: (prefix , each printString))].].
	ret nextPutAll: '</ul>'.
	^ret contents
! !

!HTMLformatter class methodsFor: 'note support' stamp: 'mjg 11/18/97 09:38'!
showList: aCollection prefix: prefix
	"Return an HTML list to reference an ordered collection of notes. prefix.index will be the reference URL for the note. Used in Comment application."
	| ret aNote |
	ret _ WriteStream on: String new.
	ret nextPutAll: '<ul>' ; cr.
	1 to: aCollection size do: [:each |
		ret nextPutAll: '<li>'.
		aNote := aCollection at: each.
		ret nextPutAll: (self linkTo: (prefix , each printString) label: (aNote title)).
		ret nextPutAll: ' ',aNote author,' ',aNote timestamp ; cr.
		aNote children size > 0 ifTrue: 
			[ret nextPutAll: (self showList: aNote children prefix: (prefix , each printString))].].
	ret nextPutAll: '</ul>'.
	^ret contents
! !

!HTMLformatter class methodsFor: 'note support' stamp: 'mjg 11/19/97 10:48'!
showListWithAuthors: aCollection
	"Return an HTML list to reference an ordered collection of notes. 
	prefix.index will be the reference URL for the note. Special version for 
	linking to author's homepage, if any."
	| ret aNote |
	ret _ WriteStream on: String new.
	ret nextPutAll: '<ul>';
	 cr.
	1 to: aCollection size do: 
		[:each | 
		ret nextPutAll: '<li>'.
		aNote _ aCollection at: each.
		ret nextPutAll: (self linkTo: (aNote url) label: aNote title)
				, '-'.
		ret nextPutAll: (self linkTo: aNote author homepage label: aNote author name)
				, '-' , aNote timestamp;
		 cr.
		aNote children size > 0 ifTrue: [ret nextPutAll: (self showListWithAuthors: aNote children)]].
	ret nextPutAll: '</ul>'.
	^ ret contents! !

!HTMLformatter class methodsFor: 'note support' stamp: 'mjg 11/18/97 09:38'!
showListWithAuthors: aCollection prefix: prefix
	"Return an HTML list to reference an ordered collection of notes. prefix.index will be the reference URL for the note. Special version for linking to author's homepage, if any."
	| ret aNote |
	ret _ WriteStream on: String new.
	ret nextPutAll: '<ul>' ; cr.
	1 to: aCollection size do: [:each |
		ret nextPutAll: '<li>'.
		aNote := aCollection at: each.
		ret nextPutAll: (self linkTo: (prefix , each printString) label: (aNote title)),'-'.
		ret nextPutAll: (self linkTo: (aNote author homepage) label: aNote author name)
			,'-',aNote timestamp ; cr.
		aNote children size > 0 ifTrue: 
			[ret nextPutAll: (self showList: aNote children prefix: (prefix , each printString))].].
	ret nextPutAll: '</ul>'.
	^ret contents
! !


Object subclass: #Note
	instanceVariableNames: 'author timestamp text children title parent url '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PluggableWebServer'!
Note comment:
'Notes are general structures for users notes.  Being used in the Comment application and others.'!

!Note methodsFor: 'access' stamp: 'mjg 11/17/97 14:19'!
addChild: aNote
	children add: aNote
! !

!Note methodsFor: 'access' stamp: 'mjg 11/17/97 14:17'!
author
	^author! !

!Note methodsFor: 'access' stamp: 'mjg 11/17/97 14:17'!
author: anAuthor
	author _ anAuthor! !

!Note methodsFor: 'access' stamp: 'mjg 11/17/97 14:18'!
children
	^children
! !

!Note methodsFor: 'access' stamp: 'mjg 11/17/97 14:39'!
children: aCollection
	children _ aCollection.
! !

!Note methodsFor: 'access' stamp: 'mjg 11/17/97 14:26'!
parent
	^parent! !

!Note methodsFor: 'access' stamp: 'mjg 11/17/97 14:26'!
parent: whatever
	parent _ whatever! !

!Note methodsFor: 'access' stamp: 'mjg 11/24/97 15:12'!
storeOn: aStream
	aStream nextPutAll: '(Note new;'.
	aStream nextPutAll: 'author: ',self author storeString,';'.
	aStream nextPutAll: 'text: ',self text storeString,';'.
	aStream nextPutAll: 'parent: ',self parent storeString,';'.
	aStream nextPutAll: 'timestamp: ',self timestamp storeString,';'.
	aStream nextPutAll: 'title: ',self title storeString,';'.
	aStream nextPutAll: 'url: ',self url storeString,';'.
	aStream nextPutAll: 'yourself)'.! !

!Note methodsFor: 'access' stamp: 'mjg 11/17/97 14:17'!
text
	^text! !

!Note methodsFor: 'access' stamp: 'mjg 11/17/97 14:18'!
text: aString
	text _ aString! !

!Note methodsFor: 'access' stamp: 'mjg 11/17/97 14:18'!
timestamp
	^timestamp! !

!Note methodsFor: 'access' stamp: 'mjg 11/17/97 14:18'!
timestamp: aDateandTime
	timestamp _ aDateandTime! !

!Note methodsFor: 'access' stamp: 'mjg 11/17/97 14:17'!
title
	^title! !

!Note methodsFor: 'access' stamp: 'mjg 11/17/97 14:17'!
title: aString
	title _ aString! !

!Note methodsFor: 'access' stamp: 'mjg 11/19/97 10:45'!
url
	^url! !

!Note methodsFor: 'access' stamp: 'mjg 11/19/97 10:45'!
url: aString
	url_aString.! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Note class
	instanceVariableNames: ''!


Object subclass: #PWS
	instanceVariableNames: 'peerName userId message fields connection log url '
	classVariableNames: 'ActionTable BackupJobs ServerStatus '
	poolDictionaries: ''
	category: 'PluggableWebServer'!
PWS comment:
'PWS is the PluggableWebServer.  Documentation for it can be found at http://www.cc.gatech.edu/fac/mark.guzdial/squeak/pws/.

The PWS decouples the networking and HTTP translation roles of a Web Server from the URL translation and CGI execution roles. The latter roles are played by ServerActions.

To record a ServerAction for the PWS, use PWS link: key to: action. Key is a string that will be parsed out of the incoming URL.

PWS (and its associated files) are based on Georg Gollman''s WebServer, extended by Mark Guzdial.  Those portions are copyright 1997 Georgia Tech Research Corporation and are used with permission.  Mark Guzdial''s work on PWS was funded in part by NSF grant REC-9550458.

'!

!PWS methodsFor: 'Accessing' stamp: 'mjg 10/25/97 14:23'!
fields

   "Return the value of the instance variable 'fields'."
   ^fields! !

!PWS methodsFor: 'Accessing' stamp: 'mjg 10/25/97 14:23'!
log
   "Return the value of the instance variable 'log'."
   ^log! !

!PWS methodsFor: 'Accessing' stamp: 'mjg 10/25/97 14:23'!
log: aString
	"Add to the log."

	log nextPutAll: aString! !

!PWS methodsFor: 'Accessing' stamp: 'mjg 10/25/97 14:23'!
message

   "Return the value of the instance variable 'message'."
   ^message! !

!PWS methodsFor: 'Accessing' stamp: 'mjg 10/25/97 14:23'!
objectsInField: fieldName
  "Extract the array of objects denoted by 'fieldName', return an empty array if there are none."

  | sel |
  sel := fields at: fieldName ifAbsent: [ ^#() ].
  (sel isKindOf: Array) ifFalse: [ sel := { sel } ].
  ^sel collect: [ :s | self objectFromString: s ]
! !

!PWS methodsFor: 'Accessing' stamp: 'mjg 10/25/97 14:23'!
peerName
  "Return the requesting ipAddress"

  ^peerName! !

!PWS methodsFor: 'Accessing' stamp: 'mjg 11/26/97 10:27'!
reply: aString
	"Send back part of the reply. If we are in roll forward mode just do nothing."
	"Transcript show: 'R',aString ; cr."
	connection ifNotNil: [ connection sendData: aString ]! !

!PWS methodsFor: 'Accessing' stamp: 'mjg 10/25/97 14:33'!
url
	^ url
! !

!PWS methodsFor: 'Accessing' stamp: 'mjg 11/6/97 16:57'!
userID

   "Return the value of the instance variable 'userID'."
   ^userId! !


!PWS methodsFor: 'Initializing' stamp: 'mjg 11/4/97 13:53'!
initializeFrom: aSocket
	"Initialize me from aSocket."
	| request header idx |
	log _ WriteStream on: ''.
	connection _ aSocket.
	request _ self readRequest.
	header _ request first substrings.
	url _ self unEscape: (header at: 2).
	((idx _ header indexOf: 'Authorization:') ~= 0 and: [(header at: idx + 1)
			= 'Basic'])
		ifTrue: [userId _ header at: idx + 2].
	peerName _ connection peerName.
	log
		nextPutAll: Time totalSeconds asString; tab;
		nextPutAll: peerName asString; tab;
		nextPutAll: userId asString; tab;
		nextPutAll: url; tab;
		nextPutAll: request last asString; tab.
	message := url findTokens: '/.\?:='.
	request last notNil ifTrue: [ fields := self decodeFields: request last ]
! !

!PWS methodsFor: 'Initializing' stamp: 'mjg 10/25/97 14:22'!
readRequest
	"Read the request and return an array of header and query."

	| idx request header query length |
	request := ''.
	[	request := request, connection getData.
		(idx := request findString: (self class crlfcrlf) startingAt: 1) = 0 ] whileTrue.
	header := request copyFrom: 1 to: idx - 1.
	(request beginsWith: 'POST') ifTrue: [
		(length := request asUppercase findString: 'CONTENT-LENGTH:' startingAt: 1) = 0 
			ifTrue: [ self error: '* noLength' ].
		length := (request copyFrom: length + 15 to: 
		  (request indexOf: Character cr startingAt: length ifAbsent: [])) 
			withBlanksTrimmed asNumber + idx + 3.
		[ request size < length ] whileTrue: [ request := request, connection getData ].
		query := (request copyFrom: idx + 3 to: request size) withBlanksTrimmed ]
	ifFalse: [
		((idx := header indexOf: $?) between: 1 and: (header indexOf: (Character cr))) ifTrue: [
			query := header copyFrom: idx + 1 to: header size.
			header := header copyFrom: 1 to: idx - 1 ]].
	"Transcript show: request."
	^{ header. query }! !


!PWS methodsFor: 'Processing' stamp: 'mjg 10/24/97 17:27'!
decodeFields: aString
  "Convert the form fields in aString to a query dictionary."

  | query dict i key value |

  query := aString findTokens: '&'.
  dict := Dictionary new.
  query do: [ :tag |
    i := tag indexOf: $=.
    key := tag copyFrom: 1 to: i - 1.
    value := i < tag size ifTrue: [ self unEscape: (tag copyFrom: i + 1 to: tag size) ] ifFalse: [ nil ].
    (dict includesKey: key)
     ifFalse: [ dict at: key put: value ]
     ifTrue: [
      ((dict at: key) isKindOf: String) 
		ifTrue: [ dict at: key put: (OrderedCollection with: (dict at: key)) ].
      (dict at: key) add: value
     ]
  ].
  ^dict! !

!PWS methodsFor: 'Processing' stamp: 'mjg 11/26/97 10:22'!
getReply
  "Generate the reply."

	| key |
	Transcript show: ('Now serving:' , url printString, ' from ', peerName) ; cr.
	[key := message at: 1] ifError: [:r :c | key := nil].
	(ActionTable includesKey: key)
	ifTrue: ["Transcript show: 'Serving from action ', key ; cr."
		(ActionTable at: key) process: self]
	ifFalse: ["Transcript show: 'Serving from action Default' ; cr."
		(ActionTable at: 'Default') process: self].
! !

!PWS methodsFor: 'Processing' stamp: 'mjg 11/17/97 12:40'!
report: msg for: rec
	"Write an error report."

	"msg = 'noAuth' ifTrue: [ ^self ]."
	self log: '*** ', rec asString, ': ', msg.
	[ self reply: ((msg indexOfSubCollection: 'HTTP' startingAt: 1) = 1
		ifTrue: [ msg ] 
		ifFalse: [ 'HTTP/1.0 400 Bad Request', self class crlfcrlf, msg ])]
	 ifError: [ :m :r | ]
! !

!PWS methodsFor: 'Processing' stamp: 'mjg 10/24/97 17:29'!
unEscape: aString
  "Convert escape sequences to their proper characters."

	| rs ws c |
	rs := ReadStream on: aString.
	ws := WriteStream on: ''.
	[ rs atEnd ] whileFalse: [
		c := rs next.
		ws nextPut: 
			(c = $+ ifTrue: [ $  ] ifFalse: [
				c = $% 
					ifTrue: [ (Number readFrom: (rs next: 2) asUppercase base: 16) asCharacter ]
					ifFalse: [ c ]
				]).
		].
	^ws contents copyWithout: Character cr! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

PWS class
	instanceVariableNames: ''!

!PWS class methodsFor: 'HTTPcodes' stamp: 'mjg 11/10/97 09:22'!
content: type
	"Can also return image types"
	^'Content-Type: ', type, self crlfcrlf
! !

!PWS class methodsFor: 'HTTPcodes' stamp: 'mjg 10/25/97 12:18'!
contentHTML
	^self content: 'text/html'
! !

!PWS class methodsFor: 'HTTPcodes' stamp: 'mjg 10/25/97 12:16'!
crlf
	^String with: Character cr with: Character linefeed! !

!PWS class methodsFor: 'HTTPcodes' stamp: 'mjg 10/25/97 12:16'!
crlfcrlf
	^self crlf , self crlf.
! !

!PWS class methodsFor: 'HTTPcodes' stamp: 'mjg 11/17/97 13:01'!
notFound
	^'HTTP/1.0 404 FILE NOT FOUND',self crlf,'<title>File Not Found</title><h2>File Not Found</h2>'! !

!PWS class methodsFor: 'HTTPcodes' stamp: 'mjg 10/25/97 12:26'!
redirectTo: URL
	^'HTTP/1.0 302 FOUND', self crlf, 'Location: ',URL, self crlf,'URI: ',URL,
	self crlfcrlf! !

!PWS class methodsFor: 'HTTPcodes' stamp: 'mjg 10/25/97 12:17'!
success
	^'HTTP/1.0 200 OK',self crlf! !

!PWS class methodsFor: 'HTTPcodes' stamp: 'mjg 12/4/97 12:05'!
unauthorizedFor: realm
	^'HTTP/1.0 401 Unauthorized', self crlf, 'WWW-Authenticate: Basic realm="Squeak/',realm,'"',
	self crlfcrlf, '<html><title>Unauthorized</title><body><h2>Unauthorized for ',realm, '</h2></body>'

! !


!PWS class methodsFor: 'Backups' stamp: 'mjg 11/10/97 09:21'!
addToBackupJob: block
	"Stores blocks to be executed hourly at snapshot time."
	BackupJobs add: block.
! !


!PWS class methodsFor: 'ServerActions' stamp: 'mjg 11/6/97 16:58'!
actions
	^ActionTable! !

!PWS class methodsFor: 'ServerActions' stamp: 'mjg 10/25/97 14:39'!
link: key to: action
	ActionTable at: key put: action.
! !


!PWS class methodsFor: 'Initializing' stamp: 'mjg 11/10/97 10:22'!
initialize
	BackupJobs := OrderedCollection new.
	self addToBackupJob: [Smalltalk garbageCollect].

	ActionTable := Dictionary new.


! !

!PWS class methodsFor: 'Initializing' stamp: 'mjg 12/2/97 16:43'!
initializeAll
	| anAuthorizer |
	anAuthorizer _ Authorizer new.
	anAuthorizer realm: 'AuthorizedSpace'.
	anAuthorizer mapName: 'owner' password: 'squeak' to: 'owner'.
	self link: 'authorized' to: (AuthorizedServerAction new authorizer: anAuthorizer).
	self link: 'chat' to: ChatPage new.
	self link: 'Default' to: ServerAction new.
	self link: 'embedded' to: EmbeddedServerAction new.
	Comment setUpExample.
	self link: 'comment' to: (SinglePlugServerAction new 
			processBlock: [:request | Comment process: request]).
	self link: 'Comment' to: (SinglePlugServerAction new 
			processBlock: [:request | Comment process: request]).
! !


!PWS class methodsFor: 'Serving' stamp: 'mjg 10/25/97 14:17'!
doBackupJobs
	"This is just a wrapper so we don't have to restart the server loop when we add/remove jobs."

	BackupJobs do: [:block | [block value]
		ifError: [ :msg :rec | ^'*** ', rec asString, ': ', msg asString ].].
	^'Backup completed'

! !

!PWS class methodsFor: 'Serving' stamp: 'mjg 12/2/97 15:11'!
loopOnPort: portNumber loggingTo: fileName
	"This is the inner HTTP server loop. Periodically flush the logfile. Invoke nightly jobs."

	| port connection log clock |
	Socket initializeNetwork: 0.
	log := FileStream fileNamed: fileName. log position: log size.
	(port := ServerSocket new) bindTo: portNumber backlog: 5.
	clock := Time now hours.
	ServerStatus := #running.
	[	(connection := port listen) notNil
		ifTrue: [ log nextPutAll: (self serve: connection); cr ]
		ifFalse: [
			clock ~= Time now hours ifTrue: [
				log nextPutAll: (self doBackupJobs); cr.
				clock := Time now hours.
				ServerStatus := #snapshot ].
			"log flush. log position: log size."].
		ServerStatus = #running ] whileTrue.
	port destroy.
	log close
! !

!PWS class methodsFor: 'Serving' stamp: 'mjg 10/25/97 14:13'!
serve: aSocket
	"Create an instance and initialize it from aSocket."

	| inst |
	inst := self new.
	([ inst initializeFrom: aSocket; getReply ] ifError: [ :msg :rec | inst report: msg for: rec ])
	 ~~ #inBackground ifTrue: [ aSocket closeAndDestroy ].
	^inst log contents
! !

!PWS class methodsFor: 'Serving' stamp: 'mjg 10/25/97 14:14'!
serveOnPort: portNumber loggingTo: fileName
	"This is the outer HTTP server loop."

	[	self loopOnPort: portNumber loggingTo: fileName.
		ServerStatus = #snapshot ifTrue: [
			Smalltalk snapshot: true andQuit: false.].
		ServerStatus ~= #quit ] whileTrue
! !

!PWS class methodsFor: 'Serving' stamp: 'mjg 10/25/97 14:46'!
status
	^ServerStatus
! !

!PWS class methodsFor: 'Serving' stamp: 'mjg 10/25/97 14:17'!
stopServer
	"Stop the server."

	ServerStatus := #quit! !


PWS initialize!


Object subclass: #ServerAction
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PluggableWebServer'!
ServerAction comment:
'The ServerAction class is the default ServerAction (if the first token in the URL does not match any in the PWS ActionTable). Instances of ServerAction act like Mac Web servers -- they parse the URL into a Mac file path (including use of default.html if no final filename is provided), then return the contents of that file as the reply. 

All ServerActions get asked to process: a PWS request. This ServerAction does the processing by asking itself to checkAuthorization, to parse the request, to log the parsed request, and then to reply to the request.  Other ServerActions (like EmbeddedServerAction) can override one or more of those requests.

The ServerAction class provides a ServerDirectory service.'!

!ServerAction methodsFor: 'file input/output' stamp: 'mjg 11/17/97 14:06'!
fileContents: serverFileRef
	^(FileStream fileNamed: (ServerAction serverDirectory) , serverFileRef)
	 contentsOfEntireFile! !

!ServerAction methodsFor: 'file input/output' stamp: 'mjg 11/25/97 14:17'!
subdirectory: named
	^named, (ServerAction pathSeparator)! !


!ServerAction methodsFor: 'URL processing' stamp: 'mjg 11/4/97 16:37'!
checkAuthorization: request
	^self! !

!ServerAction methodsFor: 'URL processing' stamp: 'mjg 10/25/97 15:02'!
log: pieces to: request
	| tab |
	tab := String with: Character tab.
	request log: ((Time now printString), tab, (Date today printString), tab, (pieces printString),
	Character cr asString).

! !

!ServerAction methodsFor: 'URL processing' stamp: 'mjg 11/19/97 09:00'!
parse: request
	| filename |
	filename := (ServerAction serverDirectory) , ((request url) allButFirst copyReplaceAll: '/' with: 
		(ServerAction pathSeparator)).
	(filename endsWith: (ServerAction pathSeparator)) ifTrue: [filename _ filename , (ServerAction defaultFile)].
	^filename
! !

!ServerAction methodsFor: 'URL processing' stamp: 'mjg 11/4/97 16:37'!
process: request
	| pieces |
	self checkAuthorization: request.
	pieces _ self parse: request.
	self log: pieces to: request.
	self replyTo: pieces from: request.
! !

!ServerAction methodsFor: 'URL processing' stamp: 'mjg 11/3/97 12:10'!
replyTo: pieces from: request
	Transcript show: 'Now replying with: ', pieces; cr.
	(StandardFileStream isAFileNamed: pieces) 
	ifTrue:
		[request reply: PWS success; reply: PWS contentHTML.
		request reply: (FileStream fileNamed: pieces) contentsOfEntireFile]
	ifFalse:
		[request error: PWS notFound].

! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ServerAction class
	instanceVariableNames: ''!

!ServerAction class methodsFor: 'System Services' stamp: 'mjg 11/17/97 11:17'!
defaultFile
	^'default.html'! !

!ServerAction class methodsFor: 'System Services' stamp: 'mjg 11/20/97 10:12'!
pathSeparator
  ^String with: FileDirectory pathNameDelimiter
! !

!ServerAction class methodsFor: 'System Services' stamp: 'mjg 11/24/97 15:32'!
serverDirectory
	^'Guz 7600:Server:'.
! !


ServerAction subclass: #ChatPage
	instanceVariableNames: 'current '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PluggableWebServer'!
ChatPage comment:
'Simple ServerAction that maintains a list of the 20 most recent submissions (chat messages).
'!

!ChatPage methodsFor: 'chat processing' stamp: 'mjg 11/25/97 13:33'!
add: aMessage 
	current isNil ifTrue: [current _ OrderedCollection new].
	current add: aMessage.
	(current size > 20) 
		ifTrue: [current _ current copyFrom: (current size - 20) to: (current size)]! !

!ChatPage methodsFor: 'chat processing' stamp: 'mjg 11/17/97 13:32'!
current
	^current
! !


!ChatPage methodsFor: 'URL processing' stamp: 'mjg 11/25/97 13:34'!
process: request 
	| author note |
	request fields isNil
		ifTrue: 
			[current isNil ifTrue: [current _ OrderedCollection new].
			request reply: (HTMLformatter evalEmbedded: (self fileContents: 'chat.html')
					with: current)]
		ifFalse: 
			[author _ request fields at: 'author'.
			note _ request fields at: 'note'.
			self add: '<b>' , author , '</b> 
			<i>' , Time now printString , '-' , Date today printString , '</i><p>' , note , '<p>'.
			request fields at: 'current' put: current.
			request reply: (HTMLformatter evalEmbedded: (self fileContents: 'chat.html')
					with: request)]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ChatPage class
	instanceVariableNames: ''!


ServerAction subclass: #EmbeddedServerAction
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PluggableWebServer'!
EmbeddedServerAction comment:
'EmbeddedServerAction works like a normal ServerAction, except that it interprets any embedded Smalltalk code (within <? ?> tags, stolen from Microsoft''s notation for a similar capability) and replaces the embedded code with the value returned from the execution of the code.
'!

!EmbeddedServerAction methodsFor: 'URL processing' stamp: 'mjg 11/7/97 11:29'!
replyTo: pieces from: request
	(StandardFileStream isAFileNamed: pieces) 
	ifTrue:
		[request reply: PWS success; reply: PWS contentHTML.
		request reply: (HTMLformatter evalEmbedded:
			(FileStream fileNamed: pieces) contentsOfEntireFile with: request)]
	ifFalse:
		[request error: PWS notFound].

! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

EmbeddedServerAction class
	instanceVariableNames: ''!


EmbeddedServerAction subclass: #AuthorizedServerAction
	instanceVariableNames: 'authorizer '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PluggableWebServer'!
AuthorizedServerAction comment:
'An EmbeddedServerAction that also has an Authorizer to verify username and password.'!

!AuthorizedServerAction methodsFor: 'URL processing' stamp: 'mjg 11/17/97 11:20'!
authorizer
	^authorizer! !

!AuthorizedServerAction methodsFor: 'URL processing' stamp: 'mjg 11/17/97 11:20'!
authorizer: anAuthorizer
	authorizer _ anAuthorizer
! !

!AuthorizedServerAction methodsFor: 'URL processing' stamp: 'mjg 11/17/97 13:09'!
checkAuthorization: request
	^authorizer user: request userID.
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

AuthorizedServerAction class
	instanceVariableNames: ''!


ServerAction subclass: #PluggableServerAction
	instanceVariableNames: 'processBlock returnBlock '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PluggableWebServer'!
PluggableServerAction comment:
'A PluggableServerAction instance has two blocks in instance variables. The processBlock is executed with the web request to do any input processing that is needed. The returnBlock is executed with the web request, and its return value is sent as the output of the CGI processing.
'!

!PluggableServerAction methodsFor: 'accessing' stamp: 'mjg 11/10/97 08:58'!
processBlock: aBlock
	processBlock := aBlock.
! !

!PluggableServerAction methodsFor: 'accessing' stamp: 'mjg 11/10/97 08:59'!
returnBlock: aBlock
	returnBlock := aBlock.
! !


!PluggableServerAction methodsFor: 'URL processing' stamp: 'mjg 11/6/97 17:09'!
process: request
	processBlock value: request.
	request reply: PWS success; reply: PWS contentHTML.
	request reply: (returnBlock value: request).
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

PluggableServerAction class
	instanceVariableNames: ''!


ServerAction subclass: #ScreenshotAction
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PluggableWebServer'!

!ScreenshotAction methodsFor: 'URL processing' stamp: 'mjg 12/31/97 08:26'!
process: request
	FileDirectory default deleteFileNamed: 'screenshot.GIF'.
	GIFReadWriter putForm: Display onFileNamed: 'screenshot.GIF'.
	request reply: (PWS success), (PWS content: 'image/gif').
	request reply: (FileStream fileNamed: 'screenshot.GIF') contentsOfEntireFile.
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

ScreenshotAction class
	instanceVariableNames: ''!

!ScreenshotAction class methodsFor: 'setupForPWS' stamp: 'mjg 12/31/97 08:19'!
setUp
	PWS link: 'screenshot' to: ScreenshotAction new.
! !


Object subclass: #Session
	instanceVariableNames: 'lastAccess data '
	classVariableNames: 'Sessions '
	poolDictionaries: ''
	category: 'PluggableWebServer'!
Session comment:
'A Session can provide server-side storage of state/data between HTML pages. After creating a new session (which can be manipulated using at: and at:put:), it can be saved on the Sessions list by asking the Session class to store: the session. A random integer is returned as a key to the session, and the key can be stored in an HTML page in a hidden field.

A session can be retrieved by ID by asking Session to recall: an ID. A session can be retired when it is no longer useful.

Each recall: or use at:/at:put: "touches" (updates) the Session''s last use time. A Session that is older than a certain period (default 30 minutes, in viableTime instance method) will generate an error. Every hour, the PWS, as part of its backup procedures, will clear out old sessions.
'!

!Session methodsFor: 'access' stamp: 'mjg 11/4/97 14:12'!
at: key
	self touch.
	^data at: key ifAbsent: [self error: 'Internal key error. Please alert administrator about key',key printString].
! !

!Session methodsFor: 'access' stamp: 'mjg 11/4/97 14:12'!
at: key put: value
	self touch.
	^data at: key put: value.
! !

!Session methodsFor: 'access' stamp: 'mjg 11/4/97 14:07'!
isViable
	^ (Time now subtractTime: lastAccess) asSeconds > self viableTime! !

!Session methodsFor: 'access' stamp: 'mjg 11/4/97 14:06'!
touch
	lastAccess := Time now.
! !

!Session methodsFor: 'access' stamp: 'mjg 11/4/97 14:07'!
viableTime
	"In seconds"
	^60*30

! !


!Session methodsFor: 'initialize' stamp: 'mjg 11/4/97 16:39'!
initialize
	data := Dictionary new.
	lastAccess := Time now.
	PWS addToBackupJob: [Session user].
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Session class
	instanceVariableNames: ''!

!Session class methodsFor: 'store/recall' stamp: 'mjg 12/2/97 10:06'!
clearOld
	| aSession |
	Sessions keys do: [:s |
	aSession := Sessions at: s ifAbsent: [nil].
	aSession isNil ifFalse:
		[aSession isViable ifFalse: [self retire: s].]]! !

!Session class methodsFor: 'store/recall' stamp: 'mjg 11/4/97 14:09'!
recall: id
	| aSession |
	aSession := Sessions at: id ifAbsent: [self error: 'Non-existent session'].
	aSession isViable ifFalse: [self error: 'Your session data has expired. Please restart the operation.'].
	aSession touch.
	^aSession

! !

!Session class methodsFor: 'store/recall' stamp: 'mjg 11/4/97 14:11'!
retire: id
	Sessions removeKey: id.
! !

!Session class methodsFor: 'store/recall' stamp: 'mjg 11/4/97 14:04'!
store: aSession
	| newID |
	[	newID := SmallInteger maxVal atRandom.
		Sessions includesKey: newID ] whileTrue.
	Sessions at: newID put: aSession.
	^newID! !


!Session class methodsFor: 'initialization' stamp: 'mjg 11/4/97 16:43'!
initialize
	Sessions := Dictionary new.
	PWS addToBackupJob: [Session clearOld].

! !

!Session class methodsFor: 'initialization' stamp: 'mjg 11/4/97 13:54'!
new
	^super new initialize
! !


Session initialize!


ServerAction subclass: #SinglePlugServerAction
	instanceVariableNames: 'processBlock '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PluggableWebServer'!
SinglePlugServerAction comment:
'When asked to process: a Web request, this ServerAction simply executes its processBlock -- the simplest possible server action. It is the responsibility of the block to send a reply: to the request.'!

!SinglePlugServerAction methodsFor: 'URL processing' stamp: 'mjg 11/10/97 09:00'!
process: request
	processBlock value: request.! !


!SinglePlugServerAction methodsFor: 'accessing' stamp: 'mjg 11/10/97 09:00'!
processBlock: aBlock
	processBlock := aBlock.
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

SinglePlugServerAction class
	instanceVariableNames: ''!


ServerAction subclass: #SwikiAction
	instanceVariableNames: 'urlmap source name '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PluggableWebServer'!
SwikiAction comment:
'SwikiAction is the action to implement a Swiki, a collaborative website.  See http://guzdial.cc.gatech.edu:8080/myswiki for an example focused on discussing Swikis.

Swiki is based on the Wiki Server, designed and implemented by Ward Cunningham.  See the original Wiki at http://c2.com/cgi-bin/wiki, or the Squeak-focused one at http://c2.com:8080/
'!

!SwikiAction methodsFor: 'accessing' stamp: 'mjg 11/25/97 16:22'!
map
	"Answer the receiver's 'urlmap'."

	^urlmap! !

!SwikiAction methodsFor: 'accessing' stamp: 'mjg 11/25/97 16:23'!
map: anObject
	"Set the receiver's instance variable 'urlmap' to be anObject."

	urlmap := anObject! !

!SwikiAction methodsFor: 'accessing' stamp: 'mjg 11/25/97 16:22'!
name
	"Answer the receiver's 'name'."

	^name! !

!SwikiAction methodsFor: 'accessing' stamp: 'mjg 11/25/97 16:22'!
name: anObject
	"Set the receiver's instance variable 'name' to be anObject."

	name := anObject! !

!SwikiAction methodsFor: 'accessing' stamp: 'mjg 11/25/97 16:22'!
source
	"Answer the receiver's 'source'."

	^source! !

!SwikiAction methodsFor: 'accessing' stamp: 'mjg 11/25/97 16:22'!
source: anObject
	"Set the receiver's instance variable 'source' to be anObject."

	source := anObject! !

!SwikiAction methodsFor: 'accessing' stamp: 'mjg 11/25/97 16:22'!
urlmap
	"Answer the receiver's 'urlmap'."

	^urlmap! !

!SwikiAction methodsFor: 'accessing' stamp: 'mjg 11/25/97 16:22'!
urlmap: anObject
	"Set the receiver's instance variable 'urlmap' to be anObject."

	urlmap := anObject! !


!SwikiAction methodsFor: 'save and restore' stamp: 'mjg 1/12/98 12:11'!
restoreFrom: filename 
	| f |
	f _ ReferenceStream fileNamed: filename.
	self map: f next.
	self map action: self.
	f close! !

!SwikiAction methodsFor: 'save and restore' stamp: 'mjg 11/28/97 10:33'!
saveTo: filename
	|f|
	f _ ReferenceStream fileNamed: filename.
	f nextPut: self map.
	f close.! !


!SwikiAction methodsFor: 'URL processing' stamp: 'mjg 1/12/98 15:35'!
log: request 
	| logfile |
	logfile _ FileStream fileNamed: name , '-log.txt'.
	logfile isNil
		ifTrue: [request log: 'Failed logging on ' , name]
		ifFalse: 
			[logfile setToEnd.
			request peerName isNil
			ifTrue: [logfile nextPutAll: 'UnknownPeer' , '-' , 
				request url , '-' , Time now printString , '-' , 
				Date today printString.]
			ifFalse: [logfile nextPutAll: request peerName , '-' , 
				request url , '-' , Time now printString , '-' , 
				Date today printString.].
			logfile nextPut: Character cr.
			logfile close]! !

!SwikiAction methodsFor: 'URL processing' stamp: 'mjg 1/12/98 12:14'!
process: request 
	"URLs are of the form:
		
	{swikiname} to browse Front Page
		
	{swikiname}.{coreID} to browse the page
		
	{swikiname}.{coreID}.edit to edit the page
		
	{swikiname}.{coreID}.all displays the page and all its references
		
	{swikiname}.searchresult conducts the search and displays the result
		
	{swikiname}.recent to bring up the recent changes list
		
	{swikiname}.{coreID}.searchresult returns a search for references to coreID's key"
	"Transcript show: 'Got request ',(request url); cr."
	| coreRef pageRef command formattedPage |
	self log: request.
	request reply: PWS success;
	 reply: PWS contentHTML.
	request message size < 2
		ifTrue: [coreRef _ '1']
		ifFalse: [coreRef _ request message at: 2].
	request fields isNil
		ifFalse: ["Are there input fields?"
			coreRef = 'searchresult'
				ifTrue: 
					["If contains search string, do search"
					request reply: (HTMLformatter evalEmbedded: (self fileContents: source , 'results.html')
							with: (urlmap searchFor: (request fields at: 'searchFor' ifAbsent: ['nothing']))).
					^ self]
				ifFalse: ["It's a response from an edit, so store the page"
					urlmap
						storeID: coreRef
						text: (request fields at: 'text' ifAbsent: ['blank text'])
						from: request peerName]].
	coreRef = 'recent'
		ifTrue: 
			[request reply: (HTMLformatter evalEmbedded: (self fileContents: source , 'recent.html')
					with: urlmap recent).
			^ self].
	"At this point, coreRef is a page reference"
	pageRef _ urlmap atID: coreRef.
	request message size > 2
		ifTrue: 
			["SearchResult, All, or Edit"
			command _ request message at: 3.
			command = 'edit'
				ifTrue: 
					[request reply: (HTMLformatter evalEmbedded: (self fileContents: source , 'edit.html')
							with: pageRef).
					^ self].
			command = 'searchresult'
				ifTrue: 
					[request reply: (HTMLformatter evalEmbedded: (self fileContents: source , 'results.html')
							with: (urlmap searchFor: pageRef name)).
					^ self].
			command = 'all'
				ifTrue: 
					[
					formattedPage _ urlmap allPagesFrom: pageRef for: request.
					request reply: (HTMLformatter evalEmbedded: (self fileContents: source , 'page.html')
							with: formattedPage).
					^ self]]
		ifFalse: 
			["Just a browse"
			formattedPage _ pageRef copy.
			"Make a copy, then format the text."
			formattedPage formatted: (HTMLformatter swikify: pageRef text
					linkhandler: [:link | urlmap
							linkFor: link
							from: request peerName
							storingTo: OrderedCollection new]).
			request reply: (HTMLformatter evalEmbedded: (self fileContents: source , 'page.html')
					with: formattedPage).
			^ self]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

SwikiAction class
	instanceVariableNames: ''!

!SwikiAction class methodsFor: 'initialization' stamp: 'mjg 12/23/97 09:35'!
restore: actionName from: filename
	"Set up a named Swiki"
	| action |
	action _ SwikiAction new.
	action name: actionName.
	action source: 'swiki:'.
	action restoreFrom: filename.
	action map pages do: [:each |
		each file: (ServerAction serverDirectory),actionName,(ServerAction pathSeparator),
			((each file findTokens: (ServerAction pathSeparator)) last)].
	PWS link: actionName to: action.
! !

!SwikiAction class methodsFor: 'initialization' stamp: 'mjg 11/25/97 16:35'!
setUp
	self setUp: 'myswiki'
! !

!SwikiAction class methodsFor: 'initialization' stamp: 'mjg 1/12/98 12:15'!
setUp: actionName
	"Set up a named Swiki"
	| action map page |
	action _ SwikiAction new.
	map _ URLmap new.
	action map: map.
	action name: actionName.
	action source: 'swiki',(ServerAction pathSeparator).
	map action: action.
	map pages: (Dictionary new).
	map directory: actionName. "I assume that you've created a directory in the ServerDirectory for storing pages."
	page _ map newpage: 'Front Page' from: 'Beginning'.
	page text: (HTMLformatter evalEmbedded: 
			((FileStream fileNamed: (ServerAction serverDirectory),'swiki',
				(ServerAction pathSeparator),'FrontPage') contentsOfEntireFile) with: actionName).
	page _ map newpage: 'Formatting Rules' from: 'Beginning'.
	page text: (HTMLformatter evalEmbedded: 
			((FileStream fileNamed: (ServerAction serverDirectory),'swiki',
				(ServerAction pathSeparator),'FormattingRules') contentsOfEntireFile) with: actionName).
	PWS link: actionName to: action.
! !


Object subclass: #SwikiPage
	instanceVariableNames: 'url map formatted address file date coreID name '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PluggableWebServer'!

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/25/97 15:02'!
address
	"Answer the receiver's 'address'."

	^address! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/25/97 15:02'!
address: anObject
	"Set the receiver's instance variable 'address' to be anObject."

	address := anObject! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/25/97 15:02'!
coreID
	"Answer the receiver's 'coreID'."

	^coreID! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/25/97 15:02'!
coreID: anObject
	"Set the receiver's instance variable 'coreID' to be anObject."

	coreID := anObject! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/25/97 15:02'!
date
	"Answer the receiver's 'date'."

	^date! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/25/97 15:02'!
date: anObject
	"Set the receiver's instance variable 'date' to be anObject."

	date := anObject! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/25/97 15:02'!
file
	"Answer the receiver's 'file'."

	^file! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/25/97 15:02'!
file: anObject
	"Set the receiver's instance variable 'file' to be anObject."

	file := anObject! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/25/97 16:01'!
formatted
	^formatted
! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/25/97 16:01'!
formatted: aString
	"Never set this except on a copy"
	formatted _ aString
! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/25/97 15:02'!
map
	"Answer the receiver's 'map'."

	^map! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/25/97 15:02'!
map: anObject
	"Set the receiver's instance variable 'map' to be anObject."

	map := anObject! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/25/97 15:02'!
name
	"Answer the receiver's 'name'."

	^name! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/25/97 15:02'!
name: anObject
	"Set the receiver's instance variable 'name' to be anObject."

	name := anObject! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/24/97 16:03'!
text
	^(FileStream fileNamed: file) contentsOfEntireFile! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 1/13/98 12:51'!
text: someText
	| newfile |
	newfile _ file allButLast , ((file last asString asNumber + 1) printString last asString).
	self file: newfile.
	(FileStream fileNamed: file) position: 0 ; nextPutAll: someText ; flush ; close.
! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/25/97 15:02'!
url
	"Answer the receiver's 'url'."

	^url! !

!SwikiPage methodsFor: 'accessing' stamp: 'mjg 11/25/97 15:02'!
url: anObject
	"Set the receiver's instance variable 'url' to be anObject."

	url := anObject! !


Object subclass: #URLmap
	instanceVariableNames: 'pages directory action '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'PluggableWebServer'!

!URLmap methodsFor: 'linking' stamp: 'mjg 1/5/98 12:54'!
linkFor: string from: peer storingTo: aList
	| uString newpage |
	uString _ string asUppercase.
	(((uString indexOfSubCollection: 'HTTP' startingAt: 1) = 1) or:
	[((uString indexOfSubCollection: 'FTP' startingAt: 1) = 1) or:
	[((uString indexOfSubCollection: 'MAILTO' startingAt: 1) = 1)]])
	ifTrue:
		[((uString endsWith: 'GIF') or: [(uString endsWith: 'JPEG') or:
			[uString endsWith: 'JPG']])
		ifTrue: [^'<image src="',string,'">']
		ifFalse: [^'<a href="',string,'">',string,'</a>']]
	ifFalse: "Serious!! Gotta provide-a-link!!"
		[newpage _ pages at: string ifAbsent: [nil].
		newpage isNil ifTrue: [ "Create a new page"
			newpage _ self newpage: string from: peer.].
		(aList indexOf: newpage) ~= 0 ifFalse: [aList add: newpage]. "Add only if not there"
		^self pageURL: newpage]! !

!URLmap methodsFor: 'linking' stamp: 'mjg 11/25/97 13:23'!
linkFor: string to: peer withPrefix: prefix storingTo: aList
	| uString newpage |
	uString _ string asUppercase.
	(uString indexOfSubCollection: 'HTTP' startingAt: 1) = 1
	ifTrue:
		[((uString endsWith: 'GIF') or: [(uString endsWith: 'JPEG') or:
			[uString endsWith: 'JPG']])
		ifTrue: [^'<image src="',string,'">']
		ifFalse: [^'<a href="',string,'">',string,'</a>']]
	ifFalse: "Serious!! Gotta provide-a-link!!"
		[newpage _ pages at: string ifAbsent: [nil].
		newpage isNil ifTrue: [ "Create a new page"
			newpage _ self newpage: string from: peer.].
		aList add: newpage.
		^'<a href="',prefix,'.',newpage coreID,'">',string,'</a>']! !


!URLmap methodsFor: 'searching' stamp: 'mjg 12/3/97 09:06'!
recent
	| response sortedPages currentDate |
	sortedPages _ pages asSortedCollection: [:a :b | a date > b date].
	response _ WriteStream on: String new.
	response nextPutAll: '<h2>Recent Changes</h2><ul>'. 
	currentDate _ Date new.
	sortedPages do: [:page |
		(currentDate ~= page date)
		ifTrue: [
			currentDate _ page date.
			response nextPutAll: '</ul><p><b>',(currentDate printString),'</b><p><ul>'.].
		response nextPutAll: '<li>',(self pageURL: page),'...',(page address).].
	response nextPutAll: '</ul>'. 
	^response contents
		
		! !

!URLmap methodsFor: 'searching' stamp: 'mjg 12/5/97 12:21'!
searchFor: aString
	| hitlines response |
	hitlines _ pages select: [:each | each text includesSubstring: aString caseSensitive: false].
	hitlines isEmpty
	ifTrue: [^aString, ' not found']
	ifFalse: [
		response _ WriteStream on: String new.
		response nextPutAll: '<h2>Search results for ',aString,'</h2><ul>'.
		hitlines do: [:each
			|response nextPutAll: '<li>',(self pageURL: each),'...',(each address)].
		response nextPutAll: '</ul>'.
		^response contents].
! !


!URLmap methodsFor: 'accessing' stamp: 'mjg 11/25/97 16:31'!
action
	"Answer the receiver's 'action'."

	^action! !

!URLmap methodsFor: 'accessing' stamp: 'mjg 11/25/97 16:31'!
action: anObject
	"Set the receiver's instance variable 'action' to be anObject."

	action := anObject! !

!URLmap methodsFor: 'accessing' stamp: 'mjg 11/25/97 14:30'!
at: key
	"Return page of a given key."

	^pages at: key ifAbsent: [nil]! !

!URLmap methodsFor: 'accessing' stamp: 'mjg 11/24/97 15:54'!
at: key put: anObject
	"Add anObject to the pages list."

	pages at: key put: anObject! !

!URLmap methodsFor: 'accessing' stamp: 'mjg 11/25/97 14:30'!
atID: id
	"Return page of a given key."

	^pages detect: [:page | page coreID = id] ifNone: [pages at: 'Front Page']! !

!URLmap methodsFor: 'accessing' stamp: 'mjg 11/25/97 16:31'!
directory
	"Answer the receiver's 'directory'."

	^directory! !

!URLmap methodsFor: 'accessing' stamp: 'mjg 11/25/97 16:31'!
directory: anObject
	"Set the receiver's instance variable 'directory' to be anObject."

	directory := anObject! !

!URLmap methodsFor: 'accessing' stamp: 'mjg 11/25/97 16:31'!
pages
	"Answer the receiver's 'pages'."

	^pages! !

!URLmap methodsFor: 'accessing' stamp: 'mjg 11/25/97 16:31'!
pages: anObject
	"Set the receiver's instance variable 'pages' to be anObject."

	pages := anObject! !

!URLmap methodsFor: 'accessing' stamp: 'mjg 11/25/97 13:52'!
pageURL: aPage
	^'<a href="',(action name),'.',aPage coreID,'">',(aPage name),'</a>'! !


!URLmap methodsFor: 'creating' stamp: 'mjg 11/26/97 12:27'!
allPagesFrom: pageRef
	^self allPagesFrom: pageRef for: '' "Probably won't create new pages here"! !

!URLmap methodsFor: 'creating' stamp: 'mjg 12/3/97 11:25'!
allPagesFrom: pageRef for: request
	| formattedPage refPages allPages peer |
	(request isKindOf: PWS) ifTrue: [peer _ request peerName] ifFalse: [peer_''].
	formattedPage _ pageRef copy.  "Make a copy, then format the text."
	refPages _ OrderedCollection new.
	formattedPage formatted: (HTMLformatter swikify: (pageRef text)
								linkhandler: [:link | self linkFor: link
													from: peer
													storingTo: refPages]).
	"Now, put all referenced pages into the page"
	allPages _ WriteStream on: String new.
	allPages nextPutAll: '<h2>',(pageRef name),'</h2>', formattedPage formatted.
	refPages do: [:page |
		allPages nextPutAll: '<h2>',(page name),'</h2>'.
		allPages nextPutAll: (HTMLformatter swikify: (page text)
								linkhandler: [:link | self linkFor: link
													from: peer
													storingTo: (OrderedCollection new)]).].
	formattedPage formatted: allPages contents. "Put all the pages into THE page"
	^formattedPage
! !

!URLmap methodsFor: 'creating' stamp: 'mjg 11/25/97 16:41'!
newpage: label from: peer
	| newpage newfile |
		newpage _ SwikiPage new. 
		self at: label put: newpage. newfile _ pages size printString.
		newpage address: peer.
		newpage date: (Date today).
		newpage coreID: newfile.
		newpage name: label.
		newpage file: ((ServerAction serverDirectory), 
			directory, (ServerAction pathSeparator), newfile, '.1').
		newpage text: 'Describe ',label,' here'.
		newpage map: self.
		newpage url: (action name),'.',newfile.
	^newpage
! !

!URLmap methodsFor: 'creating' stamp: 'mjg 11/26/97 10:50'!
storeID: id text: text from: peer
	| page |
	page _ self atID: id.
	page text: text.
	page address: peer.
	page date: (Date today).
! !

!URLmap methodsFor: 'creating' stamp: 'mjg 11/26/97 10:49'!
storePage: page text: text from: peer
	page text: text.
	page address: peer.
	page date: (Date today).
! !