SeasideSt · jbrichau · Sep 19, 2021 · Aug 11, 2021
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/README.md b/repository/Seaside-Core.package/WACORSFilter.class/README.md
@@ -0,0 +1 @@
+Implements a WARequestFilter that adds support to handle CORS requests.
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/addAllowedMethod..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/addAllowedMethod..st
@@ -0,0 +1,6 @@
+methods
+addAllowedMethod: httpMethod
+
+	self allowedMethods add: httpMethod
+
+
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/addAllowedMethodsHeadersTo..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/addAllowedMethodsHeadersTo..st
@@ -0,0 +1,7 @@
+headers
+addAllowedMethodsHeadersTo: aResponse
+
+	self allowedMethods ifNotEmpty: [:allowed |
+		aResponse
+			headerAt: 'Access-Control-Allow-Methods'
+			put: (', ' join: allowed) ]
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/addAllowedOrigin..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/addAllowedOrigin..st
@@ -0,0 +1,6 @@
+origins
+addAllowedOrigin: originUrlString
+
+	self allowedOrigins add: originUrlString asString
+
+
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/addAllowedOriginHeadersTo..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/addAllowedOriginHeadersTo..st
@@ -0,0 +1,9 @@
+headers
+addAllowedOriginHeadersTo: aResponse
+
+	self allowedOrigins ifNotEmpty: [ :allowed | 
+		| allowedOrigin |
+		allowedOrigin := allowed first.
+		aResponse headerAt: 'Access-Control-Allow-Origin' put: allowedOrigin.
+		allowedOrigin = '*' ifFalse: [ 
+			aResponse headerAt: 'Vary' put: 'Origin' ] ]
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/addCORSHeadersTo..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/addCORSHeadersTo..st
@@ -0,0 +1,5 @@
+headers
+addCORSHeadersTo: response
+
+	self addAllowedOriginHeadersTo: response.
+	self addAllowedMethodsHeadersTo: response
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/addExposedHeadersTo..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/addExposedHeadersTo..st
@@ -0,0 +1,7 @@
+headers
+addExposedHeadersTo: aResponse
+
+	self exposedHeaders ifNotEmpty: [ :exposed | 
+		aResponse
+			headerAt: 'Access-Control-Expose-Headers'
+			put: (', ' join: exposed) ]
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/allowAnyOrigin.st b/repository/Seaside-Core.package/WACORSFilter.class/instance/allowAnyOrigin.st
@@ -0,0 +1,6 @@
+origins
+allowAnyOrigin
+
+	self addAllowedOrigin: '*'
+
+
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/allowedHeaders..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/allowedHeaders..st
@@ -0,0 +1,4 @@
+accessing
+allowedHeaders: anObject
+
+	allowedHeaders := anObject
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/allowedHeaders.st b/repository/Seaside-Core.package/WACORSFilter.class/instance/allowedHeaders.st
@@ -0,0 +1,4 @@
+accessing
+allowedHeaders 
+
+	^allowedHeaders
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/allowedMethods..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/allowedMethods..st
@@ -0,0 +1,4 @@
+accessing
+allowedMethods: anObject
+
+	allowedMethods := anObject
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/allowedMethods.st b/repository/Seaside-Core.package/WACORSFilter.class/instance/allowedMethods.st
@@ -0,0 +1,4 @@
+accessing
+allowedMethods 
+
+	^allowedMethods
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/allowedOrigins..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/allowedOrigins..st
@@ -0,0 +1,4 @@
+accessing
+allowedOrigins: anObject
+
+	allowedOrigins := anObject
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/allowedOrigins.st b/repository/Seaside-Core.package/WACORSFilter.class/instance/allowedOrigins.st
@@ -0,0 +1,4 @@
+accessing
+allowedOrigins 
+
+	^allowedOrigins ifNil: [ allowedOrigins := OrderedCollection new ]
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/allowsAnyOrigin.st b/repository/Seaside-Core.package/WACORSFilter.class/instance/allowsAnyOrigin.st
@@ -0,0 +1,6 @@
+testing
+allowsAnyOrigin
+
+	^self allowedOrigins anySatisfy: [ :origin | origin = '*' ]
+
+
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/allowsCredentials..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/allowsCredentials..st
@@ -0,0 +1,4 @@
+accessing
+allowsCredentials: anObject
+
+	allowsCredentials := anObject
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/allowsCredentials.st b/repository/Seaside-Core.package/WACORSFilter.class/instance/allowsCredentials.st
@@ -0,0 +1,4 @@
+accessing
+allowsCredentials
+
+	^ allowsCredentials
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/denyAllOrigins.st b/repository/Seaside-Core.package/WACORSFilter.class/instance/denyAllOrigins.st
@@ -0,0 +1,6 @@
+origins
+denyAllOrigins
+
+	self allowedOrigins removeAll
+
+
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/explicitMethods.st b/repository/Seaside-Core.package/WACORSFilter.class/instance/explicitMethods.st
@@ -0,0 +1,4 @@
+methods
+explicitMethods
+
+	^#('GET' 'POST' 'HEAD')
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/exposedHeaders..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/exposedHeaders..st
@@ -0,0 +1,4 @@
+accessing
+exposedHeaders: anObject
+
+	exposedHeaders := anObject
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/exposedHeaders.st b/repository/Seaside-Core.package/WACORSFilter.class/instance/exposedHeaders.st
@@ -0,0 +1,4 @@
+accessing
+exposedHeaders 
+
+	^exposedHeaders
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/handleCORSFiltered..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/handleCORSFiltered..st
@@ -0,0 +1,5 @@
+handling
+handleCORSFiltered: aRequestContext
+
+	self addCORSHeadersTo: aRequestContext response.
+	super handleFiltered: aRequestContext.
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/handleCORSPreflight..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/handleCORSPreflight..st
@@ -0,0 +1,7 @@
+handling
+handleCORSPreflight: aRequestContext
+
+	| response |
+	response := aRequestContext response.
+	self addCORSHeadersTo: response.
+	aRequestContext respond
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/handleFiltered..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/handleFiltered..st
@@ -0,0 +1,11 @@
+handling
+handleFiltered: aRequestContext
+
+	"Pass on the aRequestContext to the next filter or handler. Subclasses might override this method to customize the request and response handling."
+
+	(self isPreflight: aRequestContext request)
+		ifTrue: [ self handleCORSPreflight: aRequestContext ]
+		ifFalse: [ 
+			(self isCORS: aRequestContext request) 
+				ifTrue: [ self handleCORSFiltered: aRequestContext ]
+				ifFalse: [ super handleFiltered: aRequestContext ]]
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/initialize.st b/repository/Seaside-Core.package/WACORSFilter.class/instance/initialize.st
@@ -0,0 +1,9 @@
+private
+initialize 
+
+	super initialize.
+	allowedOrigins := OrderedCollection new.
+	allowedHeaders := OrderedCollection new.
+	allowedMethods := OrderedCollection new.
+	exposedHeaders := OrderedCollection new.
+	allowsCredentials := false
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/isCORS..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/isCORS..st
@@ -0,0 +1,4 @@
+testing
+isCORS: aRequest
+
+	^ (aRequest headerAt: 'origin') notNil
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/isPreflight..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/isPreflight..st
@@ -0,0 +1,4 @@
+testing
+isPreflight: aRequest
+
+	^ aRequest method = 'OPTIONS' and: [ self isCORS: aRequest ]
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/removeAllMethods.st b/repository/Seaside-Core.package/WACORSFilter.class/instance/removeAllMethods.st
@@ -0,0 +1,4 @@
+methods
+removeAllMethods
+
+	self allowedMethods removeAll
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/removeAllowedOrigin..st b/repository/Seaside-Core.package/WACORSFilter.class/instance/removeAllowedOrigin..st
@@ -0,0 +1,6 @@
+origins
+removeAllowedOrigin: originUrlString
+
+	self allowedOrigins remove: originUrlString asString ifAbsent: [ ]
+
+
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/instance/useExplicitMethods.st b/repository/Seaside-Core.package/WACORSFilter.class/instance/useExplicitMethods.st
@@ -0,0 +1,4 @@
+methods
+useExplicitMethods
+
+	self allowedMethods addAll: self explicitMethods 
diff --git a/repository/Seaside-Core.package/WACORSFilter.class/properties.json b/repository/Seaside-Core.package/WACORSFilter.class/properties.json
@@ -0,0 +1,17 @@
+{
+	"commentStamp" : "EstebanMaringolo 8/11/2021 10:50",
+	"super" : "WARequestFilter",
+	"category" : "Seaside-Core-Filter",
+	"classinstvars" : [ ],
+	"pools" : [ ],
+	"classvars" : [ ],
+	"instvars" : [
+		"allowedOrigins",
+		"allowedMethods",
+		"allowedHeaders",
+		"exposedHeaders",
+		"allowsCredentials"
+	],
+	"name" : "WACORSFilter",
+	"type" : "normal"
+}
diff --git a/repository/Seaside-Core.package/WAUrl.class/instance/withoutResource.st b/repository/Seaside-Core.package/WAUrl.class/instance/withoutResource.st
@@ -0,0 +1,8 @@
+copying
+withoutResource
+
+	^ self copy
+		  path: OrderedCollection new;
+		  queryFields: nil;
+		  fragment: nil;
+		  yourself
diff --git a/repository/Seaside-Tests-Core.package/WAUrlTest.class/instance/testWithoutResource.st b/repository/Seaside-Tests-Core.package/WAUrlTest.class/instance/testWithoutResource.st
@@ -0,0 +1,13 @@
+tests-copy
+testWithoutResource
+	| copy |
+	url addField: 'foo' value: 'bar'.
+	url scheme: 'http'.
+	url host: 'localhost'.
+	url port: 9000.
+
+	copy := url withoutResource.
+	url addToPath: 'zork'.
+	url addField: 'zork'.
+	self assert: url printString equals: 'http://localhost:9000/zork?foo=bar&zork'.
+	self assert: copy printString equals: 'http://localhost:9000/'
diff --git a/...ory/Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/README.md b/...ory/Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/README.md
diff --git a/...itory/Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/class/register.st b/...itory/Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/class/register.st
@@ -0,0 +1,5 @@
+initialization
+register
+	<script>
+
+	WAAdmin register: self asApplicationAt: 'corsTest'
diff --git a/...ory/Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/baseUrl.st b/...ory/Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/baseUrl.st
@@ -0,0 +1,12 @@
+accessing-urls
+baseUrl
+
+	| parts url |
+	parts := self requestContext request host findTokens: ':'.
+	url := self requestContext request url withoutSeasideQueryFields 
+		       path: OrderedCollection new.
+
+	url host: parts first.
+	parts size > 1 ifTrue: [ url port: parts last asInteger ].
+
+	^ url
diff --git a/...ctional.package/WACORSFilterFunctionalTest.class/instance/buildDataUrlFor.crossOrigin..st b/...ctional.package/WACORSFilterFunctionalTest.class/instance/buildDataUrlFor.crossOrigin..st
@@ -0,0 +1,13 @@
+accessing-urls
+buildDataUrlFor: host crossOrigin: crossOrigin
+
+	| port |
+	port := crossOrigin
+		        ifTrue: [ WACORSResourceExample corsAdaptorPort ]
+		        ifFalse: [WACORSResourceExample originAdaptorPort ].
+	^self baseUrl
+		 port: port;
+		 addToPath: 'tests';
+		 addToPath: 'corsData';
+		 addToPath: 'entries';
+		 yourself
diff --git a/.../Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/corsFilter.st b/.../Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/corsFilter.st
@@ -0,0 +1,8 @@
+private
+corsFilter
+
+	^ [ 
+	  (WADispatcher default handlerAtAll: #( 'tests' 'corsData' ))
+		  filters detect: [ :each | each isKindOf: WACORSFilter ] ]
+		  on: Error
+		  do: [ :ex | ex return: nil ]
diff --git a/...-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/crossOriginDataUrl.st b/...-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/crossOriginDataUrl.st
@@ -0,0 +1,8 @@
+accessing-urls
+crossOriginDataUrl
+
+	| parts host crossOrigin |
+	parts := self requestContext request host findTokens: ':'.
+	host := parts first.
+	crossOrigin := parts last asInteger == WACORSResourceExample originAdaptorPort.
+	^ self buildDataUrlFor: host crossOrigin: crossOrigin
diff --git a/...ests-Functional.package/WACORSFilterFunctionalTest.class/instance/errorHandlerFunction.st b/...ests-Functional.package/WACORSFilterFunctionalTest.class/instance/errorHandlerFunction.st
@@ -0,0 +1,8 @@
+javascript
+errorHandlerFunction
+
+	^(JSStream on: 'console.error(arguments[0])') , (JSStream on:
+		   'document.getElementById("result").style.backgroundColor = "red"')
+	  , (JSStream on:
+			   'document.getElementById("result").innerHTML = "<p>Error</p>"') 
+		  asFunction: #( 'result' )
diff --git a/.../Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/initialize.st b/.../Seaside-Tests-Functional.package/WACORSFilterFunctionalTest.class/instance/initialize.st
@@ -0,0 +1,4 @@
+private
+initialize 
+
+	super initialize.
diff --git a/...ests-Functional.package/WACORSFilterFunctionalTest.class/instance/originTextToUrlTable.st b/...ests-Functional.package/WACORSFilterFunctionalTest.class/instance/originTextToUrlTable.st
@@ -0,0 +1,6 @@
+accessing
+originTextToUrlTable
+
+	^ OrderedDictionary
+		  with: 'Same Origin' -> self sameOriginDataUrl
+		  with: 'Cross Origin' -> self crossOriginDataUrl
diff --git a/...sts-Functional.package/WACORSFilterFunctionalTest.class/instance/renderAdaptorSetupOn..st b/...sts-Functional.package/WACORSFilterFunctionalTest.class/instance/renderAdaptorSetupOn..st
@@ -0,0 +1,13 @@
+rendering
+renderAdaptorSetupOn: html
+
+	html paragraph:
+		'This test needs to setup a separate Seaside server adaptor, to handle requests at a different host:port, in order to make requests cross-origin.'.
+
+	html form: [ 
+		html button
+			callback: [ 
+				WACORSResourceExample
+					register;
+					registerCorsAdaptor ];
+			with: 'Register CORS Server adaptor' ]
diff --git a/...unctional.package/WACORSFilterFunctionalTest.class/instance/renderCORSFilterMethodsOn..st b/...unctional.package/WACORSFilterFunctionalTest.class/instance/renderCORSFilterMethodsOn..st
@@ -0,0 +1,21 @@
+rendering-configuration
+renderCORSFilterMethodsOn: html
+
+	html heading
+		level2;
+		with: 'Currently allowed Methods.'.
+	self corsFilter allowedMethods
+		ifEmpty: [ html text: 'None' ]
+		ifNotEmpty: [ :allowed | html unorderedList list: allowed ].
+
+	html form: [ 
+		html button
+			callback: [ 
+				self corsFilter
+					addAllowedMethod: 'DELETE' ];
+			with: 'Allow DELETE'.
+		html space.
+
+		html button
+			callback: [ self corsFilter removeAllMethods ];
+			with: 'Remove all methods' ]
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1 @@
		Implements a WARequestFilter that adds support to handle CORS requests.