[Pkg] Monticello Public: Monticello.impl-mtf.524.mcz
squeaksource-noreply at iam.unibe.ch
squeaksource-noreply at iam.unibe.ch
Tue Jun 10 03:32:27 UTC 2008
A new version of Monticello.impl was added to project Monticello Public:
http://www.squeaksource.com/mc/Monticello.impl-mtf.524.mcz
==================== Summary ====================
Name: Monticello.impl-mtf.524
Author: mtf
Time: 9 June 2008, 8:30:18 pm
UUID: 7523f454-68c8-46b8-b340-bcd1dae2d755
Ancestors: Monticello.impl-mtf.523
fixed some underscore assignments
=============== Diff against Monticello.impl-mtf.523 ===============
Item was changed:
----- 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.
- 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 changed:
----- 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://')
- 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.
- 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 := '/'].
- 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) ].
- args ifNotNil: [page _ page, (self argString: args) ].
(self shouldUseProxy: serverName)
ifFalse: [
+ connectToHost := serverName.
+ connectToPort := port ]
- connectToHost _ serverName.
- connectToPort _ port ]
ifTrue: [
+ page := 'http://', serverName, ':', port printString, page. "put back
- page _ 'http://', serverName, ':', port printString, page. "put back
together"
+ connectToHost := HTTPProxyServer.
+ connectToPort := HTTPProxyPort].
- connectToHost _ HTTPProxyServer.
- connectToPort _ HTTPProxyPort].
+ serverAddr := NetNameResolver addressForName: connectToHost timeout: 20.
- serverAddr _ NetNameResolver addressForName: connectToHost timeout: 20.
serverAddr ifNil: [
^ 'Could not resolve the server named: ', connectToHost].
3 timesRepeat: [
+ sock := HTTPSocket new.
- 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,
- list _ sock getResponseUpTo: CrLf, CrLf ignoring: (String with: CR). "list = header, CrLf, CrLf,
beginningOfData"
+ header := list at: 1.
- header _ list at: 1.
"Transcript show: page; cr; show: header; cr."
+ firstData := list at: 3.
- firstData _ list at: 3.
header isEmpty
+ ifTrue: [aStream := 'server aborted early']
- 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'.
- 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 _ sock getHeader: 'location'.
newUrl ifNotNil: [
Transcript show: 'redirecting to ', newUrl; cr.
sock destroy.
+ newUrl := self expandUrl: newUrl ip: serverAddr port: connectToPort.
- newUrl _ self expandUrl: newUrl ip: serverAddr port: connectToPort.
^self httpGetDocument: newUrl args: args accept: mimeType request: requestString] ].
+ aStream := sock getRestOfBuffer: firstData totalLength: length.
- 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 changed:
----- Method: MCAncestry>>trimAfterVersionInfo: (in category 'ancestry') -----
trimAfterVersionInfo: aVersionInfo
aVersionInfo = self
+ ifTrue: [ancestors := #()]
- ifTrue: [ancestors _ #()]
ifFalse:
[aVersionInfo date <= self date ifTrue:
[self ancestors do: [:ea | ea trimAfterVersionInfo: aVersionInfo]]
]!
Item was changed:
----- 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://')
- 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
- 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: $:.
- 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 ].
+ 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.
- aStream _ s getRestOfBuffer: firstData totalLength: length.
s destroy. "Always OK to destroy!!"
^ header, aStream contents!
More information about the Packages
mailing list