The Trunk: Network-tpr.230.mcz

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

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

Name: Network-tpr.230
Author: tpr
Time: 25 February 2019, 1:18:58.682316 pm
UUID: e0d4c983-2401-4421-89bd-8ef3d1318d5d
Ancestors: Network-tpr.229

De-deprecate the URI class(es) since there is a tiny pinhole leak via String asUri etc.
Best option would be to reimplement URI & Url to unify and improve both. Not least to fix the incorrect naming of Url - it's an initialism and should be URL.

=============== Diff against Network-tpr.229 ===============

Item was added:
+ URI subclass: #HierarchicalURI
+ instanceVariableNames: 'authority query'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Network-URI'!

Item was added:
+ ----- Method: HierarchicalURI>>absoluteFromString:scheme: (in category 'private') -----
+ absoluteFromString: aString scheme: schemeName
+ | remainder |
+ super absoluteFromString: aString scheme: schemeName.
+
+ "We now have the interesting part in schemeSpecficPart and can parse it further"
+
+ "This check is somewhat redundant, just in case somebody calls this directly."
+ remainder := schemeSpecificPart.
+ (remainder isEmpty
+ or: [remainder first ~~ $/])
+ ifTrue: [(IllegalURIException new uriString: remainder) signal: 'Invalid absolute URI'].
+
+ (aString beginsWith: '//')
+ ifTrue: [remainder := self extractAuthority: (remainder copyFrom: 3 to: remainder size)].
+
+ self extractSchemeSpecificPartAndFragment: remainder!

Item was added:
+ ----- Method: HierarchicalURI>>absolutePath (in category 'accessing') -----
+ absolutePath
+ ^self schemeSpecificPart isEmpty
+ ifTrue: ['/']
+ ifFalse: [self schemeSpecificPart]!

Item was added:
+ ----- Method: HierarchicalURI>>allButScheme (in category 'printing') -----
+ allButScheme
+ "Answer the entire url except its scheme"
+
+ ^String streamContents:[:s|
+ authority ifNotNil:[self authority printOn: s].
+ s nextPutAll: super allButScheme.
+ query ifNotNil:[s nextPutAll: query].
+ ].!

Item was added:
+ ----- Method: HierarchicalURI>>assureExistance (in category 'directory operations') -----
+ assureExistance
+ !

Item was added:
+ ----- Method: HierarchicalURI>>authority (in category 'accessing') -----
+ authority
+ ^authority!

Item was added:
+ ----- Method: HierarchicalURI>>baseName (in category 'accessing') -----
+ baseName
+ "returns the last component stripped of its extension"
+
+ | baseName i |
+ baseName := self pathComponents last.
+ i := baseName findLast: [:c | c = $.].
+ ^i = 0
+ ifTrue: [baseName]
+ ifFalse: [baseName copyFrom: 1 to: i-1].
+ !

Item was added:
+ ----- Method: HierarchicalURI>>buildAbsolutePath: (in category 'private') -----
+ buildAbsolutePath: pathComponents
+ ^String streamContents: [:stream |
+ stream nextPut: $/.
+ pathComponents
+ do: [:pathPart | stream nextPutAll: pathPart]
+ separatedBy: [stream nextPut: $/]]!

Item was added:
+ ----- Method: HierarchicalURI>>extension (in category 'accessing') -----
+ extension
+ "This method assumes a $. as extension delimiter"
+
+ | i leafName |
+ leafName := self pathComponents last.
+ i := leafName findLast: [:c | c = $.].
+ ^i = 0
+ ifTrue: ['']
+ ifFalse: [leafName copyFrom: i + 1 to: leafName size].
+ !

Item was added:
+ ----- Method: HierarchicalURI>>extractAuthority: (in category 'private') -----
+ extractAuthority: aString
+ | endAuthorityIndex authorityString |
+ endAuthorityIndex := (aString indexOf: $/ ) - 1.
+ endAuthorityIndex < 0
+ ifTrue: [endAuthorityIndex := aString size].
+ authorityString := aString copyFrom: 1 to: endAuthorityIndex.
+ authority := URIAuthority fromString: authorityString.
+ ^aString copyFrom: endAuthorityIndex+1 to: aString size!

Item was added:
+ ----- Method: HierarchicalURI>>extractQuery: (in category 'private') -----
+ extractQuery: remainder
+ | queryIndex |
+ queryIndex := remainder indexOf: $?.
+ queryIndex > 0
+ ifFalse: [^remainder].
+ query := remainder copyFrom: queryIndex to: remainder size.
+ ^remainder copyFrom: 1 to: queryIndex-1!

Item was added:
+ ----- Method: HierarchicalURI>>extractSchemeSpecificPartAndFragment: (in category 'private') -----
+ extractSchemeSpecificPartAndFragment: remainder
+ super extractSchemeSpecificPartAndFragment: remainder.
+ schemeSpecificPart := self extractQuery: schemeSpecificPart!

Item was added:
+ ----- Method: HierarchicalURI>>host (in category 'accessing') -----
+ host
+ ^self authority host!

Item was added:
+ ----- Method: HierarchicalURI>>path (in category 'accessing') -----
+ path
+ " ^self schemeSpecificPart isEmpty
+ ifTrue: ['/']
+ ifFalse: [self schemeSpecificPart]"
+ ^self schemeSpecificPart!

Item was added:
+ ----- Method: HierarchicalURI>>pathComponents (in category 'accessing') -----
+ pathComponents
+ ^self path findTokens: $/!

Item was added:
+ ----- Method: HierarchicalURI>>port (in category 'accessing') -----
+ port
+ ^self authority port!

Item was added:
+ ----- Method: HierarchicalURI>>printSchemeSpecificPartOn: (in category 'printing') -----
+ printSchemeSpecificPartOn: stream
+ self isAbsolute
+ ifTrue: [stream nextPutAll: '//'].
+ authority
+ ifNotNil: [self authority printOn: stream].
+ super printSchemeSpecificPartOn: stream.
+ query
+ ifNotNil: [stream nextPutAll: query]!

Item was added:
+ ----- Method: HierarchicalURI>>query (in category 'accessing') -----
+ query
+ ^query!

Item was added:
+ ----- Method: HierarchicalURI>>relativeFromString: (in category 'private') -----
+ relativeFromString: aString
+ | remainder authorityEnd |
+ remainder := (aString beginsWith: '//')
+ ifTrue: [
+ authorityEnd := aString indexOf: $/ startingAt: 3.
+ authorityEnd = 0
+ ifTrue: [authorityEnd := aString size+1].
+ self extractAuthority: (aString copyFrom: 3 to: authorityEnd-1)]
+ ifFalse: [aString].
+ self extractSchemeSpecificPartAndFragment: remainder!

Item was added:
+ ----- Method: HierarchicalURI>>removeComponentDotDotPairs: (in category 'private') -----
+ removeComponentDotDotPairs: pathComponents
+ | dotDotIndex |
+ dotDotIndex := pathComponents indexOf: '..'.
+ [dotDotIndex > 1]
+ whileTrue: [
+ pathComponents
+ removeAt: dotDotIndex;
+ removeAt: dotDotIndex-1.
+ dotDotIndex := pathComponents indexOf: '..']!

Item was added:
+ ----- Method: HierarchicalURI>>resolveRelativeURI: (in category 'accessing') -----
+ resolveRelativeURI: aURI
+ | relativeURI newAuthority newPath pathComponents newURI relComps |
+ relativeURI := aURI asURI.
+
+ relativeURI isAbsolute
+ ifTrue: [^relativeURI].
+
+ relativeURI authority
+ ifNil: [
+ newAuthority := self authority.
+ (relativeURI path beginsWith: '/')
+ ifTrue: [newPath := relativeURI path]
+ ifFalse: [
+ pathComponents := (self path copyUpToLast: $/) findTokens: $/.
+ relComps := relativeURI pathComponents.
+ relComps removeAllSuchThat: [:each | each = '.'].
+ pathComponents addAll: relComps.
+ pathComponents removeAllSuchThat: [:each | each = '.'].
+ self removeComponentDotDotPairs: pathComponents.
+ newPath := self buildAbsolutePath: pathComponents.
+ ((relComps isEmpty
+ or: [relativeURI path last == $/
+ or: [(relativeURI path endsWith: '/..')
+ or: [relativeURI path = '..'
+ or: [relativeURI path endsWith: '/.' ]]]])
+ and: [newPath size > 1])
+ ifTrue: [newPath := newPath , '/']]]
+ ifNotNil: [
+ newAuthority := relativeURI authority.
+ newPath := relativeURI path].
+
+ newURI := String streamContents: [:stream |
+ stream nextPutAll: self scheme.
+ stream nextPut: $: .
+ newAuthority notNil
+ ifTrue: [
+ stream nextPutAll: '//'.
+ newAuthority printOn: stream].
+ newPath notNil
+ ifTrue: [stream nextPutAll: newPath].
+ relativeURI query notNil
+ ifTrue: [stream nextPutAll: relativeURI query].
+ relativeURI fragment notNil
+ ifTrue: [
+ stream nextPut: $# .
+ stream nextPutAll: relativeURI fragment]].
+ ^newURI asURI!

Item was added:
+ ----- Method: HierarchicalURI>>userInfo (in category 'accessing') -----
+ userInfo
+ ^self authority userInfo!

Item was added:
+ URI subclass: #OpaqueURI
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Network-URI'!

Item was added:
+ ----- Method: OpaqueURI>>isOpaque (in category 'testing') -----
+ isOpaque
+ ^true!

Item was added:
+ Object subclass: #URI
+ instanceVariableNames: 'fragment scheme schemeSpecificPart'
+ classVariableNames: 'ClientClasses'
+ poolDictionaries: ''
+ category: 'Network-URI'!
+
+ !URI commentStamp: 'tpr 2/18/2019 18:06' prior: 0!
+ This class is deprecated. Consider using one of the Url classes instead.
+
+ A Uniform Resource Identifier (URI) is a compact string of characters for identifying an abstract or physical resource.
+ This implementation is based on http://www.ietf.org/rfc/rfc2396.txt.
+
+ !

Item was added:
+ ----- Method: URI class>>absoluteFromString:scheme: (in category 'instance creation') -----
+ absoluteFromString: aString scheme: scheme
+ | remainder |
+ remainder := aString copyFrom: scheme size+2 to: aString size.
+ remainder isEmpty
+ ifTrue: [(IllegalURIException new uriString: aString) signal: 'Invalid absolute URI'].
+ ^(remainder first = $/
+ ifTrue: [HierarchicalURI]
+ ifFalse: [OpaqueURI]) new absoluteFromString: remainder scheme: scheme!

Item was added:
+ ----- Method: URI class>>basicNew (in category 'instance creation') -----
+ basicNew
+ self deprecated: 'This class is deprecated. USe one ofthe Url classes instead'.
+ ^super basicNew!

Item was added:
+ ----- Method: URI class>>extractSchemeFrom: (in category 'instance creation') -----
+ extractSchemeFrom: aString
+ | colonIndex slashIndex |
+ colonIndex := aString indexOf: $: .
+ ^colonIndex > 0
+ ifTrue: [
+ slashIndex := aString indexOf: $/ .
+ (slashIndex = 0
+ or: [colonIndex < slashIndex])
+ ifTrue: [aString copyFrom: 1 to: colonIndex-1]
+ ifFalse: [nil]]
+ ifFalse: [nil]!

Item was added:
+ ----- Method: URI class>>fromString: (in category 'instance creation') -----
+ fromString: aString
+ | parseString scheme |
+ parseString := aString withBlanksTrimmed.
+ scheme := self extractSchemeFrom: parseString.
+ ^scheme
+ ifNil: [HierarchicalURI new relativeFromString: aString]
+ ifNotNil: [self absoluteFromString: aString scheme: scheme]
+ !

Item was added:
+ ----- Method: URI class>>initialize (in category 'class initialization') -----
+ initialize
+ "URI initialize"
+
+ ClientClasses := Dictionary new.
+ ClientClasses
+ at: 'http' put: #HTTPClient;
+ at: 'ftp' put: #FTPClient;
+ at: 'file' put: #FileDirectory
+ !

Item was added:
+ ----- Method: URI>>= (in category 'testing') -----
+ = otherURI
+ ^ self class = otherURI class
+ and: [self asString = otherURI asString]!

Item was added:
+ ----- Method: URI>>absoluteFromString:scheme: (in category 'private') -----
+ absoluteFromString: remainder scheme: schemeName
+ scheme := schemeName.
+ self extractSchemeSpecificPartAndFragment: remainder!

Item was added:
+ ----- Method: URI>>allButScheme (in category 'printing') -----
+ allButScheme
+ "Answer the entire url except its scheme"
+
+ ^String streamContents:[:s|
+ s nextPutAll: schemeSpecificPart.
+ fragment ifNotNil: [
+ s nextPut: $# .
+ s nextPutAll: self fragment]
+ ].!

Item was added:
+ ----- Method: URI>>asText (in category 'converting') -----
+ asText
+ ^self asString asText!

Item was added:
+ ----- Method: URI>>asURI (in category 'converting') -----
+ asURI
+ ^self!

Item was added:
+ ----- Method: URI>>asUrl (in category 'converting') -----
+ asUrl
+
+ ^self asString asUrl!

Item was added:
+ ----- Method: URI>>clientClass (in category 'private') -----
+ clientClass
+ ^Smalltalk at: (ClientClasses at: self scheme ifAbsent: [ClientClasses at: 'file'])!

Item was added:
+ ----- Method: URI>>contentStream (in category 'retrieval') -----
+ contentStream
+ ^self clientClass contentStreamForURI: self!

Item was added:
+ ----- Method: URI>>downloadUrl (in category 'converting') -----
+ downloadUrl
+ self halt!

Item was added:
+ ----- Method: URI>>extractSchemeSpecificPartAndFragment: (in category 'private') -----
+ extractSchemeSpecificPartAndFragment: remainder
+ | fragmentIndex |
+ fragmentIndex := remainder indexOf: $# .
+ fragmentIndex > 0
+ ifTrue: [
+ schemeSpecificPart := remainder copyFrom: 1 to: fragmentIndex-1.
+ fragment := remainder copyFrom: fragmentIndex+1 to: remainder size]
+ ifFalse: [schemeSpecificPart := remainder]!

Item was added:
+ ----- Method: URI>>fragment (in category 'accessing') -----
+ fragment
+ ^fragment!

Item was added:
+ ----- Method: URI>>hasRemoteContents (in category 'testing') -----
+ hasRemoteContents
+ self halt!

Item was added:
+ ----- Method: URI>>hash (in category 'testing') -----
+ hash
+ ^ self asString hash!

Item was added:
+ ----- Method: URI>>isAbsolute (in category 'testing') -----
+ isAbsolute
+ ^self scheme notNil!

Item was added:
+ ----- Method: URI>>isOpaque (in category 'testing') -----
+ isOpaque
+ ^false!

Item was added:
+ ----- Method: URI>>isRelative (in category 'testing') -----
+ isRelative
+ ^self isAbsolute not!

Item was added:
+ ----- Method: URI>>printOn: (in category 'printing') -----
+ printOn: stream
+ self isAbsolute
+ ifTrue: [
+ stream nextPutAll: self scheme.
+ stream nextPut: $: ].
+ self printSchemeSpecificPartOn: stream.
+ fragment
+ ifNotNil: [
+ stream nextPut: $# .
+ stream nextPutAll: self fragment]
+ !

Item was added:
+ ----- Method: URI>>printSchemeSpecificPartOn: (in category 'printing') -----
+ printSchemeSpecificPartOn: stream
+ stream nextPutAll: self schemeSpecificPart!

Item was added:
+ ----- Method: URI>>resolveRelativeURI: (in category 'accessing') -----
+ resolveRelativeURI: relativeURI
+ self shouldNotImplement!

Item was added:
+ ----- Method: URI>>retrieveContentStream (in category 'retrieval') -----
+ retrieveContentStream
+ ^self retrieveMIMEDocument contentStream!

Item was added:
+ ----- Method: URI>>retrieveContents (in category 'retrieval') -----
+ retrieveContents
+ ^self retrieveMIMEDocument contents!

Item was added:
+ ----- Method: URI>>retrieveMIMEDocument (in category 'retrieval') -----
+ retrieveMIMEDocument
+ ^self clientClass retrieveMIMEDocument: self!

Item was added:
+ ----- Method: URI>>scheme (in category 'accessing') -----
+ scheme
+ ^scheme!

Item was added:
+ ----- Method: URI>>schemeSpecificPart (in category 'private') -----
+ schemeSpecificPart
+ ^schemeSpecificPart!