diff --git a/src/lib/regex.slate b/src/lib/regex.slate index 442b1d4..a6c664c 100644 --- a/src/lib/regex.slate +++ b/src/lib/regex.slate @@ -1,4 +1,4 @@ -ensureNamespace: #Regex. +lobby ensureNamespace: #Regex. Regex define: #Parser &slots: {#input. #lookahead}. @@ -47,7 +47,7 @@ Regex Syntax define: #Piece &parents: {Regex Syntax Node} &slots: #min. #max}. -Regex Syntax define: #CharSet &parents: {Regex Syntax Node}. +Regex Syntax define: #CharSet &parents: {Regex Syntax Node} &slots: {#negated. #elements}. @@ -129,7 +129,7 @@ m@(Regex Match Marker traits) matchAgainst: aMatcher | startPosition | startPosition: aMatcher position. (m next matchAgainst: aMatcher) - /\ [aMatcher markerPositionAt: m index maybePut: startPosition. True]. + /\ [aMatcher markerPositionAt: m index maybePut: startPosition. True] ]. t@(Regex Match Terminator traits) terminateWith: aTerminator diff --git a/src/net/http.slate b/src/net/http.slate new file mode 100644 index 0000000..3ba848d --- /dev/null +++ b/src/net/http.slate @@ -0,0 +1,2 @@ + +Net define: #HttpConnection &parents: {Cloneable} &slots: {#socket. } diff --git a/src/net/init.slate b/src/net/init.slate index b11009b..fb85d45 100644 --- a/src/net/init.slate +++ b/src/net/init.slate @@ -1,5 +1,8 @@ + load: 'src/lib/regex.slate'. load: 'src/net/sockets.slate'. +load: 'src/net/uri.slate'. +load: 'src/net/http.slate'. diff --git a/src/net/sockets.slate b/src/net/sockets.slate index 2251e0d..a2f0837 100644 --- a/src/net/sockets.slate +++ b/src/net/sockets.slate @@ -49,6 +49,9 @@ Socket ErrorCodes addSlot: #Dictionary valued: Dictionary new. Socket ErrorCodes Dictionary add: item value -> item key. ]. +conditions define: #SocketError + &parents: {ExternalResource SeriousCondition} + &slots: {#error. #errorCode}. Socket Domains `>> [ @@ -68,7 +71,7 @@ Socket Protocols `>> [ s@(Socket traits) throwError: code [ - error: (Socket ErrorCodes Dictionary at: code) printString + SocketError new `>> [error: (Socket ErrorCodes Dictionary at: code). errorCode: code. signal] ]. diff --git a/src/net/uri.slate b/src/net/uri.slate new file mode 100644 index 0000000..61e3065 --- /dev/null +++ b/src/net/uri.slate @@ -0,0 +1,196 @@ +lobby ensureNamespace: #Net. +Net ensureNamespace: #Schemes. + +Net Schemes define: #Scheme &parents: {Cloneable}. +Net Schemes define: #Http &parents: {Net Schemes Scheme}. +Net Schemes define: #Mailto &parents: {Net Schemes Scheme}. + +Net Schemes define: #SchemeDictionary -> Dictionary new. + +{ 'http' -> Net Schemes Http. + 'http' -> Net Schemes Mailto. +} do: [|:each| Net Schemes SchemeDictionary add: each]. + +u@(Net Schemes Scheme traits) uriText [overrideThis]. +u@(Net Schemes Http traits) uriText ['http']. +u@(Net Schemes Mailto traits) uriText ['mailto']. + +string@(String traits) as: _@(Net Schemes Scheme) +[ + (Net Schemes SchemeDictionary at: string ifAbsent: [ error: 'Cannot find scheme: ' ; string]) new +]. + +"http://www.ietf.org/rfc/rfc3986.txt" +Net define: #URI &parents: {ExternalResource Locator} + &slots: {#scheme. #fragment}. + +u@(Net URI traits) isAbsolute +"All Absolute URLs have a scheme." +[u scheme isNotNil]. + +u@(Net URI traits) isEmpty +"Answer whether it contains anything important according to the scheme." +[overrideThis]. + +u@(Net URI traits) printSchemeSpecificPartOn: encoder +"Print the scheme-specific part on the encoding stream." +[overrideThis]. + +Net define: #HierarchicalURI &parents: {Net URI} &slots: + {#authority. + #path -> {}. "The path segments." + #query}. + +u@(Net HierarchicalURI traits) new +"TODO: Finish this" +[u cloneSettingSlots: #(scheme fragment authority path query) + to: {u scheme. u fragment. u authority. u path new. u query new}]. + +u@(Net HierarchicalURI traits) isEmpty +[u path isEmpty /\ [u authority isNil]]. + +u@(Net HierarchicalURI traits) printSchemeSpecificPartOn: encoder +[ + u authority ifNotNil: [encoder ; '//'. u authority printOn: encoder]. + u path printOn: encoder. + u query ifNotNil: [encoder ; '?'. encoder nextPutAll: u query as: 'uric']. +]. + +u@(Net URI traits) resolveRelative: ru +[error: 'Only hierarchical URIs can resolve relative ones.']. + +abs@(Net HierarchicalURI traits) resolveRelative: rel@(Net HierarchicalURI traits) +"Resolve a URI which should be relative to this one." +"This algorithm is derived from the one in RFC 2396, section 5.2. It assumes +both URIs have already been parsed. +- If the first segment in rel's path is '', or rel's authority is + defined, rel contains an absolute path, so use rel's path as-is. + Otherwise, merge abs's path with rel's as follows: + - If the buffer is not empty, but begins with something other than '', + prepend '' to get a leading slash. If rel path is empty, but abs path + is not, put a '' at the end of the buffer so we don't lose the slash + that was there before we removed the last segment. + - Find the first occurrence of '..' from the left. If the previous argument + is '', then stop processing (or raise an error?). If '..' was the last + segment, append ''. Remove both '..' and the previous argument. Repeat + until there are no more occurrences of '..'." +[| result | + "If rel is an absolute reference, it is (by the RFC) already resolved." + rel isAbsolute ifTrue: [^ rel]. + "Scheme must be Nil at this point, since rel isAbsolute not." + "If rel's path is empty and the scheme, authority, and query are undefined, + then it is a reference to the current document." + rel path isEmpty + /\ [rel authority isNil] + /\ [rel query isNil] + ifTrue: [^ rel]. + "Use rel's query and fragment, and abs's scheme." + result: (abs cloneSettingSlots: #(query fragment scheme) + to: {rel query. rel fragment. abs scheme}). + "If rel's authority is defined, use it, or else use abs's." + rel authority + ifNil: + [result authority: abs authority. + rel path isEmpty not + /\ [rel path first = ''] + ifTrue: [result path: rel path] + ifFalse: + [| resultPath dotDotIndex | + "Copy all but the last segment of abs path to a buffer. + Append rel path to the buffer." + resultPath: (abs path allButLast ; rel path as: ExtensibleArray). + resultPath isEmpty not + /\ [resultPath first ~= ''] + ifTrue: [resultPath addFirst: '']. + rel path isEmpty + /\ [abs path isEmpty not] + ifTrue: [resultPath addLast: '']. + "If the last segment is '.', preserve a trailing slash." + resultPath last = '.' ifTrue: [resultPath addLast: '']. + "Remove all occurrences of '.' from the buffer." + resultPath removeAllSuchThat: [| :seg | seg = '.']. + "If the last segment is '..', preserve a trailing slash." + resultPath last = '..' ifTrue: [resultPath addLast: '']. + "Find occurrences of '..' from the left." + dotDotIndex: 0. + [dotDotIndex: (resultPath indexOf: '..' startingAt: dotDotIndex). + dotDotIndex isNil] + whileFalse: + [dotDotIndex = 1 + ifTrue: "Do not remove a leading slash." + [dotDotIndex: dotDotIndex + 1] + ifFalse: "Remove the '..' and the preceding element." + [resultPath at: dotDotIndex - 1 remove: 2]]. + result path: resultPath]] + ifNotNil: + [result authority: rel authority. + result path: rel path]. + result +]. + +Net define: #OpaqueURI &parents: {Net URI} + &slots: {#opaquePart}. + +u@(Net OpaqueURI traits) isEmpty [u opaquePart isNil]. + +u@(Net OpaqueURI traits) printSchemeSpecificPartOn: encoder +[u opaquePart ifNotNil: [encoder nextPutAll: u opaquePart as: 'uricNoSlash']]. + +u@(Net URI traits) readFrom: s +[| r | + r: (Regex Matcher forString: '^(([^:/?#]+)\\:)?(//([^/?#]*))?([^?#]*)(\\?([^#]*))?(#(.*))?'). + (r matches: s) + ifTrue: [Net URI cloneSettingSlots: #(scheme authority path query fragment) + to: {(r subexpression: 3) as: Net Schemes Scheme. + r subexpression: 5. + r subexpression: 6. + r subexpression: 8. + r subexpression: 10}] + ifFalse: [error: 'Unable to parse: ' ; s ; ' as URI'] +]. + +u@(Net URI traits) as: s@(String traits) +[ + [| :result | + u scheme isEmpty ifFalse: [result ; u scheme ; ':']. + u authority isEmpty ifFalse: [result ; '//' ; u authority]. + result ; u path. + u query isEmpty ifFalse: [result ; '?' ; u query]. + u fragment isEmpty ifFalse: [result ; '#' ; u fragment]. + ] streamingAs: '' +]. + +u@(Net URI traits) testParsing +[| myurl | + myurl: (uri readFrom: 'http://localhost/~jewel/moo'). + myurl actor contents print. +]. + + +Net define: #URL &parents: {Net HierarchicalURI} &slots: {}. + +u@(Net URI traits) scheme [overrideThis]. + +u@(Net URL traits) readFrom: s +[| r | + r: (Regex Matcher for: '^(([^:/?#]+)\\:)?(//([^/?#]*))?([^?#]*)(\\?([^#]*))?(#(.*))?'). + (r matches: s) + ifTrue: [Net URL clone `>> + [scheme: ((r subexpression: 3) as: Net Schemes Scheme). + authority: (r subexpression: 5). + path: (r subexpression: 6). + query: (r subexpression: 8). + fragment: (r subexpression: 10). ]] + ifFalse: [error: 'unable to parse URL'] +]. + +u@(Net URL traits) as: s@(String traits) +[ + [| :result | + u scheme ifNotNil: [result ; u scheme uriText ; ':']. + u authority = '' ifFalse: [result ; '//' ; u authority]. + result ; u path. + u query = '' ifFalse: [result ; '?' ; u query]. + u fragment = '' ifFalse: [result ; '#' ; u fragment] + ] streamingAs: '' +].