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

"This is a fake base station used for injecting RSL/DTAP messages and
simulating failure condition..."

PackageLoader fileInPackage: #OsmoGSM.

RSLBCCHInformation extend [
    trxDispatchOn: aTrx [
        <category: '*-BTS-Core'>
        "nothing todo"
    ]
]

RSLSACCHFilling extend [
    trxDispatchOn: aTrx [
        <category: '*-BTS-Core'>
        "nothing todo"
    ]
]

RSLMessageBase extend [
    trxChannelDispatch: aTrx [
        | ts lchan |
        <category: '*-BTS-Core'>
        "Generic channel based dispatch."
        ts := aTrx channel: self channelNumber timeslotNumber + 1.
        lchan := ts lchan: self channelNumber subslotNumber + 1.
        self trxDispatchOn: aTrx with: lchan.
    ]
]

RSLDedicatedChannelManagement extend [
    trxDispatchOn: aTrx [
        <category: '*-BTS-Core'>
        self trxChannelDispatch: aTrx.
    ]
]

RSLChannelActivation extend [
    trxAllocateChan: aTrx lchan: aChan [
        | ack |
        <category: '*-BTS-Core'>

        Transcript nextPutAll: 'Allocated channel'; nl.

        ack := RSLChannelActivationAck new
                channelNumber: self channelNumber;
                frameNumber: #(23 42) asRSLAttributeData;
                yourself.
        aTrx mainBts sendRSLActivationAck: ack toMessage on: aTrx.
    ]

    trxNackChan: aTrx lchan: aLchan [
        <category: '*-BTS-Core'>
        ^ self notYetImplemented
    ]

    trxDispatchOn: aTrx with: lchan [
        <category: '*-BTS-Core'>
        "Find the channel and activate it."
        Transcript
            nextPutAll: 'Channel Activation: ';
	    nextPutAll: self channelNumber subslotNumber asString; nl.

        "Allocate..."
        lchan allocate
            ifTrue:  [self trxAllocateChan: aTrx lchan: lchan]
            ifFalse: [self trxNackChan: aTrx lchan: lchan].
    ]
]

RSLRFChannelRelease extend [
    trxDispatchOn: aTrx with: lchan [
        <category: '*-BTS-Core'>
        lchan releaseRequested.
    ]
]

RSLImmediateAssignment extend [
    trxDispatchOn: aTrx [
        | gsm ts lchan chan_nr |
        <category: '*-BTS-Core'>
        self channelNumber isPchAgch
            ifFalse: [^self error: 'Can only handle assignment on PCH/AGCH'].

        "Skip the L2 Pseudo length"
        gsm := OsmoGSM.GSM48MSG decode:
                  (self fullL3Info readStream skip: 1; yourself).

        "Convert the GSM 04.08 10.5.2.5 Channel Description to a RSL
        Channel number. Do it by copying the first byte. This makes no
        differentation between channel or packet description right now"
        chan_nr := RSLChannelNumber new
                    data: (ByteArray with: gsm channelOrPacketDescription data first).

        "Find the lchan now."
        ts := aTrx channel: chan_nr timeslotNumber + 1.
        lchan := ts lchan: chan_nr subslotNumber + 1.

        "Check that the is allocated."
        lchan isFree ifTrue: [^self error: 'The lchan should be allocated.'].

        aTrx mainBts channelAssigned: lchan ra: gsm requestReference ra.
    ]
]

RSLDataRequest extend [
    trxDispatchOn: aTrx with: lchan [
        <category: '*-BTS-Core'>
        lchan 
          dataRequest: self l3Information data
          sapi: (self linkIdentifier data first bitAnd: 2r111).
    ]

    trxDispatchOn: aTrx [
        <category: '*-BTS-Core'>
        self trxChannelDispatch: aTrx.
    ]
]

RSLSacchDeactivate extend [
    trxDispatchOn: aTrx with: lchan [
        <category: '*-BTS-Core'>
        lchan 
          dataRequest: self l3Information data
          sapi: (self linkIdentifier data first bitAnd: 2r111).
    ]

    trxDispatchOn: aTrx [
        <category: '*-BTS-Core'>
        Transcript nextPutAll: 'Deactivating SACCH. Not doing anything'; nl.
    ]
]

RSLEncryptionCommand extend [
    trxDispatchOn: aTrx with: lchan [
        <category: '*-BTS-Core'>
        lchan
          dataRequest: self l3Information data
          sapi: (self linkIdentifier data first bitAnd: 2r111).
    ]

    trxDispatchOn: aTrx [
        <category: '*-BTS-Core'>
        self trxChannelDispatch: aTrx.
    ]
]

RSLModeModifyRequest extend [
    trxDispatchOn: aTrx with: lchan [
	| ack |
        <category: '*-BTS-Core'>

	ack := RSLModeModifyAck new
		channelNumber: self channelNumber;
		yourself.
        aTrx mainBts sendRSL: ack toMessage on: aTrx.
    ]

    trxDispatchOn: aTrx [
	<category: '*-BTS-Core'>
	self trxChannelDispatch: aTrx.
    ]
]

RSLReleaseRequest extend [
    trxDispatchOn: aTrx with: lchan [
        <category: '*-BTS-Core'>
        lchan releaseSapiRequest: self linkIdentifier data first.
    ]

    trxDispatchOn: aTrx [
        <category: '*-BTS-Core'>
        "A sapi has been released."
        self trxChannelDispatch: aTrx.
    ]
]

RSLIPACreateConnection extend [
    trxDispatchOn: aTrx with: lchan [
	| ack |
        <category: '*-BTS-Core'>
	lchan ipaConnId: aTrx mainBts newConnectionIdentifier asRSLAttributeData.
	ack := RSLIPACreateConnectionAck new
		channelNumber: lchan channelNumber;
		connectionIdentifier: lchan ipaConnId;
		localPort: #(23 42) asRSLAttributeData;
		localIP: #(0 0 0 0) asRSLAttributeData;
		yourself.

        aTrx mainBts sendRSL: ack toMessage on: aTrx.
    ]

    trxDispatchOn: aTrx [
        <category: '*-BTS-Core'>
        "A sapi has been released."
        self trxChannelDispatch: aTrx.
    ]
]

RSLIPAModifyConnection extend [
    trxDispatchOn: aTrx with: lchan [
	| ack |
        <category: '*-BTS-Core'>
	ack := RSLIPAModifyConnectionAck new
		channelNumber: lchan channelNumber;
		connectionIdentifier: lchan ipaConnId;
		yourself.

        aTrx mainBts sendRSL: ack toMessage on: aTrx.
    ]

    trxDispatchOn: aTrx [
        <category: '*-BTS-Core'>
        "A sapi has been released."
        self trxChannelDispatch: aTrx.
    ]
]

RSLPagingCommand extend [
    trxDispatchOn: aTrx [
	<category: '*-BTS-Core'>
	aTrx mainBts paging: self msIdenity.
    ]
]

Object subclass: BTS [
    | site_mgr oml rsl oml_queue oml_init connected oml_up ras ras_mutex
      bts_id on_paging last_conn_id |
    <category: 'BTS-Core'>
    <comment: 'A fake BTS to test the state machine and inject
    RSL messages to test a network without RF.'>

    BTS class >> omlInitClass [
        ^ OMLBTSInit
    ]

    BTS class >> channelWaitDelay [
        ^2
    ]

    connect: anAddress [
        <category: 'connect'>
        self stop.

        rsl := nil.
	last_conn_id := 0.
        oml := BTSOmlConnection new
            onData: [:each | self handleOml: each];
            onStop: [self omlStopped];
            onConnect: [self omlConnected];
            btsId: bts_id;
            yourself. 

        "Make sure oml is fully assigned"
        oml_up := Semaphore new.
        oml_queue := SharedQueue new.
        ras := OrderedCollection new.
        ras_mutex := Semaphore forMutualExclusion.
        oml connect: anAddress
    ]

    siteManager [
        <category: 'control'>
        ^ site_mgr
    ]

    trx [
        <category: 'control'>
        ^ site_mgr bts basebandTransceiver
    ]

    omlStopped [
        <category: 'control'>
        Transcript nextPutAll: 'OML Connection gone.'; nl.
    ]

    omlConnected [
        <category: 'control'>
        Transcript nextPutAll: 'OML Connected'; nl.

        "Create a new SiteManager and forward OML data."
        site_mgr := SiteManagerOML new
              onData: [:each | self sendOML: each];
              yourself.

        "Forward all RSL data from the TRX."
        site_mgr bts basebandTransceiver
              onData: [:each | self sendOnPrimaryRSL: each];
              mainBts: self.

        "Start the OML init now in a new thread"
        oml_init := self class omlInitClass initWith: self.
        [[oml_init run ] ensure: [Transcript nextPutAll: 'OML-Init exited'; nl]] fork.
    ]

    omlUp [
        <category: 'oml'>
        oml_up signal.
    ]

    omlBcchArfcn [
        ^ site_mgr bts bcchArfcn.
    ]

    findAllocatedLchanOn: aTrx with: aChannelDescription [
        | lchan |
        "We have the TRX and now need to find the right channel and then the lchan"

        aChannelDescription channelType = 1
            ifFalse: [^self error: 'Only channel type TCH/F... supported'].
        lchan := (aTrx channel: (aChannelDescription timeSlot + 1)) lchan: 1.
        lchan isFree ifTrue: [^self error: 'Should have been allocated by the BSC.'].
        ^ lchan
    ]

    findAllocatedLchan: aChannelDescription [
        "Find the given the channel. First find the TRX and then the channel"
	Transcript
            nextPutAll: 'ARFCN: '; nextPutAll: aChannelDescription arfcn printString;
            nextPutAll: ' Type: '; nextPutAll: aChannelDescription channelType printString;
            nextPutAll: ' TS: '  ; nextPutAll: aChannelDescription timeSlot printString;
            nl;
            yourself.

        1 to: site_mgr bts availableTrx do: [:nr |
            | rc trx |
            rc := site_mgr bts radioCarrier: nr.
            trx := site_mgr bts basebandTransceiver: nr.
            (rc arfcnList includes: aChannelDescription arfcn)
                ifTrue: [^self findAllocatedLchanOn: trx with: aChannelDescription].
        ].

        ^ self error: 'Failed to find the lchan'
    ]

    stop [
        <category: 'control'>
        Transcript nextPutAll: 'Stop'; nl.

        rsl isNil ifFalse: [rsl stop. rsl := nil].
        oml isNil ifFalse: [oml stop. oml := nil].
        oml_init isNil ifFalse: [oml_queue nextPut: nil. oml_init := nil].
    ]

    sendOML: aMsg [
        <category: 'oml'>
        oml send: aMsg.
    ]

    waitForOMLMsg [
        <category: 'oml'>
        "TODO: do something funny with continuations"
        ^ oml_queue next
    ]

    handleOml: aMsg [
        <category: 'oml'>
        [
            | oml |
            oml := OMLMessageBase parse: aMsg asByteArray readStream.
            oml_queue nextPut: oml.
        ] on: Exception do: [:e |
            Transcript nextPutAll: 'OML Parsing failed with'; nl.
            e inspect.
            Transcript
                  nextPutAll: 'With data: ';
                  nextPutAll: aMsg asByteArray printString;
                  nl.
        ]
    ]

    waitForBTSReady [
        <category: 'oml'>
        oml_up wait.
        oml_up wait.

        "Wait for OML queue to be empty. TODO: get a cb when last message
        was processed."
        [oml txQueueIsEmpty] whileFalse: [(Delay forMilliseconds: 500) wait].
    ]

    startRSL: aPort streamId: anId on: aTrx [
        <category: 'rsl'>

        rsl isNil ifFalse: [rsl stop].
        rsl := BTSRslConnection new
            onData: [:each | self handleRsl: each on: aTrx];
            onStop: [self rslStopped: rsl];
            onConnect: [self rslConnected: rsl];
            btsId: bts_id;
            streamId: anId;
            yourself.

        rsl connect: oml address port: aPort.
    ]

    btsId: aId [
        <category: 'bts'>
        bts_id := aId.
    ]

    handleRsl: aMsg on: aTrx [
        | rsl |
        <category: 'rsl'>

        [
            | rsl |
            rsl := RSLMessageBase parse: aMsg asByteArray readStream.
            rsl trxDispatchOn: aTrx.
        ] on: Exception do: [:e |
            Transcript nextPutAll: 'RSL Parsing failed with'; nl.
            e inspect.
            Transcript
                  nextPutAll: 'With data: ';
                  nextPutAll: aMsg asByteArray printString;
                  nl.
        ]
    ]

    rslStopped: anInput [
        <category: 'rsl'>
        Transcript nextPutAll: 'RSL Stopped'; nl.
    ]

    rslConnected: anInput [
        <category: 'rsl'>
        Transcript nextPutAll: 'RSL Connected'; nl.
        "Send anything so rsl will be initialized."
        anInput send: #(1 2 3 4 5).
        oml_up signal.
    ]

    sendOnPrimaryRSL: aMsg [
        <category: 'rsl'>
        rsl send: aMsg.
    ]

    sendRSL: aMsg on: aTrx [
        <category: 'rsl'>
        self sendOnPrimaryRSL: aMsg.
    ]

    sendRSLActivationAck: aMsg on: aTrx [
        self sendRSL: aMsg on: aTrx
    ]

    findRequestee: aRa [
        <category: 'lchan'>

        ras_mutex critical: [
            ras do: [:each |
                each key = aRa
                  ifTrue: [^each]]].
        ^ self error: 'Failed to find RA: ', aRa displayString.
    ]

    channelAssigned: aLchan ra: aRa [
        | requestee |
        <category: 'lchan'>

        "Find and remove the requestee"
        requestee := self findRequestee: aRa.
        ras_mutex critical: [
            ras identityRemove: requestee.
        ].

        "Inform about the new channel"
        requestee value value: aLchan.
    ]

    waitForChannel: aMsg with: ra [
        | sem out_chan entry |
        sem := Semaphore new.

        "Insert the callback"
        entry := ra -> [:lchan | out_chan := lchan. sem signal].
        ras_mutex critical: [
            ras add: entry.
        ].

        "Send the request"
        self sendOnPrimaryRSL: aMsg.

        "Wait for a result and just return the out_chan, remove the entry"
        (Delay forSeconds: self class channelWaitDelay) timedWaitOn: sem.
        ras_mutex critical: [ras identityRemove: entry ifAbsent: []].
        ^ out_chan
    ]

    paging: aPaging [
	on_paging ifNotNil: [on_paging value: aPaging]
    ]

    onPaging: aCallback [
	on_paging := aCallback
    ]

    newConnectionIdentifier [
	last_conn_id := last_conn_id + 1.
	^ ByteArray
	    with: ((last_conn_id bitShift: -8) bitAnd: 16rFF)
	    with: (last_conn_id bitAnd: 16rFF)
    ]
]