From 372c2e0f0b6ac35098bedc31aace9c5b7d36fee0 Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Mon, 17 Jun 2013 14:19:26 +0200 Subject: [PATCH] m2ua: Move the code to separate directory to prepare merging with Pharo --- Makefile | 7 +- m2ua/M2UAConstants.st | 126 +++++++++++ m2ua/M2UAMSG.st | 147 +++++++++++++ {ua => m2ua}/M2UAStates.st | 0 m2ua/M2UATag.st | 85 ++++++++ package.xml | 7 +- ua/M2UA.st | 420 ------------------------------------- ua/XUA.st | 116 ++++++++++ 8 files changed, 484 insertions(+), 424 deletions(-) create mode 100644 m2ua/M2UAConstants.st create mode 100644 m2ua/M2UAMSG.st rename {ua => m2ua}/M2UAStates.st (100%) create mode 100644 m2ua/M2UATag.st delete mode 100644 ua/M2UA.st create mode 100644 ua/XUA.st diff --git a/Makefile b/Makefile index ff7fba9..0a8cdd6 100644 --- a/Makefile +++ b/Makefile @@ -42,7 +42,10 @@ ISUP = \ isup/ISUPTests.st UA = \ - ua/M2UA.st ua/M2UAStates.st + ua/XUA.st + +M2UA = \ + m2ua/M2UAConstants.st m2ua/M2UAMSG.st m2ua/M2UATag.st m2ua/M2UAStates.st OSMO = \ osmo/LogAreaOsmo.st \ @@ -62,7 +65,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) $(MTP3) \ + $(CORE) $(IPA) $(SCCP) $(ISUP) $(UA) $(OSMO) $(MTP3) $(M2UA) \ Tests.st pharo-porting/changes_for_pharo.st sed -i s,"=>","==>",g fileout.st diff --git a/m2ua/M2UAConstants.st b/m2ua/M2UAConstants.st new file mode 100644 index 0000000..8061c94 --- /dev/null +++ b/m2ua/M2UAConstants.st @@ -0,0 +1,126 @@ +" + (C) 2011-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 . +" + +UAConstants subclass: M2UAConstants [ + + + + M2UAConstants class >> version [ ^ 1 ] + M2UAConstants class >> spare [ ^ 0 ] + + + M2UAConstants class >> tagData [ ^ 768 ] + M2UAConstants class >> tagDataTTC [ ^ 769 ] + M2UAConstants class >> tagStateReq [ ^ 770 ] + M2UAConstants class >> tagStateEvent [ ^ 771 ] + M2UAConstants class >> tagCongStatus [ ^ 772 ] + M2UAConstants class >> tagDiscStatus [ ^ 773 ] + M2UAConstants class >> tagAction [ ^ 774 ] + M2UAConstants class >> tagSeqNo [ ^ 775 ] + M2UAConstants class >> tagRetrRes [ ^ 776 ] + M2UAConstants class >> tagLinkKey [ ^ 777 ] + M2UAConstants class >> tagLocLinkeyIdent [ ^ 778 ] + M2UAConstants class >> tagSDT [ ^ 779 ] + M2UAConstants class >> tagSDL [ ^ 780 ] + M2UAConstants class >> tagRegRes [ ^ 781 ] + M2UAConstants class >> tagRegStatus [ ^ 782 ] + M2UAConstants class >> tagDeregRes [ ^ 783 ] + M2UAConstants class >> tagDeregStatus [ ^ 784 ] + + M2UAConstants class >> statusLpoSet [ ^ 0 ] + M2UAConstants class >> statusLpoClear [ ^ 1 ] + M2UAConstants class >> statusEmergSet [ ^ 2 ] + M2UAConstants class >> statusEmergClear [ ^ 3 ] + M2UAConstants class >> statusFlushBufs [ ^ 4 ] + M2UAConstants class >> statusContinue [ ^ 5 ] + M2UAConstants class >> statusClearRTB [ ^ 6 ] + M2UAConstants class >> statusAudit [ ^ 7 ] + M2UAConstants class >> statusCongCleared[ ^ 8 ] + M2UAConstants class >> statusCongAccept [ ^ 9 ] + M2UAConstants class >> statusCongDisc [ ^ 10 ] + + M2UAConstants class >> eventRPOEnter [ ^ 1 ] + M2UAConstants class >> eventRPOExit [ ^ 2 ] + M2UAConstants class >> eventLPOEnter [ ^ 3 ] + M2UAConstants class >> eventLPOExit [ ^ 4 ] + + M2UAConstants class >> congLevelNone [ ^ 0 ] + M2UAConstants class >> congLevel1 [ ^ 1 ] + M2UAConstants class >> congLevel2 [ ^ 2 ] + M2UAConstants class >> congLevel3 [ ^ 3 ] + + M2UAConstants class >> actionRtrvBSN [ ^ 0 ] + M2UAConstants class >> actionRtrvMSGs [ ^ 1 ] + + M2UAConstants class >> resultSuccess [ ^ 0 ] + M2UAConstants class >> resultFailure [ ^ 1 ] + + M2UAConstants class >> traOverride [ ^ 1 ] + M2UAConstants class >> traLoadShare [ ^ 2 ] + M2UAConstants class >> traBroadcast [ ^ 3 ] + + M2UAConstants class >> errInvalidVersion [ ^ 1 ] + M2UAConstants class >> errInvalidIdent [ ^ 2 ] + M2UAConstants class >> errUnsMsgClass [ ^ 3 ] + M2UAConstants class >> errUnsMsgType [ ^ 4 ] + M2UAConstants class >> errUnsTraMode [ ^ 5 ] + M2UAConstants class >> errUneMsg [ ^ 6 ] + M2UAConstants class >> errProtocolError [ ^ 7 ] + M2UAConstants class >> errUnsInterIdentInt [ ^ 8 ] + M2UAConstants class >> errInvalidStreamIdent[ ^ 9 ] + M2UAConstants class >> errUnsued1 [ ^ 10 ] + M2UAConstants class >> errUnsued2 [ ^ 11 ] + M2UAConstants class >> errUnsued3 [ ^ 12 ] + M2UAConstants class >> errRefused [ ^ 13 ] + M2UAConstants class >> errAspIdentRequired [ ^ 14 ] + M2UAConstants class >> errInvalidAspIdent [ ^ 15 ] + M2UAConstants class >> errAspActForIdent [ ^ 16 ] + M2UAConstants class >> errInvalidParamVal [ ^ 17 ] + M2UAConstants class >> errParamFieldError [ ^ 18 ] + M2UAConstants class >> errUnexpParam [ ^ 19 ] + M2UAConstants class >> errUnused4 [ ^ 20 ] + M2UAConstants class >> errUnused5 [ ^ 21 ] + M2UAConstants class >> errMissingParam [ ^ 22 ] + + M2UAConstants class >> ntfyKindStateChange [ ^ 1 ] + M2UAConstants class >> ntfyKindOther [ ^ 2 ] + + M2UAConstants class >> ntfyStateASInactive [ ^ 2 ] + M2UAConstants class >> ntfyStateASActive [ ^ 3 ] + M2UAConstants class >> ntfyStateASPending [ ^ 4 ] + + M2UAConstants class >> ntfyOtherInsuffRes [ ^ 1 ] + M2UAConstants class >> ntfyOtherAltAspActiv [ ^ 2 ] + M2UAConstants class >> ntfyOtherAspFailure [ ^ 3 ] + + M2UAConstants class >> regSuccess [ ^ 0 ] + M2UAConstants class >> regErrorUnknown [ ^ 1 ] + M2UAConstants class >> regErrorInvSDLI [ ^ 2 ] + M2UAConstants class >> regErrorInvSDTI [ ^ 3 ] + M2UAConstants class >> regErrorInvLinkKey [ ^ 4 ] + M2UAConstants class >> regErrorPermDenied [ ^ 5 ] + M2UAConstants class >> regErrorOverlapKey [ ^ 6 ] + M2UAConstants class >> regErrorNotProvisioned [ ^ 7 ] + M2UAConstants class >> regErrorInsuffRes [ ^ 8 ] + + M2UAConstants class >> deregSuccess [ ^ 0 ] + M2UAConstants class >> deregErrorUnknown [ ^ 1 ] + M2UAConstants class >> deregErrorInvIdent [ ^ 2 ] + M2UAConstants class >> deregErrorPermDenied [ ^ 3 ] + M2UAConstants class >> deregErrorNotReg [ ^ 4 ] +] diff --git a/m2ua/M2UAMSG.st b/m2ua/M2UAMSG.st new file mode 100644 index 0000000..3b763aa --- /dev/null +++ b/m2ua/M2UAMSG.st @@ -0,0 +1,147 @@ +" + (C) 2011-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: M2UAMSG [ + | msg_class msg_type tags | + + + + + M2UAMSG class >> parseFrom: aMsg [ + + self logDataContext: aMsg area: #m2ua. + + ^ self new + parseFrom: aMsg readStream; + yourself. + ] + + M2UAMSG class >> fromClass: aClass type: aType [ + + ^ self new + instVarNamed: #msg_class put: aClass; + instVarNamed: #msg_type put: aType; + yourself. + ] + + msgClass [ + + ^ msg_class + ] + + msgType [ + + ^ msg_type + ] + + findTag: aTag ifAbsent: aBlock [ + "I find a tag with a tag identifier" + + self tags do: [:each | + (each isTag: aTag) ifTrue: [ + ^ each + ] + ]. + + ^ aBlock value + ] + + tags [ + + ^ tags ifNil: [tags := OrderedCollection new] + ] + + parseFrom: aStream [ + | version spare len end | + + + version := aStream next. + version = M2UAConstants version ifFalse: [ + self logError: + ('M2UA version is wrong <1p>.' expandMacrosWith: version) area: #m2ua. + self error: ('M2UA version is wrong <1p>.' expandMacrosWith: version). + ]. + + spare := aStream next. + spare = M2UAConstants spare ifFalse: [ + self logError: ('M2UA spare is wrong <1p>.' expandMacrosWith: spare) area: #m2ua. + self error: ('M2UA spare is wrong <1p>.' expandMacrosWith: spare). + ]. + + msg_class := aStream next. + msg_type := aStream next. + + len := ((aStream next: 4) uintAt: 1) swap32. + aStream size - aStream position < (len - 8) ifTrue: [ + self logError: ('M2UA length is not plausible <1p> <2p>.' + expandMacrosWith: len with: aStream size - aStream position) + area: #m2ua. + self error: ('M2UA length is not plausible <1p> <2p>.' + expandMacrosWith: len with: aStream size - aStream position). + ]. + + tags := OrderedCollection new. + end := aStream position + len - 8. + + [aStream position < end] whileTrue: [ + tags add: (M2UATag fromStream: aStream) + ]. + ] + + addTag: aTag [ + + self tags add: aTag. + ] + + writeOn: aMsg [ + | tag_data | + + + "Create the tag data" + tag_data := MessageBuffer new. + self tags do: [:each | + each writeOn: tag_data + ]. + + aMsg putByte: M2UAConstants version. + aMsg putByte: M2UAConstants spare. + aMsg putByte: msg_class. + aMsg putByte: msg_type. + aMsg putLen32: tag_data size + 8. + aMsg putByteArray: tag_data. + ] +] + diff --git a/ua/M2UAStates.st b/m2ua/M2UAStates.st similarity index 100% rename from ua/M2UAStates.st rename to m2ua/M2UAStates.st diff --git a/m2ua/M2UATag.st b/m2ua/M2UATag.st new file mode 100644 index 0000000..3f42563 --- /dev/null +++ b/m2ua/M2UATag.st @@ -0,0 +1,85 @@ +" + (C) 2011-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: M2UATag [ + | tag_nr data | + + + + + M2UATag class >> fromStream: aStream [ + + ^ self new + parseFrom: aStream + ] + + M2UATag class >> initWith: aTag data: aData [ + + ^ self new + instVarNamed: #tag_nr put: aTag; + instVarNamed: #data put: aData; + yourself + ] + + parseFrom: aStream [ + | len padding | + + + tag_nr := ((aStream next: 2) shortAt: 1) swap16. + len := ((aStream next: 2) shortAt: 1) swap16. + data := aStream next: len - 4. + + padding := len \\ 4. + padding > 0 ifTrue: [ + self logNotice: + ('Going to skip <1p> bytes' expandMacrosWith: 4 - padding) area: #m2ua. + aStream skip: 4 - padding. + ]. + ] + + nr [ + + ^ tag_nr + ] + + data [ + + ^ data ifNil: [data := ByteArray new] + ] + + writeOn: aMsg [ + | rest | + + + aMsg putLen16: tag_nr. + aMsg putLen16: self data size + 4. + aMsg putByteArray: self data. + + rest := self data size \\ 4. + rest > 0 ifTrue: [ + aMsg putByteArray: (ByteArray new: 4 - rest). + ]. + ] + + isTag: aNr [ + + ^ self nr = aNr + ] +] + diff --git a/package.xml b/package.xml index 214c6f9..84165c7 100644 --- a/package.xml +++ b/package.xml @@ -27,8 +27,11 @@ sccp/SCCPGlobalTitle.st sccp/SCCPGlobalTitleTranslation.st mtp3/MTP3Messages.st - ua/M2UA.st - ua/M2UAStates.st + ua/XUA.st + m2ua/M2UAConstants.st + m2ua/M2UAStates.st + m2ua/M2UATag.st + m2ua/M2UAMSG.st osmo/LogAreaOsmo.st osmo/OsmoUDPSocket.st osmo/OsmoCtrlLogging.st diff --git a/ua/M2UA.st b/ua/M2UA.st deleted file mode 100644 index 3879a83..0000000 --- a/ua/M2UA.st +++ /dev/null @@ -1,420 +0,0 @@ -" - (C) 2011-2012 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: UAConstants [ - " - " - - - - - UAConstants class >> clsMgmt [ ^ 0 ] - UAConstants class >> clsTrans [ ^ 1 ] - UAConstants class >> clsSSMN [ ^ 2 ] - UAConstants class >> clsASPSM [ ^ 3 ] - UAConstants class >> clsASPTM [ ^ 4 ] - UAConstants class >> clsQPTM [ ^ 5 ] - UAConstants class >> clsMAUP [ ^ 6 ] - UAConstants class >> clsSUA_LESS [ ^ 7 ] - UAConstants class >> clsSUA_CONN [ ^ 8 ] - UAConstants class >> clsRKM [ ^ 9 ] - UAConstants class >> clasIIM [ ^ 10 ] - - - UAConstants class >> maupReserved [ ^ 0 ] - UAConstants class >> maupData [ ^ 1 ] - UAConstants class >> maupEstReq [ ^ 2 ] - UAConstants class >> maupEstCon [ ^ 3 ] - UAConstants class >> maupRelReq [ ^ 4 ] - UAConstants class >> maupRelCon [ ^ 5 ] - UAConstants class >> maupRelInd [ ^ 6 ] - UAConstants class >> maupStateReq [ ^ 7 ] - UAConstants class >> maupStateCon [ ^ 8 ] - UAConstants class >> maupStateInd [ ^ 9 ] - UAConstants class >> maupDRetrReq [ ^ 10 ] - UAConstants class >> maupDRetrCon [ ^ 11 ] - UAConstants class >> maupDRetrInd [ ^ 12 ] - UAConstants class >> maupDRetrCompl [ ^ 13 ] - UAConstants class >> maupCongInd [ ^ 14 ] - UAConstants class >> maupDataAck [ ^ 15 ] - - UAConstants class >> aspsmReserved [ ^ 0 ] - UAConstants class >> aspsmUp [ ^ 1 ] - UAConstants class >> aspsmDown [ ^ 2 ] - UAConstants class >> aspsmBeat [ ^ 3 ] - UAConstants class >> aspsmUpAck [ ^ 4 ] - UAConstants class >> aspsmDownAck [ ^ 5 ] - UAConstants class >> aspsmBeatAck [ ^ 6 ] - - UAConstants class >> asptmReserved [ ^ 0 ] - UAConstants class >> asptmActiv [ ^ 1 ] - UAConstants class >> asptmInactiv [ ^ 2 ] - UAConstants class >> asptmActivAck [ ^ 3 ] - UAConstants class >> asptmInactivAck [ ^ 4 ] - - UAConstants class >> mgmtError [ ^ 0 ] - UAConstants class >> mgmtNtfy [ ^ 1 ] - - UAConstants class >> iimReserved [ ^ 0 ] - UAConstants class >> iimRegReq [ ^ 1 ] - UAConstants class >> iimRegRsp [ ^ 2 ] - UAConstants class >> iimDeregReq [ ^ 3 ] - UAConstants class >> iimDeregResp [ ^ 4 ] - - UAConstants class >> tagReserved [ ^ 0 ] - UAConstants class >> tagIdentInt [ ^ 1 ] - UAConstants class >> tagUnused1 [ ^ 2 ] - UAConstants class >> tagIdentText [ ^ 3 ] - UAConstants class >> tagInfo [ ^ 4 ] - UAConstants class >> tagUnused2 [ ^ 5 ] - UAConstants class >> tagUnused3 [ ^ 6 ] - UAConstants class >> tagDiagInf [ ^ 7 ] - UAConstants class >> tagIdentRange [ ^ 8 ] - UAConstants class >> tagBeatData [ ^ 9 ] - UAConstants class >> tagUnused4 [ ^ 10 ] - UAConstants class >> tagTraMode [ ^ 11 ] - UAConstants class >> tagErrCode [ ^ 12 ] - UAConstants class >> tagStatus [ ^ 13 ] - UAConstants class >> tagUnused5 [ ^ 14 ] - UAConstants class >> tagUnused6 [ ^ 15 ] - UAConstants class >> tagUnused7 [ ^ 16 ] - UAConstants class >> tagAspIdent [ ^ 17 ] - UAConstants class >> tagUnused8 [ ^ 18 ] - UAConstants class >> tagCorrelId [ ^ 19 ] - -] - -UAConstants subclass: M2UAConstants [ - - - - M2UAConstants class >> version [ ^ 1 ] - M2UAConstants class >> spare [ ^ 0 ] - - - M2UAConstants class >> tagData [ ^ 768 ] - M2UAConstants class >> tagDataTTC [ ^ 769 ] - M2UAConstants class >> tagStateReq [ ^ 770 ] - M2UAConstants class >> tagStateEvent [ ^ 771 ] - M2UAConstants class >> tagCongStatus [ ^ 772 ] - M2UAConstants class >> tagDiscStatus [ ^ 773 ] - M2UAConstants class >> tagAction [ ^ 774 ] - M2UAConstants class >> tagSeqNo [ ^ 775 ] - M2UAConstants class >> tagRetrRes [ ^ 776 ] - M2UAConstants class >> tagLinkKey [ ^ 777 ] - M2UAConstants class >> tagLocLinkeyIdent [ ^ 778 ] - M2UAConstants class >> tagSDT [ ^ 779 ] - M2UAConstants class >> tagSDL [ ^ 780 ] - M2UAConstants class >> tagRegRes [ ^ 781 ] - M2UAConstants class >> tagRegStatus [ ^ 782 ] - M2UAConstants class >> tagDeregRes [ ^ 783 ] - M2UAConstants class >> tagDeregStatus [ ^ 784 ] - - M2UAConstants class >> statusLpoSet [ ^ 0 ] - M2UAConstants class >> statusLpoClear [ ^ 1 ] - M2UAConstants class >> statusEmergSet [ ^ 2 ] - M2UAConstants class >> statusEmergClear [ ^ 3 ] - M2UAConstants class >> statusFlushBufs [ ^ 4 ] - M2UAConstants class >> statusContinue [ ^ 5 ] - M2UAConstants class >> statusClearRTB [ ^ 6 ] - M2UAConstants class >> statusAudit [ ^ 7 ] - M2UAConstants class >> statusCongCleared[ ^ 8 ] - M2UAConstants class >> statusCongAccept [ ^ 9 ] - M2UAConstants class >> statusCongDisc [ ^ 10 ] - - M2UAConstants class >> eventRPOEnter [ ^ 1 ] - M2UAConstants class >> eventRPOExit [ ^ 2 ] - M2UAConstants class >> eventLPOEnter [ ^ 3 ] - M2UAConstants class >> eventLPOExit [ ^ 4 ] - - M2UAConstants class >> congLevelNone [ ^ 0 ] - M2UAConstants class >> congLevel1 [ ^ 1 ] - M2UAConstants class >> congLevel2 [ ^ 2 ] - M2UAConstants class >> congLevel3 [ ^ 3 ] - - M2UAConstants class >> actionRtrvBSN [ ^ 0 ] - M2UAConstants class >> actionRtrvMSGs [ ^ 1 ] - - M2UAConstants class >> resultSuccess [ ^ 0 ] - M2UAConstants class >> resultFailure [ ^ 1 ] - - M2UAConstants class >> traOverride [ ^ 1 ] - M2UAConstants class >> traLoadShare [ ^ 2 ] - M2UAConstants class >> traBroadcast [ ^ 3 ] - - M2UAConstants class >> errInvalidVersion [ ^ 1 ] - M2UAConstants class >> errInvalidIdent [ ^ 2 ] - M2UAConstants class >> errUnsMsgClass [ ^ 3 ] - M2UAConstants class >> errUnsMsgType [ ^ 4 ] - M2UAConstants class >> errUnsTraMode [ ^ 5 ] - M2UAConstants class >> errUneMsg [ ^ 6 ] - M2UAConstants class >> errProtocolError [ ^ 7 ] - M2UAConstants class >> errUnsInterIdentInt [ ^ 8 ] - M2UAConstants class >> errInvalidStreamIdent[ ^ 9 ] - M2UAConstants class >> errUnsued1 [ ^ 10 ] - M2UAConstants class >> errUnsued2 [ ^ 11 ] - M2UAConstants class >> errUnsued3 [ ^ 12 ] - M2UAConstants class >> errRefused [ ^ 13 ] - M2UAConstants class >> errAspIdentRequired [ ^ 14 ] - M2UAConstants class >> errInvalidAspIdent [ ^ 15 ] - M2UAConstants class >> errAspActForIdent [ ^ 16 ] - M2UAConstants class >> errInvalidParamVal [ ^ 17 ] - M2UAConstants class >> errParamFieldError [ ^ 18 ] - M2UAConstants class >> errUnexpParam [ ^ 19 ] - M2UAConstants class >> errUnused4 [ ^ 20 ] - M2UAConstants class >> errUnused5 [ ^ 21 ] - M2UAConstants class >> errMissingParam [ ^ 22 ] - - M2UAConstants class >> ntfyKindStateChange [ ^ 1 ] - M2UAConstants class >> ntfyKindOther [ ^ 2 ] - - M2UAConstants class >> ntfyStateASInactive [ ^ 2 ] - M2UAConstants class >> ntfyStateASActive [ ^ 3 ] - M2UAConstants class >> ntfyStateASPending [ ^ 4 ] - - M2UAConstants class >> ntfyOtherInsuffRes [ ^ 1 ] - M2UAConstants class >> ntfyOtherAltAspActiv [ ^ 2 ] - M2UAConstants class >> ntfyOtherAspFailure [ ^ 3 ] - - M2UAConstants class >> regSuccess [ ^ 0 ] - M2UAConstants class >> regErrorUnknown [ ^ 1 ] - M2UAConstants class >> regErrorInvSDLI [ ^ 2 ] - M2UAConstants class >> regErrorInvSDTI [ ^ 3 ] - M2UAConstants class >> regErrorInvLinkKey [ ^ 4 ] - M2UAConstants class >> regErrorPermDenied [ ^ 5 ] - M2UAConstants class >> regErrorOverlapKey [ ^ 6 ] - M2UAConstants class >> regErrorNotProvisioned [ ^ 7 ] - M2UAConstants class >> regErrorInsuffRes [ ^ 8 ] - - M2UAConstants class >> deregSuccess [ ^ 0 ] - M2UAConstants class >> deregErrorUnknown [ ^ 1 ] - M2UAConstants class >> deregErrorInvIdent [ ^ 2 ] - M2UAConstants class >> deregErrorPermDenied [ ^ 3 ] - M2UAConstants class >> deregErrorNotReg [ ^ 4 ] -] - -Object subclass: M2UATag [ - | tag_nr data | - - - - - M2UATag class >> fromStream: aStream [ - - ^ self new - parseFrom: aStream - ] - - M2UATag class >> initWith: aTag data: aData [ - - ^ self new - instVarNamed: #tag_nr put: aTag; - instVarNamed: #data put: aData; - yourself - ] - - parseFrom: aStream [ - | len padding | - - - tag_nr := ((aStream next: 2) shortAt: 1) swap16. - len := ((aStream next: 2) shortAt: 1) swap16. - data := aStream next: len - 4. - - padding := len \\ 4. - padding > 0 ifTrue: [ - self logNotice: - ('Going to skip <1p> bytes' expandMacrosWith: 4 - padding) area: #m2ua. - aStream skip: 4 - padding. - ]. - ] - - nr [ - - ^ tag_nr - ] - - data [ - - ^ data ifNil: [data := ByteArray new] - ] - - writeOn: aMsg [ - | rest | - - - aMsg putLen16: tag_nr. - aMsg putLen16: self data size + 4. - aMsg putByteArray: self data. - - rest := self data size \\ 4. - rest > 0 ifTrue: [ - aMsg putByteArray: (ByteArray new: 4 - rest). - ]. - ] - - isTag: aNr [ - - ^ self nr = aNr - ] -] - -Object subclass: M2UAMSG [ - | msg_class msg_type tags | - - - - - M2UAMSG class >> parseFrom: aMsg [ - - self logDataContext: aMsg area: #m2ua. - - ^ self new - parseFrom: aMsg readStream; - yourself. - ] - - M2UAMSG class >> fromClass: aClass type: aType [ - - ^ self new - instVarNamed: #msg_class put: aClass; - instVarNamed: #msg_type put: aType; - yourself. - ] - - msgClass [ - - ^ msg_class - ] - - msgType [ - - ^ msg_type - ] - - findTag: aTag ifAbsent: aBlock [ - "I find a tag with a tag identifier" - - self tags do: [:each | - (each isTag: aTag) ifTrue: [ - ^ each - ] - ]. - - ^ aBlock value - ] - - tags [ - - ^ tags ifNil: [tags := OrderedCollection new] - ] - - parseFrom: aStream [ - | version spare len end | - - - version := aStream next. - version = M2UAConstants version ifFalse: [ - self logError: - ('M2UA version is wrong <1p>.' expandMacrosWith: version) area: #m2ua. - self error: ('M2UA version is wrong <1p>.' expandMacrosWith: version). - ]. - - spare := aStream next. - spare = M2UAConstants spare ifFalse: [ - self logError: ('M2UA spare is wrong <1p>.' expandMacrosWith: spare) area: #m2ua. - self error: ('M2UA spare is wrong <1p>.' expandMacrosWith: spare). - ]. - - msg_class := aStream next. - msg_type := aStream next. - - len := ((aStream next: 4) uintAt: 1) swap32. - aStream size - aStream position < (len - 8) ifTrue: [ - self logError: ('M2UA length is not plausible <1p> <2p>.' - expandMacrosWith: len with: aStream size - aStream position) - area: #m2ua. - self error: ('M2UA length is not plausible <1p> <2p>.' - expandMacrosWith: len with: aStream size - aStream position). - ]. - - tags := OrderedCollection new. - end := aStream position + len - 8. - - [aStream position < end] whileTrue: [ - tags add: (M2UATag fromStream: aStream) - ]. - ] - - addTag: aTag [ - - self tags add: aTag. - ] - - writeOn: aMsg [ - | tag_data | - - - "Create the tag data" - tag_data := MessageBuffer new. - self tags do: [:each | - each writeOn: tag_data - ]. - - aMsg putByte: M2UAConstants version. - aMsg putByte: M2UAConstants spare. - aMsg putByte: msg_class. - aMsg putByte: msg_type. - aMsg putLen32: tag_data size + 8. - aMsg putByteArray: tag_data. - ] -] - diff --git a/ua/XUA.st b/ua/XUA.st new file mode 100644 index 0000000..e5fdb2c --- /dev/null +++ b/ua/XUA.st @@ -0,0 +1,116 @@ +" + (C) 2011-2012 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: UAConstants [ + " + " + + + + + UAConstants class >> clsMgmt [ ^ 0 ] + UAConstants class >> clsTrans [ ^ 1 ] + UAConstants class >> clsSSMN [ ^ 2 ] + UAConstants class >> clsASPSM [ ^ 3 ] + UAConstants class >> clsASPTM [ ^ 4 ] + UAConstants class >> clsQPTM [ ^ 5 ] + UAConstants class >> clsMAUP [ ^ 6 ] + UAConstants class >> clsSUA_LESS [ ^ 7 ] + UAConstants class >> clsSUA_CONN [ ^ 8 ] + UAConstants class >> clsRKM [ ^ 9 ] + UAConstants class >> clasIIM [ ^ 10 ] + + + UAConstants class >> maupReserved [ ^ 0 ] + UAConstants class >> maupData [ ^ 1 ] + UAConstants class >> maupEstReq [ ^ 2 ] + UAConstants class >> maupEstCon [ ^ 3 ] + UAConstants class >> maupRelReq [ ^ 4 ] + UAConstants class >> maupRelCon [ ^ 5 ] + UAConstants class >> maupRelInd [ ^ 6 ] + UAConstants class >> maupStateReq [ ^ 7 ] + UAConstants class >> maupStateCon [ ^ 8 ] + UAConstants class >> maupStateInd [ ^ 9 ] + UAConstants class >> maupDRetrReq [ ^ 10 ] + UAConstants class >> maupDRetrCon [ ^ 11 ] + UAConstants class >> maupDRetrInd [ ^ 12 ] + UAConstants class >> maupDRetrCompl [ ^ 13 ] + UAConstants class >> maupCongInd [ ^ 14 ] + UAConstants class >> maupDataAck [ ^ 15 ] + + UAConstants class >> aspsmReserved [ ^ 0 ] + UAConstants class >> aspsmUp [ ^ 1 ] + UAConstants class >> aspsmDown [ ^ 2 ] + UAConstants class >> aspsmBeat [ ^ 3 ] + UAConstants class >> aspsmUpAck [ ^ 4 ] + UAConstants class >> aspsmDownAck [ ^ 5 ] + UAConstants class >> aspsmBeatAck [ ^ 6 ] + + UAConstants class >> asptmReserved [ ^ 0 ] + UAConstants class >> asptmActiv [ ^ 1 ] + UAConstants class >> asptmInactiv [ ^ 2 ] + UAConstants class >> asptmActivAck [ ^ 3 ] + UAConstants class >> asptmInactivAck [ ^ 4 ] + + UAConstants class >> mgmtError [ ^ 0 ] + UAConstants class >> mgmtNtfy [ ^ 1 ] + + UAConstants class >> iimReserved [ ^ 0 ] + UAConstants class >> iimRegReq [ ^ 1 ] + UAConstants class >> iimRegRsp [ ^ 2 ] + UAConstants class >> iimDeregReq [ ^ 3 ] + UAConstants class >> iimDeregResp [ ^ 4 ] + + UAConstants class >> tagReserved [ ^ 0 ] + UAConstants class >> tagIdentInt [ ^ 1 ] + UAConstants class >> tagUnused1 [ ^ 2 ] + UAConstants class >> tagIdentText [ ^ 3 ] + UAConstants class >> tagInfo [ ^ 4 ] + UAConstants class >> tagUnused2 [ ^ 5 ] + UAConstants class >> tagUnused3 [ ^ 6 ] + UAConstants class >> tagDiagInf [ ^ 7 ] + UAConstants class >> tagIdentRange [ ^ 8 ] + UAConstants class >> tagBeatData [ ^ 9 ] + UAConstants class >> tagUnused4 [ ^ 10 ] + UAConstants class >> tagTraMode [ ^ 11 ] + UAConstants class >> tagErrCode [ ^ 12 ] + UAConstants class >> tagStatus [ ^ 13 ] + UAConstants class >> tagUnused5 [ ^ 14 ] + UAConstants class >> tagUnused6 [ ^ 15 ] + UAConstants class >> tagUnused7 [ ^ 16 ] + UAConstants class >> tagAspIdent [ ^ 17 ] + UAConstants class >> tagUnused8 [ ^ 18 ] + UAConstants class >> tagCorrelId [ ^ 19 ] + +] + +