'From Squeak3.3alpha of 30 January 2002 [latest update: #4981] on 3 November 2002 at 2:37:48 pm'! "Change Set: httpDNSError-ls Date: 3 November 2002 Author: Lex Spoon This makes several DNS lookup failures to immediately abort the surrounding HTTP or FTP request. Without this changeset, the system will try to ask the user whether to try again. However, this query doesn't work when the HTTP code is run from the user interface thread. Instead of fixing the query, this changeset removes the query. The idea is that, nowadays, these are low-level routines and that a higher-level routine should be responsible for asking the user whether to retry, anway. "! !HTTPSocket class methodsFor: 'get the page' stamp: 'ls 11/3/2002 14:04'! 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] ]. 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' ifFalse: [ ] ]. {'HTTPSocket class>>httpGetDocument:args:accept:request:'. aStream. url} inspect. ^'some other bad thing happened!!'! ! !HTTPSocket class methodsFor: 'get the page' stamp: 'ls 11/3/2002 14:04'! httpPostMultipart: url args: argsDict accept: mimeType request: requestString " do multipart/form-data encoding rather than x-www-urlencoded " " by Bolot Kerimbaev, 1998 " " this version is a memory hog: puts the whole file in memory " "bolot 12/14/2000 18:28 -- minor fixes to make it comply with RFC 1867" | serverName serverAddr s header length bare page list firstData aStream port argsStream specifiedServer type newUrl mimeBorder fieldValue | 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]. mimeBorder _ '----squeak-georgia-tech-', Time millisecondClockValue printString, '-csl-cool-stuff-----'. "encode the arguments dictionary" argsStream _ WriteStream on: String new. argsDict associationsDo: [:assoc | assoc value do: [ :value | "print the boundary" argsStream nextPutAll: '--', mimeBorder, CrLf. " check if it's a non-text field " argsStream nextPutAll: 'Content-disposition: multipart/form-data; name="', assoc key, '"'. (value isKindOf: MIMEDocument) ifFalse: [fieldValue _ value] ifTrue: [argsStream nextPutAll: ' filename="', value url pathForFile, '"', CrLf, 'Content-Type: ', value contentType. fieldValue _ (value content ifNil: [(FileStream fileNamed: value url pathForFile) contentsOfEntireFile] ifNotNil: [value content]) asString]. " Transcript show: 'field=', key, '; value=', fieldValue; cr. " argsStream nextPutAll: CrLf, CrLf, fieldValue, CrLf. ]]. argsStream nextPutAll: '--', mimeBorder, '--'. "make the request" serverAddr _ NetNameResolver addressForName: serverName timeout: 20. serverAddr ifNil: [ ^ 'Could not resolve the server named: ', serverName]. s _ HTTPSocket new. s connectTo: serverAddr port: port. s waitForConnectionUntil: self standardDeadline. Transcript cr; show: serverName, ':', port asString; cr. s sendCommand: 'POST ', page, ' HTTP/1.1', 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, 'Content-type: multipart/form-data; boundary=', mimeBorder, CrLf, 'Content-length: ', argsStream contents size printString, CrLf, 'Host: ', specifiedServer, CrLf. "blank line automatically added" s sendCommand: argsStream contents. "get the header of the reply" list _ s getResponseUpTo: CrLf, CrLf. "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. length _ s getHeader: 'content-length'. length ifNotNil: [ length _ length asNumber ]. type _ s getHeader: 'content-type'. s responseCode first = $3 ifTrue: [ "redirected - don't re-post automatically" "for now, just do a GET, without discriminating between 301/302 codes" newUrl _ s getHeader: 'location'. newUrl ifNotNil: [ (newUrl beginsWith: 'http://') ifFalse: [ (newUrl beginsWith: '/') ifTrue: [newUrl _ (bare copyUpTo: $/), newUrl] ifFalse: [newUrl _ url, newUrl. self flag: #todo "should do a relative URL"] ]. Transcript show: 'redirecting to: ', newUrl; cr. s destroy. ^self httpGetDocument: newUrl "for some codes, may do: ^self httpPostMultipart: newUrl args: argsDict accept: mimeType request: requestString"] ]. aStream _ s getRestOfBuffer: firstData totalLength: length. s responseCode = '401' ifTrue: [^ header, aStream contents]. s destroy. "Always OK to destroy!!" ^ MIMEDocument contentType: type content: aStream contents url: url! ! !HTTPSocket class methodsFor: 'get the page' stamp: 'ls 11/3/2002 14:04'! httpPostToSuperSwiki: url args: argsDict accept: mimeType request: requestString | serverName serverAddr s header length bare page list firstData aStream port specifiedServer type mimeBorder contentsData | 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: $/ ifAbsent: [^'error']) 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]. mimeBorder _ '---------SuperSwiki',Time millisecondClockValue printString,'-----'. contentsData _ String streamContents: [ :strm | strm nextPutAll: mimeBorder, CrLf. argsDict associationsDo: [:assoc | assoc value do: [ :value | strm nextPutAll: 'Content-disposition: form-data; name="', assoc key, '"'; nextPutAll: CrLf; nextPutAll: CrLf; nextPutAll: value; nextPutAll: CrLf; nextPutAll: CrLf; nextPutAll: mimeBorder; nextPutAll: CrLf. ] ]. ]. "make the request" serverAddr _ NetNameResolver addressForName: serverName timeout: 20. serverAddr ifNil: [ ^ 'Could not resolve the server named: ', serverName]. s _ HTTPSocket new. s connectTo: serverAddr port: port. s waitForConnectionUntil: self standardDeadline. s sendCommand: 'POST ', page, ' HTTP/1.1', 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, 'Content-type: multipart/form-data; boundary=', mimeBorder, CrLf, 'Content-length: ', contentsData size printString, CrLf, 'Host: ', specifiedServer, CrLf. "blank line automatically added" s sendCommand: contentsData. list _ s getResponseUpTo: CrLf, CrLf. "list = header, CrLf, CrLf, beginningOfData" header _ list at: 1. firstData _ list at: 3. header isEmpty ifTrue: [ s destroy. ^'no response' ]. s header: header. length _ s getHeader: 'content-length'. length ifNotNil: [ length _ length asNumber ]. type _ s getHeader: 'content-type'. aStream _ s getRestOfBuffer: firstData totalLength: length. s responseCode = '401' ifTrue: [^ header, aStream contents]. s destroy. "Always OK to destroy!!" ^ MIMEDocument contentType: type content: aStream contents url: url! ! !HTTPSocket class methodsFor: 'get the page' stamp: 'ls 11/3/2002 14:04'! 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 | 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 _ (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, '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 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. 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! ! !HTTPSocket class methodsFor: 'utilities' stamp: 'ls 11/3/2002 14:05'! initHTTPSocket: httpUrl wait: timeout ifError: aBlock "Retrieve the server and port information from the URL, match it to the proxy settings and open a http socket for the request." | serverName port serverAddr s | Socket initializeNetwork. serverName _ httpUrl authority. port _ httpUrl port ifNil: [self defaultPort]. (self shouldUseProxy: serverName) ifTrue: [ serverName _ HTTPProxyServer. port _ HTTPProxyPort]. "make the request" serverAddr _ NetNameResolver addressForName: serverName timeout: 20. serverAddr ifNil: [ aBlock value: 'Error: Could not resolve the server named: ', serverName]. s _ HTTPSocket new. s connectTo: serverAddr port: port. (s waitForConnectionUntil: timeout) ifFalse: [ Socket deadServer: httpUrl authority. s destroy. ^aBlock value: 'Error: Server ',httpUrl authority,' is not responding']. ^s ! ! !ServerDirectory methodsFor: 'dis/connect' stamp: 'ls 11/3/2002 14:06'! openNoDataFTP "Open a connection to the directory and server I hold. Return a FTPSocket. No dataPort is opened. When you are all done, be sure to tell the socket to QUIT, and then destroy it." | so rr serverIP what | Socket initializeNetwork. socket ifNotNil: [socket isValid ifTrue: [^ socket] "already open" ifFalse: [socket _ nil]]. Cursor wait showWhile: [ serverIP _ NetNameResolver addressForName: server timeout: 20. serverIP ifNil: [ ^ 'Could not resolve the server named: ', server]. so _ FTPSocket new. so portNum: 21. so connectTo: serverIP port: 21. "21 is for the control connection" so waitForConnectionUntil: FTPSocket standardDeadline. ]. "Transcript cr; show: 'ftp: ', server; cr." (rr _ so lookFor: '220 ') == true ifFalse: [^ rr]. "220 para1 Microsoft FTP Service" [ "repeat both USER and PASS since some servers require it" so sendCommand: 'USER ', user. (rr _ so lookFor: '331 ') == true ifFalse: [^ rr]. "331 Password required" so sendCommand: 'PASS ', self password. "will ask user, if needed" (rr _ so lookSoftlyFor: '230 ') == true ] "230 User logged in" whileFalse: [ rr first == $5 ifFalse: [^ rr]. "timeout" passwordHolder _ nil. what _ (PopUpMenu labels: 'enter password\give up' withCRs) startUpWithCaption: 'Would you like to try another password?'. what = 1 ifFalse: [so destroy. ^ rr]]. (rr _ self changeWorkingDirectory: so) == true ifFalse: [^rr]. "Need to ask for name of directory to make sure?" "socket _ so". "If user wants to keep connnection open, he must store socket" ^ so! !