[Pkg] The Trunk: Network-ar.73.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Jul 10 21:08:16 UTC 2010
Andreas Raab uploaded a new version of Network to project The Trunk:
http://source.squeak.org/trunk/Network-ar.73.mcz
==================== Summary ====================
Name: Network-ar.73
Author: ar
Time: 10 July 2010, 2:07:46.839 pm
UUID: ed3165f8-c237-4f4e-8958-8a6b86993249
Ancestors: Network-nice.72
Rewrite HTTPSocket to provide only a fairly minimal http implementation but allowing third party clients to register themselves as httpRequestHandler. This gets rid of the entire OldSocket hierarchy.
=============== Diff against Network-nice.72 ===============
Item was changed:
+ Object subclass: #HTTPSocket
+ instanceVariableNames: ''
+ classVariableNames: 'HTTPBlabEmail HTTPPort HTTPProxyCredentials HTTPProxyExceptions HTTPProxyPort HTTPProxyServer HTTPRequestHandler'
- OldSimpleClientSocket subclass: #HTTPSocket
- instanceVariableNames: 'headerTokens headers responseCode'
- classVariableNames: 'HTTPBlabEmail HTTPPort HTTPProxyCredentials HTTPProxyExceptions LogToTranscript ParamDelimiters'
poolDictionaries: ''
category: 'Network-Protocols'!
+ !HTTPSocket commentStamp: 'ar 7/10/2010 14:05' prior: 0!
+ HTTPSockets is a facade for handling common HTTP requests. It provides a minimal implementation of the HTTP protocol, but can be extended by third party clients that register themselves as #httpRequestHandler (see class-side protocol).
- !HTTPSocket commentStamp: '<historical>' prior: 0!
- HTTPSockets support HTTP requests, either directly or via an HTTP proxy server. An HTTPSocket saves the parse of the last ASCII header it saw, to avoid having to parse it repeatedly.
+ A third-party request handler needs to implement the single method
+
+ #httpRequest:url:headers:content:response:
+
+ in a way that is compatible with the baseline implementation in HTTPSocket.
+ !
- The real action is in httpGet:accept:. See the examples in the class, especially httpFileInNewChangeSet: and httpShowGif:.!
Item was changed:
----- Method: HTTPSocket class>>httpPostToSuperSwiki:args:accept:request: (in category 'get the page') -----
httpPostToSuperSwiki: url args: argsDict accept: mimeType request: requestString
+ | mimeBorder argString |
- | 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 := self httpProxyServer.
- port := self httpProxyPort].
-
mimeBorder := '---------SuperSwiki',Time millisecondClockValue printString,'-----'.
+ argString := String streamContents: [ :strm |
+ strm nextPutAll: mimeBorder, String crlf.
- 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: String crlf;
+ nextPutAll: String crlf;
- nextPutAll: CrLf;
- nextPutAll: CrLf;
nextPutAll: value;
+ nextPutAll: String crlf;
+ nextPutAll: String crlf;
- nextPutAll: CrLf;
- nextPutAll: CrLf;
nextPutAll: mimeBorder;
+ nextPutAll: String crlf.
- nextPutAll: CrLf.
]
].
].
+ ^self httpPost: url
+ content: argString
+ type: 'multipart/form-data; boundary=', mimeBorder
+ accept: mimeType
+ request: requestString
+ !
- "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"
- HTTPProxyCredentials,
- 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!
Item was added:
+ ----- Method: HTTPSocket class>>httpRequestHandler: (in category 'handler') -----
+ httpRequestHandler: anObject
+ "Set the registered handler for http requests. The handler needs to implement
+ #httpRequest:url:headers:content:response: compatible with the baseline version
+ in HTTPSocket."
+
+ HTTPRequestHandler := anObject!
Item was changed:
----- Method: HTTPSocket class>>initialize (in category 'class initialization') -----
initialize
"HTTPSocket initialize"
- ParamDelimiters := ' ', CrLf.
HTTPPort := 80.
self httpProxyServer: nil.
HTTPBlabEmail := ''. " 'From: somebody at no.where', CrLf "
HTTPProxyCredentials := ''.
+ ExternalSettings registerClient: self.
+ self removeHTTPProxyPreferences.!
- ExternalSettings registerClient: self!
Item was changed:
----- Method: HTTPSocket class>>httpProxyPort (in category 'proxy settings') -----
httpProxyPort
"answer the httpProxyPort"
+ <preference: 'HTTP Proxy Port'
+ category: 'HTTP Proxy'
+ description: 'HTTP Proxy Port'
+ type: #Number>
+ ^HTTPProxyPort ifNil:[80]!
- self checkHTTPProxyPreferences.
- ^Preferences valueOfPreference: #httpProxyPort.!
Item was changed:
----- Method: HTTPSocket class>>httpGet:args:user:passwd: (in category 'get the page') -----
httpGet: url args: args user: user passwd: passwd
+ "Upload the contents of the stream to a file on the server.
+ WARNING: This method will send a basic auth header proactively.
+ This is necessary to avoid breaking MC and SqueakSource since SS does not
+ return a 401 when accessing a private (global no access) repository."
+
| authorization result |
authorization := (user , ':' , passwd) base64Encoded.
result := self
httpGet: url args: args accept: '*/*'
+ request: 'Authorization: Basic ' , authorization , String crlf.
+ ^result
+ !
- request: 'Authorization: Basic ' , authorization , CrLf.
- result isString ifFalse: [^result].
-
- authorization := self digestFor: result method: 'GET' url: url user: user password: passwd.
- authorization ifNil: [^result].
- ^self
- httpGet: url args: args accept: '*/*'
- request: 'Authorization: Digest ' , authorization , CrLf!
Item was changed:
----- Method: HTTPSocket class>>httpPost:args:user:passwd: (in category 'get the page') -----
httpPost: url args: args user: user passwd: passwd
+ "WARNING: This method will send a basic auth header proactively.
+ This is necessary to avoid breaking MC and SqueakSource since SS does not
+ return a 401 when accessing a private (global no access) repository."
- | authorization result |
- authorization := (user , ':' , passwd) base64Encoded.
- result := self
- httpPostDocument: url args: args accept: '*/*'
- request: 'Authorization: Basic ' , authorization , CrLf.
- result isString ifFalse: [ ^result ].
+ | authorization |
+ authorization := (user , ':' , passwd) base64Encoded.
- authorization := self digestFor: result method: 'POST' url: url user: user password: passwd.
- authorization ifNil: [ ^result ].
^self
httpPostDocument: url args: args accept: '*/*'
+ request: 'Authorization: Basic ' , authorization , String crlf
- request: 'Authorization: Digest ' , authorization , CrLf.
!
Item was changed:
----- Method: HTTPSocket class>>httpPostMultipart:args:accept:request: (in category 'get the page') -----
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"
+ | mimeBorder argsStream |
- | serverName serverAddr s header length bare page list firstData aStream port argsStream specifiedServer type newUrl mimeBorder |
- 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].
-
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 | | fieldValue |
"print the boundary"
+ argsStream nextPutAll: '--', mimeBorder, String crlf.
- 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, '"', String crlf, 'Content-Type: ', value contentType.
- 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: String crlf, String crlf, fieldValue, String crlf.
- argsStream nextPutAll: CrLf, CrLf, fieldValue, CrLf.
]].
argsStream nextPutAll: '--', mimeBorder, '--'.
+ ^self httpPost: url
+ content: argsStream contents
+ type: 'multipart/form-data; boundary=', mimeBorder
+ accept: mimeType
+ request: requestString
+ !
- "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"
- HTTPProxyCredentials,
- 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!
Item was added:
+ ----- Method: HTTPSocket class>>removeHTTPProxyPreferences (in category 'proxy settings') -----
+ removeHTTPProxyPreferences
+ " This method will remove the old HTTP Proxy preferences. "
+ (Preferences valueOfPreference: #httpProxyServer) ifNotNil:[
+ HTTPProxyServer := Preferences valueOfPreference: #httpProxyServer.
+ Preferences removePreference: #httpProxyServer.
+ ].
+ (Preferences valueOfPreference: #httpProxyPort) ifNotNil:[
+ HTTPProxyPort := Preferences valueOfPreference: #httpProxyPort.
+ Preferences removePreference: #httpProxyPort.
+ ].
+ !
Item was changed:
----- Method: HTTPSocket class>>httpPostDocument:args:accept:request: (in category 'get the page') -----
+ httpPostDocument: url args: args accept: mimeType request: requestString
- httpPostDocument: url args: argsDict accept: mimeType request: requestString
"like httpGET, except it does a POST instead of a GET. POST allows data to be uploaded"
+ | argString |
+ args ifNotNil: [
+ argString := self argString: args.
+ argString first = $? ifTrue: [argString := argString allButFirst].
+ ].
- | s header length page list firstData aStream type newUrl httpUrl argString |
- Socket initializeNetwork.
- httpUrl := Url absoluteFromText: url.
- page := httpUrl fullPath.
- "add arguments"
- argString := argsDict
- ifNotNil: [
- argString := self argString: argsDict.
- argString first = $? ifTrue: [ argString := argString copyFrom: 2 to: argString size]]
- ifNil: [''].
+ ^self httpPost: url
+ content: argString
+ type: 'application/x-www-form-urlencoded'
+ accept: mimeType
+ request: requestString!
- s := HTTPSocket new.
- s := self initHTTPSocket: httpUrl wait: (self deadlineSecs: 30) ifError: [:errorString | ^errorString].
- s sendCommand: 'POST ', page, ' HTTP/1.0', CrLf,
- (mimeType ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']),
- 'ACCEPT: text/html', CrLf, "Always accept plain text"
- HTTPProxyCredentials,
- HTTPBlabEmail, "may be empty"
- requestString, "extra user request. Authorization"
- self userAgentString, CrLf,
- 'Content-type: application/x-www-form-urlencoded', CrLf,
- 'Content-length: ', argString size printString, CrLf,
- 'Host: ', httpUrl authority, CrLf. "blank line automatically added"
-
- "umur - IE sends argString without a $? and swiki expects so"
- s sendCommand: argString.
-
- "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 ].
- type := s getHeader: 'content-type'.
- s responseCode first = $3 ifTrue: [
- newUrl := s getHeader: 'location'.
- newUrl ifNotNil: [
- "umur 6/25/2003 12:58 - If newUrl is relative then we need to make it absolute."
- newUrl := (httpUrl newFromRelativeText: newUrl) asString.
- self flag: #refactor. "get, post, postmultipart are almost doing the same stuff"
- s destroy.
- "^self httpPostDocument: newUrl args: argsDict accept: mimeType"
- ^self httpGetDocument: newUrl accept: mimeType ] ].
-
- 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!
Item was added:
+ ----- Method: HTTPSocket class>>httpRequest:url:headers:content:response: (in category 'get the page') -----
+ httpRequest: method url: urlString headers: hdrs content: contentOrNil response: responseBlock
+
+ "Sends an HTTP request to the server. Returns a MIMEDocument if successful,
+ a string indicating the error otherwise. If a response block is provided, the
+ response is fed into into so that the sender can see all the headers."
+
+ | index serverAndPort server port rawUrl stream resp code headers
+ contentLength contentType contentStream |
+
+ (urlString beginsWith: 'http://') ifFalse:[self error: 'Not a http url'].
+
+ "Extract server, port, and url"
+ index := urlString indexOf: $/ startingAt: 8 ifAbsent:[urlString size+1]. "past http://"
+ serverAndPort := urlString copyFrom: 8 to: index-1.
+ server := serverAndPort copyUpTo: $:.
+ port := ((serverAndPort copyAfter: $:) ifEmpty:['80']) asNumber.
+
+ "Prepare the request URI"
+ rawUrl := urlString copyFrom: index to: urlString size.
+ (rawUrl beginsWith: '/') ifFalse:[rawUrl := '/', rawUrl].
+ rawUrl := rawUrl encodeForHTTPWithTextEncoding: 'utf-8'
+ conditionBlock: [:c | c isSafeForHTTP or:['/;&=\?' includes: c]].
+
+ "Check for proxy"
+ (self shouldUseProxy: server) ifTrue:[
+ self httpProxyServer ifNotEmpty:[
+ rawUrl := 'http://', serverAndPort, rawUrl. "per RFC 2616"
+ server := self httpProxyServer.
+ port := self httpProxyPort.
+ ].
+ ].
+
+ "Fire off the request"
+ stream := SocketStream openConnectionToHostNamed: server port: port.
+ stream nextPutAll: method; space; nextPutAll: rawUrl; space; nextPutAll: 'HTTP/1.0'; crlf.
+ stream nextPutAll: 'Host: ', serverAndPort; crlf.
+ stream nextPutAll: 'Connection: close'; crlf.
+ stream nextPutAll: 'User-Agent: ', self userAgentString; crlf.
+ stream nextPutAll: hdrs.
+ stream crlf.
+
+ contentOrNil ifNotNil:[
+ "Upload request content"
+ contentStream := contentOrNil readStream.
+ [contentStream atEnd] whileFalse:[
+ (HTTPProgress new) total: contentOrNil size;
+ amount: contentStream position; signal: 'Uploading...'.
+ stream nextPutAll: (contentStream next: 4096).
+ stream flush.
+ ].
+ ].
+
+ stream flush.
+
+ "Read the response"
+ resp := stream upToAll: String crlfcrlf.
+ "Extract the response code"
+ code := ((resp copyUpTo: String cr) findTokens: ' ') second asNumber.
+ "And the response headers"
+ headers := Dictionary new.
+ resp lines allButFirst allButLast do:[:nextLine|
+ headers at: (nextLine copyUpTo: $:) asLowercase
+ put: (nextLine copyAfter: $:) withBlanksTrimmed.
+ ].
+
+ "Read response content"
+ contentLength := headers at: 'content-length' ifAbsent:[nil].
+ contentType := headers at: 'content-type' ifAbsent:['application/octet-stream'].
+ "Fixme - Provide HTTProgress"
+ contentLength
+ ifNil:[contentStream := WriteStream with: stream upToEnd]
+ ifNotNil:[
+ contentLength := contentLength asNumber.
+ contentStream := (String new: contentLength) writeStream.
+ [contentStream position < contentLength] whileTrue:[
+ contentStream nextPutAll:
+ (stream next: (contentLength - contentStream position min: 4096)).
+ (HTTPProgress new) total: contentLength;
+ amount: contentStream position; signal: 'Downloading...'.
+ ].
+ ].
+ stream close.
+
+ responseBlock ifNotNil:[responseBlock value: resp].
+
+ ^(code between: 200 and: 299)
+ ifTrue:[MIMEDocument contentType: contentType
+ content: contentStream contents url: urlString]
+ ifFalse:[resp asString, contentStream contents].
+ !
Item was changed:
----- Method: HTTPSocket class>>httpProxyServer (in category 'proxy settings') -----
httpProxyServer
"answer the httpProxyServer. Take into account that as a Preference the Server might appear as an empty string but HTTPSocket expect it to be nil"
+ <preference: 'HTTP Proxy Server'
+ category: 'HTTP Proxy'
+ description: 'HTTP Proxy Server. Leave blank if you don''t want to use a Proxy'
+ type: #String>
+ ^HTTPProxyServer ifNil:['']
- self checkHTTPProxyPreferences.
- ^Preferences valueOfPreference: #httpProxyServer.
!
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
+
+ WARNING: This method will send a basic auth header proactively.
+ This is necessary to avoid breaking MC and SqueakSource since SS does not
+ return a 401 when accessing a private (global no access) repository."
- "Upload the contents of the stream to a file on the server"
+ | urlString resp header |
- | 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: $:.
- ].
+ "Normalize the url"
+ urlString := (Url absoluteFromText: url) asString.
- 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].
+ resp := (self httpRequestHandler)
+ httpRequest: 'PUT' url: urlString headers:(
+ 'Authorization: Basic ', (user, ':', passwd) base64Encoded, String crlf,
+ 'Accept: */*', String crlf,
+ 'Content-Type: application/octet-stream', String crlf,
+ 'Content-Length: ', (contents ifNil:['']) size, String crlf,
+ HTTPProxyCredentials,
+ HTTPBlabEmail
+ ) content: contents response:[:rr| header := rr].
+ ^resp isString ifTrue:[header, resp] ifFalse:[header, resp content]!
- "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.
- "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].
- s destroy. "Always OK to destroy!!"
- ^ header, aStream contents!
Item was added:
+ ----- Method: HTTPSocket class>>httpPost:content:type:accept:request: (in category 'get the page') -----
+ httpPost: url content: postData type: contentType accept: mimeType request: requestString
+ "like httpGET, except it does a POST instead of a GET. POST allows data to be uploaded"
+
+ | urlString |
+ "Normalize the url"
+ urlString := (Url absoluteFromText: url) asString.
+
+ ^(self httpRequestHandler)
+ httpRequest: 'POST' url: urlString headers:(
+ 'Accept: ', mimeType, String crlf,
+ 'Accept: text/html', String crlf,
+ 'Content-Type: ', contentType, String crlf,
+ 'Content-Length: ', (postData ifNil:['']) size, String crlf,
+ HTTPProxyCredentials,
+ HTTPBlabEmail,
+ requestString "extra user request. Authorization"
+ ) content: (postData ifNil:['']) response: nil!
Item was changed:
----- Method: HTTPSocket class>>httpProxyPort: (in category 'proxy settings') -----
httpProxyPort: aPortNumber
+ "Set the proxy port"
+ HTTPProxyPort := aPortNumber.!
- self checkHTTPProxyPreferences.
- Preferences setPreference: #httpProxyPort toValue: aPortNumber.!
Item was added:
+ ----- Method: HTTPSocket class>>httpRequestHandler (in category 'handler') -----
+ httpRequestHandler
+ "Answer the registered handler for http requests. The handler needs to implement
+ #httpRequest:url:headers:content:response: compatible with the baseline version
+ in HTTPSocket. If no handler is registered, answer the receiver"
+
+ ^HTTPRequestHandler ifNil:[self]!
Item was changed:
----- Method: HTTPSocket class>>httpProxyServer: (in category 'proxy settings') -----
+ httpProxyServer: aString
+ "answer the httpProxyServer. Take into account that as a Preference the Server might appear as an empty string but HTTPSocket expect it to be nil"
+ HTTPProxyServer := aString.
+ !
- httpProxyServer: aStringOrNil
- | serverName |
- self checkHTTPProxyPreferences.
- serverName := aStringOrNil
- ifNil: ['']
- ifNotNil: [aStringOrNil withBlanksTrimmed ].
- Preferences setPreference: #httpProxyServer toValue: serverName!
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"
- "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'."
+ "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) ].
+ | urlString |
+ "Normalize the url"
+ urlString := (Url absoluteFromText: url) asString.
+ args ifNotNil: [
+ urlString := urlString, (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].
-
- 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"
- HTTPProxyCredentials,
- 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 ].
].
+ ^(self httpRequestHandler)
+ httpRequest: 'GET' url: urlString headers:(
+ (mimeType ifNil:[''] ifNotNil:['Accept: ', mimeType, String crlf]),
+ 'Accept: text/html', String crlf,
+ HTTPBlabEmail,
+ requestString
+ ) content: nil response: nil.!
- {'HTTPSocket class>>httpGetDocument:args:accept:request:'. aStream. url} inspect.
-
- ^'some other bad thing happened!!'!
Item was changed:
+ ----- Method: HTTPSocket class>>defaultPort (in category 'class initialization') -----
- ----- Method: HTTPSocket class>>defaultPort (in category 'magic numbers') -----
defaultPort
"default port to connect on"
^80!
Item was removed:
- ----- Method: OldSocket>>readSemaphore (in category 'accessing') -----
- readSemaphore
- primitiveOnlySupportsOneSemaphore ifTrue: [^semaphore].
- ^readSemaphore!
Item was removed:
- ----- Method: OldSocket>>isUnconnected (in category 'queries') -----
- isUnconnected
- "Return true if this socket's state is Unconnected."
-
- socketHandle == nil ifTrue: [^ false].
- ^ (self primSocketConnectionStatus: socketHandle) == Unconnected
- !
Item was removed:
- ----- Method: HTTPSocket>>getHeader: (in category 'as yet unclassified') -----
- getHeader: name
- ^self getHeader: name default: nil!
Item was removed:
- ----- Method: OldSimpleClientSocket>>getResponse (in category 'as yet unclassified') -----
- getResponse
- "Get a one-line response from the server. The final LF is removed from the line, but the CR is left, so that the line is in Squeak's text format"
-
- ^ self getResponseShowing: false
- !
Item was removed:
- ----- Method: OldSocket>>primSocketCloseConnection: (in category 'primitives') -----
- primSocketCloseConnection: socketID
- "Close the connection on the given port. The remote end is informed that this end has closed and will do no further sends. This is an asynchronous call; query the socket status to discover if and when the connection is actually closed."
-
- <primitive: 'primitiveSocketCloseConnection' module: 'SocketPlugin'>
- self primitiveFailed
- !
Item was removed:
- ----- Method: OldSimpleClientSocket class>>timeTest (in category 'other examples') -----
- timeTest
- "SimpleClientSocket timeTest"
-
- | addr s |
- addr := NetNameResolver promptUserForHostAddress.
- s := OldSimpleClientSocket new.
- Transcript show: '---------- Connecting ----------'; cr.
- s connectTo: addr port: 13. "time port number"
- s waitForConnectionUntil: self standardDeadline.
- Transcript show: s getResponse.
- s closeAndDestroy.
- Transcript show: '---------- Connection Closed ----------'; cr; endEntry.
- !
Item was removed:
- ----- Method: OldSocket>>primSocket:listenOn:backlogSize: (in category 'primitives') -----
- primSocket: aHandle listenOn: portNumber backlogSize: backlog
- "Primitive. Set up the socket to listen on the given port.
- Will be used in conjunction with #accept only."
- <primitive: 'primitiveSocketListenWithOrWithoutBacklog' module: 'SocketPlugin'>
- self destroy. "Accept not supported so clean up"!
Item was removed:
- ----- Method: OldSocket>>primAcceptFrom:receiveBufferSize:sendBufSize:semaIndex:readSemaIndex:writeSemaIndex: (in category 'primitives') -----
- primAcceptFrom: aHandle receiveBufferSize: rcvBufSize sendBufSize: sndBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema
- "Create and return a new socket handle based on accepting the connection from the given listening socket"
- <primitive: 'primitiveSocketAccept3Semaphores' module: 'SocketPlugin'>
- primitiveOnlySupportsOneSemaphore := true.
- ^self primAcceptFrom: aHandle receiveBufferSize: rcvBufSize sendBufSize: sndBufSize semaIndex: semaIndex !
Item was removed:
- ----- Method: OldSocket>>primSocket:connectTo:port: (in category 'primitives') -----
- primSocket: socketID connectTo: hostAddress port: port
- "Attempt to establish a connection to the given port of the given host. This is an asynchronous call; query the socket status to discover if and when the connection is actually completed."
-
- <primitive: 'primitiveSocketConnectToPort' module: 'SocketPlugin'>
- self primitiveFailed
- !
Item was removed:
- ----- Method: HTTPSocket class>>proxyTestingComment (in category 'proxy settings') -----
- proxyTestingComment
- "Test Kevin's SmartCache on this machine"
- " HTTPSocket useProxyServerNamed: '127.0.0.1' port: 8080.
- HTTPSocket httpShowPage: 'http://www.disneyblast.com/default.html'.
- HTTPSocket stopUsingProxyServer. "
-
- "Test getting to outside world from DOL"
- " HTTPSocket useProxyServerNamed: 'web-proxy.online.disney.com' port: 8080.
- HTTPSocket httpShowPage: 'http://www.apple.com/default.html'.
- HTTPSocket stopUsingProxyServer. "
-
- "Test Windows Machine in our cubicle at DOL"
- " HTTPSocket useProxyServerNamed: '206.18.67.150' port: 8080.
- HTTPSocket httpShowPage: 'http://kids.online.disney.com/~kevin/squeak/k:=t.morph'.
- HTTPSocket stopUsingProxyServer. "
-
- " HTTPSocket httpShowPage: 'kids.online.disney.com/' "
- " HTTPSocket httpShowGif: 'kids.online.disney.com/~kevin/images/dlogo.gif' "
- !
Item was removed:
- ----- Method: OldSocket class>>remoteTestClientTCP (in category 'examples') -----
- remoteTestClientTCP
- "FIRST start up another image, and execute: Socket remoteTestServerTCP.
- THEN come back to this image and execute:"
-
- "Socket remoteTestClientTCP"
-
- "Performa 6400/200, Linux-PPC 2.1.24, both images on same CPU:
- remoteClient TCP test done; time = 5680
- 250 packets, 1000000 bytes sent (176 kBytes/sec)
- 60 packets, 1000000 bytes received (176 kBytes/sec)"
-
- | socket bytesToSend sendBuf receiveBuf done bytesSent bytesReceived packetsSent packetsReceived t serverName |
- Transcript
- show: 'starting client/server TCP test';
- cr.
- Transcript show: 'initializing network ... '.
- self initializeNetworkIfFail: [^Transcript show: 'failed'].
- Transcript
- show: 'ok';
- cr.
- socket := self newTCP.
- serverName := UIManager default request: 'What is your remote Test Server?'
- initialAnswer: ''.
- socket connectTo: (NetNameResolver addressFromString: serverName)
- port: 54321.
- socket waitForConnectionUntil: self standardDeadline.
- Transcript
- show: 'client endpoint created';
- cr.
- bytesToSend := 1000000.
- sendBuf := String new: 4000 withAll: $x.
- receiveBuf := String new: 50000.
- done := false.
- bytesSent := bytesReceived := packetsSent := packetsReceived := 0.
- t := Time millisecondsToRun:
- [[done] whileFalse:
- [(socket sendDone and: [bytesSent < bytesToSend])
- ifTrue:
- [packetsSent := packetsSent + 1.
- bytesSent := bytesSent + (socket sendData: sendBuf)].
- socket dataAvailable
- ifTrue:
- [packetsReceived := packetsReceived + 1.
- bytesReceived := bytesReceived + (socket receiveDataInto: receiveBuf)].
- done := bytesSent >= bytesToSend].
- [bytesReceived < bytesToSend] whileTrue:
- [socket dataAvailable
- ifTrue:
- [packetsReceived := packetsReceived + 1.
- bytesReceived := bytesReceived + (socket receiveDataInto: receiveBuf)]]].
- socket closeAndDestroy.
- Transcript
- show: 'remoteClient TCP test done; time = ' , t printString;
- cr.
- Transcript
- show: packetsSent printString , ' packets, ' , bytesSent printString
- , ' bytes sent (' , (bytesSent * 1000 // t) printString
- , ' bytes/sec)';
- cr.
- Transcript
- show: packetsReceived printString , ' packets, '
- , bytesReceived printString , ' bytes received ('
- , (bytesReceived * 1000 // t) printString , ' bytes/sec)';
- cr!
Item was removed:
- ----- Method: OldSocket>>isOtherEndClosed (in category 'queries') -----
- isOtherEndClosed
- "Return true if this socket had the other end closed."
-
- socketHandle == nil ifTrue: [^ false].
- ^ (self primSocketConnectionStatus: socketHandle) == OtherEndClosed
- !
Item was removed:
- ----- Method: OldSocket class>>timeTestUDP3 (in category 'examples') -----
- timeTestUDP3
- "Socket timeTestUDP3"
-
- | serverName serverAddr s |
- Transcript show: 'initializing network ... '.
- self initializeNetworkIfFail: [^Transcript show: 'failed'].
- Transcript
- show: 'ok';
- cr.
- serverName := UIManager default request: 'What is your time server?'
- initialAnswer: 'localhost'.
- serverName isEmpty
- ifTrue:
- [^Transcript
- show: 'never mind';
- cr].
- serverAddr := NetNameResolver addressForName: serverName timeout: 10.
- serverAddr = nil
- ifTrue: [self error: 'Could not find the address for ' , serverName].
- s := self newUDP.
- "The following associates a port with the UDP socket, but does NOT create a connectable endpoint"
- s setPort: self wildcardPort. "explicitly request a default port number"
- "Send a packet to the daytime port and it will reply with the current date."
- Transcript
- show: '---------- Sending datagram from port ' , s port printString
- , ' ----------';
- cr.
- s
- sendData: '!!'
- toHost: serverAddr
- port: 13.
- Transcript show: 'the time server reports: ' , s getResponseNoLF.
- s closeAndDestroy.
- Transcript
- show: '---------- Socket closed ----------';
- cr!
Item was removed:
- ----- Method: OldSimpleClientSocket>>getMultilineResponse (in category 'as yet unclassified') -----
- getMultilineResponse
- "Get a multiple line response to the last command, filtering out LF characters. A multiple line response ends with a line containing only a single period (.) character."
-
- ^ self getMultilineResponseShowing: false.
- !
Item was removed:
- ----- Method: OldSimpleClientSocket class>>finger: (in category 'other examples') -----
- finger: userName
- "OldSimpleClientSocket finger: 'stp'"
-
- | addr s |
- addr := NetNameResolver promptUserForHostAddress.
- s := OldSimpleClientSocket new.
- Transcript show: '---------- Connecting ----------'; cr.
- s connectTo: addr port: 79. "finger port number"
- s waitForConnectionUntil: self standardDeadline.
- s sendCommand: userName.
- Transcript show: s getResponse.
- s closeAndDestroy.
- Transcript show: '---------- Connection Closed ----------'; cr; endEntry.
- !
Item was removed:
- ----- Method: OldSocket>>primSocketCreateNetwork:type:receiveBufferSize:sendBufSize:semaIndex: (in category 'primitives') -----
- primSocketCreateNetwork: netType type: socketType receiveBufferSize: rcvBufSize sendBufSize: sendBufSize semaIndex: semaIndex
- "Return a new socket handle for a socket of the given type and buffer sizes. Return nil if socket creation fails.
- The netType parameter is platform dependent and can be used to encode both the protocol type (IP, Xerox XNS, etc.) and/or the physical network interface to use if this host is connected to multiple networks. A zero netType means to use IP protocols and the primary (or only) network interface.
- The socketType parameter specifies:
- 0 reliable stream socket (TCP if the protocol is IP)
- 1 unreliable datagram socket (UDP if the protocol is IP)
- The buffer size parameters allow performance to be tuned to the application. For example, a larger receive buffer should be used when the application expects to be receiving large amounts of data, especially from a host that is far away. These values are considered requests only; the underlying implementation will ensure that the buffer sizes actually used are within allowable bounds. Note that memory may be limited, so an application that keeps many sockets open should use smaller buffer sizes. Note the macintosh implementation ignores this buffer size. Also see setOption to get/set socket buffer sizes which allows you to set/get the current buffer sizes for reading and writing.
- If semaIndex is > 0, it is taken to be the index of a Semaphore in the external objects array to be associated with this socket. This semaphore will be signalled when the socket status changes, such as when data arrives or a send completes. All processes waiting on the semaphore will be awoken for each such event; each process must then query the socket state to figure out if the conditions they are waiting for have been met. For example, a process waiting to send some data can see if the last send has completed."
-
- <primitive: 'primitiveSocketCreate' module: 'SocketPlugin'>
- ^ nil "socket creation failed"
- !
Item was removed:
- OldSocket subclass: #OldSimpleClientSocket
- instanceVariableNames: 'buffer bufferPos'
- classVariableNames: 'CR CrLf LF'
- poolDictionaries: ''
- category: 'Network-Kernel'!
-
- !OldSimpleClientSocket commentStamp: '<historical>' prior: 0!
- This class supports client for simple network protocols based on sending textual commands and responses. Examples of such protocols include POP3 (mail retrieval), SMTP (mail posting), HTTP (web browsing), and NTTP (network news). Some simple examples are presented as class methods, but a full-service client of some service should be implemented as a subclass.
-
- The basic services provided by this class are:
- sendCommand: -- sends a command line terminate with <CR><LF>
- getResponse -- gets a single-line response to a command
- getMultilineResponse -- gets a multiple line response terminated by a period
- -- on a line by itself
-
- There are variants of the getResponse commands that display lines on the screen as they are being received. Linefeeds are stripped out of all responses.
-
- The 'get' commands above make use of an internal buffer. So intermixing these two commands and regular Socket recieve commands can cause problems.!
Item was removed:
- ----- Method: OldSocket class>>pingPorts:on:timeOutSecs: (in category 'utilities') -----
- pingPorts: portList on: hostName timeOutSecs: timeOutSecs
- "Attempt to connect to each of the given sockets on the given host. Wait at most timeOutSecs for the connections to be established. Answer an array of strings indicating the available ports."
-
- "Socket pingPorts: #(7 13 19 21 23 25 80 110 119) on: 'squeak.cs.uiuc.edu' timeOutSecs: 15"
-
- | serverAddr sockets deadline done result unconnectedCount connectedCount waitingCount |
- self initializeNetwork.
- serverAddr := NetNameResolver addressForName: hostName timeout: 10.
- serverAddr = nil
- ifTrue:
- [self inform: 'Could not find an address for ' , hostName.
- ^#()].
- sockets := portList collect:
- [:portNum | | sock |
- sock := self new.
- sock connectTo: serverAddr port: portNum].
- deadline := self deadlineSecs: timeOutSecs.
- done := false.
- [done] whileFalse:
- [unconnectedCount := 0.
- connectedCount := 0.
- waitingCount := 0.
- sockets do:
- [:s |
- s isUnconnectedOrInvalid
- ifTrue: [unconnectedCount := unconnectedCount + 1]
- ifFalse:
- [s isConnected ifTrue: [connectedCount := connectedCount + 1].
- s isWaitingForConnection ifTrue: [waitingCount := waitingCount + 1]]].
- waitingCount = 0 ifTrue: [done := true].
- connectedCount = sockets size ifTrue: [done := true].
- Time millisecondClockValue > deadline ifTrue: [done := true]].
- result := (sockets select: [:s | s isConnected])
- collect: [:s | self nameForWellKnownTCPPort: s remotePort].
- sockets do: [:s | s destroy].
- ^result!
Item was removed:
- ----- Method: OldSocket>>sendData: (in category 'sending-receiving') -----
- sendData: 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: [
- (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
- !
Item was removed:
- ----- Method: OldSocket>>isConnected (in category 'queries') -----
- isConnected
- "Return true if this socket is connected."
-
- socketHandle == nil ifTrue: [^ false].
- ^ (self primSocketConnectionStatus: socketHandle) == Connected
- !
Item was removed:
- ----- Method: OldSocket>>remotePort (in category 'accessing') -----
- remotePort
-
- ^ self primSocketRemotePort: socketHandle
- !
Item was removed:
- ----- Method: OldSocket>>getResponseNoLF (in category 'other') -----
- getResponseNoLF
- "Get the response to the last command."
-
- | buf response bytesRead c lf |
- (self waitForDataUntil: (self class deadlineSecs: 20))
- ifFalse: [self error: 'getResponse timeout'].
- lf := Character lf.
- buf := String new: 1000.
- response := WriteStream on: ''.
- [self dataAvailable] whileTrue:
- [bytesRead := self
- primSocket: socketHandle
- receiveDataInto: buf
- startingAt: 1
- count: buf size.
- 1 to: bytesRead
- do: [:i | (c := buf at: i) ~= lf ifTrue: [response nextPut: c]]].
- ^response contents!
Item was removed:
- ----- Method: OldSocket class>>deadlineSecs: (in category 'utilities') -----
- deadlineSecs: secs
- "Return a deadline time the given number of seconds from now."
-
- ^ Time millisecondClockValue + (secs * 1000)
- !
Item was removed:
- ----- Method: OldSocket>>primSocket:receiveDataInto:startingAt:count: (in category 'primitives') -----
- primSocket: socketID receiveDataInto: aStringOrByteArray startingAt: startIndex count: count
- "Receive data from the given socket into the given array starting at the given index. Return the number of bytes read or zero if no data is available."
-
- <primitive: 'primitiveSocketReceiveDataBufCount' module: 'SocketPlugin'>
- self primitiveFailed
- !
Item was removed:
- ----- Method: OldSocket class>>remoteTestClientTCPOpenClose1000 (in category 'examples') -----
- remoteTestClientTCPOpenClose1000
- "Socket remoteTestClientTCPOpenClose1000"
-
- | number t1 serverName |
- Transcript
- show: 'starting client/server TCP test';
- cr.
- Transcript show: 'initializing network ... '.
- self initializeNetworkIfFail: [^Transcript show: 'failed'].
- Transcript
- show: 'ok';
- cr.
- number := 1000.
- serverName := UIManager default request: 'What is your remote Test Server?'
- initialAnswer: ''.
- t1 := Time millisecondsToRun:
- [number timesRepeat:
- [ | socket |
- socket := self newTCP.
- socket connectTo: (NetNameResolver addressFromString: serverName)
- port: 54321.
- socket waitForConnectionUntil: self standardDeadline.
- socket closeAndDestroy]].
- Transcript
- cr;
- show: 'connects/close per second ' , (number / t1 * 1000.0) printString;
- cr!
Item was removed:
- ----- Method: OldSocket class>>wildcardPort (in category 'utilities') -----
- wildcardPort
- "Answer a don't-care port for use with UDP sockets. (The system will allocate an
- unused port number to the socket.)"
-
- ^0!
Item was removed:
- ----- Method: OldSocket class>>remoteTestServerUDP2 (in category 'examples') -----
- remoteTestServerUDP2
- "See remoteTestClientUDP for instructions on running this method."
-
- "Socket remoteTestServerUDP2"
-
- | socket buffer datagramInfo |
- Transcript show: 'initializing network ... '.
- self initializeNetworkIfFail: [^Transcript show: 'failed'].
- Transcript
- show: 'ok';
- cr.
- socket := self newUDP.
- socket setPort: 54321.
- Transcript
- show: 'server endpoint created -- run client test in other image';
- cr.
- buffer := String new: 65000.
- [true] whileTrue:
- [socket dataAvailable
- ifTrue:
- [datagramInfo := socket receiveUDPDataInto: buffer.
- Transcript
- show: datagramInfo printString;
- cr.
- socket sendData: buffer count: (datagramInfo at: 1)]]!
Item was removed:
- ----- Method: OldSocket>>destroy (in category 'initialize-destroy') -----
- destroy
- "Destroy this socket. Its connection, if any, is aborted and its resources are freed. Do nothing if the socket has already been destroyed (i.e., if its socketHandle is nil)."
-
- socketHandle = nil ifFalse:
- [self isValid ifTrue: [self primSocketDestroy: socketHandle].
- Smalltalk unregisterExternalObject: semaphore.
- Smalltalk unregisterExternalObject: readSemaphore.
- Smalltalk unregisterExternalObject: writeSemaphore.
- socketHandle := nil.
- readSemaphore := writeSemaphore := semaphore := nil.
- self unregister].
- !
Item was removed:
- ----- Method: OldSocket>>discardReceivedData (in category 'sending-receiving') -----
- discardReceivedData
- "Discard any data received up until now, and return the number of bytes discarded."
-
- | buf totalBytesDiscarded |
- buf := String new: 10000.
- totalBytesDiscarded := 0.
- [self isConnected and: [self dataAvailable]] whileTrue: [
- totalBytesDiscarded :=
- totalBytesDiscarded + (self receiveDataInto: buf)].
- ^ totalBytesDiscarded
- !
Item was removed:
- ----- Method: HTTPSocket class>>digestFor:method:url:user:password: (in category 'digest') -----
- digestFor: serverText method: method url: url user: user password: password
- "RFC2069"
- | sock |
- sock := HTTPSocket new. "header decoder is on instance side"
- sock header: (serverText readStream upToAll: String crlf, String crlf).
- ^self digestFrom: sock method: method url: url user: user password: password!
Item was removed:
- ----- Method: OldSocket class>>remoteTestServerUDP (in category 'examples') -----
- remoteTestServerUDP
- "See remoteTestClientUDP for instructions on running this method."
-
- "Socket remoteTestServerUDP"
-
- | socket buffer n |
- Transcript show: 'initializing network ... '.
- self initializeNetworkIfFail: [^Transcript show: 'failed'].
- Transcript
- show: 'ok';
- cr.
- socket := self newUDP.
- socket setPort: 54321.
- Transcript
- show: 'server endpoint created -- run client test in other image';
- cr.
- buffer := String new: 4000.
- [true] whileTrue:
- [socket dataAvailable
- ifTrue:
- [n := socket receiveDataInto: buffer.
- socket sendData: buffer count: n]]!
Item was removed:
- ----- Method: HTTPSocket>>contentsLength: (in category 'as yet unclassified') -----
- contentsLength: header
- "extract the data length from the header. Content-length: 1234<cr><lf>, User may look in headerTokens afterwards."
-
- | this |
- headerTokens := header findTokens: ParamDelimiters keep: String cr.
- 1 to: headerTokens size do: [:ii |
- this := headerTokens at: ii.
- (this first asLowercase = $c and: [this asLowercase = 'content-length:']) ifTrue: [
- ^ (headerTokens at: ii+1) asNumber]].
- ^ nil "not found"!
Item was removed:
- ----- Method: OldSocket>>waitForSendDoneUntil: (in category 'waiting') -----
- waitForSendDoneUntil: deadline
- "Wait up until the given deadline for the current send operation to complete. Return true if it completes by the deadline, false if not."
-
- | sendDone |
- [self isConnected & (sendDone := self primSocketSendDone: socketHandle) not
- "Connection end and final data can happen fast, so test in this order"
- and: [Time millisecondClockValue < deadline]] whileTrue: [
- self writeSemaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue)].
-
- ^ sendDone!
Item was removed:
- ----- Method: OldSocket class>>pingPortsOn: (in category 'utilities') -----
- pingPortsOn: hostName
- "Attempt to connect to a set of well-known sockets on the given host, and answer the names of the available ports."
-
- "Socket pingPortsOn: 'www.disney.com'"
-
- ^self
- pingPorts: #(7 13 19 21 23 25 80 110 119)
- on: hostName
- timeOutSecs: 20!
Item was removed:
- ----- Method: OldSimpleClientSocket class>>initialize (in category 'class initialization') -----
- initialize
- "SimpleClientSocket initialize"
-
- CR := Character cr.
- LF := Character linefeed.
-
- "string for command line termination:"
- CrLf := String with: CR with: LF.
- !
Item was removed:
- ----- Method: OldSocket>>closeAndDestroy: (in category 'connection open/close') -----
- closeAndDestroy: timeoutSeconds
- "First, try to close this connection gracefully. If the close attempt fails or times out, abort the connection. In either case, destroy the socket. Do nothing if the socket has already been destroyed (i.e., if its socketHandle is nil)."
-
- socketHandle = nil
- ifFalse:
- [self isConnected
- ifTrue:
- [self close. "close this end"
- (self waitForDisconnectionUntil: (self class deadlineSecs: timeoutSeconds))
- ifFalse:
- ["if the other end doesn't close soon, just abort the connection"
-
- self primSocketAbortConnection: socketHandle]].
- self destroy]!
Item was removed:
- ----- Method: OldSocket>>close (in category 'connection open/close') -----
- close
- "Close this connection gracefully. For TCP, this sends a close request, but the stream remains open until the other side also closes it."
-
- self primSocketCloseConnection: socketHandle. "close this end"
- !
Item was removed:
- Object subclass: #OldSocket
- instanceVariableNames: 'semaphore socketHandle readSemaphore writeSemaphore primitiveOnlySupportsOneSemaphore'
- classVariableNames: 'Connected DeadServer InvalidSocket OtherEndClosed Registry RegistryThreshold TCPSocketType ThisEndClosed UDPSocketType Unconnected WaitingForConnection'
- poolDictionaries: ''
- category: 'Network-Kernel'!
-
- !OldSocket commentStamp: '<historical>' prior: 0!
- A Socket represents a network connection point. Current sockets are designed to support the TCP/IP and UDP protocols
-
- Subclasses of socket provide support for network protocols such as POP, NNTP, HTTP, and FTP. Sockets also allow you to implement your own custom services and may be used to support Remote Procedure Call or Remote Method Invocation some day.
-
- JMM June 2nd 2000 Macintosh UDP support was added if you run open transport.
- !
Item was removed:
- ----- Method: OldSocket>>localPort (in category 'accessing') -----
- localPort
- self waitForConnectionUntil: self class standardDeadline.
- self isConnected ifFalse: [^0].
- ^self primSocketLocalPort: socketHandle!
Item was removed:
- ----- Method: OldSimpleClientSocket class>>parseHeaderList: (in category 'net news example') -----
- parseHeaderList: aString
- "Parse a list of newsgroup headers."
-
- | results s lineStart |
- results := WriteStream on: (String new: aString size).
- s := ReadStream on: aString.
- [s atEnd]
- whileFalse: [
- lineStart := s position + 1.
- 3 timesRepeat: [s skipTo: Character tab]. "find fourth tab"
- lineStart to: s position - 1 do: [:i | results nextPut: (aString at: i)].
- results cr.
- s skipTo: Character cr].
- ^ results contents
- !
Item was removed:
- ----- Method: OldSocket>>setPeer:port: (in category 'datagrams') -----
- setPeer: hostAddress port: port
- "Set the default send/recv address."
-
- self primSocket: socketHandle connectTo: hostAddress port: port.
- !
Item was removed:
- ----- Method: OldSimpleClientSocket>>waitForDataQueryingUserEvery: (in category 'as yet unclassified') -----
- waitForDataQueryingUserEvery: seconds
- "Wait for data to arrive, asking the user periodically if they wish to keep waiting. If they don't wish to keep waiting, destroy the socket and raise an error."
-
- | gotData |
- gotData := false.
- [gotData]
- whileFalse: [
- gotData := self waitForDataUntil: (Socket deadlineSecs: seconds).
- gotData ifFalse: [
- self isConnected ifFalse: [
- self destroy.
- self error: 'server closed connection'].
- (self confirm: 'server not responding; keep trying?')
- ifFalse: [
- self destroy.
- self error: 'no response from server']]].
- !
Item was removed:
- ----- Method: OldSocket>>statusString (in category 'queries') -----
- statusString
- "Return a string describing the status of this socket."
-
- | status |
- socketHandle == nil ifTrue: [^ 'destroyed'].
- status := self primSocketConnectionStatus: socketHandle.
- status = InvalidSocket ifTrue: [^ 'invalidSocketHandle'].
- status = Unconnected ifTrue: [^ 'unconnected'].
- status = WaitingForConnection ifTrue: [^ 'waitingForConnection'].
- status = Connected ifTrue: [^ 'connected'].
- status = OtherEndClosed ifTrue: [^ 'otherEndClosedButNotThisEnd'].
- status = ThisEndClosed ifTrue: [^ 'thisEndClosedButNotOtherEnd'].
- ^ 'unknown socket status'
- !
Item was removed:
- ----- Method: OldSocket>>initialize: (in category 'initialize-destroy') -----
- initialize: socketType
- "Initialize a new socket handle. If socket creation fails, socketHandle will be set to nil."
- | semaIndex readSemaIndex writeSemaIndex |
-
- primitiveOnlySupportsOneSemaphore := false.
- semaphore := Semaphore new.
- readSemaphore := Semaphore new.
- writeSemaphore := Semaphore new.
- semaIndex := Smalltalk registerExternalObject: semaphore.
- readSemaIndex := Smalltalk registerExternalObject: readSemaphore.
- writeSemaIndex := Smalltalk registerExternalObject: writeSemaphore.
- socketHandle :=
- self primSocketCreateNetwork: 0
- type: socketType
- receiveBufferSize: 8000
- sendBufSize: 8000
- semaIndex: semaIndex
- readSemaIndex: readSemaIndex
- writeSemaIndex: writeSemaIndex.
-
- socketHandle = nil ifTrue: [ "socket creation failed"
- Smalltalk unregisterExternalObject: semaphore.
- Smalltalk unregisterExternalObject: readSemaphore.
- Smalltalk unregisterExternalObject: writeSemaphore.
- readSemaphore := writeSemaphore := semaphore := nil
- ] ifFalse:[self register].
- !
Item was removed:
- ----- Method: OldSocket class>>register: (in category 'registry') -----
- register: anObject
- WeakArray isFinalizationSupported ifFalse:[^anObject].
- self registry add: anObject!
Item was removed:
- ----- Method: OldSocket>>closeAndDestroy (in category 'connection open/close') -----
- closeAndDestroy
- "First, try to close this connection gracefully. If the close attempt fails or times out, abort the connection. In either case, destroy the socket. Do nothing if the socket has already been destroyed (i.e., if its socketHandle is nil)."
-
- self closeAndDestroy: 20.
-
- !
Item was removed:
- ----- Method: HTTPSocket>>getRestOfBuffer: (in category 'as yet unclassified') -----
- 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)] ].
- self logToTranscript ifTrue: [
- Transcript cr; show: 'data byte count: ', response position printString].
- response reset. "position: 0."
- ^ response
- !
Item was removed:
- ----- Method: HTTPSocket class>>initHTTPSocket:wait:ifError: (in category 'utilities') -----
- 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 := self httpProxyServer.
- port := self 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
- !
Item was removed:
- ----- Method: OldSocket class>>timeTest (in category 'examples') -----
- timeTest
- "OldSocket timeTest"
-
- | serverName serverAddr s |
- Transcript show: 'initializing network ... '.
- self initializeNetworkIfFail: [^Transcript show: 'failed'].
- Transcript
- show: 'ok';
- cr.
- serverName := UIManager default request: 'What is your time server?'
- initialAnswer: 'localhost'.
- serverName isEmpty
- ifTrue:
- [^Transcript
- show: 'never mind';
- cr].
- serverAddr := NetNameResolver addressForName: serverName timeout: 10.
- serverAddr = nil
- ifTrue: [self error: 'Could not find the address for ' , serverName].
- s := self new.
- Transcript
- show: '---------- Connecting ----------';
- cr.
- s connectTo: serverAddr port: 13. "13 is the 'daytime' port number"
- s waitForConnectionUntil: (self deadlineSecs: 1).
- Transcript show: 'the time server reports: ' , s getResponseNoLF.
- s closeAndDestroy.
- Transcript
- show: '---------- Connection Closed ----------';
- cr!
Item was removed:
- ----- Method: OldSocket>>primAcceptFrom:receiveBufferSize:sendBufSize:semaIndex: (in category 'primitives') -----
- primAcceptFrom: aHandle receiveBufferSize: rcvBufSize sendBufSize: sndBufSize semaIndex: semaIndex
- "Create and return a new socket handle based on accepting the connection from the given listening socket"
- <primitive: 'primitiveSocketAccept' module: 'SocketPlugin'>
- ^self primitiveFailed!
Item was removed:
- ----- Method: OldSocket>>peerName (in category 'accessing') -----
- peerName
- "Return the name of the host I'm connected to, or nil if its name isn't known to the domain name server or the request times out."
- "Note: Slow. Calls the domain name server, taking up to 20 seconds to time out. Even when sucessful, delays of up to 13 seconds have been observed during periods of high network load."
-
- ^ NetNameResolver
- nameForAddress: self remoteAddress
- timeout: 20
- !
Item was removed:
- ----- Method: OldSocket class>>remoteTestServerTCPOpenClosePutGet (in category 'examples') -----
- remoteTestServerTCPOpenClosePutGet
- "The version of #remoteTestServerTCPOpenClosePutGet using the BSD style accept() mechanism."
-
- "Socket remoteTestServerTCPOpenClosePutGet"
-
- | server bytesIWantToSend bytesExpected receiveBuf sendBuf |
- Transcript show: 'initializing network ... '.
- self initializeNetworkIfFail: [^Transcript show: 'failed'].
- Transcript
- show: 'ok';
- cr.
- server := self newTCP.
- server listenOn: 54321 backlogSize: 20.
- server isValid ifFalse: [self error: 'Accept() is not supported'].
- Transcript
- show: 'server endpoint created -- run client test in other image';
- cr.
- bytesIWantToSend := 20000.
- bytesExpected := 80.
- receiveBuf := String new: 40000.
- sendBuf := String new: bytesIWantToSend withAll: $x.
- 1000 timesRepeat:
- [ | checkLength socket |
- socket := server waitForAcceptUntil: (self deadlineSecs: 300).
- socket waitForDataUntil: (self deadlineSecs: 5).
- checkLength := socket receiveDataInto: receiveBuf.
- checkLength ~= bytesExpected ifTrue: [self halt].
- socket sendData: sendBuf.
- socket waitForSendDoneUntil: (self deadlineSecs: 5).
- socket closeAndDestroy].
- server closeAndDestroy.
- Transcript
- cr;
- show: 'server endpoint destroyed';
- cr!
Item was removed:
- ----- Method: OldSimpleClientSocket class>>nntpTest (in category 'net news example') -----
- nntpTest
- "SimpleClientSocket nntpTest"
-
- | addr s headers msgs header allNewsGroups |
- addr := NetNameResolver promptUserForHostAddress.
- s := OldSimpleClientSocket new.
- Transcript show: '---------- Connecting ----------'; cr.
- s connectTo: addr port: 119. "119 is the NNTP port number"
- s waitForConnectionUntil: self standardDeadline.
- Transcript show: s getResponse.
- s sendCommand: 'group comp.lang.smalltalk'.
- Transcript show: s getResponse.
-
- "get all the message headers for the current newsgroup"
- s sendCommand: 'xover 1-1000000'.
- headers := s getMultilineResponseShowing: true.
-
- "print the headers of the first 10 messages of comp.lang.smalltalk"
- s sendCommand: 'listgroup comp.lang.smalltalk'.
- msgs := self parseIntegerList: s getMultilineResponse.
- msgs ifNotNil: [
- 1 to: 5 do: [:i |
- s sendCommand: 'head ', (msgs at: i) printString.
- header := s getMultilineResponse.
- Transcript show: (self extractDateFromAndSubjectFromHeader: header); cr]].
-
- "get a full list of usenet newsgroups"
- s sendCommand: 'newgroups 010101 000000'.
- allNewsGroups := s getMultilineResponse.
- Transcript show: allNewsGroups size printString, ' bytes in full newsgroup list'; cr.
-
- Transcript show: 'Sending quit...'; cr.
- s sendCommand: 'QUIT'.
- Transcript show: s getResponse.
- s closeAndDestroy.
- Transcript show: '---------- Connection Closed ----------'; cr; endEntry.
-
- (headers ~~ nil and:
- [self confirm: 'show article headers from comp.lang.smalltalk?'])
- ifTrue: [
- (StringHolder new contents: (self parseHeaderList: headers))
- openLabel: 'Newsgroup Headers'].
-
- (allNewsGroups ~~ nil and:
- [self confirm: 'show list of all newsgroups available on your server?'])
- ifTrue: [
- (StringHolder new contents: allNewsGroups)
- openLabel: 'All Usenet Newsgroups'].
- !
Item was removed:
- ----- Method: OldSocket>>socketError (in category 'queries') -----
- socketError
- ^self primSocketError: socketHandle!
Item was removed:
- ----- 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
- !
Item was removed:
- ----- Method: HTTPSocket>>responseCode (in category 'as yet unclassified') -----
- responseCode
- ^responseCode!
Item was removed:
- ----- Method: OldSocket>>socketHandle (in category 'accessing') -----
- socketHandle
- ^socketHandle!
Item was removed:
- ----- Method: OldSocket>>primSocketReceiveDataAvailable: (in category 'primitives') -----
- primSocketReceiveDataAvailable: socketID
- "Return true if data may be available for reading from the current socket."
-
- <primitive: 'primitiveSocketReceiveDataAvailable' module: 'SocketPlugin'>
- self primitiveFailed
- !
Item was removed:
- ----- Method: OldSocket>>writeSemaphore (in category 'accessing') -----
- writeSemaphore
- primitiveOnlySupportsOneSemaphore ifTrue: [^semaphore].
- ^writeSemaphore!
Item was removed:
- ----- Method: OldSocket class>>remoteTestSinkTCP (in category 'examples') -----
- remoteTestSinkTCP
- "See sendTest for instructions on running this method."
-
- "Socket remoteTestSinkTCP"
-
- | socket buffer n |
- Transcript show: 'initializing network ... '.
- self initializeNetworkIfFail: [^Transcript show: 'failed'].
- Transcript
- show: 'ok';
- cr.
- socket := self newTCP.
- socket listenOn: 9.
- Transcript
- show: 'server endpoint created -- run client test in other image';
- cr.
- buffer := String new: 64000.
- socket waitForConnectionUntil: self standardDeadline.
- [socket isConnected] whileTrue:
- [socket dataAvailable ifTrue: [n := socket receiveDataInto: buffer]].
- socket closeAndDestroy.
- Transcript
- cr;
- show: 'sink endpoint destroyed';
- cr!
Item was removed:
- ----- Method: OldSocket>>primSocketLocalAddress: (in category 'primitives') -----
- primSocketLocalAddress: socketID
- "Return the local host address for this socket."
-
- <primitive: 'primitiveSocketLocalAddress' module: 'SocketPlugin'>
- self primitiveFailed
- !
Item was removed:
- ----- Method: OldSocket>>primSocketLocalPort: (in category 'primitives') -----
- primSocketLocalPort: socketID
- "Return the local port for this socket, or zero if no port has yet been assigned."
-
- <primitive: 'primitiveSocketLocalPort' module: 'SocketPlugin'>
- self primitiveFailed
- !
Item was removed:
- ----- Method: OldSocket>>primSocket:listenOn: (in category 'primitives') -----
- primSocket: socketID listenOn: port
- "Listen for a connection on the given port. This is an asynchronous call; query the socket status to discover if and when the connection is actually completed."
-
- <primitive: 'primitiveSocketListenWithOrWithoutBacklog' module: 'SocketPlugin'>
- self primitiveFailed
- !
Item was removed:
- ----- Method: HTTPSocket>>getResponseUpTo:ignoring: (in category 'as yet unclassified') -----
- getResponseUpTo: markerString ignoring: ignoreString
- "Keep reading, until the marker is seen, skipping characters in ignoreString when
- comparing to the marker. Return three parts: header, marker, beginningOfData.
- Fails if no marker in first 2000 chars."
-
- | buf position bytesRead tester mm skipped |
- buf := String new: 2000.
- position := 0.
- tester := 1. mm := 1.
- skipped := 0.
- [tester := tester - markerString size + 1 max: 1. "rewind a little, in case the marker crosses a read boundary"
- tester to: position do: [:tt |
- (buf at: tt) = (markerString at: mm) ifFalse:
- [[ignoreString includes: (markerString at: mm)] whileTrue:
- [mm := mm + 1. skipped := skipped + 1]].
- (buf at: tt) = (markerString at: mm)
- ifTrue: [mm := mm + 1]
- ifFalse: [mm := 1. skipped := 0].
- "Not totally correct for markers like xx0xx"
- mm > markerString size ifTrue: ["got it"
- ^ Array with: (buf copyFrom: 1 to: tt+1-mm+skipped)
- with: markerString
- with: (buf copyFrom: tt+1 to: position)]].
- tester := 1 max: position. "OK if mm in the middle"
- (position < buf size) & (self isConnected | self dataAvailable)] whileTrue: [
- (self waitForDataUntil: (Socket deadlineSecs: 5)) ifFalse: [
- Transcript show: 'data was late'; cr].
- bytesRead := self primSocket: socketHandle receiveDataInto: buf
- startingAt: position + 1 count: buf size - position..
- position := position + bytesRead].
-
- ^ Array with: (buf copyFrom: 1 to: position)
- with: ''
- with: '' "Marker not found and connection closed"
- !
Item was removed:
- ----- Method: OldSocket>>isWaitingForConnection (in category 'queries') -----
- isWaitingForConnection
- "Return true if this socket is waiting for a connection."
-
- socketHandle == nil ifTrue: [^ false].
- ^ (self primSocketConnectionStatus: socketHandle) == WaitingForConnection
- !
Item was removed:
- ----- Method: OldSocket>>primSocketSendDone: (in category 'primitives') -----
- primSocketSendDone: socketID
- "Return true if there is no send in progress on the current socket."
-
- <primitive: 'primitiveSocketSendDone' module: 'SocketPlugin'>
- self primitiveFailed
- !
Item was removed:
- ----- Method: OldSocket class>>newTCP (in category 'instance creation') -----
- newTCP
- "Create a socket and initialise it for TCP"
- ^[ super new initialize: TCPSocketType ]
- repeatWithGCIf: [ :socket | socket isValid not ]!
Item was removed:
- ----- Method: OldSocket>>acceptFrom: (in category 'initialize-destroy') -----
- acceptFrom: aSocket
- "Initialize a new socket handle from an accept call"
- | semaIndex readSemaIndex writeSemaIndex |
-
- primitiveOnlySupportsOneSemaphore := false.
- semaphore := Semaphore new.
- readSemaphore := Semaphore new.
- writeSemaphore := Semaphore new.
- semaIndex := Smalltalk registerExternalObject: semaphore.
- readSemaIndex := Smalltalk registerExternalObject: readSemaphore.
- writeSemaIndex := Smalltalk registerExternalObject: writeSemaphore.
- socketHandle := self primAcceptFrom: aSocket socketHandle
- receiveBufferSize: 8000
- sendBufSize: 8000
- semaIndex: semaIndex
- readSemaIndex: readSemaIndex
- writeSemaIndex: writeSemaIndex.
- socketHandle = nil ifTrue: [ "socket creation failed"
- Smalltalk unregisterExternalObject: semaphore.
- Smalltalk unregisterExternalObject: readSemaphore.
- Smalltalk unregisterExternalObject: writeSemaphore.
- readSemaphore := writeSemaphore := semaphore := nil
- ] ifFalse:[self register].
- !
Item was removed:
- ----- Method: OldSocket>>waitForAcceptUntil: (in category 'waiting') -----
- waitForAcceptUntil: deadLine
- "Wait and accept an incoming connection"
- self waitForConnectionUntil: deadLine.
- ^self isConnected
- ifTrue:[self accept]
- ifFalse:[nil]!
Item was removed:
- ----- Method: OldSocket>>primSocket:setOption:value: (in category 'primitives') -----
- primSocket: socketID setOption: aString value: aStringValue
- "Set some option information on this socket. Refer to the UNIX
- man pages for valid SO, TCP, IP, UDP options. In case of doubt
- refer to the source code.
- TCP:=NODELAY, SO:=KEEPALIVE are valid options for example
- returns an array containing the error code and the negotiated value"
-
- <primitive: 'primitiveSocketSetOptions' module: 'SocketPlugin'>
- ^nil!
Item was removed:
- ----- Method: HTTPSocket class>>argStringUnencoded: (in category 'utilities') -----
- argStringUnencoded: args
- "Return the args in a long string, as encoded in a url"
-
- | argsString first |
- args isString ifTrue: ["sent in as a string, not a dictionary"
- ^ (args first = $? ifTrue: [''] ifFalse: ['?']), args].
- argsString := WriteStream on: String new.
- argsString nextPut: $?.
- first := true.
- args associationsDo: [ :assoc |
- assoc value do: [ :value |
- first ifTrue: [ first := false ] ifFalse: [ argsString nextPut: $& ].
- argsString nextPutAll: assoc key.
- argsString nextPut: $=.
- argsString nextPutAll: value. ] ].
- ^ argsString contents
- !
Item was removed:
- ----- Method: OldSocket>>listenOn:backlogSize:interface: (in category 'connection open/close') -----
- listenOn: portNumber backlogSize: backlog interface: ifAddr
- "Listen for a connection on the given port.
- If this method succeeds, #accept may be used to establish a new connection"
- | status |
- status := self primSocketConnectionStatus: socketHandle.
- (status == Unconnected)
- ifFalse: [self error: 'Socket status must Unconnected before listening for a new connection'].
- self primSocket: socketHandle listenOn: portNumber backlogSize: backlog interface: ifAddr.
- !
Item was removed:
- ----- Method: OldSocket>>sendData:count: (in category 'sending-receiving') -----
- sendData: buffer count: n
- "Send the amount of data from the given buffer"
- | sent |
- sent := 0.
- [sent < n] whileTrue:[
- sent := sent + (self sendSomeData: buffer startIndex: sent+1 count: (n-sent))].!
Item was removed:
- ----- Method: OldSocket class>>registryThreshold (in category 'registry') -----
- registryThreshold
- "Return the registry threshold above which socket creation may fail due to too many already open sockets. If the threshold is reached, a full GC will be issued if the creation of a socket fails."
- ^RegistryThreshold!
Item was removed:
- ----- Method: OldSocket>>sendSomeData: (in category 'sending-receiving') -----
- sendSomeData: aStringOrByteArray
- "Send as much of the given data as possible and answer the number of bytes actually sent."
- "Note: This operation may have to be repeated multiple times to send a large amount of data."
-
- ^ self
- sendSomeData: aStringOrByteArray
- startIndex: 1
- count: aStringOrByteArray size!
Item was removed:
- ----- Method: OldSimpleClientSocket class>>extractDateFromAndSubjectFromHeader: (in category 'POP mail example') -----
- extractDateFromAndSubjectFromHeader: headerString
-
- | date from subject s lineBuf c line i |
- date := from := subject := ''.
- s := ReadStream on: headerString.
- lineBuf := WriteStream on: ''.
- [s atEnd] whileFalse: [
- c := s next.
- c = CR
- ifTrue: [
- line := lineBuf contents.
- (line beginsWith: 'Date: ') ifTrue: [date := line copyFrom: 7 to: line size].
- (line beginsWith: 'From: ') ifTrue: [from := line copyFrom: 7 to: line size].
- (line beginsWith: 'Subject: ') ifTrue: [subject := line copyFrom: 10 to: line size].
- lineBuf := WriteStream on: '']
- ifFalse: [lineBuf nextPut: c]].
-
- i := date indexOf: $' ifAbsent: [0].
- date := date copyFrom: i + 1 to: date size.
- ^ (self simpleDateString: date), ', ', from, ':
- ', subject
- !
Item was removed:
- ----- Method: OldSocket>>sendSomeData:startIndex: (in category 'sending-receiving') -----
- sendSomeData: aStringOrByteArray startIndex: startIndex
- "Send as much of the given data as possible starting at the given index. Answer the number of bytes actually sent."
- "Note: This operation may have to be repeated multiple times to send a large amount of data."
-
- ^ self
- sendSomeData: aStringOrByteArray
- startIndex: startIndex
- count: (aStringOrByteArray size - startIndex + 1)!
Item was removed:
- ----- Method: OldSocket>>listenOn:backlogSize: (in category 'connection open/close') -----
- listenOn: portNumber backlogSize: backlog
- "Listen for a connection on the given port.
- If this method succeeds, #accept may be used to establish a new connection"
- | status |
- status := self primSocketConnectionStatus: socketHandle.
- (status == Unconnected)
- ifFalse: [self error: 'Socket status must Unconnected before listening for a new connection'].
- self primSocket: socketHandle listenOn: portNumber backlogSize: backlog.
- !
Item was removed:
- ----- Method: OldSocket class>>initializeNetworkIfFail: (in category 'network initialization') -----
- initializeNetworkIfFail: failBlock
- "Initialize the network drivers. Do nothing if the network is already initialized. Evaluate the given block if network initialization fails, perhaps because this computer isn't currently connected to a network."
-
- NetNameResolver initializeNetwork!
Item was removed:
- ----- Method: OldSocket>>isUnconnectedOrInvalid (in category 'queries') -----
- isUnconnectedOrInvalid
- "Return true if this socket is completely disconnected or is invalid."
-
- | status |
- socketHandle == nil ifTrue: [^ true].
- status := self primSocketConnectionStatus: socketHandle.
- ^ (status = Unconnected) | (status = InvalidSocket)
- !
Item was removed:
- ----- Method: OldSocket class>>wildcardAddress (in category 'utilities') -----
- wildcardAddress
- "Answer a don't-care address for use with UDP sockets."
-
- ^ByteArray new: 4 "0.0.0.0"!
Item was removed:
- ----- Method: OldSocket>>unregister (in category 'registry') -----
- unregister
- ^self class unregister: self!
Item was removed:
- ----- Method: OldSimpleClientSocket class>>httpTestHost:port:url: (in category 'other examples') -----
- httpTestHost: hostName port: port url: url
- "This test fetches a URL from the given host and port."
- "SimpleClientSocket httpTestHost: 'www.disney.com' port: 80 url: '/'"
- "Tests URL fetch through a local HTTP proxie server:
- (SimpleClientSocket
- httpTestHost: '127.0.0.1'
- port: 8080
- url: 'HTTP://www.exploratorium.edu/index.html')"
-
- | hostAddr s result buf t totalBytes |
- Transcript cr; show: 'starting http test'; cr.
- Socket initializeNetwork.
- hostAddr := NetNameResolver addressForName: hostName timeout: 10.
- hostAddr = nil ifTrue: [^ self inform: 'Could not find an address for ', hostName].
-
- s := OldSimpleClientSocket new.
- Transcript show: '---------- Connecting ----------'; cr.
- s connectTo: hostAddr port: port.
- s waitForConnectionUntil: "self standardDeadline" (Socket deadlineSecs: 10).
- (s isConnected) ifFalse: [
- s destroy.
- ^ self inform: 'could not connect'].
- Transcript show: 'connection open; waiting for data'; cr.
-
- s sendCommand: 'GET ', url, ' HTTP/1.0'.
- s sendCommand: 'User-Agent: Squeak 1.19'.
- s sendCommand: 'ACCEPT: text/html'. "always accept plain text"
- s sendCommand: 'ACCEPT: application/octet-stream'. "also accept binary data"
- s sendCommand: ''. "blank line"
-
- result := WriteStream on: (String new: 10000).
- buf := String new: 10000.
- totalBytes := 0.
- t := Time millisecondsToRun: [ | bytes |
- [s isConnected] whileTrue: [
- s waitForDataUntil: (Socket deadlineSecs: 5).
- bytes := s receiveDataInto: buf.
- 1 to: bytes do: [:i | result nextPut: (buf at: i)].
- totalBytes := totalBytes + bytes.
- Transcript show: totalBytes printString, ' bytes received'; cr]].
-
- s destroy.
- Transcript show: '---------- Connection Closed ----------'; cr; endEntry.
- Transcript show: 'http test done; ', totalBytes printString, ' bytes read in '.
- Transcript show: ((t / 1000.0) roundTo: 0.01) printString, ' seconds'; cr.
- Transcript show: ((totalBytes asFloat / t) roundTo: 0.01) printString, ' kBytes/sec'; cr.
- Transcript endEntry.
- (StringHolder new contents: (result contents))
- openLabel: 'HTTP Test Result: URL Contents'.
- !
Item was removed:
- ----- Method: OldSocket>>localAddress (in category 'accessing') -----
- localAddress
- self waitForConnectionUntil: self class standardDeadline.
- self isConnected ifFalse: [^ByteArray new: 4].
- ^self primSocketLocalAddress: socketHandle!
Item was removed:
- ----- Method: OldSimpleClientSocket>>getMultilineResponseShowing: (in category 'as yet unclassified') -----
- getMultilineResponseShowing: showFlag
- "Get a multiple line response to the last command. A multiple line response ends with a line containing only a single period (.) character. Linefeed characters are filtered out. If showFlag is true, each line is shown in the upper-left corner of the Display as it is received."
-
- | response done chunk |
- response := WriteStream on: ''.
- done := false.
- [done] whileFalse: [
- showFlag
- ifTrue: [chunk := self getResponseShowing: true]
- ifFalse: [chunk := self getResponse].
- (chunk beginsWith: '.')
- ifTrue: [ response nextPutAll: (chunk copyFrom: 2 to: chunk size) ]
- ifFalse: [ response nextPutAll: chunk ].
- done := (chunk = ('.', String cr)) ].
-
- ^ response contents
- !
Item was removed:
- ----- Method: OldSocket>>isValid (in category 'queries') -----
- isValid
- "Return true if this socket contains a valid, non-nil socket handle."
-
- | status |
- socketHandle == nil ifTrue: [^ false].
- status := self primSocketConnectionStatus: socketHandle.
- ^ status ~= InvalidSocket
- !
Item was removed:
- ----- Method: OldSocket>>primSocketAbortConnection: (in category 'primitives') -----
- primSocketAbortConnection: socketID
- "Terminate the connection on the given port immediately without going through the normal close sequence. This is an asynchronous call; query the socket status to discover if and when the connection is actually terminated."
-
- <primitive: 'primitiveSocketAbortConnection' module: 'SocketPlugin'>
- self primitiveFailed
- !
Item was removed:
- ----- 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 removed:
- ----- Method: OldSocket class>>deadServer: (in category 'utilities') -----
- deadServer: aStringOrNil
- "Keep the machine name of the most recently encoutered non-responding machine. Next time the user can move it to the last in a list of servers to try."
-
- DeadServer := aStringOrNil!
Item was removed:
- ----- Method: OldSocket class>>initialize (in category 'class initialization') -----
- initialize
- "Socket initialize"
-
- "Socket Types"
- TCPSocketType := 0.
- UDPSocketType := 1.
-
- "Socket Status Values"
- InvalidSocket := -1.
- Unconnected := 0.
- WaitingForConnection := 1.
- Connected := 2.
- OtherEndClosed := 3.
- ThisEndClosed := 4.
-
- RegistryThreshold := 100. "# of sockets"!
Item was removed:
- ----- Method: OldSocket class>>newUDP (in category 'instance creation') -----
- newUDP
- "Create a socket and initialise it for UDP"
- ^[ super new initialize: UDPSocketType ]
- repeatWithGCIf: [ :socket | socket isValid not ]!
Item was removed:
- ----- Method: OldSocket class>>unregister: (in category 'registry') -----
- unregister: anObject
- WeakArray isFinalizationSupported ifFalse:[^anObject].
- self registry remove: anObject ifAbsent:[]!
Item was removed:
- ----- Method: OldSocket>>port (in category 'accessing') -----
- port
- "Shortcut"
- ^self localPort!
Item was removed:
- ----- Method: HTTPSocket class>>checkHTTPProxyPreferences (in category 'proxy settings') -----
- checkHTTPProxyPreferences
- Preferences preferenceAt: #httpProxyPort ifAbsent: [self addHTTPProxyPreferences].
- Preferences preferenceAt: #httpProxyServer ifAbsent: [self addHTTPProxyPreferences].!
Item was removed:
- ----- Method: OldSocket>>primSocket:getOption: (in category 'primitives') -----
- primSocket: socketID getOption: aString
- "Get some option information on this socket. Refer to the UNIX
- man pages for valid SO, TCP, IP, UDP options. In case of doubt
- refer to the source code.
- TCP:=NODELAY, SO:=KEEPALIVE are valid options for example
- returns an array containing the error code and the option value"
-
- <primitive: 'primitiveSocketGetOptions' module: 'SocketPlugin'>
- self primitiveFailed
- !
Item was removed:
- ----- Method: OldSocket>>receiveDataInto:fromHost:port: (in category 'datagrams') -----
- receiveDataInto: aStringOrByteArray fromHost: hostAddress port: portNumber
- | datagram |
- "Receive a UDP packet from the given hostAddress/portNumber, storing the data in the given buffer, and return the number of bytes received. Note the given buffer may be only partially filled by the received data."
-
- primitiveOnlySupportsOneSemaphore ifTrue:
- [self setPeer: hostAddress port: portNumber.
- ^self receiveDataInto: aStringOrByteArray].
- [true] whileTrue:
- [datagram := self receiveUDPDataInto: aStringOrByteArray.
- ((datagram at: 2) = hostAddress and: [(datagram at: 3) = portNumber])
- ifTrue: [^datagram at: 1]
- ifFalse: [^0]]!
Item was removed:
- ----- Method: OldSimpleClientSocket class>>parseSensorStateString: (in category 'remote cursor example') -----
- parseSensorStateString: aString
- "Parse the given sensor stat string and return an array whose first element is the cursor point and whose second is the cursor button state."
- "SimpleClientSocket parseSensorStateString: SimpleClientSocket sensorStateString"
-
- | s buttons x y |
- s := ReadStream on: aString.
- x := Integer readFrom: s.
- s skipSeparators.
- y := Integer readFrom: s.
- s skipSeparators.
- buttons := Integer readFrom: s.
- ^ Array with: x at y with: buttons
- !
Item was removed:
- ----- Method: OldSocket>>primSocketCreateNetwork:type:receiveBufferSize:sendBufSize:semaIndex:readSemaIndex:writeSemaIndex: (in category 'primitives') -----
- primSocketCreateNetwork: netType type: socketType receiveBufferSize: rcvBufSize sendBufSize: sendBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema
- "See comment in primSocketCreateNetwork: with one semaIndex. However you should know that some implementations
- ignore the buffer size and this interface supports three semaphores, one for open/close/listen and the other two for
- reading and writing"
-
- <primitive: 'primitiveSocketCreate3Semaphores' module: 'SocketPlugin'>
- primitiveOnlySupportsOneSemaphore := true.
- ^ self primSocketCreateNetwork: netType
- type: socketType
- receiveBufferSize: rcvBufSize
- sendBufSize: sendBufSize
- semaIndex: semaIndex!
Item was removed:
- ----- Method: HTTPSocket>>header: (in category 'as yet unclassified') -----
- header: headerText
- "set the headers. Then getHeader: can be used"
-
- "divide into basic lines"
- | lines foldedLines statusLine |
- lines := headerText findTokens: String crlf.
- statusLine := lines first.
- lines := lines copyFrom: 2 to: lines size.
-
- "parse the status (pretty trivial right now)"
- responseCode := (statusLine findTokens: ' ') second.
-
- "fold lines that start with spaces into the previous line"
- foldedLines := OrderedCollection new.
- lines do: [ :line |
- line first isSeparator ifTrue: [
- foldedLines at: foldedLines size put: (foldedLines last, line) ]
- ifFalse: [ foldedLines add: line ] ].
-
- "make a dictionary mapping headers to header contents"
- headers := Dictionary new.
- foldedLines do: [ :line | | i |
- i := line indexOf: $:.
- i > 0 ifTrue: [
- headers
- at: (line copyFrom: 1 to: i-1) asLowercase
- put: (line copyFrom: i+1 to: line size) withBlanksTrimmed ] ].
- !
Item was removed:
- ----- Method: OldSocket>>accept (in category 'connection open/close') -----
- accept
- "Accept a connection from the receiver socket.
- Return a new socket that is connected to the client"
-
- ^self class acceptFrom: self!
Item was removed:
- ----- Method: HTTPSocket>>contentType: (in category 'as yet unclassified') -----
- contentType: header
- "extract the content type from the header. Content-type: text/plain<cr><lf>, User may look in headerTokens afterwards."
-
- | this |
- headerTokens ifNil: [ headerTokens := header findTokens: ParamDelimiters keep: String cr].
- 1 to: headerTokens size do: [:ii |
- this := headerTokens at: ii.
- (this first asLowercase = $c and: [#('content-type:' 'content type') includes: this asLowercase]) ifTrue: [
- ^ (headerTokens at: ii+1)]].
- ^ nil "not found"!
Item was removed:
- ----- Method: OldSocket>>waitForConnectionUntil: (in category 'waiting') -----
- waitForConnectionUntil: deadline
- "Wait up until the given deadline for a connection to be established. Return true if it is established by the deadline, false if not."
-
- | status |
- status := self primSocketConnectionStatus: socketHandle.
- [(status = WaitingForConnection) and: [Time millisecondClockValue < deadline]]
- whileTrue: [
- semaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue).
- status := self primSocketConnectionStatus: socketHandle].
-
- ^ status = Connected
- !
Item was removed:
- ----- Method: OldSimpleClientSocket class>>parseIntegerList: (in category 'net news example') -----
- parseIntegerList: aString
- "Parse a list of integers, each on a line by itself."
-
- | s out |
- s := ReadStream on: aString.
- s skipTo: Character cr. "skip the first line"
- out := OrderedCollection new.
- [s atEnd]
- whileFalse: [
- out addLast: (Integer readFrom: s).
- s skipTo: Character cr].
- ^ out asArray
- !
Item was removed:
- ----- Method: OldSocket class>>nameForWellKnownTCPPort: (in category 'utilities') -----
- nameForWellKnownTCPPort: portNum
- "Answer the name for the given well-known TCP port number. Answer a string containing the port number if it isn't well-known."
-
- | portList entry |
- portList := #(
- (7 'echo') (9 'discard') (13 'time') (19 'characterGenerator')
- (21 'ftp') (23 'telnet') (25 'smtp')
- (80 'http') (110 'pop3') (119 'nntp')).
- entry := portList detect: [:pair | pair first = portNum] ifNone: [^ 'port-', portNum printString].
- ^ entry last
- !
Item was removed:
- ----- Method: HTTPSocket>>getHeader:default: (in category 'as yet unclassified') -----
- getHeader: name default: defaultValue
- ^headers at: name ifAbsent: [ defaultValue ]!
Item was removed:
- ----- Method: OldSocket class>>deadServer (in category 'utilities') -----
- deadServer
-
- ^ DeadServer!
Item was removed:
- ----- Method: OldSocket>>finalize (in category 'finalization') -----
- finalize
- self primSocketDestroyGently: socketHandle.
- Smalltalk unregisterExternalObject: semaphore.
- Smalltalk unregisterExternalObject: readSemaphore.
- Smalltalk unregisterExternalObject: writeSemaphore.
- !
Item was removed:
- ----- Method: OldSimpleClientSocket class>>parseNTTPMsgList: (in category 'net news example') -----
- parseNTTPMsgList: aString
- "Parse a list of integers, each on a line by itself."
-
- | s out |
- s := ReadStream on: aString.
- s skipTo: Character cr. "skip the first line"
- out := OrderedCollection new.
- [s atEnd]
- whileFalse: [
- out addLast: (Integer readFrom: s).
- s skipTo: Character cr].
- ^ out asArray
- !
Item was removed:
- ----- Method: OldSocket class>>remoteTestClientUDP (in category 'examples') -----
- remoteTestClientUDP
- "FIRST start up another image, and execute: Socket remoteTestServerUDP.
- THEN come back to this image and execute:"
-
- "Socket remoteTestClientUDP"
-
- "Performa 6400/200, Linux-PPC 2.1.24:
- remoteClient UDP test done; time = 4580
- 2500 packets, 10000000 bytes sent (2183 kBytes/sec)
- 180 packets, 720000 bytes received (157 kBytes/sec)
- 4000 bytes/packet, 39 packets/sec, 2320 packets dropped"
-
- | socket bytesToSend sendBuf receiveBuf done bytesSent bytesReceived packetsSent packetsReceived t serverName |
- Transcript
- show: 'starting client/server UDP test';
- cr.
- Transcript show: 'initializing network ... '.
- self initializeNetworkIfFail: [^Transcript show: 'failed'].
- Transcript
- show: 'ok';
- cr.
- serverName := UIManager default request: 'What is your remote Test Server?'
- initialAnswer: ''.
- socket := self newUDP.
- socket setPeer: (NetNameResolver addressFromString: serverName) port: 54321.
- Transcript
- show: 'client endpoint created';
- cr.
- bytesToSend := 10000000.
- sendBuf := String new: 4000 withAll: $x.
- receiveBuf := String new: 4000.
- done := false.
- bytesSent := bytesReceived := packetsSent := packetsReceived := 0.
- t := Time millisecondsToRun:
- [[done] whileFalse:
- [(socket sendDone and: [bytesSent < bytesToSend])
- ifTrue:
- [packetsSent := packetsSent + 1.
- bytesSent := bytesSent + (socket sendData: sendBuf)].
- socket dataAvailable
- ifTrue:
- [packetsReceived := packetsReceived + 1.
- bytesReceived := bytesReceived + (socket receiveDataInto: receiveBuf)].
- done := bytesSent >= bytesToSend].
-
- [socket waitForDataUntil: (self deadlineSecs: 1).
- socket dataAvailable]
- whileTrue:
- [packetsReceived := packetsReceived + 1.
- bytesReceived := bytesReceived + (socket receiveDataInto: receiveBuf)]].
- socket closeAndDestroy.
- Transcript
- show: 'remoteClient UDP test done; time = ' , t printString;
- cr.
- Transcript
- show: packetsSent printString , ' packets, ' , bytesSent printString
- , ' bytes sent (' , (bytesSent * 1000 // t) printString
- , ' bytes/sec)';
- cr.
- Transcript
- show: packetsReceived printString , ' packets, '
- , bytesReceived printString , ' bytes received ('
- , (bytesReceived * 1000 // t) printString , ' bytes/sec)';
- cr.
- Transcript
- show: (bytesSent // packetsSent) printString , ' bytes/packet, '
- , (packetsReceived * 1000 // t) printString , ' packets/sec, '
- , (packetsSent - packetsReceived) printString , ' packets dropped';
- cr!
Item was removed:
- ----- Method: OldSocket>>primSocketDestroyGently: (in category 'primitives') -----
- primSocketDestroyGently: socketID
- "Release the resources associated with this socket. If a connection is open, it is aborted.
- Do not fail if the receiver is already closed."
-
- <primitive: 'primitiveSocketDestroy' module: 'SocketPlugin'>
- !
Item was removed:
- ----- Method: OldSocket class>>new (in category 'instance creation') -----
- new
- "Return a new, unconnected Socket. Note that since socket creation may fail, it is safer to use the method createIfFail: to handle such failures gracefully; this method is primarily for backward compatibility and may be disallowed in a future release."
- "Note: The default creates a TCP socket - this is also backward compatibility."
- ^self newTCP!
Item was removed:
- ----- Method: OldSocket class>>createIfFail: (in category 'instance creation') -----
- createIfFail: failBlock
- "Attempt to create a new socket. If successful, return the new socket. Otherwise, return the result of evaluating the given block. Socket creation can fail if the network isn't available or if there are not sufficient resources available to create another socket."
- "Note: The default creates a TCP socket"
- ^self tcpCreateIfFail: failBlock!
Item was removed:
- ----- Method: OldSocket class>>acceptFrom: (in category 'instance creation') -----
- acceptFrom: aSocket
- ^[ super new acceptFrom: aSocket ]
- repeatWithGCIf: [ :sock | sock isValid not ]!
Item was removed:
- ----- Method: OldSocket>>primSocket:receiveUDPDataInto:startingAt:count: (in category 'primitives') -----
- primSocket: socketID receiveUDPDataInto: aStringOrByteArray startingAt: startIndex count: count
- "Receive data from the given socket into the given array starting at the given index.
- Return an Array containing the amount read, the host address byte array, the host port, and the more flag"
-
- <primitive: 'primitiveSocketReceiveUDPDataBufCount' module: 'SocketPlugin'>
- self primitiveFailed
- !
Item was removed:
- ----- Method: OldSocket class>>remoteTestServerTCPOpenClose1000 (in category 'examples') -----
- remoteTestServerTCPOpenClose1000
- "The version of #remoteTestServerTCPOpenClose1000 using the BSD style accept() mechanism."
-
- "Socket remoteTestServerTCPOpenClose1000"
-
- | server |
- Transcript show: 'initializing network ... '.
- self initializeNetworkIfFail: [^Transcript show: 'failed'].
- Transcript
- show: 'ok';
- cr.
- server := self newTCP.
- server listenOn: 54321 backlogSize: 20.
- server isValid ifFalse: [self error: 'Accept() is not supported'].
- Transcript
- show: 'server endpoint created -- run client test in other image';
- cr.
- 1000 timesRepeat:
- [ | socket |
- socket := server waitForAcceptUntil: (self deadlineSecs: 300).
- socket closeAndDestroy].
- server closeAndDestroy.
- Transcript
- cr;
- show: 'server endpoint destroyed';
- cr!
Item was removed:
- ----- Method: OldSocket class>>initializeNetwork (in category 'network initialization') -----
- initializeNetwork
- "Initialize the network drivers and the NetNameResolver. Do nothing if the network is already initialized."
- "Note: The network must be re-initialized every time Squeak starts up, so applications that persist across snapshots should be prepared to re-initialize the network as needed. Such applications should call 'Socket initializeNetwork' before every network transaction. "
-
- NetNameResolver initializeNetwork!
Item was removed:
- ----- Method: OldSocket>>primitiveOnlySupportsOneSemaphore (in category 'accessing') -----
- primitiveOnlySupportsOneSemaphore
- ^primitiveOnlySupportsOneSemaphore!
Item was removed:
- ----- Method: OldSocket class>>timeTestUDP2 (in category 'examples') -----
- timeTestUDP2
- "Socket timeTestUDP2"
-
- | serverName serverAddr s |
- Transcript show: 'initializing network ... '.
- self initializeNetworkIfFail: [^Transcript show: 'failed'].
- Transcript
- show: 'ok';
- cr.
- serverName := UIManager default request: 'What is your time server?'
- initialAnswer: 'localhost'.
- serverName isEmpty
- ifTrue:
- [^Transcript
- show: 'never mind';
- cr].
- serverAddr := NetNameResolver addressForName: serverName timeout: 10.
- serverAddr = nil
- ifTrue: [self error: 'Could not find the address for ' , serverName].
- s := self newUDP.
- "The following associates a port with the UDP socket, but does NOT create a connectable endpoint"
- s setPort: 54321.
- "Send a packet to the daytime port and it will reply with the current date."
- Transcript
- show: '---------- Sending datagram from port ' , s port printString
- , ' ----------';
- cr.
- s
- sendData: '!!'
- toHost: serverAddr
- port: 13.
- Transcript show: 'the time server reports: ' , s getResponseNoLF.
- s closeAndDestroy.
- Transcript
- show: '---------- Socket closed ----------';
- cr!
Item was removed:
- ----- Method: OldSimpleClientSocket>>displayString: (in category 'as yet unclassified') -----
- displayString: aString
- "Display the given string on the Display. Used for testing."
-
- | s |
- aString isEmpty ifTrue: [^ self].
- aString size > 60
- ifTrue: [s := aString copyFrom: 1 to: 60] "limit to 60 characters"
- ifFalse: [s := aString].
-
- s displayOn: Display.
- !
Item was removed:
- ----- Method: OldSocket class>>remoteTestServerTCP (in category 'examples') -----
- remoteTestServerTCP
- "See remoteTestClientTCP for instructions on running this method."
-
- "OldSocket remoteTestServerTCP"
-
- | socket client buffer n |
- Transcript show: 'initializing network ... '.
- self initializeNetwork.
- Transcript
- show: 'ok';
- cr.
- socket := OldSocket newTCP.
- socket
- listenOn: 54321
- backlogSize: 5
- interface: (NetNameResolver addressFromString: '127.0.0.1'). "or: 0.0.0.0"
- Transcript
- show: 'server endpoint created -- run client test in other image';
- cr.
- buffer := String new: 4000.
- socket waitForConnectionUntil: self standardDeadline.
- client := socket accept.
- [client isConnected] whileTrue:
- [client dataAvailable
- ifTrue:
- [n := client receiveDataInto: buffer.
- client sendData: buffer count: n]].
- client closeAndDestroy.
- socket closeAndDestroy.
- Transcript
- cr;
- show: 'server endpoint destroyed';
- cr.
- ^socket!
Item was removed:
- ----- Method: OldSocket>>remoteAddress (in category 'accessing') -----
- remoteAddress
-
- ^ self primSocketRemoteAddress: socketHandle
- !
Item was removed:
- ----- Method: HTTPSocket>>contentType (in category 'as yet unclassified') -----
- contentType
- | type i |
- type := self getHeader: 'content-type' default: nil.
- type ifNil: [ ^nil ].
- type := type withBlanksTrimmed.
- i := type indexOf: $;.
- i = 0 ifTrue: [ ^type ].
- ^(type copyFrom: 1 to: i-1) withBlanksTrimmed !
Item was removed:
- ----- Method: OldSocket>>setOption:value: (in category 'other') -----
- setOption: aName value: aValue
- | value |
- "setup options on this socket, see Unix man pages for values for
- sockets, IP, TCP, UDP. IE SO:=KEEPALIVE
- returns an array, element one is the error number
- element two is the resulting of the negotiated value.
- See getOption for list of keys"
-
- (socketHandle == nil or: [self isValid not])
- ifTrue: [self error: 'Socket status must valid before setting an option'].
- value := aValue asString.
- aValue == true ifTrue: [value := '1'].
- aValue == false ifTrue: [value := '0'].
- ^ self primSocket: socketHandle setOption: aName value: value!
Item was removed:
- ----- Method: OldSocket>>getData (in category 'sending-receiving') -----
- getData
- "Get some data"
-
- | buf bytesRead |
- (self waitForDataUntil: self class standardDeadline)
- ifFalse: [self error: 'getData timeout'].
- buf := String new: 4000.
- bytesRead := self
- primSocket: socketHandle
- receiveDataInto: buf
- startingAt: 1
- count: buf size.
- ^buf copyFrom: 1 to: bytesRead!
Item was removed:
- ----- Method: OldSocket class>>registry (in category 'registry') -----
- registry
- WeakArray isFinalizationSupported ifFalse:[^nil].
- ^Registry isNil
- ifTrue:[Registry := WeakRegistry new]
- ifFalse:[Registry].!
Item was removed:
- ----- Method: OldSimpleClientSocket class>>crLf (in category 'queries') -----
- crLf
-
- ^ CrLf
- !
Item was removed:
- ----- Method: OldSocket>>readInto:startingAt: (in category 'sending-receiving') -----
- readInto: aStringOrByteArray startingAt: aNumber
- "Read data into the given buffer starting at the given index and return the number of bytes received. Note the given buffer may be only partially filled by the received data."
-
- (self waitForDataUntil: self class standardDeadline)
- ifFalse: [self error: 'receive timeout'].
- ^self
- primSocket: socketHandle
- receiveDataInto: aStringOrByteArray
- startingAt: aNumber
- count: aStringOrByteArray size - aNumber + 1!
Item was removed:
- ----- Method: OldSimpleClientSocket>>getResponseShowing: (in category 'as yet unclassified') -----
- getResponseShowing: showFlag
-
- | line idx |
- line := WriteStream on: String new.
-
- buffer ifNil: [
- buffer := String new.
- bufferPos := 0 ].
-
- [
- "look for a LF in the buffer"
- idx := buffer indexOf: Character lf startingAt: bufferPos+1 ifAbsent: [ 0 ].
- idx > 0 ifTrue: [
- "found it!! we have a line"
- line nextPutAll: (buffer copyFrom: bufferPos+1 to: idx-1).
- bufferPos := idx.
- ^line contents ].
-
- "didn't find it. add the whole buffer to the line, and retrieve some more data"
- line nextPutAll: (buffer copyFrom: bufferPos+1 to: buffer size).
- bufferPos := 0.
- buffer := String new.
- self waitForDataQueryingUserEvery: 30.
- buffer := self getData.
-
- true
- ] whileTrue.!
Item was removed:
- ----- Method: OldSocket>>sendData:toHost:port: (in category 'datagrams') -----
- sendData: aStringOrByteArray toHost: hostAddress port: portNumber
- "Send a UDP packet containing the given data to the specified host/port."
-
- primitiveOnlySupportsOneSemaphore ifTrue:
- [self setPeer: hostAddress port: portNumber.
- ^self sendData: aStringOrByteArray].
- ^self sendUDPData: aStringOrByteArray toHost: hostAddress port: portNumber!
Item was removed:
- ----- Method: OldSocket>>receiveUDPDataInto: (in category 'datagrams') -----
- receiveUDPDataInto: aStringOrByteArray
- "Receive UDP data into the given buffer and return the number of bytes received. Note the given buffer may be only partially filled by the received data. What is returned is an array, the first element is the bytes read, the second the sending bytearray address, the third the senders port, the fourth, true if more of the datagram awaits reading"
-
- ^ self primSocket: socketHandle
- receiveUDPDataInto: aStringOrByteArray
- startingAt: 1
- count: aStringOrByteArray size
- !
Item was removed:
- ----- Method: OldSocket class>>standardDeadline (in category 'utilities') -----
- standardDeadline
- "Return a default deadline time some seconds into the future."
-
- ^ self deadlineSecs: 45
- !
Item was removed:
- ----- Method: HTTPSocket class>>ip:port:urlPath: (in category 'utilities') -----
- ip: byteArrayIP port: portNum urlPath: urlPathString
- ^String streamContents: [:stream |
- byteArrayIP
- do: [:each | each printOn: stream]
- separatedBy: [stream nextPut: $.].
- stream nextPut: $:.
- portNum printOn: stream.
- stream nextPutAll: urlPathString]!
Item was removed:
- ----- Method: OldSimpleClientSocket>>sendCommand: (in category 'as yet unclassified') -----
- sendCommand: commandString
- "Send the given command as a single line followed by a <CR><LF> terminator."
-
- self sendData: commandString, CrLf.
- !
Item was removed:
- ----- Method: OldSimpleClientSocket class>>popTest (in category 'POP mail example') -----
- popTest
- "SimpleClientSocket popTest"
-
- | addr userName userPassword s msgs header |
- addr := NetNameResolver promptUserForHostAddress.
- userName := UIManager default
- request: 'What is your email name?'
- initialAnswer: 'johnm'.
- userPassword := UIManager default
- request: 'What is your email password?'.
-
- s := OldSimpleClientSocket new.
- Transcript show: '---------- Connecting ----------'; cr.
- s connectTo: addr port: 110. "110 is the POP3 port number"
- s waitForConnectionUntil: self standardDeadline.
- Transcript show: s getResponse.
- s sendCommand: 'USER ', userName.
- Transcript show: s getResponse.
- s sendCommand: 'PASS ', userPassword.
- Transcript show: s getResponse.
- s sendCommand: 'LIST'.
-
- "the following should be tweaked to handle an empy mailbox:"
- msgs := self parseIntegerList: s getMultilineResponse.
-
- 1 to: (msgs size min: 5) do: [ :i |
- s sendCommand: 'TOP ', (msgs at: i) printString, ' 0'.
- header := s getMultilineResponse.
- Transcript show: (self extractDateFromAndSubjectFromHeader: header); cr].
-
- msgs size > 0 ifTrue: [
- "get the first message"
- s sendCommand: 'RETR 1'.
- Transcript show: s getMultilineResponse].
-
- Transcript show: 'closing connection'; cr.
- s sendCommand: 'QUIT'.
- s closeAndDestroy.
- Transcript show: '---------- Connection Closed ----------'; cr; endEntry.
- !
Item was removed:
- ----- Method: OldSocket>>primSocketConnectionStatus: (in category 'primitives') -----
- primSocketConnectionStatus: socketID
- "Return an integer reflecting the connection status of this socket. For a list of possible values, see the comment in the 'initialize' method of this class. If the primitive fails, return a status indicating that the socket handle is no longer valid, perhaps because the Squeak image was saved and restored since the socket was created. (Sockets do not survive snapshots.)"
-
- <primitive: 'primitiveSocketConnectionStatus' module: 'SocketPlugin'>
- ^ InvalidSocket
- !
Item was removed:
- ----- Method: OldSocket>>address (in category 'accessing') -----
- address
- "Shortcut"
- ^self localAddress!
Item was removed:
- ----- Method: OldSocket>>receiveDataInto: (in category 'sending-receiving') -----
- receiveDataInto: aStringOrByteArray
- "Receive data into the given buffer and return the number of bytes received. Note the given buffer may be only partially filled by the received data."
-
- ^ self primSocket: socketHandle
- receiveDataInto: aStringOrByteArray
- startingAt: 1
- count: aStringOrByteArray size
- !
Item was removed:
- ----- Method: OldSocket class>>ensureNetworkConnected (in category 'network initialization') -----
- ensureNetworkConnected
- "Try to ensure that an intermittent network connection, such as a dialup or ISDN line, is actually connected. This is necessary to make sure a server is visible in order to accept an incoming connection."
-
- "Socket ensureNetworkConnected"
-
- self initializeNetwork.
- Utilities informUser: 'Contacting domain name server...'
- during:
- [NetNameResolver addressForName: 'bogusNameToForceDNSToBeConsulted.org'
- timeout: 30]!
Item was removed:
- ----- Method: OldSocket>>connectTo:port: (in category 'connection open/close') -----
- connectTo: hostAddress port: port
- "Initiate a connection to the given port at the given host address. This operation will return immediately; follow it with waitForConnectionUntil: to wait until the connection is established."
-
- | status |
- status := self primSocketConnectionStatus: socketHandle.
- (status == Unconnected)
- ifFalse: [self error: 'Socket status must Unconnected before opening a new connection'].
-
- self primSocket: socketHandle connectTo: hostAddress port: port.
- !
Item was removed:
- ----- Method: HTTPSocket>>logToTranscript (in category 'as yet unclassified') -----
- logToTranscript
-
- ^LogToTranscript == true!
Item was removed:
- ----- Method: HTTPSocket>>redirect (in category 'as yet unclassified') -----
- redirect
- "See if the header has a 'Location: url CrLf' in it. If so, return the new URL of this page. tk 6/24/97 18:03"
-
- | this |
- 1 to: headerTokens size do: [:ii |
- this := headerTokens at: ii.
- (this first asLowercase = $l and: [this asLowercase = 'location:']) ifTrue: [
- ^ (headerTokens at: ii+1)]].
- ^ nil "not found"
- !
Item was removed:
- ----- Method: OldSocket>>listenOn: (in category 'connection open/close') -----
- listenOn: port
- "Listen for a connection on the given port. This operation will return immediately; follow it with waitForConnectionUntil: to wait until a connection is established."
-
- | status |
- status := self primSocketConnectionStatus: socketHandle.
- (status == Unconnected)
- ifFalse: [self error: 'Socket status must Unconnected before listening for a new connection'].
-
- self primSocket: socketHandle listenOn: port.
- !
Item was removed:
- ----- Method: HTTPSocket class>>retry:asking:ifGiveUp: (in category 'utilities') -----
- retry: tryBlock asking: troubleString ifGiveUp: abortActionBlock
- "Execute the given block. If it evaluates to true, return true. If it evaluates to false, prompt the user with the given string to see if he wants to try again. If not, evaluate the abortActionBlock and return false."
-
- | response |
- [tryBlock value] whileFalse: [
- | sema |
- sema := Semaphore new.
- WorldState addDeferredUIMessage: [
- response := UIManager default chooseFrom: #('Retry' 'Give Up')
- title: troubleString.
- sema signal.
- ].
- sema wait.
- response = 2 ifTrue: [abortActionBlock value. ^ false]].
- ^ true
- !
Item was removed:
- ----- Method: OldSocket>>primSocketRemotePort: (in category 'primitives') -----
- primSocketRemotePort: socketID
- "Return the remote port for this socket, or zero if no connection has been made."
-
- <primitive: 'primitiveSocketRemotePort' module: 'SocketPlugin'>
- self primitiveFailed
- !
Item was removed:
- ----- Method: HTTPSocket class>>md5Hash: (in category 'digest') -----
- md5Hash: aString
- "Answer hash of aString as lowercase 32 digit hex String.
- There are several providers of MD5 hash ..."
- "(self md5Hash: 'user:realm:passwd') = '007e68e539ed680c24f6d9a370f3bcb1'"
- | hash |
- hash := Smalltalk at: #CMD5Hasher ifPresent: [:cls |
- cls hashMessage: aString].
- hash ifNil: [
- hash := Smalltalk at: #TCryptoRandom ifPresent: [:cls |
- (cls basicNew md5HashMessage: aString) asInteger]].
- hash ifNotNil: [
- hash := hash hex asLowercase.
- (hash beginsWith: '16r') ifTrue: [hash := hash allButFirst: 3].
- hash := hash padded: #left to: 32 with: $0].
- ^hash!
Item was removed:
- ----- Method: OldSocket class>>ping: (in category 'utilities') -----
- ping: hostName
- "Ping the given host. Useful for checking network connectivity. The host must be running a TCP echo server."
-
- "Socket ping: 'squeak.cs.uiuc.edu'"
-
- | tcpPort sock serverAddr startTime echoTime |
- tcpPort := 7. "7 = echo port, 13 = time port, 19 = character generator port"
- self initializeNetwork.
- serverAddr := NetNameResolver addressForName: hostName timeout: 10.
- serverAddr = nil
- ifTrue: [^self inform: 'Could not find an address for ' , hostName].
- sock := self new.
- sock connectTo: serverAddr port: tcpPort.
-
- [sock waitForConnectionUntil: (self deadlineSecs: 10).
- sock isConnected]
- whileFalse:
- [(self confirm: 'Continue to wait for connection to ' , hostName , '?')
- ifFalse:
- [sock destroy.
- ^self]].
- sock sendData: 'echo!!'.
- startTime := Time millisecondClockValue.
-
- [sock waitForDataUntil: (self deadlineSecs: 15).
- sock dataAvailable]
- whileFalse:
- [(self confirm: 'Packet sent but no echo yet; keep waiting?')
- ifFalse:
- [sock destroy.
- ^self]].
- echoTime := Time millisecondClockValue - startTime.
- sock destroy.
- self inform: hostName , ' responded in ' , echoTime printString
- , ' milliseconds'!
Item was removed:
- ----- Method: HTTPSocket class>>digestFrom:method:url:user:password: (in category 'digest') -----
- digestFrom: sock method: method url: url user: user password: password
- "RFC2069"
- | auth fields realm nonce uri a1 a2 response |
- sock responseCode = '401' ifFalse: [^nil].
- auth := sock getHeader: 'www-authenticate'.
- (auth asLowercase beginsWith: 'digest') ifFalse: [^nil].
-
- fields := (((auth allButFirst: 6) findTokens: ', ') collect: [:ea |
- (ea copyUpTo: $=) asLowercase -> (ea copyAfter: $=) withoutQuoting]) as: Dictionary.
-
- realm := fields at: 'realm'.
- nonce := fields at: 'nonce'.
- uri := url readStream upToAll: '://'; skipTo: $/; skip: -1; upTo: $#.
- a1 := self md5Hash: user, ':', realm, ':', password.
- a2 := self md5Hash: method, ':', uri.
- a1 ifNil: [^nil "no MD5 support"].
- response := self md5Hash: a1, ':', nonce, ':', a2.
-
- ^String streamContents: [:digest |
- digest
- nextPutAll: 'username="', user, '"';
- nextPutAll: ', realm="', realm, '"';
- nextPutAll: ', nonce="', nonce, '"';
- nextPutAll: ', uri="', uri, '"';
- nextPutAll: ', response="', response, '"'.
- fields at: 'opaque' ifPresent: [:opaque |
- digest nextPutAll: ', opaque="', opaque, '"'].
- ]
- !
Item was removed:
- ----- Method: HTTPSocket class>>addHTTPProxyPreferences (in category 'proxy settings') -----
- addHTTPProxyPreferences
- " This method will add to Squeak the HTTP Proxy preferences. "
- Preferences addTextPreference: #httpProxyServer category: #'http proxy' default: '' balloonHelp: 'HTTP Proxy Server. Leave blank if you don''t want to use a Proxy'.
- Preferences addNumericPreference: #httpProxyPort category: #'http proxy' default: 80 balloonHelp: 'HTTP Proxy Port'.!
Item was removed:
- ----- Method: OldSocket class>>timeTestUDP (in category 'examples') -----
- timeTestUDP
- "Socket timeTestUDP"
-
- | serverName serverAddr s |
- Transcript show: 'initializing network ... '.
- self initializeNetworkIfFail: [^Transcript show: 'failed'].
- Transcript
- show: 'ok';
- cr.
- serverName := UIManager default request: 'What is your time server?'
- initialAnswer: 'localhost'.
- serverName isEmpty
- ifTrue:
- [^Transcript
- show: 'never mind';
- cr].
- serverAddr := NetNameResolver addressForName: serverName timeout: 10.
- serverAddr = nil
- ifTrue: [self error: 'Could not find the address for ' , serverName].
- s := self newUDP. "a 'random' port number will be allocated by the system"
- "Send a packet to the daytime port and it will reply with the current date."
- Transcript
- show: '---------- Sending datagram from port ' , s port printString
- , ' ----------';
- cr.
- s
- sendData: '!!'
- toHost: serverAddr
- port: 13. "13 is the daytime service"
- Transcript show: 'the time server reports: ' , s getResponseNoLF.
- s closeAndDestroy.
- Transcript
- show: '---------- Socket closed ----------';
- cr!
Item was removed:
- ----- Method: OldSocket>>waitForDisconnectionUntil: (in category 'waiting') -----
- waitForDisconnectionUntil: deadline
- "Wait up until the given deadline for the the connection to be broken. Return true if it is broken by the deadline, false if not."
- "Note: The client should know the the connect is really going to be closed (e.g., because he has called 'close' to send a close request to the other end) before calling this method.
- JMM 00/5/17 note that other end can close which will terminate wait"
-
- | extraBytes status |
- extraBytes := 0.
- status := self primSocketConnectionStatus: socketHandle.
- [((status = Connected) or: [(status = ThisEndClosed)]) and:
- [Time millisecondClockValue < deadline]] whileTrue: [
- self dataAvailable
- ifTrue: [extraBytes := extraBytes + self discardReceivedData].
- semaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue).
- status := self primSocketConnectionStatus: socketHandle].
-
- extraBytes > 0
- ifTrue: [self inform: 'Discarded ', extraBytes printString, ' bytes while closing connection.'].
-
- ^ status ~= Connected
- !
Item was removed:
- ----- Method: HTTPSocket class>>initHTTPSocket:ifError: (in category 'utilities') -----
- initHTTPSocket: httpUrl 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."
-
- ^self initHTTPSocket: httpUrl wait: self standardDeadline ifError: aBlock!
Item was removed:
- ----- Method: OldSocket>>sendUDPData:toHost:port: (in category 'datagrams') -----
- sendUDPData: aStringOrByteArray toHost: hostAddress port: portNumber
- "Send a UDP packet containing the given data to the specified host/port."
-
- | bytesToSend bytesSent count |
- bytesToSend := aStringOrByteArray size.
- bytesSent := 0.
- [bytesSent < bytesToSend] whileTrue:
- [(self waitForSendDoneUntil: (self class deadlineSecs: 20))
- ifFalse: [self error: 'send data timeout; data not sent'].
- count := self
- primSocket: socketHandle
- sendUDPData: aStringOrByteArray
- toHost: hostAddress
- port: portNumber
- startIndex: bytesSent + 1
- count: bytesToSend - bytesSent.
- bytesSent := bytesSent + count].
- ^bytesSent!
Item was removed:
- ----- Method: OldSimpleClientSocket class>>remoteCursorReceiver (in category 'remote cursor example') -----
- remoteCursorReceiver
- "Wait for a connection, then display data sent by the client until the client closes the stream. This server process is usually started first (optionally in a forked process), then the sender process is started (optionally on another machine). Note this machine's address, which is printed in the transcript, since the sender process will ask for it."
- "[SimpleClientSocket remoteCursorReceiver] fork"
-
- | sock response |
- Transcript show: 'starting remote cursor receiver'; cr.
- Transcript show: 'initializing network'; cr.
- Socket initializeNetwork.
- Transcript show: 'my address is ', NetNameResolver localAddressString; cr.
- Transcript show: 'opening connection'; cr.
- sock := OldSimpleClientSocket new.
- sock listenOn: 54323.
- sock waitForConnectionUntil: (Socket deadlineSecs: 60).
- sock isConnected
- ifFalse: [
- sock destroy.
- Transcript show: 'remote cursor receiver did not receive a connection in 60 seconds; aborting.'.
- ^ self].
- Transcript show: 'connection established'; cr.
-
- [sock isConnected]
- whileTrue: [
- sock dataAvailable
- ifTrue: [
- response := sock getResponse.
- response displayOn: Display at: 10 at 10]
- ifFalse: [
- "if no data available, let other processes run for a while"
- (Delay forMilliseconds: 20) wait]].
-
- sock destroy.
- Transcript show: 'remote cursor receiver done'; cr.
- !
Item was removed:
- ----- Method: OldSocket>>setPort: (in category 'datagrams') -----
- setPort: port
- "Associate a local port number with a UDP socket. Not applicable to TCP sockets."
-
- self primSocket: socketHandle setPort: port.
- !
Item was removed:
- ----- Method: HTTPSocket class>>expandUrl:ip:port: (in category 'utilities') -----
- expandUrl: newUrl ip: byteArrayIP port: portNum
- (newUrl beginsWith: '../') ifTrue: [^self ip: byteArrayIP port: portNum urlPath: (newUrl allButFirst: 2)].
- (newUrl beginsWith: '/') ifTrue: [^self ip: byteArrayIP port: portNum urlPath: newUrl].
- ^newUrl!
Item was removed:
- ----- Method: OldSocket class>>tcpCreateIfFail: (in category 'instance creation') -----
- tcpCreateIfFail: failBlock
- "Attempt to create a new socket. If successful, return the new socket. Otherwise, return the result of evaluating the given block. Socket creation can fail if the network isn't available or if there are not sufficient resources available to create another socket."
-
- | sock |
- sock := super new initialize: TCPSocketType.
- sock isValid ifFalse: [^ failBlock value].
- ^ sock
- !
Item was removed:
- ----- Method: OldSimpleClientSocket class>>forkingRemoteCursorSender (in category 'remote cursor example') -----
- forkingRemoteCursorSender
- "This is the client side of a test that sends samples of the local input sensor state to the server, which may be running on a local or remote host. This method opens the connection, then forks a process to send the cursor data. Data is sent continuously until the user clicks in a 20x20 pixel square at the top-left corner of the display. The server should be started first. Note the server's address, since this method will prompt you for it."
- "SimpleClientSocket forkingRemoteCursorSender"
-
- | sock addr stopRect |
- Transcript show: 'starting remote cursor sender'; cr.
- Transcript show: 'initializing network'; cr.
- Socket initializeNetwork.
- addr := NetNameResolver promptUserForHostAddress.
- Transcript show: 'opening connection'; cr.
- sock := OldSimpleClientSocket new.
- sock connectTo: addr port: 54323.
- sock waitForConnectionUntil: self standardDeadline.
- (sock isConnected) ifFalse: [self error: 'sock not connected'].
- Transcript show: 'connection established'; cr.
-
- stopRect := 0 at 0 corner: 20 at 20. "click in this rectangle to stop sending"
- Display reverse: stopRect.
- ["the sending process"
- [(stopRect containsPoint: Sensor cursorPoint) and:
- [Sensor anyButtonPressed]]
- whileFalse: [
- sock sendCommand: self sensorStateString.
- (Delay forMilliseconds: 20) wait].
-
- sock waitForSendDoneUntil: self standardDeadline.
- sock destroy.
- Transcript show: 'remote cursor sender done'; cr.
- Display reverse: stopRect.
- ] fork.
- !
Item was removed:
- ----- 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 removed:
- ----- Method: OldSocket>>getOption: (in category 'other') -----
- getOption: aName
- "Get options on this socket, see Unix man pages for values for
- sockets, IP, TCP, UDP. IE SO:=KEEPALIVE
- returns an array, element one is an status number (0 ok, -1 read only option)
- element two is the resulting of the requested option"
-
- (socketHandle == nil or: [self isValid not])
- ifTrue: [self error: 'Socket status must valid before getting an option'].
- ^self primSocket: socketHandle getOption: aName
-
- "| foo options |
- Socket initializeNetwork.
- foo := Socket newTCP.
- foo connectTo: (NetNameResolver addressFromString: '192.168.1.1') port: 80.
- foo waitForConnectionUntil: (Socket standardDeadline).
-
- options := {
- 'SO:=DEBUG'. 'SO:=REUSEADDR'. 'SO:=REUSEPORT'. 'SO:=DONTROUTE'.
- 'SO:=BROADCAST'. 'SO:=SNDBUF'. 'SO:=RCVBUF'. 'SO:=KEEPALIVE'.
- 'SO:=OOBINLINE'. 'SO:=PRIORITY'. 'SO:=LINGER'. 'SO:=RCVLOWAT'.
- 'SO:=SNDLOWAT'. 'IP:=TTL'. 'IP:=HDRINCL'. 'IP:=RCVOPTS'.
- 'IP:=RCVDSTADDR'. 'IP:=MULTICAST:=IF'. 'IP:=MULTICAST:=TTL'.
- 'IP:=MULTICAST:=LOOP'. 'UDP:=CHECKSUM'. 'TCP:=MAXSEG'.
- 'TCP:=NODELAY'. 'TCP:=ABORT:=THRESHOLD'. 'TCP:=CONN:=NOTIFY:=THRESHOLD'.
- 'TCP:=CONN:=ABORT:=THRESHOLD'. 'TCP:=NOTIFY:=THRESHOLD'.
- 'TCP:=URGENT:=PTR:=TYPE'}.
-
- 1 to: options size do: [:i | | fum |
- fum :=foo getOption: (options at: i).
- Transcript show: (options at: i),fum printString;cr].
-
- foo := Socket newUDP.
- foo setPeer: (NetNameResolver addressFromString: '192.168.1.9') port: 7.
- foo waitForConnectionUntil: (Socket standardDeadline).
-
- 1 to: options size do: [:i | | fum |
- fum :=foo getOption: (options at: i).
- Transcript show: (options at: i),fum printString;cr].
- "!
Item was removed:
- ----- Method: OldSocket>>dataAvailable (in category 'queries') -----
- dataAvailable
- "Return true if this socket has unread received data."
-
- socketHandle == nil ifTrue: [^ false].
- ^ self primSocketReceiveDataAvailable: socketHandle
- !
Item was removed:
- ----- Method: OldSocket>>primSocket:setPort: (in category 'primitives') -----
- primSocket: socketID setPort: port
- "Set the local port associated with a UDP socket.
- Note: this primitive is overloaded. The primitive will not fail on a TCP socket, but
- the effects will not be what was desired. Best solution would be to split Socket into
- two subclasses, TCPSocket and UDPSocket."
-
- <primitive: 'primitiveSocketListenWithOrWithoutBacklog' module: 'SocketPlugin'>
- self primitiveFailed
- !
Item was removed:
- ----- Method: OldSocket>>primSocket:sendUDPData:toHost:port:startIndex:count: (in category 'primitives') -----
- primSocket: socketID sendUDPData: aStringOrByteArray toHost: hostAddress port: portNumber startIndex: startIndex count: count
- "Send data to the remote host through the given socket starting with the given byte index of the given byte array. The data sent is 'pushed' immediately. Return the number of bytes of data actually sent; any remaining data should be re-submitted for sending after the current send operation has completed."
- "Note: In general, it many take several sendData calls to transmit a large data array since the data is sent in send-buffer-sized chunks. The size of the send buffer is determined when the socket is created."
-
- <primitive: 'primitiveSocketSendUDPDataBufCount' module: 'SocketPlugin'>
- self primitiveFailed
-
- !
Item was removed:
- ----- Method: OldSocket>>semaphore (in category 'accessing') -----
- semaphore
- ^semaphore!
Item was removed:
- ----- Method: OldSocket class>>registryThreshold: (in category 'registry') -----
- registryThreshold: aNumber
- "Return the registry threshold above which socket creation may fail due to too many already open sockets. If the threshold is reached, a full GC will be issued if the creation of a socket fails."
- RegistryThreshold := aNumber!
Item was removed:
- ----- Method: OldSocket>>primSocketError: (in category 'primitives') -----
- primSocketError: socketID
- "Return an integer encoding the most recent error on this socket. Zero means no error."
-
- <primitive: 'primitiveSocketError' module: 'SocketPlugin'>
- self primitiveFailed
- !
Item was removed:
- ----- Method: OldSimpleClientSocket class>>remoteCursorTest (in category 'remote cursor example') -----
- remoteCursorTest
- "This version of the remote cursor test runs both the client and the server code in the same loop."
- "SimpleClientSocket remoteCursorTest"
-
- | sock1 sock2 samplesToSend t samplesSent |
- Transcript show: 'starting remote cursor test'; cr.
- Transcript show: 'initializing network'; cr.
- Socket initializeNetwork.
- Transcript show: 'opening connection'; cr.
- sock1 := OldSimpleClientSocket new.
- sock2 := OldSimpleClientSocket new.
- sock1 listenOn: 54321.
- sock2 connectTo: (NetNameResolver localHostAddress) port: 54321.
- sock1 waitForConnectionUntil: self standardDeadline.
- sock2 waitForConnectionUntil: self standardDeadline.
- (sock1 isConnected) ifFalse: [self error: 'sock1 not connected'].
- (sock2 isConnected) ifFalse: [self error: 'sock2 not connected'].
- Transcript show: 'connection established'; cr.
-
- samplesToSend := 100.
- t := Time millisecondsToRun: [ | done |
- samplesSent := 0.
- done := false.
- [done]
- whileFalse: [
- (sock1 sendDone and: [samplesSent < samplesToSend]) ifTrue: [
- sock1 sendCommand: self sensorStateString.
- samplesSent := samplesSent + 1].
- sock2 dataAvailable ifTrue: [
- sock2 getResponse displayOn: Display at: 10 at 10].
- done := samplesSent = samplesToSend]].
- sock1 destroy.
- sock2 destroy.
- Transcript show: 'remote cursor test done'; cr.
- Transcript show:
- samplesSent printString, ' samples sent in ',
- t printString, ' milliseconds'; cr.
- Transcript show: ((samplesSent * 1000) // t) printString, ' samples/sec'; cr.
- !
Item was removed:
- ----- Method: HTTPSocket>>getResponseUpTo: (in category 'as yet unclassified') -----
- getResponseUpTo: markerString
- "Keep reading until the marker is seen. Return three parts: header, marker, beginningOfData. Fails if no marker in first 2000 chars."
-
- | buf position bytesRead tester mm tries |
- buf := String new: 2000.
- position := 0.
- tester := 1. mm := 1.
- tries := 3.
- [tester := tester - markerString size + 1 max: 1. "rewind a little, in case the marker crosses a read boundary"
- tester to: position do: [:tt |
- (buf at: tt) = (markerString at: mm) ifTrue: [mm := mm + 1] ifFalse: [mm := 1].
- "Not totally correct for markers like xx0xx"
- mm > markerString size ifTrue: ["got it"
- ^ Array with: (buf copyFrom: 1 to: tt+1-mm)
- with: markerString
- with: (buf copyFrom: tt+1 to: position)]].
- tester := 1 max: position. "OK if mm in the middle"
- (position < buf size) & (self isConnected | self dataAvailable)
- & ((tries := tries - 1) >= 0)] whileTrue: [
- (self waitForDataUntil: (Socket deadlineSecs: 5)) ifFalse: [
- Transcript show: ' <response was late> '].
- bytesRead := self primSocket: socketHandle receiveDataInto: buf
- startingAt: position + 1 count: buf size - position.
- position := position + bytesRead].
-
- ^ Array with: (buf copyFrom: 1 to position)
- with: ''
- with: '' "Marker not found and connection closed"
- !
Item was removed:
- ----- Method: OldSocket class>>remoteTestClientTCPOpenClosePutGet (in category 'examples') -----
- remoteTestClientTCPOpenClosePutGet
- "Socket remoteTestClientTCPOpenClosePutGet"
-
- | number bytesExpected sendBuf receiveBuf t1 serverName |
- Transcript
- show: 'starting client/server TCP test';
- cr.
- Transcript show: 'initializing network ... '.
- self initializeNetworkIfFail: [^Transcript show: 'failed'].
- Transcript
- show: 'ok';
- cr.
- serverName := UIManager default request: 'What is your remote Test Server?'
- initialAnswer: ''.
- number := 1000.
- bytesExpected := 20000.
- sendBuf := String new: 80 withAll: $x.
- receiveBuf := String new: 50000.
- t1 := Time millisecondsToRun:
- [number timesRepeat:
- [ | socket checkLength bytesReceived |
- socket := self newTCP.
- socket connectTo: (NetNameResolver addressFromString: serverName)
- port: 54321.
- socket waitForConnectionUntil: self standardDeadline.
- socket sendData: sendBuf.
- socket waitForSendDoneUntil: (self deadlineSecs: 5).
- socket waitForDataUntil: (self deadlineSecs: 5).
- bytesReceived := 0.
- [bytesReceived < bytesExpected] whileTrue:
- [checkLength := socket receiveDataInto: receiveBuf.
- bytesReceived := bytesReceived + checkLength].
- socket closeAndDestroy]].
- Transcript
- cr;
- show: 'connects/get/put/close per second '
- , (number / t1 * 1000.0) printString;
- cr!
Item was removed:
- ----- Method: OldSocket>>sendSomeData:startIndex:count: (in category 'sending-receiving') -----
- sendSomeData: aStringOrByteArray startIndex: startIndex count: count
- "Send up to count bytes of the given data starting at the given index. Answer the number of bytes actually sent."
-
- "Note: This operation may have to be repeated multiple times to send a large amount of data."
-
- | bytesSent |
- (self waitForSendDoneUntil: (self class deadlineSecs: 20))
- ifTrue:
- [bytesSent := self
- primSocket: socketHandle
- sendData: aStringOrByteArray
- startIndex: startIndex
- count: count]
- ifFalse: [self error: 'send data timeout; data not sent'].
- ^bytesSent!
Item was removed:
- ----- Method: OldSocket class>>udpCreateIfFail: (in category 'instance creation') -----
- udpCreateIfFail: failBlock
- "Attempt to create a new socket. If successful, return the new socket. Otherwise, return the result of evaluating the given block. Socket creation can fail if the network isn't available or if there are not sufficient resources available to create another socket."
-
- | sock |
- sock := super new initialize: UDPSocketType.
- sock isValid ifFalse: [^ failBlock value].
- ^ sock
- !
Item was removed:
- ----- Method: OldSocket class>>clientServerTestUDP (in category 'examples') -----
- clientServerTestUDP
- "Socket clientServerTestUDP"
-
- "Performa 6400/200, Linux-PPC 2.1.24:
- client/server UDP test done; time = 2820
- 2500 packets, 10000000 bytes sent (3546 kBytes/sec)
- 2500 packets, 10000000 bytes received (3546 kBytes/sec)
- 4000 bytes/packet, 886 packets/sec, 0 packets dropped"
-
- | sock1 sock2 bytesToSend sendBuf receiveBuf done bytesSent bytesReceived packetsSent packetsReceived t |
- Transcript
- show: 'starting client/server UDP test';
- cr.
- Transcript show: 'initializing network ... '.
- self initializeNetworkIfFail: [^Transcript show: 'failed'].
- Transcript
- show: 'ok';
- cr.
- Transcript
- show: 'creating endpoints';
- cr.
- sock1 := self newUDP. "the sender"
- sock2 := self newUDP. "the recipient"
- sock2 setPort: 54321.
- sock1 setPeer: NetNameResolver localHostAddress port: sock2 port.
- Transcript
- show: 'endpoints created';
- cr.
- bytesToSend := 10000000.
- sendBuf := String new: 4000 withAll: $x.
- receiveBuf := String new: 50000.
- done := false.
- bytesSent := bytesReceived := packetsSent := packetsReceived := 0.
- t := Time millisecondsToRun:
- [[done] whileFalse:
- [(sock1 sendDone and: [bytesSent < bytesToSend])
- ifTrue:
- [packetsSent := packetsSent + 1.
- bytesSent := bytesSent + (sock1 sendData: sendBuf)].
- sock2 dataAvailable
- ifTrue:
- [packetsReceived := packetsReceived + 1.
- bytesReceived := bytesReceived + (sock2 receiveDataInto: receiveBuf)].
- done := bytesSent >= bytesToSend].
- sock1 waitForSendDoneUntil: self standardDeadline.
- bytesReceived := bytesReceived + sock2 discardReceivedData].
- Transcript
- show: 'closing endpoints';
- cr.
- sock1 close.
- sock2 close.
- sock1 destroy.
- sock2 destroy.
- Transcript
- show: 'client/server UDP test done; time = ' , t printString;
- cr.
- Transcript
- show: packetsSent printString , ' packets, ' , bytesSent printString
- , ' bytes sent (' , (bytesSent * 1000 // t) printString
- , ' Bytes/sec)';
- cr.
- Transcript
- show: packetsReceived printString , ' packets, '
- , bytesReceived printString , ' bytes received ('
- , (bytesReceived * 1000 // t) printString , ' Bytes/sec)';
- cr.
- Transcript
- show: (bytesSent // packetsSent) printString , ' bytes/packet, '
- , (packetsReceived * 1000 // t) printString , ' packets/sec, '
- , (packetsSent - packetsReceived) printString , ' packets dropped';
- cr!
Item was removed:
- ----- Method: OldSocket>>printOn: (in category 'printing') -----
- printOn: aStream
-
- super printOn: aStream.
- aStream nextPutAll: '[', self statusString, ']'.
- !
Item was removed:
- ----- Method: OldSocket>>primSocket:listenOn:backlogSize:interface: (in category 'primitives') -----
- primSocket: aHandle listenOn: portNumber backlogSize: backlog interface: ifAddr
- "Primitive. Set up the socket to listen on the given port.
- Will be used in conjunction with #accept only."
- <primitive: 'primitiveSocketListenOnPortBacklogInterface' module: 'SocketPlugin'>
- self destroy. "Accept not supported so clean up"!
Item was removed:
- ----- Method: OldSocket class>>clientServerTestUDP2 (in category 'examples') -----
- clientServerTestUDP2
- "Socket clientServerTestUDP2"
-
- | sock1 sock2 bytesToSend sendBuf receiveBuf t done bytesSent bytesReceived packetsSent packetsReceived |
- Transcript
- show: 'starting client/server UDP test';
- cr.
- Transcript show: 'initializing network ... '.
- self initializeNetworkIfFail: [^Transcript show: 'failed'].
- Transcript
- show: 'ok';
- cr.
- Transcript
- show: 'creating endpoints';
- cr.
- sock1 := self newUDP. "the sender"
- sock2 := self newUDP. "the recipient"
- sock2 setPort: 54321.
- Transcript
- show: 'endpoints created';
- cr.
- bytesToSend := 100000000.
- sendBuf := String new: 4000 withAll: $x.
- receiveBuf := String new: 2000.
- done := false.
- bytesSent := bytesReceived := packetsSent := packetsReceived := 0.
- t := Time millisecondsToRun:
- [ | datagramInfo |
- [done] whileFalse:
- [(sock1 sendDone and: [bytesSent < bytesToSend])
- ifTrue:
- [packetsSent := packetsSent + 1.
- bytesSent := bytesSent + (sock1
- sendData: sendBuf
- toHost: NetNameResolver localHostAddress
- port: sock2 port)].
- sock2 dataAvailable
- ifTrue:
- [packetsReceived := packetsReceived + 1.
- datagramInfo := sock2 receiveUDPDataInto: receiveBuf.
- bytesReceived := bytesReceived + (datagramInfo at: 1)].
- done := bytesSent >= bytesToSend].
- sock1 waitForSendDoneUntil: self standardDeadline.
- bytesReceived := bytesReceived + sock2 discardReceivedData].
- Transcript
- show: 'closing endpoints';
- cr.
- sock1 close.
- sock2 close.
- sock1 destroy.
- sock2 destroy.
- Transcript
- show: 'client/server UDP test done; time = ' , t printString;
- cr.
- Transcript
- show: packetsSent printString , ' packets, ' , bytesSent printString
- , ' bytes sent (' , (bytesSent * 1000 // t) printString
- , ' Bytes/sec)';
- cr.
- Transcript
- show: packetsReceived printString , ' packets, '
- , bytesReceived printString , ' bytes received ('
- , (bytesReceived * 1000 // t) printString , ' Bytes/sec)';
- cr.
- Transcript
- show: (bytesSent // packetsSent) printString , ' bytes/packet, '
- , (packetsReceived * 1000 // t) printString , ' packets/sec, '
- , (packetsSent - packetsReceived) printString , ' packets dropped';
- cr!
Item was removed:
- ----- Method: OldSocket class>>remoteTestServerTCPUsingAccept (in category 'examples') -----
- remoteTestServerTCPUsingAccept
- "The version of #remoteTestServer using the BSD style accept() mechanism."
-
- "Socket remoteTestServerTCPUsingAccept"
-
- | buffer server socket |
- Transcript show: 'initializing network ... '.
- self initializeNetworkIfFail: [^Transcript show: 'failed'].
- Transcript
- show: 'ok';
- cr.
- server := self newTCP.
- server listenOn: 54321 backlogSize: 4.
- server isValid ifFalse: [self error: 'Accept() is not supported'].
- Transcript
- show: 'server endpoint created -- run client test in other image';
- cr.
- buffer := String new: 40000.
- 10 timesRepeat:
- [ | n |
- socket := server waitForAcceptUntil: (self deadlineSecs: 300).
- [socket isConnected] whileTrue:
- [socket dataAvailable
- ifTrue:
- [n := socket receiveDataInto: buffer.
- socket sendData: buffer count: n]]].
- socket closeAndDestroy.
- server closeAndDestroy.
- Transcript
- cr;
- show: 'server endpoint destroyed';
- cr!
Item was removed:
- ----- Method: OldSocket>>disconnect (in category 'connection open/close') -----
- disconnect
- "Break this connection, no matter what state it is in. Data that has been sent but not received will be lost."
-
- self primSocketAbortConnection: socketHandle.
- !
Item was removed:
- ----- Method: OldSocket>>register (in category 'registry') -----
- register
- ^self class register: self!
Item was removed:
- ----- Method: OldSimpleClientSocket class>>sensorStateString (in category 'remote cursor example') -----
- sensorStateString
- "SimpleClientSocket sensorStateString"
-
- | pt buttons s |
- pt := Sensor cursorPoint.
- buttons := Sensor primMouseButtons.
- s := WriteStream on: (String new: 100).
- s nextPutAll: pt x printString.
- s space.
- s nextPutAll: pt y printString.
- s space.
- s nextPutAll: buttons printString.
- ^ s contents
- !
Item was removed:
- ----- Method: OldSocket>>waitForDataUntil: (in category 'waiting') -----
- waitForDataUntil: deadline
- "Wait up until the given deadline for data to arrive. Return true if data arrives by the deadline, false if not."
-
- | dataArrived |
- [self isConnected &
- (dataArrived := self primSocketReceiveDataAvailable: socketHandle) not
- "Connection end and final data can happen fast, so test in this order"
- and: [Time millisecondClockValue < deadline]] whileTrue: [
- self readSemaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue)].
-
- ^ dataArrived
- !
Item was removed:
- ----- Method: OldSocket>>primSocket:sendData:startIndex:count: (in category 'primitives') -----
- primSocket: socketID sendData: aStringOrByteArray startIndex: startIndex count: count
- "Send data to the remote host through the given socket starting with the given byte index of the given byte array. The data sent is 'pushed' immediately. Return the number of bytes of data actually sent; any remaining data should be re-submitted for sending after the current send operation has completed."
- "Note: In general, it many take several sendData calls to transmit a large data array since the data is sent in send-buffer-sized chunks. The size of the send buffer is determined when the socket is created."
-
- <primitive: 'primitiveSocketSendDataBufCount' module: 'SocketPlugin'>
- self primitiveFailed
- !
Item was removed:
- ----- Method: OldSimpleClientSocket class>>simpleDateString: (in category 'POP mail example') -----
- simpleDateString: dateString
-
- | s |
- s := ReadStream on: dateString.
- s skipTo: $,. "scan thru first comma"
- s atEnd ifTrue: [s reset]. "no comma found; reset s"
- s skipSeparators.
- ^ (Date readFrom: s) mmddyyyy
- !
Item was removed:
- ----- Method: OldSocket>>sendDone (in category 'queries') -----
- sendDone
- "Return true if the most recent send operation on this socket has completed."
-
- socketHandle == nil ifTrue: [^ false].
- ^ self primSocketSendDone: socketHandle
- !
Item was removed:
- ----- Method: OldSocket>>primSocketRemoteAddress: (in category 'primitives') -----
- primSocketRemoteAddress: socketID
- "Return the remote host address for this socket, or zero if no connection has been made."
-
- <primitive: 'primitiveSocketRemoteAddress' module: 'SocketPlugin'>
- self primitiveFailed
- !
Item was removed:
- ----- Method: OldSocket>>isThisEndClosed (in category 'queries') -----
- isThisEndClosed
- "Return true if this socket had the this end closed."
-
- socketHandle == nil ifTrue: [^ false].
- ^ (self primSocketConnectionStatus: socketHandle) == ThisEndClosed
- !
Item was removed:
- ----- Method: OldSocket>>primSocketDestroy: (in category 'primitives') -----
- primSocketDestroy: socketID
- "Release the resources associated with this socket. If a connection is open, it is aborted."
-
- <primitive: 'primitiveSocketDestroy' module: 'SocketPlugin'>
- self primitiveFailed
- !
More information about the Packages
mailing list