(Long; limited interest) For some of those behind firewalls and proxies

Tom Morgan tmorgan at acm.org
Sun Jun 21 16:21:04 UTC 1998


Below is a file in, for those who live behind firewalls with HTTP
proxies that require authentication.  An example is the
Netscape Fasttrack proxy.

This is a pretty egregious hack, but it is good enough to allow
you to use the 'update from network' facility to get your image
current.

To use:

-In a workspace, evaluate (changing proxy name, port, user
and password as required.  You can find these values
in the Preferences/Options for your browser):

HTTPSocket useProxyServerNamed: 'proxy.yourcompany.com' port: 8080.
HTTPSocket proxyUser: 'yourid' password: 'yourpassword'.

-Update your image, or do other network functions.

-If you have any interest in security at all, evaluate:

HTTPSocket clearProxyUserPassword.

when you are done.

   ...Tom M 


-- 
+---Tom Morgan ------------------------------ (tmorgan at acm.org) -----+
I   Brooklyn Union                          Phone: 1 718 403 2427    I
I   1 MetroTech Center                      Fax:   1 718 488 1752    I
+---Brooklyn, New York 11201 USA ------------------------------------+



'From Squeak 2.0 of May 22, 1998 on 21 June 1998 at 10:44:01 am'!
"Change Set:		HTTP
Date:			21 June 1998
Author:			Tom Morgan

Additions and change to allow use of the HTTPSocket class
for people who live behind firewalls which demand credentials.
These changes were tested with the Netscape-FastTrack/2.01
proxy"!

SimpleClientSocket subclass: #HTTPSocket
	instanceVariableNames: 'headerTokens '
	classVariableNames: 'HTTPBlabEmail HTTPPort HTTPProxy HTTPProxyCredentials
ParamDelimiters '
	poolDictionaries: ''
	category: 'System-Network'!

!HTTPSocket class methodsFor: 'class initialization' stamp: 'TEM 6/21/1998 09:55'!
initialize
	"HTTPSocket initialize"

	ParamDelimiters _ ' ', CrLf.
	HTTPPort _ 80.
	HTTPProxy _ nil.
	HTTPBlabEmail _ ''.  "	'From: tedk at disney.com', CrLf	"
	HTTPProxyCredentials _ ''.
! !

!HTTPSocket class methodsFor: 'examples' stamp: 'TEM 6/21/1998 10:17'!
httpGet: url accept: mimeType
	"Return the exact contents of a web object. Asks for the given MIME type. If
mimeType is nil, use 'text/html'. 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 MIMI type 'application/octet-stream'."

	| serverName serverAddr s header length bare page list firstData aStream
newURL |
	Socket initializeNetwork.
	bare _ (url asLowercase beginsWith: 'http://') 
		ifTrue: [url copyFrom: 8 to: url size]
		ifFalse: [url].
	"For now, may not put :80 or other port number in a url.  Use setHTTPPort:"
	serverName _ bare copyUpTo: $/.
	page _ bare copyFrom: serverName size + 1 to: bare size.
	page size = 0 ifTrue: [page _ '/'].
	HTTPProxy ifNotNil: [
		page _ 'http://', serverName, page.		"put back together"
		serverName _ HTTPProxy].
	
	self retry: [serverAddr _ NetNameResolver addressForName: serverName timeout: 20.
				serverAddr ~~ nil] 
		asking: 'Trouble resolving server name.  Keep trying?'
		ifGiveUp: [Socket deadServer: serverName.
				^ 'Could not resolve the server named: ', serverName].

	s _ HTTPSocket new.
	s connectTo: serverAddr port: HTTPPort.  "80 is normal"
	(s waitForConnectionUntil: (self deadlineSecs: 30)) ifFalse: [
		Socket deadServer: serverName.  s destroy.
		^ 'Server ',serverName,' is not responding'].
	Transcript cr; show: serverName; cr.
	s sendCommand: 'GET ', page, ' HTTP/1.0', CrLf, 
		(mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']),
		'ACCEPT: text/html', CrLf,	"Always accept plain text"
		HTTPProxyCredentials, CrLf, 
		HTTPBlabEmail,	"may be empty"
		'User-Agent: Squeak 1.31',		
		CrLf.	"blank line"
	list _ s getResponseUpTo: CrLf, CrLf.	"list = header, CrLf, CrLf, beginningOfData"
	header _ list at: 1.
	Transcript show: page; cr; show: header; cr.
	firstData _ list at: 3.

	"Find the length"
	length _ s contentsLength: header.	"saves the headerTokens"
	length ifNil: [
		(newURL _ s redirect) ifNotNil: [
			s destroy.
			^ self httpGet: newURL accept: mimeType].
		Transcript cr; show: 'Some kind of Error'.
		s destroy.   ^ header].
	
	aStream _ s getRestOfBuffer: firstData totalLength: length.
	s destroy.	"Always OK to destroy!!"

	^ aStream	"String with just the data"! !

!HTTPSocket class methodsFor: 'examples' stamp: 'TEM 6/21/1998 10:31'!
proxyUserTestingComment
	"Set and clear proxy authentication credentials"
	"	HTTPSocket clearProxyUserPassword.
		HTTPSocket useProxyServerNamed: 'proxy.yourdomain.com' port: 8080.
		HTTPSocket proxyUser: 'tmorgan' password: 'xxxxxxxx'"

	"	HTTPSocket stopUsingProxyServer                         "
	
! !

!HTTPSocket class methodsFor: 'proxy settings' stamp: 'TEM 6/21/1998 09:57'!
clearProxyUserPassword
	"Atonement for an ugly hack that stores your proxy password
	in your image. This clears the userid and password"

HTTPProxyCredentials _ ''.
! !

!HTTPSocket class methodsFor: 'proxy settings' stamp: 'TEM 6/21/1998 10:23'!
proxyUser: userName password: password
	"Store  HTTP 1.0 basic authentication credentials
	Note: this is an ugly hack that stores your password
	in your image.  It's just enought to get you going
	if you use a firewall that requires authentication"

	| ss bb | 
ss _ ReadWriteStream on: (String new: 16).
ss nextPutAll: userName,':',password.
bb _ Base64MimeConverter mimeEncode: ss.
HTTPProxyCredentials _ 'Proxy-Authorization: Basic ', (bb contents).
! !

!HTTPSocket class methodsFor: 'proxy settings' stamp: 'TEM 6/21/1998 10:25'!
stopUsingProxyServer
	"Stop directing HTTP request through a proxy server."
	self clearProxyUserPassword.
	HTTPProxy _ nil.
	HTTPPort _ 80.
! !


HTTPSocket initialize!
'From Squeak 2.0 of May 22, 1998 on 21 June 1998 at 10:44:01 am'!
"Change Set:		HTTP
Date:			21 June 1998
Author:			Tom Morgan

Additions and change to allow use of the HTTPSocket class
for people who live behind firewalls which demand credentials.
These changes were tested with the Netscape-FastTrack/2.01
proxy"!

SimpleClientSocket subclass: #HTTPSocket
	instanceVariableNames: 'headerTokens '
	classVariableNames: 'HTTPBlabEmail HTTPPort HTTPProxy HTTPProxyCredentials ParamDelimiters '
	poolDictionaries: ''
	category: 'System-Network'!

!HTTPSocket class methodsFor: 'class initialization' stamp: 'TEM 6/21/1998 09:55'!
initialize
	"HTTPSocket initialize"

	ParamDelimiters _ ' ', CrLf.
	HTTPPort _ 80.
	HTTPProxy _ nil.
	HTTPBlabEmail _ ''.  "	'From: tedk at disney.com', CrLf	"
	HTTPProxyCredentials _ ''.
! !

!HTTPSocket class methodsFor: 'examples' stamp: 'TEM 6/21/1998 10:17'!
httpGet: url accept: mimeType
	"Return the exact contents of a web object. Asks for the given MIME type. If mimeType is nil, use 'text/html'. 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 MIMI type 'application/octet-stream'."

	| serverName serverAddr s header length bare page list firstData aStream newURL |
	Socket initializeNetwork.
	bare _ (url asLowercase beginsWith: 'http://') 
		ifTrue: [url copyFrom: 8 to: url size]
		ifFalse: [url].
	"For now, may not put :80 or other port number in a url.  Use setHTTPPort:"
	serverName _ bare copyUpTo: $/.
	page _ bare copyFrom: serverName size + 1 to: bare size.
	page size = 0 ifTrue: [page _ '/'].
	HTTPProxy ifNotNil: [
		page _ 'http://', serverName, page.		"put back together"
		serverName _ HTTPProxy].
	
	self retry: [serverAddr _ NetNameResolver addressForName: serverName timeout: 20.
				serverAddr ~~ nil] 
		asking: 'Trouble resolving server name.  Keep trying?'
		ifGiveUp: [Socket deadServer: serverName.
				^ 'Could not resolve the server named: ', serverName].

	s _ HTTPSocket new.
	s connectTo: serverAddr port: HTTPPort.  "80 is normal"
	(s waitForConnectionUntil: (self deadlineSecs: 30)) ifFalse: [
		Socket deadServer: serverName.  s destroy.
		^ 'Server ',serverName,' is not responding'].
	Transcript cr; show: serverName; cr.
	s sendCommand: 'GET ', page, ' HTTP/1.0', CrLf, 
		(mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']),
		'ACCEPT: text/html', CrLf,	"Always accept plain text"
		HTTPProxyCredentials, CrLf, 
		HTTPBlabEmail,	"may be empty"
		'User-Agent: Squeak 1.31',		
		CrLf.	"blank line"
	list _ s getResponseUpTo: CrLf, CrLf.	"list = header, CrLf, CrLf, beginningOfData"
	header _ list at: 1.
	Transcript show: page; cr; show: header; cr.
	firstData _ list at: 3.

	"Find the length"
	length _ s contentsLength: header.	"saves the headerTokens"
	length ifNil: [
		(newURL _ s redirect) ifNotNil: [
			s destroy.
			^ self httpGet: newURL accept: mimeType].
		Transcript cr; show: 'Some kind of Error'.
		s destroy.   ^ header].
	
	aStream _ s getRestOfBuffer: firstData totalLength: length.
	s destroy.	"Always OK to destroy!!"

	^ aStream	"String with just the data"! !

!HTTPSocket class methodsFor: 'examples' stamp: 'TEM 6/21/1998 10:31'!
proxyUserTestingComment
	"Set and clear proxy authentication credentials"
	"	HTTPSocket clearProxyUserPassword.
		HTTPSocket useProxyServerNamed: 'proxy.yourdomain.com' port: 8080.
		HTTPSocket proxyUser: 'tmorgan' password: 'xxxxxxxx'"

	"	HTTPSocket stopUsingProxyServer                         "
	
! !

!HTTPSocket class methodsFor: 'proxy settings' stamp: 'TEM 6/21/1998 09:57'!
clearProxyUserPassword
	"Atonement for an ugly hack that stores your proxy password
	in your image. This clears the userid and password"

HTTPProxyCredentials _ ''.
! !

!HTTPSocket class methodsFor: 'proxy settings' stamp: 'TEM 6/21/1998 10:23'!
proxyUser: userName password: password
	"Store  HTTP 1.0 basic authentication credentials
	Note: this is an ugly hack that stores your password
	in your image.  It's just enought to get you going
	if you use a firewall that requires authentication"

	| ss bb | 
ss _ ReadWriteStream on: (String new: 16).
ss nextPutAll: userName,':',password.
bb _ Base64MimeConverter mimeEncode: ss.
HTTPProxyCredentials _ 'Proxy-Authorization: Basic ', (bb contents).
! !

!HTTPSocket class methodsFor: 'proxy settings' stamp: 'TEM 6/21/1998 10:25'!
stopUsingProxyServer
	"Stop directing HTTP request through a proxy server."
	self clearProxyUserPassword.
	HTTPProxy _ nil.
	HTTPPort _ 80.
! !


HTTPSocket initialize!





More information about the Squeak-dev mailing list