1
0
Fork 0

oml: Continue with the init sequence of the BTS init, create acks

This commit is contained in:
Holger Hans Peter Freyther 2012-08-10 14:16:56 +02:00
parent bcde37bce0
commit 3cda1acc92
4 changed files with 122 additions and 3 deletions

View File

@ -232,6 +232,28 @@ OMLManagerBase subclass: SiteManagerOML [
swLoaded := true.
]
softwareActivated [
| op_state av_state |
(swActivated or: [swLoaded])
ifFalse: [^self error: 'SW not ready'].
"Report the software being activated"
self forwardData: self createSwActivatedReport toMessage.
"Update the state"
op_state := self operationalState.
op_state state: OMLOperationalState disabled.
av_state := self availabilityStatus.
av_state state: OMLAvailabilityStatus offline.
self sendStateChanged.
]
activateSoftware: aSWDescription [
<category: 'load'>
swActivated := true.
]
siteManager [
<category: 'accessing'>
^ self

View File

@ -46,18 +46,36 @@ Object subclass: OMLBTSInit [
]
run [
| msg |
| msg ack |
"1. Initialize the SM"
sm start.
"2. Activate the software"
"2. Load the software"
msg := bts waitForOMLMsg.
msg class = FOMMessage
ifFalse: [self error: 'Failed to get a Formatted O&M message'].
msg omDataField class = OMLSWActivateRequestAck
ifFalse: [self error: 'Failed to get the SW Activate Request ACK'].
Transcript nextPutAll: 'We were asked to activate something'; nl.
(Delay forSeconds: 1) wait.
sm loadSoftware: msg omDataField swConfiguration.
"3. Activate the software. The stateChanged triggered and activated
report are not the same as with the nanoBTS."
msg := bts waitForOMLMsg.
msg class = FOMMessage
ifFalse: [self error: 'Failed to get a Formatted O&M message'].
msg omDataField class = OMLActivateSoftware
ifFalse: [self error: 'Failed to get the SW Activate Request ACK'].
sm activateSoftware: msg omDataField swDescription.
ack := msg createAck.
self forwardOML: ack toMessage.
"4. The SM has booted up, ask to activate the software"
sm softwareActivated.
self forwardOML: sm bts createSwActivateRequest toMessage.
"5. OpStart or activate requests.."
msg := bts waitForOMLMsg.
msg inspect.
]
]

View File

@ -557,6 +557,11 @@ Object subclass: OMLMessageBase [
^ 16r0B
]
msgSWActivatedReport [
<category: 'message-type'>
^ 16r10
]
msgActivateSoftware [
<category: 'message-type'>
^ 16r0D
@ -645,6 +650,14 @@ OMLMessageBase subclass: FOMMessage [
putByte: msg size;
putByteArray: msg.
]
createAck [
<category: 'acking'>
"Try to create an ACK"
^ self class new
omDataField: om_field createAck;
yourself
]
]
Object subclass: OMLDataField [
@ -714,6 +727,16 @@ Object subclass: OMLDataField [
object_instance := anInstance
]
objectClass [
<category: 'parsing'>
^ object_class
]
objectInstance [
<category: 'parsing'>
^ object_instance
]
writeOn: aMsg [
<category: 'serialize'>
@ -848,7 +871,52 @@ OMLDataField subclass: OMLActivateSoftware [
<category: 'parsing'>
^ OrderedCollection new
add: (OMLSWDescription asTLVDescription
beOptional;
instVarName: #sw_desc; yourself);
yourself
]
createAck [
<category: 'acking'>
^ OMLActivateSoftwareAck new
objectClass: self objectClass;
objectInstance: self objectInstance;
swDescription: self swDescription;
yourself
]
swDescription [
<category: 'accessing'>
^ sw_desc
]
swDescription: aDesc [
<category: 'accessing'>
sw_desc := aDesc
]
]
OMLActivateSoftware subclass: OMLActivateSoftwareAck [
<category: 'BTS-OML'>
<comment: 'I construct a GSM 12.21 O&M Data field as of 8.3.6'>
OMLActivateSoftwareAck class >> attributeType [
<category: 'parsing'>
^ FOMMessage msgActivateSoftwareAck
]
]
OMLDataField subclass: OMLSWActivatedReport [
<category: 'BTS-OML'>
<comment: 'I construct a GSM 12.21 O&M Data field as of 8.3.7'>
OMLSWActivatedReport class >> attributeType [
<category: 'parsing'>
^ FOMMessage msgSWActivatedReport
]
OMLSWActivatedReport class >> tlvDescription [
<category: 'parsing'>
^ #()
]
]

View File

@ -140,6 +140,10 @@ TestCase subclass: OMLMsgTest [
^ #(128 128 0 18 13 0 255 255 255 66 18 0 3 1 2 3 19 0 3 3 4 5)
]
activationRequestDataAck [
^ #(128 128 0 18 14 0 255 255 255 66 18 0 3 1 2 3 19 0 3 3 4 5)
]
testFomMessage [
| oml |
@ -192,6 +196,13 @@ TestCase subclass: OMLMsgTest [
data := oml toMessage asByteArray.
self assert: self activationRequestData asByteArray = data
]
testActivationRequest [
| oml nack |
oml := OMLMessageBase parse: self activationRequestData readStream.
nack := oml createAck.
self assert: nack toMessage asByteArray = self activationRequestDataAck asByteArray.
]
]
TestCase subclass: TLVDescriptionTest [