Opentalk-HTTP.pst 31.00 KiB
<?xml version="1.0"?>

<st-source>
<!-- 
Name: Opentalk-HTTP
Notice: Copyright © 2008 Cincom Systems, Inc.  All Rights Reserved.
Comment: This is the HTTP transport infrastructure for Opentalk. This package can be used with either the simple XML marshaler or the SOAP marshaler.

For complete documentation, see the Opentalk Developer's Guide and the Web Services Guide.

Summary

This package provides two versions of support for HTTP Transport: classes HTTPClientTransport and HTTPTransport.

HTTPClientTransport just wraps Net.HttpClient to do the actual HTTP work, and is thus only usable for clients sending requests. HTTPTransport implements both an HTTP client and an HTTP server. Note that HTTPTransport is not a fully-featured HTTP server, and might lack features that are important in some circumstances. For example, there's no built-in support for firewall proxies. If you need to use a proxy to reach an external SOAP server, you can use HTTPClientTransport. For setting up a server, you may also consider using a CGI relay with class CGITransport in the Opentalk-CGI package.

Note that class HTTPTransport assumes that application messages can carry contextual information (both XML and SOAP messages do). The transport compiles an "environment" dictionary from all the header fields of the transport message and attempts to install it into the message during unmarshaling. This allows the application to access the header fields if necessary.

The configuration message for class HTTPClientTransport is #chttp. The transport is implemented as a datagram transport therefore it has to be used with a connection-less adaptor.

For example, to set up a SOAP broker using HTTPClientTransport:

	(BrokerConfiguration standard
		adaptor: (AdaptorConfiguration connectionLess
			transport: (TransportConfiguration chttp
				marshaler: (MarshalerConfiguration soap
					bindingNamed: 'UDDIInquirySOAPBinding')))
	)	newAtPort: 4242

To configure HTTPTransport, use the message #http. The transport is a StreamTransport so it has to be used with a connection-oriented transport.

To set up a SOAP broker for HTTPTransport:

	(BrokerConfiguration standard
		adaptor: (AdaptorConfiguration connectionOriented
			transport: (TransportConfiguration http
				marshaler: (MarshalerConfiguration soap
					bindingNamed: 'UDDIInquirySOAPBinding')))
	)	newAtPort: 4242

DbIdentifier: bear73
DbTrace: 94094
DevelopmentPrerequisites: #(#(#package 'HTTP' '') #(#package 'Opentalk-Core' ''))
PackageName: Opentalk-HTTP
Parcel: #('Opentalk-HTTP')
PrerequisiteParcels: #(#('HTTP' '') #('Opentalk-Core' ''))
PrintStringCache: (751 9,tkogan)
Version: 7.6
Date: 1:00:26 pm February 1, 2008
 -->
<time-stamp>From VisualWorks®, 7.6 of February 1, 2008 on February 1, 2008 at 1:00:26 pm</time-stamp>


<do-it>(Dialog confirm: 'You are filing-in a Parcel source file!\\While this is possible it will not have\the same effect as loading the parcel.\None of the Parcel''s prerequisites will\be loaded and none of its load actions\will be performed.\\Are you sure you want to file-in?' withCRs) ifFalse: [self error: 'Parcel file-in abandoned.  Choose terminate or close.']</do-it>

<class>
<name>HTTPTransportConfiguration</name>
<environment>Opentalk</environment>
<super>Opentalk.StreamTransportConfiguration</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars>persist exceptionPrinter stopOnError environmentWithHeaders saveAttachmentsAsFiles </inst-vars>
<class-inst-vars></class-inst-vars>
<imports></imports>
<category>Opentalk-HTTP</category>
<attributes>
<package>Opentalk-HTTP</package>
</attributes>
</class>

<comment>
<class-id>Opentalk.HTTPTransportConfiguration</class-id>
<body>HTTPTransportConfiguration provides the settings for newly created HTTP connections.

Instance Variables:
	persist	&lt;Boolean&gt; connection persistence indicator
	exceptionPrinter	&lt;BlockClosure&gt; 2 argument block generating an exception description for failure responses (takes an exception and a write stream)
	stopOnError	&lt;Boolean&gt; should the transport resume the server loop on error
	environmentWithHeaders	&lt;Boolean&gt; should the transport compile request headers into the worker process environment
	saveAttachmentsAsFiles	&lt;Boolean&gt; should the transport save received attachments in to an external file or just kept in memory

</body>
</comment>

<class>
<name>HTTPTransport</name>
<environment>Opentalk</environment>
<super>Opentalk.StreamTransport</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars>socket timeout persist outgoingRequestQueue incomingRequestQueue exceptionPrinter stopOnError environmentWithHeaders saveAttachmentsAsFiles </inst-vars>
<class-inst-vars>defaultPersist defaultStopOnError defaultEnvironmentWithHeaders defaultExceptionPrinter defaultSaveAttachmentAsFiles </class-inst-vars>
<imports>
			private Net.*
			</imports>
<category>Opentalk-HTTP</category>
<attributes>
<package>Opentalk-HTTP</package>
</attributes>
</class>

<comment>
<class-id>Opentalk.HTTPTransport</class-id>
<body>HTTPTransport implements an HTTP 1.1 connection (either the client or the server side). It is expected to be used with a connectino oriented adaptor.

Instance Variables:
	socket	&lt;SocketAccessor&gt; 
	timeout	&lt;Integer&gt; inactivity timeout in milliseconds
	persist	&lt;Boolean&gt; connection persistence indicator
	outgoingRequestQueue	&lt;SharedQueue&gt; outgoing request pipeline
	incomingRequestQueue	&lt;SharedQueue&gt; incoming request pipeline
	exceptionPrinter	&lt;BlockClosure&gt; 2 argument block generating an exception description for failure responses (takes an exception and a write stream)
	stopOnError	&lt;Boolean&gt; should the transport resume the server loop on error
	environmentWithHeaders	&lt;Boolean&gt; should the transport compile request headers into the worker process environment
	saveAttachmentAsFile	&lt;Boolean&gt; should the transport save received attachments in to an external file or just kept in memory

Class Instance Variables:
	defaultPersist	&lt;Boolean&gt; connection persistence indicator
	defaultStopOnError	&lt;Boolean&gt; should the transport resume the server loop on error
	defaultEnvironmentWithHeaders	&lt;Boolean&gt; should the transport compile request headers into the worker process environment
	defaultExceptionPrinter	&lt;BlockClosure&gt; 2 argument block generating an exception description for failure responses (takes an exception and a write stream)
	defaultSaveAttachmentAsFile	&lt;Boolean&gt; should the transport save received attachments in to an external file or just kept in memory

</body>
</comment>

<class>
<name>HTTPClientTransport</name>
<environment>Opentalk</environment>
<super>Opentalk.DatagramTransport</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars></inst-vars>
<class-inst-vars></class-inst-vars>
<imports>
			private Net.*
			</imports>
<category>Opentalk-HTTP</category>
<attributes>
<package>Opentalk-HTTP</package>
</attributes>
</class>

<comment>
<class-id>Opentalk.HTTPClientTransport</class-id>
<body>HTTPClientTransport just wraps Net.HttpClient to do the actual HTTP work, therefore it is only usable for request clients. It is provided as a temporary measure until HTTPTransport can handle all the features that HttpClient can (e.g. proxy support).</body>
</comment>

<methods>
<class-id>Opentalk.HTTPTransportConfiguration</class-id> <category>accessing</category>

<body package="Opentalk-HTTP" selector="componentClass">componentClass

	^HTTPTransport</body>

<body package="Opentalk-HTTP" selector="environmentWithHeaders">environmentWithHeaders
	^environmentWithHeaders</body>

<body package="Opentalk-HTTP" selector="environmentWithHeaders:">environmentWithHeaders: aBoolean
	environmentWithHeaders := aBoolean</body>

<body package="Opentalk-HTTP" selector="exceptionPrinter">exceptionPrinter
	^exceptionPrinter</body>

<body package="Opentalk-HTTP" selector="exceptionPrinter:">exceptionPrinter: a2ArgumentBlock
	exceptionPrinter := a2ArgumentBlock</body>

<body package="Opentalk-HTTP" selector="persist">persist

	^persist</body>

<body package="Opentalk-HTTP" selector="persist:">persist: aBoolean

	persist := aBoolean</body>

<body package="Opentalk-HTTP" selector="saveAttachmentsAsFiles">saveAttachmentsAsFiles

	^saveAttachmentsAsFiles</body>

<body package="Opentalk-HTTP" selector="saveAttachmentsAsFiles:">saveAttachmentsAsFiles: aBoolean
"
	save &lt;Boolean&gt; should the transport save received attachments in to an external file or just kept in memory
"
	saveAttachmentsAsFiles := aBoolean</body>

<body package="Opentalk-HTTP" selector="stopOnError">stopOnError
	^stopOnError</body>

<body package="Opentalk-HTTP" selector="stopOnError:">stopOnError: aBoolean
	stopOnError := aBoolean</body>
</methods>

<methods>
<class-id>Opentalk.HTTPTransportConfiguration</class-id> <category>exception printing</category>

<body package="Opentalk-HTTP" selector="useExceptionDescriptionPrinter">useExceptionDescriptionPrinter

	exceptionPrinter := HTTPTransport exceptionDescriptionPrinter</body>

<body package="Opentalk-HTTP" selector="useExceptionStackPrinter">useExceptionStackPrinter

	exceptionPrinter := HTTPTransport exceptionStackPrinter</body>
</methods>

<methods>
<class-id>Opentalk.HTTPTransportConfiguration class</class-id> <category>instance creation</category>

<body package="Opentalk-HTTP" selector="rootConfigurationMetaclass">rootConfigurationMetaclass

	^TransportConfiguration class</body>
</methods>

<methods>
<class-id>Opentalk.HTTPTransport</class-id> <category>private</category>

<body package="Opentalk-HTTP" selector="buildHttpPackage">buildHttpPackage

	readStream atEnd ifTrue: [
		"When the other side closes the connection the #readWaitWithTimeoutMs: call
		returns as if there were data to read. Having no actual data to read seems to be
		the only indication of that on this side. So let's take it as that."
		OtENullPackage raiseSignal: (#ConnectionLikelyClosedByPeer &lt;&lt; #opentalk &gt;&gt; 'Connection is likely closed by the peer')].
	^[	HttpBuildHandler new
			saveAttachmentsAsFiles: self saveAttachmentsAsFiles;
			readFrom: readStream
	] on: HttpException do: [ :ex |
		(HttpStatusLineError handles: ex) ifTrue: [ ex pass ].
		ex resignalAs: (
			OtEProtocol new
				messageText: ((#x1sFailed2s &lt;&lt; #opentalk &gt;&gt; '&lt;1s&gt; failed - &lt;2s&gt;')
			expandMacrosWith: self printString
			with: ex description);
				parameter: ex;
				yourself) ]</body>

<body package="Opentalk-HTTP" selector="doStop">doStop

	socket isNil ifFalse: [
		socket close.
		socket := nil ].
	super doStop.</body>

<body package="Opentalk-HTTP" selector="extractTargetFrom:">extractTargetFrom: httpPkg
"Ideally this should return the whole path component of the URL. However there's an issue with this when you're using the CGITransport. In that case the URL is something along the lines of http://mkm/cgi-bin/laptop@4242/unitconv and pathString yields 'cgi-bin/laptop@4242/unitconv'. Of course the whole reason for switching from full URLs to just the tail was to avoid having the server location bits reflected in the object OID (which would mean that one has to fix up all the oids when he wants to move the server to a different location and even more trouble when the same server is accessible through different addresses). Using pathString in HTTPTransport and tail in CGITransport would work, however it would create an inconsistency between the two fairly similar transports. The consequences would be felt when a user develops with HTTPTransport and deploys with CGITransport.
I believe that there there is a good solution to the general issue somewhere in the CGI environment being passed with the request, we should reopen this later on." 
	^httpPkg url tail
	"^httpPkg url
		parseHost: (httpPkg fieldValueAt: 'host');
		yourself"</body>

<body package="Opentalk-HTTP" selector="handleIncomingMessage:">handleIncomingMessage: pkg

	super handleIncomingMessage: pkg.
	(self persist not and: [pkg isReply]) ifTrue: [ self stop ]</body>

<body package="Opentalk-HTTP" selector="handleIncomingMessageError:">handleIncomingMessageError: anException

	super handleIncomingMessageError: anException.
	(OtENullPackage, OtECommunicationFailure handles: anException) ifTrue: [^self stop].
	(OtEProtocol handles: anException) ifTrue: [
		^self stopOnError
			ifTrue: [self stop]
			ifFalse: [ | stream |
				stream := (String new: 50) writeStream.
				self exceptionPrinter value: anException value: stream.
				self sendTransportPackage: (
					(HttpResponse code: '400')
						contents: stream contents;
						yourself)] ].
	"This is to allow the application protocol layer to act on the error in case the protocol requires it (e.g. SOAP)"
	unmarshaler handlingIncomingMessageFailedBecause: anException</body>

<body package="Opentalk-HTTP" selector="oldVersionHeader">oldVersionHeader

	^#'X-Opentalk-OldVersion'</body>

<body package="Opentalk-HTTP" selector="readTransportPackage">readTransportPackage

	| httpPkg |
	httpPkg := [ self buildHttpPackage
		] 	on: OsError
			do: [ :ex |
				ex resignalAs: (OtECommunicationFailure new
					messageText: ((#x1sFailed2s &lt;&lt; #opentalk &gt;&gt; '&lt;1s&gt; failed - &lt;2s&gt;')
			expandMacrosWith: self printString
			with: ex description);
					parameter: ex;
					yourself) ].
	readStream lineEndCRLF.
	httpPkg isConnectionTransient ifTrue: [ self persist: false ].
	^httpPkg isResponse
		ifTrue: [	[	[	[ HttpException handleResponse: httpPkg
						] on: HttpInformationalError do: [ :ex |
							"Handle the 100-Continue"
							ex return: self receiveTransportPackage ]
					] on: HttpClientError, HttpServerError do: [ :ex |
						ex return: httpPkg.
						"marshaler handleResponseException: ex" ]
				] on: HttpException do: [ :ex |
					ex resignalAs: (OtECommunicationFailure new
						messageText: ((#x1sFailed2s &lt;&lt; #opentalk &gt;&gt; '&lt;1s&gt; failed - &lt;2s&gt;')
			expandMacrosWith: self printString
			with: ex description);
						parameter: ex;
						yourself) ]	]						
		ifFalse: [httpPkg]</body>

<body package="Opentalk-HTTP" selector="readyToHandleIncomingMessage">readyToHandleIncomingMessage

	^super readyToHandleIncomingMessage
		and: [ readStream basicAtEnd not
			or: [ (socket readWaitWithTimeoutMs: timeout) not ] ]</body>

<body package="Opentalk-HTTP" selector="socket">socket

	^socket</body>
</methods>

<methods>
<class-id>Opentalk.HTTPTransport</class-id> <category>initialize-release</category>

<body package="Opentalk-HTTP" selector="initializeBuffers:">initializeBuffers: bufferSize
"Do nothing for now. This might get more interesting when we figure out how to manage IOBuffer size.
But until then, we certianly don't need the 2K of TransportMessageHeaders that Transport creates"</body>

<body package="Opentalk-HTTP" selector="initializeSendLock">initializeSendLock

	sendLock := RecursionLock new</body>

<body package="Opentalk-HTTP" selector="initializeStreams">initializeStreams

	writeStream := (socket asExternalConnection withEncoding: #ISO8859_1) writeStream.
	writeStream lineEndCRLF.
	readStream := (socket asExternalConnection withEncoding: #ISO8859_1) readStream.
	readStream lineEndCRLF.</body>

<body package="Opentalk-HTTP" selector="setManager:id:socket:">setManager: aManager id: aConnectionId socket: aSocket

	timeout := aManager connectionTimeout.
	socket := aSocket.
	outgoingRequestQueue := SharedQueue new.
	incomingRequestQueue := SharedQueue new.
	"Need to set socket first because streams are created on top of it."
	super setManager: aManager id: aConnectionId socket: aSocket.</body>
</methods>

<methods>
<class-id>Opentalk.HTTPTransport</class-id> <category>transport-API</category>

<body package="Opentalk-HTTP" selector="createApplicationPackageFrom:">createApplicationPackageFrom: anHttpEntity

	| message | 
	message := unmarshaler unmarshalHttpPayloadFrom: anHttpEntity.

	self environmentWithHeaders ifTrue: [
		anHttpEntity fields do: [ :fld |
				"Have to use symbols as keys because process environment uses IdentityDictionary"
			 message environmentAt: fld canonicalFieldName asSymbol put: fld] ].
	(anHttpEntity version = 'HTTP/1.0') ifTrue: [
		"We need the indication of a 1.0 request when generating the response"
		 message environmentAt: self oldVersionHeader put: true ].

	^message</body>

<body package="Opentalk-HTTP" selector="createTransportPackageFrom:">createTransportPackageFrom: anApplicationPkg

	| httpPkg |
	httpPkg := anApplicationPkg isReply
		ifTrue: [ HttpResponse code: (
				anApplicationPkg failed
					ifTrue: ['500']
					ifFalse: ['200'] ) ]
		ifFalse: [ HttpRequest post: anApplicationPkg target ].
	httpPkg := marshaler marshalHttpPayloadFrom: anApplicationPkg into: httpPkg.
	self persist
		ifTrue: [ 	( anApplicationPkg isReply
					and: [ anApplicationPkg environment notNil
					and: [ anApplicationPkg environment
							at: self oldVersionHeader ifAbsent: [false] ] ]
				) ifTrue: [ httpPkg connection: 'Keep-Alive' ] ]
		ifFalse: [ httpPkg connection: 'close' ].
	^httpPkg</body>

<body package="Opentalk-HTTP" selector="handlingIncomingMessage">handlingIncomingMessage
"Get the next income package and dispatches it."

	| pkg |
	[	(pkg := self nextPackage) isNil ifTrue: [ ^nil].
		self handleIncomingMessage: pkg
	]	on: Error
		do: [:ex | self handleIncomingMessageError: ex]</body>

<body package="Opentalk-HTTP" selector="nextPackage">nextPackage

	| pkg |
	pkg := super nextPackage.
	pkg isReply
		ifTrue: ["HTTP 1.1 pipelining requires the responses to be coming in the same order
			as the requests were sent out."
			pkg requestId: outgoingRequestQueue next requestId]
		ifFalse: ["Need to queue up inbound requests to support proper outbound response pipelining"
			incomingRequestQueue nextPut: pkg].
	^pkg</body>

<body package="Opentalk-HTTP" selector="sendPackage:">sendPackage: pkg

	pkg isReply
		ifTrue: ["This implements pipelining of outbound responses"
			incomingRequestQueue peek = pkg request ifFalse: [
				pkg request wait].
			super sendPackage: pkg.
			(incomingRequestQueue isEmpty or: [
				incomingRequestQueue next = pkg request ]) ifFalse: [
				self error: (#PipelineQueueIsMessedUp &lt;&lt; #opentalk &gt;&gt; 'Pipeline queue is messed up!')].
			incomingRequestQueue isEmpty
				ifTrue: [self persist ifFalse: [self stop]]
				ifFalse: [incomingRequestQueue peek signal]]
		ifFalse: ["We have to extend the critical region to include the pipeline handling,
			otherwise several competing client processes can mess up the pipeline"
			sendLock critical: [
				"Need to queue up oubound requests to be able to match inbound responses to them"
				outgoingRequestQueue nextPut: pkg.
				[	super sendPackage: pkg.
				] ifCurtailed: [
					"If there is a problem in transmission of the request, we have to remove it from the pipeline,
					because there won't be a reply for it coming and the pipeline would loose synchronization."
					outgoingRequestQueue retract: pkg ]]]</body>

<body package="Opentalk-HTTP" selector="sendTransportPackage:">sendTransportPackage: httpPkg

	super sendTransportPackage: httpPkg.
	[	httpPkg writeOn: writeStream.
		writeStream commit
	] 	on: OsError
		do: [ :ex |
			ex resignalAs: (OtECommunicationFailure new
				messageText: ((#x1sFailed2s &lt;&lt; #opentalk &gt;&gt; '&lt;1s&gt; failed - &lt;2s&gt;')
			expandMacrosWith: self printString
			with: ex description);
				parameter: ex;
				yourself) ].
	writeStream lineEndCRLF</body>
</methods>

<methods>
<class-id>Opentalk.HTTPTransport</class-id> <category>accessing</category>

<body package="Opentalk-HTTP" selector="broker">broker

	^self manager orb</body>

<body package="Opentalk-HTTP" selector="environmentWithHeaders">environmentWithHeaders

	^environmentWithHeaders ifNil: [
		configuration environmentWithHeaders ifNil: [
			self class defaultEnvironmentWithHeaders ] ]</body>

<body package="Opentalk-HTTP" selector="environmentWithHeaders:">environmentWithHeaders: aBoolean

	environmentWithHeaders := aBoolean</body>

<body package="Opentalk-HTTP" selector="exceptionPrinter">exceptionPrinter

	^exceptionPrinter ifNil: [
		configuration exceptionPrinter ifNil: [
			self class defaultExceptionPrinter ] ]</body>

<body package="Opentalk-HTTP" selector="exceptionPrinter:">exceptionPrinter: a2ArgumentBlock

	exceptionPrinter := a2ArgumentBlock</body>

<body package="Opentalk-HTTP" selector="persist">persist

	^persist ifNil: [
		configuration persist ifNil: [
			self class defaultPersist ] ]</body>

<body package="Opentalk-HTTP" selector="persist:">persist: aBoolean

	persist := aBoolean</body>

<body package="Opentalk-HTTP" selector="saveAttachmentsAsFiles">saveAttachmentsAsFiles

	^saveAttachmentsAsFiles ifNil: [
		configuration saveAttachmentsAsFiles ifNil: [
			self class defaultSaveAttachmentsAsFiles ] ]</body>

<body package="Opentalk-HTTP" selector="saveAttachmentsAsFiles:">saveAttachmentsAsFiles: aBoolean
"
	save &lt;Boolean&gt; should the transport save received attachments in to an external file or just kept in memory
"
	saveAttachmentsAsFiles := aBoolean</body>

<body package="Opentalk-HTTP" selector="stopOnError">stopOnError

	^stopOnError ifNil: [
		configuration stopOnError ifNil: [
			self class defaultStopOnError ] ]</body>

<body package="Opentalk-HTTP" selector="stopOnError:">stopOnError: aBoolean

	stopOnError := aBoolean</body>
</methods>

<methods>
<class-id>Opentalk.HTTPTransport</class-id> <category>soap</category>

<body package="Opentalk-HTTP" selector="requestMatchingReply:">requestMatchingReply: aSOAPReply

	^outgoingRequestQueue peek</body>
</methods>

<methods>
<class-id>Opentalk.HTTPTransport class</class-id> <category>accessing</category>

<body package="Opentalk-HTTP" selector="protocolTag">protocolTag

	^'http'</body>
</methods>

<methods>
<class-id>Opentalk.HTTPTransport class</class-id> <category>defaults-constants</category>

<body package="Opentalk-HTTP" selector="defaultEnvironmentWithHeadersValue">defaultEnvironmentWithHeadersValue

	^true</body>

<body package="Opentalk-HTTP" selector="defaultExceptionPrinterValue">defaultExceptionPrinterValue

	^self exceptionDescriptionPrinter</body>

<body package="Opentalk-HTTP" selector="defaultPersistValue">defaultPersistValue

	^true</body>

<body package="Opentalk-HTTP" selector="defaultSaveAttachmentsAsFilesValue">defaultSaveAttachmentsAsFilesValue

	^false</body>

<body package="Opentalk-HTTP" selector="defaultStopOnErrorValue">defaultStopOnErrorValue

	^false</body>

<body package="Opentalk-HTTP" selector="exceptionDescriptionPrinter">exceptionDescriptionPrinter

	^[ :exception :stream |
		stream nextPutAll: exception description ]</body>

<body package="Opentalk-HTTP" selector="exceptionStackPrinter">exceptionStackPrinter

	^[ :exception :stream |
		exception
			nestedStackTraceOn: stream
			indentedTo: 0 ]</body>
</methods>

<methods>
<class-id>Opentalk.HTTPTransport class</class-id> <category>defaults-accessing</category>

<body package="Opentalk-HTTP" selector="defaultEnvironmentWithHeaders">defaultEnvironmentWithHeaders

	^defaultEnvironmentWithHeaders ifNil: [
		self defaultEnvironmentWithHeadersValue ]</body>

<body package="Opentalk-HTTP" selector="defaultEnvironmentWithHeaders:">defaultEnvironmentWithHeaders: aBoolean

	defaultEnvironmentWithHeaders := aBoolean</body>

<body package="Opentalk-HTTP" selector="defaultExceptionPrinter">defaultExceptionPrinter

	^defaultExceptionPrinter ifNil: [
		self defaultExceptionPrinterValue ].</body>

<body package="Opentalk-HTTP" selector="defaultExceptionPrinter:">defaultExceptionPrinter: a2ArgumentBlock

	defaultExceptionPrinter := a2ArgumentBlock</body>

<body package="Opentalk-HTTP" selector="defaultPersist">defaultPersist

	^defaultPersist ifNil: [
		self defaultPersistValue ].</body>

<body package="Opentalk-HTTP" selector="defaultPersist:">defaultPersist: aBoolean

	defaultPersist := aBoolean</body>

<body package="Opentalk-HTTP" selector="defaultSaveAttachmentsAsFiles">defaultSaveAttachmentsAsFiles

	^defaultSaveAttachmentAsFiles ifNil: [ self defaultSaveAttachmentsAsFilesValue ]</body>

<body package="Opentalk-HTTP" selector="defaultSaveAttachmentsAsFiles:">defaultSaveAttachmentsAsFiles: aBoolean
"
	save &lt;Boolean&gt; should the transport save received attachments in to an external file or just kept in memory
"
	defaultSaveAttachmentAsFiles := aBoolean</body>

<body package="Opentalk-HTTP" selector="defaultStopOnError">defaultStopOnError

	^defaultStopOnError ifNil: [
		self defaultStopOnErrorValue ].</body>

<body package="Opentalk-HTTP" selector="defaultStopOnError:">defaultStopOnError: aBoolean

	defaultStopOnError := aBoolean</body>
</methods>

<methods>
<class-id>Opentalk.HTTPTransport class</class-id> <category>deprecated</category>

<body package="Opentalk-HTTP" selector="environmentWithHeaders">environmentWithHeaders

	^defaultEnvironmentWithHeaders ifNil: [ self defaultEnvironmentWithHeaders ]</body>

<body package="Opentalk-HTTP" selector="environmentWithHeaders:">environmentWithHeaders: aBoolean

	defaultEnvironmentWithHeaders := aBoolean</body>
</methods>

<methods>
<class-id>Opentalk.HTTPTransport class</class-id> <category>private</category>

<body package="Opentalk-HTTP" selector="new:socketTo:for:">new: aConfiguration socketTo: aSocketAddress for: aManager
"Create a socket connected to the given remote address"

	| skt |
	skt := HttpSocketAccessor 
			family: SocketAccessor AF_INET
			type: SocketAccessor SOCK_STREAM.
	[ skt connectTo: aSocketAddress timeout: aManager connectingTimeout ]
		on: OsError
		do: [ :ex | ex resignalAs: (OtECommunicationFailure new
				messageText: ((#FailedToConnectTo1s &lt;&lt; #opentalk &gt;&gt; 'Failed to establish connection to &lt;1s&gt;')
			expandMacrosWith: aSocketAddress printString);
				yourself) ].
	^skt</body>
</methods>

<methods>
<class-id>Opentalk.HTTPClientTransport</class-id> <category>accessing</category>

<body package="Opentalk-HTTP" selector="socketIsInactiveOrNil">socketIsInactiveOrNil
	
	^true</body>
</methods>

<methods>
<class-id>Opentalk.HTTPClientTransport</class-id> <category>private</category>

<body package="Opentalk-HTTP" selector="startServerProcess">startServerProcess

	"Let's remove the server process for now while we do the client side only"</body>
</methods>

<methods>
<class-id>Opentalk.HTTPClientTransport</class-id> <category>transport-API</category>

<body package="Opentalk-HTTP" selector="sendPackage:">sendPackage: pkg
"Note that there's no server process with this transport, therefore we have to make sure that the response is delivered to it's response within this thread"

	^sendLock critical: [ | httpRequest httpResponse reply |
		httpRequest := HttpRequest post: pkg target.
		httpRequest := marshaler marshalHttpPayloadFrom: pkg into: httpRequest.
		self sendingPackage: httpRequest.
		httpResponse := httpRequest execute.
		self receivingPackage: httpResponse.
		reply := unmarshaler unmarshalHttpPayloadFrom: httpResponse.
		pkg returnWith: reply ]</body>
</methods>

<methods>
<class-id>Opentalk.HTTPClientTransport class</class-id> <category>accessing</category>

<body package="Opentalk-HTTP" selector="protocolTag">protocolTag

	^'chttp'</body>
</methods>

<methods>
<class-id>Opentalk.RemoteMessage</class-id> <category>testing</category>

<body package="Opentalk-HTTP" selector="isResponse">isResponse

	^self isReply</body>
</methods>

<methods>
<class-id>Net.HttpEntity</class-id> <category>opentalk</category>

<body package="Opentalk-HTTP" selector="size">size

	^self contentLength</body>
</methods>

<methods>
<class-id>Opentalk.TransportConfiguration class</class-id> <category>types</category>

<body package="Opentalk-HTTP" selector="chttp">chttp

	^self new: HTTPClientTransport</body>

<body package="Opentalk-HTTP" selector="http">http

	^HTTPTransportConfiguration new</body>
</methods>

<methods>
<class-id>Opentalk.RemoteRequest</class-id> <category>private</category>

<body package="Opentalk-HTTP" selector="signal">signal
"This is just reusing the promise instvar on the server side, since the promise is not necessary there"

	promise isNil ifTrue: [
		promise := Semaphore new ].
	promise signal</body>

<body package="Opentalk-HTTP" selector="wait">wait
"This is just reusing the promise instvar on the server side, since the timed promise is needed on the client side only"

	promise isNil ifTrue: [
		promise := Semaphore new ].
	promise wait</body>
</methods>

<methods>
<class-id>Core.SharedQueue</class-id> <category>accessing</category>

<body package="Opentalk-HTTP" selector="retract:">retract: anObject
"This is to allow a producer to retract it's previous submission into the queue if it's still there. Use with caution."

	^[	accessProtect critical: [
			contents remove: anObject ifAbsent: [nil]]
	] valueUninterruptably</body>
</methods>

<do-it>"Imported Classes:"</do-it>

<do-it>self error: 'Attempting to file-in parcel imports.  Choose terminate or close'</do-it>

<class>
<name>StreamTransportConfiguration</name>
<environment>Opentalk</environment>
<super>Opentalk.TransportConfiguration</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars></inst-vars>
<class-inst-vars></class-inst-vars>
<imports></imports>
<category>Opentalk-Core</category>
<attributes>
<package>Opentalk-Core</package>
</attributes>
</class>

<class>
<name>RemoteMessage</name>
<environment>Opentalk</environment>
<super>Core.Object</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars>requestId interceptorDispatcher </inst-vars>
<class-inst-vars></class-inst-vars>
<imports></imports>
<category>Opentalk-Core</category>
<attributes>
<package>Opentalk-Core</package>
</attributes>
</class>

<class>
<name>RemoteRequest</name>
<environment>Opentalk</environment>
<super>Opentalk.RemoteMessage</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars>target message timeout promise reply </inst-vars>
<class-inst-vars></class-inst-vars>
<imports></imports>
<category>Opentalk-Core</category>
<attributes>
<package>Opentalk-Core</package>
</attributes>
</class>

<class>
<name>StreamTransport</name>
<environment>Opentalk</environment>
<super>Opentalk.RequestTransport</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars>id writeStream readStream </inst-vars>
<class-inst-vars></class-inst-vars>
<imports></imports>
<category>Opentalk-Core</category>
<attributes>
<package>Opentalk-Core</package>
</attributes>
</class>

<class>
<name>HttpEntity</name>
<environment>Net</environment>
<super>Net.MimeEntity</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars>nextNamespaceId useGZipTransfer chunkSize decodeContents decompressContents shouldChunk </inst-vars>
<class-inst-vars></class-inst-vars>
<imports>
			OS.ZLib.*
			</imports>
<category>Net-HTTP-Support</category>
<attributes>
<package>HTTP</package>
</attributes>
</class>

<class>
<name>SharedQueue</name>
<environment>Core</environment>
<super>Core.Object</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars>contents accessProtect readSynch </inst-vars>
<class-inst-vars></class-inst-vars>
<imports></imports>
<category>Kernel-Processes</category>
<attributes>
<package>Kernel-Processes</package>
</attributes>
</class>

<class>
<name>DatagramTransport</name>
<environment>Opentalk</environment>
<super>Opentalk.RequestTransport</super>
<private>false</private>
<indexed-type>none</indexed-type>
<inst-vars></inst-vars>
<class-inst-vars></class-inst-vars>
<imports></imports>
<category>Opentalk-Core</category>
<attributes>
<package>Opentalk-Core</package>
</attributes>
</class>

</st-source>