1# Net::SMPP.pm - SMPP over TCP, pure perl implementation 2# Copyright (c) 2001-2011 Sampo Kellomaki <sampo@iki.fi>, All rights reserved. 3# Portions Copyright (c) 2001-2005 Symlabs, All rights reserved. 4# This code may be distributed under same terms as perl. NO WARRANTY. 5# Work sponsored by Symlabs, the LDAP and directory experts (www.symlabs.com) 6# 12.3.2001, Sampo Kellomaki <sampo@symlabs.com> 7# 7.7.2001, added SMPP 4.0 support --Sampo #4 8# 9.7.2001, continued 4.0 hacking --Sampo #4 9# 11.7.2001, added J-Phone specific extended options --Sampo #4 10# 12.7.2001, fixed eating options off @_ --Sampo 11# 1.8.2001, merged in fixes from Felix Gaehtgens <felix@symlabs.com>, bumped 12# version to 0.90 to reflect successfully conducted tests --Sampo 13# 25.9.2001, tagged all 4.0 specifics so that 3.4-only version can be #4 14# extracted for public distribution --Sampo #4 15# 11.12.2001, fixed encode_deliver_v4 to encode_deliver_sm_v4, bug reported 16# by Cristina Del Amo (Cristina.delAmo@vodafone-us.com), --Sampo 17# 4.1.2002, Fixed enquiry_link to enquire_link --Sampo 18# 10.1.2002, applied big patch by Lars Thegler <lars@@thegler_.dk> to 19# make pack and unpack templates perl5.005_03 compatible. --Sampo 20# Caught bugs in decode_outbind_v34(), encode_query_sm(), 21# encode_query_sm_resp() and replace_sm() --Sampo 22# 11.1.2002, 7bit pack and unpack --Sampo 23# 3.4.2002, command length check from Cris, rolled out 1.01 --Sampo 24# 7.12.2002, applied some patched by Luis Munoz <lem@@cantv.net> --Sampo 25# 8.12.2002, more patched from Luis, --Sampo 26# 23.9.2004, applied bind ip patch from Igor Ivoilov <igor@_francoudi.com> --Sampo 27# 29.4.2005, applied patch from Kristian Nielsen <kn_@@sifira..dk> --Sampo 28# 21.4.2006, applied sysread patch from Dziugas.Baltrunas@bite..lt. Similar 29# patch was also proposed by Felix Gaehtgens <felix@symlabs..com> --Sampo 30# 20.7.2007, patch from Matthias Meyser to fix enquiry_link, document 7bit (1.11) --Sampo 31# 14.12.2008, adapted to SMPPv50, thanks to Gema niskazhu (and curse to 32# the spec authors for not letting me know about new version) --Sampo 33# 24.6.2010, tweaked for perl 5.8.8 --Sampo 34# 29.5.2011, improved signal handling in read_hard(), patch from Clemens Dorner --Sampo 35# 36# Why ${*$me}{async} vs. $me->async ? 37# 38# $Id: SMPP.pm,v 1.31 2008-12-02 16:41:30 sampo Exp $ 39 40### The comments often refer to sections of the following document 41### Short Message Peer to Peer Protocol Specification v3.4, 42### 12-Oct-1999, Issue 1.2 (from www.smpp.org) 43### 44### Reference document for version 4.0 support was #4 45### Short Message Peer to Peer (SMPP) V4 Protocol Specification, #4 46### 29-Apr-1997, Version 1.1 (from Aldiscon/Logica) #4 47 48package Net::SMPP; 49 50require 5.008; 51use strict; 52use Socket; 53use Symbol; 54use Carp; 55use IO::Socket; 56use Data::Dumper; # for debugging 57 58use vars qw(@ISA $VERSION %default %param_by_name $trace); 59@ISA = qw(IO::Socket::INET); 60$VERSION = '1.19'; 61$trace = 0; 62 63use constant Transmitter => 1; # SMPP transmitter mode of operation 64use constant Receiver => 2; # receiver mode of operation 65use constant Transceiver => 3; # both 66 67### command_status code (Error Codes) from sec 5.1.3, table 5-2, pp.112-114 68 69use constant status_code => { 70 0x00000000 => { code => 'ESME_ROK', msg => 'No error', }, 71 0x00000001 => { code => 'ESME_RINVMSGLEN', msg => 'Message Length is invalid', }, 72 0x00000002 => { code => 'ESME_RINVCMDLEN', msg => 'Command Length is invalid', }, 73 0x00000003 => { code => 'ESME_RINVCMDID', msg => 'Invalid Command ID', }, 74 0x00000004 => { code => 'ESME_RINVBNDSTS', msg => 'Incorrect BIND Status for given command', }, 75 0x00000005 => { code => 'ESME_RALYBND', msg => 'ESME Already in bound state', }, 76 0x00000006 => { code => 'ESME_RINVPRTFLG', msg => 'Invalid priority flag', }, 77 0x00000007 => { code => 'ESME_RINVREGDLVFLG', msg => 'Invalid registered delivery flag', }, 78 0x00000008 => { code => 'ESME_RSYSERR', msg => 'System Error', }, 79# 0x00000009 => { code => 'ESME_', msg => '', }, 80 0x0000000a => { code => 'ESME_RINVSRCADR', msg => 'Invalid source address', }, 81 0x0000000b => { code => 'ESME_RINVDSTADR', msg => 'Invalid destination address', }, 82 0x0000000c => { code => 'ESME_RINVMSGID', msg => 'Message ID is invalid', }, 83 0x0000000d => { code => 'ESME_RBINDFAIL', msg => 'Bind failed', }, 84 0x0000000e => { code => 'ESME_RINVPASWD', msg => 'Invalid password', }, 85 0x0000000f => { code => 'ESME_RINVSYSID', msg => 'Invalid System ID', }, 86# 0x00000010 => { code => 'ESME_', msg => '', }, 87 0x00000011 => { code => 'ESME_RCANCELFAIL', msg => 'Cancel SM Failed', }, 88# 0x00000012 => { code => 'ESME_', msg => '', }, 89 0x00000013 => { code => 'ESME_RREPLACEFAIL', msg => 'Replace SM Failed', }, 90 0x00000014 => { code => 'ESME_RMSGQFUL', msg => 'Message queue full', }, 91 0x00000015 => { code => 'ESME_RINVSERTYP', msg => 'Invalid service type', }, 92# 0x00000016 - 0x00000032 reserved 93 0x00000033 => { code => 'ESME_RINVNUMDESTS', msg => 'Invalid number of destinations', }, 94 0x00000034 => { code => 'ESME_RINVDLNAME', msg => 'Invalid distribution list name', }, 95# 0x00000035 - 0x0000003f reserved 96 0x00000040 => { code => 'ESME_RINVDESTFLAG', msg => 'Destination flag is invalid (submit_multi)', }, 97# 0x00000041 => { code => 'ESME_', msg => '', }, 98 0x00000042 => { code => 'ESME_RINVSUBREP', msg => "Invalid `submit with replace' request (i.e. submit_sm with replace_if_present_flag set)", }, 99 0x00000043 => { code => 'ESME_RINVESMCLASS', msg => 'Invalid esm_class field data', }, 100 0x00000044 => { code => 'ESME_RCNTSUBDL', msg => 'Cannot submit to distribution list', }, 101 0x00000045 => { code => 'ESME_RSUBMITFAIL', msg => 'submit_sm or submit_multi failed', }, 102# 0x00000046 => { code => 'ESME_', msg => '', }, 103# 0x00000047 => { code => 'ESME_', msg => '', }, 104 0x00000048 => { code => 'ESME_RINVSRCTON', msg => 'Invalid source address TON', }, 105 0x00000049 => { code => 'ESME_RINVSRCNPI', msg => 'Invalid source address NPI', }, 106# 0x0000004a - 0x0000004f undocumented 107 0x00000050 => { code => 'ESME_RINVDSTTON', msg => 'Invalid destination address TON', }, 108 0x00000051 => { code => 'ESME_RINVDSTNPI', msg => 'Invalid destination address NPI', }, 109# 0x00000052 => { code => 'ESME_', msg => '', }, 110 0x00000053 => { code => 'ESME_RINVSYSTYP', msg => 'Invalid system_type field', }, 111 0x00000054 => { code => 'ESME_RINVREPFLAG', msg => 'Invalid replace_if_present flag', }, 112 0x00000055 => { code => 'ESME_RINVNUMMSGS', msg => 'Invalid number of messages', }, 113# 0x00000056 => { code => 'ESME_', msg => '', }, 114# 0x00000057 => { code => 'ESME_', msg => '', }, 115 0x00000058 => { code => 'ESME_RTHROTTLED', msg => 'Throttling error (ESME has exceeded allowed message limits)', }, 116# 0x00000059 - 0x00000060 reserved 117 0x00000061 => { code => 'ESME_RINVSCHED', msg => 'Invalid scheduled delivery time', }, 118 0x00000062 => { code => 'ESME_RINVEXPIRY', msg => 'Invalid message validity period (expiry time)', }, 119 0x00000063 => { code => 'ESME_RINVDFTMSGID', msg => 'Predefined message invalid or not found', }, 120 0x00000064 => { code => 'ESME_RX_T_APPN', msg => 'ESME Receiver Temporary App Error Code', }, 121 0x00000065 => { code => 'ESME_RX_P_APPN', msg => 'ESME Receiver Permanent App Error Code', }, 122 0x00000066 => { code => 'ESME_RX_R_APPN', msg => 'ESME Receiver Reject Message Error Code', }, 123 0x00000067 => { code => 'ESME_RQUERYFAIL', msg => 'query_sm request failed', }, 124# 0x00000068 - 0x000000bf reserved 125 0x000000c0 => { code => 'ESME_RINVOPTPARSTREAM', msg => 'Error in the optional part of the PDU Body', }, 126 0x000000c1 => { code => 'ESME_ROPTPARNOTALLWD', msg => 'Optional paramenter not allowed', }, 127 0x000000c2 => { code => 'ESME_RINVPARLEN', msg => 'Invalid parameter length', }, 128 0x000000c3 => { code => 'ESME_RMISSINGOPTPARAM', msg => 'Expected optional parameter missing', }, 129 0x000000c4 => { code => 'ESME_RINVOPTPARAMVAL', msg => 'Invalid optional parameter value', }, 130# 0x000000c5 - 0x000000fd reserved 131 0x000000fe => { code => 'ESME_RDELIVERYFAILURE', msg => 'Delivery Failure (used for data_sm_resp)', }, 132 0x000000ff => { code => 'ESME_RUNKNOWNERR', msg => 'Unknown error', }, 133# 0x00000100 - 0x000003ff reserved for SMPP extension 134# 0x00000400 - 0x000004ff reserved for SMSC vendor specific errors 135# 0x00000500 - 0xffffffff reserved 136 137### *** Dear reader: if you know more error codes, e.g. in the 138### vendor specific range, please let me know so we can teach 139### this module about them. 140 141}; 142 143### Convert the status code table into constants 144 145do { 146 no strict "refs"; 147 for my $k (keys(%{&status_code})) 148 { 149 eval { *{status_code->{$k}->{code}} = sub { return $k; } }; 150 eval { *{status_code->{$k}->{code}.'_msg'} = sub { return *{status_code->{$k}->{msg}}; } }; 151 } 152}; 153 154### Command IDs, sec 5.1.2.1, table 5-1, pp. 110-111 155 156use constant CMD_generic_nack => 0x80000000; 157use constant CMD_bind_receiver => 0x00000001; 158use constant CMD_bind_receiver_resp => 0x80000001; 159use constant CMD_bind_transmitter => 0x00000002; 160use constant CMD_bind_transmitter_resp => 0x80000002; 161use constant CMD_query_sm => 0x00000003; 162use constant CMD_query_sm_resp => 0x80000003; 163use constant CMD_submit_sm => 0x00000004; 164use constant CMD_submit_sm_resp => 0x80000004; 165use constant CMD_deliver_sm => 0x00000005; 166use constant CMD_deliver_sm_resp => 0x80000005; 167use constant CMD_unbind => 0x00000006; 168use constant CMD_unbind_resp => 0x80000006; 169use constant CMD_replace_sm => 0x00000007; 170use constant CMD_replace_sm_resp => 0x80000007; 171use constant CMD_cancel_sm => 0x00000008; 172use constant CMD_cancel_sm_resp => 0x80000008; 173use constant CMD_bind_transceiver => 0x00000009; # v3.4 174use constant CMD_bind_transceiver_resp => 0x80000009; # v3.4 175use constant CMD_delivery_receipt => 0x00000009; # v4 #4 176use constant CMD_delivery_receipt_resp => 0x80000009; # v4 #4 177use constant CMD_enquire_link_v4 => 0x0000000a; #4 178use constant CMD_enquire_link_resp_v4 => 0x8000000a; #4 179use constant CMD_outbind => 0x0000000b; 180use constant CMD_enquire_link => 0x00000015; 181use constant CMD_enquire_link_resp => 0x80000015; 182use constant CMD_submit_multi => 0x00000021; 183use constant CMD_submit_multi_resp => 0x80000021; 184use constant CMD_alert_notification => 0x00000102; 185use constant CMD_data_sm => 0x00000103; 186use constant CMD_data_sm_resp => 0x80000103; 187 188### Type of Number constants, see section 5.2.5, p. 117 189 190use constant TON_unknown => 0x00; 191use constant TON_international => 0x01; 192use constant TON_national => 0x02; 193use constant TON_network_specific => 0x03; 194use constant TON_subscriber_number => 0x04; 195use constant TON_alphanumeric => 0x05; 196use constant TON_abbreviated => 0x06; 197 198### Number plan indicators, sec 5.2.6, p. 118 199 200use constant NPI_unknown => 0x00; 201use constant NPI_isdn => 0x01; # E163/E164 202use constant NPI_data => 0x03; # X.121 203use constant NPI_telex => 0x04; # F.69 204use constant NPI_land_mobile => 0x06; # E.212 205use constant NPI_national => 0x08; 206use constant NPI_private => 0x09; 207use constant NPI_ERMES => 0x0a; 208use constant NPI_internet => 0x0e; # IP 209use constant NPI_wap => 0x12; # WAP client id 210 211### ESM class constants, these are additive, use or (|) to combine them (5.2.12, p.121) 212 213use constant ESM_mode_mask => 0x03; 214use constant ESM_type_mask => 0x3c; 215use constant ESM_feature_mask => 0xc0; 216 217use constant ESM_mode_default => 0x00; # usually store and forward 218use constant ESM_mode_datagram => 0x01; 219use constant ESM_mode_forward => 0x02; # i.e. transaction mode 220use constant ESM_mode_store_and_forward => 0x03; # store and forward mode (even if not default) 221 222use constant ESM_type_default => 0x00; # default message type (i.e. normal message) 223use constant ESM_type_delivery_receipt => 0x04; # SMSC Delivery receipt (SMSC->ESME only) 224use constant ESM_type_delivery_ack => 0x08; # ESME delivery acknowledgement 225use constant ESM_type_0011 => 0x0a; 226use constant ESM_type_user_ack => 0x10; # ESME manual/user acknowledgement 227use constant ESM_type_0101 => 0x14; 228use constant ESM_type_conversation_abort => 0x18; # Korean CDMA (SMSC->ESME only) 229use constant ESM_type_0111 => 0x1a; 230use constant ESM_type_intermed_deliv_notif => 0x20; # Intermediate delivery notification (SMSC->ESME) 231use constant ESM_type_1001 => 0x24; 232use constant ESM_type_1010 => 0x28; 233use constant ESM_type_1011 => 0x2a; 234use constant ESM_type_1100 => 0x30; 235use constant ESM_type_1101 => 0x34; 236use constant ESM_type_1110 => 0x38; 237use constant ESM_type_1111 => 0x3a; 238 239use constant ESM_feature_none => 0x00; 240use constant ESM_feature_UDHI => 0x40; # User Data Header Ind, only relevant for MT short messages 241use constant ESM_feature_reply_path => 0x80; # only relevant for GSM networks 242use constant ESM_feature_UDHI_and_reply_path => 0xc0; # only relevant for GSM networks 243 244### Registered delivery bits (5.2.17, p. 124) 245 246use constant REG_receipt_mask => 0x03; 247use constant REG_ack_mask => 0x0c; 248use constant REG_intermed_notif_mask => 0x80; 249 250use constant REG_receipt_none => 0x00; 251use constant REG_receipt_always => 0x01; # receipt is returned for both success and failure 252use constant REG_receipt_on_fail => 0x02; 253use constant REG_receipt_res => 0x03; 254 255use constant REG_ack_none => 0x00; 256use constant REG_ack_delivery => 0x04; 257use constant REG_ack_user => 0x08; 258use constant REG_ack_delivery_and_user => 0x0c; 259 260use constant REG_intermed_notif_none => 0x00; 261use constant REG_intermed_notif => 0x10; 262 263### submit_multi dest_flag constants (5.2.25, p. 129) 264 265use constant MULTIDESTFLAG_SME_Address => 1; 266use constant MULTIDESTFLAG_dist_list => 2; 267 268### message_state codes returned in query_sm_resp (5.2.28, table 5-6, p. 130) 269 270use constant MSGSTATE_enroute => 1; 271use constant MSGSTATE_delivered => 2; 272use constant MSGSTATE_expired => 3; # message validity period has expired 273use constant MSGSTATE_deleted => 4; 274use constant MSGSTATE_undeliverable => 5; 275use constant MSGSTATE_accepted => 6; # i.e. message has been manually read on behalf of 276 # the subscriber by customer service 277use constant MSGSTATE_unknown => 7; # message is in invalid state 278use constant MSGSTATE_rejected => 8; 279 280### Facility codes for V4 (used as arguments to bind, or the bits together) #4 281 282use constant GF_PVCY => 0x00000001; # V4 extended p.58 Privacy #4 283use constant GF_SUBADDR => 0x00000002; # V4 extended p.64 #4 284use constant NF_CC => 0x00080000; # V4 extended p.69 Call Control *** N.B: Spec has bug *** #4 285use constant NF_PDC => 0x00010000; # V4 extended p.74 #4 286use constant NF_IS136 => 0x00020000; # V4 extended p.80 (TDMA) #4 287use constant NF_IS95A => 0x00040000; # V4 extended p.84 (CDMA) (TIA/EIA IS-637) #4 288 289### Default value table that gets incorporated into smpp object unless 290### overridden in the constructor 291 292use constant Default => { 293 294 async => 0, 295 port => 2255, # TCP port 296 timeout => 5, # Connection establishment timeout 297 listen => 120, # size of listen queue for new_listen() 298 mode => Transceiver, # Chooses type of bind #4> (Transceiver is illegal for v4) <4# 299 300 enquire_interval => 0, # How often enquire PDU is sent during read_hard(). 0 == off 301 302### Version dependent defaults. Mainly these are used to handle different #4 303### message header formats between v34 and v4 in a consistent way. Generally #4 304### these are set in the constructor based on the smpp_version field. #4 305 306 smpp_version => 0x34, # Supported versions are 0x34 == 3.4 #4> and 0x40 == 4.0 <4# 307 head_templ => 'NNNN', # v3.4 'NNNN', #4> v4.0 'NNNNxxxx', must change in tandem with above <4# 308 head_len => 16, # v3.4 16, #4> v4.0 20, must change in tandem with smpp_version <4# 309 cmd_version => 0x00000000, # v3.4 0x00000000, #4> v4 0x00010000; to be or'd with cmd <4# 310 311### Default values for bind parameters 312### For interpretation of these parameters refer to 313### sections 4.1 (p.51) and 5.2 (p. 116). 314 315 system_id => '', # 5.2.1, usually needs to be supplied 316 password => '', # 5.2.2 317 system_type => '', # 5.2.3, often optional, leave empty 318 interface_version => 0x34, # 5.2.4 319 addr_ton => 0x00, # 5.2.5 type of number 320 addr_npi => 0x00, # 5.2.6 numbering plan indicator 321 address_range => '', # 5.2.7 regular expression matching numbers 322 facilities_mask => 0x00000000, # SMPP v4.0 extension #4 323 324### Default values for submit_sm and deliver_sm 325 326 service_type => '', # NULL: SMSC defaults, #4> on v4 this is message_class <4# 327 message_class => 0xffff, # v4: 0xffff = not required, 0-0x0fff = non replace, #4 328 # 0x8000-0x8fff = replace types, others reserved (v4 p.32) #4 329 source_addr_ton => 0x00, #? not known, see sec 5.2.5 330 source_addr_npi => 0x00, #? not known, see sec 5.2.6 331 source_addr => '', ## NULL: not known. You should set this for reply to work. 332 dest_addr_ton => 0x00, #?? 333 dest_addr_npi => 0x00, #?? 334 destination_addr => '', ### Destination address must be supplied 335 esm_class => 0x00, # Default mode (store and forward) and type (5.2.12, p.121) 336 messaging_mode => 0x00, # v4 Default mode (store and forward) (v4, table 6-8, p.33) #4 337 msg_reference => '', # v4, either empty or 9 digits. For user messages 4 first digits must be 0 #4 338 protocol_id => 0x00, ### 0 works for TDMA & CDMA, for GSM set according to GSM 03.40 339 telematic_interworking => 0xff, # v4 name for v34 protocol_id (SMPP V4 Telematic Interworking Identifiers, sec 7.11, p.68) #4 340 priority_flag => 0, # non-priority/bulk/normal 341 priority_level => 0xff, # v4: 0=lowest, 1=lowmid, 2=himid, 3=highest, 4-254 reserved, 255 default #4 342 schedule_delivery_time => '', # NULL: immediate delivery 343 validity_period => '', # NULL: SMSC default validity period 344 registered_delivery => 0x00, # no receipt, no ack, no intermed notif 345 registered_delivery_mode => 0x00, # v4: 0=no receipt, 1=receipt required, 2=nondelivery receipt confirmation #4 346 replace_if_present_flag => 0, # no replacement 347 data_coding => 0, # SMSC default alphabet 348 sm_default_msg_id => 0, # Do not use canned message 349 350### default values for query_sm_resp 351 final_date => '', # NULL: message has not yet reached final state 352 error_code => 0, # no error 353 network_error_code => 0, # v4 no error? #4 354### default values for alert_notification 355 esme_addr_ton => 0x00, 356 esme_addr_npi => 0x00, 357 358### default values used by cancel_sm 359 message_id => '', # NULL: other parameters specify message to be cancelled 360 361### Table of PDU handlers. These PDUs are automatically 362### handled during wait_pdu() (as opposed to being discarded). 363### they are called as 364### $smpp->handler($pdu); 365### N.B. because the command number is constant, a comma must be used as separator 366### to prevent interpretation as string. (Thanks Matthias Meyser for pointing this out.) 367 368 handlers => { 369 CMD_enquire_link, \&handle_enquire_link, 370 CMD_enquire_link_v4, \&handle_enquire_link, #4 371 }, 372}; 373 374### Optional parameter tags, see sec 5.3.2, Table 5-7, pp.132-133 375### See also Sec 4.8.1 "TLV Tag", Table 4-60 "TLV Tag Definitions", pp. 135-137 376 377use constant param_tab => { 378 0x0005 => { name => 'dest_addr_subunit', technology => 'GSM', }, 379 0x0006 => { name => 'dest_network_type', technology => 'Generic', }, 380 0x0007 => { name => 'dest_bearer_type', technology => 'Generic', }, 381 0x0008 => { name => 'dest_telematics_id', technology => 'GSM', }, 382 383 0x000d => { name => 'source_addr_subunit', technology => 'GSM', }, 384 0x000e => { name => 'source_network_type', technology => 'Generic', }, 385 0x000f => { name => 'source_bearer_type', technology => 'Generic', }, 386 0x0010 => { name => 'source_telematics_id', technology => 'GSM', }, 387 388 0x0017 => { name => 'qos_time_to_live', technology => 'Generic', }, 389 0x0019 => { name => 'payload_type', technology => 'Generic', }, 390 0x001d => { name => 'additional_status_info_text', technology => 'Generic', }, 391 0x001e => { name => 'receipted_message_id', technology => 'Generic', }, 392 0x0030 => { name => 'ms_msg_wait_facilities', technology => 'GSM', }, 393 394 0x0101 => { name => 'PVCY_AuthenticationStr', technology => '? (J-Phone)', }, # V4ext pp.58-62 #4 395 # "\x01\x00\x00" 0x010000 no privacy option 396 397 0x0201 => { name => 'privacy_indicator', technology => 'CDMA,TDMA', }, 398 0x0202 => { name => 'source_subaddress', technology => 'CDMA,TDMA', }, # V4ext pp. 65-67 #4 399 # Aka PDC_Originator_Subaddr, "\x01\x00\x00" 0x010000 undefined #4> (J-Phone) <4# 400 0x0203 => { name => 'dest_subaddress', technology => 'CDMA,TDMA', }, # V4ext pp. 65-67 #4 401 # Aka PDC_Destination_Subaddr, "\x01\x00\x00" 0x010000 undefined #4> (J-Phone) <4# 402 0x0204 => { name => 'user_message_reference', technology => 'Generic', }, 403 0x0205 => { name => 'user_response_code', technology => 'CDMA,TDMA', }, 404 0x020a => { name => 'source_port', technology => 'WAP', }, 405 0x020b => { name => 'destination_port', technology => 'WAP', }, 406 0x020c => { name => 'sar_msg_ref_num', technology => 'Generic', }, 407 0x020d => { name => 'language_indicator', technology => 'CDMA,TDMA', }, 408 0x020e => { name => 'sar_total_segments', technology => 'Generic', }, 409 0x020f => { name => 'sar_segment_seqnum', technology => 'Generic', }, 410 0x0210 => { name => 'sc_interface_version', technology => 'Generic', }, # bind_*_resp 411 412 0x0301 => { name => 'CC_CBN', technology => 'V4', }, # V4ext p.70 Call Back Number #4 413 0x0302 => { name => 'callback_num_pres_ind', technology => 'TDMA', }, # V4ext p.71 CC_CBNPresentation #4 414 0x0303 => { name => 'callback_num_atag', technology => 'TDMA', }, # V4ext p.71 CC_CBNAlphaTag #4 415 0x0304 => { name => 'number_of_messages', technology => 'CDMA', }, # V4ext p.72 CC_NumberOfMessages #4 416 0x0381 => { name => 'callback_num', technology => 'CDMA,TDMA,GSM,iDEN', }, 417 418 0x0420 => { name => 'dpf_result', technology => 'Generic', }, 419 0x0421 => { name => 'set_dpf', technology => 'Generic', }, 420 0x0422 => { name => 'ms_availability_status', technology => 'Generic', }, 421 0x0423 => { name => 'network_error_code', technology => 'Generic', }, 422 0x0424 => { name => 'message_payload', technology => 'Generic', }, 423 0x0425 => { name => 'delivery_failure_reason', technology => 'Generic', }, 424 0x0426 => { name => 'more_messages_to_send', technology => 'GSM', }, 425 0x0427 => { name => 'message_state', technology => 'Generic', }, 426 0x0428 => { name => 'congestion_state', technology => 'Generic', }, 427 428 0x0501 => { name => 'ussd_service_op', technology => 'GSM (USSD)', }, 429 430 0x0600 => { name => 'broadcast_channel_indicator', technology => 'GSM', }, 431 0x0601 => { name => 'broadcast_content_type', technology => 'CDMA, TDMA, GSM', }, 432 0x0602 => { name => 'broadcast_content_type_info', technology => 'CDMA, TDMA', }, 433 0x0603 => { name => 'broadcast_message_class', technology => 'GSM', }, 434 0x0604 => { name => 'broadcast_rep_num', technology => 'GSM', }, 435 0x0605 => { name => 'broadcast_frequency_interval', technology => 'CDMA, TDMA, GSM', }, 436 0x0606 => { name => 'broadcast_area_identifier', technology => 'CDMA, TDMA, GSM', }, 437 0x0607 => { name => 'broadcast_error_status', technology => 'CDMA, TDMA, GSM', }, 438 0x0608 => { name => 'broadcast_area_success', technology => 'GSM', }, 439 0x0609 => { name => 'broadcast_end_time', technology => 'CDMA, TDMA, GSM', }, 440 0x060a => { name => 'broadcast_service_group', technology => 'CDMA, TDMA', }, 441 0x060b => { name => 'billing_identification', technology => 'Generic', }, 442 0x060d => { name => 'source_network_id', technology => 'Generic', }, 443 0x060e => { name => 'dest_network_id', technology => 'Generic', }, 444 0x060f => { name => 'source_node_id', technology => 'Generic', }, 445 0x0610 => { name => 'dest_node_id', technology => 'Generic', }, 446 0x0611 => { name => 'dest_addr_np_resolution', technology => 'CDMA, TDMA (US Only)', }, 447 0x0612 => { name => 'dest_addr_np_information', technology => 'CDMA, TDMA (US Only)', }, 448 0x0613 => { name => 'dest_addr_np_country', technology => 'CDMA, TDMA (US Only)', }, 449 450 0x1201 => { name => 'display_time', technology => 'CDMA,TDMA', }, # IS136_DisplayTime 451 0x1203 => { name => 'sms_signal', technology => 'TDMA', }, 452 0x1204 => { name => 'ms_validity', technology => 'CDMA,TDMA', }, 453 454 0x1304 => { name => 'IS95A_AlertOnDelivery', technology => 'CDMA', }, # V4ext p.85 #4 455 0x1306 => { name => 'IS95A_LanguageIndicator', technology => 'CDMA', }, # V4ext p.86 #4 456 # "\x00" 0x00 = Unknown, 0x01 = english, 0x02 = french, 0x03 = spanish 457 0x130c => { name => 'alert_on_message_delivery', technology => 'CDMA', }, 458 0x1380 => { name => 'its_reply_type', technology => 'CDMA', }, 459 0x1383 => { name => 'its_session_info', technology => 'CDMA Korean [KORITS]', }, 460 461 # from http://docs.roottori.fi/display/MSGAPI/SMPP+commands 462 # On the other hand, http://sms-clearing.com/downloads/gateway/7_SMPP.pdf 463 # lists tag 0x1403 as holding both MCC and MNC in format "MCC/MNC" 464 0x1402 => { name => 'operator_id', technology => 'vendor extension', }, 465 0x1403 => { name => 'tariff', technology => 'Mobile Network Code vendor extension', }, 466 # valyakol@gmail.com reports that these should be 467 #0x1402 => { name => 'mBlox_operator', technology => 'Generic', }, 468 #0x1403 => { name => 'mBlox_rate', technology => 'Generic', }, 469 0x1450 => { name => 'mcc', technology => 'Mobile Country Code vendor extension', }, 470 0x1451 => { name => 'mnc', technology => 'Mobile Network Code vendor extension', }, 471 472 0x1101 => { name => 'PDC_MessageClass', technology => '? (J-Phone)', }, # V4ext p.75 #4 473 # "\x20\x00" 0x2000 Sky Mail (service name of J-Phone SMS) #4 474 # 0x2033 - 0x20fe Vendor defined 475 # 0x1001 Coordinator (sender is able to send msg to more than two users) 476 # 0x1002 Hotline (two users communicate using private line) 477 # 0x1003 Relay Mail (Message relays user to user in turn by sender is specified) 478 # 0x1004 Greeting service (J-Phone original) (sender can spec. deiv. date and time) #4 479 480 0x1102 => { name => 'PDC_PresentationOption', technology => '? (J-Phone)', }, # V4ext p.76 #4 481 # "\x00\xff\xff\xff" 0x00ffffff Receiver defined option 482 # "\x01\xff\xff\xff" 0x01ffffff MS 483 484 0x1103 => { name => 'PDC_AlertMechanism', technology => '? (J-Phone)', }, # V4ext p.76 #4 485 # "\x01" 0x01 Alert tones level 1, 0x00 = no detectable alert, 0x0f = emergency, 0xff = default 486 487 0x1104 => { name => 'PDC_Teleservice', technology => '? (J-Phone)', }, # V4 p.77 #4 488 # "\x01" 0x01 Generalized message, 0x00 reserved, 0x02 two way, 0x03 concateneated 489 490 0x1105 => { name => 'PDC_MultiPartMessage', technology => '? (J-Phone)', # V4 p.77 #4 491 format => 'nCC', # MessageNumber, current_Sequence_Number, Maximum_Sequence_Number 492 }, 493 # "\0\0\0\0" 0x00000000 undefined, i.e. no multipart 494 495 0x1106 => { name => 'PDC_PredefinedMsg', technology => '? (J-Phone)', }, # V4 p.78 #4 496 # "\x00" 0x00 Undefined. This can be used to indicate preformatted messages, possibly with Kanji 497 #0x0101 => { name => '', technology => '? (J-Phone)', }, 498 499 ### Tags not specified in v3.4 specification 500 # *** dear reader, please add here any old or nonstandard tags 501 # that you know to exist so that this module becomes more 502 # useful 503}; 504 505### invert the param_tab so we can get from name to code 506 507for my $tag (keys %{¶m_tab}) { 508 $param_by_name{param_tab->{$tag}->{name}} = $tag; 509} 510 511sub format_a_line { 512 my ($tt, $prefix) = shift; 513 my $t=$tt; 514 $t=~tr[\x20-\x7e][]c; 515# sprintf("$prefix%04x: " . '%02x ' x length($1) . "\t$t\n", $n+=16, map {ord} split('', $1)); 516} 517 518sub hexdump { 519 my ($data, $prefix) = @_; 520 my $n = -16; 521 $data =~ s/(.{1,16})/ 522 sprintf("$prefix%04x: " . '%02x ' x length($1) . "\n", $n+=16, map {ord} split('', $1))/ge; 523# sprintf("$prefix%04x: " . '%02x ' x length($1) . "\t$1\n", $n+=16, map {ord} split('', $1))/ge; 524# format_a_line($1, $prefix)/gsex; 525 return $data; 526} 527 528### The optional values are encoded as TLV (tag, len, value) triplets where 529### tag and length are 16 bit network byteorder and value is as much as 530### the length says (length does not include tag or length of the length 531### field itself). 532 533sub decode_optional_params { 534 my ($pdu, $offset) = @_; 535 while ($offset < length($pdu->{data})) { 536 my ($tag, $len) = unpack 'nn', substr($pdu->{data}, $offset); 537 my ($val) = unpack "a$len", substr($pdu->{data}, $offset+4); 538 $pdu->{$tag} = $val; # value is always accessible via numeric tag 539 if (defined param_tab->{$tag}) { 540 $pdu->{param_tab->{$tag}->{name}} = $val; # assign symbolic name 541 } else { 542 warn "Unknown tag (offset $offset): $tag, len=".length($val).", val=`$val'"; 543 } 544 $offset += 4 + length($val); 545 } 546} 547 548sub encode_optional_params { 549 my $data = ''; 550 while (@_) { # N.B. by using array instead of hash we can control order of items 551 my $opt_param = shift; 552 my $val = shift; 553 next if !defined $opt_param; # skip mandatory parameters that were taken 554 if ($param_by_name{$opt_param}) { 555 $data .= pack 'nna*', $param_by_name{$opt_param}, length($val), $val; 556 } elsif ($opt_param =~ /^\d+$/) { # specification by numeric tag 557 if ($val > -128 && $val < 127) { 558 $data .= pack 'nnc', $opt_param, 1, $val; 559 } elsif ($val > -32768 && $val < 32767) { 560 $data .= pack 'nnn!', $opt_param, 2, $val; 561 } else { 562 $data .= pack 'nnN!', $opt_param, 4, $val; 563 } 564 } else { 565 warn "Unknown optional parameter `$opt_param', skipping"; 566 } 567 } 568 return $data; 569} 570 571### return $_[0]->req_backend($op, &encode, @_); 572 573sub req_backend { 574 my $me = shift; 575 my $op = shift; 576 my $data = shift; 577 my ($async, $seq); 578 shift; # skip over second copy of $me 579 580 ### Extract operational parameters that should not make part of PDU 581 582 for (my $i=0; $i <= $#_; $i+=2) { 583 next if !defined $_[$i]; 584 if ($_[$i] eq 'async') { $async = splice @_,$i,2,undef,undef; } 585 elsif ($_[$i] eq 'seq') { $seq = splice @_,$i,2,undef,undef; } 586 } 587 $async = ${*$me}{async} if !defined $async; 588 if (!defined $seq) { 589 $seq = ++(${*$me}{seq}); 590 } 591 592 $data .= &encode_optional_params; # will process remaining @_ 593 594 my $header = pack(${*$me}{head_templ}, ${*$me}{head_len}+length($data), 595 $op|${*$me}{cmd_version}, 0, $seq); 596 597 warn "req Header:\n".hexdump($header,"\t") if $trace; 598 warn "req Body:\n".hexdump($data,"\t") if $trace; 599 $me->syswrite($header.$data); 600 return $seq if $async; 601 602 # Synchronous operation: wait for response 603 604 warn "req sent, waiting response" if $trace; 605 return $me->wait_pdu($op | ${*$me}{cmd_version} | 0x80000000, $seq); 606} 607 608### return $_[0]->resp_backend($op, &encode, @_); 609 610sub resp_backend { 611 my $me = shift; 612 my $op = shift; 613 my $data = shift; 614 my ($async, $seq, $status); 615 shift; # skip over second copy of $me 616 617 ### Extract operational parameters that should not make part of PDU 618 619 for (my $i=0; $i <= $#_; $i+=2) { 620 next if !defined $_[$i]; 621 if ($_[$i] eq 'async') { $async = splice @_,$i,2,undef,undef; } 622 elsif ($_[$i] eq 'seq') { $seq = splice @_,$i,2,undef,undef; } 623 elsif ($_[$i] eq 'status') { $status = splice @_,$i,2,undef,undef; } 624 } 625 croak "seq must be supplied" if !defined $seq; 626 $status = 0 if !defined $status; 627 628 $data .= &encode_optional_params; # will process remaining @_ 629 630 my $header = pack(${*$me}{head_templ}, ${*$me}{head_len}+length($data), 631 $op|${*$me}{cmd_version}, $status, $seq); 632 #warn "$op,$seq==>".join(':',@_); 633 634 warn "resp Header:\n".hexdump($header, "\t") if $trace; 635 warn "resp Body:\n".hexdump($data, "\t") if $trace; 636 $me->syswrite($header.$data); 637 return $seq; 638} 639 640### These triplets occur often enough to warrant common function 641 642sub decode_source_addr { 643 my ($pdu, $data) = @_; 644 ($pdu->{source_addr_ton}, # 2 C 645 $pdu->{source_addr_npi}, # 3 C 646 $pdu->{source_addr}) = unpack 'CCZ*', $data; 647 return 1 + 1 + length($pdu->{source_addr}) + 1; 648} 649 650sub decode_destination_addr { 651 my ($pdu, $data) = @_; 652 ($pdu->{dest_addr_ton}, # 2 C 653 $pdu->{dest_addr_npi}, # 3 C 654 $pdu->{destination_addr}) = unpack 'CCZ*', $data; 655 return 1 + 1 + length($pdu->{destination_addr}) + 1; 656} 657 658sub decode_source_and_destination { 659 my ($pdu, $data) = @_; 660 my $len = decode_source_addr($pdu, $data); 661 $len += decode_destination_addr($pdu, substr($data, $len)); 662 return $len; 663} 664 665### Some PDUs do not have any body (mandatory parameters) 666 667sub decode_empty { 668 #my $pdu = shift; 669 return 0; 670} 671 672### 673### Public API functions for emitting trivial empty PDUs 674### 675 676sub unbind { $_[0]->req_backend(CMD_unbind, '', @_) } 677 678sub enquire_link { 679 my $me = $_[0]; 680 return $me->req_backend(${*$me}{smpp_version}==0x40?CMD_enquire_link_v4:CMD_enquire_link, '', @_); #4 681 $me->req_backend(CMD_enquire_link, '', @_); 682} 683 684sub enquire_link_resp { 685 my $me = $_[0]; 686 return $me->resp_backend(${*$me}{smpp_version}==0x40?CMD_enquire_link_resp_v4:CMD_enquire_link_resp, '', @_); #4 687 $me->resp_backend(CMD_enquire_link_resp, '', @_); 688} 689 690sub generic_nack { $_[0]->resp_backend(CMD_generic_nack, '', @_) } 691sub unbind_resp { $_[0]->resp_backend(CMD_unbind_resp, '', @_) } 692sub replace_sm_resp { $_[0]->resp_backend(CMD_replace_sm_resp, '', @_) } 693sub cancel_sm_resp { $_[0]->resp_backend(CMD_cancel_sm_resp, '', @_) } 694sub delivery_receipt_resp { $_[0]->resp_backend(CMD_delivery_receipt_resp, '', @_) } 695 696### 697### All bind operations have same PDU format (4.1.1, p.46) 698### 699 700sub decode_bind { 701 my $pdu = shift; 702 my $me = shift; 703 ($pdu->{system_id}) = unpack 'Z*', $pdu->{data}; # 1 Z 704 my $len = length($pdu->{system_id}) + 1; 705 ($pdu->{password}) = unpack 'Z*', substr($pdu->{data}, $len); # 2 Z 706 $len += length($pdu->{password}) + 1; 707 ($pdu->{system_type}) = unpack 'Z*', substr($pdu->{data}, $len); # 3 Z 708 $len += length($pdu->{system_type}) + 1; 709 ($pdu->{interface_version}, # 4 710 $pdu->{addr_ton}, # 5 711 $pdu->{addr_npi}, # 6 712 $pdu->{address_range}) = unpack 'CCCZ*', substr($pdu->{data}, $len); 713 $len += 3 + length($pdu->{address_range}) + 1; 714 if (${*$me}{smpp_version}==0x40) { #4 715 ($pdu->{facilities_mask}) = unpack 'N', substr($pdu->{data}, $len); #4 716 $len += 4; #4 717 } #4 718 return $len; 719} 720 721sub encode_bind { 722 my $me = $_[0]; 723 my ($system_id, $password, $system_type, $interface_version, 724 $addr_ton, $addr_npi, $address_range, $facilities_mask); 725 726 ### Extract mandatory parameters from argument stream 727 728 for (my $i=1; $i <= $#_; $i+=2) { 729 next if !defined $_[$i]; 730 if ($_[$i] eq 'system_id') { $system_id = splice @_,$i,2,undef,undef; } 731 elsif ($_[$i] eq 'password') { $password = splice @_,$i,2,undef,undef; } 732 elsif ($_[$i] eq 'system_type') { $system_type = splice @_,$i,2,undef,undef; } 733 elsif ($_[$i] eq 'interface_version') { $interface_version = splice @_,$i,2,undef,undef; } 734 elsif ($_[$i] eq 'interface_type') { $interface_version = splice @_,$i,2,undef,undef; } 735 elsif ($_[$i] eq 'addr_ton') { $addr_ton = splice @_,$i,2,undef,undef; } 736 elsif ($_[$i] eq 'addr_npi') { $addr_npi = splice @_,$i,2,undef,undef; } 737 elsif ($_[$i] eq 'address_range') { $address_range = splice @_,$i,2,undef,undef; } 738 elsif ($_[$i] eq 'facilities_mask') { $facilities_mask = splice @_,$i,2,undef,undef; } #4 739 } 740 741 ### Apply defaults for those mandatory arguments that were not specified 742 743 $system_id = ${*$me}{system_id} if !defined $system_id; 744 $password = ${*$me}{password} if !defined $password; 745 $system_type = ${*$me}{system_type} if !defined $system_type; 746 $interface_version = ${*$me}{interface_version} if !defined $interface_version; 747 $addr_ton = ${*$me}{addr_ton} if !defined $addr_ton; 748 $addr_npi = ${*$me}{addr_npi} if !defined $addr_npi; 749 $address_range = ${*$me}{address_range} if !defined $address_range; 750 $facilities_mask = ${*$me}{facilities_mask} if !defined $facilities_mask; #4 751 752 ### N.B. v3.4 last argument, $facilities_mask, will be ignored because #4 753 ### template misses N, v4.0 it will be used because template has N #4 754 return pack(${*$me}{smpp_version}==0x40?'Z*Z*Z*CCCZ*N':'Z*Z*Z*CCCZ*', #4 755 $system_id, $password, $system_type, #4 756 $interface_version, $addr_ton, $addr_npi, #4 757 $address_range, $facilities_mask); #4 758 return pack('Z*Z*Z*CCCZ*', 759 $system_id, $password, $system_type, 760 $interface_version, $addr_ton, $addr_npi, 761 $address_range); 762} 763 764### All bind operations have same response format (4.1.2, p.47) 765 766sub decode_bind_resp_v34 { 767 my $pdu = shift; 768 my $me = shift; 769 ($pdu->{system_id}) = unpack 'Z*', $pdu->{data}; 770 return length($pdu->{system_id}) + 1; 771} 772 773#4#cut 774sub decode_bind_resp_v4 { 775 my $pdu = shift; 776 my $me = shift; 777 ($pdu->{system_id}) = unpack 'Z*', $pdu->{data}; 778 my $len = length($pdu->{system_id}) + 1; 779 ($pdu->{facilities_mask}) = unpack 'N', substr($pdu->{data}, $len); 780 return $len + 4; 781} 782#4#end 783 784sub encode_bind_resp { 785 my $me = $_[0]; 786 my ($system_id, $facilities_mask); 787 788 for (my $i=1; $i <= $#_; $i+=2) { 789 next if !defined $_[$i]; 790 if ($_[$i] eq 'system_id') { $system_id = splice @_,$i,2,undef,undef; } 791 elsif ($_[$i] eq 'facilities_mask') { $facilities_mask = splice @_,$i,2,undef,undef; } #4 792 } 793 $system_id = ${*$me}{system_id} if !defined $system_id; 794 $facilities_mask = ${*$me}{facilities_mask} if !defined $facilities_mask; #4 795 return pack(${*$me}{smpp_version}==0x40?'Z*N':'Z*', $system_id, $facilities_mask); #4 796 return pack('Z*', $system_id); 797} 798 799### 800### Public API functions to emit binds and bind_resps. 801### 802 803sub bind_transceiver { $_[0]->req_backend(CMD_bind_transceiver, &encode_bind, @_) } 804sub bind_transmitter { $_[0]->req_backend(CMD_bind_transmitter, &encode_bind, @_) } 805sub bind_receiver { $_[0]->req_backend(CMD_bind_receiver, &encode_bind, @_) } 806 807sub bind_transceiver_resp { $_[0]->resp_backend(CMD_bind_transceiver_resp, &encode_bind_resp, @_) } 808sub bind_transmitter_resp { $_[0]->resp_backend(CMD_bind_transmitter_resp, &encode_bind_resp, @_) } 809sub bind_receiver_resp { $_[0]->resp_backend(CMD_bind_receiver_resp, &encode_bind_resp, @_) } 810 811### outbind (4.1.7.1) 812 813sub decode_outbind_v34 { 814 my $pdu = shift; 815 my $me = shift; 816 ($pdu->{system_id}) = unpack 'Z*', $pdu->{data}; 817 my $len = length($pdu->{system_id}) + 1; 818 ($pdu->{password}) = unpack 'Z*', substr($pdu->{data}, $len); 819 return $len + length($pdu->{password}) + 1; 820} 821 822#4#cut 823sub decode_outbind_v4 { 824 my $pdu = shift; 825 my $me = shift; 826 ($pdu->{password}) = unpack 'Z*', $pdu->{data}; 827 return length($pdu->{password}) + 1; 828} 829#4#end 830 831sub encode_outbind { 832 my $me = $_[0]; 833 my ($system_id, $password); 834 835 for (my $i=1; $i <= $#_; $i+=2) { 836 next if !defined $_[$i]; 837 if ($_[$i] eq 'system_id') { $system_id = splice @_,$i,2,undef,undef; } 838 elsif ($_[$i] eq 'password') { $password = splice @_,$i,2,undef,undef; } 839 } 840 841 $system_id = ${*$me}{system_id} if !defined $system_id; 842 $password = ${*$me}{password} if !defined $password; 843 ### N.B. v4 does not have system_id. "CX" construct skips over this parameter #4 844 return pack(${*$me}{smpp_version}==0x40?'CXZ*':'Z*Z*', $system_id, $password); #4 845 return pack('Z*Z*', $system_id, $password); 846} 847 848sub outbind { 849 my $me = $_[0]; 850 push @_, seq => ++(${*$me}{seq}) unless grep $_ eq 'seq', @_; 851 return $me->resp_backend(CMD_outbind, &encode_outbind, @_); 852} 853 854### outbind does not have response 855 856### submit (4.4.1), deliver (4.6.1) (both use same PDU format), p.59 857 858sub decode_submit_v34 { 859 my $pdu = shift; 860 ($pdu->{service_type}) = unpack 'Z*', $pdu->{data}; 861 my $len = length($pdu->{service_type}) + 1; 862 $len += decode_source_and_destination($pdu, substr($pdu->{data}, $len)); 863 864 ($pdu->{esm_class}, # 8 865 $pdu->{protocol_id}, # 9 866 $pdu->{priority_flag}, # 10 867 $pdu->{schedule_delivery_time}) = unpack 'CCCZ*', substr($pdu->{data}, $len); 868 $len += 1 + 1 + 1 + length($pdu->{schedule_delivery_time}) + 1; 869 870 ($pdu->{validity_period}) = unpack 'Z*', substr($pdu->{data}, $len); 871 $len += length($pdu->{validity_period}) + 1; 872 873 my $sm_length; 874 ($pdu->{registered_delivery}, # 13 875 $pdu->{replace_if_present_flag}, # 14 876 $pdu->{data_coding}, # 15 877 $pdu->{sm_default_msg_id}, # 16 878 $sm_length, # 17 879# 1 880# 12345678901234567 8 881 ) = unpack 'CCCCC', substr($pdu->{data}, $len); 882 $len += 1 + 1 + 1 + 1 + 1; 883 ($pdu->{short_message} # 18 884 ) = unpack "a$sm_length", substr($pdu->{data}, $len); 885 return $len + $sm_length; 886} 887 888sub encode_submit_v34 { 889 my $me = $_[0]; 890 my ($service_type, $source_addr_ton, $source_addr_npi, $source_addr, 891 $dest_addr_ton, $dest_addr_npi, $destination_addr, 892 $esm_class, $protocol_id, $priority_flag, 893 $schedule_delivery_time, $validity_period, 894 $registered_delivery, $replace_if_present_flag, $data_coding, 895 $sm_default_msg_id, $short_message); 896 897 ### Extract mandatory parameters from argument stream 898 899 for (my $i=1; $i <= $#_; $i+=2) { 900 next if !defined $_[$i]; 901 if ($_[$i] eq 'service_type') { $service_type = splice @_,$i,2,undef,undef; } 902 elsif ($_[$i] eq 'source_addr_ton') { $source_addr_ton = splice @_,$i,2,undef,undef; } 903 elsif ($_[$i] eq 'source_addr_npi') { $source_addr_npi = splice @_,$i,2,undef,undef; } 904 elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; } 905 elsif ($_[$i] eq 'dest_addr_ton') { $dest_addr_ton = splice @_,$i,2,undef,undef; } 906 elsif ($_[$i] eq 'dest_addr_npi') { $dest_addr_npi = splice @_,$i,2,undef,undef; } 907 elsif ($_[$i] eq 'destination_addr') { $destination_addr = splice @_,$i,2,undef,undef; } 908 elsif ($_[$i] eq 'esm_class') { $esm_class = splice @_,$i,2,undef,undef; } 909 elsif ($_[$i] eq 'protocol_id') { $protocol_id = splice @_,$i,2,undef,undef; } 910 elsif ($_[$i] eq 'priority_flag') { $priority_flag = splice @_,$i,2,undef,undef; } 911 elsif ($_[$i] eq 'schedule_delivery_time') { $schedule_delivery_time = splice @_,$i,2,undef,undef; } 912 elsif ($_[$i] eq 'validity_period') { $validity_period = splice @_,$i,2,undef,undef; } 913 elsif ($_[$i] eq 'registered_delivery') { $registered_delivery = splice @_,$i,2,undef,undef; } 914 elsif ($_[$i] eq 'replace_if_present_flag') { $replace_if_present_flag = splice @_,$i,2,undef,undef; } 915 elsif ($_[$i] eq 'data_coding') { $data_coding = splice @_,$i,2,undef,undef; } 916 elsif ($_[$i] eq 'sm_default_msg_id') { $sm_default_msg_id = splice @_,$i,2,undef,undef; } 917 elsif ($_[$i] eq 'short_message') { $short_message = splice @_,$i,2,undef,undef; } 918 } 919 920 ### Apply defaults for those mandatory arguments that were not specified 921 922 $service_type = ${*$me}{service_type} if !defined $service_type; 923 $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton; 924 $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi; 925 $source_addr = ${*$me}{source_addr} if !defined $source_addr; 926 $dest_addr_ton = ${*$me}{dest_addr_ton} if !defined $dest_addr_ton; 927 $dest_addr_npi = ${*$me}{dest_addr_npi} if !defined $dest_addr_npi; 928 croak "Must supply destination_addr to submit_sm or deliver_sm" if !defined $destination_addr; 929 $esm_class = ${*$me}{esm_class} if !defined $esm_class; 930 $protocol_id = ${*$me}{protocol_id} if !defined $protocol_id; 931 $priority_flag = ${*$me}{priority_flag} if !defined $priority_flag; 932 $schedule_delivery_time = ${*$me}{schedule_delivery_time} if !defined $schedule_delivery_time; 933 $validity_period = ${*$me}{validity_period} if !defined $validity_period; 934 $registered_delivery = ${*$me}{registered_delivery} if !defined $registered_delivery; 935 $replace_if_present_flag = ${*$me}{replace_if_present_flag} if !defined $replace_if_present_flag; 936 $data_coding = ${*$me}{data_coding} if !defined $data_coding; 937 $sm_default_msg_id = ${*$me}{sm_default_msg_id} if !defined $sm_default_msg_id; 938 $short_message = '' if !defined $short_message; 939 940 return pack('Z*CCZ*CCZ*CCCZ*Z*CCCCCa*', 941 $service_type, $source_addr_ton, $source_addr_npi, $source_addr, 942 $dest_addr_ton, $dest_addr_npi, $destination_addr, 943 $esm_class, $protocol_id, $priority_flag, 944 $schedule_delivery_time, $validity_period, 945 $registered_delivery, $replace_if_present_flag, $data_coding, 946 $sm_default_msg_id, length($short_message), $short_message, ); 947} 948 949#4#cut 950### submit_sm_v4 (6.4.4.1), v4 p.32 951 952sub decode_submit_v4 { 953 my $pdu = shift; 954 ($pdu->{message_class}, # 1 (2) 955 $pdu->{source_addr_ton}, # 2 (1) 956 $pdu->{source_addr_npi}, # 3 (1) 957 $pdu->{source_addr}, # 4 (n+1) 958 ) = unpack 'nCCZ*', $pdu->{data}; 959 my $len = 2 + 1 + 1 + length($pdu->{source_addr}) + 1; 960 961 ($pdu->{number_of_dests}) = unpack 'N', substr($pdu->{data}, $len); 962 $len += 4; 963 #warn "a decode_submit $len ($pdu->{number_of_dests}): ".hexdump(substr($pdu->{data}, $len)); 964 965 ### Walk down the variable length destination address list 966 967 for (my $i = 0; $i < $pdu->{number_of_dests}; $i++) { 968 ($pdu->{dest_addr_ton}[$i], # SME ton (v4 table 6-9, p. 36) 969 $pdu->{dest_addr_npi}[$i], # SME npi 970 $pdu->{destination_addr}[$i]) # SME address 971 = unpack 'CCZ*', substr($pdu->{data}, $len); 972 $len += 1 + 1 + length($pdu->{destination_addr}[$i]) + 1; 973 #warn "b decode_submit $len: ".hexdump(substr($pdu->{data}, $len)); 974 } 975 976 ### Now that we skipped over the variable length destinations 977 ### we are ready to decode the rest of the packet. 978 979 ($pdu->{messaging_mode}, # 7 C 980 $pdu->{msg_reference}) = unpack 'CZ*', substr($pdu->{data}, $len); 981 $len += 1 + length($pdu->{msg_reference}) + 1; 982 #warn "c decode_submit $len: ".hexdump(substr($pdu->{data}, $len)); 983 984 ($pdu->{telematic_interworking}, # 9 C 985 $pdu->{priority_level}, # 10 C 986 $pdu->{schedule_delivery_time}) = unpack 'CCZ*', substr($pdu->{data}, $len); 987 $len += 1 + 1 + length($pdu->{schedule_delivery_time}) + 1; 988 warn "d decode_submit $len: ".hexdump(substr($pdu->{data}, $len)) if $trace; 989 990 my $sm_length; 991 ($pdu->{validity_period}, # 12 n v4: n.b. this is now short instead of Cstr 992 $pdu->{registered_delivery}, # 13 C 993 $pdu->{data_coding}, # 14 C 994 $pdu->{sm_default_msg_id}, # 15 C 995 $sm_length, # 16 n 996 997# 1 998# 7890123456 7 999 ) = unpack 'nCCCn', substr($pdu->{data}, $len); 1000 $len += 2 + 1 + 1 + 1 + 2; 1001 ($pdu->{short_message} # 17 a 1002 ) = unpack "a$sm_length", substr($pdu->{data}, $len); 1003 $len += $sm_length; 1004 warn "e decode_submit ($pdu->{short_message}) $len: ".hexdump(substr($pdu->{data}, $len)) if $trace; 1005 1006 $pdu->{service_type} = $pdu->{message_class}; # compat v34 1007 $pdu->{esm_class} = $pdu->{messaging_mode}; # compat v34 1008 $pdu->{protocol_id} = $pdu->{telematic_interworking}; # compat v34 1009 $pdu->{priority_flag} = $pdu->{priority_level}; # compat v34 1010 1011 return $len; 1012} 1013 1014sub encode_submit_v4 { 1015 my $me = $_[0]; 1016 my ($message_class, $source_addr_ton, $source_addr_npi, $source_addr, 1017 @dest_addr_ton, @dest_addr_npi, @destination_addr, 1018 $messaging_mode, $msg_reference, $telematic_interworking, $priority_level, 1019 $schedule_delivery_time, $validity_period, 1020 $registered_delivery_mode, $data_coding, 1021 $sm_default_msg_id, $short_message, $addr_data); 1022 1023 ### Extract mandatory parameters from argument stream 1024 1025 for (my $i=1; $i <= $#_; $i+=2) { 1026 next if !defined $_[$i]; 1027 #warn "iter $i: >$_[$i]<"; 1028 if ($_[$i] eq 'message_class') { $message_class = splice @_,$i,2,undef,undef; } 1029 elsif ($_[$i] eq 'service_type') { $message_class = splice @_,$i,2,undef,undef; } # v34 1030 elsif ($_[$i] eq 'source_addr_ton') { $source_addr_ton = splice @_,$i,2,undef,undef; } 1031 elsif ($_[$i] eq 'source_addr_npi') { $source_addr_npi = splice @_,$i,2,undef,undef; } 1032 elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; } 1033 elsif ($_[$i] eq 'dest_addr_ton') { 1034 @dest_addr_ton = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)} 1035 : (scalar(splice @_,$i,2,undef,undef)); 1036 } 1037 elsif ($_[$i] eq 'dest_addr_npi') { 1038 @dest_addr_npi = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)} 1039 : (scalar(splice @_,$i,2,undef,undef)); 1040 } 1041 elsif ($_[$i] eq 'destination_addr') { 1042 @destination_addr = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)} 1043 : (scalar(splice @_,$i,2,undef,undef)); 1044 } 1045 elsif ($_[$i] eq 'messaging_mode') { $messaging_mode = splice @_,$i,2,undef,undef; } 1046 elsif ($_[$i] eq 'esm_class') { $messaging_mode = splice @_,$i,2,undef,undef; } # v34 1047 elsif ($_[$i] eq 'msg_reference') { $msg_reference = splice @_,$i,2,undef,undef; } 1048 elsif ($_[$i] eq 'telematic_interworking') { $telematic_interworking = splice @_,$i,2,undef,undef; } 1049 elsif ($_[$i] eq 'protocol_id') { $telematic_interworking = splice @_,$i,2,undef,undef; } # v34 1050 elsif ($_[$i] eq 'priority_level') { $priority_level = splice @_,$i,2,undef,undef; } 1051 elsif ($_[$i] eq 'priority_flag') { $priority_level = splice @_,$i,2,undef,undef; } # v34 1052 elsif ($_[$i] eq 'schedule_delivery_time') { $schedule_delivery_time = splice @_,$i,2,undef,undef; } 1053 elsif ($_[$i] eq 'validity_period') { $validity_period = splice @_,$i,2,undef,undef; } 1054 elsif ($_[$i] eq 'registered_delivery_mode') { $registered_delivery_mode = splice @_,$i,2,undef,undef; } 1055 elsif ($_[$i] eq 'registered_delivery') { $registered_delivery_mode = splice @_,$i,2,undef,undef; } # v34 1056 elsif ($_[$i] eq 'data_coding') { $data_coding = splice @_,$i,2,undef,undef; } 1057 elsif ($_[$i] eq 'sm_default_msg_id') { $sm_default_msg_id = splice @_,$i,2,undef,undef; } 1058 elsif ($_[$i] eq 'short_message') { $short_message = splice @_,$i,2,undef,undef; } 1059 1060 ### Following kludge was added by Felix as PTF when integrating. 1061 ### Basically this should be handled correctly by the generic 1062 ### optional parameter code but didn't work right for Felix at the 1063 ### time. Lets hope this is fixed now. --Sampo 1064 #elsif ($_[$i] eq 'PDC_MultiPartMessage') { my $tmp_mpm = splice @_,$i,2, undef,undef; 1065 # $pdc_multipartmessage = pack("CCCC", 1066 # 0x11, 0x05, 0x00, 0x04) 1067 # . $tmp_mpm 1068 # unless (length ($tmp_mpm) != 4); 1069 # } 1070 1071 } 1072 1073 ### Apply defaults for those mandatory arguments that were not specified 1074 1075 $message_class = ${*$me}{message_class} if !defined $message_class; 1076 $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton; 1077 $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi; 1078 $source_addr = ${*$me}{source_addr} if !defined $source_addr; 1079 1080 croak "Must supply destination_addr to submit_sm v4" if !@destination_addr; 1081 1082 $messaging_mode = ${*$me}{messaging_mode} if !defined $messaging_mode; 1083 $msg_reference = ${*$me}{msg_reference} if !defined $msg_reference; 1084 $telematic_interworking = ${*$me}{telematic_interworking} if !defined $telematic_interworking; 1085 $priority_level = ${*$me}{priority_level} if !defined $priority_level; 1086 $schedule_delivery_time = ${*$me}{schedule_delivery_time} if !defined $schedule_delivery_time; 1087 $validity_period = ${*$me}{validity_period} if !defined $validity_period; 1088 $registered_delivery_mode = ${*$me}{registered_delivery_mode} if !defined $registered_delivery_mode; 1089 $data_coding = ${*$me}{data_coding} if !defined $data_coding; 1090 $sm_default_msg_id = ${*$me}{sm_default_msg_id} if !defined $sm_default_msg_id; 1091 $short_message = '' if !defined $short_message; 1092 1093 ### destination address encoding is pretty messy with variable 1094 ### number of variable length records. 1095 1096 for (my $i = 0; $i <= $#destination_addr; $i++) { 1097 my $ton = !defined($dest_addr_ton[$i]) ? ${*$me}{dest_addr_ton} : $dest_addr_ton[$i]; 1098 my $npi = !defined($dest_addr_npi[$i]) ? ${*$me}{dest_addr_npi} : $dest_addr_npi[$i]; 1099 $addr_data .= pack 'CCZ*', $ton, $npi, $destination_addr[$i]; 1100 } 1101 1102 return pack('nCCZ*N', 1103 $message_class, $source_addr_ton, $source_addr_npi, $source_addr, 1104 scalar(@destination_addr)) . $addr_data 1105 . pack('CZ*CCZ*nCCCna*', 1106 $messaging_mode, $msg_reference, $telematic_interworking, 1107 $priority_level, $schedule_delivery_time, $validity_period, 1108 $registered_delivery_mode, $data_coding, 1109 $sm_default_msg_id, length($short_message), $short_message, ) 1110 # . $pdc_multipartmessage # *** Felix 1111 ; 1112} 1113 1114### v4 submit_sm response encoding and decoding is equal to submit_multi_resp v3.4 1115#4#end 1116 1117sub submit_sm { 1118 my $me = $_[0]; 1119 return $me->req_backend(CMD_submit_sm, #4 1120 (${*$me}{smpp_version} == 0x40) #4 1121 ? &encode_submit_v4 : &encode_submit_v34, #4 1122 @_); #4 1123 return $me->req_backend(CMD_submit_sm, &encode_submit_v34, @_); 1124} 1125 1126#4#cut 1127### deliver_sm_v4 (v4 6.4.5.1), p.38 1128### N.B v34 deliver is decoded as v34 submit 1129 1130sub decode_deliver_sm_v4 { 1131 my $pdu = shift; 1132 my $len = decode_source_and_destination($pdu, $pdu->{data}); 1133 1134 ### *** WARNING: if this section of code bombs you should 1135 ### check carefully that Z9 and Z17 are working correctly. 1136 ### Although the spec says that these are fixed length, one 1137 ### should not blindly take this for granted. If fixed length 1138 ### interpreatation is chosen then the $len has to be updated 1139 ### by the fixed length irrespective of what the C string 1140 ### length is. If however the variable length interpretation 1141 ### is chosen then Z* should be used to decode and C string 1142 ### length should be used to update the length. Using Z9 to 1143 ### decode but C string length to update $len is inconsistent 1144 ### although I believe it amounts to the variable length 1145 ### interpretation in the end. --Sampo 1146 1147 ($pdu->{msg_reference}) = unpack 'Z9', substr($pdu->{data}, $len); # Felix: its always fixed len 1148 $len += 9; 1149 #($pdu->{msg_reference}) = unpack 'Z*', substr($pdu->{data}, $len); 1150 #$len += length($pdu->{msg_reference}) + 1; 1151 1152 ($pdu->{message_class}, # 8 n 1153 $pdu->{telematic_interworking}, # 9 C 1154 $pdu->{priority_level}, # 10 C 1155 $pdu->{submit_time_stamp}) = unpack 'nCCZ17', substr($pdu->{data}, $len); # Felix: fixed len 1156 $len += 2 + 1 + 1 + 17; 1157 # $pdu->{submit_time_stamp}) = unpack 'nCCZ*', substr($pdu->{data}, $len); 1158 #$len += 2 + 1 + 1 + length($pdu->{submit_time_stamp}) + 1; 1159 1160 my $sm_length; 1161 ($pdu->{data_coding}, # 15 C 1162 $sm_length, # 17 n 1163 ) = unpack 'Cn', substr($pdu->{data}, $len); 1164 $len += 1 + 2; 1165 ($pdu->{short_message} 1166 ) = unpack "a$sm_length", substr($pdu->{data}, $len); 1167 $len += $sm_length; 1168 1169 $pdu->{esm_class} = $pdu->{message_class}; 1170 $pdu->{protocol_id} = $pdu->{telematic_interworking}; 1171 $pdu->{priority_flag} = $pdu->{priority_level}; 1172 $pdu->{schedule_delivery_time} = $pdu->{submit_time_stamp}; 1173 1174 return $len; 1175} 1176 1177sub encode_deliver_sm_v4 { 1178 my $me = $_[0]; 1179 my ($source_addr_ton, $source_addr_npi, $source_addr, 1180 $dest_addr_ton, $dest_addr_npi, $destination_addr, 1181 $msg_reference, $message_class, $telematic_interworking, $priority_level, 1182 $schedule_delivery_time, $data_coding, $short_message); 1183 1184 ### Extract mandatory parameters from argument stream 1185 1186 for (my $i=1; $i <= $#_; $i+=2) { 1187 next if !defined $_[$i]; 1188 if ($_[$i] eq 'source_addr_ton') { $source_addr_ton = splice @_,$i,2,undef,undef; } 1189 elsif ($_[$i] eq 'source_addr_npi') { $source_addr_npi = splice @_,$i,2,undef,undef; } 1190 elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; } 1191 elsif ($_[$i] eq 'dest_addr_ton') { $dest_addr_ton = splice @_,$i,2,undef,undef; } 1192 elsif ($_[$i] eq 'dest_addr_npi') { $dest_addr_npi = splice @_,$i,2,undef,undef; } 1193 elsif ($_[$i] eq 'destination_addr') { $destination_addr = splice @_,$i,2,undef,undef; } 1194 elsif ($_[$i] eq 'msg_reference') { $msg_reference = splice @_,$i,2,undef,undef; } 1195 elsif ($_[$i] eq 'message_class') { $message_class = splice @_,$i,2,undef,undef; } 1196 elsif ($_[$i] eq 'esm_class') { $message_class = splice @_,$i,2,undef,undef; } # v34 1197 elsif ($_[$i] eq 'telematic_interworking') { $telematic_interworking = splice @_,$i,2,undef,undef; } 1198 elsif ($_[$i] eq 'protocol_id') { $telematic_interworking = splice @_,$i,2,undef,undef; } # v34 1199 elsif ($_[$i] eq 'priority_level') { $priority_level = splice @_,$i,2,undef,undef; } 1200 elsif ($_[$i] eq 'priority_flag') { $priority_level = splice @_,$i,2,undef,undef; } # v34 1201 elsif ($_[$i] eq 'schedule_delivery_time') { $schedule_delivery_time = splice @_,$i,2,undef,undef; } 1202 elsif ($_[$i] eq 'data_coding') { $data_coding = splice @_,$i,2,undef,undef; } 1203 elsif ($_[$i] eq 'short_message') { $short_message = splice @_,$i,2,undef,undef; } 1204 } 1205 1206 ### Apply defaults for those mandatory arguments that were not specified 1207 1208 $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton; 1209 $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi; 1210 $source_addr = ${*$me}{source_addr} if !defined $source_addr; 1211 $dest_addr_ton = ${*$me}{dest_addr_ton} if !defined $dest_addr_ton; 1212 $dest_addr_npi = ${*$me}{dest_addr_npi} if !defined $dest_addr_npi; 1213 die "Must supply destination_addr to deliver_sm v4" if !defined $destination_addr; 1214 $msg_reference = ${*$me}{msg_reference} if !defined $msg_reference; 1215 $message_class = ${*$me}{message_class} if !defined $message_class; 1216 $telematic_interworking = ${*$me}{telematic_interworking} if !defined $telematic_interworking; 1217 $priority_level = ${*$me}{priority_level} if !defined $priority_level; 1218 $schedule_delivery_time = ${*$me}{schedule_delivery_time} if !defined $schedule_delivery_time; 1219 $data_coding = ${*$me}{data_coding} if !defined $data_coding; 1220 $short_message = '' if !defined $short_message; 1221 1222 return pack('CCZ*CCZ*Z*nCCZ*Cna*', 1223 $source_addr_ton, $source_addr_npi, $source_addr, 1224 $dest_addr_ton, $dest_addr_npi, $destination_addr, 1225 $msg_reference, $message_class, $telematic_interworking, $priority_level, 1226 $schedule_delivery_time, $data_coding, length($short_message),$short_message, ); 1227} 1228#4#end 1229 1230sub deliver_sm { 1231 my $me = $_[0]; 1232 # N.B. deliver_sm v34 == submit_sm v34 1233 return $me->req_backend(CMD_deliver_sm, #4 1234 (${*$me}{smpp_version} == 0x40) #4 1235 ? &encode_deliver_sm_v4 : &encode_submit_v34, #4 1236 @_); #4 1237 return $me->req_backend(CMD_deliver_sm, &encode_submit_v34, @_); 1238} 1239 1240### 1241 1242sub decode_submit_resp_v34 { 1243 my $pdu = shift; 1244 ($pdu->{message_id}) = unpack 'Z*', $pdu->{data}; 1245 return length($pdu->{message_id}) + 1; 1246} 1247 1248sub encode_submit_resp_v34 { 1249 my $me = $_[0]; 1250 my ($message_id); 1251 1252 for (my $i=1; $i <= $#_; $i+=2) { 1253 next if !defined $_[$i]; 1254 if ($_[$i] eq 'message_id') { $message_id = splice @_,$i,2,undef,undef; } 1255 } 1256 warn "message_id=$message_id" if $trace; 1257 croak "message_id must be supplied" if !defined $message_id; 1258 return pack('Z*', $message_id); 1259} 1260 1261sub submit_sm_resp { 1262 my $me = $_[0]; 1263 1264 # N.B. submit_sm_resp v4 == submit_multi_resp v34 #4 1265 # data_sm_resp v34 == submit_sm_resp v34 1266 return $me->resp_backend(CMD_submit_sm_resp, #4 1267 (${*$me}{smpp_version} == 0x40) #4 1268 ? &encode_submit_sm_resp_v4 #4 1269 : &encode_submit_resp_v34, #4 1270 @_); #4 1271 return $me->resp_backend(CMD_submit_sm_resp, &encode_submit_resp_v34, @_); 1272} 1273sub data_sm_resp { $_[0]->resp_backend(CMD_data_sm_resp, &encode_submit_resp_v34, @_) } # pubAPI 1274 1275sub deliver_sm_resp { # public API 1276 my $me = $_[0]; 1277 # N.B. submit_sm_resp v34 == deliver_sm_resp v34 1278 return $me->resp_backend(CMD_deliver_sm_resp, #4 1279 (${*$me}{smpp_version} == 0x40) #4 1280 ? '' # v4 deliver_resp is empty v4 6.4.5.2, p.40 #4 1281 : &encode_submit_resp_v34, #4 1282 @_); #4 1283 return $me->resp_backend(CMD_deliver_sm_resp, &encode_submit_resp_v34, @_); 1284} 1285 1286### submit_multi (4.5.1), p.59 1287 1288sub decode_submit_multi { 1289 my $pdu = shift; 1290 ($pdu->{service_type}) = unpack 'Z*', $pdu->{data}; 1291 my $len = length($pdu->{service_type}) + 1; 1292 1293 $len += decode_source_addr($pdu, substr($pdu->{data}, $len)); 1294 1295 ($pdu->{number_of_dests}) = unpack 'C', substr($pdu->{data}, $len); 1296 $len += 1; 1297 1298 ### To make life difficult, the multi destination addresses 1299 ### are a hotch potch of variable length, variable type 1300 ### records. Only way to do it is to walk the list. 1301 1302 for (my $i = 0; $i < $pdu->{number_of_dests}; $i++) { 1303 ($pdu->{dest_flag}[$i]) = unpack 'C', substr($pdu->{data}, $len++); 1304 if ($pdu->{dest_flag}[$i] == MULTIDESTFLAG_SME_Address) { 1305 ($pdu->{dest_addr_ton}[$i], 1306 $pdu->{dest_addr_npi}[$i], 1307 $pdu->{destination_addr}[$i]) 1308 = unpack 'CCZ*', substr($pdu->{data}, $len); 1309 $len += 1 + 1 + length($pdu->{destination_addr}[$i]) + 1; 1310 } elsif ($pdu->{dest_flag}[$i] == MULTIDESTFLAG_dist_list) { 1311 $pdu->{dest_addr_ton}[$i] = 0; 1312 $pdu->{dest_addr_npi}[$i] = 0; 1313 ($pdu->{destination_addr}[$i]) 1314 = unpack 'Z*', substr($pdu->{data}, $len); 1315 $len += length($pdu->{destination_addr}[$i]) + 1; 1316 } else { 1317 warn "Unknown multidest flag: $pdu->{dest_flag} (4.5.1.1, p. 75)"; 1318 } 1319 } 1320 1321 ### Now that we skipped over the variable length destinations 1322 ### we are ready to decode the rest of the packet. 1323 1324 ($pdu->{esm_class}, # 8 1325 $pdu->{protocol_id}, # 9 1326 $pdu->{priority_flag}, # 10 1327 $pdu->{schedule_delivery_time}) = unpack 'CCCZ*', substr($pdu->{data}, $len); 1328 $len += 1 + 1 + 1 + length($pdu->{schedule_delivery_time}) + 1; 1329 1330 ($pdu->{validity_period}) = unpack 'Z*', substr($pdu->{data}, $len); 1331 $len += length($pdu->{validity_period}) + 1; 1332 1333 my $sm_length; 1334 ($pdu->{registered_delivery}, # 13 1335 $pdu->{replace_if_present_flag}, # 14 1336 $pdu->{data_coding}, # 15 1337 $pdu->{sm_default_msg_id}, # 16 1338 $sm_length, # 17 1339# 1 1340# 8901234567 8 1341 ) = unpack 'CCCCC', substr($pdu->{data}, $len); 1342 $len += 1 + 1 + 1 + 1 + 1; 1343 ($pdu->{short_message} # 18 1344 ) = unpack "a$sm_length", substr($pdu->{data}, $len); 1345 1346 return $len + $sm_length; 1347} 1348 1349sub encode_submit_multi { 1350 my $me = $_[0]; 1351 my ($service_type, $source_addr_ton, $source_addr_npi, $source_addr, 1352 @dest_flag, @dest_addr_ton, @dest_addr_npi, @destination_addr, 1353 $esm_class, $protocol_id, $priority_flag, 1354 $schedule_delivery_time, $validity_period, 1355 $registered_delivery, $replace_if_present_flag, $data_coding, 1356 $sm_default_msg_id, $short_message, $addr_data); 1357 1358 ### Extract mandatory parameters from argument stream 1359 1360 for (my $i=1; $i <= $#_; $i+=2) { 1361 next if !defined $_[$i]; 1362 if ($_[$i] eq 'service_type') { $service_type = splice @_,$i,2,undef,undef; } 1363 elsif ($_[$i] eq 'source_addr_ton') { $source_addr_ton = splice @_,$i,2,undef,undef; } 1364 elsif ($_[$i] eq 'source_addr_npi') { $source_addr_npi = splice @_,$i,2,undef,undef; } 1365 elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; } 1366 elsif ($_[$i] eq 'dest_flag') { 1367 @dest_flag = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)} 1368 : (scalar(splice @_,$i,2,undef,undef)); 1369 } 1370 elsif ($_[$i] eq 'dest_addr_ton') { 1371 @dest_addr_ton = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)} 1372 : (scalar(splice @_,$i,2,undef,undef)); 1373 } 1374 elsif ($_[$i] eq 'dest_addr_npi') { 1375 @dest_addr_npi = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)} 1376 : (scalar(splice @_,$i,2,undef,undef)); 1377 } 1378 elsif ($_[$i] eq 'destination_addr') { 1379 @destination_addr = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)} 1380 : (scalar(splice @_,$i,2,undef,undef)); 1381 } 1382 elsif ($_[$i] eq 'esm_class') { $esm_class = splice @_,$i,2,undef,undef; } 1383 elsif ($_[$i] eq 'protocol_id') { $protocol_id = splice @_,$i,2,undef,undef; } 1384 elsif ($_[$i] eq 'priority_flag') { $priority_flag = splice @_,$i,2,undef,undef; } 1385 elsif ($_[$i] eq 'schedule_delivery_time') { $schedule_delivery_time = splice @_,$i,2,undef,undef; } 1386 elsif ($_[$i] eq 'validity_period') { $validity_period = splice @_,$i,2,undef,undef; } 1387 elsif ($_[$i] eq 'registered_delivery') { $registered_delivery = splice @_,$i,2,undef,undef; } 1388 elsif ($_[$i] eq 'replace_if_present_flag') { $replace_if_present_flag = splice @_,$i,2,undef,undef; } 1389 elsif ($_[$i] eq 'data_coding') { $data_coding = splice @_,$i,2,undef,undef; } 1390 elsif ($_[$i] eq 'sm_default_msg_id') { $sm_default_msg_id = splice @_,$i,2,undef,undef; } 1391 elsif ($_[$i] eq 'short_message') { $short_message = splice @_,$i,2,undef,undef; } 1392 } 1393 1394 ### Apply defaults for those mandatory arguments that were not specified 1395 1396 $service_type = ${*$me}{service_type} if !defined $service_type; 1397 $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton; 1398 $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi; 1399 $source_addr = ${*$me}{source_addr} if !defined $source_addr; 1400 croak "Must supply destination_addr to submit_multi" if !@destination_addr; 1401 $esm_class = ${*$me}{esm_class} if !defined $esm_class; 1402 $protocol_id = ${*$me}{protocol_id} if !defined $protocol_id; 1403 $priority_flag = ${*$me}{priority_flag} if !defined $priority_flag; 1404 $schedule_delivery_time = ${*$me}{schedule_delivery_time} if !defined $schedule_delivery_time; 1405 $validity_period = ${*$me}{validity_period} if !defined $validity_period; 1406 $registered_delivery = ${*$me}{registered_delivery} if !defined $registered_delivery; 1407 $replace_if_present_flag = ${*$me}{replace_if_present_flag} if !defined $replace_if_present_flag; 1408 $data_coding = ${*$me}{data_coding} if !defined $data_coding; 1409 $sm_default_msg_id = ${*$me}{sm_default_msg_id} if !defined $sm_default_msg_id; 1410 $short_message = '' if !defined $short_message; 1411 1412 ### destination address encoding is pretty messy with variable 1413 ### number of variable length variable type records. 1414 1415 for (my $i = 0; $i <= $#destination_addr; $i++) { 1416 if (!defined($dest_flag[$i]) 1417 || $dest_flag[$i] == MULTIDESTFLAG_SME_Address) { 1418 my $ton = !defined($dest_addr_ton[$i]) ? ${*$me}{dest_addr_ton} : $dest_addr_ton[$i]; 1419 my $npi = !defined($dest_addr_npi[$i]) ? ${*$me}{dest_addr_npi} : $dest_addr_npi[$i]; 1420 $addr_data .= pack 'CCCZ*', MULTIDESTFLAG_SME_Address, $ton, $npi, $destination_addr[$i]; 1421 } elsif ($dest_flag[$i] == MULTIDESTFLAG_dist_list) { 1422 $addr_data .= pack 'CZ*', MULTIDESTFLAG_dist_list, $destination_addr[$i]; 1423 } else { 1424 warn "Unknown dest_flag: $dest_flag[$i] (4.5.1, p. 70)"; 1425 } 1426 } 1427 1428 return pack('Z*CCZ*C', 1429 $service_type, $source_addr_ton, $source_addr_npi, $source_addr, 1430 scalar(@destination_addr)) . $addr_data 1431 . pack('CCCZ*Z*CCCCCa*', 1432 $esm_class, $protocol_id, $priority_flag, 1433 $schedule_delivery_time, $validity_period, 1434 $registered_delivery, $replace_if_present_flag, $data_coding, 1435 $sm_default_msg_id, length($short_message), $short_message, ); 1436} 1437 1438sub submit_multi { $_[0]->req_backend(CMD_submit_multi, &encode_submit_multi, @_) } # public API 1439 1440#4#cut 1441 1442sub decode_submit_sm_resp_v4 { 1443 my $pdu = shift; 1444 ($pdu->{message_id}) = unpack 'Z*', $pdu->{data}; 1445 my $len = length($pdu->{message_id}) + 1; 1446 ($pdu->{no_unsuccess}) = unpack 'n', substr($pdu->{data}, $len); 1447 $pdu->{num_unsuccess} = $pdu->{no_unsuccess}; # Compat 1448 $len += 2; 1449 1450 ### process the unsuccess_sme(s) field into meaningful arrays 1451 1452 for (my $i = 0; $i < $pdu->{no_unsuccess}; $i++) { 1453 ($pdu->{dest_addr_ton}[$i], $pdu->{dest_addr_npi}[$i], 1454 $pdu->{destination_addr}[$i]) = unpack 'CCZ*', substr($pdu->{data}, $len); 1455 $len += 1 + 1 + length($pdu->{destination_addr}[$i]) + 1; 1456 ($pdu->{error_status_code}[$i]) = unpack 'N', substr($pdu->{data}, $len); 1457 $len += 4; 1458 } 1459 1460 return $len; 1461} 1462#4#end 1463 1464sub decode_submit_multi_resp { 1465 my $pdu = shift; 1466 ($pdu->{message_id}) = unpack 'Z*', $pdu->{data}; 1467 my $len = length($pdu->{message_id}) + 1; 1468 ($pdu->{no_unsuccess}) = unpack 'C', substr($pdu->{data}, $len); 1469 $pdu->{num_unsuccess} = $pdu->{no_unsuccess}; # Compat 1470 $len += 1; 1471 1472 ### process the unsuccess_sme(s) field into meaningful arrays 1473 1474 for (my $i = 0; $i < $pdu->{no_unsuccess}; $i++) { 1475 ($pdu->{dest_addr_ton}[$i], $pdu->{dest_addr_npi}[$i], 1476 $pdu->{destination_addr}[$i]) = unpack 'CCZ*', substr($pdu->{data}, $len); 1477 $len += 1 + 1 + length($pdu->{destination_addr}[$i]) + 1; 1478 ($pdu->{error_status_code}[$i]) = unpack 'N', substr($pdu->{data}, $len); 1479 $len += 4; 1480 } 1481 1482 return $len; 1483} 1484 1485sub encode_submit_multi_resp { 1486 my $me = $_[0]; 1487 my ($message_id, @dest_addr_ton, @dest_addr_npi, @destination_addr, 1488 @error_status_code, $addr_data); 1489 1490 for (my $i=1; $i <= $#_; $i+=2) { 1491 next if !defined $_[$i]; 1492 if ($_[$i] eq 'message_id') { $message_id = splice @_,$i,2,undef,undef; } 1493 elsif ($_[$i] eq 'dest_addr_ton') { 1494 @dest_addr_ton = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)} 1495 : (scalar(splice @_,$i,2,undef,undef)); 1496 } 1497 elsif ($_[$i] eq 'dest_addr_npi') { 1498 @dest_addr_npi = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)} 1499 : (scalar(splice @_,$i,2,undef,undef)); 1500 } 1501 elsif ($_[$i] eq 'destination_addr') { 1502 @destination_addr = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)} 1503 : (scalar(splice @_,$i,2,undef,undef)); 1504 } 1505 elsif ($_[$i] eq 'error_status_code') { 1506 @error_status_code = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)} 1507 : (scalar(splice @_,$i,2,undef,undef)); 1508 } 1509 } 1510 1511 croak "message_id must be supplied" if !defined $message_id; 1512 #croak "destination_addr must be supplied" if !@destination_addr; 1513 croak "error_status_code must be supplied" if !@error_status_code; 1514 1515 for (my $i = 0; $i <= $#destination_addr; $i++) { 1516 my $ton = !defined($dest_addr_ton[$i]) ? ${*$me}{dest_addr_ton} : $dest_addr_ton[$i]; 1517 my $npi = !defined($dest_addr_npi[$i]) ? ${*$me}{dest_addr_npi} : $dest_addr_npi[$i]; 1518 $addr_data .= pack 'CCZ*N', $ton, $npi, $destination_addr[$i], $error_status_code[$i]; 1519 } 1520 1521 return pack('Z*C', $message_id, scalar(@destination_addr)) . $addr_data; 1522} 1523 1524#4#cut 1525sub encode_submit_sm_resp_v4 { 1526 my $me = $_[0]; 1527 my ($message_id, @dest_addr_ton, @dest_addr_npi, @destination_addr, 1528 @error_status_code); 1529 my $addr_data = ''; # May be empty if all addresses were successful 1530 1531 for (my $i=1; $i <= $#_; $i+=2) { 1532 next if !defined $_[$i]; 1533 if ($_[$i] eq 'message_id') { $message_id = splice @_,$i,2,undef,undef; } 1534 elsif ($_[$i] eq 'sc_msg_reference') { $message_id = splice @_,$i,2,undef,undef; } 1535 elsif ($_[$i] eq 'dest_addr_ton') { 1536 @dest_addr_ton = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)} 1537 : (scalar(splice @_,$i,2,undef,undef)); 1538 } 1539 elsif ($_[$i] eq 'dest_addr_npi') { 1540 @dest_addr_npi = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)} 1541 : (scalar(splice @_,$i,2,undef,undef)); 1542 } 1543 elsif ($_[$i] eq 'destination_addr') { 1544 @destination_addr = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)} 1545 : (scalar(splice @_,$i,2,undef,undef)); 1546 } 1547 elsif ($_[$i] eq 'error_status_code') { 1548 @error_status_code = ref($_[$i+1]) ? @{scalar(splice @_,$i,2,undef,undef)} 1549 : (scalar(splice @_,$i,2,undef,undef)); 1550 } 1551 } 1552 1553 croak "message_id must be supplied" if !defined $message_id; 1554 #croak "destination_addr must be supplied" if !@destination_addr; 1555 croak "error_status_code must be supplied" if !@error_status_code; 1556 1557 for (my $i = 0; $i <= $#destination_addr; $i++) { 1558 my $ton = !defined($dest_addr_ton[$i]) ? ${*$me}{dest_addr_ton} : $dest_addr_ton[$i]; 1559 my $npi = !defined($dest_addr_npi[$i]) ? ${*$me}{dest_addr_npi} : $dest_addr_npi[$i]; 1560 $addr_data .= pack 'CCZ*N', $ton, $npi, $destination_addr[$i], $error_status_code[$i]; 1561 } 1562 1563 return pack('Z*n', $message_id, scalar(@destination_addr)) . $addr_data; 1564} 1565#4#end 1566 1567sub submit_multi_resp { $_[0]->resp_backend(CMD_submit_multi_resp, &encode_submit_multi_resp, @_) } 1568 1569### query (4.8.1), p.95 1570 1571sub decode_query_v34 { 1572 my $pdu = shift; 1573 ($pdu->{message_id}) = unpack 'Z*', $pdu->{data}; 1574 my $len = length($pdu->{message_id}) + 1; 1575 $len += decode_source_addr($pdu, substr($pdu->{data}, $len)); 1576 return $len; 1577} 1578 1579#4#cut 1580sub decode_query_v4 { 1581 my $pdu = shift; 1582 ($pdu->{message_id}) = unpack 'Z*', $pdu->{data}; 1583 my $len = length($pdu->{message_id}) + 1; 1584 $len += decode_source_and_destination($pdu, substr($pdu->{data}, $len)); 1585 return $len; 1586} 1587#4#end 1588 1589sub encode_query_sm_v34 { 1590 my $me = $_[0]; 1591 my ($message_id, $source_addr_ton, $source_addr_npi, $source_addr); 1592 1593 ### Extract mandatory parameters from argument stream 1594 1595 for (my $i=1; $i <= $#_; $i+=2) { 1596 next if !defined $_[$i]; 1597 if ($_[$i] eq 'message_id') { $message_id = splice @_,$i,2,undef,undef; } 1598 elsif ($_[$i] eq 'source_addr_ton') { $source_addr_ton = splice @_,$i,2,undef,undef; } 1599 elsif ($_[$i] eq 'source_addr_npi') { $source_addr_npi = splice @_,$i,2,undef,undef; } 1600 elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; } 1601 } 1602 1603 ### Apply defaults for those mandatory arguments that were not specified 1604 1605 croak "Must supply message_id to query_sm" if !defined $message_id; 1606 $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton; 1607 $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi; 1608 $source_addr = ${*$me}{source_addr} if !defined $source_addr; 1609 1610 return pack('Z*CCZ*', $message_id, $source_addr_ton, $source_addr_npi, $source_addr); 1611} 1612 1613#4#cut 1614sub encode_query_sm_v4 { 1615 my $me = $_[0]; 1616 my ($message_id, $source_addr_ton, $source_addr_npi, $source_addr, 1617 $dest_addr_ton, $dest_addr_npi, $destination_addr); 1618 1619 ### Extract mandatory parameters from argument stream 1620 1621 for (my $i=1; $i <= $#_; $i+=2) { 1622 next if !defined $_[$i]; 1623 if ($_[$i] eq 'message_id') { $message_id = splice @_,$i,2,undef,undef; } 1624 elsif ($_[$i] eq 'source_addr_ton') { $source_addr_ton = splice @_,$i,2,undef,undef; } 1625 elsif ($_[$i] eq 'source_addr_npi') { $source_addr_npi = splice @_,$i,2,undef,undef; } 1626 elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; } 1627 elsif ($_[$i] eq 'dest_addr_ton') { $dest_addr_ton = splice @_,$i,2,undef,undef; } 1628 elsif ($_[$i] eq 'dest_addr_npi') { $dest_addr_npi = splice @_,$i,2,undef,undef; } 1629 elsif ($_[$i] eq 'destination_addr') { $destination_addr = splice @_,$i,2,undef,undef; } 1630 } 1631 1632 ### Apply defaults for those mandatory arguments that were not specified 1633 1634 croak "Must supply message_id to query_sm" if !defined $message_id; 1635 1636 $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton; 1637 $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi; 1638 $source_addr = ${*$me}{source_addr} if !defined $source_addr; 1639 1640 $dest_addr_ton = ${*$me}{dest_addr_ton} if !defined $dest_addr_ton; 1641 $dest_addr_npi = ${*$me}{dest_addr_npi} if !defined $dest_addr_npi; 1642 $destination_addr = ${*$me}{destination_addr} if !defined $destination_addr; 1643 1644 return pack('Z*CCZ*CCZ*', 1645 $message_id, $source_addr_ton, $source_addr_npi, $source_addr, 1646 $dest_addr_ton, $dest_addr_npi, $destination_addr); 1647} 1648#4#end 1649 1650sub query_sm { 1651 my $me = $_[0]; 1652 return $me->req_backend(CMD_query_sm, ${*$me}{smpp_version} == 0x40 #4 1653 ? &encode_query_sm_v4 : &encode_query_sm_v34, @_); #4 1654 return $me->req_backend(CMD_query_sm, &encode_query_sm_v34, @_); 1655} 1656 1657sub decode_query_resp_v34 { 1658 my $pdu = shift; 1659 ($pdu->{message_id}) = unpack 'Z*', $pdu->{data}; 1660 my $len = length($pdu->{message_id}) + 1; 1661 1662 ($pdu->{final_date}) = unpack 'Z*', substr($pdu->{data}, $len); 1663 $len += length($pdu->{final_date}) + 1; 1664 1665 ($pdu->{message_state}, $pdu->{error_code}) = unpack 'CC', substr($pdu->{data}, $len); 1666 return $len + 1 + 1; 1667} 1668 1669#4#cut 1670sub decode_query_resp_v4 { 1671 my $pdu = shift; 1672 ($pdu->{sc_msg_reference}) = unpack 'Z*', $pdu->{data}; 1673 my $len = length($pdu->{sc_msg_reference}) + 1; 1674 1675 ($pdu->{final_date}) = unpack 'Z*', substr($pdu->{data}, $len); 1676 $len += length($pdu->{final_date}) + 1; 1677 1678 ($pdu->{message_status}, $pdu->{network_error_code}) = unpack 'CN', substr($pdu->{data}, $len); 1679 1680 $pdu->{message_id} = $pdu->{sc_msg_reference}; # v34 compat 1681 $pdu->{message_state} = $pdu->{message_status}; # v34 compat 1682 $pdu->{error_code} = $pdu->{network_error_code}; # v34 compat 1683 return $len + 1 + 4; 1684} 1685#4#end 1686 1687sub encode_query_sm_resp_v34 { 1688 my $me = $_[0]; 1689 my ($message_id, $final_date, $message_state, $error_code); 1690 $message_id = '2'; 1691 1692 for (my $i=1; $i < $#_; $i+=2) { 1693 next if !defined $_[$i]; 1694 if ($_[$i] eq 'message_id') { $message_id = splice @_,$i,2,undef,undef; } 1695 elsif ($_[$i] eq 'final_date') { $final_date = splice @_,$i,2,undef,undef; } 1696 elsif ($_[$i] eq 'message_state') { $message_state = splice @_,$i,2,undef,undef; } 1697 elsif ($_[$i] eq 'error_code') { $error_code = splice @_,$i,2,undef,undef; } 1698 } 1699 1700 croak "message_id must be supplied" if !defined $message_id; 1701 $final_date = ${*$me}{final_date} if !defined $final_date; 1702 croak "message_state must be supplied" if !defined $message_state; 1703 $error_code = ${*$me}{error_code} if !defined $error_code; 1704 return pack('Z*Z*CC', $message_id, $final_date, $message_state, $error_code); 1705} 1706 1707#4#cut 1708sub encode_query_sm_resp_v4 { 1709 my $me = $_[0]; 1710 my ($sc_msg_reference, $final_date, $message_status, $network_error_code); 1711 1712 for (my $i=1; $i <= $#_; $i+=2) { 1713 next if !defined $_[$i]; 1714 if ($_[$i] eq 'sc_msg_reference') { $sc_msg_reference = splice @_,$i,2,undef,undef; } 1715 elsif ($_[$i] eq 'message_id') { $sc_msg_reference = splice @_,$i,2,undef,undef; } # v34 1716 elsif ($_[$i] eq 'final_date') { $final_date = splice @_,$i,2,undef,undef; } 1717 elsif ($_[$i] eq 'message_status') { $message_status = splice @_,$i,2,undef,undef; } 1718 elsif ($_[$i] eq 'message_state') { $message_status = splice @_,$i,2,undef,undef; } # v34 1719 elsif ($_[$i] eq 'networkerror_code') { $network_error_code = splice @_,$i,2,undef,undef; } 1720 elsif ($_[$i] eq 'error_code') { $network_error_code = splice @_,$i,2,undef,undef; } # v34 1721 } 1722 1723 croak "sc_msg_reference or message_id must be supplied" if !defined $sc_msg_reference; 1724 $final_date = ${*$me}{final_date} if !defined $final_date; 1725 croak "message_status or message_state must be supplied" if !defined $message_status; 1726 $network_error_code = ${*$me}{network_error_code} if !defined $network_error_code; 1727 return pack('Z*Z*CN', $sc_msg_reference, $final_date, $message_status, $network_error_code); 1728} 1729#4#end 1730 1731sub query_sm_resp { 1732 my $me = $_[0]; 1733 return $me->resp_backend(CMD_query_sm_resp, ${*$me}{smpp_version} == 0x40 #4 1734 ? &encode_query_sm_resp_v4 : &encode_query_sm_resp_v34, @_); #4 1735 return $me->resp_backend(CMD_query_sm_resp, &encode_query_sm_resp_v34, @_); 1736} 1737 1738### alert_notification (4.12.1), p.108 1739 1740sub decode_alert_notification { 1741 my $pdu = shift; 1742 my $len = decode_source_addr($pdu, $pdu->{data}); 1743 1744 ($pdu->{esme_addr_ton}, # 4 1745 $pdu->{esme_addr_npi}, # 5 1746 $pdu->{esme_addr}) = unpack 'CCZ*', substr($pdu->{data}, $len); 1747 1748 return $len + 1 + 1 + length($pdu->{esme_addr}) + 1; 1749} 1750 1751sub encode_alert_notification { 1752 my $me = $_[0]; 1753 my ($source_addr_ton, $source_addr_npi, $source_addr, 1754 $esme_addr_ton, $esme_addr_npi, $esme_addr); 1755 1756 ### Extract mandatory parameters from argument stream 1757 1758 for (my $i=1; $i <= $#_; $i+=2) { 1759 next if !defined $_[$i]; 1760 if ($_[$i] eq 'source_addr_ton') { $source_addr_ton = splice @_,$i,2,undef,undef; } 1761 elsif ($_[$i] eq 'source_addr_npi') { $source_addr_npi = splice @_,$i,2,undef,undef; } 1762 elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; } 1763 elsif ($_[$i] eq 'esme_addr_ton') { $esme_addr_ton = splice @_,$i,2,undef,undef; } 1764 elsif ($_[$i] eq 'esme_addr_npi') { $esme_addr_npi = splice @_,$i,2,undef,undef; } 1765 elsif ($_[$i] eq 'esme_addr') { $esme_addr = splice @_,$i,2,undef,undef; } 1766 } 1767 1768 ### Apply defaults for those mandatory arguments that were not specified 1769 1770 $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton; 1771 $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi; 1772 $source_addr = ${*$me}{source_addr} if !defined $source_addr; 1773 $esme_addr_ton = ${*$me}{esme_addr_ton} if !defined $esme_addr_ton; 1774 $esme_addr_npi = ${*$me}{esme_addr_npi} if !defined $esme_addr_npi; 1775 croak "Must supply esme_addr to alert_notification" if !defined $esme_addr; 1776 1777 return pack('CCZ*CCZ*', 1778 $source_addr_ton, $source_addr_npi, $source_addr, 1779 $esme_addr_ton, $esme_addr_npi, $esme_addr, ); 1780} 1781 1782sub alert_notification { $_[0]->req_backend(CMD_alert_notification, 1783 &encode_alert_notification, @_) } 1784 1785### replace (4.10.1), p.102 1786 1787sub decode_replace_sm_v34 { 1788 my $pdu = shift; 1789 ($pdu->{message_id}) = unpack 'Z*', $pdu->{data}; 1790 my $len = length($pdu->{message_id}) + 1; 1791 $len += decode_source_addr($pdu, substr($pdu->{data}, $len)); 1792 1793 ($pdu->{schedule_delivery_time}) = unpack 'Z*', substr($pdu->{data}, $len); 1794 $len += length($pdu->{schedule_delivery_time}) + 1; 1795 1796 ($pdu->{validity_period}) = unpack 'Z*', substr($pdu->{data}, $len); 1797 $len += length($pdu->{validity_period}) + 1; 1798 1799 my $sm_length; 1800 ($pdu->{registered_delivery}, # 7 1801 $pdu->{sm_default_msg_id}, # 8 1802 $sm_length, # 9 1803# 123456789 0 1804 ) = unpack 'CCC', substr($pdu->{data}, $len); 1805 $len += 1 + 1 + 1; 1806 ($pdu->{short_message} # 10 1807 ) = unpack "a$sm_length", substr($pdu->{data}, $len); 1808 1809 return $len + $sm_length; 1810} 1811 1812#4#cut 1813sub decode_replace_sm_v4 { 1814 my $pdu = shift; 1815 ($pdu->{msg_reference}) = unpack 'Z*', $pdu->{data}; 1816 my $len = length($pdu->{msg_reference}) + 1; 1817 $len += decode_source_and_destination($pdu, substr($pdu->{data}, $len)); 1818 1819 ($pdu->{schedule_delivery_time}, # Z 1820 ) = unpack 'Z*', substr($pdu->{data}, $len); 1821 $len += length($pdu->{schedule_delivery_time}) + 1; 1822 1823 my $sm_length; 1824 ($pdu->{validity_period}, # 6 n 1825 $pdu->{registered_delivery_mode}, # C 1826 $pdu->{data_coding}, # 8 C 1827 $pdu->{sm_default_msg_id}, # 8 C 1828 $sm_length, # 9 n 1829 ) = unpack 'nCCCn', substr($pdu->{data}, $len); 1830 $len += 2 + 1 + 1 + 1 + 2; 1831 ($pdu->{short_message} # 10 a 1832 ) = unpack "a$sm_length", substr($pdu->{data}, $len); 1833 1834 $pdu->{message_id} = $pdu->{msg_reference}; # v34 compat 1835 $pdu->{registered_delivery} = $pdu->{registered_delivery_mode}; # v34 compat 1836 1837 return $len + $sm_length; 1838} 1839#4#end 1840 1841sub encode_replace_sm_v34 { 1842 my $me = $_[0]; 1843 my ($message_id, $source_addr_ton, $source_addr_npi, $source_addr, 1844 $schedule_delivery_time, $validity_period, 1845 $registered_delivery, $sm_default_msg_id, $short_message); 1846 1847 ### Extract mandatory parameters from argument stream 1848 1849 for (my $i=1; $i <= $#_; $i+=2) { 1850 next if !defined $_[$i]; 1851 if ($_[$i] eq 'message_id') { $message_id = splice @_,$i,2,undef,undef; } 1852 elsif ($_[$i] eq 'source_addr_ton') { $source_addr_ton = splice @_,$i,2,undef,undef; } 1853 elsif ($_[$i] eq 'source_addr_npi') { $source_addr_npi = splice @_,$i,2,undef,undef; } 1854 elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; } 1855 elsif ($_[$i] eq 'schedule_delivery_time') { $schedule_delivery_time = splice @_,$i,2,undef,undef; } 1856 elsif ($_[$i] eq 'validity_period') { $validity_period = splice @_,$i,2,undef,undef; } 1857 elsif ($_[$i] eq 'registered_delivery') { $registered_delivery = splice @_,$i,2,undef,undef; } 1858 elsif ($_[$i] eq 'sm_default_msg_id') { $sm_default_msg_id = splice @_,$i,2,undef,undef; } 1859 elsif ($_[$i] eq 'short_message') { $short_message = splice @_,$i,2,undef,undef; } 1860 } 1861 1862 ### Apply defaults for those mandatory arguments that were not specified 1863 1864 croak "Must supply message_id to replace_sm" if !defined $message_id; 1865 $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton; 1866 $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi; 1867 $source_addr = ${*$me}{source_addr} if !defined $source_addr; 1868 $schedule_delivery_time = ${*$me}{schedule_delivery_time} if !defined $schedule_delivery_time; 1869 $validity_period = ${*$me}{validity_period} if !defined $validity_period; 1870 $registered_delivery = ${*$me}{registered_delivery} if !defined $registered_delivery; 1871 $sm_default_msg_id = ${*$me}{sm_default_msg_id} if !defined $sm_default_msg_id; 1872 $short_message = ${*$me}{short_message} if !defined $short_message; 1873 1874 return pack('Z*CCZ*Z*Z*CCCa*', 1875 $message_id, $source_addr_ton, $source_addr_npi, $source_addr, 1876 $schedule_delivery_time, $validity_period, 1877 $registered_delivery, $sm_default_msg_id, length($short_message), $short_message, ); 1878} 1879 1880#4#cut 1881sub encode_replace_sm_v4 { 1882 my $me = $_[0]; 1883 my ($msg_reference, $source_addr_ton, $source_addr_npi, $source_addr, 1884 $dest_addr_ton, $dest_addr_npi, $destination_addr, 1885 $schedule_delivery_time, $validity_period, 1886 $registered_delivery_mode, $data_coding, $sm_default_msg_id, $short_message); 1887 1888 ### Extract mandatory parameters from argument stream 1889 1890 for (my $i=1; $i <= $#_; $i+=2) { 1891 next if !defined $_[$i]; 1892 if ($_[$i] eq 'msg_reference') { $msg_reference = splice @_,$i,2,undef,undef; } 1893 elsif ($_[$i] eq 'message_id') { $msg_reference = splice @_,$i,2,undef,undef; } # v34 1894 elsif ($_[$i] eq 'source_addr_ton') { $source_addr_ton = splice @_,$i,2,undef,undef; } 1895 elsif ($_[$i] eq 'source_addr_npi') { $source_addr_npi = splice @_,$i,2,undef,undef; } 1896 elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; } 1897 elsif ($_[$i] eq 'dest_addr_ton') { $dest_addr_ton = splice @_,$i,2,undef,undef; } 1898 elsif ($_[$i] eq 'dest_addr_npi') { $dest_addr_npi = splice @_,$i,2,undef,undef; } 1899 elsif ($_[$i] eq 'destination_addr') { $destination_addr = splice @_,$i,2,undef,undef; } 1900 elsif ($_[$i] eq 'schedule_delivery_time') { $schedule_delivery_time = splice @_,$i,2,undef,undef; } 1901 elsif ($_[$i] eq 'validity_period') { $validity_period = splice @_,$i,2,undef,undef; } 1902 elsif ($_[$i] eq 'registered_delivery_mode') { $registered_delivery_mode = splice @_,$i,2,undef,undef; } 1903 elsif ($_[$i] eq 'registered_delivery') { $registered_delivery_mode = splice @_,$i,2,undef,undef; } # v34 1904 elsif ($_[$i] eq 'data_coding') { $data_coding = splice @_,$i,2,undef,undef; } 1905 elsif ($_[$i] eq 'sm_default_msg_id') { $sm_default_msg_id = splice @_,$i,2,undef,undef; } 1906 elsif ($_[$i] eq 'short_message') { $short_message = splice @_,$i,2,undef,undef; } 1907 } 1908 1909 ### Apply defaults for those mandatory arguments that were not specified 1910 1911 croak "Must supply msg_reference or message_id to replace_sm" if !defined $msg_reference; 1912 $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton; 1913 $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi; 1914 $source_addr = ${*$me}{source_addr} if !defined $source_addr; 1915 $dest_addr_ton = ${*$me}{dest_addr_ton} if !defined $dest_addr_ton; 1916 $dest_addr_npi = ${*$me}{dest_addr_npi} if !defined $dest_addr_npi; 1917 $destination_addr = ${*$me}{destination_addr} if !defined $destination_addr; 1918 $schedule_delivery_time = ${*$me}{schedule_delivery_time} if !defined $schedule_delivery_time; 1919 $validity_period = ${*$me}{validity_period} if !defined $validity_period; 1920 $registered_delivery_mode = ${*$me}{registered_delivery_mode} if !defined $registered_delivery_mode; 1921 $data_coding = ${*$me}{data_coding} if !defined $data_coding; 1922 $sm_default_msg_id = ${*$me}{sm_default_msg_id} if !defined $sm_default_msg_id; 1923 $short_message = ${*$me}{short_message} if !defined $short_message; 1924 1925 return pack('Z*CCZ*CCZ*Z*nCCCna*', 1926 $msg_reference, $source_addr_ton, $source_addr_npi, $source_addr, 1927 $dest_addr_ton, $dest_addr_npi, $destination_addr, 1928 $schedule_delivery_time, $validity_period, 1929 $registered_delivery_mode, $data_coding, $sm_default_msg_id, length($short_message), $short_message, ); 1930} 1931#4#end 1932 1933sub replace_sm { 1934 my $me = $_[0]; 1935 return $me->req_backend(CMD_replace_sm, ${*$me}{smpp_version} == 0x40 #4 1936 ? &encode_replace_sm_v4 : &encode_replace_sm_v34, #4 1937 @_); #4 1938 return $me->req_backend(CMD_replace_sm, &encode_replace_sm_v34, @_); 1939} 1940 1941### cancel (4.9.1), p.98 1942 1943sub decode_cancel { 1944 my $pdu = shift; 1945 my $me = shift; 1946 my $len = 0; 1947 if (${*$me}{smpp_version}==0x40) { #4 1948 ($pdu->{service_type}) = unpack 'n', $pdu->{data}; #4 1949 $len += 2; #4 1950 } else { #4 1951 ($pdu->{service_type}) = unpack 'Z*', $pdu->{data}; 1952 $len += length($pdu->{service_type}) + 1; 1953 } #4 1954 ($pdu->{message_id}) = unpack 'Z*', substr($pdu->{data}, $len); 1955 $len += length($pdu->{message_id}) + 1; 1956 1957 $len += decode_source_and_destination($pdu, substr($pdu->{data}, $len)); 1958 1959 $pdu->{message_class} = $pdu->{service_type}; # v4 #4 1960 return $len; 1961} 1962 1963sub encode_cancel_sm { 1964 my $me = $_[0]; 1965 my ($service_type, $message_id, $source_addr_ton, $source_addr_npi, $source_addr, 1966 $dest_addr_ton, $dest_addr_npi, $destination_addr); 1967 1968 ### Extract mandatory parameters from argument stream 1969 1970 for (my $i=1; $i <= $#_; $i+=2) { 1971 next if !defined $_[$i]; 1972 if ($_[$i] eq 'service_type') { $service_type = splice @_,$i,2,undef,undef; } 1973 elsif ($_[$i] eq 'message_class') { $service_type = splice @_,$i,2,undef,undef; } # v4 #4 1974 elsif ($_[$i] eq 'message_id') { $message_id = splice @_,$i,2,undef,undef; } 1975 elsif ($_[$i] eq 'source_addr_ton') { $source_addr_ton = splice @_,$i,2,undef,undef; } 1976 elsif ($_[$i] eq 'source_addr_npi') { $source_addr_npi = splice @_,$i,2,undef,undef; } 1977 elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; } 1978 elsif ($_[$i] eq 'dest_addr_ton') { $dest_addr_ton = splice @_,$i,2,undef,undef; } 1979 elsif ($_[$i] eq 'dest_addr_npi') { $dest_addr_npi = splice @_,$i,2,undef,undef; } 1980 elsif ($_[$i] eq 'destination_addr') { $destination_addr = splice @_,$i,2,undef,undef; } 1981 } 1982 1983 ### Apply defaults for those mandatory arguments that were not specified 1984 1985 $service_type = ${*$me}{service_type} if !defined $service_type; 1986 $message_id = ${*$me}{message_id} if !defined $message_id; 1987 $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton; 1988 $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi; 1989 $source_addr = ${*$me}{source_addr} if !defined $source_addr; 1990 $dest_addr_ton = ${*$me}{dest_addr_ton} if !defined $dest_addr_ton; 1991 $dest_addr_npi = ${*$me}{dest_addr_npi} if !defined $dest_addr_npi; 1992 $destination_addr = ${*$me}{destination_addr} if !defined $destination_addr; 1993 1994 return pack(${*$me}{smpp_version}==0x40 ? 'nZ*CCZ*CCZ*' : 'Z*Z*CCZ*CCZ*', #4 1995 $service_type, $message_id, #4 1996 $source_addr_ton, $source_addr_npi, $source_addr, #4 1997 $dest_addr_ton, $dest_addr_npi, $destination_addr, ); #4 1998 return pack('Z*Z*CCZ*CCZ*', 1999 $service_type, $message_id, 2000 $source_addr_ton, $source_addr_npi, $source_addr, 2001 $dest_addr_ton, $dest_addr_npi, $destination_addr, ); 2002} 2003 2004sub cancel_sm { $_[0]->req_backend(CMD_cancel_sm, &encode_cancel_sm, @_) } # public API 2005 2006### data_sm (4.7.1), p.87 2007 2008sub decode_data_sm { 2009 my $pdu = shift; 2010 2011 ($pdu->{service_type}) = unpack 'Z*', $pdu->{data}; 2012 my $len = length($pdu->{service_type}) + 1; 2013 2014 $len += decode_source_and_destination($pdu, substr($pdu->{data}, $len)); 2015 2016 ($pdu->{esm_class}, # 8 2017 $pdu->{registered_delivery}, # 9 2018 $pdu->{data_coding}, # 10 2019# 890 2020 ) = unpack 'CCC', substr($pdu->{data}, $len); 2021 2022 return $len + 1 + 1 + 1; 2023} 2024 2025sub encode_data_sm { 2026 my $me = $_[0]; 2027 my ($service_type, $source_addr_ton, $source_addr_npi, $source_addr, 2028 $dest_addr_ton, $dest_addr_npi, $destination_addr, 2029 $esm_class, $registered_delivery, $data_coding); 2030 2031 ### Extract mandatory parameters from argument stream 2032 2033 for (my $i=1; $i <= $#_; $i+=2) { 2034 next if !defined $_[$i]; 2035 if ($_[$i] eq 'service_type') { $service_type = splice @_,$i,2,undef,undef; } 2036 elsif ($_[$i] eq 'source_addr_ton') { $source_addr_ton = splice @_,$i,2,undef,undef; } 2037 elsif ($_[$i] eq 'source_addr_npi') { $source_addr_npi = splice @_,$i,2,undef,undef; } 2038 elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; } 2039 elsif ($_[$i] eq 'dest_addr_ton') { $dest_addr_ton = splice @_,$i,2,undef,undef; } 2040 elsif ($_[$i] eq 'dest_addr_npi') { $dest_addr_npi = splice @_,$i,2,undef,undef; } 2041 elsif ($_[$i] eq 'destination_addr') { $destination_addr = splice @_,$i,2,undef,undef; } 2042 elsif ($_[$i] eq 'esm_class') { $esm_class = splice @_,$i,2,undef,undef; } 2043 elsif ($_[$i] eq 'registered_delivery') { $registered_delivery = splice @_,$i,2,undef,undef; } 2044 elsif ($_[$i] eq 'data_coding') { $data_coding = splice @_,$i,2,undef,undef; } 2045 } 2046 2047 ### Apply defaults for those mandatory arguments that were not specified 2048 2049 $service_type = ${*$me}{service_type} if !defined $service_type; 2050 $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton; 2051 $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi; 2052 $source_addr = ${*$me}{source_addr} if !defined $source_addr; 2053 $dest_addr_ton = ${*$me}{dest_addr_ton} if !defined $dest_addr_ton; 2054 $dest_addr_npi = ${*$me}{dest_addr_npi} if !defined $dest_addr_npi; 2055 2056 croak "Must supply destination_addr to data_sm" if !defined $destination_addr; 2057 2058 $esm_class = ${*$me}{esm_class} if !defined $esm_class; 2059 $registered_delivery = ${*$me}{registered_delivery} if !defined $registered_delivery; 2060 $data_coding = ${*$me}{data_coding} if !defined $data_coding; 2061 2062 return pack('Z*CCZ*CCZ*CCC', 2063 $service_type, $source_addr_ton, $source_addr_npi, $source_addr, 2064 $dest_addr_ton, $dest_addr_npi, $destination_addr, 2065 $esm_class, $registered_delivery, $data_coding, ); 2066} 2067 2068sub data_sm { $_[0]->req_backend(CMD_data_sm, &encode_data_sm, @_) } 2069 2070#4#cut 2071### delivery_receipt: v4 6.4.6.1, p.41 2072 2073sub decode_delivery_receipt { 2074 my $pdu = shift; 2075 my $len = decode_source_and_destination($pdu, $pdu->{data}); 2076 2077 ($pdu->{msg_reference}) = unpack 'Z*', substr($pdu->{data}, $len); 2078 $len += length($pdu->{msg_reference}) + 1; 2079 2080 ($pdu->{num_msgs_submitted}, # 9 N 2081 $pdu->{num_msgs_delivered}, # 10 N 2082 $pdu->{submit_date}, # 11 Z 2083 ) = unpack 'NNZ*', substr($pdu->{data}, $len); 2084 $len += 4 + 4 + length($pdu->{submit_date}) + 1; 2085 2086 ($pdu->{done_date}) = unpack 'Z*', substr($pdu->{data}, $len); 2087 $len += length($pdu->{done_date}) + 1; 2088 2089 my $sm_length; 2090 ($pdu->{message_state}, # 13 N 2091 $pdu->{network_error_code}, # 14 N 2092 $pdu->{data_coding}, # 15 C 2093 $sm_length, # 16 n 2094# 234567890123456 7 2095 ) = unpack 'NNCn', substr($pdu->{data}, $len); 2096 $len += 4 + 4 + 1 + 2; 2097 ($pdu->{short_message}, # 17 a 2098 ) = unpack "a$sm_length", substr($pdu->{data}, $len); 2099 return $len + $sm_length; 2100} 2101 2102sub encode_delivery_receipt { 2103 my $me = $_[0]; 2104 my ($source_addr_ton, $source_addr_npi, $source_addr, 2105 $dest_addr_ton, $dest_addr_npi, $destination_addr, 2106 $msg_reference, $num_msgs_submitted, $num_msgs_delivered, 2107 $submit_date, $done_date, $message_state, $network_error_code, 2108 $data_coding, $short_message); 2109 2110 ### Extract mandatory parameters from argument stream 2111 2112 for (my $i=1; $i <= $#_; $i+=2) { 2113 next if !defined $_[$i]; 2114 if ($_[$i] eq 'source_addr_ton') { $source_addr_ton = splice @_,$i,2,undef,undef; } 2115 elsif ($_[$i] eq 'source_addr_npi') { $source_addr_npi = splice @_,$i,2,undef,undef; } 2116 elsif ($_[$i] eq 'source_addr') { $source_addr = splice @_,$i,2,undef,undef; } 2117 elsif ($_[$i] eq 'dest_addr_ton') { $dest_addr_ton = splice @_,$i,2,undef,undef; } 2118 elsif ($_[$i] eq 'dest_addr_npi') { $dest_addr_npi = splice @_,$i,2,undef,undef; } 2119 elsif ($_[$i] eq 'destination_addr') { $destination_addr = splice @_,$i,2,undef,undef; } 2120 elsif ($_[$i] eq 'msg_reference') { $msg_reference = splice @_,$i,2,undef,undef; } 2121 elsif ($_[$i] eq 'num_msgs_submitted') { $num_msgs_submitted = splice @_,$i,2,undef,undef; } 2122 elsif ($_[$i] eq 'num_msgs_delivered') { $num_msgs_delivered = splice @_,$i,2,undef,undef; } 2123 elsif ($_[$i] eq 'submit_date') { $submit_date = splice @_,$i,2,undef,undef; } 2124 elsif ($_[$i] eq 'done_date') { $done_date = splice @_,$i,2,undef,undef; } 2125 elsif ($_[$i] eq 'message_state') { $message_state = splice @_,$i,2,undef,undef; } 2126 elsif ($_[$i] eq 'network_error_code') { $network_error_code = splice @_,$i,2,undef,undef; } 2127 elsif ($_[$i] eq 'data_coding') { $data_coding = splice @_,$i,2,undef,undef; } 2128 elsif ($_[$i] eq 'short_message') { $short_message = splice @_,$i,2,undef,undef; } 2129 } 2130 2131 ### Apply defaults for those mandatory arguments that were not specified 2132 2133 $source_addr_ton = ${*$me}{source_addr_ton} if !defined $source_addr_ton; 2134 $source_addr_npi = ${*$me}{source_addr_npi} if !defined $source_addr_npi; 2135 $source_addr = ${*$me}{source_addr} if !defined $source_addr; 2136 $dest_addr_ton = ${*$me}{dest_addr_ton} if !defined $dest_addr_ton; 2137 $dest_addr_npi = ${*$me}{dest_addr_npi} if !defined $dest_addr_npi; 2138 2139 croak "Must supply destination_addr to delivery_receipt" if !defined $destination_addr; 2140 2141 $msg_reference = ${*$me}{msg_reference} if !defined $msg_reference; 2142 $num_msgs_submitted = ${*$me}{num_msgs_submitted} if !defined $num_msgs_submitted; 2143 $num_msgs_delivered = ${*$me}{num_msgs_delivered} if !defined $num_msgs_delivered; 2144 $submit_date = ${*$me}{submit_date} if !defined $submit_date; 2145 $done_date = ${*$me}{done_date} if !defined $done_date; 2146 $message_state = ${*$me}{message_state} if !defined $message_state; 2147 $network_error_code = ${*$me}{network_error_code} if !defined $network_error_code; 2148 $data_coding = ${*$me}{data_coding} if !defined $data_coding; 2149 $short_message = ${*$me}{short_message} if !defined $short_message; 2150 2151 return pack('CCZ*CCZ*Z*NNZ*Z*NNCna*', 2152 $source_addr_ton, $source_addr_npi, $source_addr, 2153 $dest_addr_ton, $dest_addr_npi, $destination_addr, 2154 $msg_reference, $num_msgs_submitted, $num_msgs_delivered, 2155 $submit_date, $done_date, $message_state, 2156 $network_error_code, $data_coding, length($short_message), $short_message); 2157} 2158 2159sub delivery_receipt { $_[0]->req_backend(CMD_delivery_receipt, &encode_delivery_receipt, @_) } 2160#4#end 2161 2162### 2163 2164sub set_version { 2165 my $me = shift; 2166 my $version = shift; 2167 2168 if ($version == 0x40) { #4 2169 ${*$me}{smpp_version} = 0x40; #4 2170 ${*$me}{head_templ} = 'NNNNxxxx'; #4 2171 ${*$me}{head_len} = 20; #4 2172 ${*$me}{cmd_version} = 0x00010000; #4 2173 } else { #4 2174 ${*$me}{smpp_version} = $version; 2175 ${*$me}{head_templ} = 'NNNN'; 2176 ${*$me}{head_len} = 16; 2177 ${*$me}{cmd_version} = 0x00000000; 2178 } #4 2179} 2180 2181### Accept a new server child, i.e. accepted socket. This 2182### constructor gets called internally just after accept system 2183### call when listening socket does accept. See also "new_listen" 2184### which gets called when socket is created and put listening. 2185### DO NOT USE THIS CONSTRUCTOR FOR CLIENT SIDE CONNECTIONS. 2186### 2187### The way this code works is that somewhere deep in guts of 2188### IO::Socket module the constructor name is hardwired to 2189### "new" and there is no way to pass any arguments to this 2190### constructor, hence I have to copy the arguments from 2191### the parent when constructing. Let's hope this aspect 2192### of IO::Socket does not change. 2193 2194sub new { 2195 my $accept = shift; 2196 my $type = ref($accept) || $accept; 2197 my $me = gensym; 2198 for my $k (keys %{*$accept}) { 2199 ${*$me}{$k} = ${*$accept}{$k}; 2200 } 2201 return bless $me, $type; 2202} 2203 2204### Create client connection (do not use "new") 2205 2206sub new_connect { 2207 my $me = shift; 2208 my $type = ref($me) || $me; 2209 my $host = shift if @_ % 2; # host need not be tagged 2210 my %arg = @_; 2211 2212 my $s = $type->SUPER::new( 2213 PeerAddr => $host, 2214 PeerPort => exists $arg{port} ? $arg{port} : Default->{port}, 2215 LocalAddr => exists $arg{local_ip} ? $arg{local_ip} : Default->{local_ip}, 2216 Proto => 'tcp', 2217 Timeout => exists $arg{timeout} ? $arg{timeout} : Default->{timeout}, 2218 @_) # pass any extra args to constructor 2219 or return undef; 2220 2221 for my $a (keys %{&Default}) { 2222 ${*$s}{$a} = exists $arg{$a} ? $arg{$a} : Default->{$a}; 2223 } 2224 $s->set_version(${*$s}{smpp_version}); 2225 #warn Dumper $s; 2226 2227 $s->autoflush(1); 2228 #$s->debug(exists $arg{debug} ? $arg{debug} : undef); 2229 return $s; 2230} 2231 2232sub new_transceiver { 2233 my $type = shift; 2234 my $me = $type->new_connect(@_); 2235 return undef if !defined $me; 2236 warn "Connected, sending bind: ".Dumper($me) if $trace; 2237 my $resp = $me->bind_transceiver(); 2238 warn "Bound: ".Dumper($resp) if $trace; 2239 return ($me, $resp) if wantarray; 2240 return $me; 2241} 2242 2243sub new_transmitter { 2244 my $type = shift; 2245 my $me = $type->new_connect(@_); 2246 return undef if !defined $me; 2247 warn "Connected, sending bind: ".Dumper($me) if $trace; 2248 my $resp = $me->bind_transmitter(); 2249 warn "Bound: ".Dumper($resp) if $trace; 2250 return ($me, $resp) if wantarray; 2251 return $me; 2252} 2253 2254sub new_receiver { 2255 my $type = shift; 2256 my $me = $type->new_connect(@_); 2257 return undef if !defined $me; 2258 warn "Connected, sending bind: ".Dumper($me) if $trace; 2259 my $resp = $me->bind_receiver(); 2260 warn "Bound: ".Dumper($resp) if $trace; 2261 return ($me, $resp) if wantarray; 2262 return $me; 2263} 2264 2265### Create new server connection, i.e. listening socket. See 2266### also "new" which gets called when connection is accepted 2267### from the listening socket. 2268 2269sub new_listen { 2270 my $me = shift; 2271 my $type = ref($me) || $me; 2272 my $host = shift if @_ % 2; # host need not be tagged 2273 my %arg = @_; 2274 2275 my $s = $type->SUPER::new( 2276 LocalAddr => $host, 2277 LocalPort => exists $arg{port} ? $arg{port} : Default->{port}, 2278 Proto => 'tcp', 2279 ReuseAddr => 'true', 2280 Listen => exists $arg{listen} ? $arg{listen} : Default->{listen}, 2281 Timeout => exists $arg{timeout} ? $arg{timeout} : Default->{timeout}) 2282 or return undef; 2283 for my $a (keys %{&Default}) { 2284 ${*$s}{$a} = exists $arg{$a} ? $arg{$a} : Default->{$a}; 2285 } 2286 $s->set_version(${*$s}{smpp_version}); 2287 $s->sockopt(SO_REUSEADDR => 1); 2288 $s->autoflush(1); 2289 #$s->debug(exists $arg{debug} ? $arg{debug} : undef); 2290 return $s; 2291} 2292 2293### This table drives the decoding process 2294 2295use constant pdu_tab => { 2296 0x80000000 => { cmd => 'generic_nack', decode => \&decode_empty, }, # i 2297 0x00000001 => { cmd => 'bind_receiver', decode => \&decode_bind, }, # i 2298 0x80000001 => { cmd => 'bind_receiver_resp', decode => \&decode_bind_resp_v34, }, # i 2299 0x00000002 => { cmd => 'bind_transmitter', decode => \&decode_bind, }, # i 2300 0x80000002 => { cmd => 'bind_transmitter_resp', decode => \&decode_bind_resp_v34, }, # i 2301 0x00000003 => { cmd => 'query_sm', decode => \&decode_query_v34, }, # i 2302 0x80000003 => { cmd => 'query_sm_resp', decode => \&decode_query_resp_v34, }, # i 2303 0x00000004 => { cmd => 'submit_sm', decode => \&decode_submit_v34, }, # i 2304 0x80000004 => { cmd => 'submit_sm_resp', decode => \&decode_submit_resp_v34, }, # i 2305 0x00000005 => { cmd => 'deliver_sm', decode => \&decode_submit_v34, }, # i 2306 0x80000005 => { cmd => 'deliver_sm_resp', decode => \&decode_submit_resp_v34, }, # i 2307 0x00000006 => { cmd => 'unbind', decode => \&decode_empty, }, # i 2308 0x80000006 => { cmd => 'unbind_resp', decode => \&decode_empty, }, # i 2309 0x00000007 => { cmd => 'replace_sm', decode => \&decode_replace_sm_v34, }, # i 2310 0x80000007 => { cmd => 'replace_sm_resp', decode => \&decode_empty, }, # i 2311 0x00000008 => { cmd => 'cancel_sm', decode => \&decode_cancel, }, # i 2312 0x80000008 => { cmd => 'cancel_sm_resp', decode => \&decode_empty, }, # i 2313 0x00000009 => { cmd => 'bind_transceiver', decode => \&decode_bind, }, # i 2314 0x80000009 => { cmd => 'bind_transceiver_resp', decode => \&decode_bind_resp_v34, }, # i 2315 0x0000000b => { cmd => 'outbind', decode => \&decode_outbind_v34, }, # i 2316 0x00000015 => { cmd => 'enquire_link', decode => \&decode_empty, }, # i 2317 0x80000015 => { cmd => 'enquire_link_resp', decode => \&decode_empty, }, # i 2318 0x00000021 => { cmd => 'submit_multi', decode => \&decode_submit_multi, }, # i 2319 0x80000021 => { cmd => 'submit_multi_resp', decode => \&decode_submit_multi_resp, }, # i 2320 0x00000102 => { cmd => 'alert_notification', decode => \&decode_alert_notification, }, # i 2321 0x00000103 => { cmd => 'data_sm', decode => \&decode_data_sm, }, # i 2322 0x80000103 => { cmd => 'data_sm_resp', decode => \&decode_submit_resp_v34, }, # i 2323 2324#4#cut 2325 # v4 codes 2326 2327 0x80010000 => { cmd => 'generic_nack_v4', decode => \&decode_empty, }, # i 2328 0x00010001 => { cmd => 'bind_receiver_v4', decode => \&decode_bind, }, # i 2329 0x80010001 => { cmd => 'bind_receiver_resp_v4', decode => \&decode_bind_resp_v4, }, # i 2330 0x00010002 => { cmd => 'bind_transmitter_v4', decode => \&decode_bind, }, # i 2331 0x80010002 => { cmd => 'bind_transmitter_resp_v4', decode => \&decode_bind_resp_v4, }, # i 2332 0x00010003 => { cmd => 'query_sm_v4', decode => \&decode_query_v4, }, # i 2333 0x80010003 => { cmd => 'query_sm_resp_v4', decode => \&decode_query_resp_v4, }, # i 2334 0x00010004 => { cmd => 'submit_sm_v4', decode => \&decode_submit_v4, }, # i 2335 0x80010004 => { cmd => 'submit_sm_resp_v4', decode => \&decode_submit_sm_resp_v4, }, # i 2336 0x00010005 => { cmd => 'deliver_sm_v4', decode => \&decode_deliver_sm_v4, }, # i 2337 0x80010005 => { cmd => 'deliver_sm_resp_v4', decode => \&decode_empty, }, # i 2338 0x00010006 => { cmd => 'unbind_v4', decode => \&decode_empty, }, # i 2339 0x80010006 => { cmd => 'unbind_resp_v4', decode => \&decode_empty, }, # i 2340 0x00010007 => { cmd => 'replace_sm_v4', decode => \&decode_replace_sm_v4, }, # i 2341 0x80010007 => { cmd => 'replace_sm_resp_v4', decode => \&decode_empty, }, # i 2342 0x00010008 => { cmd => 'cancel_sm_v4', decode => \&decode_cancel, }, # i 2343 0x80010008 => { cmd => 'cancel_sm_resp_v4', decode => \&decode_empty, }, # i 2344 0x00010009 => { cmd => 'delivery_receipt_v4', decode => \&decode_delivery_receipt, }, # *** 2345 0x80010009 => { cmd => 'delivery_receipt_resp_v4', decode => \&decode_empty, }, # i 2346 0x0001000a => { cmd => 'enquire_link_v4', decode => \&decode_empty, }, # i v4 2347 0x8001000a => { cmd => 'enquire_link_resp_v4', decode => \&decode_empty, }, # i v4 2348 0x0001000b => { cmd => 'outbind_v4', decode => \&decode_outbind_v4, }, # i 2349#4#end 2350}; 2351 2352package Net::SMPP::PDU; 2353 2354sub message_id { 2355 my $me = shift; 2356 return $me->{message_id}; 2357} 2358 2359sub status { 2360 my $me = shift; 2361 return $me->{status}; 2362 #return ${$me}{status}; 2363 #return ${*$me}{status}; 2364} 2365 2366sub seq { 2367 my $me = shift; 2368 return $me->{seq}; 2369} 2370 2371sub explain_status { 2372 my $me = shift; 2373 return sprintf("%s (%s=0x%08X)", 2374 Net::SMPP::status_code->{$me->{status}}->{msg}, 2375 Net::SMPP::status_code->{$me->{status}}->{code}, 2376 $me->{status}); 2377} 2378 2379sub cmd { 2380 my $me = shift; 2381 return $me->{cmd}; 2382} 2383 2384sub explain_cmd { 2385 my $me = shift; 2386 my $cmd = Net::SMPP::pdu_tab->{$me->{cmd}} 2387 || { cmd => sprintf(q{Unknown(0x%08X)}, $me->{cmd}) }; 2388 return $cmd->{cmd}; 2389} 2390 2391package Net::SMPP; 2392 2393### Try real hard to read something, i.e. block until the thing has 2394### been entirely read. 2395 2396sub read_hard { 2397 my ($me, $len, $dr, $offset) = @_; 2398 while (length($$dr) < $len+$offset) { 2399 my $n = length($$dr) - $offset; 2400 eval { 2401 local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required 2402 alarm ${*$me}{enquire_interval} if ${*$me}{enquire_interval}; 2403 warn "read $n/$len enqint(${*$me}{enquire_interval})" if $trace>1; 2404 while (1) { 2405 $n = $me->sysread($$dr, $len-$n, $n+$offset); 2406 next if $! =~ /^Interrupted/; 2407 last; 2408 } 2409 alarm 0; 2410 }; 2411 if ($@) { 2412 warn "ENQUIRE $@" if $trace; 2413 die unless $@ eq "alarm\n"; # propagate unexpected errors 2414 $me->enquire_link(); # Send a periodic ping 2415 } else { 2416 if (!defined($n)) { 2417 warn "error reading header from socket: $!"; 2418 ${*$me}{smpperror} = "read_hard I/O error: $!"; 2419 ${*$me}{smpperrorcode} = 1; 2420 return undef; 2421 } 2422 if (!$n) { 2423 warn "premature eof reading from socket"; 2424 ${*$me}{smpperror} = "read_hard premature eof"; 2425 ${*$me}{smpperrorcode} = 2; 2426 return undef; 2427 } 2428 } 2429 } 2430 #warn "read complete"; 2431 return 1; 2432} 2433 2434### read pdu from wire and decode it, if PDU is understood 2435 2436sub read_pdu { 2437 my $me = shift; 2438 my $header = ''; 2439 my $len; 2440 my $head_len = ${*$me}{head_len}; 2441 $me->read_hard($head_len, \$header, 0) or return undef; 2442 my $pdu = { cmd => 0, status => 0, seq => 0, data => '', }; 2443 ($len, 2444 $pdu->{cmd}, 2445 $pdu->{status}, 2446 $pdu->{seq}, 2447 $pdu->{reserved}) = unpack ${*$me}{head_templ}, $header; 2448 if ($len < $head_len) { 2449 warn "Too short length $len < ${*$me}{head_len}, cmd=$pdu->{cmd}, status=$pdu->{status}, seq=$pdu->{seq}"; 2450 ${*$me}{smpperror} = "read_pdu: Too short length $len < ${*$me}{head_len}, cmd=$pdu->{cmd}, status=$pdu->{status}, seq=$pdu->{seq}"; 2451 ${*$me}{smpperrorcode} = 3; 2452 return undef; 2453 } 2454 warn "read Header:\n".hexdump($header, "\t") if $trace; 2455 2456 $len -= $head_len; 2457 $me->read_hard($len, \$pdu->{data}, 0) or do { 2458 ${*$me}{smpperror} = "read_pdu: invalid length cmd=$pdu->{cmd},status=$pdu->{status}, seq=$pdu->{seq}"; 2459 ${*$me}{smpperrorcode} = 3; 2460 return undef; 2461 }; 2462 warn "read Body:\n".hexdump($pdu->{data}, "\t") if $trace; 2463 2464 ### Check if we know this PDU and decode it 2465 2466 if (defined pdu_tab->{$pdu->{cmd}}) { 2467 $pdu->{known_pdu} = 1; 2468 my $pdu_templ = pdu_tab->{$pdu->{cmd}}; 2469 my $mandat_len = &{$pdu_templ->{decode}}($pdu, $me); 2470 decode_optional_params($pdu, $mandat_len) if $mandat_len < $len; 2471 } 2472 2473 return bless $pdu => 'Net::SMPP::PDU'; 2474} 2475 2476sub wait_pdu { 2477 my ($me, $look_for_me, $seq) = @_; 2478 while (1) { 2479 my $pdu = $me->read_pdu() || return undef; 2480 return $pdu if $pdu->{cmd} == $look_for_me && $pdu->{seq} == $seq; 2481 2482 ### Check if PDU has a handlers (e.g. its enquire_link) 2483 2484 if (exists ${*$me}{handlers}->{$pdu->{cmd}}) { 2485 &{${*$me}{handlers}->{$pdu->{cmd}}}($me, $pdu); 2486 } 2487 2488 ### *** effectively all other PDUs get ignored 2489 warn "looking for $look_for_me seq=$seq, skipping cmd=$pdu->{cmd} seq=$pdu->{seq}" if $trace; 2490 } 2491} 2492 2493### Send a response to enquire_link 2494 2495sub handle_enquire_link { 2496 my ($me, $pdu) = @_; 2497 $me->enquire_link_resp(seq => $pdu->{seq}); 2498} 2499 2500### GSM often uses 7bit encoding to squeeze 160 7bit characters 2501### in 140 octets. This encoding is not automatically done by 2502### this module, but following routines allow one to do it 2503### manually. 2504### 2505### In general we can fit 8 7bit characters in 7 octets. 2506### 2507### Packing method: 2508### 2509### BIT: 76543210 76543210 76543210 76543210 76543210 76543210 76543210 2510### BYTE: 0 1 2 3 4 5 6 2511### CHAR: BAAAAAAA CCBBBBBB DDDCCCCC EEEEDDDD FFFFFEEE GGGGGGFF HHHHHHHG 2512### 2513### So as can be seen, the characters are encoded lowest bit to lowest 2514### available bit position, just wrapping around. Another possiblity 2515### would be as follows 2516### 2517### BIT: 76543210 76543210 76543210 76543210 76543210 76543210 76543210 2518### BYTE: 0 1 2 3 4 5 6 2519### CHAR: HAAAAAAA HBBBBBBB HCCCCCCC HDDDDDDD HEEEEEEE HFFFFFFF HGGGGGGG 2520### 2521### In this scheme the last character is distributed over the high bits 2522### of the other bytes. while bytes A-G would just be normal. 2523### 2524### These routines still have some issues in handling the padding. Especially 2525### unpack_7bit may leave some artifacts in the end. 2526 2527sub pack_7bit { 2528 my ($s) = @_; 2529 $s = unpack 'b*', $s; 2530 $s =~ s/(.{7})./$1/g; # Zap the high order (8th) bits 2531 return pack 'b*', $s; 2532} 2533 2534sub unpack_7bit { 2535 my ($s) = @_; 2536 $s = unpack 'b*', $s; 2537 $s =~ s/(.{7})/${1}0/g; # Stuff in high order (8th) bits 2538 $s = pack 'b*', $s; 2539 chop $s if substr($s, -1, 1) eq "\x00"; 2540 return $s; 2541# return pack 'b*', $s; 2542} 2543 2544# "Gema niskazhu" <gemochka@gmail.com> 2545 25461; 2547__END__ 2548 2549=head1 NAME 2550 2551Net::SMPP - pure Perl implementation of SMPP 3.4 over TCP 2552 2553=head1 SYNOPSIS 2554 2555 use Net::SMPP; 2556 $smpp = Net::SMPP->new_transceiver($host, port=>$port, 2557 system_id => 'yourusername', 2558 password => 'secret', 2559 ) or die; 2560 2561=head1 DESCRIPTION 2562 2563Implements Short Message Peer to Peer protocol, which is frequently used to 2564pass short messages between mobile operators implementing short message 2565service (SMS). This is applicable to both european GSM and american CDMA/TDMA 2566systems. 2567 2568This documentation is not intended to be complete reference to SMPP 2569protocol - use the SMPP specification documents (see references 2570section) to obtain exact operation and parameter names and their 2571meaning. You may also need to obtain site specific documentation about 2572the remote end and any protocol extensions that it supports or demands 2573before you start a project. This document follows the convention of 2574spelling parameter names exactly as they appear in the SMPP v3.4 2575documentation. SMPP v4.0 support also follows the respective 2576documentation, except where v4.0 usage is in conflict with v3.4 usage, 2577in which case the latter prevails (in practise I believe no such 2578conflicts remain in the madule at present). For a complete list of error 2579code and optional parameter enumerations, the reader is encouraged to 2580consult the source code or SMPP speciofications. 2581 2582Despite its name, SMPP protocol defines a client (ESME) and a server 2583(often called SMSC in the mobile operator world). Client usually 2584initiates the TCP connection and does I<bind> to log in. After 2585binding, a series of request response pairs, called PDUs (protocol 2586data units) is exchanged. Request can be initiated by either end 2587(hence "peer-to-peer"?) and the other end reponds. Requests are 2588numbered with a sequence number and each response has corresponding 2589sequence number. This allows several requests to be pending at the 2590same time. Conceptually this is similar to IMAP or LDAP message IDs. 2591Usually the $smpp object maintains the sequence numbers by itself and 2592the programmer need not concern himself with their exact values, but 2593should a need to override them arise, the seq argument can be supplied 2594to any request or response method. 2595 2596Normally this module operates in synchronous mode, meaning that a 2597method that sends a request will also block until it gets the 2598corresponding response. Internal command used for waiting for response is 2599 2600 $resp_pdu = $smpp->wait_pdu($cmd_id, $seq); 2601 2602If, while waiting for a particular response, other PDUs are received 2603they are either handled by handlers (set up by constructor) or 2604discarded. Both command code and sequence number must match. Typically 2605a handler for enquire command is set up while all other commands are 2606silently dropped. This practise may not be very suitable for 2607transceiver mode of operation and certainly is not suitable for 2608implementing a SMSC. 2609 2610Synchronous operation makes it impossible to interleave SMPP 2611operations, thus it should be regarded as a simplified programming 2612model for simple tasks. Anyone requiring more advanced control has to 2613use the asynchronous mode and take up the burden of understanding and 2614implementing more of the message flow logic in his own application. 2615 2616In synchronous mode request PDU methods return a Net::SMPP::PDU object 2617representing the response, if all went well protocolwise, or undef if 2618there was a protocol level error. If undef was returned, the reason 2619for the failure can be extracted from ${*$smpp}{smpperror} and 2620${*$smpp}{smpperrorcode} (actual codes are undocumented at the moment, 2621but are guaranteed not to change) variables and the global variable 2622$!. These variables are meaningless if anything else than undef was 2623returned. The response itself may be an error response if there was an 2624application level error in the remote end. In this case the application 2625level error can be determined from $pdu->{status} field. Some 2626responses also have optional parameters that further clarify the failure, 2627see documentation for each operation. 2628 2629If a protocol level error happens, probably the only safe action is 2630to destroy the connection object (e.g. undef $smpp). If an application 2631level error happens, then depending on how the remote end has been 2632implemented it may be possible to continue operation. 2633 2634Module can also be used asynchronously by specifying async=>1 to the 2635constructor. In this mode command methods return immediately with the 2636sequence number of the PDU and user should poll for any responses 2637using 2638 2639 $pdu = $smpp->wait_pdu($cmd_id, $seq); 2640 2641Typically wait_pdu() is used to wait for a response, but if wait_pdu() 2642is used to wait for a command, the caller should generate appropriate 2643response. 2644 2645If caller wants to receive next available PDU, he can call 2646 2647 $pdu = $smpp->read_pdu(); 2648 2649which will block until a PDU is received from the stream. The caller would 2650then have to check if the PDU is a response or a request and take appropriate 2651action. The smsc.pl example program supplied with this distribution 2652demonstrates a possible framework for handling both requests and responses. 2653 2654If the caller does not want to block on wait_pdu() or read_pdu(), he 2655must use select() to determine if the socket is readable (*** what if 2656SSL layer gets inserted?). Even if the socket selects for reading, 2657there may not be enough data to complete the PDU, so the call may 2658still block. Currently there is no reliable mechanism for avoiding 2659this. If this bothers you, you may consider allocating a separate 2660process for each connection so that blocking does not matter, or you 2661may set up some sort of timeout (see perlipc(1) man page) or you may 2662rewrite this module and contribute patches. 2663 2664Response methods always return the sequence number, irrespective 2665of synchronous or asynchronous mode, or undef if an error happened. 2666 2667=head1 CONSTRUCTORS 2668 2669=over 4 2670 2671=item new() 2672 2673Do not call. Has special internal meaning during accepting connections 2674from listening socket. 2675 2676=item new_connect() 2677 2678Create a new SMPP client object and open conncetion to SMSC host 2679 2680 $smpp = Net::SMPP->new_connect($host, 2681 system_id => 'username', # usually needed (default '') 2682 password => 'secret', # usually needed (default '') 2683 system_type => '', # default ok, often not needed 2684 interface_version => 0x34, # default ok, almost never needed 2685 addr_ton => 0x00, # default ok, type of number unknwn 2686 addr_npi => 0x00, # default ok, number plan indicator 2687 address_range => '', # default ok, regex matching nmbrs 2688 ) or die; 2689 2690Usually this constructor is not called directly. Use 2691new_transceiver(), new_transmitter(), and new_receiver() instead. 2692 2693=item new_transceiver() 2694 2695=item new_transmitter() 2696 2697=item new_receiver() 2698 2699These constructors first construct the object using new_connect() and 2700then bind using given type of bind request. See bind family of 2701methods, below. These constructors are usually used to implement 2702ESME type functionality. 2703 2704=item new_listen('localhost', port=>2251) 2705 2706Create new SMPP server object and open socket to listen on 2707given port. This constructor is usually used to implement a SMSC. 2708 2709=back 2710 2711=head1 REQUEST PDU METHODS 2712 2713Each request PDU method constructs a PDU from list of arguments supplied 2714and sends it to the wire. 2715 2716If async mode has been enabled (by specifying "async=>1" in the constructor 2717or as an argument to the method), the methods return sequence number of 2718the PDU just sent. This number can be later used to match up the response, 2719like this: 2720 2721 $seq = $smpp->query_sm(message_id => $msg_id) or die; 2722 ... 2723 $resp_pdu = $smpp->wait_pdu(Net::SMPP::CMD_query_sm_resp, $seq) 2724 or die; 2725 die "Response indicated error: " . $resp_pdu->explain_status() 2726 if $resp_pdu->status; 2727 2728If async mode is not enabled (i.e. "async=>1" was not specified 2729neither in constructor nor the method), the method will wait for the 2730corresponding response and return Net::SMPP::PDU object representing 2731that response. The application should check the outcome of the 2732operation from the status field of the response PDU, like this: 2733 2734 $resp_pdu = $smpp->query_sm(message_id => $msg_id) or die; 2735 die "Response indicated error: " . $resp_pdu->explain_status() 2736 if $resp_pdu->status; 2737 2738All request PDU methods optionally take "seq=>123" argument that 2739allows explicit specification of the sequence number. The default is 2740to increment internally stored sequence number by one and use that. 2741 2742Most PDUs have mandatory parameters and optional parameters. If 2743mandatory parameter is not supplied, it is inherited from the smpp 2744object. This means that the parameter can either be set as an argument 2745to the constructor or it is inherited from built-in defaults in the 2746innards of Net::SMPP (see C<Default> table from line 217 2747onwards). Some mandatory parameters can not be defaulted - if they are 2748missing a die results. In descriptions below, defaultable mandatory 2749parameters are show with the default value and comment indicating that 2750its defaultable. 2751 2752Optional parameters can be supplied to all PDUs (although the SMPP 2753spec does not allow optional parameters for some PDUs, the module does 2754not check for this) by listing them in the order that they should be 2755appended to the end of the PDU. Optional parameters can not be 2756defaulted - if the parameter is not supplied, it simply is not 2757included in the PDU. Optional parameters are not supported 2758by previous versions of the SMPP protocol (up to and including 3.3). 2759Applications wishing to be downwards compatible should not make 2760use of optional parameters. 2761 2762Standard optional parameters can be supplied by their name (see 2763C<param_tab> in the Net::SMPP source code, around line 345, for list of 2764known optional parameters), but the programmer still needs to supply 2765the value of the parameter in the expected format (one often has to 2766use pack to construct the value). Consult SMPP specifications for 2767the correct format. 2768 2769It is possible to supply arbitrary unsupported optional parameters 2770by simply supplying the parameter tag as a decimal number. Consult 2771your site dependent documentation to figure out the correct tags and 2772to determine the correct format for the value. 2773 2774When optional parameters are returned in response PDUs, they are 2775decoded and made available under both numeric tag and symbolic tag, if 2776known. For example the delivery_failure_reson of data_sm_resp can be 2777accessed both as $resp->{delivery_failure_reson} and $resp->{1061}. 2778The application needs to interpret the formatting of optional 2779parameters itself. The module always assumes they are strings, while 2780often they actually are interpretted as integers. Consult SMPP 2781specifications and site dependent documentation for correct format and 2782use unpack to obtain the numbers. 2783 2784If an unknown nonnumeric parameter tags are supplied a warning is 2785issued and parameter is skipped. 2786 2787In general the Net::SMPP module does not enforce SMPP 2788specifications. This means that it will happily accept too long or too 2789short values for manatory or optional parameters. Also the internal 2790formatting of the parameter values is not checked in any way. The 2791programmer should consult the SMPP specifications to learn the correct 2792length and format of each mandatory and optional parameter. 2793 2794Similarily, if the remote end returns incorrect PDUs and Net::SMPP is 2795able to parse them (usually because length fields match), then Net::SMPP 2796will not perform any further checks. This means that some fields 2797may be longer than allowed for in the specifications. 2798 2799I opted to leave the checks out at this stage because I needed a flexible 2800module that allowed me to explore even nonconformant SMSC implementations. 2801If the lack of sanity checks bothers you, formulate such checks and 2802submit me a patch. Ideally one could at construction time supply an 2803argument like "strict=>1" to enable the sanity checks. 2804 2805=over 4 2806 2807=item alert_notification() (4.12.1, p.108) 2808 2809Sent by SMSC to ESME when particular mobile subscriber has become 2810available. source_addr specifies which mobile subscriber. esme_addr 2811specifies which esme the message is destined to. Alert notifications 2812can arise if delivery pending flag had been set 2813for the subscriber from previous data_sm operation. 2814 2815There is no response PDU. 2816 2817 $smpp->alert_notification( 2818 source_addr_ton => 0x00, # default ok 2819 source_addr_npi => 0x00, # default ok 2820 source_addr => '', # default ok 2821 esme_addr_ton => 0x00, # default ok 2822 esme_addr_npi => 0x00, # default ok 2823 esme_addr => $esme_addr, # mandatory 2824 ) or die; 2825 2826=item bind_transceiver() (4.1.5, p.51) 2827 2828=item bind_transmitter() (4.1.1, p.46) 2829 2830=item bind_receiver() (4.1.3, p.48) 2831 2832Bind family of methods is used to authenticate the client (ESME) to 2833the server (SMSC). Usually bind happens as part of corresponding 2834constructor C<new_transceiver()>, C<new_transmitter()>, or 2835C<new_receiver()> so these methods are rarely called directly. These 2836methods take a plethora of options, which are largely the same as the 2837options taken by the constructors and can safely be defaulted. 2838 2839 $smpp->bind_transceiver( 2840 system_id => 'username', # usually needed (default '') 2841 password => 'secret', # usually needed (default '') 2842 system_type => '', # default ok, often not needed 2843 interface_version => 0x34, # default ok, almost never needed 2844 addr_ton => 0x00, # default ok, type of number unkwn 2845 addr_npi => 0x00, # default ok, number plan indic. 2846 address_range => '', # default ok, regex matching tels 2847 ) or die; 2848 2849Typically it would be called like: 2850 2851 $resp_pdu = $smpp->bind_transceiver(system_id => 'username', 2852 password => 'secret') or die; 2853 die "Response indicated error: " . $resp_pdu->explain_status() 2854 if $resp_pdu->status; 2855 2856or to inform SMSC that you can handle all Spanish numbers: 2857 2858 $resp_pdu = $smpp->bind_transceiver(system_id => 'username', 2859 password => 'secret', 2860 address_range => '^\+?34') 2861 or die; 2862 die "Response indicated error: " . $resp_pdu->explain_status() 2863 if $resp_pdu->status; 2864 2865=item cancel_sm() (4.9.1, p.98) 2866 2867Issued by ESME to cancel one or more short messages. Two principal 2868modes of operation are: 2869 28701. if message_id is supplied, other fields can be left at 2871defaults. This mode deletes just one message. 2872 28732. if message_id is not supplied (or is empty string), then 2874the other fields must be supplied and all messages matching 2875the criteria reflected by the other fields are deleted. 2876 2877 $smpp->cancel_sm( 2878 service_type => '', # default ok 2879 message_id => '', # default ok, but often given 2880 source_addr_ton => 0x00, # default ok 2881 source_addr_npi => 0x00, # default ok 2882 source_addr => '', # default ok 2883 dest_addr_ton => 0x00, # default ok 2884 dest_addr_npi => 0x00, # default ok 2885 destination_addr => '', # default ok 2886 ) or die; 2887 2888For example 2889 2890 $resp_pdu = $smpp->submit_sm(destination_addr => '+447799658372', 2891 short_message => 'test message') 2892 or die; 2893 die "Response indicated error: " . $resp_pdu->explain_status() 2894 if $resp_pdu->status; 2895 $msg_id = $resp_pdu->{message_id}; 2896 2897 $resp_pdu = $smpp->query_sm(message_id => $msg_id) or die; 2898 die "Response indicated error: " . $resp_pdu->explain_status() 2899 if $resp_pdu->status; 2900 print "Message state is $resp_pdu->{message_state}\n"; 2901 2902 $resp_pdu = $smpp->replace_sm(message_id => $msg_id, 2903 short_message => 'another test') 2904 or die; 2905 die "Response indicated error: " . $resp_pdu->explain_status() 2906 if $resp_pdu->status; 2907 2908 $resp_pdu = $smpp->cancel_sm(message_id => $msg_id) or die; 2909 die "Response indicated error: " . $resp_pdu->explain_status() 2910 if $resp_pdu->status; 2911 2912=item data_sm() (4.7.1, p.87) 2913 2914Newer alternative to submit_sm and deliver_sm. In addition to that 2915data_sm can be used to pass special messages such as SMSC Delivery 2916Receipt, SME Delivery Acknowledgement, SME Manual/User 2917Acknowledgement, Intermediate notification. 2918 2919Unlike submit_sm and deliver_sm, the short_message parameter is not 2920mandatory. Never-the-less, the optional parameter message_payload must 2921be supplied for things to work correctly. 2922 2923 $smpp->data_sm( 2924 service_type => '', # default ok 2925 source_addr_ton => 0x00, # default ok 2926 source_addr_npi => 0x00, # default ok 2927 source_addr => '', # default ok 2928 dest_addr_ton => 0x00, # default ok 2929 dest_addr_npi => 0x00, # default ok 2930 destination_addr => $tel, # mandatory 2931 esm_class => 0x00, # default ok 2932 registered_delivery => 0x00, #default ok 2933 data_coding => 0x00, # default ok 2934 message_payload => 'test msg', # opt, but needed 2935 ) or die; 2936 2937For example 2938 2939 $resp_pdu = $smpp->data_sm(destination_addr => '+447799658372', 2940 message_payload => 'test message') 2941 or die; 2942 die "Response indicated error: " . $resp_pdu->explain_status() 2943 if $resp_pdu->status; 2944 2945=item deliver_sm() (4.6.1, p.79) 2946 2947Issued by SMSC to send message to an ESME. Further more SMSC 2948can transfer following special messages: 1. SMSC delivery receipt, 29492. SME delivery acknowledgement, 3. SME Manual/User Acknowledgement, 29504. Intermediate notification. These messages are sent in response 2951to SMS message whose registered_delivery parameter requested them. 2952 2953If message data is longer than 254 bytes, the optional parameter 2954C<message_payload> should be used to store the message and 2955C<short_message> should be set to empty string. N.B. although protocol 2956has mechanism for sending fairly large messages, the underlying mobile 2957network usually does not support very large messages. GSM supports 2958only up to 160 characters, other systems 128 or even just 100 characters. 2959 2960 $smpp->deliver_sm( 2961 service_type => '', # default ok 2962 source_addr_ton => 0x00, # default ok 2963 source_addr_npi => 0x00, # default ok 2964 source_addr => '', # default ok 2965 dest_addr_ton => 0x00, # default ok 2966 dest_addr_npi => 0x00, # default ok 2967 destination_addr => $t, # mandatory 2968 esm_class => 0x00, # default ok 2969 protocol_id => 0x00, # default ok on CDMA,TDMA 2970 # on GSM value needed 2971 priority_flag => 0x00, # default ok 2972 schedule_delivery_time => '', # default ok 2973 validity_period => '', # default ok 2974 registered_delivery => 0x00, # default ok 2975 replace_if_present_flag => 0x00, # default ok 2976 data_coding => 0x00, # default ok 2977 sm_default_msg_id => 0x00, # default ok 2978 short_message => '', # default ok, but 2979 # usually supplied 2980 ) or die; 2981 2982For example 2983 2984 $resp_pdu = $smpp->deliver_sm(destination_addr => '+447799658372', 2985 short_message => 'test message') 2986 or die; 2987 die "Response indicated error: " . $resp_pdu->explain_status() 2988 if $resp_pdu->status; 2989 2990=item enquire_link() (4.11.1, p.106) 2991 2992Used by either ESME or SMSC to "ping" the other side. Takes no 2993parameters. 2994 2995 $smpp->enquire_link() or die; 2996 2997=item outbind() (4.1.7, p.54, 2.2.1, p.16) 2998 2999Used by SMSC to signal ESME to originate a C<bind_receiver> request to 3000the SMSC. C<system_id> and C<password> authenticate the SMSC to the 3001ESME. The C<outbind> is used when SMSC initiates the TCP session and 3002needs to trigger ESME to perform a C<bind_receiver>. It is not needed 3003if the ESME initiates the TCP connection (e.g. sec 2.7.1, p.27). 3004 3005There is not response PDU for C<outbind>, instead the ESME is 3006expected to issue C<bind_receiver>. 3007 3008 $smpp->outbind( 3009 system_id => '', # default ok, but usually given 3010 password => '', # default ok, but usually given 3011 ) or die; 3012 3013=item query_sm() (4.8.1, p.95) 3014 3015Used by ESME to query status of a submitted short message. Both 3016message_id and source_addr must match (if source_addr was defaulted to 3017NULL during submit, it must be NULL here, too). See example near 3018C<cancel_sm>. 3019 3020 3021 $smpp->query_sm( 3022 message_id => $msg_id, # mandatory 3023 source_addr_ton => 0x00, # default ok 3024 source_addr_npi => 0x00, # default ok 3025 source_addr => '', # default ok 3026 ) or die; 3027 3028 3029=item replace_sm() (4.10.1, p.102) 3030 3031Used by ESME to replace a previously submitted short message, provided 3032it is still pending delivery. Both message_id and source_addr must 3033match (if source_addr was defaulted to NULL during submit, it must be 3034NULL here, too). See example near C<cancel_sm>. 3035 3036 $smpp->replace_sm( 3037 message_id => $msg_id, # mandatory 3038 source_addr_ton => 0x00, # default ok 3039 source_addr_npi => 0x00, # default ok 3040 source_addr => '', # default ok 3041 schedule_delivery_time => '', # default ok 3042 validity_period => '', # default ok 3043 registered_delivery => 0x00, # default ok 3044 sm_default_msg_id => 0x00, # default ok 3045 short_message => '', # default ok, but 3046 # usually supplied 3047 ) or die; 3048 3049=item submit_sm() (4.4.1, p.59) 3050 3051Used by ESME to submit short message to the SMSC for onward 3052transmission to the specified short message entity (SME). The 3053submit_sm does not support the transaction message mode. 3054 3055If message data is longer than 254 bytes, the optional parameter 3056C<message_payload> should be used to store the message and 3057C<short_message> should be set to empty string. N.B. although protocol 3058has mechanism for sending fairly large messages, the underlying mobile 3059network usually does not support very large messages. GSM supports 3060only up to 160 characters. 3061 3062 $smpp->submit_sm( 3063 service_type => '', # default ok 3064 source_addr_ton => 0x00, # default ok 3065 source_addr_npi => 0x00, # default ok 3066 source_addr => '', # default ok 3067 dest_addr_ton => 0x00, # default ok 3068 dest_addr_npi => 0x00, # default ok 3069 destination_addr => $t, # mandatory 3070 esm_class => 0x00, # default ok 3071 protocol_id => 0x00, # default ok on CDMA,TDMA 3072 # on GSM value needed 3073 priority_flag => 0x00, # default ok 3074 schedule_delivery_time => '', # default ok 3075 validity_period => '', # default ok 3076 registered_delivery => 0x00, # default ok 3077 replace_if_present_flag => 0x00, # default ok 3078 data_coding => 0x00, # default ok 3079 sm_default_msg_id => 0x00, # default ok 3080 short_message => '', # default ok, but 3081 # usually supplied 3082 ) or die; 3083 3084For example 3085 3086 $resp_pdu = $smpp->submit_sm(destination_addr => '+447799658372', 3087 short_message => 'test message') 3088 or die; 3089 die "Response indicated error: " . $resp_pdu->explain_status() 3090 if $resp_pdu->status; 3091 3092Or 3093 3094 $resp_pdu = $smpp->submit_sm(destination_addr => '+447799658372', 3095 short_message => '', 3096 message_payload => 'a'x500) or die; 3097 die "Response indicated error: " . $resp_pdu->explain_status() 3098 if $resp_pdu->status; 3099 3100=item submit_multi() (4.5.1, p.69) 3101 3102Used by ESME to submit short message to the SMSC for onward 3103transmission to the specified short message entities (SMEs). This 3104command is especially destined for multiple recepients. 3105 3106If message data is longer than 254 bytes, the optional parameter 3107C<message_payload> should be used to store the message and 3108C<short_message> should be set to empty string. N.B. although protocol 3109has mechanism for sending fairly large messages, the underlying mobile 3110network usually does not support very large messages. GSM supports 3111only up to 160 characters. 3112 3113 $smpp->submit_multi( 3114 service_type => '', # default ok 3115 source_addr_ton => 0x00, # default ok 3116 source_addr_npi => 0x00, # default ok 3117 source_addr => '', # default ok 3118 dest_flag => # default ok 3119 [ MULTIDESTFLAG_SME_Address, 3120 MULTIDESTFLAG_dist_list, ... ], 3121 dest_addr_ton => # default ok 3122 [ 0x00, 0x00, ... ], 3123 dest_addr_npi => # default ok 3124 [ 0x00, 0x00, ... ], 3125 destination_addr => # mandatory 3126 [ $t1, $t2, ... ], 3127 esm_class => 0x00, # default ok 3128 protocol_id => 0x00, # default ok on CDMA,TDMA 3129 # on GSM value needed 3130 priority_flag => 0x00, # default ok 3131 schedule_delivery_time => '', # default ok 3132 validity_period => '', # default ok 3133 registered_delivery => 0x00, # default ok 3134 replace_if_present_flag => 0x00, # default ok 3135 data_coding => 0x00, # default ok 3136 sm_default_msg_id => 0x00, # default ok 3137 short_message => '', # default ok, but 3138 # usually supplied 3139 ) or die; 3140 3141For example 3142 3143 $resp_pdu = $smpp->submit_multi(destination_addr => 3144 [ '+447799658372', '+447799658373' ], 3145 short_message => 'test message') 3146 or die; 3147 die "Response indicated error: " . $resp_pdu->explain_status() 3148 if $resp_pdu->status; 3149 3150The destinations are specified as an array reference. dest_flag, 3151dest_addr_ton, and dest_addr_npi must have same cardinality as 3152destination_addr if they are present. Default for dest_flag 3153is MULTIDESTFLAG_SME_Address, i.e. normal phone number. 3154 3155=item unbind() (4.2, p.56) 3156 3157Used by ESME to unregisters ESME from SMSC. Does not take any 3158parameters. 3159 3160 $smpp->unbind() or die; 3161 3162=back 3163 3164=head1 RESPONSE PDU METHODS 3165 3166Response PDU methods are used to indicate outcome of requested 3167commands. Typically these methods would be used by someone 3168implementing a server (SMSC). 3169 3170Response PDUs do not have separate asynchronous behaviour pattern. 3171 3172=over 3173 3174=item bind_receiver_resp() 3175 3176=item bind_transmitter_resp() 3177 3178=item bind_transceiver_resp() 3179 3180 $smpp->bind_transceiver_resp( 3181 system_id => '', # default ok 3182 ) or die; 3183 3184=item cancel_sm_resp() (4.9.2, p.100) 3185 3186 $smpp->cancel_sm_resp() or die; 3187 3188=item data_sm_resp() 3189 3190 $smpp->data_sm_resp(message_id => $msg_id) or die; 3191 3192=item deliver_sm_resp() 3193 3194 $smpp->deliver_sm_resp(message_id => $msg_id) or die; 3195 3196=item enquire_link_resp() (4.11.2, p.106) 3197 3198 $smpp->enquire_link_resp() or die; 3199 3200=item generic_nack() (4.3.1, p.57) 3201 3202 $smpp->generic_nack() or die; 3203 3204=item query_sm_resp() (4.6.2, p.96) 3205 3206 $smpp->query_sm_resp( 3207 message_id => $msg_id, # mandatory 3208 final_date => '', # default ok 3209 message_state => $state, # mandatory 3210 error_code => 0x00, # default ok 3211 ) or die; 3212 3213=item replace_sm_resp() (4.10.2, p.104) 3214 3215 $smpp->replace_sm_resp() or die; 3216 3217=item submit_sm_resp() (4.4.2, p.67) 3218 3219 $smpp->submit_sm_resp(message_id => $msg_id) or die; 3220 3221=item submit_multi_resp() (4.5.2, p.76) 3222 3223 $smpp->submit_multi_resp(message_id => $msg_id 3224 dest_addr_ton => [], # default ok 3225 dest_addr_npi => [], # default ok 3226 destination_addr => [], # mandatory 3227 error_status_code => [], # mandatory 3228 ) or die; 3229 3230=item unbind_resp() (4.2.2, p.56) 3231 3232 $smpp->unbind_resp() or die; 3233 3234=back 3235 3236=head1 MESSAGE ENCODING AND LENGTH 3237 3238=over 4 3239 3240Many SMS technologies have inherent message length limits. For example 3241GSM specifies length to be 140 bytes. Using 7 bit encoding, this holds 3242the 160 characters that people are familiar with. Net::SMPP does not 3243enforce this limit in any way, i.e. if you create too long message, 3244then it is your problem. You should at application layer make sure 3245you stay within limits. 3246 3247Net::SMPP also does not automatically perform the encoding, not even 3248if you set data_encoding parameter. Application layer is responsible 3249for performing the encoding and setting the data_encoding parameter 3250accordingly. 3251 3252To assist in performing the usual 7 bit encoding, following functions 3253are provided (but you have to call them explicitly): 3254 3255=over 3256 3257=item pack_7bit() 3258 3259=item unpack_7bit() 3260 3261Example 3262 3263 $resp_pdu = $smpp->submit_sm(destination_addr => '+447799658372', 3264 data_encoding => 0x00, 3265 short_message => pack_7bit('test message')) 3266 or die; 3267 3268=back 3269 3270The rationale for leaving encoding and length issues at application 3271layer is two fold: 1. often the data is just copied through to another 3272message or protocol, thus we do not really care how it is encoded or 3273how long it is. Presumably it was valid at origin. 2. This policy 3274avoids underlying technology dependencies in the module. Often local 3275deployments have all the manner of hacks that make this area very 3276difficult to chart. So I leave it to local application developer to 3277find out what is locally needed. 3278 3279=back 3280 3281=head1 OTHER METHODS 3282 3283=over 4 3284 3285=item read_pdu() 3286 3287Reads a PDU from stream and analyzes it into Net::SMPP::PDU 3288object (if PDU is of known type). Blocks until PDU is available. 3289If you do not want it to block, do select on the socket to 3290make sure some data is available (unfortunately some data 3291may be available, but not enough, so it can still block). 3292 3293read_pdu() is very useful for implementing main loop of SMSC 3294where unknown PDUs must be received in random order and 3295processed. 3296 3297 $pdu = $smpp->read_pdu() or die; 3298 3299=item wait_pdu() 3300 3301Reads PDUs from stream and handles or discards them until matching PDU 3302is found. Blocks until success. Typically wait_pdu() is used 3303internally by request methods when operating in synchronous mode. The 3304PDUs to handle are specified by C<${*$me}{handlers}->{$command_id}>. 3305The handlers table is initially populated to handle enquire_link PDUs 3306automatically, but this can be altered using C<handlers> argument to 3307constructor. 3308 3309 $pdu = $smpp->wait_pdu($cmd_id_to_wait, $seq_to_wait) or die; 3310 3311=item set_version($vers) 3312 3313Sets the protocol version of the object either to 0x40 or 0x34. Its 3314important to use this method instead of altering $smpp->{smpp_version} 3315field directly because there are several other fields that have to be 3316set in tandem. 3317 3318=back 3319 3320=head1 EXAMPLES 3321 3322Typical client: 3323 3324 use Net::SMPP; 3325 $smpp = Net::SMPP->new_transceiver('smsc.foo.net', port=>2552) or die; 3326 $resp_pdu = $smpp->submit_sm(destination_addr => '447799658372', 3327 data => 'test message') or die; 3328 *** 3329 3330Typical server, run from inetd: 3331 3332 *** 3333 3334See test.pl for good templates with all official parameters, but 3335beware that the actual parameter values are ficticious as is the flow 3336of the dialog. 3337 3338=head1 MULTIPART MESSAGE 3339 3340Reportedly (Zeus Panchenko) multipart messages can be gotten to work with 3341 3342 while (length ($msgtext)) { 3343 if ($multimsg_maxparts) { 3344 @udh_ar = map { sprintf "%x", $_ } $origref, $multimsg_maxparts, $multimsg_curpart; 3345 $udh = pack("hhhhhh",0x05, 0x00, 0x03 , @udh_ar); 3346 $resp_pdu = $smpp->submit_sm(destination_addr => $phone, 3347 ... 3348 short_message => $udh . $msgtext, 3349 ); 3350 ... 3351 } 3352 } 3353 3354#4#cut 3355=head1 VERSION 4.0 SUPPORT 3356 3357Net::SMPP was originally written for version 3.4 of SMPP protocol. I 3358have since then gotten specifications for an earlier protocol, the 3359version 4.0 (Logical, eh? (pun intended)). In my understanding the 3360relevant differences are as follows (n.b. (ok) marks difference 3361that has already been implemented): 3362 33631. A reserved (always 0x00000000) field in message 3364 header (v4 p. 21) (ok) 3365 33662. Connection can not be opened in transceiver mode (this 3367 module will not enforce this restriction) (ok) 3368 33693. Command versioning. Version 0x01 == V4 (v4 p. 22) (ok) 3370 33714. Support for extended facilities has to be requested 3372 during bind (ok) 3373 33745. bind_* PDUs have facilities_mask field (v4 p. 25) (ok) 3375 33766. bind_*_resp PDUs have facilities_mask field (v4 p. 27) (ok) 3377 33787. outbind lacks system ID field (v4 p.30, v3.4 p. 54) (ok) 3379 33808. submit_sm lacks service_type and adds 3381 message_class (v4 p. 34, v3.4 p. 59) (ok) 3382 33839. submit_sm: telematic_interworking == protocol_id (ok) 3384 338510. submit_sm: starting from number of destinations and 3386 destination address the message format is substantially 3387 different. Actually the message format is somewhat 3388 similar to v3.4 submit_multi. (ok) 3389 339011. submit_sm: validity period encoded as an integer 3391 relative offset (was absolute time as C string) (ok) 3392 339312. submit_sm: replace_if_present flag missing (ok) 3394 339513. submit_sm: sm_length field is 2 octets (was one) (ok) 3396 339714. submit_sm_resp is completely different, but actually 3398 equal to v3.4 submit_multi_resp (v4 p. 37, 3399 v3.4 pp. 67,75) (ok) 3400 340115. submit_sm vs submit_multi: lacks service_type, 3402 adds message_class (ok) 3403 340416. submit_sm vs submit_multi: number_of_dests increased 3405 from 1 byte to 4 (ok) 3406 340717. submit_sm vs submit_multi: esm_class lacking, adds 3408 messaging_mode and msg_reference (ok) 3409 341018. submit_sm vs submit_multi: telematic_interworking == protocol_id (ok) 3411 341219. submit_sm vs submit_multi: replace_if_present missing (ok) 3413 341420. submit_sm vs submit_multi: sm_length is 2 bytes (was one) (ok) 3415 341621. submit_sm vs submit_multi: lacks dest_flag and distribution_list_name (ok) 3417 341822. deliver_sm: lacks service_type (ok) 3419 342023. deliver_sm: lacks esm_class, adds msg_reference and message_class (ok) 3421 342224. deliver_sm: telematic_interworking == protocol_id (ok) 3423 342425. deliver_sm: priority_level == priority_flag (ok) 3425 342626. deliver_sm: submit_time_stamp == schedule_delivery_time (ok) 3427 342827. deliver_sm: lacks validity_period, registered_delivery, 3429 and replace_if_present_flag (ok) 3430 343128. deliver_sm: lacks sm_default_msg_id (ok) 3432 343329. deliver_sm: sm_length is now 2 bytes (was one) (ok) 3434 343530. deliver_sm_resp: lacks message_id (v3.4 has the field, but its unused) (ok) 3436 343731. New command: delivery_receipt (ok) 3438 343932. New response: delivery_receipt_resp (ok) 3440 344133. query_sm: dest_addr_* fields added (v4 p. 46, v3.4 p. 95) (ok) 3442 344334. query_sm_resp: error_code renamed to network_error_code 3444 and increased in size from one to 4 bytes (ok) 3445 344635. cancel_sm: service_type renamed to message_class, also 3447 type changed (ok) 3448 344936. replace_sm: added dest_addr_* fields (ok) 3450 345137. replace_sm: data type of validity_period changed (ok) 3452 345338. replace_sm: added data_coding field (ok) 3454 345539. replace_sm: sm_length field increased from one to two bytes (ok) 3456 345740. In v3.4 command code 0x0009 means bind_transceiver, 3458 in v4.0 this very same code means delivery_receipt (bummer) (ok) 3459 346041. In v3.4 enquire_link is 0x0015 where as in v4 it is 0x000a (ok) 3461 3462 3463To create version 4 connection, you must specify smpp_version => 0x40 3464and you should not bind as transceiver as that is not supported by the 3465specification. 3466 3467As v3.4 specification seems more mature, I recommend that where attributes 3468have been renamed between v4 and v3.4 you stick to using v3.4 names. I 3469have tried to provide compatibility code whenever possible. 3470 3471#4#end 3472 3473=head1 MISC. NOTES 3474 3475Unless you wrote your program to be multithreaded or 3476multiprocess, everything will happen in one thread of execution. 3477Thus if you get unbind while doing something else (e.g. checking 3478your spool directory), it stays in operating system level buffers until 3479you actually call read_pdu(). Knowing about unbind or not is of little 3480use. You can write your program to assume the network traffic arrives 3481only exactly when you call read_pdu(). 3482 3483Regarding the unbind, it is normally handled by a dispatch table 3484automatically if you use wait_pdu() to receive your traffic. But 3485if you created your own dispatch table, you will have to add it 3486there yourself. If you are calling read_pdu() then you have 3487to handle it yourslef. Even if you are using the 3488supplied table, you may want to double check - there could be a bug. 3489 3490One more thing: if your problem is knowing whether wait_pdu() or 3491read_pdu() would block, then you have two possible solutions: 3492 3493 1. use select(2) systemcall to determine for the socket 3494 is ready for reading 3495 2. structure your program as several processes (e.g. one 3496 for sending and one for receiving) so that you 3497 can afford to block 3498 3499The above two tricks are not specific to this module. Consult any standard 3500text book on TCP/IP network programming. 3501 3502=head1 ERRORS 3503 3504Please consult C<status_code> table in the beginning of the source code or 3505SMPP specification section 5.1.3, table 5-2, pp.112-114. 3506 3507=head1 EXPORT 3508 3509None by default. 3510 3511=head1 TESTS / WHAT IS KNOWN TO WORK 3512 3513Interoperates with itself. 3514 3515=head1 TO DO AND BUGS 3516 3517=over 4 3518 3519=item read_pdu() can block even if socket selects for reading. 3520 3521=item The submit_multi command has not been implemented. 3522 3523=back 3524 3525=head1 AUTHOR AND COPYRIGHT 3526 3527Sampo Kellomaki <sampo@symlabs.com> 3528 3529Net::SMPP is copyright (c) 2001-2010 by Sampo Kellomaki, All rights reserved. 3530Portions copyright (c) 2001-2005 by Symlabs, All rights reserved. 3531You may use and distribute Net::SMPP under same terms as perl itself. 3532 3533NET::SMPP COMES WITH ABSOLUTELY NO WARRANTY. 3534 3535=head1 PLUG 3536 3537This work was sponsored by Symlabs, the LDAP and directory experts 3538(www.symlabs.com). 3539 3540=head1 SEE ALSO 3541 3542=over 4 3543 3544=item test.pl from this package 3545 3546=item Short Message Peer to Peer Protocol Specification v3.4, 12-Oct-1999, Issue 1.2 3547 3548=item www.etsi.fr 3549 3550=item GSM 03.40, v5.7.1 3551 3552=item www.wapforum.org 3553 3554=item Short Message Peer to Peer (SMPP) V4 Protocol Specification, 29-Apr-1997, Version 1.1 (from Aldiscon/Logica) #4 3555 3556=item http://www.hsl.uk.com/documents/advserv-sms-smpp.pdf 3557 3558=item http://www.mobilesms.com/developers.asp 3559 3560=item http://opensmpp.logica.com 3561 3562=item www.smpp.org (it appears as of July 2007 domain squatters have taken over the site and it is no longer useful) 3563 3564=item http://www.smsforum.net/ -- New place for info (as of 20081214). However, this page announces the death of itself as of July 27, 2007. Great. The SMS folks really do not want anyone to implement their protocols from specifications. 3565 3566=item "Short Message Peer to Peer Protocol Specification v5.0 19-February-2003", http://www.csoft.co.uk/documents/smppv50.pdf (good as of 20081214) 3567 3568=item http://freshmeat.net/projects/netsmpp/ (announcements about Net::SMPP) 3569 3570=item http://zxid.org/smpp/net-smpp.html (home page) 3571 3572=item http://cpan.org/modules/by-module/Net/Net-SMPP-1.12.tar.gz (download from CPAN) 3573 3574=item perl(1) 3575 3576=back 3577 3578=cut 3579