From 009957dffc175e609b7bef6047b860ea0a073c57 Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Sat, 6 Apr 2013 11:36:41 +0200 Subject: [PATCH] mtp3: Introduce some basic structures for MTP3 decoding This starts to introduce some basic MTP3 message decoding and encoding using the generic MessageBuffer classes. --- Makefile | 6 +- mtp3/MTP3Messages.st | 1435 +++++++++++++++++++++++++++++++++++++ mtp3/MTP3MessagesTests.st | 101 +++ package.xml | 9 + 4 files changed, 1549 insertions(+), 2 deletions(-) create mode 100644 mtp3/MTP3Messages.st create mode 100644 mtp3/MTP3MessagesTests.st diff --git a/Makefile b/Makefile index 20daddd..65f5887 100644 --- a/Makefile +++ b/Makefile @@ -43,7 +43,9 @@ OSMO = \ osmo/OsmoUDPSocket.st osmo/OsmoCtrlLogging.st \ osmo/OsmoCtrlGrammar.st osmo/OsmoAppConnection.st \ osmo/OsmoCtrlConnection.st osmo/OsmoCtrlGrammarTest.st - + +MTP3 = \ + mtp3/MTP3Messages.st mtp3/MTP3MessagesTests.st @@ -53,7 +55,7 @@ all: convert: $(GST_CONVERT) $(CONVERT_RULES) -F squeak -f gst \ -o fileout.st pharo-porting/compat_for_pharo.st \ - $(CORE) $(IPA) $(SCCP) $(ISUP) $(UA) $(OSMO) \ + $(CORE) $(IPA) $(SCCP) $(ISUP) $(UA) $(OSMO) $(MTP3) \ Tests.st pharo-porting/changes_for_pharo.st sed -i s,"=>","==>",g fileout.st diff --git a/mtp3/MTP3Messages.st b/mtp3/MTP3Messages.st new file mode 100644 index 0000000..d16b36e --- /dev/null +++ b/mtp3/MTP3Messages.st @@ -0,0 +1,1435 @@ +" + (C) 2013 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 . +" + +Object subclass: MTP3Address [ + | dpc opc | + + + +] + + + +Object subclass: MTP3Service [ + | on_transfer on_pause on_resume on_status | + + + + + transfer: aByteArray to: anAddr [ + + ^self notYetImplemented + ] + + onPause: aBlock [ + "Called with DPC" + + + on_pause := aBlock + ] + + onResume: aBlock [ + "Called with affected DPC" + + + on_resume := aBlock + ] + + onStatus: aBlock [ + "Called with the Affected DPC" + + + on_status := aBlock + ] + + onTransfer: aBlock [ + "Called with MTP3Address and UserData" + + + on_transfer := aBlock + ] +] + + + +Object subclass: MTP3NetworkManagementTimer [ + + + + + MTP3NetworkManagementTimer class >> T1 [ + "Delay to avoid message mis-sequencing on changeover." + + + ^500 to: 1200 + ] + + MTP3NetworkManagementTimer class >> T10 [ + "Waiting to repeat signalling route set test message. + The maximum value may be extended at the discretion of the management function in + certain situations, e.g. many signalling points being unavailable or signalling point of + known long term unavailability." + + + ^30000 to: 60000 + ] + + MTP3NetworkManagementTimer class >> T11 [ + "Transfer restricted timer. (This is one way of implementing the function described in + 13.4 and mainly intended to simplify STPs.)" + + + ^30000 to: 90000 + ] + + MTP3NetworkManagementTimer class >> T12 [ + "Waiting for uninhibit acknowledgement." + + + ^800 to: 1500 + ] + + MTP3NetworkManagementTimer class >> T13 [ + "Waiting for force uninhibit." + + + ^800 to: 1500 + ] + + MTP3NetworkManagementTimer class >> T14 [ + "Waiting for inhibition acknowledgement." + + + ^2000 to: 3000 + ] + + MTP3NetworkManagementTimer class >> T15 [ + "Waiting to start signalling route set congestion test." + + + ^2000 to: 3000 + ] + + MTP3NetworkManagementTimer class >> T16 [ + "Waiting for route set congestion status update." + + + ^1400 to: 2000 + ] + + MTP3NetworkManagementTimer class >> T17 [ + "Delay to avoid oscillation of initial alignment failure and link restart." + + + ^800 to: 1500 + ] + + MTP3NetworkManagementTimer class >> T18 [ + "Timer8 within a signalling point whose MTP restarts for supervising link and link set + activation as well as the receipt of routing information. + The value is implementation and network dependent. + Criteria to choose T18 are given in 9.2." + + + ^self notYetImplemented + ] + + MTP3NetworkManagementTimer class >> T19 [ + "Supervision timer during MTP restart to avoid possible ping-pong of TFP, TFR1 and + TRA messages." + + + ^67000 to: 69000 + ] + + MTP3NetworkManagementTimer class >> T2 [ + "Waiting for changeover acknowledgement." + + + ^700 to: 2000 + ] + + MTP3NetworkManagementTimer class >> T20 [ + "Overall MTP restart timer at the signalling point whose MTP restarts." + + + ^59000 to: 61000 + ] + + MTP3NetworkManagementTimer class >> T21 [ + "Overall MTP restart timer at a signalling point adjacent to one whose MTP restarts." + + + ^63000 to: 65000 + ] + + MTP3NetworkManagementTimer class >> T22 [ + "Local inhibit test timer." + + + ^3 * 60 * 1000 to: 6 * 60 * 1000 + ] + + MTP3NetworkManagementTimer class >> T23 [ + "Remote inhibit test timer." + + + ^3 * 60 * 1000 to: 6 * 60 * 1000 + ] + + MTP3NetworkManagementTimer class >> T24 [ + "Stabilising timer after removal of local processor outage, used in LPO latching to RPO + (national option)." + + + ^500 to: 500 + ] + + MTP3NetworkManagementTimer class >> T3 [ + "Time controlled diversion-delay to avoid mis-sequencing on changeback." + + + ^500 to: 1200 + ] + + MTP3NetworkManagementTimer class >> T4 [ + "Waiting for changeback acknowledgement (first attempt)." + + + ^500 to: 1200 + ] + + MTP3NetworkManagementTimer class >> T5 [ + "Waiting for changeback acknowledgement (second attempt)." + + + ^500 to: 1200 + ] + + MTP3NetworkManagementTimer class >> T6 [ + "Delay to avoid message mis-sequencing on controlled rerouting." + + + ^500 to: 1200 + ] + + MTP3NetworkManagementTimer class >> T7 [ + "Waiting for signalling data link connection acknowledgement." + + + ^1000 to: 2000 + ] + + MTP3NetworkManagementTimer class >> T8 [ + "Transfer prohibited inhibition timer (transient solution)." + + + ^800 to: 1200 + ] + + MTP3NetworkManagementTimer class >> T9 [ + + ^self shouldNotImplement + ] +] + + + +Object subclass: MTP3Field [ + + + +] + + + +MTP3Field subclass: MTP3Heading [ + | h0 h1 | + + + + + MTP3Heading class >> parseFrom: aStream [ + | byte | + byte := aStream next. + ^(self new) + h0: (byte bitAnd: 2r1111); + h1: (byte bitShift: -4); + yourself + ] + + h0: aHeading [ + + h0 := aHeading + ] + + h1: aHeading [ + + h1 := aHeading + ] + + h0 [ + + ^h0 + ] + + h1 [ + + ^h1 + ] + + writeOn: aBuffer [ + + | byte | + byte := h0 bitOr: (h1 bitShift: 4). + aBuffer putByte: byte + ] +] + + + +Object subclass: MTP3LinkTestTimer [ + + + + + T1 [ + "Supervision timer for signalling link test + acknowledgement message. Equal or greater than T6 of Q.703" + + ^4 * 1000 to: 12 * 1000 + ] + + T2 [ + "Interval timer for sending signalling link + test messages" + + ^30 * 1000 to: 90 * 1000 + ] +] + + + +Object subclass: MTP3MSG [ + | service label heading | + + + + + MTP3MSG class >> findMessageClassFor: aServiceIndicator heading: aHeading [ + + self subclassesDo: + [:each | + (each isServiceCompatible: aServiceIndicator) + ifTrue: [^each findClassForHeading: aHeading]]. + ^nil + ] + + MTP3MSG class >> parseFrom: aStream [ + + | service label heading msg | + service := MTP3ServiceIndicators parseFrom: aStream. + label := MTP3Label parseFrom: aStream. + heading := MTP3Heading parseFrom: aStream. + msg := ((self findMessageClassFor: service heading: heading) new) + service: service; + label: label; + heading: heading; + parseFrom: aStream; + yourself. + ^msg + ] + + heading: aHeading [ + + heading := aHeading + ] + + label: aLabel [ + + label := aLabel + ] + + service: aService [ + + service := aService + ] + + writeOn: aBuffer [ + + service writeOn: aBuffer. + label writeOn: aBuffer. + heading writeOn: aBuffer + ] +] + + + +MTP3MSG subclass: MTP3LinkTestMSG [ + | pattern | + + + + + MTP3LinkTestMSG class >> h0 [ + ^2r0001 + ] + + MTP3LinkTestMSG class >> h1SLTA [ + ^2r0010 + ] + + MTP3LinkTestMSG class >> h1SLTM [ + ^2r0001 + ] + + MTP3LinkTestMSG class >> findClassForHeading: aHeading [ + + aHeading h0 = self h0 ifFalse: [^self error: 'Wrong heading']. + self subclassesDo: [:each | each h1 = aHeading h1 ifTrue: [^each]] + ] + + MTP3LinkTestMSG class >> isServiceCompatible: aServiceIndicator [ + + ^aServiceIndicator serviceIndicator + = MTP3ServiceIndicators signallingNetworkTestingAndMaintenance + ] + + writeOn: aBuffer [ + + | len | + super writeOn: aBuffer. + len := (pattern size bitShift: 4) bitAnd: 2r11110000. + aBuffer putByte: len. + aBuffer putByteArray: pattern + ] + + parseFrom: aStream [ + + | length | + length := aStream next bitShift: -4. + self testPattern: (aStream next: length) + ] + + testPattern [ + + ^pattern + ] + + testPattern: aPattern [ + + pattern := aPattern + ] +] + + + +MTP3MSG subclass: MTP3NetworkManagementMSG [ + + + + + MTP3NetworkManagementMSG class >> h0Chm [ + + ^2r0001 + ] + + MTP3NetworkManagementMSG class >> h0Dlm [ + + ^2r1000 + ] + + MTP3NetworkManagementMSG class >> h0Ecm [ + + ^2r0010 + ] + + MTP3NetworkManagementMSG class >> h0Fcm [ + + ^2r0011 + ] + + MTP3NetworkManagementMSG class >> h0Mim [ + + ^2r0110 + ] + + MTP3NetworkManagementMSG class >> h0Rsm [ + + ^2r0101 + ] + + MTP3NetworkManagementMSG class >> h0Tfm [ + + ^2r0100 + ] + + MTP3NetworkManagementMSG class >> h0Trm [ + + ^2r0111 + ] + + MTP3NetworkManagementMSG class >> h0Ufc [ + + ^2r1010 + ] + + MTP3NetworkManagementMSG class >> h1CBA [ + + ^2r0110 + ] + + MTP3NetworkManagementMSG class >> h1CBD [ + + ^2r0101 + ] + + MTP3NetworkManagementMSG class >> h1COA [ + + ^2r0010 + ] + + MTP3NetworkManagementMSG class >> h1COO [ + + ^2r0001 + ] + + MTP3NetworkManagementMSG class >> h1CNP [ + + ^2r0100 + ] + + MTP3NetworkManagementMSG class >> h1CNS [ + + ^2r0011 + ] + + MTP3NetworkManagementMSG class >> h1CSS [ + + ^2r0010 + ] + + MTP3NetworkManagementMSG class >> h1DLC [ + + ^2r0001 + ] + + MTP3NetworkManagementMSG class >> h1ECA [ + + ^2r0010 + ] + + MTP3NetworkManagementMSG class >> h1ECO [ + + ^2r0001 + ] + + MTP3NetworkManagementMSG class >> h1RCT [ + + ^2r0001 + ] + + MTP3NetworkManagementMSG class >> h1TFC [ + + ^2r0010 + ] + + MTP3NetworkManagementMSG class >> h1LFU [ + + ^2r0110 + ] + + MTP3NetworkManagementMSG class >> h1LIA [ + + ^2r0011 + ] + + MTP3NetworkManagementMSG class >> h1LID [ + + ^2r0101 + ] + + MTP3NetworkManagementMSG class >> h1LIN [ + + ^2r0001 + ] + + MTP3NetworkManagementMSG class >> h1LLT [ + + ^2r0111 + ] + + MTP3NetworkManagementMSG class >> h1LRT [ + + ^2r1000 + ] + + MTP3NetworkManagementMSG class >> h1LUA [ + + ^2r0100 + ] + + MTP3NetworkManagementMSG class >> h1LUN [ + + ^2r0010 + ] + + MTP3NetworkManagementMSG class >> h1RSR [ + + ^2r0010 + ] + + MTP3NetworkManagementMSG class >> h1RST [ + + ^2r0001 + ] + + MTP3NetworkManagementMSG class >> h1TFA [ + + ^2r0101 + ] + + MTP3NetworkManagementMSG class >> h1TFP [ + + ^2r0001 + ] + + MTP3NetworkManagementMSG class >> h1TFR [ + + ^2r0011 + ] + + MTP3NetworkManagementMSG class >> h1TRA [ + + ^2r0001 + ] + + MTP3NetworkManagementMSG class >> h1UPU [ + + ^2r0001 + ] + + MTP3NetworkManagementMSG class >> isServiceCompatible: aServiceIndicator [ + + ^aServiceIndicator serviceIndicator + = MTP3ServiceIndicators signallingNetworkManagement + ] +] + + + +MTP3NetworkManagementMSG subclass: MTP3TRMMSG [ + + + + + MTP3TRMMSG class >> h0 [ + ^self h0Trm + ] + + MTP3TRMMSG class >> humanName [ + ^'Traffic-restart-allowed message' + ] +] + + + +MTP3NetworkManagementMSG subclass: MTP3CHMMSG [ + + + + + MTP3CHMMSG class >> h0 [ + ^self h0Chm + ] + + MTP3CHMMSG class >> humanName [ + ^'Changeover and changeback messages' + ] +] + + + +MTP3NetworkManagementMSG subclass: MTP3ECMMSG [ + + + + + MTP3ECMMSG class >> h0 [ + ^self h0Ecm + ] + + MTP3ECMMSG class >> humanName [ + ^'Emergency-changeover message' + ] +] + + + +MTP3LinkTestMSG subclass: MTP3SLTMMSG [ + + + + + MTP3SLTMMSG class >> h1 [ + ^self h1SLTM + ] + + MTP3SLTMMSG class >> humanName [ + ^'signalling link test acknowledgement message' + ] +] + + + +MTP3CHMMSG subclass: MTP3CBAMSG [ + + + + + MTP3CBAMSG class >> h1 [ + ^self h1CBA + ] + + MTP3CBAMSG class >> humanName [ + ^'Changeback-acknowledgement signal' + ] +] + + + +MTP3CHMMSG subclass: MTP3COOMSG [ + + + + + MTP3COOMSG class >> h1 [ + ^self h1COO + ] + + MTP3COOMSG class >> humanName [ + ^'Changeover-order signal' + ] +] + + + +MTP3Field subclass: MTP3Label [ + | dpc opc slc | + + + + + MTP3Label class >> parseFrom: aStream [ + | slc opc dpc tmp | + tmp := aStream next: 4. + + "TODO: Use the GSMBitfield or a bitreader" + slc := (tmp at: 4) bitAnd: 16r0F. + dpc := tmp first. + dpc := dpc bitOr: ((tmp second bitAnd: 2r00111111) bitShift: 8). + opc := tmp second bitShift: -6. + opc := opc bitOr: (tmp third bitShift: 2). + opc := opc bitOr: ((tmp fourth bitAnd: 2r00001111) bitShift: 10). + ^(MTP3Label new) + dpc: dpc; + opc: opc; + slc: slc; + yourself + ] + + dpc [ + + ^dpc + ] + + opc [ + + ^opc + ] + + slc [ + + ^slc + ] + + dpc: aDpc [ + + dpc := aDpc + ] + + opc: anOpc [ + + opc := anOpc + ] + + slc: aSlc [ + + slc := aSlc + ] + + writeOn: aBuffer [ + + | data w_slc w_dpc w_opc | + w_slc := slc bitAnd: 2r111. + w_dpc := dpc bitAnd: 2r11111111111111. + w_opc := opc bitAnd: 2r11111111111111. + data := (w_dpc bitOr: (w_opc bitShift: 14)) + bitOr: (w_slc bitShift: 14 + 14). + aBuffer + putByte: ((data bitShift: 0) bitAnd: 16rFF); + putByte: ((data bitShift: -8) bitAnd: 16rFF); + putByte: ((data bitShift: -16) bitAnd: 16rFF); + putByte: ((data bitShift: -24) bitAnd: 16rFF) + ] +] + + + +MTP3NetworkManagementMSG subclass: MTP3RSMMSG [ + + + + + MTP3RSMMSG class >> h0 [ + ^self h0Rsm + ] + + MTP3RSMMSG class >> humanName [ + ^'Signalling-route-set-test message' + ] +] + + + +MTP3RSMMSG subclass: MTP3RSTMSG [ + + + + + MTP3RSTMSG class >> h1 [ + ^self h1RST + ] + + MTP3RSTMSG class >> humanName [ + ^'Signalling-route-set-test signal for prohibited destination' + ] +] + + + +MTP3CHMMSG subclass: MTP3CBDMSG [ + + + + + MTP3CBDMSG class >> h1 [ + ^self h1CBD + ] + + MTP3CBDMSG class >> humanName [ + ^'Changeback-declaration signal' + ] +] + + + +MTP3LinkTestMSG subclass: MTP3SLTAMSG [ + + + + + MTP3SLTAMSG class >> h1 [ + ^self h1SLTA + ] + + MTP3SLTAMSG class >> humanName [ + ^'Signalling link test message' + ] +] + + + +MTP3ECMMSG subclass: MTP3ECOMSG [ + + + + + MTP3ECOMSG class >> h1 [ + ^self h1ECO + ] + + MTP3ECOMSG class >> humanName [ + ^'Emergency-changeover-order signal' + ] +] + + + +MTP3NetworkManagementMSG subclass: MTP3DLMMSG [ + + + + + MTP3DLMMSG class >> h0 [ + ^self h0Dlm + ] + + MTP3DLMMSG class >> humanName [ + ^'Signalling-data-link-connection-order message' + ] +] + + + +MTP3DLMMSG subclass: MTP3CNPMSG [ + + + + + MTP3CNPMSG class >> h1 [ + ^self h1CNP + ] + + MTP3CNPMSG class >> humanName [ + ^'Connection-not-possible signal' + ] +] + + + +MTP3DLMMSG subclass: MTP3DLCMSG [ + + + + + MTP3DLCMSG class >> h1 [ + ^self h1DLC + ] + + MTP3DLCMSG class >> humanName [ + ^'Signalling-data-link-connection-order signal' + ] +] + + + +MTP3DLMMSG subclass: MTP3CNSMSG [ + + + + + MTP3CNSMSG class >> h1 [ + ^self h1CNS + ] + + MTP3CNSMSG class >> humanName [ + ^'Connection-not-successful signal' + ] +] + + + +MTP3DLMMSG subclass: MTP3CSSMSG [ + + + + + MTP3CSSMSG class >> h1 [ + ^self h1CSS + ] + + MTP3CSSMSG class >> humanName [ + ^'Connection-successful signal' + ] +] + + + +MTP3RSMMSG subclass: MTP3RSRMSG [ + + + + + MTP3RSRMSG class >> h1 [ + ^self h1RSR + ] + + MTP3RSRMSG class >> humanName [ + ^'Signalling-route-set-test signal for restricted destination (national option)' + ] +] + + + +MTP3CHMMSG subclass: MTP3COAMSG [ + + + + + MTP3COAMSG class >> h1 [ + ^self h1COA + ] + + MTP3COAMSG class >> humanName [ + ^'Changeover-acknowledgement signal' + ] +] + + + +MTP3NetworkManagementMSG subclass: MTP3MIMMSG [ + + + + + MTP3MIMMSG class >> h0 [ + ^self h0Mim + ] + + MTP3MIMMSG class >> humanName [ + ^'Management inhibit messages' + ] +] + + + +MTP3MIMMSG subclass: MTP3LIAMSG [ + + + + + MTP3LIAMSG class >> h1 [ + ^self h1LIA + ] + + MTP3LIAMSG class >> humanName [ + ^'Link inhibit acknowledgement signal' + ] +] + + + +MTP3MIMMSG subclass: MTP3LINMSG [ + + + + + MTP3LINMSG class >> h1 [ + ^self h1LIN + ] + + MTP3LINMSG class >> humanName [ + ^'Link inhibit signal' + ] +] + + + +MTP3MIMMSG subclass: MTP3LFUMSG [ + + + + + MTP3LFUMSG class >> h1 [ + ^self h1LFU + ] + + MTP3LFUMSG class >> humanName [ + ^'Link forced uninhibit signal' + ] +] + + + +MTP3MIMMSG subclass: MTP3LIDMSG [ + + + + + MTP3LIDMSG class >> h1 [ + ^self h1LID + ] + + MTP3LIDMSG class >> humanName [ + ^'Link inhibit denied signal' + ] +] + + + +MTP3MIMMSG subclass: MTP3LUAMSG [ + + + + + MTP3LUAMSG class >> h1 [ + ^self h1LUA + ] + + MTP3LUAMSG class >> humanName [ + ^'Link uninhibit acknowledgement signal' + ] +] + + + +MTP3MIMMSG subclass: MTP3LUNMSG [ + + + + + MTP3LUNMSG class >> h1 [ + ^self h1LUN + ] + + MTP3LUNMSG class >> humanName [ + ^'Link uninhibit signal' + ] +] + + + +MTP3MIMMSG subclass: MTP3LLTMSG [ + + + + + MTP3LLTMSG class >> h1 [ + ^self h1LLT + ] + + MTP3LLTMSG class >> humanName [ + ^'Link local inhibit test signal' + ] +] + + + +MTP3NetworkManagementMSG subclass: MTP3FCMMSG [ + + + + + MTP3FCMMSG class >> h0 [ + ^self h0Fcm + ] + + MTP3FCMMSG class >> humanName [ + ^'Signalling-traffic-flow-control messages' + ] +] + + + +MTP3FCMMSG subclass: MTP3TFCMSG [ + + + + + MTP3TFCMSG class >> humanName [ + ^'Transfer-controlled signal' + ] +] + + + +MTP3FCMMSG subclass: MTP3RCTMSG [ + + + + + MTP3RCTMSG class >> humanName [ + ^'Signalling-route-set-congestion-test signal' + ] +] + + + +MTP3TRMMSG subclass: MTP3TRAMSG [ + + + + + MTP3TRAMSG class >> h1 [ + ^self h1TRA + ] + + MTP3TRAMSG class >> humanName [ + ^'Traffic-restart-allowed signal' + ] +] + + + +MTP3Field subclass: MTP3ServiceIndicators [ + | serviceIndicator subServiceField | + + + + + MTP3ServiceIndicators class >> broadbandIsdnUserPart [ + + ^2r1001 + ] + + MTP3ServiceIndicators class >> dataUserPartCallAndCircuit [ + + ^2r0110 + ] + + MTP3ServiceIndicators class >> dataUserPartFacilityAndCancellation [ + + ^2r0111 + ] + + MTP3ServiceIndicators class >> isdnUserPart [ + + ^2r0101 + ] + + MTP3ServiceIndicators class >> reservedMtpTestingUserPart [ + + ^2r1000 + ] + + MTP3ServiceIndicators class >> satelliteIsdnUserPart [ + + ^2r1010 + ] + + MTP3ServiceIndicators class >> sccp [ + + ^2r0011 + ] + + MTP3ServiceIndicators class >> serviceSpare [ + + ^2r0010 + ] + + MTP3ServiceIndicators class >> signallingNetworkManagement [ + + ^2r0000 + ] + + MTP3ServiceIndicators class >> signallingNetworkTestingAndMaintenance [ + + ^2r0001 + ] + + MTP3ServiceIndicators class >> telephoneUserPart [ + + ^2r0100 + ] + + MTP3ServiceIndicators class >> internationalNetwork [ + + ^2r0000 + ] + + MTP3ServiceIndicators class >> nationalNetwork [ + + ^2r1000 + ] + + MTP3ServiceIndicators class >> reservedNationalUse [ + + ^2r1100 + ] + + MTP3ServiceIndicators class >> subServiceSpare [ + + ^2r0100 + ] + + MTP3ServiceIndicators class >> parseFrom: aStream [ + + | byte | + byte := aStream next. + ^(self new) + serviceIndicator: (byte bitAnd: 2r1111); + subServiceField: (byte bitShift: -4); + yourself + ] + + serviceIndicator: anIndicator [ + + serviceIndicator := anIndicator + ] + + subServiceField: aSubServiceField [ + + subServiceField := aSubServiceField + ] + + serviceIndicator [ + + ^serviceIndicator + ] + + subServiceField [ + + ^subServiceField + ] + + writeOn: aMsg [ + + | data | + data := (subServiceField bitShift: 4) bitAnd: 2r11110000. + data := (serviceIndicator bitAnd: 2r1111) bitOr: data. + aMsg putByte: data + ] +] + + + +MTP3NetworkManagementMSG subclass: MTP3TFMMSG [ + + + + + MTP3TFMMSG class >> h0 [ + ^self h0Tfm + ] + + MTP3TFMMSG class >> humanName [ + ^'Transfer-prohibited-transfer-allowed-transfer-restricted messages' + ] +] + + + +MTP3TFMMSG subclass: MTP3TFAMSG [ + + + + + MTP3TFAMSG class >> h1 [ + ^self h1TFA + ] + + MTP3TFAMSG class >> humanName [ + ^'Transfer-allowed signal' + ] +] + + + +MTP3TFMMSG subclass: MTP3TFRMSG [ + + + + + MTP3TFRMSG class >> h1 [ + ^self h1TFR + ] + + MTP3TFRMSG class >> humanName [ + ^'Transfer-restricted signal (national option)' + ] +] + + + +MTP3TFMMSG subclass: MTP3TFPMSG [ + + + + + MTP3TFPMSG class >> h1 [ + ^self h1TFP + ] + + MTP3TFPMSG class >> humanName [ + ^'Transfer-prohibited signal' + ] +] + + + +MTP3NetworkManagementMSG subclass: MTP3UFCMSG [ + + + + + MTP3UFCMSG class >> h0 [ + ^self h0Ufc + ] + + MTP3UFCMSG class >> humanName [ + ^'User part flow control messages' + ] +] + + + +MTP3UFCMSG subclass: MTP3UPUMSG [ + + + + + MTP3UPUMSG class >> h1 [ + ^self h1UPU + ] + + MTP3UPUMSG class >> humanName [ + ^'User part unavailable signal' + ] +] + + + +MTP3ECMMSG subclass: MTP3ECAMSG [ + + + + + MTP3ECAMSG class >> h1 [ + ^self h1ECA + ] + + MTP3ECAMSG class >> humanName [ + ^'Emergency-changeover-acknowledgement signal' + ] +] + + + +MTP3MIMMSG subclass: MTP3LRTMSG [ + + + + + MTP3LRTMSG class >> h1 [ + ^self h1LRT + ] + + MTP3LRTMSG class >> humanName [ + ^'Link remote inhibit test signal' + ] +] + diff --git a/mtp3/MTP3MessagesTests.st b/mtp3/MTP3MessagesTests.st new file mode 100644 index 0000000..ec9e86f --- /dev/null +++ b/mtp3/MTP3MessagesTests.st @@ -0,0 +1,101 @@ +TestCase subclass: MTP3LabelTest [ + + + + + testParseFrom [ + | data stream label | + data := #(16r01 16r80 16r00 16r00) asByteArray. + stream := data readStream. + label := MTP3Label parseFrom: stream. + self assert: stream atEnd. + self assert: label dpc = 1. + self assert: label opc = 2. + self assert: label slc = 0. + self assert: label toMessage asByteArray = data + ] +] + + + +TestCase subclass: MTP3SLTAMSGTest [ + + + + + testParsing [ + | data stream msg | + data := #(16r81 16r02 16r40 16r00 16r00 16r21 16rE0 16r47 16r53 16r4D 16r4D 16r4D 16r53 16r00 16r00 16r00 16r00 16r00 16r00 16r00 16r00) + asByteArray. + stream := data readStream. + msg := MTP3MSG parseFrom: stream. + self assert: stream atEnd. + self assert: msg class = MTP3SLTAMSG. + self assert: msg testPattern + = #(16r47 16r53 16r4D 16r4D 16r4D 16r53 16r00 16r00 16r00 16r00 16r00 16r00 16r00 16r00) + asByteArray. + self assert: msg toMessage asByteArray = data + ] +] + + + +TestCase subclass: MTP3SLTMMSGTest [ + + + + + testParsing [ + | data stream msg | + data := #(16r81 16r02 16r40 16r00 16r00 16r11 16rE0 16r47 16r53 16r4D 16r4D 16r4D 16r53 16r00 16r00 16r00 16r00 16r00 16r00 16r00 16r00) + asByteArray. + stream := data readStream. + msg := MTP3MSG parseFrom: stream. + self assert: stream atEnd. + self assert: msg class = MTP3SLTMMSG. + self assert: msg testPattern + = #(16r47 16r53 16r4D 16r4D 16r4D 16r53 16r00 16r00 16r00 16r00 16r00 16r00 16r00 16r00) + asByteArray. + self assert: msg toMessage asByteArray = data + ] +] + + + +TestCase subclass: MTP3ServiceIndicatorsTest [ + + + + + testParseFrom [ + | data stream field | + data := #(16r81) asByteArray. + stream := data readStream. + field := MTP3ServiceIndicators parseFrom: stream. + self assert: stream atEnd. + self assert: field subServiceField = MTP3ServiceIndicators nationalNetwork. + self assert: field serviceIndicator + = MTP3ServiceIndicators signallingNetworkTestingAndMaintenance. + self assert: field toMessage asByteArray = data + ] +] + + + +TestCase subclass: MTP3HeadingTest [ + + + + + testParsing [ + | data stream field | + data := #(16r14) asByteArray. + stream := data readStream. + field := MTP3Heading parseFrom: stream. + self assert: stream atEnd. + self assert: field h0 = MTP3TFMMSG h0. + self assert: field h1 = MTP3TFPMSG h1. + self assert: field toMessage asByteArray = data + ] +] + diff --git a/package.xml b/package.xml index 458f2a7..9780435 100644 --- a/package.xml +++ b/package.xml @@ -23,6 +23,7 @@ ipa/IPAMsg.st sccp/SCCP.st sccp/SCCPAddress.st + mtp3/MTP3Messages.st ua/M2UA.st osmo/LogAreaOsmo.st osmo/OsmoUDPSocket.st @@ -45,10 +46,18 @@ Osmo.TLVDescriptionTest Osmo.CtrlGrammarTest Osmo.CtrlParserTest + + Osmo.MTP3LabelTest + Osmo.MTP3SLTAMSGTest + Osmo.MTP3SLTMMSGTest + Osmo.MTP3ServiceIndicatorsTest + Osmo.MTP3HeadingTest + Tests.st core/TLVTests.st isup/ISUPTests.st ipa/IPATests.st osmo/OsmoCtrlGrammarTest.st + mtp3/MTP3MessagesTests.st