The Trunk: System-tpr.1055.mcz

tim Rowledge uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-tpr.1055.mcz

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

Name: System-tpr.1055
Author: tpr
Time: 18 February 2019, 7:27:45.328716 pm
UUID: e5a22b14-e481-4ca2-bb73-06c231538511
Ancestors: System-tonyg.1054

Part of deprecating HTTPClient for 6.0
Stop using it and deprecate the actual class

=============== Diff against System-tonyg.1054 ===============

Item was removed:
- ----- Method: AutoStart class>>checkForPluginUpdate (in category 'updating') -----
- checkForPluginUpdate
- | pluginVersion updateURL |
- HTTPClient isRunningInBrowser
- ifFalse: [^false].
- pluginVersion := Smalltalk namedArguments
- at: (Smalltalk platformName copyWithout: Character space) asUppercase
- ifAbsent: [^false].
- updateURL := Smalltalk namedArguments
- at: 'UPDATE_URL'
- ifAbsent: [^false].
- ^SystemVersion check: pluginVersion andRequestPluginUpdate: updateURL!

Item was changed:
  ----- Method: AutoStart class>>processUpdates (in category 'updating') -----
  processUpdates
  "Process update files from a well-known update server.  This method is called at system startup time,   Only if the preference #updateFromServerAtStartup is true is the actual update processing undertaken automatically"
  | choice |
  (MCMcmUpdater updateFromServerAtStartup) ifTrue:
  [choice := UIManager default chooseFrom: #('Yes, Update' 'No, Not now' 'Don''t ask again')
  title: 'Shall I look for new code\updates on the server?' withCRs.
  choice = 1 ifTrue: [
  MCMcmUpdater updateFromServer].
  choice = 3 ifTrue: [
  MCMcmUpdater updateFromServerAtStartup: false.
+ self inform: 'Remember to save your image to make this setting permant']]!
- self inform: 'Remember to save your image to make this setting permant.']].
- ^false!

Item was changed:
  ----- Method: AutoStart class>>startUp: (in category 'initialization') -----
  startUp: resuming
  "The image is either being newly started (resuming is true), or it's just been snapshotted.
  If this has just been a snapshot, skip all the startup stuff."
 
  | startupParameters launchers |
  self active ifTrue: [^self].
  self active: true.
  resuming ifFalse: [^self].
 
- HTTPClient determineIfRunningInBrowser.
  startupParameters := Smalltalk namedArguments.
- (startupParameters includesKey: 'apiSupported' asUppercase )
- ifTrue: [
- HTTPClient browserSupportsAPI: ((startupParameters at: 'apiSupported' asUppercase) asUppercase = 'TRUE').
- HTTPClient isRunningInBrowser
- ifFalse: [HTTPClient isRunningInBrowser: true]].
 
  Project current world ifNotNil: [:w | w install. w firstHand position: 100 @ 100 ].
 
+ self processUpdates.
+
- "Some images might not have the UpdateStream package."
- ((self respondsTo: #checkForUpdates) and: [self checkForUpdates]) ifTrue: [^self].
- self checkForPluginUpdate.
  launchers := self installedLaunchers collect: [:launcher |
  launcher new].
  launchers do: [:launcher |
  launcher parameters: startupParameters].
  launchers do: [:launcher |
  Project current addDeferredUIMessage: [launcher startUp]]!

Item was removed:
- Object subclass: #HTTPClient
- instanceVariableNames: ''
- classVariableNames: 'BrowserSupportsAPI RunningInBrowser'
- poolDictionaries: ''
- category: 'System-Support'!

Item was removed:
- ----- Method: HTTPClient class>>browserSupportsAPI (in category 'class initialization') -----
- browserSupportsAPI
- ^BrowserSupportsAPI == true!

Item was removed:
- ----- Method: HTTPClient class>>browserSupportsAPI: (in category 'class initialization') -----
- browserSupportsAPI: aBoolean
- BrowserSupportsAPI := aBoolean!

Item was removed:
- ----- Method: HTTPClient class>>composeMailTo:subject:body: (in category 'utilities') -----
- composeMailTo: address subject: subject body: body
- "HTTPClient composeMailTo: '[hidden email]' subject: 'test subject' body: 'message' "
- | mailTo |
- mailTo := WriteStream on: String new.
- mailTo nextPutAll: 'mailto:'.
- mailTo
- nextPutAll: address;
- nextPut: $?.
- subject isEmptyOrNil
- ifFalse: [mailTo nextPutAll: 'subject='; nextPutAll: subject; nextPut: $&].
- body isEmptyOrNil
- ifFalse: [mailTo nextPutAll: 'body='; nextPutAll: body].
-
- self httpGet: mailTo contents!

Item was removed:
- ----- Method: HTTPClient class>>determineIfRunningInBrowser (in category 'class initialization') -----
- determineIfRunningInBrowser
- "HTTPClient determineIfRunningInBrowser"
-
- RunningInBrowser := StandardFileStream isRunningAsBrowserPlugin
- !

Item was removed:
- ----- Method: HTTPClient class>>exampleMailTo (in category 'examples') -----
- exampleMailTo
- "HTTPClient exampleMailTo"
-
- HTTPClient mailTo: '[hidden email]' message: 'A test message from within Squeak'
- !

Item was removed:
- ----- Method: HTTPClient class>>examplePostArgs (in category 'examples') -----
- examplePostArgs
- "HTTPClient examplePostArgs"
-
- | args result |
- args := Dictionary new
- at: 'arg1' put: #('val1');
- at: 'arg2' put: #('val2');
- yourself.
- result := HTTPClient httpPostDocument: 'http://www.squeaklet.com/cgi-bin/thrd.pl [^]' args: args.
- Transcript show: result content; cr; cr.
-
- !

Item was removed:
- ----- Method: HTTPClient class>>examplePostMultipart (in category 'examples') -----
- examplePostMultipart
- "HTTPClient examplePostMultipart"
-
- | args result |
- args := Dictionary new
- at: 'arg1' put: #('val1');
- at: 'arg2' put: #('val2');
- yourself.
- result := HTTPClient httpPostMultipart: 'http://www.squeaklet.com/cgi-bin/thrd.pl'  args: args.
- Transcript show: result content; cr; cr.
-
- !

Item was removed:
- ----- Method: HTTPClient class>>getDirectoryListing: (in category 'utilities') -----
- getDirectoryListing: dirListURL
- "HTTPClient getDirectoryListing: 'http://www.squeakalpha.org/uploads' "
- | answer ftpEntries |
- " answer := self
- httpPostDocument: dirListURL
- args: Dictionary new."
- "Workaround for Mac IE problem"
- answer := self httpGetDocument: dirListURL.
- answer isString
- ifTrue: [^self error: 'Listing failed: ' , answer]
- ifFalse: [answer := answer content].
- answer first == $<
- ifTrue: [self error: 'Listing failed: ' , answer].
- ftpEntries := answer findTokens: String crlf.
- ^ ftpEntries
- collect:[:ftpEntry | ServerDirectory parseFTPEntry: ftpEntry]
- thenSelect: [:entry | entry notNil]!

Item was removed:
- ----- Method: HTTPClient class>>httpGet: (in category 'post/get') -----
- httpGet: url
- | document |
- document := self httpGetDocument: url.
- ^(document isString)
- ifTrue: [
- "strings indicate errors"
- document]
- ifFalse: [(RWBinaryOrTextStream with: document content) reset]!

Item was removed:
- ----- Method: HTTPClient class>>httpGetDocument: (in category 'post/get') -----
- httpGetDocument: url
- | stream content |
- ^self shouldUsePluginAPI
- ifTrue: [
- stream := FileStream requestURLStream: url ifError: [self error: 'Error in get from ' , url printString].
- stream ifNil: [^''].
- stream position: 0.
- content := stream upToEnd.
- stream close.
- MIMEDocument content: content]
- ifFalse: [HTTPSocket httpGetDocument: url]!

Item was removed:
- ----- Method: HTTPClient class>>httpPostDocument:args: (in category 'post/get') -----
- httpPostDocument: url args: argsDict
- ^self httpPostDocument: url target: nil args: argsDict!

Item was removed:
- ----- Method: HTTPClient class>>httpPostDocument:target:args: (in category 'post/get') -----
- httpPostDocument: url target: target args: argsDict
- | argString stream content |
- ^self shouldUsePluginAPI
- ifTrue: [
- argString := argsDict
- ifNotNil: [argString := HTTPSocket argString: argsDict]
- ifNil: [''].
- stream := FileStream post: argString , ' ' target: target url: url , argString ifError: [self error: 'Error in post to ' , url printString].
- stream position: 0.
- content := stream upToEnd.
- stream close.
- MIMEDocument content: content]
- ifFalse: [HTTPSocket httpPostDocument: url  args: argsDict]!

Item was removed:
- ----- Method: HTTPClient class>>httpPostMultipart:args: (in category 'post/get') -----
- httpPostMultipart: url args: argsDict
- " do multipart/form-data encoding rather than x-www-urlencoded "
-
- ^self shouldUsePluginAPI
- ifTrue: [self pluginHttpPostMultipart: url args: argsDict]
- ifFalse: [HTTPSocket httpPostMultipart: url args: argsDict accept: nil request: '']!

Item was removed:
- ----- Method: HTTPClient class>>isRunningInBrowser (in category 'testing') -----
- isRunningInBrowser
-
- RunningInBrowser isNil
- ifTrue: [self determineIfRunningInBrowser].
- ^RunningInBrowser!

Item was removed:
- ----- Method: HTTPClient class>>isRunningInBrowser: (in category 'testing') -----
- isRunningInBrowser: aBoolean
- "Override the automatic process.
- This should be used with caution.
- One way to determine it without using the primitive is to check for parameters typically only encountered when running as a plugin."
-
- RunningInBrowser := aBoolean!

Item was removed:
- ----- Method: HTTPClient class>>mailTo:message: (in category 'utilities') -----
- mailTo: address message: aString
- HTTPClient shouldUsePluginAPI
- ifFalse: [^self error: 'You need to run inside a web browser.'].
- FileStream post: aString url: 'mailto:' , address ifError: [self error: 'Can not send mail']!

Item was removed:
- ----- Method: HTTPClient class>>pluginHttpPostMultipart:args: (in category 'private') -----
- pluginHttpPostMultipart: url args: argsDict
- | mimeBorder argsStream crLf resultStream result |
- " do multipart/form-data encoding rather than x-www-urlencoded "
-
- crLf := String crlf.
- mimeBorder := '----squeak-', Time millisecondClockValue printString, '-stuff-----'.
- "encode the arguments dictionary"
- argsStream := WriteStream on: String new.
- argsDict associationsDo: [:assoc |
- assoc value do: [ :value | | fieldValue |
- "print the boundary"
- argsStream nextPutAll: '--', mimeBorder, crLf.
- " check if it's a non-text field "
- argsStream nextPutAll: 'Content-disposition: form-data; name="', assoc key, '"'.
- (value isKindOf: MIMEDocument)
- ifFalse: [fieldValue := value]
- ifTrue: [argsStream nextPutAll: ' filename="', value url pathForFile, '"', crLf, 'Content-Type: ', value contentType.
- fieldValue := (value content
- ifNil: [(FileStream fileNamed: value url pathForFile) contentsOfEntireFile]
- ifNotNil: [value content]) asString].
- " Transcript show: 'field=', key, '; value=', fieldValue; cr. "
- argsStream nextPutAll: crLf, crLf, fieldValue, crLf.
- ]].
- argsStream nextPutAll: '--', mimeBorder, '--'.
- resultStream := FileStream
- post:
- ('ACCEPT: text/html', crLf,
- 'User-Agent: Squeak 3.1', crLf,
- 'Content-type: multipart/form-data; boundary=', mimeBorder, crLf,
- 'Content-length: ', argsStream contents size printString, crLf, crLf,
- argsStream contents)
- url: url ifError: [^'Error in post ' url asString].
- "get the header of the reply"
- result := resultStream
- ifNil: ['']
- ifNotNil: [resultStream upToEnd].
- ^MIMEDocument content: result!

Item was removed:
- ----- Method: HTTPClient class>>requestURL:target: (in category 'post/get') -----
- requestURL: url target: target
- ^self shouldUsePluginAPI
- ifTrue: [FileStream requestURL: url target: target]
- ifFalse: [self error: 'Requesting a new URL target is not supported.']!

Item was removed:
- ----- Method: HTTPClient class>>shouldUsePluginAPI (in category 'testing') -----
- shouldUsePluginAPI
- "HTTPClient shouldUsePluginAPI"
-
- self isRunningInBrowser
- ifFalse: [^false].
- self browserSupportsAPI
- ifFalse: [^false].
- "The Mac plugin calls do not work in full screen mode"
- ^((Smalltalk platformName = 'Mac OS')
- and: [DisplayScreen displayIsFullScreen]) not!

Item was removed:
- ----- Method: HTTPClient class>>uploadFileNamed:to:user:passwd: (in category 'utilities') -----
- uploadFileNamed: aFilename to: baseUrl user: user passwd: passwd
-
- | fileContents remoteFilename |
- remoteFilename := (baseUrl endsWith: '/')
- ifTrue: [baseUrl , '/' , aFilename]
- ifFalse: [baseUrl , aFilename].
- fileContents := (StandardFileStream readOnlyFileNamed: aFilename) contentsOfEntireFile.
- HTTPSocket httpPut: fileContents to: remoteFilename user: user passwd: passwd!

Item was changed:
  ----- Method: HTTPLoader class>>httpRequestClass (in category 'accessing') -----
  httpRequestClass
+ ^HTTPDownloadRequest!
- ^HTTPClient shouldUsePluginAPI
- ifTrue: [PluginHTTPDownloadRequest]
- ifFalse: [HTTPDownloadRequest]!

Item was changed:
  ----- Method: Project>>tellAFriend: (in category 'SuperSwiki') -----
+ tellAFriend: emailAddressOrNil
+ "
+ Project current tellAFrien
+ "
- tellAFriend: emailAddressOrNil
  | urlForLoading |
+ (urlForLoading := self urlForLoading)
+ ifNil: [urlForLoading := self url
+ "fallback for dtp servers"].
+ urlForLoading isEmptyOrNil
+ ifTrue: [^ self inform: 'Since this project has not been saved yet,
+ I cannot tell someone where it is.' translated].
+ FancyMailComposition new
+ celeste: nil
+ to: (emailAddressOrNil
+ ifNil: ['RECIPIENT.GOESHERE'])
+ subject: 'New/Updated Squeak project'
+ initialText: 'This is a link to the Squeak project ' , self name , ': ' , String crlf
+ theLinkToInclude: urlForLoading;
+ open!
- "
- Project current tellAFriend
- "
-
- (urlForLoading := self urlForLoading) ifNil: [
- urlForLoading := self url "fallback for dtp servers"
- ].
- urlForLoading isEmptyOrNil ifTrue: [
- ^self inform: 'Since this project has not been saved yet,
- I cannot tell someone where it is.' translated
- ].
- HTTPClient tellAFriend: emailAddressOrNil url: urlForLoading name: self name!

Item was changed:
  ----- Method: ProjectLauncher>>initialize (in category 'initialization') -----
  initialize
  super initialize.
+ showSplash := true!
- showSplash := true.
- HTTPClient isRunningInBrowser
- ifTrue: [whichFlaps := 'etoy']!

Item was changed:
  ----- Method: ProjectLauncher>>startUpAfterLogin (in category 'running') -----
  startUpAfterLogin
  | scriptName loader isUrl |
  self setupFlaps.
+ Preferences readDocumentAtStartup
+ ifTrue: [scriptName := Smalltalk documentPath
+ ifNil: [''].
- Preferences readDocumentAtStartup ifTrue: [
- HTTPClient isRunningInBrowser ifTrue:[
- self setupFromParameters.
- scriptName := self parameterAt: 'src'.
- CodeLoader defaultBaseURL: (self parameterAt: 'Base').
- ] ifFalse:[
- scriptName := (Smalltalk documentPath) ifNil:[''].
  scriptName := scriptName convertFromSystemString.
+ scriptName isEmpty
+ ifFalse: ["figure out if script name is a URL by itself"
+ isUrl := (scriptName asLowercase beginsWith: 'http://')
+ or: [(scriptName asLowercase beginsWith: 'file://')
+ or: [scriptName asLowercase beginsWith: 'ftp://']].
+ isUrl
+ ifFalse: [| encodedPath pathTokens |
+ "Allow for ../dir/scriptName arguments"
+ pathTokens := scriptName splitBy: FileDirectory slash.
+ pathTokens := pathTokens
+ collect: [:s | s encodeForHTTP].
+ encodedPath := pathTokens
+ reduce: [:acc :each | acc , FileDirectory slash , each].
+ scriptName := (FileDirectory default uri resolveRelativeURI: encodedPath) asString]]]
+ ifFalse: [scriptName := ''].
- scriptName isEmpty ifFalse:[
- "figure out if script name is a URL by itself"
- isUrl := (scriptName asLowercase beginsWith:'http://') or:[
- (scriptName asLowercase beginsWith:'file://') or:[
- (scriptName asLowercase beginsWith:'ftp://')]].
- isUrl ifFalse:[ | encodedPath pathTokens |
- "Allow for ../dir/scriptName arguments"
- pathTokens := scriptName splitBy: FileDirectory slash.
- pathTokens := pathTokens collect: [:s | s encodeForHTTP].
- encodedPath := pathTokens reduce: [:acc :each | acc , FileDirectory slash , each].
- scriptName := (FileDirectory default uri
- resolveRelativeURI: encodedPath) asString]].
- ]. ]
- ifFalse: [ scriptName := '' ].
-
  scriptName isEmptyOrNil
+ ifTrue: [^ Preferences eToyFriendly
+ ifTrue: [self currentWorld addGlobalFlaps]].
- ifTrue:[^Preferences eToyFriendly ifTrue: [self currentWorld addGlobalFlaps]].
  loader := CodeLoader new.
+ loader
+ loadSourceFiles: (Array with: scriptName).
+ (scriptName asLowercase endsWith: '.pr')
+ ifTrue: [self installProjectFrom: loader]
+ ifFalse: [loader installSourceFiles]!
- loader loadSourceFiles: (Array with: scriptName).
- (scriptName asLowercase endsWith: '.pr')
- ifTrue:[self installProjectFrom: loader]
- ifFalse:[loader installSourceFiles].
- !

Item was changed:
  ----- Method: ResourceCollector>>writeResourceForm:fromLocator: (in category 'resource writing') -----
  writeResourceForm: aForm fromLocator: aLocator
  "The given form has been externalized before. If it was reasonably compressed, use the bits of the original data - this allows us to recycle GIF, JPEG, PNG etc. data without using the internal compression (which is in most cases inferior). If necessary the data will be retrieved from its URL location. This retrieval is done only if the resouce comes from either
  * the local disk (in which case the file has never been published)
  * the browser cache (in which case we don't cache the resource locally)
  In any other case we will *not* attempt to retrieve it, because doing so can cause the system to connect to the network which is probably not what we want. It should be a rare case anyways; could only happen if one clears the squeak cache selectively."
  | fName fStream url data |
  "Try to be smart about the name of the file"
  fName := (aLocator urlString includes: $:)
  ifTrue: [
  url := aLocator urlString asUrl.
  url path last]
  ifFalse: [aLocator urlString].
  fName isEmptyOrNil ifFalse:[fName := fName asFileName].
  (fName isEmptyOrNil or:[localDirectory isAFileNamed: fName]) ifTrue:[
  "bad luck -- duplicate name"
  fName := localDirectory
  nextNameFor:'resource'
  extension: (FileDirectory extensionFor: aLocator urlString)].
  "Let's see if we have cached it locally"
  ResourceManager
  lookupCachedResource: self baseUrl , aLocator urlString
  ifPresentDo:[:stream | data := stream upToEnd].
  "Check if the cache entry is without qualifying baseUrl. Workaround for older versions."
  data ifNil:[
  ResourceManager
  lookupCachedResource: aLocator urlString
  ifPresentDo:[:stream | data := stream upToEnd]].
  data ifNil:[
  "We don't have it cached locally. Retrieve it from its original location."
+ (url notNil and: [url hasRemoteContents])
- ((url notNil and: [url hasRemoteContents]) and:[HTTPClient isRunningInBrowser not])
  ifTrue:[^nil]. "see note above"
  (Url schemeNameForString: aLocator urlString)
  ifNil: [^nil].
  data := HTTPLoader default retrieveContentsFor: aLocator urlString.
  data ifNil:[^nil].
  data := data content.
  ].
  "data size > aForm bits byteSize ifTrue:[^nil]."
  fStream := localDirectory newFileNamed: fName.
  fStream binary.
  fStream nextPutAll: data.
  fStream close.
  ^{fName. data size}!

Item was changed:
  ----- Method: ResourceManager class>>cacheResource:stream: (in category 'resource caching') -----
  cacheResource: urlString stream: aStream
  | fd localName file buf |
+
- HTTPClient shouldUsePluginAPI ifTrue:[^self]. "use browser cache"
  (self resourceCache at: urlString ifAbsent:[#()]) size > 0
  ifTrue:[^self]. "don't waste space"
  fd := Project squeakletDirectory.
  localName := fd nextNameFor: 'resource' extension:'cache'.
  file := fd forceNewFileNamed: localName.
  buf := ByteArray new: 10000.
  aStream binary.
  file binary.
  [aStream atEnd] whileFalse:[
  buf := aStream next: buf size into: buf.
  file nextPutAll: buf.
  ].
  file close.
  "update cache"
  file := [fd oldFileNamed: self resourceCacheName]
  on: FileDoesNotExistException
  do:[:ex| fd forceNewFileNamed: self resourceCacheName].
  file setToEnd.
  file nextPutAll: urlString; cr.
  file nextPutAll: localName; cr.
  file close.
  self addCacheLocation: localName for: urlString.
  aStream position: 0.
  !

Item was removed:
- ----- Method: SystemVersion class>>check:andRequestPluginUpdate: (in category 'updating') -----
- check: pluginVersion andRequestPluginUpdate: updateURL
- "SystemVersion check: 'zzz' andRequestPluginUpdate: 'http://www.squeakland.org/installers/update.html' "
-
- "We don't have a decent versioning scheme yet, so we are basically checking for a nil VM version on the mac."
- (self pluginVersion: pluginVersion newerThan: self currentPluginVersion)
- ifFalse: [^true].
- (self confirm: 'There is a newer plugin version available. Do you want to install it now?')
- ifFalse: [^false].
- HTTPClient
- requestURL: updateURL , (Smalltalk platformName copyWithout: Character space) asLowercase , '.html'
- target: '_top'.
- ^false!