'From Squeak3.1alpha of 28 February 2001 [latest update: #4175] on 27 June 2001 at 9:49:07 pm'! "Change Set: dnsRaceCondFix-mir Date: 25 June 2001 Author: Michael Rueger Fixes a problem with a race condition in the name lookup if more than one query is launched at the same time from concurrent processes. It also adds the server name to the error message."! Object subclass: #NetNameResolver instanceVariableNames: '' classVariableNames: 'DefaultHostName HaveNetwork LastContact ResolverBusy ResolverError ResolverMutex ResolverReady ResolverSemaphore ResolverUninitialized ' poolDictionaries: '' category: 'Network-Kernel'! !HTTPSocket methodsFor: 'as yet unclassified' stamp: 'mir 6/15/2001 17:51'! getRestOfBuffer: beginning "We don't know the length. Keep going until connection is closed. Part of it has already been received. Response is of type text, not binary." | buf response bytesRead | response _ RWBinaryOrTextStream on: (String new: 2000). response nextPutAll: beginning. buf _ String new: 2000. [self isConnected | self dataAvailable] whileTrue: [ (self waitForDataUntil: (Socket deadlineSecs: 5)) ifFalse: [ Transcript show: 'data was slow'; cr]. bytesRead _ self primSocket: socketHandle receiveDataInto: buf startingAt: 1 count: buf size. bytesRead > 0 ifTrue: [ response nextPutAll: (buf copyFrom: 1 to: bytesRead)] ]. Transcript cr; show: 'data byte count: ', response position printString. response reset. "position: 0." ^ response ! ! !HTTPSocket class methodsFor: 'get the page' stamp: 'mir 6/15/2001 18:25'! 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) ]. HTTPProxyServer isNil ifTrue: [ connectToHost _ serverName. connectToPort _ port ] ifFalse: [ page _ 'http://', serverName, ':', port printString, page. "put back together" connectToHost _ HTTPProxyServer. connectToPort _ HTTPProxyPort]. self flag: #XXX. "this doesn't make sense if a user isn't available for questioning... -ls" self retry: [serverAddr _ NetNameResolver addressForName: connectToHost timeout: 20. serverAddr ~~ nil] asking: 'Trouble resolving server name "' , connectToHost , '". Keep trying?' ifGiveUp: [Socket deadServer: connectToHost. ^ '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" 'User-Agent: Squeak 1.31', 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. ^self httpGetDocument: newUrl args: args accept: mimeType ] ]. aStream _ sock getRestOfBuffer: firstData totalLength: length. sock responseCode = '401' 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: 'mir 6/7/2001 16:39'! 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 _ '/']. HTTPProxyServer ifNotNil: [ 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" self retry: [serverAddr _ NetNameResolver addressForName: serverName timeout: 20. serverAddr ~~ nil] asking: 'Trouble resolving server name "' , serverName , '". Keep trying?' ifGiveUp: [^ '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" 'User-Agent: Squeak 1.31', 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: 'mir 6/7/2001 16:39'! 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 _ '/']. HTTPProxyServer ifNotNil: [ 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" self retry: [serverAddr _ NetNameResolver addressForName: serverName timeout: 20. serverAddr ~~ nil] asking: 'Trouble resolving server name "' , serverName , '". Keep trying?' ifGiveUp: [^ '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" 'User-Agent: Squeak 2.9', 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: 'mir 6/7/2001 16:39'! 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 _ '/']. HTTPProxyServer ifNotNil: [ page _ 'http://', serverName, ':', port printString, page. "put back together" serverName _ HTTPProxyServer. port _ HTTPProxyPort]. "make the request" self retry: [serverAddr _ NetNameResolver addressForName: serverName timeout: 20. serverAddr ~~ nil] asking: 'Trouble resolving server name "' , serverName , '". Keep trying?' ifGiveUp: [^ '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, 'User-Agent: Squeak 2.0', 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: 'mir 6/7/2001 16:40'! 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" self retry: [serverAddr _ NetNameResolver addressForName: serverName timeout: 20. serverAddr ~~ nil] asking: 'Trouble resolving server name "' , serverName , '". Keep trying?' ifGiveUp: [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 ! ! !NetNameResolver class methodsFor: 'lookups' stamp: 'mir 6/18/2001 21:18'! addressForName: hostName timeout: secs "Look up the given host name and return its address. Return nil if the address is not found in the given number of seconds." "NetNameResolver addressForName: 'create.ucsb.edu' timeout: 30" "NetNameResolver addressForName: '100000jobs.de' timeout: 30" "NetNameResolver addressForName: '1.7.6.4' timeout: 30" "NetNameResolver addressForName: '' timeout: 30 (This seems to return nil?)" | deadline result | "check if this is a valid numeric host address (e.g. 1.2.3.4)" result _ self addressFromString: hostName. result isNil ifFalse: [^result]. "Look up a host name, including ones that start with a digit (e.g. 100000jobs.de or squeak.org)" deadline _ Time millisecondClockValue + (secs * 1000). "Protect the execution of this block, as the ResolverSemaphore is used for both parts of the transaction." self resolverMutex critical: [ result _ (self waitForResolverReadyUntil: deadline) ifTrue: [ self primStartLookupOfName: hostName. (self waitForCompletionUntil: deadline) ifTrue: [self primNameLookupResult] ifFalse: [nil]] ifFalse: [nil]] ifError: [:msg :rcvr| rcvr error: msg]. ^result! ! !NetNameResolver class methodsFor: 'lookups' stamp: 'mir 6/18/2001 21:19'! nameForAddress: hostAddress timeout: secs "Look up the given host address and return its name. Return nil if the lookup fails or is not completed in the given number of seconds. Depends on the given host address being known to the gateway, which may not be the case for dynamically allocated addresses." "NetNameResolver nameForAddress: (NetNameResolver addressFromString: '128.111.92.40') timeout: 30" | deadline result | deadline _ Time millisecondClockValue + (secs * 1000). "Protect the execution of this block, as the ResolverSemaphore is used for both parts of the transaction." "Protect the execution of this block, as the ResolverSemaphore is used for both parts of the transaction." self resolverMutex critical: [ result _ (self waitForResolverReadyUntil: deadline) ifTrue: [ self primStartLookupOfAddress: hostAddress. (self waitForCompletionUntil: deadline) ifTrue: [self primAddressLookupResult] ifFalse: [nil]] ifFalse: [nil]] ifError: [:msg :rcvr| rcvr error: msg]. ^result ! ! !NetNameResolver class methodsFor: 'private' stamp: 'mir 6/18/2001 21:05'! resolverMutex ResolverMutex ifNil: [ResolverMutex _ Semaphore forMutualExclusion]. ^ResolverMutex! ! !ServerDirectory methodsFor: 'do ftp' stamp: 'mir 6/7/2001 16:40'! 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: [ FTPSocket retry: [serverIP _ NetNameResolver addressForName: server timeout: 20. serverIP ~~ nil] asking: 'Trouble resolving server name "' , server , '". Keep trying?' ifGiveUp: [^ '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]]. directory isEmpty ifFalse: [ so sendCommand: 'CWD ', directory. (rr _ so lookFor: '250 ') == true ifFalse: [^ rr]. "250 CWD successful" ]. "Need to ask for name of directory to make sure?" "socket _ so". "If user wants to keep connnection open, he must store socket" ^ so! !