/smsc.pl

https://github.com/gitpan/Net-SMPP · Perl · 226 lines · 190 code · 14 blank · 22 comment · 7 complexity · 502936781f53c2fe564e36293e5b5293 MD5 · raw file 

    

  1. #!/usr/bin/perl
    2. 

  2. #
    3. 

  3. # Copyright (c) 2010 Sampo Kellomaki (sampo@iki.fi), All Rights Reserved.
    4. 

  4. # Copyright (c) 2001 SymLABS <symlabs@symlabs.com>, All Rights Reserved.
    5. 

  5. # See README for license. NO WARRANTY.
    6. 

  6. #
    7. 

  7. # 10.7.2001, Sampo Kellomaki <sampo@iki.fi>
    8. 

  8. # $Id: smsc.pl,v 1.11 2007-07-20 16:39:19 sampo Exp $
    9. 

  9. #
    10. 

  10. # SMSC - Short Message Service Center
    11. 

  11. #
    12. 

  12. # Test Net::SMPP in SMSC role
    13. 

  13. #
    14. 

  14. # Usage: ./smsc.pl *version*
    15. 

  15. #    version can be 4 or 3
    16. 

  16. 

  17. use Net::SMPP;
    18. 

  18. use Data::Dumper;
    19. 

  19. 

  20. $trace = 0;
    21. 

  21. $Net::SMPP::trace = 0;
    22. 

  22. $sysid = "GSMSGW";
    23. 

  23. $pw = "secret";
    24. 

  24. $host = 'localhost';
    25. 

  25. $port = 9900;
    26. 

  26. $facil = 0x00010003;
    27. 

  27. ($vers) = @ARGV;
    28. 

  28. $vers = $vers == 4 ? 0x40 : 0x34;
    29. 

  29. $if_vers = 0x00;
    30. 

  30. 

  31. use constant reply_tab => {
    32. 

  32.     0x80000000 => { cmd => 'generic_nack', reply => undef, },
    33. 

  33.     0x00000001 => { cmd => 'bind_receiver',
    34. 

  34. 		    reply => sub { my ($me,$pdu) = @_;
    35. 

  35. 				   $me->set_version(0x34);
    36. 

  36. 				   $me->bind_receiver_resp(system_id => $sysid,
    37. 

  37. 							   seq => $pdu->{seq});
    38. 

  38. 			       }, },
    39. 

  39.     0x80000001 => { cmd => 'bind_receiver_resp', reply => undef, }, 
    40. 

  40.     0x00000002 => { cmd => 'bind_transmitter',
    41. 

  41. 		    reply => sub { my ($me, $pdu) = @_;
    42. 

  42. 				   $me->set_version(0x34);
    43. 

  43. 				   warn "Doing bind_tx_resp";
    44. 

  44. 				   $me->bind_transmitter_resp(system_id => $sysid,
    45. 

  45. 							   seq => $pdu->{seq});
    46. 

  46. 			       }, },
    47. 

  47.     0x80000002 => { cmd => 'bind_transmitter_resp', reply => undef, }, 
    48. 

  48.     0x00000003 => { cmd => 'query_sm',
    49. 

  49. 		    reply => sub { my ($me, $pdu) = @_;
    50. 

  50. 				   $me->query_sm_resp(message_id=>$pdu->{message_id},
    51. 

  51. 						      final_date=>'010711135959000+',
    52. 

  52. 							   seq => $pdu->{seq},
    53. 

  53. 						      ) }, },
    54. 

  54.     0x80000003 => { cmd => 'query_sm_resp', reply => undef, },     
    55. 

  55.     0x00000004 => { cmd => 'submit_sm',
    56. 

  56. 		    reply => sub { my ($me, $pdu) = @_;
    57. 

  57. 				   $me->submit_sm_resp(message_id=>'123456789',
    58. 

  58. 						       seq => $pdu->{seq}) }, },
    59. 

  59.     0x80000004 => { cmd => 'submit_sm_resp', reply => undef, },   
    60. 

  60.     0x00000005 => { cmd => 'deliver_sm', reply => undef, },    # we originate this
    61. 

  61.     0x80000005 => { cmd => 'deliver_sm_resp', reply => undef, },  # *** need to handle this?
    62. 

  62.     0x00000006 => { cmd => 'unbind',
    63. 

  63. 		    reply => sub { my ($me, $pdu) = @_;
    64. 

  64. 				   $me->unbind_resp(seq => $pdu->{seq});
    65. 

  65. 				   warn "$$: Remote sent unbind. Dropping connection.";
    66. 

  66. 				   exit;
    67. 

  67. 			       }, },       
    68. 

  68.     0x80000006 => { cmd => 'unbind_resp',
    69. 

  69. 		    reply => sub { warn "$$: Remote replied to unbind. Dropping connection.";
    70. 

  70. 				   exit;
    71. 

  71. 			       }, },
    72. 

  72.     0x00000007 => { cmd => 'replace_sm',
    73. 

  73. 		    reply => sub { my ($me, $pdu) = @_;
    74. 

  74. 				   $me->replace_sm_resp(seq => $pdu->{seq}) }, },
    75. 

  75.     0x80000007 => { cmd => 'replace_sm_resp', reply => undef, }, 
    76. 

  76.     0x00000008 => { cmd => 'cancel_sm', reply => sub { my ($me, $pdu) = @_;
    77. 

  77. 						       $me->cancel_resp(seq => $pdu->{seq}) }, },
    78. 

  78.     0x80000008 => { cmd => 'cancel_sm_resp', reply => undef, },  
    79. 

  79.     0x00000009 => { cmd => 'bind_transceiver',
    80. 

  80. 		    reply => sub { my ($me, $pdu) = @_;
    81. 

  81. 				   $me->set_version(0x34);
    82. 

  82. 				   $me->bind_transceiver_resp(system_id => $sysid,
    83. 

  83. 							      seq => $pdu->{seq});
    84. 

  84. 			       }, },
    85. 

  85.     0x80000009 => { cmd => 'bind_transceiver_resp', reply => undef, }, 
    86. 

  86.     0x0000000b => { cmd => 'outbind',
    87. 

  87. 		    reply => sub {  my ($me, $pdu) = @_;
    88. 

  88. 				    $me->set_version(0x34);
    89. 

  89. 				    $me->bind_receiver(system_id => $sysid,
    90. 

  90. 						       password => $pw) }, },
    91. 

  91.     0x00000015 => { cmd => 'enquire_link',
    92. 

  92. 		    reply => sub { my ($me, $pdu) = @_;
    93. 

  93. 				   $me->enquire_link_resp(seq => $pdu->{seq}) }, },      
    94. 

  94.     0x80000015 => { cmd => 'enquire_link_resp', reply => undef, }, 
    95. 

  95.     0x00000021 => { cmd => 'submit_multi',
    96. 

  96. 		    reply => sub { my ($me, $pdu) = @_;
    97. 

  97. 				   $me->submit_multi_resp(message_id=>'123456789',
    98. 

  98. #							  no_unsuccess=>0,
    99. 

  99. 							  seq => $pdu->{seq} ) }, },
    100. 

  100.     0x80000021 => { cmd => 'submit_multi_resp', reply => undef, }, 
    101. 

  101.     0x00000102 => { cmd => 'alert_notification', reply => undef, },  # ***
    102. 

  102.     0x00000103 => { cmd => 'data_sm', reply => undef, },  # ***
    103. 

  103.     0x80000103 => { cmd => 'data_sm_resp', reply => undef, }, 
    104. 

  104. 

  105.     # v4 codes
    106. 

  106. 

  107.     0x80010000 => { cmd => 'generic_nack_v4', reply => undef, }, 
    108. 

  108.     0x00010001 => { cmd => 'bind_receiver_v4',
    109. 

  109. 		    reply => sub { my ($me, $pdu) = @_;
    110. 

  110. 				   $me->set_version(0x40);
    111. 

  111. 				   $me->bind_receiver_resp(system_id => $sysid,
    112. 

  112. 							   facilities_mask => $facil,
    113. 

  113. 							   seq => $pdu->{seq});
    114. 

  114. 			       }, },
    115. 

  115.     0x80010001 => { cmd => 'bind_receiver_resp_v4', reply => undef, }, 
    116. 

  116.     0x00010002 => { cmd => 'bind_transmitter_v4',
    117. 

  117. 		    reply => sub { my ($me, $pdu) = @_;
    118. 

  118. 				   $me->set_version(0x40);
    119. 

  119. 				   $me->bind_transmitter_resp(system_id => $sysid,
    120. 

  120. 							      facilities_mask => $facil,
    121. 

  121. 							      seq => $pdu->{seq});
    122. 

  122. 			       }, },
    123. 

  123.     0x80010002 => { cmd => 'bind_transmitter_resp_v4', reply => undef, }, 
    124. 

  124.     0x00010003 => { cmd => 'query_sm_v4',
    125. 

  125. 		    reply => sub { my ($me, $pdu) = @_;
    126. 

  126. 				   $me->query_sm_resp(message_id=>$pdu->{message_id},
    127. 

  127. 						      final_date=>'010711135959000+',
    128. 

  128. 						      seq => $pdu->{seq}) }, },
    129. 

  129.     0x80010003 => { cmd => 'query_sm_resp_v4', reply => undef, },     
    130. 

  130.     0x00010004 => { cmd => 'submit_sm_v4',
    131. 

  131. 		    reply => sub { my ($me, $pdu) = @_;
    132. 

  132. 				   $me->submit_sm_resp(message_id=>'123456789',
    133. 

  133. #						       num_unsuccess=>0,
    134. 

  134. #						       destination_addr=>$pdu->{source_addr},
    135. 

  135. 						       error_status_code => 0,
    136. 

  136. 						       seq => $pdu->{seq} ) }, },
    137. 

  137.     0x80010004 => { cmd => 'submit_sm_resp_v4', reply => undef, },   
    138. 

  138.     0x00010005 => { cmd => 'deliver_sm_v4', reply => undef, },
    139. 

  139.     0x80010005 => { cmd => 'deliver_sm_resp_v4', reply => undef, },  # Need to handle this?
    140. 

  140.     0x00010006 => { cmd => 'unbind_v4',
    141. 

  141. 		    reply => sub { my ($me, $pdu) = @_;
    142. 

  142. 				   $me->unbind_resp(seq => $pdu->{seq});
    143. 

  143. 				   warn "$$: Remote sent unbind. Dropping connection.";
    144. 

  144. 				   exit;
    145. 

  145. 			       }, },       
    146. 

  146.     0x80010006 => { cmd => 'unbind_resp_v4',
    147. 

  147. 		    reply => sub { warn "$$: Remote replied to unbind. Dropping connection.";
    148. 

  148. 				   exit;
    149. 

  149. 			       }, },       
    150. 

  150.     0x00010007 => { cmd => 'replace_sm_v4',
    151. 

  151. 		    reply => sub { my ($me, $pdu) = @_;
    152. 

  152. 				   $me->replace_sm_resp(seq => $pdu->{seq}) }, },
    153. 

  153.     0x80010007 => { cmd => 'replace_sm_resp_v4', reply => undef, }, 
    154. 

  154.     0x00010008 => { cmd => 'cancel_sm_v4',
    155. 

  155. 		    reply => sub { my ($me, $pdu) = @_;
    156. 

  156. 				   $me->cancel_resp(seq => $pdu->{seq}) }, },      
    157. 

  157.     0x80010008 => { cmd => 'cancel_sm_resp_v4', reply => undef, },  
    158. 

  158.     0x00010009 => { cmd => 'delivery_receipt_v4',
    159. 

  159. 		    reply => sub { my ($me, $pdu) = @_;
    160. 

  160. 				   $me->delivery_receipt_resp(seq => $pdu->{seq}) }, },
    161. 

  161.     0x80010009 => { cmd => 'delivery_receipt_resp_v4', reply => undef, },  
    162. 

  162.     0x0001000a => { cmd => 'enquire_link_v4',
    163. 

  163. 		    reply => sub { my ($me, $pdu) = @_;
    164. 

  164. 				   $me->enquire_link_resp(seq => $pdu->{seq}) }, },
    165. 

  165.     0x8001000a => { cmd => 'enquire_link_resp_v4', reply => undef, },
    166. 

  166.     0x0001000b => { cmd => 'outbind_v4',
    167. 

  167. 		    reply => sub { my ($me, $pdu) = @_;
    168. 

  168. 				   $me->set_version(0x34);
    169. 

  169. 				   $me->bind_receiver(system_id => $sysid,
    170. 

  170. 						      password => $pw,
    171. 

  171. 						      facilities_mask => $facil,
    172. 

  172. 						      seq => $pdu->{seq}) }, },
    173. 

  173. };
    174. 

  174. 

  175. $smpp = Net::SMPP->new_listen($host,
    176. 

  176. 			      smpp_version => $vers,
    177. 

  177. 			      interface_version => $if_vers,
    178. 

  178. 			      addr_ton => 0x09,
    179. 

  179. 			      addr_npi => 0x00,
    180. 

  180. 			      source_addr_ton => 0x09,
    181. 

  181. 			      source_addr_npi => 0x00,
    182. 

  182. 			      dest_addr_ton => 0x09,
    183. 

  183. 			      dest_addr_npi => 0x00,
    184. 

  184. 			      system_type => '_001',
    185. 

  185. 			      facilities_mask => $facil,
    186. 

  186. 			      port => $port,
    187. 

  187. 			      )
    188. 

  188.     or die "Can't create server: $!";
    189. 

  189. 

  190. $SIG{CHLD} = 'IGNORE';  # Don't reap zombies
    191. 

    192. 

  192. warn "$$: Entering accept loop";
    193. 

  193. while (1) {
    194. 

  194.     $c = $smpp->accept;
    195. 

  195.     if (!defined $c) {
    196. 

  196. 	print STDERR '.';
    197. 

  197. 	next;
    198. 

  198.     }
    199. 

  199.     $pid = fork or last;  # last will happen to child, parent stays in loop
    200. 

  200.     warn "$$: forked off child $pid";
    201. 

  201. }
    202. 

  202. 

  203. ### Child handles a connection
    204. 

  204. 

  205. undef $smpp;  # close listening socket
    206. 

  206. 

  207. warn "Child $$ entring main loop";
    208. 

  208. 

  209. while (1) {
    210. 

  210.     warn "Waiting for PDU";
    211. 

  211.     $pdu = $c->read_pdu() or die "$$: PDU not read. Closing connection";
    212. 

  212.     print "Received #$pdu->{seq} $pdu->{cmd}:". Net::SMPP::pdu_tab->{$pdu->{cmd}}{cmd} ."\n"
    213. 

  213. 	;
    214. 

  214.     warn Dumper($pdu) if $trace;
    215. 

  215.     #warn Net::SMPP::hexdump($pdu->{PDC_MultiPartMessage}, "\t") if $trace;
    216. 

  216. 

  217.     if (defined reply_tab->{$pdu->{cmd}}) {
    218. 

  218. 	&{reply_tab->{$pdu->{cmd}}{reply}}($c, $pdu);
    219. 

  219. 	warn "Replied";
    220. 

  220.     } else {
    221. 

  221. 	warn "Don't know to reply to $pdu->{cmd}";
    222. 

  222. 	sleep 1;
    223. 

  223.     }
    224. 

  224. }
    225. 

  225. 

  226. #EOF
    227.