diff --git a/codec/SMPPBodyBase.st b/codec/SMPPBodyBase.st index ea68753..ca564d1 100644 --- a/codec/SMPPBodyBase.st +++ b/codec/SMPPBodyBase.st @@ -175,8 +175,15 @@ sub-classes will provide the specific bodies.'> attribute isMandatory ifTrue: [self doParse: attribute stream: aStream]. attribute isOptional - ifTrue: [^self error: 'Optional attributes not implemented!']. - ] + ifTrue: [ + | tag | + tag := aStream peek. + tag = attribute tag ifTrue: [ + aStream next. + self doParse: attribute stream: aStream]]. + ]. + + aStream atEnd ifFalse: [^self error: 'Message not consume']. ] writeOn: aMsg [ diff --git a/codec/SMPPSubmitSM.st b/codec/SMPPSubmitSM.st new file mode 100644 index 0000000..3b078a2 --- /dev/null +++ b/codec/SMPPSubmitSM.st @@ -0,0 +1,109 @@ +" + (C) 2014 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 . +" + +SMPPBodyBase subclass: SMPPSubmitSM [ + | service_type source_addr_ton source_addr_npi source_addr + dest_addr_ton dest_addr_npi destination_addr esm_class + protocol_id priority_flag schedule_delivery_time + validity_period registered_delivery replace_if_present_flag + data_coding sm_default_msg_id short_message + user_message_reference source_port source_addr_subunit + destination_port dest_addr_subunit sar_msg_ref_num + sar_total_segments sar_segment_seqnum more_messages_to_send + payload_type message_payload privacy_indicator callback_num + callback_num_pres_ind callback_num_atag source_subaddress + dest_subaddress user_response_code display_time sms_signal + ms_validity ms_msg_wait_facilities number_of_messages + alert_on_msg_delivery language_indicator its_reply_type + its_session_info ussd_service_op | + + SMPPSubmitSM class >> messageType [ + ^self submitSM + ] + + SMPPSubmitSM class >> tlvDescription [ + ^OrderedCollection new + add: SMPPServiceType tlvDescription; + add: (SMPPAddressTypeOfNumber tlvDescription + instVarName: #source_addr_ton; yourself); + add: (SMPPAddressNumberingPlanIndicator tlvDescription + instVarName: #source_addr_npi; yourself); + add: (SMPPAddress tlvDescription + instVarName: #source_addr; yourself); + add: (SMPPAddressTypeOfNumber tlvDescription + instVarName: #dest_addr_ton; yourself); + add: (SMPPAddressNumberingPlanIndicator tlvDescription + instVarName: #dest_addr_npi; yourself); + add: (SMPPAddress tlvDescription + instVarName: #destination_addr; yourself); + add: SMPPESMClass tlvDescription; + add: SMPPProtocolId tlvDescription; + add: SMPPPriorityFlag tlvDescription; + add: SMPPScheduleDeliveryTime tlvDescription; + add: SMPPValidityPeriod tlvDescription; + add: SMPPRegisteredDelivery tlvDescription; + add: SMPPReplaceIfPresentFlag tlvDescription; + add: SMPPDataCoding tlvDescription; + add: SMPPDefaultMessageId tlvDescription; + add: SMPPShortMessage tlvDescription; + add: (SMPPValueHolder for: #user_message_reference tag: 16r0204); + add: (SMPPValueHolder for: #source_port tag: 16r020A); + add: (SMPPValueHolder for: #source_addr_subunit tag: 16r000D); + add: (SMPPValueHolder for: #destination_port tag: 16r020B); + add: (SMPPValueHolder for: #dest_addr_submit tag: 16r0005); + add: (SMPPValueHolder for: #sar_msg_ref_num tag: 16r020C); + add: (SMPPValueHolder for: #sar_total_segments tag: 16r020E); + add: (SMPPValueHolder for: #sar_segment_seqnum tag: 16r020F); + add: (SMPPValueHolder for: #more_messages_to_send tag: 16r0426 ); + add: (SMPPValueHolder for: #payload_type tag: 16r0019); + add: (SMPPValueHolder for: #message_payload tag: 16r0424); + add: (SMPPValueHolder for: #privacy_indicator tag: 16r0201); + add: (SMPPValueHolder for: #callback_num tag: 16r0381); + add: (SMPPValueHolder for: #callback_num_pres_ind tag: 16r0302); + add: (SMPPValueHolder for: #callback_num_atag tag: 16r0303); + add: (SMPPValueHolder for: #source_subaddress tag: 16r0202); + add: (SMPPValueHolder for: #dest_subaddress tag: 16r0203); + add: (SMPPValueHolder for: #user_response_code tag: 16r0205); + add: (SMPPValueHolder for: #display_time tag: 16r1201); + add: (SMPPValueHolder for: #sms_signal tag: 16r1203); + add: (SMPPValueHolder for: #ms_validity tag: 16r1204); + add: (SMPPValueHolder for: #ms_msg_wait_facilities tag: 16r0030); + add: (SMPPValueHolder for: #number_of_messages tag: 16r0304); + add: (SMPPValueHolder for: #alert_on_msg_delivery tag: 16r130C); + add: (SMPPValueHolder for: #language_indicator tag: 16r020D); + add: (SMPPValueHolder for: #its_reply_type tag: 16r1380); + add: (SMPPValueHolder for: #its_session_info tag: 16r1383); + add: (SMPPValueHolder for: #ussd_service_op tag: 16r0501); + yourself + ] + + sourceAddress [ + + ^source_addr + ] + + destinationAddress [ + + ^destination_addr + ] + + shortMessage [ + + ^short_message + ] +] diff --git a/codec/attributes/SMPPAddress.st b/codec/attributes/SMPPAddress.st new file mode 100644 index 0000000..ee7592d --- /dev/null +++ b/codec/attributes/SMPPAddress.st @@ -0,0 +1,28 @@ +" + (C) 2014 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 . +" + +SMPPOctetString subclass: SMPPAddress [ + + + SMPPAddress class >> tlvDescription [ + ^super tlvDescription + minSize: 0 maxSize: 20; + yourself + ] +] diff --git a/codec/attributes/SMPPDataCoding.st b/codec/attributes/SMPPDataCoding.st new file mode 100644 index 0000000..fb0d370 --- /dev/null +++ b/codec/attributes/SMPPDataCoding.st @@ -0,0 +1,28 @@ +" + (C) 2014 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 . +" + +SMPPInteger subclass: SMPPDataCoding [ + + + SMPPDataCoding class >> tlvDescription [ + ^super tlvDescription + valueSize: 1; + instVarName: #data_coding; + yourself + ] +] diff --git a/codec/attributes/SMPPDefaultMessageId.st b/codec/attributes/SMPPDefaultMessageId.st new file mode 100644 index 0000000..8f1cc81 --- /dev/null +++ b/codec/attributes/SMPPDefaultMessageId.st @@ -0,0 +1,28 @@ +" + (C) 2014 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 . +" + +SMPPInteger subclass: SMPPDefaultMessageId [ + + + SMPPDefaultMessageId class >> tlvDescription [ + ^super tlvDescription + valueSize: 1; + instVarName: #sm_default_msg_id; + yourself + ] +] diff --git a/codec/attributes/SMPPESMClass.st b/codec/attributes/SMPPESMClass.st new file mode 100644 index 0000000..f4e0326 --- /dev/null +++ b/codec/attributes/SMPPESMClass.st @@ -0,0 +1,110 @@ +" + (C) 2014 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 . +" + +SMPPInteger subclass: SMPPESMClass [ + + + SMPPESMClass class [ + modeBitMask [ + SMSC'> + ^2r11 + ] + + modeDefault [ + SMSC'> + ^2r00 + ] + + modeDatagram [ + SMSC'> + ^2r01 + ] + + modeForward [ + SMSC'> + ^2r10 + ] + + typeBitMask [ + SMSC'> + ^2r00111100 + ] + + typeDefault [ + + ^2r0 bitShift: 2 + ] + + typeSMSCDeliveryReceipt [ + ESME'> + ^2r1 bitShift: 2 + ] + + typeESMEDeliveryAck [ + SMSC'> + ^2r10 bitShift: 2 + ] + + typeESMEUserAck [ + SMSC'> + ^2r100 bitShift: 2 + ] + + typeConversationAbort [ + ESME'> + ^2r110 bitShift: 2 + ] + + typeIntermediateDeliveryNotification [ + ESME'> + ^2r1000 bitShift: 2 + ] + + gsmBitMask [ + + ^2r11000000 + ] + + gsmNoSpecific [ + + ^2r00000000 + ] + + gsmUDHIIndicator [ + + ^2r01000000 + ] + + gsmReplyPath [ + + ^2r10000000 + ] + + gsmUHDIAndReplyPath [ + + ^self gsmUDHIIndicator bitOr: self gsmReplyPath + ] + ] + + SMPPESMClass class >> tlvDescription [ + ^super tlvDescription + valueSize: 1; + instVarName: #esm_class; + yourself + ] +] diff --git a/codec/attributes/SMPPPriorityFlag.st b/codec/attributes/SMPPPriorityFlag.st new file mode 100644 index 0000000..217bdfc --- /dev/null +++ b/codec/attributes/SMPPPriorityFlag.st @@ -0,0 +1,29 @@ +" + (C) 2014 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 . +" + +SMPPInteger subclass: SMPPPriorityFlag [ + + + SMPPPriorityFlag class >> tlvDescription [ + ^super tlvDescription + valueSize: 1; + instVarName: #priority_flag; + yourself + ] +] diff --git a/codec/attributes/SMPPProtocolId.st b/codec/attributes/SMPPProtocolId.st new file mode 100644 index 0000000..7ebf7db --- /dev/null +++ b/codec/attributes/SMPPProtocolId.st @@ -0,0 +1,28 @@ +" + (C) 2014 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 . +" + +SMPPInteger subclass: SMPPProtocolId [ + + + SMPPProtocolId class >> tlvDescription [ + ^super tlvDescription + valueSize: 1; + instVarName: #protocol_id; + yourself + ] +] diff --git a/codec/attributes/SMPPRegisteredDelivery.st b/codec/attributes/SMPPRegisteredDelivery.st new file mode 100644 index 0000000..42be6e6 --- /dev/null +++ b/codec/attributes/SMPPRegisteredDelivery.st @@ -0,0 +1,28 @@ +" + (C) 2014 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 . +" + +SMPPInteger subclass: SMPPRegisteredDelivery [ + + + SMPPRegisteredDelivery class >> tlvDescription [ + ^super tlvDescription + valueSize: 1; + instVarName: #registered_delivery; + yourself + ] +] diff --git a/codec/attributes/SMPPReplaceIfPresentFlag.st b/codec/attributes/SMPPReplaceIfPresentFlag.st new file mode 100644 index 0000000..f475719 --- /dev/null +++ b/codec/attributes/SMPPReplaceIfPresentFlag.st @@ -0,0 +1,38 @@ +" + (C) 2014 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 . +" + +SMPPInteger subclass: SMPPReplaceIfPresentFlag [ + + + SMPPReplaceIfPresentFlag class [ + dontReplace [ + ^0 + ] + + replace [ + ^1 + ] + ] + + SMPPReplaceIfPresentFlag class >> tlvDescription [ + ^super tlvDescription + valueSize: 1; + instVarName: #replace_if_present_flag; + yourself + ] +] diff --git a/codec/attributes/SMPPScheduleDeliveryTime.st b/codec/attributes/SMPPScheduleDeliveryTime.st new file mode 100644 index 0000000..7d41bde --- /dev/null +++ b/codec/attributes/SMPPScheduleDeliveryTime.st @@ -0,0 +1,29 @@ +" + (C) 2014 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 . +" + +SMPPOctetString subclass: SMPPScheduleDeliveryTime [ + + + SMPPScheduleDeliveryTime class >> tlvDescription [ + "Empty string or 16 characters" + ^super tlvDescription + minSize: 0 maxSize: 16; + instVarName: #schedule_delivery_time; + yourself + ] +] diff --git a/codec/attributes/SMPPServiceType.st b/codec/attributes/SMPPServiceType.st new file mode 100644 index 0000000..37d03e3 --- /dev/null +++ b/codec/attributes/SMPPServiceType.st @@ -0,0 +1,65 @@ +" + (C) 2014 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 . +" + +SMPPOctetString subclass: SMPPServiceType [ + + + SMPPServiceType class [ + typeDefault [ + + ^'' + ] + + typeCellularMessaging [ + + ^'CMT' + ] + + typeCellularPaging [ + + ^'CPT' + ] + + typeVoiceMailNotification [ + + ^'VMN' + ] + + typeVoiceMailAlerting [ + + ^'VMA' + ] + + typeWirelessApplicationProtocol [ + + ^'WAP' + ] + + typeUSSD [ + + ^'USSD' + ] + ] + + SMPPServiceType class >> tlvDescription [ + ^super tlvDescription + instVarName: #service_type; + minSize: 0 maxSize: 5; + yourself + ] +] diff --git a/codec/attributes/SMPPShortMessage.st b/codec/attributes/SMPPShortMessage.st new file mode 100644 index 0000000..5925ee2 --- /dev/null +++ b/codec/attributes/SMPPShortMessage.st @@ -0,0 +1,42 @@ +" + (C) 2014 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: SMPPShortMessage [ + + + SMPPShortMessage class >> tlvDescription [ + ^Osmo.TLVDescription new + beLV; + instVarName: #short_message; + minSize: 0 maxSize: 254; + parseClass: self; + yourself + ] + + SMPPShortMessage class >> readFrom: aStream with: anAttribute [ + | len | + len := aStream next. + ^(aStream next: len) asString + ] + + SMPPShortMessage class >> write: aValue on: aMsg with: anAttribute [ + aMsg + putByte: aValue size; + putByteArray: aValue asByteArray. + ] +] diff --git a/codec/attributes/SMPPValidityPeriod.st b/codec/attributes/SMPPValidityPeriod.st new file mode 100644 index 0000000..ffbdd61 --- /dev/null +++ b/codec/attributes/SMPPValidityPeriod.st @@ -0,0 +1,29 @@ +" + (C) 2014 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 . +" + +SMPPOctetString subclass: SMPPValidityPeriod [ + + + SMPPValidityPeriod class >> tlvDescription [ + ^super tlvDescription + minSize: 0 maxSize: 16; + instVarName: #validity_period; + yourself + ] +] diff --git a/codec/attributes/SMPPValueHolder.st b/codec/attributes/SMPPValueHolder.st new file mode 100644 index 0000000..0c3c9de --- /dev/null +++ b/codec/attributes/SMPPValueHolder.st @@ -0,0 +1,43 @@ +" + (C) 2014 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: SMPPValueHolder [ + | tag value | + + + SMPPValueHolder class >> for: aString tag: aTag [ + ^Osmo.TLVDescription new + instVarName: aString; + tag: aTag; + beOptional; + beTLV; + yourself + ] + + SMPPValueHolder class >> readFrom: aStream with: anAttribute [ + | len | + len := aStream next. + ^(aStream next: len) + ] + + SMPPValueHolder class >> write: aValue on: aMsg with: anAttribute [ + aMsg + putByte: aValue size; + putByteArray: aValue asByteArray. + ] +] diff --git a/package.xml b/package.xml index f4635e7..0e6b51d 100644 --- a/package.xml +++ b/package.xml @@ -11,6 +11,7 @@ codec/SMPPEnquireLink.st codec/SMPPGenericNack.st codec/SMPPUnbind.st + codec/SMPPSubmitSM.st codec/attributes/SMPPOctetString.st codec/attributes/SMPPInteger.st @@ -21,6 +22,19 @@ codec/attributes/SMPPAddressTypeOfNumber.st codec/attributes/SMPPAddressNumberingPlanIndicator.st codec/attributes/SMPPAddressRange.st + codec/attributes/SMPPServiceType.st + codec/attributes/SMPPAddress.st + codec/attributes/SMPPESMClass.st + codec/attributes/SMPPProtocolId.st + codec/attributes/SMPPPriorityFlag.st + codec/attributes/SMPPScheduleDeliveryTime.st + codec/attributes/SMPPValidityPeriod.st + codec/attributes/SMPPRegisteredDelivery.st + codec/attributes/SMPPReplaceIfPresentFlag.st + codec/attributes/SMPPDataCoding.st + codec/attributes/SMPPDefaultMessageId.st + codec/attributes/SMPPValueHolder.st + codec/attributes/SMPPShortMessage.st codec/SMPPMessage.st diff --git a/test/SMPPMessageTest.st b/test/SMPPMessageTest.st index 08caac9..77a58fa 100644 --- a/test/SMPPMessageTest.st +++ b/test/SMPPMessageTest.st @@ -52,6 +52,22 @@ TestCase subclass: SMPPMessageTest [ 16r00 16r00 16r00 16r00 16r00 16r00 16r00 16r06] ] + exampleSubmitSM [ + ^#[16r00 16r00 16r00 16r61 16r00 16r00 16r00 16r04 + 16r00 16r00 16r00 16r00 16r00 16r00 16r00 16r04 + 16r00 16r01 16r01 16r39 16r32 16r32 16r35 16r30 + 16r30 16r31 16r00 16r01 16r01 16r34 16r30 16r30 + 16r39 16r39 16r39 16r31 16r36 16r00 16r02 16r00 + 16r00 16r00 16r00 16r00 16r00 16r00 16r00 16r31 + 16r44 16r69 16r65 16r73 16r20 16r69 16r73 16r74 + 16r20 16r65 16r69 16r6E 16r65 16r20 16r54 16r65 + 16r73 16r74 16r6E 16r61 16r63 16r68 16r72 16r69 + 16r63 16r68 16r74 16r21 16r20 16r20 16r32 16r30 + 16r31 16r34 16r2D 16r30 16r33 16r2D 16r30 16r31 + 16r5F 16r31 16r36 16r2E 16r34 16r30 16r2E 16r34 + 16r32] + ] + testReadMessage [ | msg | msg := SMPPMessage readFrom: self examplePdu readStream. @@ -112,4 +128,13 @@ TestCase subclass: SMPPMessageTest [ msg := SMPPMessage readFrom: self exampleUnbind readStream. self assert: msg body class equals: SMPPUnbind. ] + + testSubmitSM [ + | msg | + msg := SMPPMessage readFrom: self exampleSubmitSM readStream. + self assert: msg body class equals:SMPPSubmitSM. + self assert: msg body shortMessage equals: 'Dies ist eine Testnachricht! 2014-03-01_16.40.42'. + self assert: msg body sourceAddress equals: '9225001'. + self assert: msg body destinationAddress equals: '40099916'. + ] ]