From a82f815760bed3b0e3f7ce0ec3168584d37be66a Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Tue, 30 Nov 2010 20:47:45 +0100 Subject: [PATCH] GSM48: Add parsing of the GSM CC Setup message --- GSM48.st | 274 ++++++++++++++++++++++++++++++++++++++++++++++++++++++- Tests.st | 5 + 2 files changed, 274 insertions(+), 5 deletions(-) diff --git a/GSM48.st b/GSM48.st index e778412..9f097e3 100644 --- a/GSM48.st +++ b/GSM48.st @@ -6,6 +6,90 @@ IEs for GSM48MSG IEBase subclass: GSM48IE [ + + GSM48IE class >> ieMask [ + "Some IEs encode the IE and the value into one. Return the mask to be used + to determine the IE and see if it is matching." + ^ 16rFF + ] +] + +GSM48IE subclass: GSM48SimpleTag [ + | value | + + + + GSM48SimpleTag class >> ieMask [ ^ 16rF0 ] + GSM48SimpleTag class >> initWithData: aData [ + ^ self new + value: aData; + yourself + ] + + GSM48SimpleTag class >> length: aByteArray [ + ^ 0 + ] + + value: aValue [ + | inv | + inv := 255 - self class ieMask. + value := (aValue bitAnd: inv) + ] + + value [ + ^ value ifNil: [ 0 ] + ] + + writeOn: aMsg [ + | combined | + combined := self class elementId bitOr: value. + aMsg putByte: combined. + ] + + writeOnDirect: aMsg [ + self shouldNotImplement + ] +] + +GSM48IE subclass: GSM48DataHolder [ + | data | + + + GSM48DataHolder class >> createDefault [ + self error: 'I have no concept of a default' + ] + + GSM48DataHolder class >> length: aByteArray [ + ^ (aByteArray at: 1) + 1. + ] + + GSM48DataHolder class >> initWithData: aData [ + ^ self new + data: aData; + yourself. + ] + + GSM48DataHolder class >> parseFrom: aData [ + | len | + len := aData at: 1. + ^ self initWithData: (aData copyFrom: 2 to: 2 + len - 1) + ] + + data: aData [ + data := aData. + ] + + data [ ^ data ] + + writeOn: aMsg [ + aMsg putByte: self class elementId. + aMsg putByte: data size. + aMsg putByteArray: data. + ] + + writeOnDirect: aMsg [ + self error: 'Do not call this.'. + ] ] GSM48IE subclass: GSM48SimpleData [ @@ -327,19 +411,19 @@ GSM48SimpleData subclass: GSM48AuthSRES [ GSM48AuthSRES class >> length [ ^ 4 ] ] -GSM48SimpleData subclass: GSM48FollowOn [ +GSM48SimpleTag subclass: GSM48FollowOn [ - GSM48FollowOn class >> length [ ^ 0 ] + GSM48FollowOn class >> ieMask [ ^ 16rFF ] GSM48FollowOn class >> elementId [ ^ 16rA1 ] ] -GSM48SimpleData subclass: GSM48CTSPermission [ +GSM48SimpleTag subclass: GSM48CTSPermission [ - GSM48CTSPermission class >> length [ ^ 0 ] + GSM48CTSPermission class >> ieMask [ ^ 16rFF ] GSM48CTSPermission class >> elementId [ ^ 16rA2 ] ] @@ -360,6 +444,92 @@ GSM48SimpleData subclass: GSM48IdentityType [ GSM48IdentityType class >> length [ ^ 1 ] ] +GSM48SimpleTag subclass: GSMRepeatInd [ + GSMRepeatInd class >> elementId [ ^ 16rD0 ] +] + +GSM48SimpleTag subclass: GSMPriorityLevel [ + GSMPriorityLevel class >> elementId [ ^ 16r80 ] +] + +GSM48DataHolder subclass: GSMBearerCap [ + GSMBearerCap class >> elementId [ ^ 16r04 ] +] + +GSM48DataHolder subclass: GSMFacility [ + GSMFacility class >> elementId [ ^ 16r1C ] +] + +GSM48SimpleData subclass: GSMProgress [ + GSMProgress class >> elementId [ ^ 16r1E ] + GSMProgress class >> length [ ^ 3 ] +] + +GSM48SimpleData subclass: GSMSignal [ + | signal | + GSMSignal class >> elementId [ ^ 16r34 ] + GSMSignal class >> length [ ^ 1 ] +] + +GSM48DataHolder subclass: GSMCalledBCDNumber [ + GSMCalledBCDNumber class >> elementId [ ^ 16r5E ] +] + +GSM48DataHolder subclass: GSMCalledSubBCDNumber [ + GSMCalledSubBCDNumber class >> elementId [ ^ 16r6D ] +] + +GSM48DataHolder subclass: GSMCallingBCDNumber [ + GSMCallingBCDNumber class >> elementId [ ^ 16r5C ] +] + +GSM48DataHolder subclass: GSMCallingSubBCDNumber [ + GSMCallingSubBCDNumber class >> elementId [ ^ 16r5D ] +] + +GSM48DataHolder subclass: GSMRedirectingBCDNumber [ + GSMRedirectingBCDNumber class >> elementId [ ^ 16r74 ] +] + +GSM48DataHolder subclass: GSMRedirectingSubBCDNumber [ + GSMRedirectingSubBCDNumber class >> elementId [ ^ 16r75 ] +] + +GSM48DataHolder subclass: GSMLLCompability [ + GSMLLCompability class >> elementId [ ^ 16r7C ] +] + +GSM48DataHolder subclass: GSMHLCompability [ + GSMHLCompability class >> elementId [ ^ 16r7D ] +] +GSM48DataHolder subclass: GSMUserUser [ + GSMUserUser class >> elementId [ ^ 16r7E ] +] + +GSM48DataHolder subclass: GSMSSVersionInd [ + GSMSSVersionInd class >> elementId [ ^ 16r7F ] +] + +GSM48SimpleTag subclass: GSMClirSuppression [ + GSMClirSuppression class >> elementId [ ^ 16rA1 ] + GSMClirSuppression class >> ieMask [ ^ 16rFF ] +] + +GSM48SimpleTag subclass: GSMClirInvocation [ + GSMClirInvocation class >> elementId [ ^ 16rA2 ] + GSMClirInvocation class >> ieMask [ ^ 16rFF ] +] + +GSM48DataHolder subclass: GSMCCCapabilities [ + "TODO: the length is fixed to three" + GSMCCCapabilities class >> elementId [ ^ 16r15 ] +] + +GSM48SimpleData subclass: GSMAlertingPattern [ + GSMAlertingPattern class >> elementId [ ^ 16r19 ] + GSMAlertingPattern class >> length [ ^ 2 ] +] + IEMessage subclass: GSM48MSG [ | seq | @@ -377,13 +547,19 @@ IEMessage subclass: GSM48MSG [ GSM48MSG class >> addOptional: aName with: aClass [ + + aClass = nil + ifTrue: [ + self error: 'Class should not be null for ', aName + ]. + self addInstVarName: aName asSymbol. self compile: '%1 [ ^ %1 ]' % {aName}. self Optional add: (aName asSymbol -> aClass). ] GSM48MSG class >> isCompatible: classType msgType: messageType [ - self = GSM48MMMessage + (self = GSM48MMMessage or: [self = GSM48CCMessage]) ifTrue: [^ false]. ^ (self classType = classType) and: [self messageType = messageType]. @@ -526,6 +702,14 @@ GSM48MSG subclass: GSM48MMMessage [ GSM48MMMessage class >> msgIMSIDetach [ ^ 16r01 ] ] +GSM48MSG subclass: GSM48CCMessage [ + + + + GSM48CCMessage class >> classType [ ^ 16r3 ] + GSM48CCMessage class >> msgSetup [ ^ 16r5 ] +] + GSM48MMMessage subclass: GSM48LURequest [ Mandantory := nil. @@ -680,6 +864,84 @@ GSM48MMMessage subclass: GSM48IMSIDetachInd [ ] ] +GSM48CCMessage subclass: GSM48CCSetup [ + + + Mandantory := nil. + Optional := nil. + + GSM48CCSetup class >> messageType [ ^ self msgSetup ] + GSM48CCSetup class >> Mandantory [ + ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ]. + ] + GSM48CCSetup class >> Optional [ + ^ Optional ifNil: [ Optional := OrderedCollection new ] + ] + + GSM48CCSetup class >> initialize [ + self addOptional: 'repeatInd' with: GSMRepeatInd. + self addOptional: 'bearer1' with: GSMBearerCap. + self addOptional: 'bearer2' with: GSMBearerCap. + self addOptional: 'facility' with: GSMFacility. + self addOptional: 'progress' with: GSMProgress. + self addOptional: 'signal' with: GSMSignal. + self addOptional: 'calling' with: GSMCalledBCDNumber. + self addOptional: 'callingSub' with: GSMCalledSubBCDNumber. + self addOptional: 'called' with: GSMCallingBCDNumber. + self addOptional: 'calledSub' with: GSMCallingSubBCDNumber. + self addOptional: 'redirect' with: GSMRedirectingBCDNumber. + self addOptional: 'redirectSub' with: GSMRedirectingSubBCDNumber. + self addOptional: 'LLCInd' with: GSMRepeatInd. + self addOptional: 'llc1' with: GSMLLCompability. + self addOptional: 'llc2' with: GSMLLCompability. + self addOptional: 'HLCInd' with: GSMRepeatInd. + self addOptional: 'hlc1' with: GSMHLCompability. + self addOptional: 'hlc2' with: GSMHLCompability. + self addOptional: 'useruser' with: GSMUserUser. + "For MO call" + self addOptional: 'ssVersion' with: GSMSSVersionInd. + self addOptional: 'clirSuppr' with: GSMClirSuppression. + self addOptional: 'clirInvoc' with: GSMClirInvocation. + self addOptional: 'ccCapabil' with: GSMCCCapabilities. + self addOptional: 'facilityCCBS' with: GSMFacility. + self addOptional: 'facilityReca' with: GSMFacility. + + "For MT call" + self addOptional: 'prio' with: GSMPriorityLevel. + self addOptional: 'alert' with: GSMAlertingPattern. + ] + + writeOn: aMsg [ + "TODO: these are incomplete and wrong" + "Implement the conditionals" + (self bearer1 ~= nil and: [self bearer2 ~= nil]) + ifTrue: [ + self instVarNamed: #repeatInd put: GSMRepeatInd new. + ] + ifFalse: [ + self instVarNamed: #repeatInd put: nil. + ]. + + (self llc1 ~= nil and: [self llc2 ~= nil]) + ifTrue: [ + self instVarNamed: #LLCInd put: GSMRepeatInd new. + ] + ifFalse: [ + self instVarNamed: #LLCInd put: nil. + ]. + + (self hlc1 ~= nil and: [self hlc2 ~= nil]) + ifTrue: [ + self instVarNamed: #HLCInd put: GSMRepeatInd new. + ] + ifFalse: [ + self instVarNamed: #HLCInd put: nil. + ]. + + ^ super writeOn: aMsg. + ] +] + Eval [ GSM48LURequest initialize. GSM48LUReject initialize. @@ -690,4 +952,6 @@ Eval [ GSM48IdentityResponse initialize. GSM48CMServiceReq initialize. GSM48IMSIDetachInd initialize. + + GSM48CCSetup initialize. ] diff --git a/Tests.st b/Tests.st index 864ffcf..d658ce5 100644 --- a/Tests.st +++ b/Tests.st @@ -344,5 +344,10 @@ TestCase subclass: TestMessages [ inp := #(6 1 3 35 0 1 16 0 14 84 18 3 51 25 145 19 6 96 20 69 0 1 0) asByteArray. msg := MSGParser parse: inp. self assert: msg toMessage asByteArray = inp. + + "MO Setup message" + inp := #(6 1 3 35 0 1 21 1 128 18 3 69 4 6 96 4 2 0 5 129 94 6 145 83 132 54 23 121 ) asByteArray. + msg := MSGParser parse: inp. + self assert: msg toMessage asByteArray = inp. ] ]