The Trunk: Network-ul.41.mcz

Levente Uzonyi uploaded a new version of Network to project The Trunk:
http://source.squeak.org/trunk/Network-ul.41.mcz

==================== Summary ====================

Name: Network-ul.41
Author: ul
Time: 2 December 2009, 6:11:43 am
UUID: 0598c060-af2b-ca4b-8fa3-09e0dd0162ae
Ancestors: Network-nice.40

- merged http://bugs.squeak.org/view.php?id=7291

=============== Diff against Network-nice.40 ===============

Item was changed:
  ----- Method: HTTPSocket class>>httpPost:args:user:passwd: (in category 'get the page') -----
  httpPost: url args: args user: user passwd: passwd
+
+ | authorization result |
- | authorization |
  authorization := (user , ':' , passwd) base64Encoded.
+ result := self
+ httpPostDocument: url args: args accept: '*/*'
+ request: 'Authorization: Basic ' , authorization , CrLf.
+ result isString ifFalse: [ ^result ].
+
+ authorization := self digestFor: result method: 'POST' url: url user: user password: passwd.
+ authorization ifNil: [ ^result ].
  ^self
  httpPostDocument: url args: args accept: '*/*'
+ request: 'Authorization: Digest ' , authorization , CrLf.
+ !
- request: 'Authorization: Basic ' , authorization , CrLf!

Item was changed:
+ ----- Method: HTTPSocket class>>httpGetDocument:args:accept:request: (in category 'proxy settings') -----
- ----- Method: HTTPSocket class>>httpGetDocument:args:accept:request: (in category 'get the page') -----
  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) ].
 
 
  (self shouldUseProxy: serverName)
  ifFalse: [
  connectToHost := serverName.
  connectToPort := port ]
  ifTrue:  [
  page := 'http://', serverName, ':', port printString, page. "put back
  together"
  connectToHost := self httpProxyServer.
  connectToPort := self httpProxyPort].
 
 
  serverAddr := NetNameResolver addressForName: connectToHost timeout: 20.
  serverAddr ifNil: [
  ^ '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: url; cr.
  Transcript show: page; cr."
  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"
  self userAgentString, CrLf,
  'Host: ', serverName, ':', port printString, CrLf. "blank line
  automatically added"
 
+ list := sock getResponseUpTo: CrLf, CrLf ignoring: String cr. "list = header, CrLf, CrLf,
- list := sock getResponseUpTo: CrLf, CrLf ignoring: (String with: CR). "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.
  newUrl := self expandUrl: newUrl ip: serverAddr port: connectToPort.
  ^self httpGetDocument: newUrl args: args  accept: mimeType request: requestString] ].
  aStream := sock getRestOfBuffer: firstData totalLength: length.
  "a 400-series error"
  sock responseCode first = $4 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' ifTrue: [ ^aStream ].
  ].
 
  {'HTTPSocket class>>httpGetDocument:args:accept:request:'. aStream. url} inspect.
 
  ^'some other bad thing happened!!'!

Item was added:
+ ----- Method: HTTPSocket class>>digestFor:method:url:user:password: (in category 'digest') -----
+ digestFor: serverText method: method url: url user: user password: password
+ "RFC2069"
+ | sock |
+ sock := HTTPSocket new. "header decoder is on instance side"
+ sock header: (serverText readStream upToAll: String crlf, String crlf).
+ ^self digestFrom: sock method: method url: url user: user password: password!

Item was changed:
  ----- Method: HTTPSocket class>>httpGet:args:user:passwd: (in category 'get the page') -----
  httpGet: url args: args user: user passwd: passwd
+
+ | authorization result |
- | authorization |
  authorization := (user , ':' , passwd) base64Encoded.
+ result := self
+ httpGet: url args: args accept: '*/*'
+ request: 'Authorization: Basic ' , authorization , CrLf.
+ result isString ifFalse: [^result].
+
+ authorization := self digestFor: result method: 'GET' url: url user: user password: passwd.
+ authorization ifNil: [^result].
  ^self
  httpGet: url args: args accept: '*/*'
+ request: 'Authorization: Digest ' , authorization , CrLf!
- request: 'Authorization: Basic ' , authorization , CrLf!

Item was added:
+ ----- Method: HTTPSocket class>>md5Hash: (in category 'digest') -----
+ md5Hash: aString
+ "Answer hash of aString as lowercase 32 digit hex String.
+ There are several providers of MD5 hash ..."
+ "(self md5Hash: 'user:realm:passwd') =  '007e68e539ed680c24f6d9a370f3bcb1'"
+ | hash |
+ hash := Smalltalk at: #CMD5Hasher ifPresent: [:cls |
+ cls hashMessage: aString].
+ hash ifNil: [
+ hash := Smalltalk at: #TCryptoRandom ifPresent: [:cls |
+ (cls basicNew md5HashMessage: aString) asInteger]].
+ hash ifNotNil: [
+ hash := hash hex asLowercase.
+ (hash beginsWith: '16r') ifTrue: [hash := hash allButFirst: 3].
+ hash := hash padded: #left to: 32 with: $0].
+ ^hash!

Item was changed:
  ----- Method: HTTPSocket class>>httpPut:to:user:passwd: (in category 'get the page') -----
  httpPut: contents to: url user: user passwd: passwd
  "Upload the contents of the stream to a file on the server"
 
+ | bare serverName specifiedServer port page serverAddr authorization s list header firstData length aStream command digest |
- | bare serverName specifiedServer port page serverAddr authorization s list header firstData length aStream command |
  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 := '/'].
  (self shouldUseProxy: serverName) ifTrue: [
  page := 'http://', serverName, ':', port printString, page. "put back together"
  serverName := self httpProxyServer.
  port := self httpProxyPort].
 
    "make the request"
  serverAddr := NetNameResolver addressForName: serverName timeout: 20.
  serverAddr ifNil: [
  ^ 'Could not resolve the server named: ', serverName].
 
+ authorization := ' Basic ', (user , ':' , passwd) base64Encoded.
+ [
- authorization := (user , ':' , passwd) base64Encoded.
  s := HTTPSocket new.
  s connectTo: serverAddr port: port.
  s waitForConnectionUntil: self standardDeadline.
  Transcript cr; show: url; cr.
  command :=
  'PUT ', page, ' HTTP/1.0', CrLf,
  self userAgentString, CrLf,
  'Host: ', specifiedServer, CrLf,
  'ACCEPT: */*', CrLf,
  HTTPProxyCredentials,
+ 'Authorization: ' , authorization , CrLf ,
- 'Authorization: Basic ' , authorization , CrLf ,
  'Content-length: ', contents size printString, CrLf , CrLf ,
  contents.
  s sendCommand: command.
  "get the header of the reply"
+ list := s getResponseUpTo: CrLf, CrLf ignoring: String cr. "list = header, CrLf, CrLf, beginningOfData"
- list := s getResponseUpTo: CrLf, CrLf ignoring: (String with: CR). "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.
+
+ (authorization beginsWith: 'Digest ') not
+ and: [(digest := self digestFrom: s method: 'PUT' url: url user: user password: passwd) notNil]]
+ whileTrue: [authorization :=  'Digest ', digest].
- length := s getHeader: 'content-length'.
- length ifNotNil: [ length := length asNumber ].
-
- aStream := s getRestOfBuffer: firstData totalLength: length.
- s destroy. "Always OK to destroy!!"
 
+ length := s getHeader: 'content-length'.
+ length ifNotNil: [ length := length asNumber ].
+
+ aStream := s getRestOfBuffer: firstData totalLength: length.
+ s destroy. "Always OK to destroy!!"
  ^ header, aStream contents!

Item was added:
+ ----- Method: HTTPSocket class>>digestFrom:method:url:user:password: (in category 'digest') -----
+ digestFrom: sock method: method url: url user: user password: password
+ "RFC2069"
+ | auth fields realm nonce uri a1 a2 response |
+ sock responseCode = '401' ifFalse: [^nil].
+ auth := sock getHeader: 'www-authenticate'.
+ (auth asLowercase beginsWith: 'digest') ifFalse: [^nil].
+
+ fields := (((auth allButFirst: 6) findTokens: ', ') collect: [:ea |
+ (ea copyUpTo: $=) asLowercase -> (ea copyAfter: $=) withoutQuoting]) as: Dictionary.
+
+ realm := fields at: 'realm'.
+ nonce := fields at: 'nonce'.
+ uri := url readStream upToAll: '://'; skipTo: $/; skip: -1; upTo: $#.
+ a1 := self md5Hash: user, ':', realm, ':', password.
+ a2 := self md5Hash: method, ':', uri.
+ a1 ifNil: [^nil "no MD5 support"].
+ response := self md5Hash: a1, ':', nonce, ':', a2.
+
+ ^String streamContents: [:digest |
+ digest
+ nextPutAll: 'username="', user, '"';
+ nextPutAll: ', realm="', realm, '"';
+ nextPutAll: ', nonce="', nonce, '"';
+ nextPutAll: ', uri="', uri, '"';
+ nextPutAll: ', response="', response, '"'.
+ fields at: 'opaque' ifPresent: [:opaque |
+ digest nextPutAll: ', opaque="', opaque, '"'].
+ ]
+ !