[squeak-dev] The Trunk: Network-ul.41.mczcommits at source.squeak.org commits at source.squeak.orgThu Dec 3 03:18:02 UTC 2009
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, '"']. + ] + !
More information about the Squeak-dev mailing list |