path: root/m2ua/M2UAApplicationServerProcess.st

"
 (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 <http://www.gnu.org/licenses/>.
"

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 |
    
    <category: 'OsmoNetwork-M2UA'>
    <comment: 'I am a M2UA Application Server Process.

I have an internal state machine and a state and will be used by the
M2UA Layer. I am written for the usage in a Media Gateway Controller
and will also keep information about the Application Server itself.

If I need to be used on a Signalling Gateway (SG) I will need a dedicated
M2UA Application Server class and state machine.

I can currently only manage a single interface. The specification allows
a single ASP to send one ASPActive for one interface at a time.'>

    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."

	<category: 'Primitives-LayerManagement'>
	error_block := aBlock
    ]

    onNotify: aBlock [
	"M-NOTIFY indication
	 Direction: M2UA -> LM
	 Purpose: ASP reports that it has received a NOTIFY message
	 from its peer."

	<category: 'Primitives-LayerManagement'>
	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."

	<category: 'Primitives-LayerManagement-SCTP'>
	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."

	<category: 'Primitives-LayerManagement-SCTP'>
	sctp_released_block := aBlock
    ]

    onSctpRestarted: aBlock [
	"M-SCTP_RELEASE indication
	 Direction: M2UA -> LM
	 Purpose: SGP informs LM that ASP has released an SCTP association."

	<category: 'Primitives-LayerManagement-SCTP'>
	sctp_restarted_block := aBlock
    ]

    onSctpStatus: aBlock [
	"M-SCTP_STATUS indication
	 Direction: M2UA -> LM
	 Purpose: M2UA reports status of SCTP association."

	<category: 'Primitives-LayerManagement-SCTP'>
	sctp_status_block := aBlock
    ]

    sctpEstablish [
	"M-SCTP_ESTABLISH request
	 Direction: LM -> M2UA
	 Purpose: LM requests ASP to establish an SCTP association with an SGP."

	<category: 'Primitives-LayerManagement-SCTP'>
	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."

	<category: 'Primitives-LayerManagement-SCTP'>
	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."

	<category: 'Primitives-LayerManagement-SCTP'>
	self notYetImplemented
    ]

    aspActive [
	<category: 'Primitives-LayerManagemennt-ASP'>
	"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 [
	<category: 'Primitives-LayerManagemennt-ASP'>
	"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 [
	<category: 'Primitives-LayerManagemennt-ASP'>
	"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 [
	<category: 'Primitives-LayerManagemennt-ASP'>
	"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."

	<category: 'Primitives-LayerManagemennt-ASP'>
	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."

	<category: 'Primitives-LayerManagemennt-ASP'>
	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."

	<category: 'Primitives-LayerManagemennt-ASP'>
	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."

	<category: 'Primitives-LayerManagemennt-ASP'>
	asp_up_block := aBlock
    ]

    onStateChange: aBlock [
	"A generic callback for all state changes"

	<category: 'Primitives-LayerManagemennt-ASP'>
	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."

	<category: 'Primitives-LayerManagement-LinkKey'>
	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."

	<category: 'Primitives-LayerManagement-LinkKey'>
	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."

	<category: 'Primitives-LayerManagement-LinkKey'>
	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."

	<category: 'Primitives-LayerManagement-LinkKey'>
	self notYetImplemented
    ]

    hostname: aHostname port: aPort [
	"Select the SCTP hostname/port for the SG to connect to"

	<category: 'configuration'>
	socket
	    hostname: aHostname;
	    port: aPort
    ]

    createAspIdentTag [
	<category: 'm2ua-tags'>
	^M2UATag initWith: M2UAConstants tagAspIdent data: #(1 2 3 4)
    ]

    createIdentIntTag [
	<category: 'm2ua-tags'>
	^M2UATag initWith: M2UAConstants tagIdentInt data: #(0 0 0 0)
    ]

    createInfoTag [
	<category: 'm2ua-tags'>
	^M2UATag initWith: M2UAConstants tagInfo
	    data: 'Hello from Smalltalk' asByteArray
    ]

    callNotification: aBlock [
	"Inform the generic method first, then all the others"

	<category: 'private'>
	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:"

	<category: 'private'>
	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 [
	<category: 'private'>
	| msg |
	msg := M2UAMSG parseToClass: aByteArray.
	msg dispatchOnAsp: self
    ]

    dispatchNotification: aBlock [
	<category: 'private'>
	aBlock value
    ]

    internalReset [
	<category: 'private'>
	self socketService: socket
    ]

    moveToState: newState [
	<category: 'private'>
	((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 [
	<category: 'private'>
	"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."

	<category: 'private'>
	self moveToState: M2UAAspStateDown.
	established = true ifFalse: [^self].
	sctp_released_block ifNotNil: [sctp_released_block value]
    ]

    send: aMsg [
	"Forget about what we did before"

	<category: 'private'>
	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 [
	<category: 'creation'>
	state := M2UAAspStateDown
    ]

    socketService: aService [
	<category: 'creation'>
	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 [
	<category: 'dispatch'>
	t_ack cancel.
	self moveToState: M2UAAspStateActive.
	self callNotification: asp_active_block
    ]

    handleAspDownAck: aMsg [
	<category: 'dispatch'>
	t_ack cancel.
	as_state := nil.
	self moveToState: M2UAAspStateDown.
	self callNotification: asp_down_block
    ]

    handleAspInactiveAck: aMsg [
	<category: 'dispatch'>
	t_ack cancel.
	as_state := nil.
	self moveToState: M2UAAspStateInactive.
	self callNotification: asp_inactive_block
    ]

    handleAspUpAck: aMsg [
	<category: 'dispatch'>
	t_ack cancel.
	self moveToState: M2UAAspStateInactive.
	self callNotification: asp_inactive_block
    ]

    handleError: aMsg [
	"Cancel pending operations.. because something went wrong"

	<category: 'dispatch'>
	t_ack cancel.
	error_block ifNotNil: [error_block value: aMsg]
    ]

    handleNotify: aMsg [
	<category: 'dispatch'>
	"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."

	<category: 'dispatch'>
	
    ]

    isASActive [
	<category: 'status'>
	^as_state = M2UAConstants ntfyStateASActive
    ]

    isASInactive [
	<category: 'status'>
	^as_state = M2UAConstants ntfyStateASInactive
    ]

    isASPending [
	<category: 'status'>
	^as_state = M2UAConstants ntfyStateASPending
    ]

    state [
	<category: 'accessing'>
	^state
    ]
]