[ENH][FIX] HTTP-ProxiesMichael Rueger Michael.Rueger.-ND at disney.comWed Mar 1 23:02:17 UTC 2000
Change Set: ProxyFix-mir
Date: 3 August 1999
Author: Michael Rueger
Setting a proxy in Squeak usually keeps you from connecting to local hosts
within your domain. This fix adds a list of exempt host or domain names to
HTTPSocket, which should not be contacted through the proxy.
--
"To improve is to change, to be perfect is to change often."
Winston Churchill
+------------------------------------------------------------+
| Michael Rueger |
| Phone: ++1 (818) 623 3283 Fax: ++1 (818) 623 3559 |
+---------- Michael.Rueger.-ND at corp.go.com ------------------+
-------------- next part --------------
"Change Set: ProxyFix-mir
Date: 3 August 1999
Author: Michael Rueger
Setting a proxy in Squeak usually keeps you from connecting to local hosts within your domain. This fix adds a list of exempt host or domain names to HTTPSocket, which should not be contacted through the proxy.
"!
SimpleClientSocket subclass: #HTTPSocket
instanceVariableNames: 'headerTokens headers responseCode '
classVariableNames: 'HTTPBlabEmail HTTPPort HTTPProxyExceptions HTTPProxyPort HTTPProxyServer ParamDelimiters '
poolDictionaries: ''
category: 'Network-Protocols'!
Url subclass: #HierarchicalUrl
instanceVariableNames: 'schemeName authority port path query '
classVariableNames: ''
poolDictionaries: ''
category: 'Network-Url'!
!HTTPSocket class methodsFor: 'get the page' stamp: 'mir 7/30/1999 14:55'!
httpGetDocument: url args: args accept: mimeType request: requestString
"Return the exact contents of a web object. Asks for the given MIME
type. If mimeType is nil, use 'text/html'. An extra requestString may be
submitted and must end with crlf. The parsed header is saved. Use a
proxy server if one has been registered. tk 7/23/97 17:12"
"Note: To fetch raw data, you can use the MIME type
'application/octet-stream'."
| httpUrl page sock list header firstData aStream length type newUrl |
Socket initializeNetwork.
httpUrl _ Url absoluteFromText: url.
page _ httpUrl toText.
"add arguments"
args ifNotNil: [page _ page, (self argString: args) ].
3 timesRepeat: [
sock _ self initHTTPSocket: httpUrl ifError: [:errorString | ^errorString].
"Transcript cr; cr; show: url."
sock sendCommand: 'GET ', page, ' HTTP/1.0', CrLf,
(mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']),
'ACCEPT: text/html', CrLf, "Always accept plain text"
HTTPBlabEmail, "may be empty"
requestString, "extra user request. Authorization"
'User-Agent: Squeak 1.31', CrLf,
'Host: ', httpUrl authority, ':', httpUrl port printString, CrLf. "blank line
automatically added"
list _ sock getResponseUpTo: CrLf, CrLf. "list = header, CrLf, CrLf,
beginningOfData"
header _ list at: 1.
"Transcript show: page; cr; show: header; cr."
firstData _ list at: 3.
header isEmpty
ifTrue: [aStream _ 'server aborted early']
ifFalse: [
"dig out some headers"
sock header: header.
length _ sock getHeader: 'content-length'.
length ifNotNil: [ length _ length asNumber ].
type _ sock getHeader: 'content-type'.
sock responseCode first = $3 ifTrue: [
newUrl _ sock getHeader: 'location'.
newUrl ifNotNil: [
Transcript show: 'redirecting to ', newUrl; cr.
sock destroy.
^self httpGetDocument: newUrl args: args accept: mimeType ] ].
aStream _ sock getRestOfBuffer: firstData totalLength: length.
sock responseCode = '401' ifTrue: [^ header, aStream contents].
].
sock destroy. "Always OK to destroy!!"
aStream class ~~ String ifTrue: [
^ MIMEDocument contentType: type content: aStream contents url: url].
aStream = 'server aborted early' ifFalse: [
]
].! !
!HTTPSocket class methodsFor: 'get the page' stamp: 'mir 7/30/1999 15:44'!
httpPostDocument: url args: argsDict accept: mimeType request: requestString
"like httpGET, except it does a POST instead of a GET. POST allows data to be uploaded"
| s header length page list firstData aStream argsStream first type newUrl httpUrl |
Socket initializeNetwork.
httpUrl _ Url absoluteFromText: url.
page _ httpUrl toText.
"add arguments"
argsDict ifNotNil: [page _ page, (self argString: argsDict) ].
"encode the arguments dictionary"
argsStream _ WriteStream on: String new.
first _ true.
argsDict associationsDo: [ :assoc |
assoc value do: [ :value |
first ifTrue: [ first _ false ] ifFalse: [ argsStream nextPut: $& ].
argsStream nextPutAll: assoc key encodeForHTTP.
argsStream nextPut: $=.
argsStream nextPutAll: value encodeForHTTP.
] ].
s _ HTTPSocket new.
s _ self initHTTPSocket: httpUrl wait: (self deadlineSecs: 30) ifError: [:errorString | ^errorString].
Transcript cr; show: url; cr.
s sendCommand: 'POST ', page, ' HTTP/1.0', CrLf,
(mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']),
'ACCEPT: text/html', CrLf, "Always accept plain text"
HTTPBlabEmail, "may be empty"
requestString, "extra user request. Authorization"
'User-Agent: Squeak 1.31', CrLf,
'Content-type: application/x-www-form-urlencoded', CrLf,
'Content-length: ', argsStream contents size printString, CrLf,
'Host: ', httpUrl authority, CrLf. "blank line automatically added"
s sendCommand: argsStream contents.
"get the header of the reply"
list _ s getResponseUpTo: CrLf, CrLf. "list = header, CrLf, CrLf, beginningOfData"
header _ list at: 1.
"Transcript show: page; cr; show: argsStream contents; cr; show: header; cr."
firstData _ list at: 3.
"dig out some headers"
s header: header.
length _ s getHeader: 'content-length'.
length ifNotNil: [ length _ length asNumber ].
type _ s getHeader: 'content-type'.
s responseCode first = $3 ifTrue: [
newUrl _ s getHeader: 'location'.
newUrl ifNotNil: [
Transcript show: 'redirecting to: ', newUrl; cr.
s destroy.
^self httpPostDocument: newUrl args: argsDict accept: mimeType ] ].
aStream _ s getRestOfBuffer: firstData totalLength: length.
s responseCode = '401' ifTrue: [^ header, aStream contents].
s destroy. "Always OK to destroy!!"
^ MIMEDocument contentType: type content: aStream contents url: url! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'mir 7/30/1999 16:08'!
addProxyException: domainName
"Add a (partial, wildcard) domain name to the list of proxy exceptions"
"HTTPSocket addProxyException: '*.online.disney.com'"
self httpProxyExceptions add: domainName! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'mir 7/30/1999 15:03'!
httpProxyExceptions
HTTPProxyExceptions ifNil: [HTTPProxyExceptions _ OrderedCollection new].
^HTTPProxyExceptions! !
!HTTPSocket class methodsFor: 'proxy settings' stamp: 'mir 7/30/1999 15:03'!
removeProxyException: domainName
"Remove a (partial, wildcard) domain name from the list of proxy exceptions"
self httpProxyExceptions remove: domainName ifAbsent: []! !
!HTTPSocket class methodsFor: 'utilities' stamp: 'mir 7/30/1999 15:46'!
initHTTPSocket: httpUrl ifError: aBlock
"Retrieve the server and port information from the URL, match it to the proxy settings and open a http socket for the request."
^self initHTTPSocket: httpUrl wait: self standardDeadline ifError: aBlock! !
!HTTPSocket class methodsFor: 'utilities' stamp: 'mir 7/30/1999 15:43'!
initHTTPSocket: httpUrl wait: timeout ifError: aBlock
"Retrieve the server and port information from the URL, match it to the proxy settings and open a http socket for the request."
| serverName port serverAddr s |
Socket initializeNetwork.
serverName _ httpUrl authority.
port _ httpUrl port ifNil: [self defaultPort].
(self shouldUseProxy: serverName) ifTrue: [
serverName _ HTTPProxyServer.
port _ HTTPProxyPort].
"make the request"
self retry: [serverAddr _ NetNameResolver addressForName: serverName timeout: 20.
serverAddr ~~ nil]
asking: 'Trouble resolving server name. Keep trying?'
ifGiveUp: [aBlock value: 'Error: Could not resolve the server named: ', serverName].
s _ HTTPSocket new.
s connectTo: serverAddr port: port.
(s waitForConnectionUntil: timeout) ifFalse: [
Socket deadServer: httpUrl authority.
s destroy.
^aBlock value: 'Error: Server ',httpUrl authority,' is not responding'].
^s
! !
!HTTPSocket class methodsFor: 'utilities' stamp: 'mir 7/30/1999 13:33'!
shouldUseProxy: serverName
"Retrieve the server and port information from the URL, match it to the proxy settings and open a http socket for the request."
HTTPProxyServer ifNotNil: [
self httpProxyExceptions
detect: [:domainName | domainName match: serverName]
ifNone: [^true]].
^false
! !
!HierarchicalUrl methodsFor: 'parsing' stamp: 'mir 7/30/1999 13:05'!
privateInitializeFromText: aString
| remainder ind nextTok s specifiedSchemeName |
remainder _ aString.
schemeName ifNil: [
specifiedSchemeName _ Url schemeNameForString: remainder.
specifiedSchemeName ifNotNil: [
schemeName _ specifiedSchemeName.
remainder _ remainder copyFrom: (schemeName size+2) to: remainder size ].
schemeName ifNil: [ "assume HTTP" schemeName _ 'http' ] ].
"remove leading // if it's there"
(remainder beginsWith: '//') ifTrue: [
remainder _ remainder copyFrom: 3 to: remainder size ].
"get the query"
ind _ remainder indexOf: $?.
ind > 0 ifTrue: [
query _ (remainder copyFrom: ind+1 to: remainder size).
remainder _ remainder copyFrom: 1 to: ind-1 ].
"get the authority"
ind _ remainder indexOf: $/.
ind > 0 ifTrue: [
ind = 1 ifTrue: [ authority _ '' ] ifFalse: [
authority _ remainder copyFrom: 1 to: ind-1.
remainder _ remainder copyFrom: ind+1 to: remainder size. ] ]
ifFalse: [
authority _ remainder.
remainder _ ''. ].
"Extract the port"
(authority includes: $:)
ifTrue: [
port _ (authority copyFrom: (authority indexOf: $:) + 1 to: authority size) asNumber.
authority _ authority copyUpTo: $:].
"get the path"
path _ OrderedCollection new.
s _ ReadStream on: remainder.
[
s peek = $/ ifTrue: [ s next ].
nextTok _ WriteStream on: String new.
[ s atEnd or: [ s peek = $/ ] ] whileFalse: [ nextTok nextPut: s next ].
nextTok _ nextTok contents unescapePercents.
nextTok = '..'
ifTrue: [ path size > 0 ifTrue: [ path removeLast ] ]
ifFalse: [ nextTok ~= '.' ifTrue: [ path add: nextTok ] ].
s atEnd
] whileFalse.
path isEmpty ifTrue: [ path add: '' ].! !
!HierarchicalUrl methodsFor: 'access' stamp: 'mir 7/30/1999 13:05'!
port
^port! !
More information about the Squeak-dev mailing list |