From 216c6fdcb65446358b4efd74f6f50b024ed9812b Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Thu, 10 Jul 2014 18:58:45 +0200 Subject: [PATCH 1/4] mgcp: We want to create an Error and raise it here This is not a log message. This means the area: argument of the message is completely bogus. Found while running a MGCP CallAgent and the MGCP GW was restarting. --- callagent/MGCPEndpoint.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/callagent/MGCPEndpoint.st b/callagent/MGCPEndpoint.st index 42a23ff..c373e3b 100644 --- a/callagent/MGCPEndpoint.st +++ b/callagent/MGCPEndpoint.st @@ -83,7 +83,7 @@ Object subclass: MGCPEndpoint [ state = aState ifFalse: [ ^ self error: 'MGCPEndpoint(%1) not %2.' - % {self endpointName. aState} area: #mgcp. + % {self endpointName. aState}. ]. ] From aa8d9b64c62440f11f71226da1dd507fc0af4cc1 Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Thu, 24 Jul 2014 15:45:42 +0200 Subject: [PATCH 2/4] misc: Use "self basicNew initialize" to be portable --- callagent/MGCPTrunk.st | 4 +--- callagent/Tests.st | 4 +--- 2 files changed, 2 insertions(+), 6 deletions(-) diff --git a/callagent/MGCPTrunk.st b/callagent/MGCPTrunk.st index 04764d2..8f39253 100644 --- a/callagent/MGCPTrunk.st +++ b/callagent/MGCPTrunk.st @@ -23,9 +23,7 @@ Object subclass: MGCPTrunkBase [ MGCPTrunkBase class >> new [ - ^ super new - initialize; - yourself + ^self basicNew initialize ] initialize [ diff --git a/callagent/Tests.st b/callagent/Tests.st index 945e9d3..975ce14 100644 --- a/callagent/Tests.st +++ b/callagent/Tests.st @@ -150,9 +150,7 @@ MGCPCallAgent subclass: MGCPMockNoTransmitAgent [ MGCPMockNoTransmitAgent class >> new [ - ^ super new - initialize; - yourself + ^self basicNew initialize ] initialize [ From 0ffe0afcb511d3abb2c0dda69c15f2b1bf74c770 Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Sat, 9 Aug 2014 21:15:20 +0200 Subject: [PATCH 3/4] Add >>#endpointNumber and add some test cases for it. --- callagent/MGCPEndpoint.st | 5 +++++ callagent/Tests.st | 4 ++++ 2 files changed, 9 insertions(+) diff --git a/callagent/MGCPEndpoint.st b/callagent/MGCPEndpoint.st index c373e3b..d28615a 100644 --- a/callagent/MGCPEndpoint.st +++ b/callagent/MGCPEndpoint.st @@ -39,6 +39,11 @@ Object subclass: MGCPEndpoint [ ^ trunk endpointName: nr. ] + endpointNumber [ + + ^ nr + ] + multiplex [ ^ trunk multiplexFor: nr. diff --git a/callagent/Tests.st b/callagent/Tests.st index 975ce14..918ec45 100644 --- a/callagent/Tests.st +++ b/callagent/Tests.st @@ -115,8 +115,10 @@ TestCase subclass: MGCPCommandTest [ | trunk | trunk := MGCPDSTrunk createWithDest: '0.0.0.0' trunkNr: 3. + self assert: (self trunk endpointAt: 1) endpointNumber equals: 1. self assert: (self trunk endpointAt: 1) multiplex = 0. self assert: (self trunk endpointAt: 1) timeslot = 1. + self assert: (self trunk endpointAt: 31) endpointNumber equals: 31. self assert: (self trunk endpointAt: 31) multiplex = 0. self assert: (self trunk endpointAt: 31) timeslot = 31. @@ -282,6 +284,7 @@ TestCase subclass: MGCPEndpointAllocTest [ "Initial..." self assert: endp isUnused. + self assert: endp endpointNumber equals: 1. "Reserve..." endp reserve. @@ -332,6 +335,7 @@ TestCase subclass: MGCPEndpointAllocTest [ self assert: (trunk allocateEndpointIfFailure: [true]). "now free some endpoints" + self assert: (trunk endpointAt: 20) endpointNumber equals: 20. (trunk endpointAt: 20) free. (trunk endpointAt: 5) free. endp := (trunk allocateEndpointIfFailure: []). From d5248eceecd9d2f8c7061538163bc8ec80168dfc Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Tue, 26 Aug 2014 19:04:52 +0200 Subject: [PATCH 4/4] mgcp: Be able to parse the X-Osmux extension we have --- callagent/Tests.st | 18 ++++++++++++++++++ grammar/MGCPGrammar.st | 3 ++- 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/callagent/Tests.st b/callagent/Tests.st index 918ec45..a0f42a4 100644 --- a/callagent/Tests.st +++ b/callagent/Tests.st @@ -379,10 +379,28 @@ PP.PPCompositeParserTest subclass: MGCPParserTest [ ] + exampleCRCXWithOsmux [ + ^String streamContents: [:stream | + stream + nextPutAll: 'CRCX 361562151 1@mgw MGCP 1.0'; nl; + nextPutAll: 'X-Osmux: on'; cr; nl; + nextPutAll: 'C: f553fcb979'; cr; nl; + nextPutAll: 'L: p:20, a:AMR, nt:IN'; cr; nl; + nextPutAll: 'M: recvonly'; cr; nl + ] + + ] + parserClass [ ^MGCPParser ] + testParseCRCXWithOsmux [ + | crcx | + crcx := self parse: self exampleCRCXWithOsmux. + self assert: crcx class verb equals: 'CRCX'. + ] + testParseCRCX [ | crcx | crcx := self parse: self class crcxMessage. diff --git a/grammar/MGCPGrammar.st b/grammar/MGCPGrammar.st index dcde4e2..2986273 100644 --- a/grammar/MGCPGrammar.st +++ b/grammar/MGCPGrammar.st @@ -130,7 +130,8 @@ PP.PPCompositeParser subclass: MGCPGrammar [ ('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) / - ('X-Osmo-CP' asParser, $: asParser, #blank asParser star, self wordParser star flatten) + ('X-Osmo-CP' asParser, $: asParser, #blank asParser star, self wordParser star flatten) / + ('X-Osmux' asParser, $: asParser, #blank asParser star, self wordParser star flatten) ] MGCPResponse [