1004 lines
23 KiB
Smalltalk
1004 lines
23 KiB
Smalltalk
PackageLoader fileInPackage: #Sockets.
|
||
PackageLoader fileInPackage: #NetClients.
|
||
|
||
SoapConfigurationMap subclass: SoapConnectorMap [
|
||
|
||
<comment: nil>
|
||
<category: 'SOAP-Client-Base'>
|
||
|
||
SoapConnectorMap class >> at: aSymbol [
|
||
<category: 'actions'>
|
||
| cls |
|
||
cls := super at: aSymbol.
|
||
^cls isNil ifTrue: [SoapNoSuchConnector signal: aSymbol] ifFalse: [cls new]
|
||
]
|
||
|
||
SoapConnectorMap class >> rootImplClassName [
|
||
<category: 'factory'>
|
||
^#SoapAbstractConnector
|
||
]
|
||
]
|
||
|
||
|
||
|
||
Object subclass: SoapAbstractConnector [
|
||
| envelopeBuilder |
|
||
|
||
<category: 'SOAP-Client-Base'>
|
||
<comment: 'I connect to some server.
|
||
My subclasses will know what socket client should be used for connecting right server.
|
||
|
||
---
|
||
MU 10/5/2002 01:35'>
|
||
|
||
ShowLog := nil.
|
||
|
||
SoapAbstractConnector class >> initialize [
|
||
"SoapAbstractConnector initialize"
|
||
|
||
<category: 'class initialization'>
|
||
ShowLog := false.
|
||
self initializeAfterLoad
|
||
]
|
||
|
||
SoapAbstractConnector class >> initializeAfterLoad [
|
||
<category: 'class initialization'>
|
||
self name == #SoapAbstractConnector
|
||
ifFalse: [SoapConnectorMap at: self transportName asSymbol put: self]
|
||
]
|
||
|
||
SoapAbstractConnector class >> initializeAll [
|
||
"SoapAbstractConnector initializeAll"
|
||
|
||
<category: 'class initialization'>
|
||
self subclassesDo: [:each | each initialize]
|
||
]
|
||
|
||
SoapAbstractConnector class >> showLog [
|
||
<category: 'setting'>
|
||
^ShowLog
|
||
]
|
||
|
||
SoapAbstractConnector class >> showLog: aBoolean [
|
||
<category: 'setting'>
|
||
ShowLog := aBoolean
|
||
]
|
||
|
||
SoapAbstractConnector class >> transportName [
|
||
<category: 'constants'>
|
||
^#noName
|
||
]
|
||
|
||
debugReturn: aSoapMessage [
|
||
<category: 'actions'>
|
||
self class showLog
|
||
ifTrue:
|
||
[| envelope context |
|
||
envelope := aSoapMessage envelope.
|
||
context := aSoapMessage context.
|
||
Transcript
|
||
cr;
|
||
cr;
|
||
show: '##';
|
||
show: super printString;
|
||
show: ' Client:Return:{';
|
||
cr;
|
||
show: envelope printString;
|
||
cr;
|
||
show: '}'.
|
||
Transcript
|
||
cr;
|
||
show: '-> with ->'.
|
||
Transcript
|
||
cr;
|
||
show: context printString]
|
||
]
|
||
|
||
debugSend: aSoapEnvelope to: anSoapLocatorObject with: aSoapContext [
|
||
<category: 'actions'>
|
||
self class showLog
|
||
ifTrue:
|
||
[Transcript
|
||
cr;
|
||
show: '##' , super printString , ' Client:Request:{'.
|
||
Transcript
|
||
cr;
|
||
show: aSoapEnvelope printString.
|
||
Transcript
|
||
cr;
|
||
show: '} to ->'.
|
||
Transcript
|
||
cr;
|
||
show: anSoapLocatorObject printString.
|
||
Transcript
|
||
cr;
|
||
show: '-> with ->'.
|
||
Transcript
|
||
cr;
|
||
show: aSoapContext printString]
|
||
]
|
||
|
||
envelopeBuilder [
|
||
<category: 'accessing'>
|
||
envelopeBuilder isNil ifTrue: [envelopeBuilder := SoapEnvelopeBuilder new].
|
||
^envelopeBuilder
|
||
]
|
||
|
||
envelopeBuilder: aSoapEnvelopeBuilder [
|
||
<category: 'accessing'>
|
||
envelopeBuilder := aSoapEnvelopeBuilder
|
||
]
|
||
|
||
send: aSoapEnvelope to: anSoapLocatorObject with: aSoapContext [
|
||
"1. add an addittinal protocolSpecific header to aSoapEnvelope"
|
||
|
||
"2. send a SoapMessage to a remote server"
|
||
|
||
"3. get the result and unmarshall it"
|
||
|
||
"4. return aSoapMessage or nil"
|
||
|
||
<category: 'actions'>
|
||
^self subclassResponsibility
|
||
]
|
||
]
|
||
|
||
|
||
|
||
SoapAbstractConnector subclass: SoapHttpConnector [
|
||
|
||
<category: 'SOAP-Client-Http'>
|
||
<comment: nil>
|
||
|
||
SoapHttpConnector class >> initialize [
|
||
<category: 'class initialization'>
|
||
self initializeAfterLoad
|
||
]
|
||
|
||
SoapHttpConnector class >> transportName [
|
||
<category: 'constants'>
|
||
^#http
|
||
]
|
||
|
||
send: aSoapEnvelope to: anSoapTcpLocator with: aSoapContext [
|
||
"return aSoapMessage or nil"
|
||
|
||
<category: 'actions'>
|
||
| page soapClient envBuilder rawString returnEnvelope message |
|
||
self
|
||
debugSend: aSoapEnvelope
|
||
to: anSoapTcpLocator
|
||
with: aSoapContext.
|
||
page := aSoapContext targetObjectURI.
|
||
soapClient := SoapHttpClient
|
||
host: anSoapTcpLocator host
|
||
port: anSoapTcpLocator port
|
||
page: page.
|
||
envBuilder := self envelopeBuilder.
|
||
|
||
[
|
||
[rawString := soapClient send: aSoapEnvelope printXmlString
|
||
action: aSoapContext soapAction.
|
||
returnEnvelope := envBuilder buildSoapEnvelopeFromXmlString: rawString]
|
||
on: SoapHttpGenericError
|
||
do:
|
||
[:ex |
|
||
ex errorCode = '500'
|
||
ifTrue:
|
||
[returnEnvelope := envBuilder
|
||
buildSoapEnvelopeFromXmlString: ex errorContents]
|
||
ifFalse: [ex pass]]]
|
||
on: SoapCannotResolveServer , SoapCannotConnectToServer
|
||
do: [:ex | returnEnvelope := envBuilder buildClientSoapFaultEnvelope: ex].
|
||
message := SoapMessage envelope: returnEnvelope.
|
||
self debugReturn: message.
|
||
^message
|
||
]
|
||
]
|
||
|
||
|
||
|
||
SoapAbstractConnector subclass: SoapLocalRpcConnector [
|
||
|
||
<category: 'SOAP-Client-Base'>
|
||
<comment: nil>
|
||
|
||
SoapLocalRpcConnector class [
|
||
| debugMode |
|
||
|
||
]
|
||
|
||
SoapLocalRpcConnector class >> initialize [
|
||
<category: 'class initialization'>
|
||
self initializeAfterLoad
|
||
]
|
||
|
||
SoapLocalRpcConnector class >> transportName [
|
||
<category: 'constants'>
|
||
^#localRpc
|
||
]
|
||
|
||
send: aSoapEnvelope to: anSoapLocatorObject with: aSoapContext [
|
||
<category: 'actions'>
|
||
"ignore the locator and just invoke a local call"
|
||
|
||
| sercviceHandler returnEnv message |
|
||
self
|
||
debugSend: aSoapEnvelope
|
||
to: anSoapLocatorObject
|
||
with: aSoapContext.
|
||
sercviceHandler := SoapServiceHandler default.
|
||
returnEnv := sercviceHandler dispatch: aSoapEnvelope with: aSoapContext.
|
||
message := SoapMessage envelope: returnEnv.
|
||
self debugReturn: message.
|
||
^message
|
||
]
|
||
]
|
||
|
||
|
||
|
||
Object subclass: SoapAbstractSocketClient [
|
||
| socket serverAddress host port reqURI |
|
||
|
||
<category: 'SOAP-Client-Base'>
|
||
<comment: 'I use some socket to send packets to server.
|
||
My subclasses will know what tranport protocol should be used in that socket.
|
||
|
||
---
|
||
MU 10/5/2002 01:35'>
|
||
|
||
SoapAbstractSocketClient class [
|
||
| showLog resolveTimeout connectionTimeout connectionPool |
|
||
|
||
]
|
||
|
||
HostAddressCache := nil.
|
||
UseHostAddressCache := nil.
|
||
|
||
SoapAbstractSocketClient class >> connectionPool [
|
||
<category: 'accessing'>
|
||
connectionPool isNil ifTrue: [self initConnectionPool].
|
||
^connectionPool
|
||
]
|
||
|
||
SoapAbstractSocketClient class >> connectionTimeout [
|
||
<category: 'setting'>
|
||
connectionTimeout isNil ifTrue: [connectionTimeout := 30].
|
||
^connectionTimeout
|
||
]
|
||
|
||
SoapAbstractSocketClient class >> connectionTimeout: timeout [
|
||
"SoapAbstractSocketClient connectionTimeout: 20"
|
||
|
||
<category: 'setting'>
|
||
connectionTimeout := timeout
|
||
]
|
||
|
||
SoapAbstractSocketClient class >> hostAddressCache [
|
||
<category: 'accessing'>
|
||
HostAddressCache isNil ifTrue: [self initHostAddressCache].
|
||
^HostAddressCache
|
||
]
|
||
|
||
SoapAbstractSocketClient class >> initConnectionPool [
|
||
<category: 'class initialization'>
|
||
connectionPool := IdentityDictionary new
|
||
]
|
||
|
||
SoapAbstractSocketClient class >> initHostAddressCache [
|
||
"SoapAbstractSocketClient initHostAddressCache"
|
||
|
||
<category: 'class initialization'>
|
||
HostAddressCache := Dictionary new.
|
||
HostAddressCache at: 'localhost'
|
||
put: (ByteArray
|
||
with: 127
|
||
with: 0
|
||
with: 0
|
||
with: 1)
|
||
]
|
||
|
||
SoapAbstractSocketClient class >> initialize [
|
||
"SoapAbstractSocketClient initialize"
|
||
|
||
<category: 'class initialization'>
|
||
showLog := false.
|
||
resolveTimeout := 20.
|
||
self initHostAddressCache.
|
||
self initConnectionPool.
|
||
|
||
ObjectMemory addDependent: self.
|
||
]
|
||
|
||
SoapAbstractSocketClient class >> resolveTimeout [
|
||
<category: 'setting'>
|
||
resolveTimeout isNil ifTrue: [resolveTimeout := 20].
|
||
^resolveTimeout
|
||
]
|
||
|
||
SoapAbstractSocketClient class >> resolveTimeout: timeout [
|
||
"SoapAbstractSocketClient resolveTimeout: 20"
|
||
|
||
<category: 'setting'>
|
||
resolveTimeout := timeout
|
||
]
|
||
|
||
SoapAbstractSocketClient class >> showLog [
|
||
<category: 'setting'>
|
||
^showLog
|
||
]
|
||
|
||
SoapAbstractSocketClient class >> showLog: aBoolean [
|
||
"SoapHttpClient showLog: true"
|
||
|
||
"SoapHttpClient showLog: false"
|
||
|
||
"SoapSqtpClient showLog: true"
|
||
|
||
"SoapSqtpClient showLog: false"
|
||
|
||
<category: 'setting'>
|
||
showLog := aBoolean
|
||
]
|
||
|
||
SoapAbstractSocketClient class >> update: aSymbol [
|
||
aSymbol = #aboutToQuit ifTrue: [self shutDown].
|
||
aSymbol = #returnFromSnapshot ifTrue: [self startUp].
|
||
]
|
||
|
||
SoapAbstractSocketClient class >> shutDown [
|
||
<category: 'start up/shut down'>
|
||
self initHostAddressCache
|
||
]
|
||
|
||
SoapAbstractSocketClient class >> startUp [
|
||
<category: 'start up/shut down'>
|
||
self initHostAddressCache
|
||
]
|
||
|
||
SoapAbstractSocketClient class >> useHostAddressCache [
|
||
<category: 'setting'>
|
||
UseHostAddressCache isNil ifTrue: [UseHostAddressCache := false].
|
||
^UseHostAddressCache
|
||
]
|
||
|
||
SoapAbstractSocketClient class >> useHostAddressCache: aBoolean [
|
||
"SoapAbstractSocketClient useHostAddressCache: true"
|
||
|
||
<category: 'setting'>
|
||
self initHostAddressCache.
|
||
UseHostAddressCache := aBoolean
|
||
]
|
||
|
||
addressForName: hostNameOrIp timeout: timeout [
|
||
<category: 'private'>
|
||
"TODO: Use the timeout"
|
||
^ Sockets.SocketAddress byName: hostNameOrIp.
|
||
]
|
||
|
||
cachedAddressFor: hostName [
|
||
"utility for fast hostAddress lookup - if not found, just return nil"
|
||
|
||
<category: 'private'>
|
||
| timeout cache |
|
||
hostName = 'localhost' ifTrue: [^#(127 0 0 1) asByteArray].
|
||
timeout := self class resolveTimeout.
|
||
self class useHostAddressCache
|
||
ifFalse: [^self addressForName: hostName timeout: timeout].
|
||
cache := self class hostAddressCache.
|
||
(cache includesKey: hostName)
|
||
ifTrue: [^cache at: hostName]
|
||
ifFalse:
|
||
[| resolvedAddress |
|
||
resolvedAddress := self addressForName: hostName timeout: timeout.
|
||
^resolvedAddress isNil ifFalse: [cache at: hostName put: resolvedAddress]]
|
||
]
|
||
|
||
getResponseContents [
|
||
<category: 'actions-hooks'>
|
||
self subclassResponsibility
|
||
]
|
||
|
||
host [
|
||
<category: 'accessing'>
|
||
^host
|
||
]
|
||
|
||
host: aValue [
|
||
<category: 'accessing'>
|
||
host := aValue
|
||
]
|
||
|
||
initializeNetwork [
|
||
<category: 'private'>
|
||
]
|
||
|
||
port [
|
||
<category: 'accessing'>
|
||
^port
|
||
]
|
||
|
||
port: aValue [
|
||
<category: 'accessing'>
|
||
port := aValue
|
||
]
|
||
|
||
prepareAdditionals [
|
||
"By default - do nothing"
|
||
|
||
<category: 'actions-hooks'>
|
||
|
||
]
|
||
|
||
prepareEnvelope: soapEnvelope [
|
||
<category: 'actions-hooks'>
|
||
self subclassResponsibility
|
||
]
|
||
|
||
prepareSocket [
|
||
<category: 'actions-hooks'>
|
||
self subclassResponsibility
|
||
]
|
||
|
||
releaseSocket [
|
||
<category: 'actions-hooks'>
|
||
socket ifNotNil: [
|
||
"Call close and closeConnection"
|
||
socket close.
|
||
socket closeConnection.
|
||
].
|
||
]
|
||
|
||
reqURI [
|
||
<category: 'accessing'>
|
||
^reqURI
|
||
]
|
||
|
||
reqURI: aValue [
|
||
<category: 'accessing'>
|
||
reqURI := aValue
|
||
]
|
||
|
||
resolveServerAddress [
|
||
<category: 'private'>
|
||
serverAddress := self cachedAddressFor: host.
|
||
serverAddress isNil
|
||
ifTrue:
|
||
[self class useHostAddressCache
|
||
ifTrue: [self class hostAddressCache removeKey: host ifAbsent: []].
|
||
SoapCannotResolveServer
|
||
signal: 'Could not resolve the server named: ' , host]
|
||
]
|
||
|
||
send: soapEnvelope [
|
||
<category: 'actions'>
|
||
| cont |
|
||
cont := nil.
|
||
self prepareEnvelope: soapEnvelope.
|
||
self prepareHeader.
|
||
self initializeNetwork.
|
||
self resolveServerAddress.
|
||
|
||
[self prepareSocket.
|
||
self sendBySocket.
|
||
cont := self getResponseContents]
|
||
ensure: [self releaseSocket].
|
||
^cont
|
||
]
|
||
|
||
sendBySocket [
|
||
<category: 'actions-hooks'>
|
||
self subclassResponsibility
|
||
]
|
||
|
||
socket [
|
||
<category: 'accessing'>
|
||
^socket
|
||
]
|
||
|
||
socket: aValue [
|
||
<category: 'accessing'>
|
||
socket := aValue
|
||
]
|
||
]
|
||
|
||
|
||
|
||
SoapAbstractSocketClient subclass: SoapHttpClient [
|
||
| specifiedServer soapEnvelopeString headerCollection bodyString contents soapAction resp inStream redirect |
|
||
|
||
<category: 'SOAP-Client-Http'>
|
||
<comment: nil>
|
||
|
||
SoapHttpClient class >> defaultPort [
|
||
"default port to connect on"
|
||
|
||
<category: 'constants'>
|
||
^80
|
||
]
|
||
|
||
SoapHttpClient class >> host: hostnameString page: pageString [
|
||
<category: 'instance creation'>
|
||
^self
|
||
host: hostnameString
|
||
port: self defaultPort
|
||
page: pageString
|
||
]
|
||
|
||
SoapHttpClient class >> host: hostnameString port: portNumberInteger page: pageString [
|
||
<category: 'instance creation'>
|
||
^self new
|
||
host: hostnameString
|
||
port: portNumberInteger
|
||
page: pageString
|
||
]
|
||
|
||
SoapHttpClient class >> initialize [
|
||
"SoapHttpClient initialize"
|
||
|
||
<category: 'class initialization'>
|
||
showLog := false.
|
||
]
|
||
|
||
SoapHttpClient class >> url: urlString [
|
||
<category: 'instance creation'>
|
||
^self new parseURL: urlString
|
||
]
|
||
|
||
defaultPort [
|
||
<category: 'constants'>
|
||
^self class defaultPort
|
||
]
|
||
|
||
getResponseContents [
|
||
| type respClass |
|
||
<category: 'actions-hooks'>
|
||
|
||
redirect ifNotNil: [
|
||
^ self redirectWith: redirect.
|
||
].
|
||
|
||
self class showLog
|
||
ifTrue:
|
||
[Transcript
|
||
cr;
|
||
cr;
|
||
show: 'Got following header response:';
|
||
cr;
|
||
show: resp messageHeader asString].
|
||
|
||
respClass := resp status / 100.
|
||
(respClass = 4 or: [respClass = 5]) ifTrue: [
|
||
socket close.
|
||
socket closeConnection.
|
||
^ self signalHttpErrorWith: resp status.
|
||
].
|
||
|
||
type := resp fieldAt: 'content-type' ifAbsent: [NetClients.ContentTypeField default].
|
||
((type contentType = 'text/xml') not and: [respClass = 2]) ifTrue: [
|
||
socket close.
|
||
socket closeConnection.
|
||
^SoapContentTypeMismatch
|
||
signal: 'Wrong type: ' , type , ' It should be text/xml'
|
||
].
|
||
|
||
^ inStream contents
|
||
]
|
||
|
||
host: hostnameString port: portNumberInteger page: pageString [
|
||
<category: 'initialize-release'>
|
||
host := hostnameString.
|
||
port := portNumberInteger.
|
||
reqURI := (pageString isNil or: [pageString isEmpty])
|
||
ifTrue: ['/']
|
||
ifFalse: [pageString].
|
||
specifiedServer := host , ':' , port printString.
|
||
]
|
||
|
||
parseURL: anUrlString [
|
||
<category: 'initialize-release'>
|
||
| url bare frm |
|
||
url := anUrlString.
|
||
bare := (url asLowercase beginsWith: 'http://')
|
||
ifTrue: [url copyFrom: 8 to: url size]
|
||
ifFalse: [url].
|
||
host := bare copyUpTo: $/.
|
||
specifiedServer := host.
|
||
(host includes: $:)
|
||
ifTrue:
|
||
[port := (host copyFrom: (host indexOf: $:) + 1 to: host size) asNumber.
|
||
host := host copyUpTo: $:]
|
||
ifFalse: [port := self defaultPort].
|
||
(frm := bare indexOf: $/) = 0 ifTrue: [frm := 1].
|
||
reqURI := bare copyFrom: frm to: bare size.
|
||
(reqURI size = 0 or: [reqURI = specifiedServer]) ifTrue: [reqURI := '/'].
|
||
]
|
||
|
||
prepareAdditionalsOn: aStream [
|
||
"do nothing by default"
|
||
|
||
<category: 'actions-hooks'>
|
||
|
||
]
|
||
|
||
prepareEnvelope: soapEnvelopeOrString [
|
||
<category: 'actions-hooks'>
|
||
soapEnvelopeString := soapEnvelopeOrString isString
|
||
ifTrue: [soapEnvelopeOrString]
|
||
ifFalse: [soapEnvelopeOrString printXmlString].
|
||
bodyString := SoXmlUtil contentsWithXmlDeclaration: soapEnvelopeString.
|
||
]
|
||
|
||
prepareHeader [
|
||
<category: 'actions-hooks'>
|
||
(headerCollection := OrderedCollection new)
|
||
add: 'Host: ' , specifiedServer;
|
||
add: 'User-Agent: ' , 'GNU-Smalltalk/', Smalltalk version;
|
||
add: soapAction headerString, ': ', soapAction intentString.
|
||
self prepareAdditionalsOn: headerCollection.
|
||
self class showLog
|
||
ifTrue:
|
||
[Transcript
|
||
cr;
|
||
cr;
|
||
show: 'Sending following header:';
|
||
cr;
|
||
show: headerCollection]
|
||
]
|
||
|
||
prepareSocket [
|
||
<category: 'actions-hooks'>
|
||
[
|
||
socket := NetClients.HTTP.HTTPClient connectToHost: serverAddress port: port.
|
||
] on: NetClients.ConnectionFailedError
|
||
do: [
|
||
SoapCannotConnectToServer
|
||
signal: 'Server does not respond - ''host: ' , host , ' port: '
|
||
, port printString].
|
||
]
|
||
|
||
redirectWith: newUrl [
|
||
<category: 'private'>
|
||
socket close.
|
||
newUrl ifNotNil:
|
||
[self class showLog ifTrue: [Transcript show: ' redirecting to: ' , newUrl].
|
||
^(self class url: newUrl) send: soapEnvelopeString action: soapAction].
|
||
^SoapHttpGenericError
|
||
signal: 'failed to redirect by no ''location'' header'
|
||
code: 399
|
||
contents: ''
|
||
]
|
||
|
||
send: soapEnvelopeOrSrting action: aSoapAction [
|
||
<category: 'actions'>
|
||
| return |
|
||
self soapAction: aSoapAction.
|
||
return := self send: soapEnvelopeOrSrting.
|
||
^SoPortableUtil convertString: return from: SoapSetting stringEncoding
|
||
]
|
||
|
||
sendBySocket [
|
||
| d |
|
||
<category: 'actions-hooks'>
|
||
|
||
[
|
||
redirect := nil.
|
||
inStream := ReadWriteStream on: (String new: 10).
|
||
resp := socket post: reqURI
|
||
type: 'text/xml; charset="', SoapSetting stringEncoding , '"'
|
||
data: bodyString
|
||
binary: true
|
||
requestHeaders: headerCollection
|
||
into: inStream.
|
||
] on: NetClients.ConnectionFailedError do: [
|
||
socket close.
|
||
socket closeConnection.
|
||
SoapCannotConnectToServer
|
||
signal: 'Server does not respond - ''host: ' , host , ' port: '
|
||
, port printString]
|
||
on: NetClients.ProtocolError do: [:ex |
|
||
"In case of a 404 we have an empty response here"
|
||
socket close.
|
||
socket closeConnection.
|
||
^ self signalHttpErrorWith: 404.
|
||
] on: NetClients.HTTP.HTTPRedirection do: [:ex |
|
||
redirect := ex tag.
|
||
ex return
|
||
]
|
||
]
|
||
|
||
signalHttpErrorWith: responseCode [
|
||
<category: 'private'>
|
||
^SoapHttpGenericError
|
||
signal: ''
|
||
code: responseCode
|
||
contents: contents
|
||
]
|
||
|
||
soapAction [
|
||
<category: 'accessing'>
|
||
soapAction isNil ifTrue: [soapAction := SoapAction noIntent].
|
||
^soapAction
|
||
]
|
||
|
||
soapAction: aValue [
|
||
<category: 'accessing'>
|
||
soapAction := aValue
|
||
]
|
||
|
||
specifiedServer [
|
||
<category: 'accessing'>
|
||
^specifiedServer
|
||
]
|
||
|
||
specifiedServer: aValue [
|
||
<category: 'accessing'>
|
||
specifiedServer := aValue
|
||
]
|
||
]
|
||
|
||
|
||
|
||
Object subclass: SoapConnectorFactory [
|
||
|
||
<category: 'SOAP-Client-Base'>
|
||
<comment: nil>
|
||
|
||
SoapConnectorFactory class >> createFrom: anTransportSymbol [
|
||
<category: 'instance creation'>
|
||
^SoapConnectorMap at: anTransportSymbol
|
||
]
|
||
]
|
||
|
||
|
||
|
||
Object subclass: SoapTcpLocator [
|
||
| host port |
|
||
|
||
<category: 'SOAP-Client-Base'>
|
||
<comment: nil>
|
||
|
||
SoapTcpLocator class [
|
||
| localAddress localHost |
|
||
|
||
]
|
||
|
||
SoapTcpLocator class >> host: hostnameString port: portNumberInteger [
|
||
<category: 'instance creation'>
|
||
^(self new)
|
||
host: hostnameString;
|
||
port: portNumberInteger
|
||
]
|
||
|
||
SoapTcpLocator class >> initLocalInfo [
|
||
<category: 'private'>
|
||
localAddress := localHost := nil
|
||
]
|
||
|
||
SoapTcpLocator class >> initialize [
|
||
"SoapTcpLocator initialize"
|
||
|
||
<category: 'class initialization'>
|
||
ObjectMemory addDependent: self.
|
||
self startUp
|
||
]
|
||
|
||
SoapTcpLocator class >> isLocal: hostOrIp port: portNum [
|
||
"Squeak specific"
|
||
|
||
<category: 'colocation'>
|
||
| setup |
|
||
SoapConfigurationMap isServerInstalled ifFalse: [^false].
|
||
setup := self serverSetup.
|
||
setup ifNil: [^false].
|
||
^(setup runningPorts includes: portNum) and:
|
||
[((hostOrIp = 'localhost' or: [hostOrIp = '127.0.0.1'])
|
||
or: [hostOrIp = self localAddress]) or: [hostOrIp = self localHost]]
|
||
]
|
||
|
||
SoapTcpLocator class >> localAddress [
|
||
"Squeak specific"
|
||
|
||
<category: 'private'>
|
||
localAddress isNil
|
||
ifTrue: [localAddress := Sockets.SocketAddress anyLocalAddress].
|
||
^localAddress
|
||
]
|
||
|
||
SoapTcpLocator class >> localHost [
|
||
"Squeak specific"
|
||
|
||
<category: 'private'>
|
||
localHost isNil
|
||
ifTrue:
|
||
[localHost := 'localhost'].
|
||
^localHost
|
||
]
|
||
|
||
SoapTcpLocator class >> serverSetup [
|
||
<category: 'colocation'>
|
||
^Smalltalk at: #SoapServerSetup ifAbsent: []
|
||
]
|
||
|
||
SoapTcpLocator class >> update: aSymbol [
|
||
aSymbol = #returnFromSnapshot ifTrue: [self startUp].
|
||
]
|
||
|
||
SoapTcpLocator class >> startUp [
|
||
<category: 'system startup'>
|
||
self initLocalInfo
|
||
]
|
||
|
||
colocated [
|
||
<category: 'testing'>
|
||
^self class isLocal: host port: port
|
||
]
|
||
|
||
colocatedFor: transportSymbol [
|
||
<category: 'testing'>
|
||
| runningPort |
|
||
self colocated ifFalse: [^false].
|
||
runningPort := self class serverSetup runningPortAt: transportSymbol.
|
||
^runningPort = self port
|
||
]
|
||
|
||
host [
|
||
<category: 'accessing'>
|
||
^host
|
||
]
|
||
|
||
host: hostnameOrIpAddressString [
|
||
<category: 'accessing'>
|
||
host := hostnameOrIpAddressString asLowercase
|
||
]
|
||
|
||
port [
|
||
<category: 'accessing'>
|
||
^port
|
||
]
|
||
|
||
port: aValue [
|
||
<category: 'accessing'>
|
||
port := aValue
|
||
]
|
||
|
||
printOn: aStream [
|
||
<category: 'printing'>
|
||
super printOn: aStream.
|
||
aStream nextPutAll: ' host: '.
|
||
aStream print: self host.
|
||
aStream nextPutAll: ' port: '.
|
||
aStream print: self port
|
||
]
|
||
]
|
||
|
||
|
||
|
||
SoapNoSuchClass subclass: SoapNoSuchConnector [
|
||
|
||
<comment: nil>
|
||
<category: 'SOAP-Client-Base'>
|
||
]
|
||
|
||
|
||
|
||
SoapImplError subclass: SoapCannotConnectToServer [
|
||
|
||
<comment: nil>
|
||
<category: 'SOAP-Client-Base'>
|
||
]
|
||
|
||
|
||
|
||
SoapImplError subclass: SoapCannotResolveServer [
|
||
|
||
<comment: nil>
|
||
<category: 'SOAP-Client-Base'>
|
||
]
|
||
|
||
|
||
|
||
SoapImplError subclass: SoapContentTypeMismatch [
|
||
|
||
<comment: nil>
|
||
<category: 'SOAP-Client-Http'>
|
||
]
|
||
|
||
|
||
|
||
SoapImplError subclass: SoapHttpGenericError [
|
||
| errorCode errorContents |
|
||
|
||
<comment: nil>
|
||
<category: 'SOAP-Client-Http'>
|
||
|
||
ResultMessageTable := nil.
|
||
|
||
SoapHttpGenericError class >> initResultMessageTable [
|
||
"SoapHttpGenericError initResultMessageTable"
|
||
|
||
<category: 'class initialization'>
|
||
ResultMessageTable := Dictionary new.
|
||
ResultMessageTable at: '300' put: 'Multiple Choices'.
|
||
ResultMessageTable at: '301' put: 'Moved Permanently'.
|
||
ResultMessageTable at: '302' put: 'Moved Temporarily'.
|
||
ResultMessageTable at: '303' put: 'See Other'.
|
||
ResultMessageTable at: '304' put: 'Not Modified'.
|
||
ResultMessageTable at: '305' put: 'Use Proxy'.
|
||
ResultMessageTable at: '400' put: 'Bad Request'.
|
||
ResultMessageTable at: '401' put: 'Unauthorized'.
|
||
ResultMessageTable at: '402' put: 'Payment Required'.
|
||
ResultMessageTable at: '403' put: 'Forbidden'.
|
||
ResultMessageTable at: '404' put: 'Not Found'.
|
||
ResultMessageTable at: '405' put: 'Method Not Allowed'.
|
||
ResultMessageTable at: '406' put: 'Not Acceptable'.
|
||
ResultMessageTable at: '407' put: 'Bad Request'.
|
||
ResultMessageTable at: '408' put: 'Request Time-out'.
|
||
ResultMessageTable at: '409' put: 'Conflict'.
|
||
ResultMessageTable at: '410' put: 'Gone'.
|
||
ResultMessageTable at: '411' put: 'Length Required'.
|
||
ResultMessageTable at: '412' put: 'Precondition Failed'.
|
||
ResultMessageTable at: '413' put: 'Request Entity Too Large'.
|
||
ResultMessageTable at: '414' put: 'Request-URI Too Large'.
|
||
ResultMessageTable at: '415' put: 'Unsupported Media Type'.
|
||
ResultMessageTable at: '500' put: 'Internal Server Error'.
|
||
ResultMessageTable at: '501' put: 'Not Implemented'.
|
||
ResultMessageTable at: '502' put: 'Bad Gateway'.
|
||
ResultMessageTable at: '503' put: 'Service Unavailable'.
|
||
ResultMessageTable at: '504' put: 'Gateway Time-out'.
|
||
ResultMessageTable at: '505' put: 'HTTP Version not supported'
|
||
]
|
||
|
||
SoapHttpGenericError class >> initialize [
|
||
"SoapHttpGenericError initialize"
|
||
|
||
<category: 'class initialization'>
|
||
self initResultMessageTable
|
||
]
|
||
|
||
SoapHttpGenericError class >> signal: messageText code: errorCode contents: contents [
|
||
<category: 'instance creation'>
|
||
^(self new)
|
||
errorCode: errorCode;
|
||
errorContents: contents;
|
||
signal: messageText
|
||
]
|
||
|
||
description [
|
||
"Return a textual description of the exception."
|
||
|
||
<category: 'exceptionDescription'>
|
||
| desc httpErrorDesc mt |
|
||
desc := self class name asString.
|
||
httpErrorDesc := self errorCode printString , ' '
|
||
, (ResultMessageTable at: self errorCode ifAbsent: ['']).
|
||
desc := desc , ': ' , httpErrorDesc.
|
||
^(mt := self messageText) == nil ifTrue: [desc] ifFalse: [desc , ': ' , mt]
|
||
]
|
||
|
||
errorCode [
|
||
<category: 'accessing'>
|
||
^errorCode
|
||
]
|
||
|
||
errorCode: anInteger [
|
||
<category: 'accessing'>
|
||
errorCode := anInteger
|
||
]
|
||
|
||
errorContents [
|
||
<category: 'accessing'>
|
||
^errorContents
|
||
]
|
||
|
||
errorContents: anInteger [
|
||
<category: 'accessing'>
|
||
errorContents := anInteger
|
||
]
|
||
]
|
||
|
||
|
||
|
||
Eval [
|
||
SoapAbstractConnector initialize.
|
||
SoapHttpConnector initialize.
|
||
SoapLocalRpcConnector initialize.
|
||
SoapAbstractSocketClient initialize.
|
||
SoapHttpClient initialize.
|
||
SoapTcpLocator initialize.
|
||
SoapHttpGenericError initialize
|
||
]
|
||
|