aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorHolger Hans Peter Freyther <zecke@selfish.org>2011-06-24 18:57:53 +0200
committerHolger Hans Peter Freyther <zecke@selfish.org>2011-06-24 20:08:23 +0200
commit9c5b73d4c6130d3780b40e0f2043fb3553345a09 (patch)
treee52d4c591fc69f65935f64535a4fb91534654eaa
parent212c4068bd01cc40e4e955c6d641ef2693412642 (diff)
callagent: Introduce a MGCPParser and parse it into a MGCPResponse.
-rw-r--r--callagent/MGCPCallAgent.st4
-rw-r--r--callagent/MGCPParser.st37
-rw-r--r--callagent/MGCPResponse.st96
-rw-r--r--callagent/Tests.st37
-rw-r--r--grammar/MGCPGrammar.st4
-rw-r--r--package.xml3
6 files changed, 177 insertions, 4 deletions
diff --git a/callagent/MGCPCallAgent.st b/callagent/MGCPCallAgent.st
index d1f0444..8532303 100644
--- a/callagent/MGCPCallAgent.st
+++ b/callagent/MGCPCallAgent.st
@@ -143,8 +143,8 @@ MGCPCallAgentBase subclass: MGCPCallAgent [
[
| res data id trans |
data := aData data copyFrom: 1 to: aData size.
- res := MGCPGrammar new parse: data asString.
- id := res first third asInteger.
+ res := MGCPParser new parse: data asString.
+ id := res transactionId asInteger.
trans := sem critical: [transactions copy].
trans do: [:each |
diff --git a/callagent/MGCPParser.st b/callagent/MGCPParser.st
new file mode 100644
index 0000000..18c3a2f
--- /dev/null
+++ b/callagent/MGCPParser.st
@@ -0,0 +1,37 @@
+"
+ (C) 2011 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 <http://www.gnu.org/licenses/>.
+"
+
+MGCPGrammar subclass: MGCPParser [
+ <category: 'MGCP-Parser'>
+ <comment: 'I parse responses for now.'>
+
+ MGCPMessage [
+ <category: 'extract'>
+ ^ super MGCPMessage => [:nodes | nodes]
+ ]
+
+ MGCPCommand [
+ <category: 'extract'>
+ ^ super MGCPCommand => [:nodes | nil]
+ ]
+
+ MGCPResponse [
+ <category: 'extract'>
+ ^ super MGCPResponse => [:nodes | MGCPResponse fromDict: nodes]
+ ]
+]
diff --git a/callagent/MGCPResponse.st b/callagent/MGCPResponse.st
new file mode 100644
index 0000000..babcff6
--- /dev/null
+++ b/callagent/MGCPResponse.st
@@ -0,0 +1,96 @@
+"
+ (C) 2011 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 <http://www.gnu.org/licenses/>.
+"
+
+Object subclass: MGCPResponse [
+ | code transaction params sdp |
+
+ <category: 'MGCP-Response'>
+ <comment: 'I provide a nicer way to look at responses'>
+
+ MGCPResponse class >> fromDict: aDict [
+ <category: 'creation'>
+ ^ self new
+ initialize;
+ responseCode: aDict first first;
+ transaction: aDict first third;
+ addParamsFromDict: aDict second;
+ addSDPFromDict: aDict third;
+ yourself
+ ]
+
+ initialize [
+ <category: 'creation'>
+ params := Dictionary new.
+ ]
+
+ responseCode: aCode [
+ <category: 'creation'>
+ code := aCode asInteger
+ ]
+
+ transaction: aTrans [
+ <category: 'creation'>
+ transaction := aTrans.
+ ]
+
+ addParamsFromDict: aList [
+ <category: 'creation'>
+
+ aList do: [:each |
+ params at: each first first asString put: each first fourth].
+ ]
+
+ addSDPFromDict: aDict [
+ | str |
+ <category: 'creation'>
+
+ str := WriteStream on: (String new).
+ aDict second do: [:each |
+ str
+ nextPutAll: each first;
+ cr; nl.
+ ].
+
+ sdp := str contents.
+ ]
+
+ transactionId [
+ <category: 'accessing'>
+ ^ transaction
+ ]
+
+ code [
+ <category: 'accessing'>
+ ^ code
+ ]
+
+ isSuccess [
+ <category: 'accessing'>
+ ^ code >= 200 and: [code < 300].
+ ]
+
+ sdp [
+ <category: 'accessing'>
+ ^ sdp
+ ]
+
+ parameterAt: aKey ifAbsent: aBlock [
+ ^ params at: aKey ifAbsent: aBlock.
+ ]
+
+]
diff --git a/callagent/Tests.st b/callagent/Tests.st
index 8479564..3990aed 100644
--- a/callagent/Tests.st
+++ b/callagent/Tests.st
@@ -259,3 +259,40 @@ TestCase subclass: MGCPEndpointAllocTest [
self assert: endp endpointName = '4@mgw'.
]
]
+
+PP.PPCompositeParserTest subclass: MGCPParserTest [
+ <category: 'parsing tests'>
+
+ parserClass [
+ ^MGCPParser
+ ]
+
+ testRespParse [
+ | nl res sdp |
+ nl := Character cr asString, Character nl asString.
+
+ sdp := 'v=0', nl,
+ 'o=- 258696477 0 IN IP4 172.16.1.107', nl,
+ 's=-', nl,
+ 'c=IN IP4 172.16.1.107', nl,
+ 't=0 0', nl,
+ 'm=audio 6666 RTP/AVP 127', nl,
+ 'a=rtpmap:127 GSM-EFR/8000/1', nl,
+ 'a=ptime:20', nl,
+ 'a=recvonly', nl,
+ 'm=image 4402 udptl t38', nl,
+ 'a=T38FaxVersion:0', nl,
+ 'a=T38MaxBitRate:14400', nl.
+
+ res := self parse: '200 32323 OK', nl,
+ 'I: 233434', nl,
+ nl,
+ sdp.
+
+ self assert: res code = 200.
+ self assert: res isSuccess.
+ self assert: res transactionId = '32323'.
+ self assert: res sdp = sdp.
+ self assert: (res parameterAt: 'I' ifAbsent: []) = '233434'.
+ ]
+]
diff --git a/grammar/MGCPGrammar.st b/grammar/MGCPGrammar.st
index fe2056c..62e98cf 100644
--- a/grammar/MGCPGrammar.st
+++ b/grammar/MGCPGrammar.st
@@ -19,7 +19,7 @@
PackageLoader fileInPackage: 'PetitParser'.
PP.PPCompositeParser subclass: MGCPGrammar [
- | MGCPMessage EOL One_WSP MGCPMessage MGCPCommandLine MGCPVerb transaction_id endpointName MGCPversion MGCPParameter MGCPCommand ParameterValue SDPRecord SDPLine SDPinformation MGCPResponse MGCPResponseLine responseCode responseString packageName |
+ | MGCPMessage EOL One_WSP MGCPMessage MGCPCommandLine MGCPVerb transaction_id endpointName MGCPversion MGCPParameter MGCPCommand ParameterValue SDPRecord SDPLine SDPinformation MGCPResponseLine responseCode responseString packageName |
<category: 'MGCP-Core'>
<comment: 'I am a the Grammar of the Media Gateway Control Protocol'>
@@ -41,7 +41,7 @@ PP.PPCompositeParser subclass: MGCPGrammar [
MGCPMessage [
<category: 'grammar-common'>
- ^ MGCPCommand / MGCPResponse
+ ^ MGCPCommand / self MGCPResponse
]
MGCPCommandLine [
diff --git a/package.xml b/package.xml
index 0ebcfa1..ffcf9bd 100644
--- a/package.xml
+++ b/package.xml
@@ -8,16 +8,19 @@
<filein>callagent/MGCPCallAgent.st</filein>
<filein>callagent/MGCPCommands.st</filein>
+ <filein>callagent/MGCPResponse.st</filein>
<filein>callagent/MGCPEndpoint.st</filein>
<filein>callagent/MGCPLogArea.st</filein>
<filein>callagent/MGCPTransaction.st</filein>
<filein>callagent/MGCPTrunk.st</filein>
+ <filein>callagent/MGCPParser.st</filein>
<test>
<sunit>Osmo.MGCPGrammarTest</sunit>
<sunit>Osmo.MGCPCommandTest</sunit>
<sunit>Osmo.MGCPEndpointAllocTest</sunit>
<sunit>Osmo.MGCPTransactionTest</sunit>
+ <sunit>Osmo.MGCPParserTest</sunit>
<filein>grammar/MGCPGrammarTest.st</filein>
<filein>callagent/Tests.st</filein>
</test>