The Trunk: Network-ar.47.mcz

Andreas Raab uploaded a new version of Network to project The Trunk:
http://source.squeak.org/trunk/Network-ar.47.mcz

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

Name: Network-ar.47
Author: ar
Time: 30 December 2009, 4:40:24 am
UUID: 429af7d7-a121-3342-a5c5-2f6c27f10bbe
Ancestors: Network-ar.46

Add HTTPProgress for put operations (uploads).

=============== Diff against Network-ar.46 ===============

Item was added:
+ ----- Method: HTTPSocket>>sendCommandWithProgress: (in category 'as yet unclassified') -----
+ sendCommandWithProgress: commandString
+ "Send the given command as a single line followed by a <CR><LF> terminator."
+
+ self sendDataWithProgress: commandString, CrLf.
+ !

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 |
  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.
  [
  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 sendCommandWithProgress: command.
- s sendCommand: command.
  "get the header of the reply"
  list := s getResponseUpTo: CrLf, CrLf ignoring: String 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 ].
 
+ "Suppress progress during response handling"
+ [aStream := s getRestOfBuffer: firstData totalLength: length]
+ on: HTTPProgress do:[:ex| ex resume].
- aStream := s getRestOfBuffer: firstData totalLength: length.
  s destroy. "Always OK to destroy!!"
  ^ header, aStream contents!

Item was added:
+ ----- Method: HTTPSocket>>sendDataWithProgress: (in category 'as yet unclassified') -----
+ sendDataWithProgress: aStringOrByteArray
+ "Send all of the data in the given array, even if it requires multiple calls to send it all. Return the number of bytes sent."
+
+ "An experimental version use on slow lines: Longer timeout and smaller writes to try to avoid spurious timeouts."
+
+ | bytesSent bytesToSend count |
+ bytesToSend := aStringOrByteArray size.
+ bytesSent := 0.
+ [bytesSent < bytesToSend] whileTrue: [
+ (HTTPProgress new)
+ total: bytesToSend;
+ amount: bytesSent;
+ signal: 'Uploading...'.
+ (self waitForSendDoneUntil: (Socket deadlineSecs: 60))
+ ifFalse: [ConnectionTimedOut signal: 'send data timeout; data not sent'].
+ count := self primSocket: socketHandle
+ sendData: aStringOrByteArray
+ startIndex: bytesSent + 1
+ count: (bytesToSend - bytesSent min: 5000).
+ bytesSent := bytesSent + count].
+
+ ^ bytesSent
+ !