1#!/usr/local/bin/perl
2#
3# Copyright (c) 2010 Sampo Kellomaki (sampo@iki.fi), All Rights Reserved.
4# Copyright (c) 2001 SymLABS <symlabs@symlabs.com>, All Rights Reserved.
5# See README for license. NO WARRANTY.
6#
7# 10.7.2001, Sampo Kellomaki <sampo@iki.fi>
8# $Id: smsc.pl,v 1.11 2007-07-20 16:39:19 sampo Exp $
9#
10# SMSC - Short Message Service Center
11#
12# Test Net::SMPP in SMSC role
13#
14# Usage: ./smsc.pl *version*
15#    version can be 4 or 3
16
17use Net::SMPP;
18use Data::Dumper;
19
20$trace = 0;
21$Net::SMPP::trace = 0;
22$sysid = "GSMSGW";
23$pw = "secret";
24$host = 'localhost';
25$port = 9900;
26$facil = 0x00010003;
27($vers) = @ARGV;
28$vers = $vers == 4 ? 0x40 : 0x34;
29$if_vers = 0x00;
30
31use constant reply_tab => {
32    0x80000000 => { cmd => 'generic_nack', reply => undef, },
33    0x00000001 => { cmd => 'bind_receiver',
34		    reply => sub { my ($me,$pdu) = @_;
35				   $me->set_version(0x34);
36				   $me->bind_receiver_resp(system_id => $sysid,
37							   seq => $pdu->{seq});
38			       }, },
39    0x80000001 => { cmd => 'bind_receiver_resp', reply => undef, },
40    0x00000002 => { cmd => 'bind_transmitter',
41		    reply => sub { my ($me, $pdu) = @_;
42				   $me->set_version(0x34);
43				   warn "Doing bind_tx_resp";
44				   $me->bind_transmitter_resp(system_id => $sysid,
45							   seq => $pdu->{seq});
46			       }, },
47    0x80000002 => { cmd => 'bind_transmitter_resp', reply => undef, },
48    0x00000003 => { cmd => 'query_sm',
49		    reply => sub { my ($me, $pdu) = @_;
50				   $me->query_sm_resp(message_id=>$pdu->{message_id},
51						      final_date=>'010711135959000+',
52							   seq => $pdu->{seq},
53						      ) }, },
54    0x80000003 => { cmd => 'query_sm_resp', reply => undef, },
55    0x00000004 => { cmd => 'submit_sm',
56		    reply => sub { my ($me, $pdu) = @_;
57				   $me->submit_sm_resp(message_id=>'123456789',
58						       seq => $pdu->{seq}) }, },
59    0x80000004 => { cmd => 'submit_sm_resp', reply => undef, },
60    0x00000005 => { cmd => 'deliver_sm', reply => undef, },    # we originate this
61    0x80000005 => { cmd => 'deliver_sm_resp', reply => undef, },  # *** need to handle this?
62    0x00000006 => { cmd => 'unbind',
63		    reply => sub { my ($me, $pdu) = @_;
64				   $me->unbind_resp(seq => $pdu->{seq});
65				   warn "$$: Remote sent unbind. Dropping connection.";
66				   exit;
67			       }, },
68    0x80000006 => { cmd => 'unbind_resp',
69		    reply => sub { warn "$$: Remote replied to unbind. Dropping connection.";
70				   exit;
71			       }, },
72    0x00000007 => { cmd => 'replace_sm',
73		    reply => sub { my ($me, $pdu) = @_;
74				   $me->replace_sm_resp(seq => $pdu->{seq}) }, },
75    0x80000007 => { cmd => 'replace_sm_resp', reply => undef, },
76    0x00000008 => { cmd => 'cancel_sm', reply => sub { my ($me, $pdu) = @_;
77						       $me->cancel_resp(seq => $pdu->{seq}) }, },
78    0x80000008 => { cmd => 'cancel_sm_resp', reply => undef, },
79    0x00000009 => { cmd => 'bind_transceiver',
80		    reply => sub { my ($me, $pdu) = @_;
81				   $me->set_version(0x34);
82				   $me->bind_transceiver_resp(system_id => $sysid,
83							      seq => $pdu->{seq});
84			       }, },
85    0x80000009 => { cmd => 'bind_transceiver_resp', reply => undef, },
86    0x0000000b => { cmd => 'outbind',
87		    reply => sub {  my ($me, $pdu) = @_;
88				    $me->set_version(0x34);
89				    $me->bind_receiver(system_id => $sysid,
90						       password => $pw) }, },
91    0x00000015 => { cmd => 'enquire_link',
92		    reply => sub { my ($me, $pdu) = @_;
93				   $me->enquire_link_resp(seq => $pdu->{seq}) }, },
94    0x80000015 => { cmd => 'enquire_link_resp', reply => undef, },
95    0x00000021 => { cmd => 'submit_multi',
96		    reply => sub { my ($me, $pdu) = @_;
97				   $me->submit_multi_resp(message_id=>'123456789',
98#							  no_unsuccess=>0,
99							  seq => $pdu->{seq} ) }, },
100    0x80000021 => { cmd => 'submit_multi_resp', reply => undef, },
101    0x00000102 => { cmd => 'alert_notification', reply => undef, },  # ***
102    0x00000103 => { cmd => 'data_sm', reply => undef, },  # ***
103    0x80000103 => { cmd => 'data_sm_resp', reply => undef, },
104
105    # v4 codes
106
107    0x80010000 => { cmd => 'generic_nack_v4', reply => undef, },
108    0x00010001 => { cmd => 'bind_receiver_v4',
109		    reply => sub { my ($me, $pdu) = @_;
110				   $me->set_version(0x40);
111				   $me->bind_receiver_resp(system_id => $sysid,
112							   facilities_mask => $facil,
113							   seq => $pdu->{seq});
114			       }, },
115    0x80010001 => { cmd => 'bind_receiver_resp_v4', reply => undef, },
116    0x00010002 => { cmd => 'bind_transmitter_v4',
117		    reply => sub { my ($me, $pdu) = @_;
118				   $me->set_version(0x40);
119				   $me->bind_transmitter_resp(system_id => $sysid,
120							      facilities_mask => $facil,
121							      seq => $pdu->{seq});
122			       }, },
123    0x80010002 => { cmd => 'bind_transmitter_resp_v4', reply => undef, },
124    0x00010003 => { cmd => 'query_sm_v4',
125		    reply => sub { my ($me, $pdu) = @_;
126				   $me->query_sm_resp(message_id=>$pdu->{message_id},
127						      final_date=>'010711135959000+',
128						      seq => $pdu->{seq}) }, },
129    0x80010003 => { cmd => 'query_sm_resp_v4', reply => undef, },
130    0x00010004 => { cmd => 'submit_sm_v4',
131		    reply => sub { my ($me, $pdu) = @_;
132				   $me->submit_sm_resp(message_id=>'123456789',
133#						       num_unsuccess=>0,
134#						       destination_addr=>$pdu->{source_addr},
135						       error_status_code => 0,
136						       seq => $pdu->{seq} ) }, },
137    0x80010004 => { cmd => 'submit_sm_resp_v4', reply => undef, },
138    0x00010005 => { cmd => 'deliver_sm_v4', reply => undef, },
139    0x80010005 => { cmd => 'deliver_sm_resp_v4', reply => undef, },  # Need to handle this?
140    0x00010006 => { cmd => 'unbind_v4',
141		    reply => sub { my ($me, $pdu) = @_;
142				   $me->unbind_resp(seq => $pdu->{seq});
143				   warn "$$: Remote sent unbind. Dropping connection.";
144				   exit;
145			       }, },
146    0x80010006 => { cmd => 'unbind_resp_v4',
147		    reply => sub { warn "$$: Remote replied to unbind. Dropping connection.";
148				   exit;
149			       }, },
150    0x00010007 => { cmd => 'replace_sm_v4',
151		    reply => sub { my ($me, $pdu) = @_;
152				   $me->replace_sm_resp(seq => $pdu->{seq}) }, },
153    0x80010007 => { cmd => 'replace_sm_resp_v4', reply => undef, },
154    0x00010008 => { cmd => 'cancel_sm_v4',
155		    reply => sub { my ($me, $pdu) = @_;
156				   $me->cancel_resp(seq => $pdu->{seq}) }, },
157    0x80010008 => { cmd => 'cancel_sm_resp_v4', reply => undef, },
158    0x00010009 => { cmd => 'delivery_receipt_v4',
159		    reply => sub { my ($me, $pdu) = @_;
160				   $me->delivery_receipt_resp(seq => $pdu->{seq}) }, },
161    0x80010009 => { cmd => 'delivery_receipt_resp_v4', reply => undef, },
162    0x0001000a => { cmd => 'enquire_link_v4',
163		    reply => sub { my ($me, $pdu) = @_;
164				   $me->enquire_link_resp(seq => $pdu->{seq}) }, },
165    0x8001000a => { cmd => 'enquire_link_resp_v4', reply => undef, },
166    0x0001000b => { cmd => 'outbind_v4',
167		    reply => sub { my ($me, $pdu) = @_;
168				   $me->set_version(0x34);
169				   $me->bind_receiver(system_id => $sysid,
170						      password => $pw,
171						      facilities_mask => $facil,
172						      seq => $pdu->{seq}) }, },
173};
174
175$smpp = Net::SMPP->new_listen($host,
176			      smpp_version => $vers,
177			      interface_version => $if_vers,
178			      addr_ton => 0x09,
179			      addr_npi => 0x00,
180			      source_addr_ton => 0x09,
181			      source_addr_npi => 0x00,
182			      dest_addr_ton => 0x09,
183			      dest_addr_npi => 0x00,
184			      system_type => '_001',
185			      facilities_mask => $facil,
186			      port => $port,
187			      )
188    or die "Can't create server: $!";
189
190$SIG{CHLD} = 'IGNORE';  # Don't reap zombies
191
192warn "$$: Entering accept loop";
193while (1) {
194    $c = $smpp->accept;
195    if (!defined $c) {
196	print STDERR '.';
197	next;
198    }
199    $pid = fork or last;  # last will happen to child, parent stays in loop
200    warn "$$: forked off child $pid";
201}
202
203### Child handles a connection
204
205undef $smpp;  # close listening socket
206
207warn "Child $$ entring main loop";
208
209while (1) {
210    warn "Waiting for PDU";
211    $pdu = $c->read_pdu() or die "$$: PDU not read. Closing connection";
212    print "Received #$pdu->{seq} $pdu->{cmd}:". Net::SMPP::pdu_tab->{$pdu->{cmd}}{cmd} ."\n"
213	;
214    warn Dumper($pdu) if $trace;
215    #warn Net::SMPP::hexdump($pdu->{PDC_MultiPartMessage}, "\t") if $trace;
216
217    if (defined reply_tab->{$pdu->{cmd}}) {
218	&{reply_tab->{$pdu->{cmd}}{reply}}($c, $pdu);
219	warn "Replied";
220    } else {
221	warn "Don't know to reply to $pdu->{cmd}";
222	sleep 1;
223    }
224}
225
226#EOF
227