osmo-st-network/ipa/IPAMsg.st

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

Object subclass: IPAMsgRequest [
    | data type |
    <category: 'OsmoNetwork-IPA'>
    <comment: 'I can parse the IPA messages and generate them'>


    IPAMsgRequest class >> parse: aStream [
        | type data |
        <category: 'parsing'>
        "TLV parser for the IPAMessage"

        type := aStream next.
        data := self parseTLV: aStream.

        ^ self new
            type: type;
            data: data;
            yourself.
    ]

    IPAMsgRequest class >> parseTLV: aStream [
        | data |
        <category: 'parsing'>
        data := OrderedCollection new.

        [aStream atEnd] whileFalse: [
            | len tag msg |
            len := aStream next.
            tag := aStream next.

            "On requests the length counts the tag"
            msg := len > 1
                      ifTrue:  [aStream next: len]
                      ifFalse: [nil].

            data add: (Association key: tag value: msg)
        ].

        ^ data
    ]

    type: aType [
        <category: 'data'>
        type := aType.
    ]

    data: aData [
        <category: 'data'>
        data := aData.
    ]

    tags [
        <category: 'accessing'>
        ^ data collect: [:each | each key].
    ]

    hasTag: aTag [
        <category: 'accessing'>
        ^ self tags includes: aTag
    ]

    dataForTag: aTag [
        <category: 'accessing'>
        data do: [:each | each key = aTag ifTrue: [^each value]].

        ^ SystemExceptions.NotFound
              signalOn: self what: 'Tag ', aTag asString, ' not found'.
    ]

    writeOn: aMsg [
        <category: 'serialize'>
        aMsg putByte: type.

        self writeTLV: aMsg.
    ]

    writeTLV: aMsg [
        <category: 'serialize'>

        data do: [:each |
            "Write the length and tag"
            aMsg
              putByte: 1 + each value basicSize;
              putByte: each key.

            "Write the optional value"
            each value isNil ifFalse: [
                aMsg putByteArray: each value.].
        ].
    ]
]

IPAMsgRequest subclass: IPAMsgResponse [
    <category: 'OsmoNetwork-IPA'>
    <comment: 'I can handle messages with a two byte size after the
    type and then followed by the usual TV'>


    IPAMsgResponse class >> parse: aStream [
        | type data |
        <category: 'parsing'>
        "TLV parser for the IPAMessage"

        type := aStream next.
        aStream skip: 1.
        data := self parseTLV: aStream.

        ^ self new
            type: type;
            data: data;
            yourself.
    ]

    IPAMsgResponse class >> readByteString: aStream length: aLen [
        "Read a IPA string from a stream that might be up to len."
        | str |
        str := WriteStream on: (ByteArray new: aLen).

        (1 to: aLen) do: [:each |
            | chr |

            chr := aStream next.
            str nextPut: chr.

            "deal with broken messages. so far only observed at the end
            of a packet"
            (aStream atEnd and: [chr = 16r0])
                ifTrue: [^ str contents].
        ].

        ^ str contents.
    ]

    IPAMsgResponse class >> parseTLV: aStream [
        | data |
        "The messages generated by the ip.access nanoBTS do not follow
        the TLV pattern properly. For responses the length does not include
        the size of the tag and to make it worse sometimes the wrong size
        is sent, e.g. there strings are null-terminated."

        data := OrderedCollection new.

        [aStream atEnd] whileFalse: [
            | tag len string |
            len := aStream next.
            tag := aStream next.
            string := self readByteString: aStream length: len.

            data add: (Association key: tag value: string).
        ].

        ^ data
    ]

    writeOn: aMsg [
        <category: 'serialize'>

        aMsg putByte: type.
        aMsg putByte: 0.
        self writeTLV: aMsg. 
    ]

    writeTLV: aMsg [
        <category: 'serialize'>
        "Request/Response appear to have different size constraints"

        data do: [:each |
            "Write the length and tag"
            aMsg
              putByte: each value basicSize;
              putByte: each key;
              putByteArray: each value.
        ].
    ]
]