[enh] userid and password for firewall authentication

David Faught dave_faught at yahoo.com
Mon Jul 21 13:01:28 UTC 2003


I found this changeset at http://minnow.cc.gatech.edu/squeak/23
I don't "own" this changeset and didn't develop it.  I do use it all
the time and think it's important.

__________________________________
Do you Yahoo!?
SBC Yahoo! DSL - Now only $29.95 per month!
http://sbc.yahoo.com
-------------- next part --------------
'From Squeak 2.2 of Sept 23, 1998 on 12 November 1998 at 9:21:31 pm'!
SimpleClientSocket subclass: #HTTPSocket
         instanceVariableNames: 'headerTokens headers responseCode '
         classVariableNames: 'HTTPBlabEmail HTTPPort 
HTTPProxyCredentials HTTPProxyPort HTTPProxyServer 
HTTPProxyExceptions ParamDelimiters '
         poolDictionaries: ''
         category: 'Network-Protocols'!

!HTTPSocket class methodsFor: 'class initialization' stamp: 'TEM 
11/12/1998 20:59'!
initialize
         "HTTPSocket initialize"

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

!HTTPSocket class methodsFor: 'examples' stamp: 'TEM 11/12/1998 21:11'!
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'."

         | serverName serverAddr port sock header length bare page 
list firstData aStream index connectToHost connectToPort type newUrl |
         Socket initializeNetwork.
         bare _ (url asLowercase beginsWith: 'http://')
                 ifTrue: [url copyFrom: 8 to: url size]
                 ifFalse: [url].
         bare _ bare copyUpTo: $#.  "remove fragment, if specified"
         serverName _ bare copyUpTo: $/.
         page _ bare copyFrom: serverName size + 1 to: bare size.
         (serverName includes: $:)
                 ifTrue: [ index _ serverName indexOf: $:.
                         port _ (serverName copyFrom: index+1 to: 
serverName size) asNumber.
                         serverName _ serverName copyFrom: 1 to: index-1. ]
                 ifFalse: [ port _ self defaultPort ].
         page size = 0 ifTrue: [page _ '/'].
         "add arguments"
         args ifNotNil: [page _ page, self argString: args ].


         HTTPProxyServer isNil
                 ifTrue: [
                         connectToHost _ serverName.
                         connectToPort _ port ]
                 ifFalse:  [
                         page _ 'http://', serverName, ':', port 
printString, page.              "put back together"
                         connectToHost _ HTTPProxyServer.
                         connectToPort _ HTTPProxyPort].

         self flag: #XXX.  "this doesn't make sense if a user isn't 
available for questioning...  -ls"
         self retry: [serverAddr _ NetNameResolver addressForName: 
connectToHost timeout: 20.
                                 serverAddr ~~ nil]
                 asking: 'Trouble resolving server name.  Keep trying?'
                 ifGiveUp: [Socket deadServer: connectToHost.
                                 ^ 'Could not resolve the server 
named: ', connectToHost].

3 timesRepeat: [
         sock _ HTTPSocket new.
         sock connectTo: serverAddr port: connectToPort.
         (sock waitForConnectionUntil: (self deadlineSecs: 30)) ifFalse: [
                 Socket deadServer: connectToHost.  sock destroy.
                 ^ 'Server ',connectToHost,' is not responding'].
         Transcript cr; show: connectToHost; cr.
         sock sendCommand: 'GET ', page, ' HTTP/1.0', CrLf,
                 (mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']),
                 'ACCEPT: text/html', CrLf,      "Always accept plain text"
                 HTTPProxyCredentials,
                 HTTPBlabEmail,  "may be empty"
                 requestString,  "extra user request. Authorization"
                 'User-Agent: Squeak 1.31', CrLf,
                 'Host: ', serverName, ':', 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: 'examples' stamp: 'TEM 11/12/1998 21:12'!
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"

         | serverName serverAddr s header length bare page list 
firstData aStream port argsStream first specifiedServer type newUrl |
         Socket initializeNetwork.

         "parse url"
         bare _ (url asLowercase beginsWith: 'http://')
                 ifTrue: [url copyFrom: 8 to: url size]
                 ifFalse: [url].
         serverName _ bare copyUpTo: $/.
         specifiedServer _ serverName.
         (serverName includes: $:) ifFalse: [ port _ self defaultPort 
] ifTrue: [
                 port _ (serverName copyFrom: (serverName indexOf: $:) + 1
                                 to: serverName size) asNumber.
                 serverName _ serverName copyUpTo: $:.
         ].

         page _ bare copyFrom: (bare indexOf: $/) to: bare size.
         page size = 0 ifTrue: [page _ '/'].
         HTTPProxyServer ifNotNil: [
                 page _ 'http://', serverName, ':', port printString, 
page.              "put back together"
                 serverName _ HTTPProxyServer.
                 port _ HTTPProxyPort].

         "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.
         ] ].

         "make the request"
         self retry: [serverAddr _ NetNameResolver addressForName: 
serverName timeout: 20.
                                 serverAddr ~~ nil]
                 asking: 'Trouble resolving server name.  Keep trying?'
                 ifGiveUp: [^ 'Could not resolve the server named: ', 
serverName].

         s _ HTTPSocket new.
         s connectTo: serverAddr port: port.
         s waitForConnectionUntil: self standardDeadline.
         Transcript cr; show: serverName; 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"
                 HTTPProxyCredentials,
                 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: ', specifiedServer, 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: '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),CrLf.
! !

!HTTPSocket class methodsFor: 'proxy settings' stamp: 'TEM 11/12/1998 21:00'!
stopUsingProxyServer
         "Stop directing HTTP request through a proxy server."
         self clearProxyUserPassword.
         HTTPProxyServer _ nil.
         HTTPPort _ 80.
! !


HTTPSocket initialize!


More information about the Squeak-dev mailing list