" (C) 2010-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 . " "Messages for GSM04.08" """ 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 [ | size data | size := self validSizes first. data := ByteArray new: size. ^ self new data: data; yourself. ] GSM48DataHolder class >> validSizes [ ^ 1 to: 180 ] 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 [ | size | "Add the size for the length header" (self class validSizes includes: aData size + 1) ifFalse: [ ^ self error: 'The data is not of a valid size'. ]. data := aData. ] data [ ^ data ] writeOn: aMsg [ aMsg putByte: self class elementId. aMsg putByte: data size. aMsg putByteArray: data. ] writeOnDirect: aMsg [ aMsg putByte: data size. aMsg putByteArray: data. ] ] GSM48IE subclass: GSM48SimpleData [ | data | GSM48SimpleData class >> initWithData: aData [ ^ self new data: aData; yourself. ] GSM48SimpleData class >> length: aByteArray [ ^ self length ] GSM48SimpleData class >> defaultValue [ ^ ByteArray new: self length ] GSM48SimpleData class >> createDefault [ ^ self new data: self defaultValue; yourself ] GSM48SimpleData class >> parseFrom: aByteArray [ | dat | dat := aByteArray copyFrom: 1 to: self length. ^ self new data: dat; yourself ] data [ ^ data ] data: aData [ aData size = self class length ifFalse: [ Error signal: 'DATA needs to be ', self class length asString, ' long.', 'But it was ', aData size asString, ' long.'. ]. data := aData. ] writeOnDirect: aMsg [ aMsg putByteArray: data. ] writeOn: aMsg [ "Write a TV" aMsg putByte: self class elementId. self writeOnDirect: aMsg ] ] GSM48SimpleData subclass: GSM48KeySeqLuType [ | val | GSM48KeySeqLuType class >> createDefault [ ^ (self new) val: 16r70; yourself ] GSM48KeySeqLuType class >> length [ "We always need a byte" ^ 1 ] val [ ^ self data at: 1 ] val: aVal [ self data: (ByteArray with: aVal). ] ] GSM48IE subclass: GSM48Lai [ | lai lac | GSM48Lai class >> createDefault [ ^ (self new) lai: (LAI initWith: 0 mnc: 0); lac: 0; yourself ] GSM48Lai class >> length: aByteArray [ ^ 5 ] GSM48Lai class >> parseFrom: aByteArray [ ^ (self new) lai: (LAI parseFrom: (aByteArray copyFrom: 1 to: 3)); lac: (aByteArray ushortAt: 4) swap16; yourself ] mcc: aMcc [ lai mcc: aMcc ] mnc: aMnc [ lai mnc: aMnc ] lai: aLai [ lai := aLai ] lac: aLac [ lac := aLac ] mcc [ ^ lai mcc ] mnc [ ^ lai mnc ] lac [ ^ lac ] writeOnDirect: aMsg [ lai writeOn: aMsg. aMsg putLen16: lac. ] ] GSM48IE subclass: GSM48Classmark1 [ | cm1 | GSM48Classmark1 class >> createDefault [ ^ (self new) cm1: 16r33; yourself ] GSM48Classmark1 class >> length: aByteArray [ ^ 1 ] GSM48Classmark1 class >> parseFrom: aByteArray [ ^ (self new) cm1: (aByteArray at: 1); yourself ] cm1: aCm [ cm1 := aCm ] cm1 [ ^ cm1 ] writeOnDirect: aMsg [ aMsg putByte: cm1. ] ] GSM48DataHolder subclass: GSM48Classmark2 [ "TODO: This is broken... it needs to be a simple data holder" GSM48Classmark2 class >> createDefault [ ^ self new data: self defaultValue; yourself ] GSM48Classmark2 class >> defaultValue [ ^ ByteArray with: 16r33 with: 16r19 with: 16rA2. ] GSM48Classmark2 class >> validSizes [ ^ 4 to: 4 ] ] GSM48IE subclass: GSM48MIdentity [ | imsi tmsi | GSM48MIdentity class >> miIMSI [ ^ 16r1 ] GSM48MIdentity class >> miIMEI [ ^ 16r2 ] GSM48MIdentity class >> miIMEISV [ ^ 16r3 ] GSM48MIdentity class >> miTMSI [ ^ 16r4 ] GSM48MIdentity class >> elementId [ ^ 23 ] GSM48MIdentity class >> createDefault [ ^ (self new) imsi: '000000000000'; yourself ] GSM48MIdentity class >> length: aByteArray [ ^ (aByteArray at: 1) + 1 ] GSM48MIdentity class >> parseFrom: aByteArray [ | len head type | len := aByteArray at: 1. head := aByteArray at: 2. type := head bitAnd: 16r7. type = self miIMSI ifTrue: [ | odd digits | digits := OrderedCollection new. odd := (head bitShift: -3) bitAnd: 16r1. digits add: ((head bitShift: -4) bitAnd: 16rF). 3 to: (1 + len) do: [:each | digits add: ((aByteArray at: each) bitAnd: 16rF). digits add: (((aByteArray at: each) bitShift: -4) bitAnd: 16rF). ]. "The last was just a dummy value" odd = 1 ifFalse: [ digits removeLast. ]. ^ (self new) imsi: (BCD decode: digits) asString; yourself ]. self notYetImplemented. ] imsi: aImsi [ imsi := aImsi. ] imsi [ ^ imsi ] writeOnDirect: aMsg [ imsi ifNotNil: [ ^ self storeImsiDirect: aMsg. ]. self notYetImplemented ] storeImsiDirect: aMsg [ | odd len head encoded bcds | odd := imsi size odd. "Calculate the length. We can fit two digits into one byte" len := odd ifTrue: [ (imsi size + 1) / 2 ] ifFalse: [ (imsi size / 2) + 1 ]. aMsg putByte: len. "Create the first data" head := ((imsi at: 1) digitValue) bitShift: 4. odd ifTrue: [ head := head bitOr: (1 bitShift: 3). ]. head := head bitOr: self class miIMSI. aMsg putByte: head. "Encode everything from 2..n into a ByteArray of len - 1" bcds := OrderedCollection new. 2 to: imsi size do: [:pos | bcds add: (imsi at: pos) digitValue. ]. odd ifFalse: [ bcds add: 16r0F. ]. "now fold the bcds into and encoded array" encoded := OrderedCollection new. 1 to: bcds size by: 2 do: [:pos | | lower upper | lower := bcds at: pos. upper := bcds at: pos + 1. encoded add: ((upper bitShift: 4) bitOr: lower). ]. aMsg putByteArray: encoded asByteArray. ] ] GSM48SimpleData subclass: GSM48RejectCause [ GSM48RejectCause class >> createDefault [ ^ self new cause: 11; yourself. ] GSM48RejectCause class >> length [ ^ 1 ] cause [ ^ self data at: 1 ] cause: aCause [ self data: (ByteArray with: aCause). ] ] GSM48SimpleData subclass: GSM48AuthRand [ GSM48AuthRand class >> length [ ^ 16 ] ] GSM48SimpleData subclass: GSM48AuthSRES [ GSM48AuthSRES class >> length [ ^ 4 ] ] GSM48SimpleTag subclass: GSM48FollowOn [ GSM48FollowOn class >> ieMask [ ^ 16rFF ] GSM48FollowOn class >> elementId [ ^ 16rA1 ] ] GSM48SimpleTag subclass: GSM48CTSPermission [ GSM48CTSPermission class >> ieMask [ ^ 16rFF ] GSM48CTSPermission class >> elementId [ ^ 16rA2 ] ] GSM48SimpleData subclass: GSM48IdentityType [ "Ignore the spare values" GSM48IdentityType class >> typeIMSI [ ^ 1 ] GSM48IdentityType class >> typeIMEI [ ^ 2 ] GSM48IdentityType class >> typeIMEISV [ ^ 3 ] GSM48IdentityType class >> typeTMSI [ ^ 4 ] GSM48IdentityType class >> defaultValue [ ^ ByteArray with: self typeIMSI ] GSM48IdentityType class >> length [ ^ 1 ] type: aType [ self data: (ByteArray with: aType) ] ] GSM48SimpleTag subclass: GSMRepeatInd [ GSMRepeatInd class >> elementId [ ^ 16rD0 ] ] GSM48SimpleTag subclass: GSMPriorityLevel [ GSMPriorityLevel class >> elementId [ ^ 16r80 ] ] GSM48DataHolder subclass: GSMBearerCap [ GSMBearerCap class >> elementId [ ^ 16r04 ] GSMBearerCap class >> validSizes [ ^ 1 to: 14 ] ] GSM48DataHolder subclass: GSMFacility [ GSMFacility class >> elementId [ ^ 16r1C ] GSMFacility class >> validSizes [ ^ 1 to: 254 ] ] GSM48DataHolder subclass: GSMProgress [ GSMProgress class >> elementId [ ^ 16r1E ] GSMProgress class >> validSizes [ ^ 3 to: 3 ] ] GSM48SimpleData subclass: GSMSignal [ | signal | GSMSignal class >> elementId [ ^ 16r34 ] GSMSignal class >> length [ ^ 1 ] ] Object subclass: GSMNumberingPlan [ GSMNumberingPlan class >> planUnknown [ ^ 0 ] GSMNumberingPlan class >> planISDN [ ^ 1 ] GSMNumberingPlan class >> planData [ ^ 3 ] GSMNumberingPlan class >> planTelex [ ^ 4 ] GSMNumberingPlan class >> planNational [ ^ 8 ] GSMNumberingPlan class >> planPrivate [ ^ 9 ] GSMNumberingPlan class >> planReserved [ ^ 15 ] ] Object subclass: GSMNumberDigits [ DigitMap := nil. ReverseMap := nil. GSMNumberDigits class >> mapDigit: aBinary [ ^ self digitMap at: aBinary asInteger + 1. ] GSMNumberDigits class >> digitMap: aDigit [ ^ self reverseMap at: aDigit. ] GSMNumberDigits class >> digitMap [ ^ DigitMap ifNil: [ DigitMap := Dictionary new. 1 to: 10 do: [:each | DigitMap at: each put: (each + 48 - 1) asCharacter. ]. DigitMap at: 11 put: $*. DigitMap at: 12 put: $#. DigitMap at: 13 put: $a. DigitMap at: 14 put: $b. DigitMap at: 15 put: $c. DigitMap at: 16 put: Character eof. DigitMap yourself. ]. ] GSMNumberDigits class >> reverseMap [ ^ ReverseMap ifNil: [ ReverseMap := Dictionary new. self digitMap associationsDo: [:each | ReverseMap at: each value put: (each key - 1). ]. ReverseMap yourself. ]. ] GSMNumberDigits class >> decodeFrom: anArray [ | str | str := OrderedCollection new. 1 to: anArray size do: [:each | | low high char | low := (anArray at: each) bitAnd: 16r0F. str add: (self mapDigit: low). high := ((anArray at: each) bitAnd: 16rF0) bitShift: -4. char := (self mapDigit: high). char = Character eof ifFalse: [ str add: char. ]. ]. ^ str asString ] GSMNumberDigits class >> encodeFrom: aNumber [ | digits res | digits := OrderedCollection new. aNumber do: [:digit | digits add: (self digitMap: digit). ]. digits size odd ifTrue: [ digits add: 16rF. ]. "Create the binary structure" res := OrderedCollection new. 1 to: digits size by: 2 do: [:each | | low high | low := digits at: each. high := digits at: each + 1. res add: (low bitOr: (high bitShift: 4)). ]. ^ res asByteArray. ] ] GSM48DataHolder subclass: GSMCalledBCDNumber [ GSMCalledBCDNumber class >> elementId [ ^ 16r5E ] GSMCalledBCDNumber class >> validSizes [ ^ 2 to: 18 ] ] GSM48DataHolder subclass: GSMCalledSubBCDNumber [ GSMCalledSubBCDNumber class >> elementId [ ^ 16r6D ] GSMCalledSubBCDNumber class >> validSizes [ ^ 1 to: 22 ] ] GSM48DataHolder subclass: GSMCallingBCDNumber [ GSMCallingBCDNumber class >> elementId [ ^ 16r5C ] GSMCallingBCDNumber class >> validSizes [ ^ 2 to: 13 ] ] GSM48DataHolder subclass: GSMCallingSubBCDNumber [ GSMCallingSubBCDNumber class >> elementId [ ^ 16r5D ] GSMCallingSubBCDNumber class >> validSizes [ ^ 1 to: 22 ] ] GSM48DataHolder subclass: GSMRedirectingBCDNumber [ GSMRedirectingBCDNumber class >> elementId [ ^ 16r74 ] GSMRedirectingBCDNumber class >> validSizes [ ^ 2 to: 18 ] ] GSM48DataHolder subclass: GSMRedirectingSubBCDNumber [ GSMRedirectingSubBCDNumber class >> elementId [ ^ 16r75 ] GSMRedirectingSubBCDNumber class >> validSizes [ ^ 1 to: 22 ] ] GSM48DataHolder subclass: GSMLLCompability [ GSMLLCompability class >> elementId [ ^ 16r7C ] GSMLLCompability class >> validSizes [ ^ 1 to: 14 ] ] GSM48DataHolder subclass: GSMHLCompability [ GSMHLCompability class >> elementId [ ^ 16r7D ] GSMHLCompability class >> validSizes [ ^ 1 to: 4 ] ] GSM48DataHolder subclass: GSMUserUser [ GSMUserUser class >> elementId [ ^ 16r7E ] GSMUserUser class >> validSizes [ ^ 2 to: 34 ] ] GSM48DataHolder subclass: GSMSSVersionInd [ GSMSSVersionInd class >> elementId [ ^ 16r7F ] GSMSSVersionInd class >> validSizes [ ^ 1 to: 2 ] ] 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 ] GSMCCCapabilities class >> validSizes [ ^ 2 to: 2 ] ] GSM48DataHolder subclass: GSMConnectedNumber [ GSMConnectedNumber class >> elementId [ ^ 16r4C ] GSMConnectedNumber class >> validSizes [ ^ 2 to: 13 ] ] GSM48DataHolder subclass: GSMConnectedSubNumber [ GSMConnectedSubNumber class >> elementId [ ^ 16r4D ] GSMConnectedSubNumber class >> validSizes [ ^ 1 to: 22 ] ] GSM48DataHolder subclass: GSMAllowedActions [ GSMAllowedActions class >> elementId [ ^ 16r7B ] GSMAllowedActions class >> validSizes [ ^ 2 to: 2 ] ] GSM48DataHolder subclass: GSM48Cause [ GSM48Cause class >> elementId [ ^ 16r8 ] GSM48Cause class >> validSizes [ ^ 3 to: 31 ] ] GSM48DataHolder subclass: GSMAlertingPattern [ GSMAlertingPattern class >> elementId [ ^ 16r19 ] GSMAlertingPattern class >> validSizes [ ^ 3 to: 3 ] ] IEMessage subclass: GSM48MSG [ | seq ti | GSM48MSG class >> addVariable: aName [ "Check if the variable exists, otherwise add it" (self instVarNames includes: aName) ifFalse: [ self addInstVarName: aName. ]. ] GSM48MSG class >> addMandantory: aName with: aClass [ self addVariable: aName asSymbol. self compile: '%1 [ ^ %1 ifNil: [%1 := %2 createDefault.]]' % {aName. aClass}. self Mandantory add: ({aName asSymbol. #normal} -> aClass). ] GSM48MSG class >> addTaggedMandantory: aName with: aClass [ self addVariable: aName asSymbol. self compile: '%1 [ ^ %1 ifNil: [%1 := %2 createDefault.]]' % {aName. aClass}. self Mandantory add: ({aName asSymbol. #tagged} -> aClass). ] GSM48MSG class >> addOptional: aName with: aClass [ aClass = nil ifTrue: [ self error: 'Class should not be null for ', aName ]. self addVariable: aName asSymbol. self compile: '%1 [ ^ %1 ]' % {aName}. self compile: '%1OrDefault [ ^ %1 ifNil: [%1 := %2 createDefault.]]' % {aName. aClass}. self Optional add: (aName asSymbol -> aClass). ] GSM48MSG class >> isCompatible: classType msgType: messageType [ | localType | "Ignore the base classes. TODO: find a better way" (self = GSM48MMMessage or: [self = GSM48CCMessage or: [self = GSM48SSMessage]]) ifTrue: [^ false]. localType := classType bitAnd: 16r0F. ^ (self classType = localType) and: [self messageType = messageType]. ] GSM48MSG class >> decode: aByteArray [ | classType messageType | classType := aByteArray at: 1. messageType := (aByteArray at: 2) bitAnd: 16r3F. GSM48MSG allSubclassesDo: [:each | (each isCompatible: classType msgType: messageType) ifTrue: [ ^ each parseFrom: aByteArray. ]. ]. Exception signal: 'No one handles: ', classType asString, ' and: ', (aByteArray at: 2) asString. ] GSM48MSG class >> parseFrom: aByteArray [ | res dat | res := self new. res seq: ((aByteArray at: 2) bitShift: -6). res ti: ((aByteArray at: 1) bitShift: -4). dat := aByteArray copyFrom: 3. "This is messy. The GSM04.80 spec had the great idea of adding tagged mandantory items and we need to deal with it here." self Mandantory do: [:tuple | | len name type clazz | name := tuple key first. type := tuple key second. clazz := tuple value. type = #tagged ifTrue: [ (dat at: 1) = clazz elementId ifFalse: [ ^ self error: 'Mandantory Tagged Element %1 not present.' % {name->clazz}. ]. dat := dat copyFrom: 2. ]. len := clazz length: dat. res instVarNamed: name put: (clazz parseFrom: dat). "Move the parser forward" dat := dat copyFrom: len + 1. ]. "We are done here if this class has no optional IEs" (self respondsTo: #Optional) ifFalse: [ ^ res ]. "Types must appear in order" self Optional do: [:each | | tag | "We have consumed everything" dat size = 0 ifTrue: [ ^ res ]. tag := (dat at: 1) bitAnd: each value ieMask. tag = each value elementId ifTrue: [ | len data | data := dat copyFrom: 2. len := each value length: data. "treat the T only tags specially" len = 0 ifTrue: [ res instVarNamed: each key put: (each value initWithData: (dat at: 1)). dat := data. ] ifFalse: [ res instVarNamed: each key put: (each value parseFrom: data). dat := data copyFrom: len + 1. ]. ]. ]. "TODO: Complain if we have not consumed everything" dat size = 0 ifFalse: [ res inspect. dat printNl. self error: 'Every byte should be consumed'. ]. ^ res ] writeOn: aMsg [ | type classType | type := self seq bitShift: 6. type := type bitOr: self class messageType. "Write the header. Skip Ind, Sequence are hardcoded" classType := self ti bitShift: 4. classType := classType bitOr: self class classType. aMsg putByte: classType. aMsg putByte: type. "Write all Mandantory parts" self class Mandantory do: [:tuple | | tmp | tmp := self perform: tuple key first. tuple key second = #tagged ifTrue: [tmp writeOn: aMsg.] ifFalse: [tmp writeOnDirect: aMsg.]. ]. (self class respondsTo: #Optional) ifFalse: [ ^ 0 ]. self class Optional do: [:each | | tmp | tmp := self perform: each key. tmp ifNotNil: [ tmp writeOn: aMsg. ]. ]. "TODO: Handle the Conditionals too" ^ 0 ] seq: aSeq [ seq := aSeq. ] seq [ ^ seq ifNil: [ 0 ] ] ti: aTi [ ti := aTi. ] ti [ "by default treat it like a spare" ^ 0 ] type [ ^ self class messageType ] ] GSM48MSG subclass: GSM48MMMessage [ GSM48MMMessage class >> classType [ ^ 16r5 ] GSM48MMMessage class >> msgLUAcc [ ^ 16r02 ] GSM48MMMessage class >> msgLURej [ ^ 16r04 ] GSM48MMMessage class >> msgLUReq [ ^ 16r08 ] GSM48MMMessage class >> msgIdRes [ ^ 16r19 ] GSM48MMMessage class >> msgIdReq [ ^ 16r18 ] GSM48MMMessage class >> msgAuRej [ ^ 16r11 ] GSM48MMMessage class >> msgAuReq [ ^ 16r12 ] GSM48MMMessage class >> msgAuRes [ ^ 16r14 ] GSM48MMMessage class >> msgCMAccept [ ^ 16r21 ] GSM48MMMessage class >> msgCMReject [ ^ 16r22 ] GSM48MMMessage class >> msgCMReq [ ^ 16r24 ] GSM48MMMessage class >> msgIMSIDetach [ ^ 16r01 ] ] GSM48MSG subclass: GSM48CCMessage [ GSM48CCMessage class >> classType [ ^ 16r3 ] GSM48CCMessage class >> msgAlerting [ ^ 16r1 ] GSM48CCMessage class >> msgProceeding [ ^ 16r2 ] GSM48CCMessage class >> msgSetup [ ^ 16r5 ] GSM48CCMessage class >> msgConnect [ ^ 16r7 ] GSM48CCMessage class >> msgConnectAck [ ^ 16rF ] GSM48CCMessage class >> msgDisconnect [ ^ 16r25 ] GSM48CCMessage class >> msgReleaseCompl [ ^ 16r2A ] GSM48CCMessage class >> msgRelease [ ^ 16r2D ] ti [ ^ ti ifNil: [ 0 ] ] ] GSM48MSG subclass: GSM48SSMessage [ GSM48SSMessage class >> classType [ ^ 2r1011 ] GSM48SSMessage class >> msgReleaseCompl [ ^ 2r101010 ] GSM48SSMessage class >> msgFacility [ ^ 2r111010 ] GSM48SSMessage class >> msgRegister [ ^ 2r111011 ] ti [ ^ ti ifNil: [ 0 ] ] ] GSM48MMMessage subclass: GSM48LURequest [ Mandantory := nil. Optional := nil. GSM48LURequest class >> messageType [ ^ self msgLUReq ] GSM48LURequest class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ]. ] GSM48LURequest class >> Optional [ ^ Optional ifNil: [ Optional := OrderedCollection new ]. ] GSM48LURequest class >> initialize [ self addMandantory: 'luType' with: GSM48KeySeqLuType. self addMandantory: 'lai' with: GSM48Lai. self addMandantory: 'cm1' with: GSM48Classmark1. self addMandantory: 'mi' with: GSM48MIdentity. ] ] GSM48MMMessage subclass: GSM48LUAccept [ Mandantory := nil. Optional := nil. GSM48LUAccept class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ]. ] GSM48LUAccept class >> Optional [ ^ Optional ifNil: [ Optional := OrderedCollection new ]. ] GSM48LUAccept class >> messageType [ ^ self msgLUAcc ] GSM48LUAccept class >> initialize [ self addMandantory: 'cause' with: GSM48Lai. self addOptional: 'mi' with: GSM48MIdentity. self addOptional: 'follow' with: GSM48FollowOn. self addOptional: 'cts' with: GSM48CTSPermission. ] ] GSM48MMMessage subclass: GSM48LUReject [ Mandantory := nil. Optional := nil. GSM48LUReject class >> messageType [ ^ self msgLURej ] GSM48LUReject class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ]. ] GSM48LUReject class >> initialize [ self addMandantory: 'cause' with: GSM48RejectCause. ] ] GSM48MMMessage subclass: GSM48AuthRej [ Mandantory := nil. Optional := nil. GSM48AuthRej class >> messageType [ ^ self msgAuRej ] GSM48AuthRej class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ]. ] ] GSM48MMMessage subclass: GSM48AuthReq [ Mandantory := nil. Optional := nil. GSM48AuthReq class >> messageType [ ^ self msgAuReq ] GSM48AuthReq class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ]. ] GSM48AuthReq class >> initialize [ self addMandantory: 'key' with: GSM48KeySeqLuType. self addMandantory: 'auth' with: GSM48AuthRand. ] ] GSM48MMMessage subclass: GSM48AuthResp [ Mandantory := nil. GSM48AuthResp class >> messageType [ ^ self msgAuRes ] GSM48AuthResp class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ]. ] GSM48AuthResp class >> initialize [ self addMandantory: 'sres' with: GSM48AuthSRES. ] ] GSM48MMMessage subclass: GSM48IdentityReq [ Mandantory := nil. GSM48IdentityReq class >> messageType [ ^ self msgIdReq ] GSM48IdentityReq class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ]. ] GSM48IdentityReq class >> initialize [ self addMandantory: 'idType' with: GSM48IdentityType. ] ] GSM48MMMessage subclass: GSM48IdentityResponse [ Mandantory := nil. GSM48IdentityResponse class >> messageType [ ^ self msgIdRes ] GSM48IdentityResponse class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ]. ] GSM48IdentityResponse class >> initialize [ self addMandantory: 'mi' with: GSM48MIdentity. ] ] GSM48MMMessage subclass: GSM48CMServiceReq [ Mandantory := nil. Optional := nil. GSM48CMServiceReq class >> messageType [ ^ self msgCMReq ] GSM48CMServiceReq class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ]. ] GSM48CMServiceReq class >> Optional [ ^ Optional ifNil: [ Optional := OrderedCollection new ] ] GSM48CMServiceReq class >> initialize [ self addMandantory: 'keyAndType' with: GSM48KeySeqLuType. self addMandantory: 'cm2' with: GSM48Classmark2. self addMandantory: 'mi' with: GSM48MIdentity. self addOptional: 'prio' with: GSMPriorityLevel. ] ] GSM48MMMessage subclass: GSM48CMServiceReject [ Mandantory := nil. GSM48CMServiceReject class >> messageType [ ^ self msgCMReject ] GSM48CMServiceReject class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ] ] GSM48CMServiceReject class >> initialize [ self addMandantory: 'reject' with: GSM48RejectCause. ] ] GSM48MMMessage subclass: GSM48IMSIDetachInd [ Mandantory := nil. GSM48IMSIDetachInd class >> messageType [ ^ self msgIMSIDetach ] GSM48IMSIDetachInd class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ]. ] GSM48IMSIDetachInd class >> initialize [ self addMandantory: 'cm1' with: GSM48Classmark1. self addMandantory: 'mi' with: GSM48MIdentity. ] ] 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: GSMCallingBCDNumber. self addOptional: 'callingSub' with: GSMCallingSubBCDNumber. self addOptional: 'called' with: GSMCalledBCDNumber. self addOptional: 'calledSub' with: GSMCalledSubBCDNumber. 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. ] ] GSM48CCMessage subclass: GSM48CCProceeding [ Mandantory := nil. Optional := nil. GSM48CCProceeding class >> messageType [ ^ self msgProceeding ] GSM48CCProceeding class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ] ] GSM48CCProceeding class >> Optional [ ^ Optional ifNil: [ Optional := OrderedCollection new ] ] GSM48CCProceeding 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: 'priorityGranted' with: GSMPriorityLevel. ] writeOn: aMsg [ (self bearer1 ~= nil and: [self bearer2 ~= nil]) ifTrue: [ self instVarNamed: #repeatInd put: GSMRepeatInd new. ] ifFalse: [ self instVarNamed: #repeatInd put: nil. ]. ^ super writeOn: aMsg. ] ] GSM48CCMessage subclass: GSM48CCAlerting [ Mandantory := nil. Optional := nil. GSM48CCAlerting class >> messageType [ ^ self msgAlerting ] GSM48CCAlerting class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ] ] GSM48CCAlerting class >> Optional [ ^ Optional ifNil: [ Optional := OrderedCollection new ] ] GSM48CCAlerting class >> initialize [ self addOptional: 'facility' with: GSMFacility. self addOptional: 'progress' with: GSMProgress. self addOptional: 'useruser' with: GSMUserUser. "mobile station to network" self addOptional: 'ssVersion' with: GSMSSVersionInd. ] ] GSM48CCMessage subclass: GSM48CCConnect [ Mandantory := nil. Optional := nil. GSM48CCConnect class >> messageType [ ^ self msgConnect ] GSM48CCConnect class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new. ] ] GSM48CCConnect class >> Optional [ ^ Optional ifNil: [ Optional := OrderedCollection new. ] ] GSM48CCConnect class >> initialize [ self addOptional: 'facility' with: GSMFacility. self addOptional: 'progress' with: GSMProgress. self addOptional: 'connected' with: GSMConnectedNumber. self addOptional: 'connectedSub' with: GSMConnectedSubNumber. self addOptional: 'useruser' with: GSMUserUser. self addOptional: 'ssVersion' with: GSMSSVersionInd. ] ] GSM48CCMessage subclass: GSM48CCConnectAck [ Optional := nil. Mandantory := nil. GSM48CCConnectAck class >> messageType [ ^ self msgConnectAck ] GSM48CCConnectAck class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new. ] ] GSM48CCConnectAck class >> Optional [ ^ Optional ifNil: [ Optional := OrderedCollection new. ] ] GSM48CCConnectAck class >> initialize [ ] ] GSM48CCMessage subclass: GSM48CCDisconnect [ Optional := nil. Mandantory := nil. GSM48CCDisconnect class >> messageType [ ^ self msgDisconnect ] GSM48CCDisconnect class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new. ] ] GSM48CCDisconnect class >> Optional [ ^ Optional ifNil: [ Optional := OrderedCollection new. ] ] GSM48CCDisconnect class >> initialize [ self addMandantory: 'cause' with: GSM48Cause. self addOptional: 'facility' with: GSMFacility. self addOptional: 'progress' with: GSMProgress. self addOptional: 'useruser' with: GSMUserUser. self addOptional: 'allowedActions' with: GSMAllowedActions. "MO addition" self addOptional: 'ssVersion' with: GSMSSVersionInd. ] ] GSM48CCMessage subclass: GSM48CCRelease [ Optional := nil. Mandantory := nil. GSM48CCRelease class >> messageType [ ^ self msgRelease ] GSM48CCRelease class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ] ] GSM48CCRelease class >> Optional [ ^ Optional ifNil: [ Optional := OrderedCollection new ] ] GSM48CCRelease class >> initialize [ self addOptional: 'cause' with: GSM48Cause. self addOptional: 'secondCause' with: GSM48Cause. self addOptional: 'facility' with: GSMFacility. self addOptional: 'useruser' with: GSMUserUser. self addOptional: 'ssVersion' with: GSMSSVersionInd. ] ] GSM48CCMessage subclass: GSM48CCReleaseCompl [ Optional := nil. Mandantory := nil. GSM48CCReleaseCompl class >> messageType [ ^ self msgReleaseCompl ] GSM48CCReleaseCompl class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ] ] GSM48CCReleaseCompl class >> Optional [ ^ Optional ifNil: [ Optional := OrderedCollection new ] ] GSM48CCReleaseCompl class >> initialize [ self addOptional: 'cause' with: GSM48Cause. self addOptional: 'facility' with: GSMFacility. self addOptional: 'useruser' with: GSMUserUser. self addOptional: 'ssVersion' with: GSMSSVersionInd. ] ] GSM48SSMessage subclass: GSM48SSFacility [ Optional := nil. Mandantory := nil. GSM48SSFacility class >> messageType [ ^ self msgFacility ] GSM48SSFacility class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ] ] GSM48SSFacility class >> Optional [ ^ Optional ifNil: [ Optional := OrderedCollection new ] ] GSM48SSFacility class >> initialize [ self addMandantory: 'facility' with: GSMFacility. ] ] GSM48SSMessage subclass: GSM48SSRegister [ Optional := nil. Mandantory := nil. GSM48SSRegister class >> messageType [ ^ self msgRegister ] GSM48SSRegister class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ] ] GSM48SSRegister class >> Optional [ ^ Optional ifNil: [ Optional := OrderedCollection new ] ] GSM48SSRegister class >> initialize [ self addTaggedMandantory: 'facility' with: GSMFacility. "MS to mobile can contain this one" self addOptional: 'ssVersion' with: GSMSSVersionInd. ] ] GSM48SSMessage subclass: GSM48SSReleaseComplete [ Optional := nil. Mandantory := nil. GSM48SSReleaseComplete class >> messageType [ ^ self msgReleaseCompl ] GSM48SSReleaseComplete class >> Mandantory [ ^ Mandantory ifNil: [ Mandantory := OrderedCollection new ] ] GSM48SSReleaseComplete class >> Optional [ ^ Optional ifNil: [ Optional := OrderedCollection new ] ] GSM48SSReleaseComplete class >> initialize [ self addOptional: 'cause' with: GSM48Cause. self addOptional: 'facility' with: GSMFacility. ] ] Eval [ GSM48LURequest initialize. GSM48LUReject initialize. GSM48LUAccept initialize. GSM48AuthReq initialize. GSM48AuthResp initialize. GSM48IdentityReq initialize. GSM48IdentityResponse initialize. GSM48CMServiceReq initialize. GSM48CMServiceReject initialize. GSM48IMSIDetachInd initialize. GSM48CCSetup initialize. GSM48CCProceeding initialize. GSM48CCAlerting initialize. GSM48CCConnect initialize. GSM48CCConnectAck initialize. GSM48CCDisconnect initialize. GSM48CCRelease initialize. GSM48CCReleaseCompl initialize. GSM48SSFacility initialize. GSM48SSRegister initialize. GSM48SSReleaseComplete initialize. ]