line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#=============================================================================== |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# MODULE: NetSDS::Kannel |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# DESCRIPTION: This module provides API to Kannel message structure. |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# NOTES: This is NetSDS specific API implementation. |
8
|
|
|
|
|
|
|
# It's expected that kannel configuration is standard for NetSDS. |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
# AUTHOR: Michael Bochkaryov (Rattler), <misha@rattler.kiev.ua> |
11
|
|
|
|
|
|
|
# COMPANY: Net.Style |
12
|
|
|
|
|
|
|
# |
13
|
|
|
|
|
|
|
#=============================================================================== |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 NAME |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
NetSDS::Kannel - Kannel SMS gateway API |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 SYNOPSIS |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
#!/usr/bin/env perl |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
use 5.8.0; |
24
|
|
|
|
|
|
|
use warnings; |
25
|
|
|
|
|
|
|
use strict; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
use NetSDS::Kannel; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my $kannel = NetSDS::Kannel->new( |
30
|
|
|
|
|
|
|
sendsms_url => 'http://localhost:1234/sendsms', |
31
|
|
|
|
|
|
|
sendsms_user => 'sender', |
32
|
|
|
|
|
|
|
sendsms_passwd => 'secret', |
33
|
|
|
|
|
|
|
default_smsc => 'esme-megafon', |
34
|
|
|
|
|
|
|
); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
$res = $kannel->send( |
37
|
|
|
|
|
|
|
from => '1234', |
38
|
|
|
|
|
|
|
to => '380672222111', |
39
|
|
|
|
|
|
|
text => 'Hallo there!', |
40
|
|
|
|
|
|
|
smsc => 'emse-mts', |
41
|
|
|
|
|
|
|
priority => 3, |
42
|
|
|
|
|
|
|
); |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
1; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head1 DESCRIPTION |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
C<NetSDS::Kannel> module provides API to Kannel SMS gateway. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
To decrease innecessary problems we use a lot of predefined parameters |
51
|
|
|
|
|
|
|
while sending and receiving messages via Kannel HTTP API. It's not so flexible |
52
|
|
|
|
|
|
|
as direct HTTP processing but less expensive in development time ;-) |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
This modules uses LWP to send messages and CGI.pm to process messages from Kannel. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=cut |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
package NetSDS::Kannel; |
59
|
|
|
|
|
|
|
|
60
|
2
|
|
|
2
|
|
47697
|
use 5.8.0; |
|
2
|
|
|
|
|
9
|
|
|
2
|
|
|
|
|
100
|
|
61
|
2
|
|
|
2
|
|
12
|
use strict; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
92
|
|
62
|
2
|
|
|
2
|
|
12
|
use warnings; |
|
2
|
|
|
|
|
8
|
|
|
2
|
|
|
|
|
64
|
|
63
|
|
|
|
|
|
|
|
64
|
2
|
|
|
2
|
|
964
|
use NetSDS::Util::Convert; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
use NetSDS::Util::String; |
66
|
|
|
|
|
|
|
use NetSDS::Util::Types; |
67
|
|
|
|
|
|
|
use LWP::UserAgent; |
68
|
|
|
|
|
|
|
use URI::Escape; |
69
|
|
|
|
|
|
|
use XML::LibXML; |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
use base qw( |
72
|
|
|
|
|
|
|
NetSDS::Class::Abstract |
73
|
|
|
|
|
|
|
Exporter |
74
|
|
|
|
|
|
|
); |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
use version; our $VERSION = "1.300"; |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
use constant USER_AGENT => 'NetSDS Kannel API'; |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
our @EXPORT = qw( |
81
|
|
|
|
|
|
|
STATE_DELIVERED |
82
|
|
|
|
|
|
|
STATE_UNDELIVERABLE |
83
|
|
|
|
|
|
|
STATE_ENROUTE |
84
|
|
|
|
|
|
|
STATE_ACCEPTED |
85
|
|
|
|
|
|
|
STATE_REJECTED |
86
|
|
|
|
|
|
|
ESME_RINVMSGLEN |
87
|
|
|
|
|
|
|
ESME_RINVCMDID |
88
|
|
|
|
|
|
|
ESME_RINVBNDSTS |
89
|
|
|
|
|
|
|
ESME_RSYSERR |
90
|
|
|
|
|
|
|
ESME_RINVDSTADR |
91
|
|
|
|
|
|
|
ESME_RMSGQFUL |
92
|
|
|
|
|
|
|
ESME_RTHROTTLED |
93
|
|
|
|
|
|
|
ESME_RUNKNOWNERR |
94
|
|
|
|
|
|
|
ESME_RTIMEOUT |
95
|
|
|
|
|
|
|
ESME_LICENSE |
96
|
|
|
|
|
|
|
ESME_CHARGING |
97
|
|
|
|
|
|
|
); |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# SMS delivery states |
100
|
|
|
|
|
|
|
use constant STATE_DELIVERED => 1; # Delivered to MS |
101
|
|
|
|
|
|
|
use constant STATE_UNDELIVERABLE => 2; # Undeliverable |
102
|
|
|
|
|
|
|
use constant STATE_ENROUTE => 4; # Queued on SMSC |
103
|
|
|
|
|
|
|
use constant STATE_ACCEPTED => 8; # Received by SMSC |
104
|
|
|
|
|
|
|
use constant STATE_REJECTED => 16; # Rejected by SMSC |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
# Reject codes from SMSC |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
use constant ESME_RINVMSGLEN => 1; # Wrong length |
109
|
|
|
|
|
|
|
use constant ESME_RINVCMDID => 3; # Wrong SMPP command |
110
|
|
|
|
|
|
|
use constant ESME_RINVBNDSTS => 4; |
111
|
|
|
|
|
|
|
use constant ESME_RSYSERR => 8; |
112
|
|
|
|
|
|
|
use constant ESME_RINVDSTADR => 11; # Invalid destination address |
113
|
|
|
|
|
|
|
use constant ESME_RMSGQFUL => 20; |
114
|
|
|
|
|
|
|
use constant ESME_RTHROTTLED => 88; |
115
|
|
|
|
|
|
|
use constant ESME_RUNKNOWNERR => 255; |
116
|
|
|
|
|
|
|
use constant ESME_RTIMEOUT => 1057; |
117
|
|
|
|
|
|
|
use constant ESME_LICENSE => 1058; # License restriction (vendor specific) |
118
|
|
|
|
|
|
|
use constant ESME_CHARGING => 1059; # Low billing balance (vendor specific) |
119
|
|
|
|
|
|
|
use constant ESME_CHARGING_PP => 1111; # Low billing balance on prepaid (vendor specific) |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
#=============================================================================== |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=head1 CLASS API |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=over |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=item B<new(%params)> - class constructor |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
Constructor creates Kannel API handler and set it's configuration. |
130
|
|
|
|
|
|
|
Most of these parameters may be overriden while object method calls. |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
B<Admin API parameters:> |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
* admin_url - Kannel admin API URL |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
* admin_passwd - password to admin API |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
B<Sending SMS API parameters:> |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
* sendsms_url - URL of Kannel sendsms HTTP API |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
* sendsms_user - user name for sending SMS |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
* sendsms_passwd - password for sending SMS |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
* dlr_url - base URL for DLR retrieving |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
* default_smsc - default SMSC identifier for sending SMS |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
* default_timeout - default sending TCP timeout |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=back |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=cut |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
157
|
|
|
|
|
|
|
sub new { |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
my ( $class, %params ) = @_; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
my $self = $class->SUPER::new( |
162
|
|
|
|
|
|
|
admin_url => 'http://127.0.0.1:13000/', |
163
|
|
|
|
|
|
|
admin_passwd => '', |
164
|
|
|
|
|
|
|
sendsms_url => 'http://127.0.0.1:13013/cgi-bin/sendsms', |
165
|
|
|
|
|
|
|
sendsms_user => 'netsds', |
166
|
|
|
|
|
|
|
sendsms_passwd => '', |
167
|
|
|
|
|
|
|
dlr_url => 'http://127.0.0.1/smsc/kannel_receiver.fcgi', |
168
|
|
|
|
|
|
|
default_smsc => undef, |
169
|
|
|
|
|
|
|
default_timeout => 30, # 30 seconds enough for sending timeout |
170
|
|
|
|
|
|
|
%params, |
171
|
|
|
|
|
|
|
); |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# Initialize LWP user agent |
174
|
|
|
|
|
|
|
$self->{_ua} = LWP::UserAgent->new(); |
175
|
|
|
|
|
|
|
$self->{_ua}->agent( USER_AGENT . "/$VERSION" ); |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# Initialize XML parser |
178
|
|
|
|
|
|
|
$self->{_xml} = XML::LibXML->new(); |
179
|
|
|
|
|
|
|
$self->{_xml}->validation(0); |
180
|
|
|
|
|
|
|
$self->{_xml}->recover(1); |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
return $self; |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
} ## end sub new |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors('admin_url'); |
187
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors('admin_passwd'); |
188
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors('sendsms_url'); |
189
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors('sendsms_user'); |
190
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors('sendsms_passwd'); |
191
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors('dlr_url'); |
192
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors('default_smsc'); |
193
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors('default_timeout'); |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
#*********************************************************************** |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=head1 OBJECT METHODS |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=over |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=item B<send(%parameters)> - send MT SM message to Kannel |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
This method allows to send SMS message via Kannel SMS gateway. |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
Parameters (mostly the same as in Kannel sendsms API): |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
* from - source address (overrides message) |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
* to - destination address (overrides message) |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
* text - message text (byte string) |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
* udh - user data header (byte string) |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
* charset - charset of text |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
* coding - 0 for GSM 03.38, 1 for binary, 2 for UCS2 |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
* smsc - target SMSC (overrides default one) |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
* mclass - message class if necessary (0 for flash sms) |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
* validity - TTL for MO SM in minutes |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
* deferred - timeout for delayed delivery |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
Example: |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
$kannel->send_sms( |
230
|
|
|
|
|
|
|
from => '1234', |
231
|
|
|
|
|
|
|
to => '380672206770', |
232
|
|
|
|
|
|
|
text => 'Wake up!!!', |
233
|
|
|
|
|
|
|
smsc => 'nokia_modem', |
234
|
|
|
|
|
|
|
); |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=cut |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
sub send { |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
my ( $self, %params ) = @_; |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
my %send = ( |
245
|
|
|
|
|
|
|
'username' => $self->sendsms_user, |
246
|
|
|
|
|
|
|
'password' => $self->sendsms_passwd, |
247
|
|
|
|
|
|
|
'charset' => 'UTF-8', # Local text representation |
248
|
|
|
|
|
|
|
'coding' => 0, # 7 bit GSM 03.38 |
249
|
|
|
|
|
|
|
); |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
# Then we override message parameters |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
# Set sendsms URL |
254
|
|
|
|
|
|
|
my $send_url = $self->sendsms_url; |
255
|
|
|
|
|
|
|
if ( $params{sendsms_url} ) { |
256
|
|
|
|
|
|
|
$send_url = $params{sendsms_url}; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
# Set sendsms username |
260
|
|
|
|
|
|
|
if ( $params{sendsms_user} ) { |
261
|
|
|
|
|
|
|
$send{username} = $params{sendsms_user}; |
262
|
|
|
|
|
|
|
} |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
# Set sendsms password |
265
|
|
|
|
|
|
|
if ( $params{sendsms_passwd} ) { |
266
|
|
|
|
|
|
|
$send{password} = $params{sendsms_passwd}; |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
# Set source address |
270
|
|
|
|
|
|
|
if ( $params{from} ) { |
271
|
|
|
|
|
|
|
$send{from} = uri_escape( $params{from} ); |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
# Set destination address |
275
|
|
|
|
|
|
|
if ( $params{to} ) { |
276
|
|
|
|
|
|
|
$send{to} = uri_escape( $params{to} ); |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# Set message text |
280
|
|
|
|
|
|
|
if ( $params{text} ) { |
281
|
|
|
|
|
|
|
$send{text} = uri_escape( $params{text} ); |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
# Set message UDH |
285
|
|
|
|
|
|
|
if ( $params{udh} ) { |
286
|
|
|
|
|
|
|
$send{udh} = uri_escape( $params{udh} ); |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# Set message charset |
290
|
|
|
|
|
|
|
if ( $params{charset} ) { |
291
|
|
|
|
|
|
|
$send{charset} = $params{charset}; |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
# Set message mclass |
295
|
|
|
|
|
|
|
if ( defined $params{mclass} ) { |
296
|
|
|
|
|
|
|
$send{mclass} = $params{mclass}; |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
# Set data coding |
300
|
|
|
|
|
|
|
if ( $params{coding} ) { |
301
|
|
|
|
|
|
|
$send{coding} = $params{coding}; |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
# Set message TTL in minutes |
305
|
|
|
|
|
|
|
if ( $params{validity} and ( is_int( $params{validity} ) ) ) { |
306
|
|
|
|
|
|
|
$send{validity} = $params{validity}; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
# Set deferred delivery in minutes |
310
|
|
|
|
|
|
|
if ( $params{deferred} and ( is_int( $params{deferred} ) ) ) { |
311
|
|
|
|
|
|
|
$send{deferred} = $params{deferred}; |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
# Set message priority (0 to 3) |
315
|
|
|
|
|
|
|
if ( defined $params{priority} and ( is_int( $params{priority} ) and ( $params{priority} <= 3 ) and ( $params{priority} >= 0 ) ) ) { |
316
|
|
|
|
|
|
|
$send{priority} = $params{priority}; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
# Set SMSC id |
320
|
|
|
|
|
|
|
if ( $params{smsc} ) { |
321
|
|
|
|
|
|
|
$send{smsc} = $params{smsc}; |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
# Set DLR fetching mask (see kannel documentation) |
325
|
|
|
|
|
|
|
if ( $params{dlr_id} ) { |
326
|
|
|
|
|
|
|
$send{'dlr-url'} = $self->make_dlr_url( msgid => $params{dlr_id} ); |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
# Set DLR fetching mask (see kannel documentation) |
329
|
|
|
|
|
|
|
if ( $params{dlr_mask} ) { |
330
|
|
|
|
|
|
|
$send{'dlr-mask'} = $params{dlr_mask}; |
331
|
|
|
|
|
|
|
} else { |
332
|
|
|
|
|
|
|
$send{'dlr-mask'} = 3; # default mask (delivered and undeliverable) |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
# Set meta data |
337
|
|
|
|
|
|
|
if ( $params{meta} ) { |
338
|
|
|
|
|
|
|
$send{'meta-data'} = $self->make_meta( %{ $params{meta} } ); |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
# Set HTTP request timeout |
342
|
|
|
|
|
|
|
my $timeout = $self->default_timeout; |
343
|
|
|
|
|
|
|
if ( $params{timeout} ) { |
344
|
|
|
|
|
|
|
$timeout = $params{timeout}; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
$self->{_ua}->timeout($timeout); |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
# Prepare HTTP request |
349
|
|
|
|
|
|
|
my @pairs = map $_ . '=' . $send{$_}, keys %send; |
350
|
|
|
|
|
|
|
my $req = HTTP::Request->new( GET => $send_url . "?" . join '&', @pairs ); |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
# Send request |
353
|
|
|
|
|
|
|
my $res = $self->{_ua}->request($req); |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
# Analyze response |
356
|
|
|
|
|
|
|
if ( $res->is_success ) { |
357
|
|
|
|
|
|
|
return $res->content; |
358
|
|
|
|
|
|
|
} else { |
359
|
|
|
|
|
|
|
return $self->error( $res->status_line ); |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
} ## end sub send |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
#*********************************************************************** |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
=item B<receive($cgi)> - receive MO or DLR from CGI object |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
This method provides import message structure from CGI request . |
369
|
|
|
|
|
|
|
This method is just wrapper around C<receive_mo()> and C<receive_dlr()> methods. |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
Message type (MO or DLR) recognized by C<type> CGI parameter that may be C<mo> or C<dlr>. |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
my $cgi = CGI::Fast->new(); |
374
|
|
|
|
|
|
|
my %ret = $kannel->receive($cgi); |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
=cut |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
sub receive { |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
my ( $self, $cgi ) = @_; |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
my %ret = (); |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
# Set message type (MO or DLR) |
388
|
|
|
|
|
|
|
if ( $cgi->param('type') ) { |
389
|
|
|
|
|
|
|
if ( $cgi->param('type') eq 'mo' ) { |
390
|
|
|
|
|
|
|
%ret = $self->receive_mo($cgi); |
391
|
|
|
|
|
|
|
} elsif ( $cgi->param('type') eq 'dlr' ) { |
392
|
|
|
|
|
|
|
%ret = $self->receive_dlr($cgi); |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
return %ret; |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
} else { |
398
|
|
|
|
|
|
|
return $self->error("Unknown message type received"); |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
} ## end sub receive |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
#*********************************************************************** |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=item B<receive_mo($cgi)> - import MO message from CGI object |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
This method provides import message structure from CGI request . |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
Imported MO message parameters returned as hash with the following keys: |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
* smsc - Kannel's SMSC Id |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
* smsid - SMSC message ID |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
* from - subscriber's MSISDN |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
* to - service address (short code) |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
* time - SMS receive time |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
* unixtime SMS receive time as UNIX timestamp |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
* text - MO SM text |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
* bin - MO SM as binary string |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
* udh - SMS UDH (User Data Headers) |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
* coding - SMS encoding (0 - 7 bit GSM 03.38; 2 - UCS2-BE) |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
* charset - charset of MO SM text while receiving from Kannel |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
* binfo - SMPP C<service_type> parameter for billing puroses |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
=cut |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
sub receive_mo { |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
my ( $self, $cgi ) = @_; |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
my %ret = ( |
444
|
|
|
|
|
|
|
type => 'mo', |
445
|
|
|
|
|
|
|
); |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
# Set SMSC Id (smsc=%i) |
448
|
|
|
|
|
|
|
if ( $cgi->param('smsc') ) { |
449
|
|
|
|
|
|
|
$ret{smsc} = $cgi->param('smsc'); |
450
|
|
|
|
|
|
|
} else { |
451
|
|
|
|
|
|
|
$ret{smsc} = undef; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
# Set SMSC message Id (smsid=%I) |
455
|
|
|
|
|
|
|
if ( $cgi->param('smsid') ) { |
456
|
|
|
|
|
|
|
$ret{smsid} = $cgi->param('smsid'); |
457
|
|
|
|
|
|
|
} else { |
458
|
|
|
|
|
|
|
$ret{smsid} = undef; |
459
|
|
|
|
|
|
|
} |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
# Set source (subscriber) address (from=%p) |
462
|
|
|
|
|
|
|
if ( $cgi->param('from') ) { |
463
|
|
|
|
|
|
|
$ret{from} = $cgi->param('from'); |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
# Set destination (service) address (to=%P) |
467
|
|
|
|
|
|
|
if ( $cgi->param('to') ) { |
468
|
|
|
|
|
|
|
$ret{to} = $cgi->param('to'); |
469
|
|
|
|
|
|
|
} |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
# Set timestamp information (time=%t) |
472
|
|
|
|
|
|
|
if ( $cgi->param('time') ) { |
473
|
|
|
|
|
|
|
$ret{time} = $cgi->param('time'); |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
# Set UNIX timestamp information (unixtime=%T) |
477
|
|
|
|
|
|
|
if ( $cgi->param('unixtime') ) { |
478
|
|
|
|
|
|
|
$ret{unixtime} = $cgi->param('unixtime'); |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
# Set message text (text=%a) |
482
|
|
|
|
|
|
|
if ( $cgi->param('text') ) { |
483
|
|
|
|
|
|
|
$ret{text} = $cgi->param('text'); |
484
|
|
|
|
|
|
|
} |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
# Set binary message (bin=%b) |
487
|
|
|
|
|
|
|
if ( $cgi->param('bin') ) { |
488
|
|
|
|
|
|
|
$ret{bin} = $cgi->param('bin'); |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
# Set UDH (udh=%u) |
492
|
|
|
|
|
|
|
if ( $cgi->param('udh') ) { |
493
|
|
|
|
|
|
|
$ret{udh} = $cgi->param('udh'); |
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
# Set coding (coding=%c) |
497
|
|
|
|
|
|
|
if ( defined $cgi->param('coding') ) { |
498
|
|
|
|
|
|
|
$ret{coding} = $cgi->param('coding') + 0; |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
# Set charset (charset=%C) |
502
|
|
|
|
|
|
|
if ( $cgi->param('charset') ) { |
503
|
|
|
|
|
|
|
$ret{charset} = $cgi->param('charset'); |
504
|
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
# Set message class (mclass=%m) |
507
|
|
|
|
|
|
|
if ( $cgi->param('mclass') ) { |
508
|
|
|
|
|
|
|
$ret{mclass} = $cgi->param('mclass'); |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
# Set billing information (binfo=%B) |
512
|
|
|
|
|
|
|
if ( $cgi->param('binfo') ) { |
513
|
|
|
|
|
|
|
$ret{binfo} = $cgi->param('binfo'); |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
# Convert message text to UTF-8 |
517
|
|
|
|
|
|
|
if ( 1 != $ret{coding} ) { |
518
|
|
|
|
|
|
|
# It's text message |
519
|
|
|
|
|
|
|
$ret{text} = str_recode( $ret{text}, $ret{charset} ); |
520
|
|
|
|
|
|
|
$ret{text} = str_encode( $ret{text} ); |
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
# Process optional SMPP TLV (meta=%D) |
524
|
|
|
|
|
|
|
if ( $cgi->param('meta') ) { |
525
|
|
|
|
|
|
|
my $meta_str = $cgi->param('meta'); |
526
|
|
|
|
|
|
|
$ret{meta} = {}; |
527
|
|
|
|
|
|
|
if ( $meta_str =~ /^\?smpp\?(.*)$/ ) { |
528
|
|
|
|
|
|
|
foreach my $tlv_par ( split /\&/, $1 ) { |
529
|
|
|
|
|
|
|
my ( $tag, $val ) = split /\=/, $tlv_par; |
530
|
|
|
|
|
|
|
$ret{meta}->{$tag} = $val; |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
return %ret; |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
} ## end sub receive_mo |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
#*********************************************************************** |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
=item B<receive_dlr($cgi)> - import message from CGI object |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
This method provides import message structure from CGI request . |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
C<receive_dlr> method returns hash with the following keys: |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
* smsc - kannel SMSC id |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
* msgid - original MT SM message id for DLR identification |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
* smsid - SMSC message ID |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
* from - subscriber's MSISDN (phone number) |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
* to - service address (short code) |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
* time - delivery time |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
* unixtime - delivery time as UNIX timestamp |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
* dlr - DLR state |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
* dlrmsg - DLR message from SMSC |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
Example: |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
my $cgi = CGI->new(); |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
my %dlr = $kannel->receive_dlr($cgi); |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
print "DLR received for MSISDN: " . $dlr{from}; |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
=cut |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
sub receive_dlr { |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
my ( $self, $cgi ) = @_; |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
my %ret = ( |
582
|
|
|
|
|
|
|
type => 'dlr', |
583
|
|
|
|
|
|
|
); |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
# Set SMSC Id (smsc=%i) |
586
|
|
|
|
|
|
|
if ( $cgi->param('smsc') ) { |
587
|
|
|
|
|
|
|
$ret{smsc} = $cgi->param('smsc'); |
588
|
|
|
|
|
|
|
} else { |
589
|
|
|
|
|
|
|
$ret{smsc} = undef; |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
# Set VASP message Id (msgid=our_id) |
593
|
|
|
|
|
|
|
if ( $cgi->param('msgid') ) { |
594
|
|
|
|
|
|
|
$ret{msgid} = $cgi->param('msgid'); |
595
|
|
|
|
|
|
|
} else { |
596
|
|
|
|
|
|
|
$ret{msgid} = undef; |
597
|
|
|
|
|
|
|
} |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
# Set SMSC message Id (smsid=%I) |
600
|
|
|
|
|
|
|
if ( $cgi->param('smsid') ) { |
601
|
|
|
|
|
|
|
$ret{smsid} = $cgi->param('smsid'); |
602
|
|
|
|
|
|
|
} else { |
603
|
|
|
|
|
|
|
$ret{smsid} = undef; |
604
|
|
|
|
|
|
|
} |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
# Set source (subscriber) address (from=%p) |
607
|
|
|
|
|
|
|
if ( $cgi->param('from') ) { |
608
|
|
|
|
|
|
|
$ret{from} = $cgi->param('from'); |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
# Set destination (service) address (to=%P) |
612
|
|
|
|
|
|
|
if ( $cgi->param('to') ) { |
613
|
|
|
|
|
|
|
$ret{to} = $cgi->param('to'); |
614
|
|
|
|
|
|
|
} |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
# Set timestamp information (time=%t) |
617
|
|
|
|
|
|
|
if ( $cgi->param('time') ) { |
618
|
|
|
|
|
|
|
$ret{time} = $cgi->param('time'); |
619
|
|
|
|
|
|
|
} |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
# Set UNIX timestamp information (unixtime=%T) |
622
|
|
|
|
|
|
|
if ( $cgi->param('unixtime') ) { |
623
|
|
|
|
|
|
|
$ret{unixtime} = $cgi->param('unixtime'); |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
# Set DLR state (dlr=%d) |
627
|
|
|
|
|
|
|
$ret{dlr_state} = $cgi->param('dlr'); |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
# Set DLR message (dlrmsg=%A) |
630
|
|
|
|
|
|
|
$ret{dlr_msg} = $cgi->param('dlrmsg'); |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
# Process return code if not success |
633
|
|
|
|
|
|
|
if ( $ret{dlr_msg} =~ /^NACK\/(\d+)\// ) { |
634
|
|
|
|
|
|
|
$self->{reject_code} = $1; |
635
|
|
|
|
|
|
|
} |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
return %ret; |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
} ## end sub receive_dlr |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
#*********************************************************************** |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
=item B<make_dlr_url(%params)> - prepare DLR URL |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
This method creates URI escaped string with URL template for DLR notification. |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
Paramters: hash (dlr_url, msgid) |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
Returns: URI escaped DLR URL |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
=cut |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
sub make_dlr_url { |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
my ( $self, %params ) = @_; |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
# Set reference to MT message Id for identification |
660
|
|
|
|
|
|
|
my $msgid = $params{msgid}; |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
# Set DLR base URL from object property or method parameter |
663
|
|
|
|
|
|
|
my $dlr_url = $self->{dlr_url}; |
664
|
|
|
|
|
|
|
if ( $params{dlr_url} ) { $dlr_url = $params{dlr_url}; } |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
$dlr_url .= "?type=dlr&msgid=$msgid&smsid=%I&from=%p&to=%P&time=%t&unixtime=%T&dlr=%d&dlrmsg=%A"; |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
return conv_str_uri($dlr_url); |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
} |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
#*********************************************************************** |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
=item B<make_meta(%params)> - prepare SMPP optional TLV |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
This method creates URI escaped string with optional SMPP tag-lenght-value (TLV) |
677
|
|
|
|
|
|
|
parameters to send them in C<meta-data> CGI paramter of Kannel's C<sendsms> HTTP API. |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
Format of C<meta-data> parameter value: |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
?smpp?tag1=value1&tag2=value2&...tagN=valueN |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
Paramters: hash of TLV pairs |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
Returns: URI escaped string |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
Example: |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
my $meta = $self->make_meta( |
690
|
|
|
|
|
|
|
charging_id => '0', |
691
|
|
|
|
|
|
|
); |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
This will return: %3Fsmpp%3Fcharging_id%3D0 |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
=cut |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
sub make_meta { |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
my ( $self, %params ) = @_; |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
my $meta_str = '?smpp?'; # FIXME: only 'smpp' group allowed |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
my @pairs = map $_ . '=' . $params{$_}, keys %params; |
706
|
|
|
|
|
|
|
$meta_str .= join '&', @pairs; |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
return conv_str_uri($meta_str); |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
} |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
#*********************************************************************** |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
=item B<status()> - retrieve Kannel status |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
=cut |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
sub status { |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
my ($self) = @_; |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
my $res = $self->{_ua}->get( $self->admin_url . "status.xml" ); |
725
|
|
|
|
|
|
|
if ( $res->is_success ) { |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
# Parse XML and retrieve DOM structure |
728
|
|
|
|
|
|
|
# |
729
|
|
|
|
|
|
|
# NOTE: we use eval{} because of XML::LibXML calls die() on parser errors |
730
|
|
|
|
|
|
|
my $doc = undef; |
731
|
|
|
|
|
|
|
eval { $doc = $self->{_xml}->parse_string( $res->content )->documentElement(); }; |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
# Catch exceptions |
734
|
|
|
|
|
|
|
if ($@) { |
735
|
|
|
|
|
|
|
return $self->error("Can't parse XML from Kannel API"); |
736
|
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
# ========================== |
739
|
|
|
|
|
|
|
# Preparing result structure |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
# Version string |
742
|
|
|
|
|
|
|
my $result = { |
743
|
|
|
|
|
|
|
version => $doc->findvalue('/gateway/version'), |
744
|
|
|
|
|
|
|
}; |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
# Total Kannel status and uptime |
747
|
|
|
|
|
|
|
# |
748
|
|
|
|
|
|
|
# Sample XML part from status.xml API |
749
|
|
|
|
|
|
|
# <status>suspended, uptime 32d 7h 26m 43s</status> |
750
|
|
|
|
|
|
|
if ( $doc->findvalue('/gateway/status') =~ /^(\S+),\s+uptime\s+(.+)$/ ) { |
751
|
|
|
|
|
|
|
$result->{status} = $1; |
752
|
|
|
|
|
|
|
$result->{uptime} = $2; |
753
|
|
|
|
|
|
|
} |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
# Common SMS information |
756
|
|
|
|
|
|
|
$result->{sms} = { |
757
|
|
|
|
|
|
|
received_total => $doc->findvalue('/gateway/sms/received/total'), |
758
|
|
|
|
|
|
|
received_queued => $doc->findvalue('/gateway/sms/received/queued'), |
759
|
|
|
|
|
|
|
sent_total => $doc->findvalue('/gateway/sms/sent/total'), |
760
|
|
|
|
|
|
|
sent_queued => $doc->findvalue('/gateway/sms/sent/queued'), |
761
|
|
|
|
|
|
|
storesize => $doc->findvalue('/gateway/sms/storesize'), |
762
|
|
|
|
|
|
|
inbound => $doc->findvalue('/gateway/sms/inbound'), |
763
|
|
|
|
|
|
|
outbound => $doc->findvalue('/gateway/sms/outbound'), |
764
|
|
|
|
|
|
|
}; |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
# Common DLR information |
767
|
|
|
|
|
|
|
$result->{dlr} = { |
768
|
|
|
|
|
|
|
queued => $doc->findvalue('/gateway/dlr/queued'), |
769
|
|
|
|
|
|
|
storage => $doc->findvalue('/gateway/dlr/storage'), |
770
|
|
|
|
|
|
|
}; |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
# SMSC connections information |
773
|
|
|
|
|
|
|
$result->{'smsc'} = []; |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
foreach ( $doc->findnodes('/gateway/smscs/smsc') ) { |
776
|
|
|
|
|
|
|
my $smsc = { |
777
|
|
|
|
|
|
|
name => $_->findvalue('name'), |
778
|
|
|
|
|
|
|
id => $_->findvalue('id'), |
779
|
|
|
|
|
|
|
status => $_->findvalue('status'), |
780
|
|
|
|
|
|
|
received => $_->findvalue('received'), |
781
|
|
|
|
|
|
|
sent => $_->findvalue('sent'), |
782
|
|
|
|
|
|
|
failed => $_->findvalue('failed'), |
783
|
|
|
|
|
|
|
queued => $_->findvalue('queued'), |
784
|
|
|
|
|
|
|
}; |
785
|
|
|
|
|
|
|
if ( $smsc->{status} =~ /online\s+(.+)/ ) { |
786
|
|
|
|
|
|
|
$smsc->{status} = 'online'; |
787
|
|
|
|
|
|
|
$smsc->{uptime} = $1; |
788
|
|
|
|
|
|
|
} |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
push @{ $result->{'smsc'} }, $smsc; |
791
|
|
|
|
|
|
|
} |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
return $result; |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
} ## end if ( $res->is_success ) |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
else { |
798
|
|
|
|
|
|
|
return $self->error( "Can't retrieve Kannel status: " . $res->status_line ); |
799
|
|
|
|
|
|
|
} |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
} ## end sub status |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
#*********************************************************************** |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
=item B<store_status()> - retrieve message queue status |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
Not implemented yet. |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
=cut |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
sub store_status { |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
my ($self) = @_; |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
} |
818
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
#*********************************************************************** |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
=item B<shutdown()> - bring down Kannel |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=cut |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
sub shutdown { |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
my ($self) = @_; |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
return $self->_send_cmd('shutdown'); |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
#*********************************************************************** |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
=item B<suspend()> - switch Kannel to 'suspended' state |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
=cut |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
sub suspend { |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
my ($self) = @_; |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
return $self->_send_cmd('suspend'); |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
} |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
#*********************************************************************** |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
=item B<isolate()> - switch Kannel to 'isolated' state |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
=cut |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
sub isolate { |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
my ($self) = @_; |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
return $self->_send_cmd('isolate'); |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
} |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
#*********************************************************************** |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
=item B<resume()> - resume Kannel to 'online' state |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=cut |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
sub resume { |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
my ($self) = @_; |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
return $self->_send_cmd('resume'); |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
} |
882
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
#*********************************************************************** |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
=item B<restart()> - whole bearerbox restart |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
=cut |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
sub restart { |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
my ($self) = @_; |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
return $self->_send_cmd('restart'); |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
} |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
#*********************************************************************** |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
=item B<flush_dlr()> - flush queued DLR if Kannel in 'suspended' state |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
=cut |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
sub flush_dlr { |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
my ($self) = @_; |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
return $self->_send_cmd('flush-dlr'); |
912
|
|
|
|
|
|
|
|
913
|
|
|
|
|
|
|
} |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
#*********************************************************************** |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
=item B<reload_lists()> - reload black/white lists |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
=cut |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
922
|
|
|
|
|
|
|
|
923
|
|
|
|
|
|
|
sub reload_lists { |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
my ($self) = @_; |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
return $self->_send_cmd('reload-lists'); |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
} |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
#*********************************************************************** |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
=item B<log_level($level)> - change Kannel log-level |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
=cut |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
sub log_level { |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
my ( $self, $level ) = @_; |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
return $self->_send_cmd( 'log-level', level => $level ); |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
} |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
#*********************************************************************** |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
=item B<start_smsc($smsc)> - switch on SMSC connection |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
=cut |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
sub start_smsc { |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
my ( $self, $smsc ) = @_; |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
return $self->_send_cmd( 'start-smsc', smsc => $smsc ); |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
} |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
#*********************************************************************** |
964
|
|
|
|
|
|
|
|
965
|
|
|
|
|
|
|
=item B<stop_smsc($smsc)> - switch off SMSC connection |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
=cut |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
970
|
|
|
|
|
|
|
|
971
|
|
|
|
|
|
|
sub stop_smsc { |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
my ( $self, $smsc ) = @_; |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
return $self->_send_cmd( 'stop-smsc', smsc => $smsc ); |
976
|
|
|
|
|
|
|
|
977
|
|
|
|
|
|
|
} |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
#*********************************************************************** |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
=item B<add_smsc($smsc)> - add new SMSC connection |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
=cut |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
sub add_smsc { |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
my ( $self, $smsc ) = @_; |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
return $self->_send_cmd( 'add-smsc', smsc => $smsc ); |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
} |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
#*********************************************************************** |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
=item B<remove_smsc($smsc)> - remove SMSC connection |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
=cut |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
#----------------------------------------------------------------------- |
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
sub remove_smsc { |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
my ( $self, $smsc ) = @_; |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
return $self->_send_cmd( 'remove-smsc', smsc => $smsc ); |
1008
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
} |
1010
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
sub _send_cmd { |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
my ( $self, $cmd, %params ) = @_; |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
# Prepare base URL with administrative URL and password |
1016
|
|
|
|
|
|
|
my $url = $self->admin_url . "$cmd?password=" . $self->admin_passwd; |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
# Add optional parameters |
1019
|
|
|
|
|
|
|
foreach ( keys %params ) { |
1020
|
|
|
|
|
|
|
$url .= "&" . $_ . "=" . $params{$_}; |
1021
|
|
|
|
|
|
|
} |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
# Prepare and send HTTP request to Kannel admin API |
1024
|
|
|
|
|
|
|
my $req = HTTP::Request->new( GET => $url ); |
1025
|
|
|
|
|
|
|
my $res = $self->{_ua}->request($req); |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
# Analyze HTTP response |
1028
|
|
|
|
|
|
|
if ( $res->is_success ) { |
1029
|
|
|
|
|
|
|
# OK - send result data "as is" |
1030
|
|
|
|
|
|
|
return $res->content; |
1031
|
|
|
|
|
|
|
} else { |
1032
|
|
|
|
|
|
|
# Error - send error string |
1033
|
|
|
|
|
|
|
return $self->error( $res->status_line ); |
1034
|
|
|
|
|
|
|
} |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
} ## end sub _send_cmd |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
1; |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
__END__ |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
=back |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
=head1 EXAMPLES |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
See Nibelite kannel API |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
=head1 SEE ALSO |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
=over |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
=item * L<NetSDS::Class::Abstract> - base NetSDS class |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
=item * L<http://www.kannel.org/download/1.4.3/userguide-1.4.3/userguide.html> - Kannel User Guide |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
=back |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
=head1 TODO |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
1. Add PPG support. |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
2. Add OTA support. |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
=head1 AUTHOR |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
Michael Bochkaryov <misha@rattler.kiev.ua> |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
=head1 LICENSE |
1069
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
Copyright (C) 2008-2009 Net Style Ltd. |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
1073
|
|
|
|
|
|
|
it under the terms of the GNU General Public License as published by |
1074
|
|
|
|
|
|
|
the Free Software Foundation; either version 2 of the License, or |
1075
|
|
|
|
|
|
|
(at your option) any later version. |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, |
1078
|
|
|
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of |
1079
|
|
|
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
1080
|
|
|
|
|
|
|
GNU General Public License for more details. |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
You should have received a copy of the GNU General Public License |
1083
|
|
|
|
|
|
|
along with this program; if not, write to the Free Software |
1084
|
|
|
|
|
|
|
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
=cut |
1087
|
|
|
|
|
|
|
|