Andreas Raab uploaded a new version of Network to project The Trunk:
http://source.squeak.org/trunk/Network-ar.46.mcz ==================== Summary ==================== Name: Network-ar.46 Author: ar Time: 30 December 2009, 4:23:24 am UUID: 62689cdd-d137-f546-acfb-840508ca3502 Ancestors: Network-ar.45 Add an HTTPProgress notification that can be used to display progress during HTTPSocket httpGet: operations. =============== Diff against Network-ar.45 =============== Item was changed: ----- 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 bare page index connectToHost connectToPort aStream portSuffix | 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. portSuffix := ':', port printString. serverName := serverName copyFrom: 1 to: index-1. ] ifFalse: [ port := self defaultPort. portSuffix := ''. ]. 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, portSuffix, page. "put back together" connectToHost := self httpProxyServer. connectToPort := self httpProxyPort]. + HTTPProgress signal: 'Looking up ', connectToHost. serverAddr := NetNameResolver addressForName: connectToHost timeout: 20. + serverAddr ifNil: [^ 'Could not resolve the server named: ', connectToHost]. - serverAddr ifNil: [ - ^ 'Could not resolve the server named: ', connectToHost]. 3 timesRepeat: [ | sock length firstData list type header newUrl | 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, portSuffix, 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 added: + Notification subclass: #HTTPProgress + instanceVariableNames: 'total amount' + classVariableNames: '' + poolDictionaries: '' + category: 'Network-Protocols'! + + !HTTPProgress commentStamp: 'ar 12/30/2009 16:16' prior: 0! + HTTP progress notification. Includes: + - total: The total size of the download (if known) + - amount: The completed amount of the download (if known) + ! Item was changed: ----- Method: HTTPSocket>>getRestOfBuffer:totalLength: (in category 'as yet unclassified') ----- getRestOfBuffer: beginning totalLength: length "Reel in a string of a fixed length. Part of it has already been received. Close the connection after all chars are received. We do not strip out linefeed chars. tk 6/16/97 22:32" "if length is nil, read until connection close. Response is of type text, not binary." | buf response bytesRead | length ifNil: [^ self getRestOfBuffer: beginning]. buf := String new: length. response := RWBinaryOrTextStream on: buf. response nextPutAll: beginning. buf := String new: length. [(response position < length) & (self isConnected | self dataAvailable)] whileTrue: [ + (HTTPProgress new) + total: length; + amount: response position; + signal: 'Downloading...'. (self waitForDataUntil: (Socket deadlineSecs: 5)) ifFalse: [ Transcript show: 'data was slow'; cr]. bytesRead := self primSocket: socketHandle receiveDataInto: buf startingAt: 1 count: (length - response position). bytesRead > 0 ifTrue: [ response nextPutAll: (buf copyFrom: 1 to: bytesRead)] ]. "Transcript cr; show: 'data byte count: ', response position printString." "Transcript cr; show: ((self isConnected) ifTrue: ['Over length by: ', bytesRead printString] ifFalse: ['Socket closed'])." response position < length ifTrue: [^ 'server aborted early']. response reset. "position: 0." ^ response! Item was added: + ----- Method: HTTPProgress>>total (in category 'accessing') ----- + total + "Answer the total size of the download, if known" + ^total! Item was added: + ----- Method: HTTPProgress>>amount: (in category 'accessing') ----- + amount: bytes + "Set the completed amount of the download (if known)" + amount := bytes! Item was added: + ----- Method: HTTPProgress>>total: (in category 'accessing') ----- + total: bytes + "Answer the total size of the download, if known" + total := bytes! Item was added: + ----- Method: HTTPProgress>>amount (in category 'accessing') ----- + amount + "Answer the completed amount of the download (if known)" + ^amount! |
Free forum by Nabble | Edit this page |