diff --git a/callagent/parser/SIPParser.st b/callagent/parser/SIPParser.st index 5435f7e..9ffd4a4 100644 --- a/callagent/parser/SIPParser.st +++ b/callagent/parser/SIPParser.st @@ -138,14 +138,6 @@ SIPGrammar subclass: SIPParser [ ^super EQUAL flatten ] - realm_value [ - ^super realm_value => [:nodes | nodes third] - ] - - nonce_value [ - ^super nonce_value => [:nodes | nodes third] - ] - stale [ ^super stale => [:nodes | Array @@ -191,7 +183,7 @@ SIPGrammar subclass: SIPParser [ Array with: nodes first with: nodes second - with: nodes third third] + with: nodes third] ] Authorization [ diff --git a/callagent/tests/SIPParserTest.st b/callagent/tests/SIPParserTest.st index 13fcab3..6348f86 100644 --- a/callagent/tests/SIPParserTest.st +++ b/callagent/tests/SIPParserTest.st @@ -117,6 +117,7 @@ PP.PPCompositeParserTest subclass: SIPParserTest [ self should: [((res parameter: 'To') valueAt: 'foo')] raise: SystemExceptions.NotFound. self assert: (res parameter: 'From') tag = 'MzQ4NTQ0MTg2NzIyNDEwNjkyNjY_'. self assert: (res parameter: 'From') address = 'sip:1000@on-waves.com'. + self assert: res asDatagram equals: self testResponseData. ] testSIPDialog [ @@ -182,6 +183,7 @@ PP.PPCompositeParserTest subclass: SIPParserTest [ from := (res parameter: 'From' ifAbsent: []). self assert: from address equals: 'sip:1000@osmocom.org'. self assert: from tag equals: 'MzQ4ODYyNTkyODQxMDY0OTAxMzI_'. + self assert: res asDatagram equals: self statusResponseData. ] resultUnauthorized [ diff --git a/grammar/SIPGrammar.st b/grammar/SIPGrammar.st index 570ca85..a570b60 100644 --- a/grammar/SIPGrammar.st +++ b/grammar/SIPGrammar.st @@ -346,7 +346,7 @@ PP.PPCompositeParser subclass: SIPGrammar [ quoted_string [ - ^SWS, DQUOTE, (self qdtext / self quoted_pair) star flatten, DQUOTE + ^SIPQuotedStringParser new ] qdtext [ diff --git a/grammar/SIPQuotedStringParser.st b/grammar/SIPQuotedStringParser.st new file mode 100644 index 0000000..b56bfc9 --- /dev/null +++ b/grammar/SIPQuotedStringParser.st @@ -0,0 +1,102 @@ +" + (C) 2011-2014 by Holger Hans Peter Freyther + All Rights Reserved + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as + published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . +" + +PP.PPParser subclass: SIPQuotedStringParser [ + + + + skipWhitespace: aStream [ + [aStream atEnd] whileFalse: [ + | c | + c := aStream uncheckedPeek. + c = ##(Character tab) ifTrue: [aStream next]. + c = ##(Character space) ifTrue: [aStream next]. + ^self + ] + ] + + parseToClosingQuote: aStream startingAt: aStartPointer [ + | text inQuote finish parsed | + text := WriteStream on: String new. + + inQuote := false. + parsed := false. + finish := aStream atEnd. + [finish] whileFalse: [ + "Did we have an escape?" + inQuote + ifTrue: [ + "TODO: Check if that is a valid sequence" + text nextPut: aStream next. + inQuote := false. + finish := aStream atEnd] + ifFalse: [ + | c | + c := aStream uncheckedPeek. + c = $" + ifTrue: [ + aStream skip: 1. + parsed := true. + finish := true] + ifFalse: [ + c = $\ ifTrue: [inQuote := true]. + text nextPut: c. + aStream skip: 1. + finish := aStream atEnd]]]. + + ^parsed + ifFalse: [ + aStream pointer: aStartPointer. + PPFailure message: 'Expected closing quote' at: aStream position] + ifTrue: [ + text contents]. + ] + + parseOn: aStream [ + | startPtr | + + startPtr := aStream pointer. + + "Skip whitespace" + self skipWhitespace: aStream. + + "Check for the opening space" + aStream atEnd ifTrue: [ + aStream pointer: startPtr. + ^PPFailure message: 'No space for opening quote' at: aStream position]. + aStream uncheckedPeek = $" ifFalse: [ + aStream pointer: startPtr. + ^PPFailure message: 'No opening quote' at: aStream position]. + aStream skip: 1. + + ^self parseToClosingQuote: aStream startingAt: startPtr. + ] +] diff --git a/grammar/SIPQuotedStringParserTest.st b/grammar/SIPQuotedStringParserTest.st new file mode 100644 index 0000000..1f767f9 --- /dev/null +++ b/grammar/SIPQuotedStringParserTest.st @@ -0,0 +1,64 @@ +" + (C) 2011-2014 by Holger Hans Peter Freyther + All Rights Reserved + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as + published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . +" + +PP.PPCompositeParserTest subclass: SIPQuotedStringParserTest [ + + + parserClass [ + ^SIPQuotedStringParser + ] + + testParseStrings [ + | res beenHere stream | + + beenHere := false. + stream := '' readStream asPetitStream. + self assert: stream position equals: 0. + res := self parserInstance parse: stream onError: [beenHere := true]. + self assert: stream position equals: 0. + self assert: beenHere. + + beenHere := false. + stream := '"' readStream asPetitStream. + self assert: stream position equals: 0. + res := self parserInstance parse: stream onError: [beenHere := true]. + self assert: stream position equals: 0. + self assert: beenHere. + + stream := '""' readStream asPetitStream. + res := self parse: stream. + self assert: stream atEnd. + self assert: res equals: ''. + + + stream := ' ""' readStream asPetitStream. + res := self parse: stream. + self assert: stream atEnd. + self assert: res equals: ''. + + stream := '"abcdef0123-!"' readStream asPetitStream. + res := self parserInstance parse: stream. + self assert: stream atEnd. + self assert: res equals: 'abcdef0123-!'. + + stream := '"\""' readStream asPetitStream. + res := self parserInstance parse: stream. + self assert: stream atEnd. + self assert: res equals: '\"'. + ] +] diff --git a/package.xml b/package.xml index 0e6918d..e5d7a8c 100644 --- a/package.xml +++ b/package.xml @@ -8,6 +8,7 @@ PetitParser Digest + grammar/SIPQuotedStringParser.st grammar/SIPGrammar.st callagent/Base64MimeConverter.st @@ -63,6 +64,7 @@ PetitParserTests + Osmo.SIPQuotedStringParserTest Osmo.SIPGrammarTest Osmo.SIPParserTest Osmo.SIPRequestTest @@ -73,6 +75,7 @@ Osmo.SIPInviteTest Osmo.SIPBase64Test grammar/SIPGrammarTest.st + grammar/SIPQuotedStringParserTest.st callagent/tests/SIPParserTest.st callagent/tests/Tests.st callagent/tests/SIPCallAgentTest.st