[Pkg] Monticello Public: Monticello.impl-kph.634.mcz
squeak-dev-noreply at lists.squeakfoundation.org
squeak-dev-noreply at lists.squeakfoundation.org
Tue Feb 17 11:50:24 UTC 2009
Damien Cassou uploaded a new version of Monticello.impl to project Monticello Public:
http://www.squeaksource.com/mc/Monticello.impl-kph.634.mcz
==================== Summary ====================
Name: Monticello.impl-kph.634
Author: kph
Time: 17 February 2009, 12:50:13 pm
UUID: 89183e80-a85c-4d01-8a33-853ee0dc09a1
Ancestors: Monticello.impl-kph.631
- Removes overrides that are now part of changeset at bug #7291.
=============== Diff against Monticello.impl-kph.631 ===============
Item was removed:
- ----- Method: HTTPSocket class>>httpPost:args:user:passwd: (in category '*monticello-override') -----
- httpPost: url args: args user: user passwd: passwd
- | authorization result |
- authorization := (Base64MimeConverter mimeEncode: (user , ':' , passwd) readStream) contents.
- 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.
- !
Item was removed:
- ----- Method: HTTPSocket class>>httpGetDocument:args:accept:request: (in category '*monticello-override') -----
- 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 := HTTPProxyServer.
- connectToPort := 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 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 removed:
- ----- Method: HTTPSocket class>>digestFor:method:url:user:password: (in category '*monticello-override') -----
- 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: CrLf, CrLf).
- ^self digestFrom: sock method: method url: url user: user password: password!
Item was removed:
- ----- Method: HTTPSocket class>>httpGet:args:user:passwd: (in category '*monticello-override') -----
- httpGet: url args: args user: user passwd: passwd
- | authorization result |
- authorization := (Base64MimeConverter mimeEncode: (user , ':' , passwd) readStream) contents.
- 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.
- !
Item was removed:
- ----- Method: HTTPSocket class>>md5Hash: (in category '*monticello-override') -----
- 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 removed:
- ----- Method: HTTPSocket class>>httpPut:to:user:passwd: (in category '*monticello-override') -----
- 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 |
- 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 := HTTPProxyServer.
- port := HTTPProxyPort].
-
- "make the request"
- serverAddr := NetNameResolver addressForName: serverName timeout: 20.
- serverAddr ifNil: [
- ^ 'Could not resolve the server named: ', serverName].
-
- authorization := ' Basic ', (Base64MimeConverter mimeEncode: (user , ':' , passwd) readStream) contents.
- [
- 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 ,
- 'Content-length: ', contents size printString, CrLf , CrLf ,
- contents.
- s sendCommand: command.
- "get the header of the reply"
- 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!!"
- ^ header, aStream contents!
Item was removed:
- ----- Method: HTTPSocket class>>digestFrom:method:url:user:password: (in category '*monticello-override') -----
- 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 Packages
mailing list