From be46bf5b3592a58f5d9f3aa6946da9aca7c6544a Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Fri, 14 Mar 2014 15:06:06 +0100 Subject: [PATCH 1/6] mgcp: Be able to parse the first osmocom vendor extension --- grammar/MGCPGrammar.st | 3 ++- grammar/MGCPGrammarTest.st | 9 +++++++++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/grammar/MGCPGrammar.st b/grammar/MGCPGrammar.st index d6270d6..5ed374e 100644 --- a/grammar/MGCPGrammar.st +++ b/grammar/MGCPGrammar.st @@ -127,7 +127,8 @@ PP.PPCompositeParser subclass: MGCPGrammar [ ($A asParser, $: asParser, #blank asParser star, self wordParser star flatten) / ('ES' asParser, $: asParser, #blank asParser star, self wordParser star flatten) / ('PL' asParser, $: asParser, #blank asParser star, self wordParser star flatten) / - ('MD' asParser, $: asParser, #blank asParser star, self wordParser star flatten) + ('MD' asParser, $: asParser, #blank asParser star, self wordParser star flatten) / + ('X-Osmo-CP' asParser, $: asParser, #blank asParser star, self wordParser star flatten) ] MGCPResponse [ diff --git a/grammar/MGCPGrammarTest.st b/grammar/MGCPGrammarTest.st index 1ac83ba..1262d29 100644 --- a/grammar/MGCPGrammarTest.st +++ b/grammar/MGCPGrammarTest.st @@ -90,4 +90,13 @@ PP.PPCompositeParserTest subclass: MGCPGrammarTest [ self assert: res first first = '200'. self assert: res first third = '433414656'. ] + + testDlcxResponse [ + | res inp | + + inp := #[50 53 48 32 54 56 51 52 53 53 50 52 52 32 79 75 13 10 80 58 32 80 83 61 49 54 57 44 32 79 83 61 55 54 48 53 44 32 80 82 61 48 44 32 79 82 61 48 44 32 80 76 61 48 44 32 74 73 61 48 13 10 88 45 79 115 109 111 45 67 80 58 32 69 67 32 84 73 83 61 48 44 32 84 79 83 61 48 44 32 84 73 82 61 48 44 32 84 79 82 61 48 13 10]. + + res := self parse: inp asString. + res inspect. + ] ] From f0549c2df8860aee6887b8c9426701ddb5d67cb2 Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Wed, 28 May 2014 18:21:14 +0200 Subject: [PATCH 2/6] command: Be able to parse a MGCP Command The Command and Response code could and should share parts. Start with slowly aligning the APIs and begin being able to parse a command from a string. --- callagent/MGCPCommands.st | 70 +++++++++++++++++++++++++++++++-------- callagent/MGCPParser.st | 6 +++- callagent/Tests.st | 34 ++++++++++++++----- 3 files changed, 87 insertions(+), 23 deletions(-) diff --git a/callagent/MGCPCommands.st b/callagent/MGCPCommands.st index 91c9fe7..1e316f0 100644 --- a/callagent/MGCPCommands.st +++ b/callagent/MGCPCommands.st @@ -16,27 +16,45 @@ along with this program. If not, see . " -Object subclass: MGCPCommand [ +Object subclass: MGCPCommandBase [ | transaction endp params sdp | - MGCPCommand class >> create: anEndpoint callId: aCallId [ - ^ (self new) - endpoint: anEndpoint; - parameterAdd: 'C: ', aCallId asString; + MGCPCommandBase class >> fromDict: nodes [ + | verb | + verb := nodes first. + self allSubclassesDo: [:each | + each verb = verb + ifTrue: [^each parseFromDict: nodes]]. + ^self error: 'Unknown command verb "%1"' % {verb}. + ] + + MGCPCommandBase class >> parseFromDict: nodes [ + ^self new + transactionId: nodes third; + endpoint: (nodes at: 5); + addParametersInternal: (nodes at: 9); + sdp: (nodes at: 10); yourself ] - MGCPCommand class >> create: anEndpoint [ + MGCPCommandBase class >> create: anEndpoint callId: aCallId [ + ^ (self new) + endpoint: anEndpoint; + addParameter: 'C' with: aCallId asString; + yourself + ] + + MGCPCommandBase class >> create: anEndpoint [ ^ (self new) endpoint: anEndpoint; yourself ] - MGCPCommand class >> verb [ + MGCPCommandBase class >> verb [ ^ self subclassResponsibility ] @@ -53,7 +71,29 @@ Object subclass: MGCPCommand [ parameterAdd: aParam [ - self params add: aParam. + ^self error: 'This is deprecated. Use >>#addParameter:with:' + ] + + addParameter: aKey with: aValue [ + ^self params add: aKey->aValue. + ] + + addParametersInternal: anArray [ + + "TODO: Share code with MGCPResponse" + anArray do: [:each | + self addParameter: each first first asString with: each first fourth]. + ] + + parameterAt: aKey [ + ^self parameterAt: aKey ifAbsent: [^self error: 'Parameter not found']. + ] + + parameterAt: aKey ifAbsent: aBlock [ + self params do: [:each | + each key = aKey + ifTrue: [^each value]]. + ^aBlock value. ] params [ @@ -85,7 +125,9 @@ Object subclass: MGCPCommand [ "write the parameters" self params do: [:each | out - nextPutAll: each; + nextPutAll: each key; + nextPutAll: ': '; + nextPutAll: each value; cr; nl. ]. @@ -100,7 +142,7 @@ Object subclass: MGCPCommand [ ] ] -MGCPCommand subclass: MGCPCRCXCommand [ +MGCPCommandBase subclass: MGCPCRCXCommand [ @@ -118,7 +160,7 @@ MGCPCommand subclass: MGCPCRCXCommand [ ] ] -MGCPCommand subclass: MGCPMDCXCommand [ +MGCPCommandBase subclass: MGCPMDCXCommand [ @@ -135,7 +177,7 @@ MGCPCommand subclass: MGCPMDCXCommand [ ] ] -MGCPCommand subclass: MGCPDLCXCommand [ +MGCPCommandBase subclass: MGCPDLCXCommand [ @@ -150,7 +192,7 @@ MGCPCommand subclass: MGCPDLCXCommand [ ] ] -MGCPCommand subclass: MGCPAUEPComamnd [ +MGCPCommandBase subclass: MGCPAUEPComamnd [ @@ -165,7 +207,7 @@ MGCPCommand subclass: MGCPAUEPComamnd [ ] ] -MGCPCommand subclass: MGCPOsmoRSIPCommand [ +MGCPCommandBase subclass: MGCPOsmoRSIPCommand [ diff --git a/callagent/MGCPParser.st b/callagent/MGCPParser.st index a052f55..f05041e 100644 --- a/callagent/MGCPParser.st +++ b/callagent/MGCPParser.st @@ -27,11 +27,15 @@ MGCPGrammar subclass: MGCPParser [ MGCPCommand [ - ^ super MGCPCommand => [:nodes | nil] + ^ super MGCPCommand => [:nodes | MGCPCommandBase fromDict: nodes] ] MGCPResponse [ ^ super MGCPResponse => [:nodes | MGCPResponse fromDict: nodes] ] + + endpointName [ + ^super endpointName flatten + ] ] diff --git a/callagent/Tests.st b/callagent/Tests.st index d9ce38b..4ec2175 100644 --- a/callagent/Tests.st +++ b/callagent/Tests.st @@ -78,8 +78,8 @@ TestCase subclass: MGCPCommandTest [ trans := MGCPTransaction on: self endpoint of: self callagent. trans transactionId: '808080'. crcx := (MGCPCRCXCommand createCRCX: self endpoint callId: '4a84ad5d25f') - parameterAdd: 'L: p:20, a:GSM-EFR, nt:IN'; - parameterAdd: 'M: recvonly'; + addParameter: 'L' with: 'p:20, a:GSM-EFR, nt:IN'; + addParameter: 'M' with: 'recvonly'; yourself. trans command: crcx. @@ -130,8 +130,8 @@ TestCase subclass: MGCPCommandTest [ trans := MGCPTransaction on: self endpoint of: self callagent. trans transactionId: '808080'. mdcx := (MGCPMDCXCommand createMDCX: self endpoint callId: '4a84ad5d25f') - parameterAdd: 'L: p:20, a:GSM-EFR, nt:IN'; - parameterAdd: 'M: recvonly'; + addParameter: 'L' with: 'p:20, a:GSM-EFR, nt:IN'; + addParameter: 'M' with: 'recvonly'; sdp: self exampleSDP; yourself. trans command: mdcx. @@ -224,8 +224,8 @@ TestCase subclass: MGCPTransactionTest [ trans := MGCPShortTransaction on: self endpoint of: self timeoutCallagent. crcx := (MGCPCRCXCommand createCRCX: self endpoint callId: '4a84ad5d25f') - parameterAdd: 'L: p:20, a:GSM-EFR, nt:IN'; - parameterAdd: 'M: recvonly'; + addParameter: 'L' with: 'p:20, a:GSM-EFR, nt:IN'; + addParameter: 'M' with: 'recvonly'; yourself. trans command: crcx. @@ -248,8 +248,8 @@ TestCase subclass: MGCPTransactionTest [ trans := MGCPShortTransaction on: self endpoint of: self dropAgent. crcx := (MGCPCRCXCommand createCRCX: self endpoint callId: '4a84ad5d25f') - parameterAdd: 'L: p:20, a:GSM-EFR, nt:IN'; - parameterAdd: 'M: recvonly'; + addParameter: 'L' with: 'p:20, a:GSM-EFR, nt:IN'; + addParameter: 'M' with: 'recvonly'; yourself. trans command: crcx. @@ -352,10 +352,28 @@ TestCase subclass: MGCPEndpointAllocTest [ PP.PPCompositeParserTest subclass: MGCPParserTest [ + MGCPParserTest class >> crcxMessage [ + ^String streamContents: [:stream | + stream + nextPutAll: 'CRCX 1 14@mgw MGCP 1.0'; cr; nl; + nextPutAll: 'C: 4a84ad5d25f'; cr; nl; + nextPutAll: 'L: p:20, a:GSM-EFR, nt:IN'; cr; nl; + nextPutAll: 'M: recvonly'; cr; nl] + ] + parserClass [ ^MGCPParser ] + testParseCRCX [ + | crcx | + crcx := self parse: self class crcxMessage. + + self assert: crcx class verb equals: 'CRCX'. + self assert: (crcx parameterAt: 'M') equals: 'recvonly'. + self assert: crcx asDatagram equals: self class crcxMessage. + ] + testRespParse [ | nl res sdp | nl := Character cr asString, Character nl asString. From da6b55669646968d03d9d7ad6dae74c38fc6bcc0 Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Thu, 29 May 2014 21:32:53 +0200 Subject: [PATCH 3/6] mgcp: Fix the name of the AUEP command --- callagent/MGCPCommands.st | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/callagent/MGCPCommands.st b/callagent/MGCPCommands.st index 1e316f0..921701c 100644 --- a/callagent/MGCPCommands.st +++ b/callagent/MGCPCommands.st @@ -192,16 +192,16 @@ MGCPCommandBase subclass: MGCPDLCXCommand [ ] ] -MGCPCommandBase subclass: MGCPAUEPComamnd [ +MGCPCommandBase subclass: MGCPAUEPCommand [ - MGCPAUEPComamnd class >> verb [ + MGCPAUEPCommand class >> verb [ ^ 'AUEP' ] - MGCPAUEPComamnd class >> createAUEP: anEndpoint [ + MGCPAUEPCommand class >> createAUEP: anEndpoint [ ^ (self create: anEndpoint) yourself ] From 2b5089d84deda5c94db3865a5b58f12b241959f1 Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Thu, 29 May 2014 21:52:50 +0200 Subject: [PATCH 4/6] mgcp: Be able to parse a Osmocom transaction ID the namespace nat-NUMBER is not valid according to the grammar. Add an optional extension for it and add a testcase. In case we get too many extensions we might introduce a MGCPGrammar subclass for osmocom. --- callagent/Tests.st | 15 +++++++++++++++ grammar/MGCPGrammar.st | 4 +++- 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/callagent/Tests.st b/callagent/Tests.st index 4ec2175..6706dde 100644 --- a/callagent/Tests.st +++ b/callagent/Tests.st @@ -361,6 +361,13 @@ PP.PPCompositeParserTest subclass: MGCPParserTest [ nextPutAll: 'M: recvonly'; cr; nl] ] + MGCPParserTest class >> natDLCXMessage [ + ^String streamContents: [:stream | + stream + nextPutAll: 'DLCX nat-0 1@mgw MGCP 1.0'; cr; nl] + + ] + parserClass [ ^MGCPParser ] @@ -374,6 +381,14 @@ PP.PPCompositeParserTest subclass: MGCPParserTest [ self assert: crcx asDatagram equals: self class crcxMessage. ] + testParseDLCX [ + | dlcx | + dlcx := self parse: self class natDLCXMessage. + + self assert: dlcx class verb equals: 'DLCX'. + self assert: dlcx asDatagram equals: self class natDLCXMessage. + ] + testRespParse [ | nl res sdp | nl := Character cr asString, Character nl asString. diff --git a/grammar/MGCPGrammar.st b/grammar/MGCPGrammar.st index 5ed374e..fb0afe1 100644 --- a/grammar/MGCPGrammar.st +++ b/grammar/MGCPGrammar.st @@ -71,7 +71,9 @@ PP.PPCompositeParser subclass: MGCPGrammar [ transaction_id [ - ^ ((#digit asParser) min: 1 max: 9) flatten + "Add Osmocom extension that starts with 'nat-'" + ^ ((#digit asParser) min: 1 max: 9) flatten / + ('nat-' asParser, (#digit asParser) min: 1 max: 9) flatten ] endpointName [ From 2796b46a1f219e90363e88d9436adf1be6d502b1 Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Fri, 30 May 2014 18:00:11 +0200 Subject: [PATCH 5/6] align: Align command and response handling Make sure that both have a transactionId setter and getter --- callagent/MGCPCommands.st | 4 ++++ callagent/MGCPResponse.st | 5 +++++ 2 files changed, 9 insertions(+) diff --git a/callagent/MGCPCommands.st b/callagent/MGCPCommands.st index 921701c..ef9d713 100644 --- a/callagent/MGCPCommands.st +++ b/callagent/MGCPCommands.st @@ -69,6 +69,10 @@ Object subclass: MGCPCommandBase [ transaction := anId. ] + transactionId [ + ^transaction + ] + parameterAdd: aParam [ ^self error: 'This is deprecated. Use >>#addParameter:with:' diff --git a/callagent/MGCPResponse.st b/callagent/MGCPResponse.st index c932a1e..0d5f5f1 100644 --- a/callagent/MGCPResponse.st +++ b/callagent/MGCPResponse.st @@ -44,6 +44,11 @@ Object subclass: MGCPResponse [ ] transaction: aTrans [ + + self transactionId: aTrans + ] + + transactionId: aTrans [ transaction := aTrans. ] From 948264560fa608c487bf3cccd2055cb919ebbbb0 Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Fri, 30 May 2014 19:01:26 +0200 Subject: [PATCH 6/6] sdp: Parse the SDP file in the command like it is done in the response --- callagent/MGCPCommands.st | 2 +- callagent/MGCPResponse.st | 31 ++++++++++++++++--------------- callagent/Tests.st | 5 ++++- 3 files changed, 21 insertions(+), 17 deletions(-) diff --git a/callagent/MGCPCommands.st b/callagent/MGCPCommands.st index ef9d713..493a0c3 100644 --- a/callagent/MGCPCommands.st +++ b/callagent/MGCPCommands.st @@ -37,7 +37,7 @@ Object subclass: MGCPCommandBase [ transactionId: nodes third; endpoint: (nodes at: 5); addParametersInternal: (nodes at: 9); - sdp: (nodes at: 10); + sdp: (MGCPResponse sdpFromDict: (nodes at: 10)); yourself ] diff --git a/callagent/MGCPResponse.st b/callagent/MGCPResponse.st index 0d5f5f1..813327f 100644 --- a/callagent/MGCPResponse.st +++ b/callagent/MGCPResponse.st @@ -33,6 +33,21 @@ Object subclass: MGCPResponse [ yourself ] + MGCPResponse class >> sdpFromDict: aDict [ + | str | + + aDict isNil ifTrue: [ + ^nil + ]. + + str := WriteStream on: (String new). + ^String streamContents: [:stream | + aDict second do: [:each | + stream + nextPutAll: each first; + cr; nl.]] + ] + initialize [ params := Dictionary new. @@ -61,22 +76,8 @@ Object subclass: MGCPResponse [ ] addSDPFromDict: aDict [ - | str | - - aDict isNil ifTrue: [ - sdp := nil. - ^ self - ]. - - str := WriteStream on: (String new). - aDict second do: [:each | - str - nextPutAll: each first; - cr; nl. - ]. - - sdp := str contents. + sdp := self class sdpFromDict: aDict. ] transactionId [ diff --git a/callagent/Tests.st b/callagent/Tests.st index 6706dde..db179f4 100644 --- a/callagent/Tests.st +++ b/callagent/Tests.st @@ -358,7 +358,10 @@ PP.PPCompositeParserTest subclass: MGCPParserTest [ nextPutAll: 'CRCX 1 14@mgw MGCP 1.0'; cr; nl; nextPutAll: 'C: 4a84ad5d25f'; cr; nl; nextPutAll: 'L: p:20, a:GSM-EFR, nt:IN'; cr; nl; - nextPutAll: 'M: recvonly'; cr; nl] + nextPutAll: 'M: recvonly'; cr; nl; + cr; nl; + nextPutAll: 'v=0'; cr; nl; + nextPutAll: 'b=0'; cr; nl] ] MGCPParserTest class >> natDLCXMessage [