[Seaside] Potentially nasty seaside bug.

Lawson English lenglish5 at cox.net
Sat Sep 11 05:39:43 UTC 2010


  On 9/10/10 10:12 PM, Lukas Renggli wrote:
>> I invited bunches of people to spam click on the submit button and every now
>> and then people notice that stray values start appearing in the entry field,
>> as though sessions were sharing data in some way.
> Normally that shouldn't happen, unless of course you use shared state.
>
>> It's running in a (hopefully well sand-boxed) account on my computer:
>> http://72.200.121.127:8080/SeventhTestComponent
> Can't reach it.
>
>> Not sure where to upload the source code, but you can browse the instance
>> methods from within the page.
> Maybe you can copy and paste the methods into a mail? File-out the
> class? Or publish a Monticello package?
>
> Lukas
>
Wasn't sure how to get it into a public monticello respository. Here's 
the file-out .st file.


Lawson



-------------- next part --------------
'From Squeak4.1 of 17 April 2010 [latest update: #9957] on 10 September 2010 at 10:38:32 pm'!
WAComponent subclass: #SeventhTestComponent
	instanceVariableNames: 'testvalue codeSelector'
	classVariableNames: 'Counter'
	poolDictionaries: ''
	category: 'Seaside-Bug-Test'!

!SeventhTestComponent methodsFor: 'rendering' stamp: 'LDE 9/10/2010 17:31'!
renderContentOn: html

	self renderExplanationOn: html.
	self renderCounterOn: html.
	
	html html: '<h1>some raw html </h1>'.

html form: [
      html text: 'enter value here: '.
      html textInput
         value: self inputValue;

         callback: [ :value | self handleValue: value].
	html break.
 	html text: 'result:'.
      html textArea
         value: self outputValue;
		rows: 10;
		columns: 60.
		html submitButton with: self inputValue asString, ' factorial'.
          ].
html form:[
	html text: 'source code: '.
	html select
		list:  (self class selectors);
		selected: self codeSelector ;
		"beSubmitOnChange;"
		callback: [:value | self codeSelector: value ].
		html submitButton with: 'lookup'.
	html break.
	html textArea
		value: (self class sourceCodeAt: self codeSelector);
		rows: 30;
		columns: 90.
]

"callback: [ :value | self postBody: value ].
      html break.
	html text: 'primResponse'.
	html textInput
		value: self primResponse.
      html submitButton callback: [self postMessageToPrim]"! !

!SeventhTestComponent methodsFor: 'rendering' stamp: 'LDE 9/10/2010 16:48'!
renderCounterOn: html
html break.
	html render: 'This field shows how many times a value has been sent back to server:'.
		html textArea
		value: (self class Counter).
! !

!SeventhTestComponent methodsFor: 'rendering' stamp: 'LDE 9/10/2010 11:59'!
renderExplanationOn: html
	html paragraph: 'This form  displays the result of ''yourentry factorial'' if your entry is valid input.'! !

!SeventhTestComponent methodsFor: 'rendering' stamp: 'LDE 9/8/2010 23:09'!
testvalue: anObject
	"Set the value of testvalue"
	(anObject class = Number)
	ifTrue: [testvalue := anObject factorial.]
	ifFalse: [testvalue := 'please enter an integer!!'].! !


!SeventhTestComponent methodsFor: 'accessing' stamp: 'LDE 9/10/2010 11:30'!
codeSelector
	"Answer the value of codeSelector"

	^ codeSelector! !

!SeventhTestComponent methodsFor: 'accessing' stamp: 'LDE 9/10/2010 11:30'!
codeSelector: anObject
	"Set the value of codeSelector"

	codeSelector := anObject! !

!SeventhTestComponent methodsFor: 'accessing' stamp: 'LDE 9/8/2010 23:11'!
inputValue
	"Answer the value of testvalue"

	^ inputValue! !

!SeventhTestComponent methodsFor: 'accessing' stamp: 'LDE 9/8/2010 23:14'!
inputValue: anObject
	"Set the value of inputValue"

	inputValue := anObject! !

!SeventhTestComponent methodsFor: 'accessing' stamp: 'LDE 9/8/2010 23:13'!
outputValue
	"Answer the value of testvalue"

	^ outputValue! !

!SeventhTestComponent methodsFor: 'accessing' stamp: 'LDE 9/8/2010 23:14'!
outputValue: anObject
	"Set the value of outputValue"

	outputValue := anObject! !

!SeventhTestComponent methodsFor: 'accessing' stamp: 'LDE 9/3/2010 14:13'!
testvalue
	"Answer the value of testvalue"

	^ testvalue! !


!SeventhTestComponent methodsFor: 'initialization' stamp: 'LDE 9/10/2010 11:31'!
initialize
	super initialize.
	self 
		inputValue:1;
		outputValue:1;
		codeSelector: #renderContentOn: .! !


!SeventhTestComponent methodsFor: 'error handling' stamp: 'LDE 9/9/2010 00:50'!
itsNotAPosIntegerMessageWith: aValue
	
	self outputValue: (aValue asString), ' cannot handle the factorial call'.! !

!SeventhTestComponent methodsFor: 'error handling' stamp: 'LDE 9/10/2010 15:42'!
itsTooBigANumber: aValue
	
	self outputValue: (aValue asString), ' is too big!! Keep it reasonable, like under 1,000'.! !

!SeventhTestComponent methodsFor: 'error handling' stamp: 'LDE 9/8/2010 23:52'!
returnNotAPosIntegerMessageWith: aValue
	
	^aValue asString, ' is cannot handle the factorial call'.! !

!SeventhTestComponent methodsFor: 'error handling' stamp: 'LDE 9/10/2010 11:53'!
verifyPosInteger: anObject
	"wot it says"
	|temp|
	 [temp:= anObject asNumber] on: Exception do: [ :e| ^false].
	temp := anObject asNumber.
((temp class = Integer) or: [temp class = SmallInteger] or:  [temp class = LargePositiveInteger] or:  [temp class = LargeNegativeInteger] )
	 ifTrue: [ ^((anObject asInteger) >= 0)] 
	ifFalse: [^false]
	
	
! !


!SeventhTestComponent methodsFor: 'nil' stamp: 'LDE 9/10/2010 16:27'!
add1ToCounter

self class add1ToCounter.


! !

!SeventhTestComponent methodsFor: 'nil' stamp: 'LDE 9/10/2010 16:14'!
handleValue: value

|temp|

self class add1ToCounter.
 temp := self verifyPosInteger:value. 

			temp
				ifTrue: [ (value asInteger <1000) 
					ifTrue: [self inputValue: value. 
						self outputValue: value asString, ' factorial = ', (value asInteger factorial) asString]
					ifFalse: [self itsTooBigANumber: value. self inputValue: value]]
				ifFalse: [self itsNotAPosIntegerMessageWith: value. self inputValue: value].! !

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

SeventhTestComponent class
	instanceVariableNames: 'counter'!

!SeventhTestComponent class methodsFor: 'as yet unclassified' stamp: 'LDE 9/10/2010 16:26'!
Counter


^Counter! !

!SeventhTestComponent class methodsFor: 'as yet unclassified' stamp: 'LDE 9/10/2010 16:26'!
Counter: value


 Counter := value.! !

!SeventhTestComponent class methodsFor: 'as yet unclassified' stamp: 'LDE 9/10/2010 16:27'!
add1ToCounter


 Counter := Counter + 1.! !

!SeventhTestComponent class methodsFor: 'as yet unclassified' stamp: 'LDE 9/10/2010 15:15'!
canBeRoot
	"When returning true, the component can be registered as a standalone application from the config interface."

	^ true! !

!SeventhTestComponent class methodsFor: 'as yet unclassified' stamp: 'LDE 9/10/2010 16:13'!
initialize


 Counter := 1! !


SeventhTestComponent initialize!


More information about the seaside mailing list