diff --git a/Makefile b/Makefile
index 0a8cdd6..986159d 100644
--- a/Makefile
+++ b/Makefile
@@ -45,7 +45,11 @@ UA = \
ua/XUA.st
M2UA = \
- m2ua/M2UAConstants.st m2ua/M2UAMSG.st m2ua/M2UATag.st m2ua/M2UAStates.st
+ m2ua/M2UAConstants.st m2ua/M2UAMSG.st m2ua/M2UATag.st m2ua/M2UAMessages.st \
+ m2ua/M2UAStates.st m2ua/M2UAAspStateMachine.st \
+ m2ua/M2UAApplicationServerProcess.st m2ua/M2UALayerManagement.st \
+ m2ua/M2UAExamples.st m2ua/M2UATerminology.st m2ua/M2UATests.st
+
OSMO = \
osmo/LogAreaOsmo.st \
diff --git a/core/ExtensionsGST.st b/core/ExtensionsGST.st
new file mode 100644
index 0000000..efeec62
--- /dev/null
+++ b/core/ExtensionsGST.st
@@ -0,0 +1,28 @@
+"
+ (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 .
+"
+
+BlockClosure extend [
+ value: arg1 value: arg2 value: arg3 value: arg4 [
+
+ "Evaluate the receiver passing arg1, arg2, arg3 and arg4 as the parameters"
+
+
+
+ SystemExceptions.WrongArgumentCount signal
+ ]
+]
diff --git a/m2ua/M2UAApplicationServerProcess.st b/m2ua/M2UAApplicationServerProcess.st
new file mode 100644
index 0000000..e9fb1aa
--- /dev/null
+++ b/m2ua/M2UAApplicationServerProcess.st
@@ -0,0 +1,507 @@
+"
+ (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: M2UAApplicationServerProcess [
+ | socket asp_active_block asp_down_block asp_inactive_block asp_up_block error_block notify_block sctp_confirm_block sctp_released_block sctp_restarted_block sctp_status_block established state t_ack lastMsg on_state_change as_state |
+
+
+
+
+ M2UAApplicationServerProcess class >> initWith: aService [
+ ^self new
+ socketService: aService;
+ yourself
+ ]
+
+ M2UAApplicationServerProcess class >> new [
+ ^super new
+ initialize;
+ yourself
+ ]
+
+ onError: aBlock [
+ "M-ERROR indication
+ Direction: M2UA -> LM
+ Purpose: ASP or SGP reports that it has received an ERROR
+ message from its peer."
+
+
+ error_block := aBlock
+ ]
+
+ onNotify: aBlock [
+ "M-NOTIFY indication
+ Direction: M2UA -> LM
+ Purpose: ASP reports that it has received a NOTIFY message
+ from its peer."
+
+
+ notify_block := aBlock
+ ]
+
+ onSctpEstablished: aBlock [
+ "M-SCTP_ESTABLISH confirm
+ Direction: M2UA -> LM
+ Purpose: ASP confirms to LM that it has established an SCTP association with an SGP."
+
+
+ sctp_confirm_block := aBlock
+ ]
+
+ onSctpReleased: aBlock [
+ "M-SCTP_RELEASE confirm
+ Direction: M2UA -> LM
+ Purpose: ASP confirms to LM that it has released SCTP association with SGP."
+
+
+ sctp_released_block := aBlock
+ ]
+
+ onSctpRestarted: aBlock [
+ "M-SCTP_RELEASE indication
+ Direction: M2UA -> LM
+ Purpose: SGP informs LM that ASP has released an SCTP association."
+
+
+ sctp_restarted_block := aBlock
+ ]
+
+ onSctpStatus: aBlock [
+ "M-SCTP_STATUS indication
+ Direction: M2UA -> LM
+ Purpose: M2UA reports status of SCTP association."
+
+
+ sctp_status_block := aBlock
+ ]
+
+ sctpEstablish [
+ "M-SCTP_ESTABLISH request
+ Direction: LM -> M2UA
+ Purpose: LM requests ASP to establish an SCTP association with an SGP."
+
+
+ established := false.
+ socket stop.
+ socket start
+ ]
+
+ sctpRelease [
+ "M-SCTP_RELEASE request
+ Direction: LM -> M2UA
+ Purpose: LM requests ASP to release an SCTP association with SGP."
+
+
+ established := false.
+ socket stop.
+ t_ack ifNotNil: [t_ack cancel]
+ ]
+
+ sctpStatusRequest [
+ "M-SCTP_STATUS request
+ Direction: LM -> M2UA
+ Purpose: LM requests M2UA to report status of SCTP association."
+
+
+ self notYetImplemented
+ ]
+
+ aspActive [
+
+ "M-ASP_ACTIVE request
+ Direction: LM -> M2UA
+ Purpose: LM requests ASP to send an ASP ACTIVE message to the SGP."
+
+ | msg |
+ self checkNextState: M2UAAspStateActive.
+ msg := M2UAMSG new
+ class: M2UAConstants clsASPTM;
+ msgType: M2UAConstants asptmActiv;
+ addTag: self createIdentIntTag;
+ addTag: self createInfoTag;
+ yourself.
+ self send: msg
+ ]
+
+ aspDown [
+
+ "M-ASP_DOWN request
+ Direction: LM -> M2UA
+ Purpose: LM requests ASP to stop its operation and send an ASP DOWN
+ message to the SGP."
+
+ | msg |
+ self checkNextState: M2UAAspStateDown.
+ msg := M2UAMSG new
+ class: M2UAConstants clsASPSM;
+ msgType: M2UAConstants aspsmDown;
+ addTag: self createAspIdentTag;
+ addTag: self createInfoTag;
+ yourself.
+ self send: msg
+ ]
+
+ aspInactive [
+
+ "M-ASP_INACTIVE request
+ Direction: LM -> M2UA
+ Purpose: LM requests ASP to send an ASP INACTIVE message to the SGP."
+
+ | msg |
+ self checkNextState: M2UAAspStateInactive.
+ msg := M2UAMSG new
+ class: M2UAConstants clsASPTM;
+ msgType: M2UAConstants asptmInactiv;
+ addTag: self createIdentIntTag;
+ addTag: self createInfoTag;
+ yourself.
+ self send: msg
+ ]
+
+ aspUp [
+
+ "M-ASP_UP request
+ Direction: LM -> M2UA
+ Purpose: LM requests ASP to start its operation and send an ASP UP
+ message to the SGP."
+
+ | msg |
+ self checkNextState: M2UAAspStateInactive.
+ msg := M2UAMSG new
+ class: M2UAConstants clsASPSM;
+ msgType: M2UAConstants aspsmUp;
+ addTag: self createAspIdentTag;
+ addTag: self createInfoTag;
+ yourself.
+ self send: msg
+ ]
+
+ onAspActive: aBlock [
+ "M-ASP_ACTIVE confirm
+ Direction: M2UA -> LM
+ Purpose: ASP reports that is has received an ASP ACTIVE
+ Acknowledgment message from the SGP."
+
+
+ asp_active_block := aBlock
+ ]
+
+ onAspDown: aBlock [
+ "M-ASP_DOWN confirm
+ Direction: M2UA -> LM
+ Purpose: ASP reports that is has received an ASP DOWN Acknowledgment
+ message from the SGP."
+
+
+ asp_down_block := aBlock
+ ]
+
+ onAspInactive: aBlock [
+ "M-ASP_INACTIVE confirm
+ Direction: M2UA -> LM
+ Purpose: ASP reports that is has received an ASP INACTIVE
+ Acknowledgment message from the SGP."
+
+
+ asp_inactive_block := aBlock
+ ]
+
+ onAspUp: aBlock [
+ "M-ASP_UP confirm
+ Direction: M2UA -> LM
+ Purpose: ASP reports that it has received an ASP UP Acknowledgment
+ message from the SGP."
+
+
+ asp_up_block := aBlock
+ ]
+
+ onStateChange: aBlock [
+ "A generic callback for all state changes"
+
+
+ on_state_change := aBlock
+ ]
+
+ deregisterLinkKey [
+ "M-LINK_KEY_DEREG Request
+ Direction: LM -> M2UA
+ Purpose: LM requests ASP to de-register Link Key with SG by sending
+ DEREG REQ message."
+
+
+ self notYetImplemented
+ ]
+
+ onLinkKeyDeregistered: aBlock [
+ "M-LINK_KEY_DEREG Confirm
+ Direction: M2UA -> LM
+ Purpose: ASP reports to LM that it has successfully received a
+ DEREG RSP message from SG."
+
+
+ self notYetImplemented
+ ]
+
+ onLinkKeyRegistered: aBlock [
+ "M-LINK_KEY_REG Confirm
+ Direction: M2UA -> LM
+ Purpose: ASP reports to LM that it has successfully received a REG
+ RSP message from SG."
+
+
+ self notYetImplemented
+ ]
+
+ registerLinkKey [
+ "M-LINK_KEY_REG Request
+ Direction: LM -> M2UA
+ Purpose: LM requests ASP to register Link Key with SG by sending REG
+ REQ message."
+
+
+ self notYetImplemented
+ ]
+
+ hostname: aHostname port: aPort [
+ "Select the SCTP hostname/port for the SG to connect to"
+
+
+ socket
+ hostname: aHostname;
+ port: aPort
+ ]
+
+ createAspIdentTag [
+
+ ^M2UATag initWith: M2UAConstants tagAspIdent data: #(1 2 3 4)
+ ]
+
+ createIdentIntTag [
+
+ ^M2UATag initWith: M2UAConstants tagIdentInt data: #(0 0 0 0)
+ ]
+
+ createInfoTag [
+
+ ^M2UATag initWith: M2UAConstants tagInfo
+ data: 'Hello from Smalltalk' asByteArray
+ ]
+
+ callNotification: aBlock [
+ "Inform the generic method first, then all the others"
+
+
+ on_state_change ifNotNil: [on_state_change value].
+ aBlock ifNotNil: [aBlock value]
+ ]
+
+ checkNextState: nextState [
+ "Check if nextState and state are compatible and if not
+ throw an exception. TODO:"
+
+
+ self state = nextState
+ ifTrue:
+ [^self error: ('M2UA ASP already in state <1p>' expandMacrosWith: state)].
+ (self state nextPossibleStates includes: nextState)
+ ifFalse:
+ [^self error: ('M2UA ASP illegal state transition from <1p> to <2p>.'
+ expandMacrosWith: state
+ with: nextState)]
+ ]
+
+ dispatchData: aByteArray [
+
+ | msg |
+ msg := M2UAMSG parseToClass: aByteArray.
+ msg dispatchOnAsp: self
+ ]
+
+ dispatchNotification: aBlock [
+
+ aBlock value
+ ]
+
+ internalReset [
+
+ self socketService: socket
+ ]
+
+ moveToState: newState [
+
+ ((state nextPossibleStates includes: newState) or: [state = newState])
+ ifFalse:
+ [^self error: ('M2UA ASP Illegal state transition from <1p> to <2p>'
+ expandMacrosWith: state
+ with: newState)].
+
+ "TODO: general on entry, on exit"
+ state := newState
+ ]
+
+ sctpConnected [
+
+ "The connect was issued."
+
+ | wasEstablished |
+ wasEstablished := established.
+ established := true.
+ state := M2UAAspStateDown.
+ t_ack ifNotNil: [t_ack cancel].
+ wasEstablished = true
+ ifTrue: [sctp_confirm_block ifNotNil: [sctp_confirm_block value]]
+ ifFalse: [sctp_restarted_block ifNotNil: [sctp_restarted_block value]]
+ ]
+
+ sctpReleased [
+ "The SCTP connection has been released."
+
+
+ self moveToState: M2UAAspStateDown.
+ established = true ifFalse: [^self].
+ sctp_released_block ifNotNil: [sctp_released_block value]
+ ]
+
+ send: aMsg [
+ "Forget about what we did before"
+
+
+ t_ack ifNotNil: [t_ack cancel].
+ t_ack := TimerScheduler instance scheduleInSeconds: 2
+ block:
+ ["Re-send the message"
+
+ self logNotice: ('<1p>:<2p> Sending message has timed out'
+ expandMacrosWith: socket hostname
+ with: socket port)
+ area: #m2ua.
+ self send: aMsg].
+ socket nextPut: aMsg toMessage asByteArray
+ ]
+
+ initialize [
+
+ state := M2UAAspStateDown
+ ]
+
+ socketService: aService [
+
+ socket := aService.
+ socket
+ onSctpConnect: [self sctpConnected];
+ onSctpReleased: [self sctpReleased];
+ onSctpData:
+ [:stream :assoc :ppid :data |
+ ppid = 2
+ ifFalse:
+ [^self logNotice: 'M2UAApplicationServerProcess expecting PPID 2.'
+ area: #m2ua].
+ self dispatchData: data]
+ ]
+
+ handleAspActiveAck: aMsg [
+
+ t_ack cancel.
+ self moveToState: M2UAAspStateActive.
+ self callNotification: asp_active_block
+ ]
+
+ handleAspDownAck: aMsg [
+
+ t_ack cancel.
+ as_state := nil.
+ self moveToState: M2UAAspStateDown.
+ self callNotification: asp_down_block
+ ]
+
+ handleAspInactiveAck: aMsg [
+
+ t_ack cancel.
+ as_state := nil.
+ self moveToState: M2UAAspStateInactive.
+ self callNotification: asp_inactive_block
+ ]
+
+ handleAspUpAck: aMsg [
+
+ t_ack cancel.
+ self moveToState: M2UAAspStateInactive.
+ self callNotification: asp_inactive_block
+ ]
+
+ handleError: aMsg [
+ "Cancel pending operations.. because something went wrong"
+
+
+ t_ack cancel.
+ error_block ifNotNil: [error_block value: aMsg]
+ ]
+
+ handleNotify: aMsg [
+
+ "Extract the status"
+
+ | tag type ident |
+ tag := aMsg findTag: M2UAConstants tagStatus.
+ tag ifNil: [^self].
+ type := (tag data ushortAt: 1) swap16.
+ ident := (tag data ushortAt: 3) swap16.
+ type = M2UAConstants ntfyKindStateChange ifTrue: [as_state := ident].
+
+ "Inform our user about it"
+ notify_block ifNotNil: [notify_block value: type value: ident]
+ ]
+
+ handleUnknownMessage: aMsg [
+ "We got something we don't know. ignore it for now."
+
+
+
+ ]
+
+ isASActive [
+
+ ^as_state = M2UAConstants ntfyStateASActive
+ ]
+
+ isASInactive [
+
+ ^as_state = M2UAConstants ntfyStateASInactive
+ ]
+
+ isASPending [
+
+ ^as_state = M2UAConstants ntfyStateASPending
+ ]
+
+ state [
+
+ ^state
+ ]
+]
diff --git a/m2ua/M2UAAspStateMachine.st b/m2ua/M2UAAspStateMachine.st
new file mode 100644
index 0000000..0e495e6
--- /dev/null
+++ b/m2ua/M2UAAspStateMachine.st
@@ -0,0 +1,106 @@
+"
+ (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: M2UAAspStateMachine [
+ | state |
+
+
+
+
+ M2UAAspStateMachine class >> initialState [
+ ^M2UAAspStateDown
+ ]
+
+ M2UAAspStateMachine class >> new [
+ ^(self basicNew)
+ initialize;
+ yourself
+ ]
+
+ entered: aState [
+ aState entered
+
+ "TODO notify users of the machine"
+ ]
+
+ initialize [
+ state := self class initialState on: self
+ ]
+
+ left: aState [
+ aState left
+
+ "TODO notify users of the machine"
+ ]
+
+ moveToState: aNewState [
+ | oldState |
+ oldState := state.
+ state := (aNewState new)
+ machine: self;
+ yourself.
+ self left: oldState.
+ self entered: state
+ ]
+
+ state [
+ ^state class
+ ]
+
+ aspActive: anEvent [
+
+ state onAspActive: anEvent
+ ]
+
+ aspDown: anEvent [
+
+ state onAspDown: anEvent
+ ]
+
+ aspInactive: anEvent [
+
+ state onAspInactive: anEvent
+ ]
+
+ aspUp: anEvent [
+
+ state onAspUp: anEvent
+ ]
+
+ otherAspInAsOverrides: anEvent [
+
+ state onOtherAspInAsOverrides: anEvent
+ ]
+
+ sctpCdi: anEvent [
+
+ state onSctpCdi: anEvent
+ ]
+
+ sctpRi: anEvent [
+
+ state onSctpRi: anEvent
+ ]
+]
diff --git a/m2ua/M2UAExamples.st b/m2ua/M2UAExamples.st
new file mode 100644
index 0000000..feb29c4
--- /dev/null
+++ b/m2ua/M2UAExamples.st
@@ -0,0 +1,42 @@
+"
+ (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: M2UAExamples [
+
+
+
+
+ createAsp [
+ "Create a SCTP network service"
+
+ | service asp manager |
+ service := SCTPNetworkService new
+ hostname: 'localhost';
+ port: 2904;
+ yourself.
+ "Create the ASP"
+ asp := M2UAApplicationServerProcess initWith: service.
+
+ "Create a Layer Management (LM) and start it"
+ manager := M2UALayerManagement new
+ applicationServerProcess: asp;
+ targetState: M2UAAspStateActive;
+ yourself.
+ manager manage
+ ]
+]
diff --git a/m2ua/M2UALayerManagement.st b/m2ua/M2UALayerManagement.st
new file mode 100644
index 0000000..2f0e086
--- /dev/null
+++ b/m2ua/M2UALayerManagement.st
@@ -0,0 +1,127 @@
+"
+ (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: M2UALayerManagement [
+ | targetState managedProcess |
+
+
+
+
+ applicationServerProcess: aProcess [
+
+ managedProcess := aProcess.
+ managedProcess
+ onSctpEstablished: [self sctpEstablished];
+ onSctpRestarted: [self sctpEstablished];
+ onError: [:msg | self m2uaError: msg];
+ onNotify: [:type :ident | self m2uaNotify: type ident: ident];
+ onAspActive: [self m2uaActive];
+ onAspInactive: [self m2uaInactive];
+ onAspDown: [self m2uaDown];
+ onAspUp: [self m2uaUp]
+ ]
+
+ manage [
+ "I begin to manage the process."
+
+
+ managedProcess
+ sctpRelease;
+ sctpEstablish
+ ]
+
+ targetState: aState [
+ "Use the M2UAAspState subclasses for the states"
+
+
+ targetState := aState
+ ]
+
+ applicationServerProcess [
+
+ ^managedProcess
+ ]
+
+ m2uaActive [
+ "E.g if the target state is already reached"
+
+
+ managedProcess state = targetState ifTrue: [^self targetReached].
+ targetState = M2UAAspStateInactive
+ ifTrue: [managedProcess aspInactive]
+ ifFalse: [managedProcess aspDown]
+ ]
+
+ m2uaDown [
+ "E.g if the target state is already reached"
+
+
+ managedProcess state = targetState ifTrue: [^self targetReached].
+
+ "There is only one way forward"
+ managedProcess aspUp
+ ]
+
+ m2uaError: aMsg [
+
+ self logNotice: 'M2UA Error.' area: #m2ua
+ ]
+
+ m2uaInactive [
+ "E.g if the target state is already reached"
+
+
+ managedProcess state = targetState ifTrue: [^self targetReached].
+ targetState = M2UAAspStateActive
+ ifTrue: [managedProcess aspActive]
+ ifFalse: [managedProcess aspDown]
+ ]
+
+ m2uaNotify: type ident: ident [
+ "TODO: Check the type/ident"
+
+
+
+ ]
+
+ m2uaUp [
+ "E.g if the target state is already reached"
+
+
+ managedProcess state = targetState ifTrue: [^self targetReached].
+ targetState = M2UAAspStateActive
+ ifTrue: [managedProcess aspActive]
+ ifFalse: [managedProcess aspInactive]
+ ]
+
+ sctpEstablished [
+ "E.g if the target state is already reached"
+
+
+ managedProcess state = targetState ifTrue: [^self].
+ "There is only one way forward"
+ managedProcess aspUp
+ ]
+
+ targetReached [
+
+ ]
+]
diff --git a/m2ua/M2UAMSG.st b/m2ua/M2UAMSG.st
index 3b763aa..313555b 100644
--- a/m2ua/M2UAMSG.st
+++ b/m2ua/M2UAMSG.st
@@ -57,6 +57,41 @@ struct m2ua_parameter_hdr {
yourself.
]
+ M2UAMSG class >> copyFrom: aMsg [
+
+ ^ self new
+ msgClass: aMsg msgClass;
+ msgType: aMsg msgType;
+ tags: aMsg tags;
+ yourself
+ ]
+
+ M2UAMSG class >> parseToClass: aMsg [
+
+ "This will attempt to parse the message into one of the
+ available subclasses."
+
+ | rawMsg msgClasses |
+ rawMsg := self parseFrom: aMsg.
+
+ "A simple class based lookup"
+ msgClasses :=
+ {M2UAASPSMMessage.
+ M2UAASPTMMessage.
+ M2UAASPMGMTMessage}.
+ msgClasses do:
+ [:msgClass |
+ rawMsg msgClass = msgClass messageClass
+ ifTrue:
+ [msgClass allSubclassesDo: [:class |
+ class messageTag = rawMsg msgType
+ ifTrue: [^class copyFrom: rawMsg]]]].
+
+ ^self error: ('Unknown message class (<1p>) or message type (<2p>)'
+ expandMacrosWith: rawMsg msgClass
+ with: rawMsg msgType)
+ ]
+
msgClass [
^ msg_class
@@ -67,6 +102,13 @@ struct m2ua_parameter_hdr {
^ msg_type
]
+ findTag: aTag [
+ "I find a tag with a tag identifier"
+
+
+ ^self findTag: aTag ifAbsent: [nil]
+ ]
+
findTag: aTag ifAbsent: aBlock [
"I find a tag with a tag identifier"
@@ -85,42 +127,61 @@ struct m2ua_parameter_hdr {
]
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)
- ].
+
+ | len |
+ self parseVersion: aStream.
+ self parseSpare: aStream.
+ msg_class := aStream next.
+ msg_type := aStream next.
+ len := self parseLength: aStream.
+ tags := self parseTags: aStream to: aStream position + len - 8
]
+ parseLength: aStream [
+
+ | len |
+ 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)].
+ ^len
+ ]
+
+ parseSpare: aStream [
+
+ | spare |
+ 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)]
+ ]
+
+ parseTags: aStream to: end [
+
+ tags := OrderedCollection new.
+ [aStream position < end]
+ whileTrue: [tags add: (M2UATag fromStream: aStream)].
+ ^tags
+ ]
+
+ parseVersion: aStream [
+
+ | version |
+ 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)]
+ ]
addTag: aTag [
self tags add: aTag.
@@ -143,5 +204,30 @@ struct m2ua_parameter_hdr {
aMsg putLen32: tag_data size + 8.
aMsg putByteArray: tag_data.
]
+
+ class: aClass [
+
+ msg_class := aClass
+ ]
+
+ msgClass: aClass [
+
+ self class: aClass
+ ]
+
+ msgType: aType [
+
+ msg_type := aType
+ ]
+
+ tags: aTags [
+
+ tags := aTags
+ ]
+
+ dispatchOnAsp: anAsp [
+
+ anAsp handleUnknownMessage: self
+ ]
]
diff --git a/m2ua/M2UAMessages.st b/m2ua/M2UAMessages.st
new file mode 100644
index 0000000..e9f4a16
--- /dev/null
+++ b/m2ua/M2UAMessages.st
@@ -0,0 +1,217 @@
+"
+ (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 .
+"
+
+M2UAMSG subclass: M2UAASPSMMessage [
+
+
+
+
+ M2UAASPSMMessage class >> messageClass [
+ ^M2UAConstants clsASPSM
+ ]
+]
+
+M2UAMSG subclass: M2UAASPTMMessage [
+
+
+
+
+ M2UAASPTMMessage class >> messageClass [
+ ^M2UAConstants clsASPTM
+ ]
+]
+
+M2UAMSG subclass: M2UAASPMGMTMessage [
+
+
+
+
+ M2UAASPMGMTMessage class >> messageClass [
+ ^M2UAConstants clsMgmt
+ ]
+]
+
+M2UAASPSMMessage subclass: M2UAApplicationServerProcessHeartbeatAck [
+
+
+
+
+ M2UAApplicationServerProcessHeartbeatAck class >> messageTag [
+ ^M2UAConstants aspsmBeatAck
+ ]
+]
+
+M2UAASPSMMessage subclass: M2UAApplicationServerProcessDown [
+
+
+
+
+ M2UAApplicationServerProcessDown class >> messageTag [
+ ^M2UAConstants aspsmDown
+ ]
+
+ dispatchOnAsp: anAsp [
+
+ anAsp handleAspDown: self
+ ]
+]
+
+M2UAASPSMMessage subclass: M2UAApplicationServerProcessHeartbeat [
+
+
+
+
+ M2UAApplicationServerProcessHeartbeat class >> messageTag [
+ ^M2UAConstants aspsmBeat
+ ]
+]
+
+M2UAASPSMMessage subclass: M2UAApplicationServerProcessDownAck [
+
+
+
+
+ M2UAApplicationServerProcessDownAck class >> messageTag [
+ ^M2UAConstants aspsmDownAck
+ ]
+
+ dispatchOnAsp: anAsp [
+
+ anAsp handleAspDownAck: self
+ ]
+]
+
+M2UAASPSMMessage subclass: M2UAApplicationServerProcessUp [
+
+
+
+
+ M2UAApplicationServerProcessUp class >> messageTag [
+ ^M2UAConstants aspsmUp
+ ]
+
+ dispatchOnAsp: anAsp [
+
+ anAsp handleAspUp: self
+ ]
+]
+
+M2UAASPTMMessage subclass: M2UAApplicationServerProcessInactiveAck [
+
+
+
+
+ M2UAApplicationServerProcessInactiveAck class >> messageTag [
+ ^M2UAConstants asptmInactivAck
+ ]
+
+ dispatchOnAsp: anAsp [
+
+ anAsp handleAspInactiveAck: self
+ ]
+]
+
+M2UAASPTMMessage subclass: M2UAApplicationServerProcessActive [
+
+
+
+
+ M2UAApplicationServerProcessActive class >> messageTag [
+ ^M2UAConstants asptmActiv
+ ]
+
+ dispatchOnAsp: anAsp [
+
+ anAsp handleAspActive: self
+ ]
+]
+
+M2UAASPTMMessage subclass: M2UAApplicationServerProcessInactive [
+
+
+
+
+ M2UAApplicationServerProcessInactive class >> messageTag [
+ ^M2UAConstants asptmInactiv
+ ]
+
+ dispatchOnAsp: anAsp [
+
+ anAsp handleAspInactive: self
+ ]
+]
+
+M2UAASPMGMTMessage subclass: M2UAApplicationServerProcessNotify [
+
+
+
+
+ M2UAApplicationServerProcessNotify class >> messageTag [
+ ^M2UAConstants mgmtNtfy
+ ]
+
+ dispatchOnAsp: anAsp [
+
+ anAsp handleNotify: self
+ ]
+]
+
+M2UAASPMGMTMessage subclass: M2UAApplicationServerProcessError [
+
+
+
+
+ M2UAApplicationServerProcessError class >> messageTag [
+ ^M2UAConstants mgmtError
+ ]
+
+ dispatchOnAsp: anAsp [
+
+ anAsp handleError: self
+ ]
+]
+
+M2UAASPTMMessage subclass: M2UAApplicationServerProcessActiveAck [
+
+
+
+
+ M2UAApplicationServerProcessActiveAck class >> messageTag [
+ ^M2UAConstants asptmActivAck
+ ]
+
+ dispatchOnAsp: anAsp [
+
+ anAsp handleAspActiveAck: self
+ ]
+]
+
+M2UAASPSMMessage subclass: M2UAApplicationServerProcessUpAck [
+
+
+
+
+ M2UAApplicationServerProcessUpAck class >> messageTag [
+ ^M2UAConstants aspsmUpAck
+ ]
+
+ dispatchOnAsp: anAsp [
+
+ anAsp handleAspUpAck: self
+ ]
+]
diff --git a/m2ua/M2UAStates.st b/m2ua/M2UAStates.st
index ed9f1ae..dc26c85 100644
--- a/m2ua/M2UAStates.st
+++ b/m2ua/M2UAStates.st
@@ -42,6 +42,7 @@ STInST.RBProgramNodeVisitor subclass: M2UAStateMachineVisitor [
Object subclass: M2UAStateBase [
+ | machine |
@@ -82,6 +83,31 @@ Object subclass: M2UAStateBase [
nextPutAll: '}';
contents
]
+
+ M2UAStateBase class >> on: aMachine [
+ "Create a new state for a machine"
+
+ ^self new
+ machine: aMachine;
+ yourself
+ ]
+
+ entered [
+ "The state has been entered"
+ ]
+
+ left [
+ "The state has been left"
+ ]
+
+ machine: aMachine [
+ machine := aMachine
+ ]
+
+ moveToState: aNewState [
+
+ machine moveToState: aNewState
+ ]
]
@@ -147,6 +173,10 @@ M2UAStateBase subclass: M2UAAspState [
+
+ M2UAAspState class >> nextPossibleStates [
+ ^self subclassResponsibility
+ ]
]
@@ -156,6 +186,10 @@ M2UAAspState subclass: M2UAAspStateActive [
+ M2UAAspStateActive class >> nextPossibleStates [
+ ^ {M2UAAspStateInactive. M2UAAspStateDown}
+ ]
+
onAspDown: anEvent [
self moveToState: M2UAAspStateDown
@@ -189,6 +223,10 @@ M2UAAspState subclass: M2UAAspStateDown [
+ M2UAAspStateDown class >> nextPossibleStates [
+ ^{M2UAAspStateInactive}
+ ]
+
onAspUp: anEvent [
^self moveToState: M2UAAspStateInactive
@@ -202,6 +240,10 @@ M2UAAspState subclass: M2UAAspStateInactive [
+ M2UAAspStateInactive class >> nextPossibleStates [
+ ^ {M2UAAspStateActive. M2UAAspStateDown}
+ ]
+
onAspActive: anEvent [
^self moveToState: M2UAAspStateActive
diff --git a/m2ua/M2UATerminology.st b/m2ua/M2UATerminology.st
new file mode 100644
index 0000000..6c1ae72
--- /dev/null
+++ b/m2ua/M2UATerminology.st
@@ -0,0 +1,44 @@
+"
+ (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: M2UATerminology [
+
+
+
+]
diff --git a/m2ua/M2UATests.st b/m2ua/M2UATests.st
new file mode 100644
index 0000000..4f6def2
--- /dev/null
+++ b/m2ua/M2UATests.st
@@ -0,0 +1,222 @@
+"
+ (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: M2UAASMock [
+ | socket |
+
+
+
+
+ socketService: aSocket [
+
+ socket := aSocket
+ ]
+
+ handleAspActive: aMsg [
+
+ | ret |
+ ret := M2UAMSG new
+ msgClass: M2UAConstants clsASPTM;
+ msgType: M2UAConstants asptmActivAck;
+ yourself.
+ socket sendToAsp: ret toMessage asByteArray
+ ]
+
+ handleAspDown: aMsg [
+
+ | ret |
+ ret := M2UAMSG new
+ msgClass: M2UAConstants clsASPSM;
+ msgType: M2UAConstants aspsmDownAck;
+ yourself.
+ socket sendToAsp: ret toMessage asByteArray
+ ]
+
+ handleAspInactive: aMsg [
+
+ | ret |
+ ret := M2UAMSG new
+ msgClass: M2UAConstants clsASPTM;
+ msgType: M2UAConstants asptmInactivAck;
+ yourself.
+ socket sendToAsp: ret toMessage asByteArray
+ ]
+
+ handleAspUp: aMsg [
+
+ | ret |
+ ret := M2UAMSG new
+ msgClass: M2UAConstants clsASPSM;
+ msgType: M2UAConstants aspsmUpAck;
+ yourself.
+ socket sendToAsp: ret toMessage asByteArray
+ ]
+
+ onData: aData [
+ | msg |
+ msg := M2UAMSG parseToClass: aData.
+ msg dispatchOnAsp: self
+ ]
+]
+
+Object subclass: SCTPNetworkServiceMock [
+ | on_connect on_released on_data as asp |
+
+
+
+
+ onSctpConnect: aBlock [
+
+ on_connect := aBlock
+ ]
+
+ applicationServer: anAs [
+
+ as := anAs
+ ]
+
+ applicationServerProcess: anAsp [
+
+ asp := anAsp
+ ]
+
+ onSctpData: aBlock [
+
+ on_data := aBlock
+ ]
+
+ onSctpReleased: aBlock [
+
+ on_released := aBlock
+ ]
+
+ hostname [
+
+ ^'localhost'
+ ]
+
+ port [
+
+ ^0
+ ]
+
+ start [
+ "Nothing"
+
+
+ on_connect value
+ ]
+
+ stop [
+
+ on_released value
+ ]
+
+ nextPut: aMsg [
+ as onData: aMsg
+ ]
+
+ sendToAsp: aMsg [
+ on_data
+ value: nil
+ value: nil
+ value: 2
+ value: aMsg
+ ]
+]
+
+TestCase subclass: M2UAApplicationServerProcessTest [
+
+
+
+
+ testCreation [
+ | asp |
+ asp := M2UAApplicationServerProcess new
+ onAspActive: [];
+ onAspDown: [];
+ onAspInactive: [];
+ onAspUp: [];
+ onStateChange: [];
+ onError: [:msg | ];
+ onNotify: [:type :ident | ];
+ onSctpEstablished: [];
+ onSctpReleased: [];
+ onSctpRestarted: [];
+ onSctpStatus: [];
+ yourself
+ ]
+
+ testStateTransitions [
+ | mock as asp |
+ mock := SCTPNetworkServiceMock new.
+ as := M2UAASMock new
+ socketService: mock;
+ yourself.
+ asp := M2UAApplicationServerProcess initWith: mock.
+ mock
+ applicationServer: as;
+ applicationServerProcess: asp.
+
+ "This works as the mock will handle this synchronously"
+ self assert: asp state = M2UAAspStateDown.
+ asp
+ sctpEstablish;
+ aspUp.
+ self assert: asp state = M2UAAspStateInactive.
+
+ "Now bring it down and up again"
+ asp aspDown.
+ self assert: asp state = M2UAAspStateDown.
+ asp
+ aspUp;
+ aspActive.
+ self assert: asp state = M2UAAspStateActive.
+ asp aspDown.
+ self assert: asp state = M2UAAspStateDown.
+ asp
+ aspUp;
+ aspActive;
+ aspInactive.
+ self assert: asp state = M2UAAspStateInactive.
+ asp sctpRelease.
+ self assert: asp state = M2UAAspStateDown
+ ]
+]
+
+TestCase subclass: M2UAAspStateMachineTest [
+
+
+
+
+ testLegalTransitions [
+ | machine |
+ machine := M2UAAspStateMachine new.
+ self assert: machine state = M2UAAspStateDown.
+ machine aspUp: 'Link is up'.
+ self assert: machine state = M2UAAspStateInactive.
+ machine aspActive: 'Active'.
+ self assert: machine state = M2UAAspStateActive.
+ machine aspInactive: 'Inactive'.
+ self assert: machine state = M2UAAspStateInactive.
+ machine aspActive: 'Active'.
+ self assert: machine state = M2UAAspStateActive.
+ machine sctpCdi: 'Connection is gone'.
+ self assert: machine state = M2UAAspStateDown
+ ]
+]
diff --git a/package.xml b/package.xml
index 84165c7..eb6eb1f 100644
--- a/package.xml
+++ b/package.xml
@@ -9,6 +9,7 @@
Parser
core/Extensions.st
+ core/ExtensionsGST.st
core/MessageStructure.st
core/MessageBuffer.st
core/LogAreas.st
@@ -28,10 +29,21 @@
sccp/SCCPGlobalTitleTranslation.st
mtp3/MTP3Messages.st
ua/XUA.st
+
m2ua/M2UAConstants.st
m2ua/M2UAStates.st
m2ua/M2UATag.st
m2ua/M2UAMSG.st
+ m2ua/M2UAMessages.st
+ m2ua/M2UAStates.st
+ m2ua/M2UAAspStateMachine.st
+ m2ua/M2UAApplicationServerProcess.st
+ m2ua/M2UALayerManagement.st
+ m2ua/M2UATerminology.st
+ m2ua/M2UAExamples.st
+
+
+
osmo/LogAreaOsmo.st
osmo/OsmoUDPSocket.st
osmo/OsmoCtrlLogging.st
@@ -48,13 +60,16 @@
Osmo.IPAGSTTests
Osmo.IPAMsgTests
Osmo.MessageBufferTest
- Osmo.M2UAMSGTests
Osmo.ISUPGeneratedTest
Osmo.OsmoUDPSocketTest
Osmo.TLVDescriptionTest
Osmo.CtrlGrammarTest
Osmo.CtrlParserTest
+ Osmo.M2UAMSGTests
+ Osmo.M2UAApplicationServerProcessTest
+ Osmo.M2UAAspStateMachineTest
+
Osmo.MTP3LabelTest
Osmo.MTP3SLTAMSGTest
Osmo.MTP3SLTMMSGTest
@@ -66,6 +81,7 @@
isup/ISUPTests.st
ipa/IPATests.st
osmo/OsmoCtrlGrammarTest.st
+ m2ua/M2UATests.st
mtp3/MTP3MessagesTests.st