initial commit
|
1 |
#!/usr/bin/perl |
2 | ||
3 |
use strict; |
|
4 |
use warnings; |
|
5 | ||
6 |
use Net::XMPP; |
|
7 |
use DBI; |
|
8 |
use POSIX qw/ceil strftime/; |
|
9 | ||
10 |
use open ':utf8'; |
|
11 |
use open ':std'; |
|
12 |
use utf8; |
|
13 |
#use Data::Dumper; |
|
14 | ||
15 |
use threads; |
|
16 |
use threads::shared; |
|
17 |
use Thread::Queue; |
|
18 | ||
remplacement de nom de varia...
|
19 |
$ENV{PWD} = "" if not defined $ENV{PWD}; |
initial commit
|
20 |
my $scriptconf = $ENV{PWD} . "/$0"; |
21 |
$scriptconf =~ s/\.pl$//; |
|
22 |
$scriptconf =~ s/$/.conf/; |
|
23 |
if (-r $scriptconf) { |
|
24 |
package cfg; |
|
25 |
unless (my $return = do $scriptconf) { |
|
26 |
warn "couldn't parse $scriptconf: $@" if $@; |
|
27 |
warn "couldn't do $scriptconf: $!" unless defined $return; |
|
28 |
warn "couldn't run $scriptconf" unless $return; |
|
29 |
} |
|
30 |
} |
|
31 |
else { |
|
32 |
print "pas de config\n"; |
|
33 |
exit; |
|
34 |
} |
|
35 | ||
36 |
$SIG{INT}=\&terminate; |
|
37 |
#my $next_sms :shared; # utilisé pour le top du procahin envoi |
|
38 |
my $debugLevel = 0; |
|
39 | ||
remplacement de nom de varia...
|
40 |
my $phone_status : shared = ""; |
initial commit
|
41 | |
42 |
my $from_gtalksms_queue = Thread::Queue->new; |
|
43 |
my $to_gtalksms_queue = Thread::Queue->new; |
|
44 |
my $mail_queue = Thread::Queue->new; |
|
45 | ||
46 |
my $bot = &xmpp_login($cfg::config{xmpp}->{hostName}, |
|
47 |
$cfg::config{xmpp}->{portNumber}, |
|
48 |
$cfg::config{xmpp}->{userName}, |
|
49 |
$cfg::config{xmpp}->{passWord}, |
|
50 |
$cfg::config{xmpp}->{componentName}, |
|
51 |
$cfg::config{xmpp}->{resource}, |
|
52 |
$cfg::config{xmpp}->{tls}, |
|
53 |
1, "", 0, |
|
54 |
$cfg::config{DEBUG}); |
|
55 | ||
56 |
$SIG{INT} = sub { $bot->Disconnect; }; |
|
57 | ||
58 |
my $mail = threads->new(\&ssmtp_send_mail); |
|
59 | ||
60 |
my $from_gtalksms = threads->new(\&from_gtalksms_parse); |
|
61 | ||
62 |
my $to_gtalksms = threads->new(\&xmpp_send_sms); |
|
63 | ||
64 |
sub debug_print { |
|
65 |
print STDERR "sendxmpp: " . (join ' ', @_) . "\n" |
|
66 |
if (@_ && ($cfg::config{DEBUG} ||$cfg::config{VERBOSE})); |
|
67 |
} |
|
68 | ||
69 |
sub log_bot { |
|
70 |
# open(LOGFILE,'>>', 'bot.log'); |
|
71 |
# print LOGFILE sprintf("[%s] %s\n",strftime("%Y-%m-%d %H:%M:%S", localtime), shift); |
|
72 |
print sprintf("[%s] %s\n",strftime("%Y-%m-%d %H:%M:%S", localtime), shift); |
|
73 |
# close LOGFILE; |
|
74 |
} |
|
75 | ||
76 |
sub xmpp_logout($) { |
|
77 |
# HACK |
|
78 |
# messages may not be received if we log out too quickly... |
|
79 |
sleep 1; |
|
80 | ||
81 |
my $cnx = shift; |
|
82 |
$cnx->Disconnect(); |
|
83 |
xmpp_check_result ('Disconnect',0); # well, nothing to check, really |
|
84 |
} |
|
85 | ||
86 |
sub terminate () { |
|
87 |
my $cnx = shift; |
|
88 |
debug_print "caught TERM"; |
|
89 |
xmpp_logout($cnx); |
|
90 |
exit 0; |
|
91 |
} |
|
92 | ||
93 |
sub error_exit { |
|
94 |
my ($err,$cnx) = @_; |
|
95 |
print STDERR "$err\n"; |
|
96 |
xmpp_logout ($cnx) |
|
97 |
if ($cnx); |
|
98 |
exit 1; |
|
99 |
} |
|
100 | ||
101 |
sub xmpp_check_result { |
|
102 |
my ($txt, $res, $cnx)=@_; |
|
103 | ||
104 |
error_exit ("Error '$txt': result undefined") |
|
105 |
unless (defined $res); |
|
106 | ||
107 |
# res may be 0 |
|
108 |
if ($res == 0) { |
|
109 |
debug_print "$txt"; |
|
110 |
# result can be true or 'ok' |
|
111 |
} |
|
112 |
elsif ((@$res == 1 && $$res[0]) || $$res[0] eq 'ok') { |
|
113 |
debug_print "$txt: " . $$res[0]; |
|
114 |
# otherwise, there is some error |
|
115 |
} |
|
116 |
else { |
|
117 |
my $errmsg = $cnx->GetErrorCode() || '?'; |
|
118 |
error_exit ("Error '$txt': " . join (': ',@$res) . "[$errmsg]", $cnx); |
|
119 |
} |
|
120 |
} |
|
121 | ||
122 |
sub xmpp_login ($$$$$$$$$$$) { |
|
123 |
my ($host, $port, $user, $pw, $comp, $res, $tls, $no_tls_verify, $tls_ca_path, $ssl, $debug) = @_; |
|
124 |
my $cnx = new Net::XMPP::Client(debuglevel=>0); |
|
125 |
error_exit "could not create XMPP client object: $!" unless ($cnx); |
|
126 | ||
127 |
my $ssl_verify = 0x01; |
|
128 |
if ($no_tls_verify) { $ssl_verify = 0x00; } |
|
129 |
debug_print "ssl_verify: $ssl_verify"; |
|
130 | ||
131 |
debug_print "tls_ca_path: $tls_ca_path"; |
|
132 | ||
133 |
my @res; |
|
134 |
my $arghash = { |
|
135 |
hostname => $host, |
|
136 |
port => $port, |
|
137 |
tls => $tls, |
|
138 |
ssl_verify => $ssl_verify, |
|
139 |
ssl_ca_path => $tls_ca_path, |
|
140 |
ssl => $ssl, |
|
141 |
connectiontype => 'tcpip', |
|
142 |
componentname => $comp |
|
143 |
}; |
|
144 | ||
145 |
delete $arghash->{port} unless $port; |
|
146 |
if ($arghash->{port}) { |
|
147 |
@res = $cnx->Connect(%$arghash); |
|
148 |
error_exit ("Could not connect to '$host' on port $port: $@") unless @res; |
|
149 |
} else { |
|
150 |
@res = $cnx->Connect(%$arghash); |
|
151 |
error_exit ("Could not connect to server '$host': $@") unless @res; |
|
152 |
} |
|
153 | ||
154 |
xmpp_check_result("Connect",\@res,$cnx); |
|
155 | ||
156 |
if ($comp) { |
|
157 |
my $sid = $cnx->{SESSION}->{id}; |
|
158 |
$cnx->{STREAM}->{SIDS}->{$sid}->{hostname} = $comp |
|
159 |
} |
|
160 | ||
161 |
@res = $cnx->AuthSend(#'hostname' => $host, |
|
162 |
'username' => $user, |
|
163 |
'password' => $pw, |
|
164 |
'resource' => $res); |
|
165 |
xmpp_check_result('AuthSend',\@res,$cnx); |
|
166 | ||
167 |
return $cnx; |
|
168 |
} |
|
169 | ||
170 |
sub sql_request ($) { |
|
171 |
my $request = shift; |
|
172 |
my @result; |
|
173 |
my $dbh = DBI->connect($cfg::config{db}->{driver}, $cfg::config{db}->{user}, $cfg::config{db}->{password}, {'RaiseError' => 1}); |
|
174 |
$dbh->{'mysql_enable_utf8'} = 1; |
|
175 |
$dbh->do(qq{SET NAMES "utf8"}); |
|
176 |
my $sth = $dbh->prepare($request); |
|
177 |
$sth->execute(); |
|
178 |
if (defined($sth->{NUM_OF_FIELDS})) { |
|
179 |
while (my $ref = $sth->fetchrow_hashref()) { |
|
180 |
push @result, $ref; |
|
181 |
} |
|
182 |
} |
|
183 |
$sth->finish(); |
|
184 |
$dbh->disconnect(); |
|
185 |
return @result; |
|
186 |
} |
|
187 | ||
188 |
sub massive_send_sms { |
|
189 |
my $request = shift; |
|
190 |
my @results = sql_request("SELECT * FROM __tables__ WHERE phone = '$request->{phone}' AND table_id = '$request->{table}'"); |
|
191 |
if (scalar(@results) == 1) { |
|
192 |
my @results = sql_request("SELECT * FROM $request->{table}"); |
|
193 |
my $start_msg = "envoi de " . scalar(@results) . " SMS (30 max par demi-heure)"; |
|
194 |
$to_gtalksms_queue->enqueue([$request->{phone}, $start_msg]); |
|
195 |
foreach my $contact (@results) { |
|
196 |
$contact->{phone} =~ s/[\s\.]//g; |
|
197 |
$_ = $request->{body}; |
|
198 |
s/\@prénom/$contact->{firstname}/g; |
|
199 |
if ($contact->{gender} eq 'F') { |
|
200 |
s/\@\(\s*(\w+)\s*,\s*\w+\s*\)/$1/g; |
|
201 |
} |
|
202 |
else { |
|
203 |
s/\@\(\s*\w+\s*,\s*(\w+)\s*\)/$1/g; |
|
204 |
} |
|
205 |
$to_gtalksms_queue->enqueue([$contact->{phone}, $_]) |
|
206 |
} |
|
207 |
$to_gtalksms_queue->enqueue([$request->{phone}, "envoi des SMS terminé !"]); |
|
208 |
} |
|
209 |
else { |
|
210 |
$to_gtalksms_queue->enqueue([$request->{phone}, "pas la bonne base $request->{table} pour $request->{phone}"]); |
|
211 |
} |
|
212 |
} |
|
213 | ||
214 |
sub control_sms_flow { |
|
215 |
my ($body, $max, $interval) = @_; |
|
216 |
my $flow_control="/home/sms/flow.control"; |
|
217 |
# use bytes; # les caractères UTF-8 peuvent être codés sur plus d'un octet |
|
218 |
# my $nbr = ceil(length($$body)/140); # taille d'un SMS 140 octets |
|
219 |
my $nbr = 1; |
|
220 |
# no bytes; |
|
221 |
while (1) { |
|
222 |
my $left = $max; |
|
223 |
my $t = time; |
|
224 |
open (FILE, "<", $flow_control); |
|
225 |
my @lines = <FILE>; |
|
226 |
close FILE; |
|
227 |
open(FILE, ">", $flow_control); |
|
228 |
foreach my $line (@lines) { |
|
229 |
$line =~ /(\d+)/; |
|
230 |
my $ts = $1; |
|
231 |
if ($ts + $interval > $t) { |
|
232 |
$left--; |
|
233 |
print FILE $line; |
|
234 |
} |
|
235 |
} |
|
236 |
close FILE; |
|
237 |
log_bot(" ---> to send: $nbr; left: $left"); |
|
238 |
last if $nbr < $left; |
|
239 |
sleep 10; |
|
240 |
} |
|
241 |
open (FILE,">>", $flow_control); |
|
242 |
for (my $i = 0; $i < $nbr; $i++) { print FILE time, "\n"; } |
|
243 |
close FILE; |
|
244 |
} |
|
245 | ||
246 |
sub xmpp_send { |
|
247 |
my $msg = shift; |
|
248 |
$bot->MessageSend( |
|
remplacement de nom de varia...
|
249 |
to => $cfg::config{xmpp}->{phoneBuddy}, |
initial commit
|
250 |
from => $cfg::config{xmpp}->{userName} . "@" . $cfg::config{xmpp}->{hostName}, |
251 |
resource => $cfg::config{xmpp}->{resource}, |
|
252 |
type => 'chat', |
|
253 |
body => $$msg |
|
254 |
); |
|
255 |
} |
|
256 | ||
257 |
sub ssmtp_send_mail { |
|
258 |
while (my $request = $mail_queue->dequeue) { |
|
259 |
defined($request->{to}) or $request->{to} = $cfg::config{mail}; |
|
260 |
open(MAIL, "|/usr/lib/sendmail -t"); |
|
261 |
print MAIL "Subject: $request->{subject}\n"; |
|
262 |
print MAIL "To: $request->{to}\n"; |
|
263 |
print MAIL "$request->{body}\n"; |
|
264 |
close(MAIL); |
|
265 |
log_bot("mail envoyé à $request->{to}"); |
|
266 |
} |
|
267 |
} |
|
268 | ||
269 |
sub wait_open_time ($$) { |
|
270 |
my ($close_hour, $open_hour) = @_; |
|
271 |
while (strftime('%H', localtime) > $close_hour or strftime('%H', localtime) < $open_hour) { |
|
272 |
sleep 1800; |
|
273 |
} |
|
274 |
} |
|
275 | ||
276 |
sub xmpp_send_sms { |
|
277 |
while (my $ref = $to_gtalksms_queue->dequeue) { |
|
278 |
wait_open_time(21, 8); # pas d'envoi entre 21h et 8h |
|
279 |
# TODO lock($next_sms); |
|
280 |
# TODO $next_sms = $$ref[0]; |
|
281 |
control_sms_flow(\$$ref[1], 30, 1800); # pas plus de 30 messages de 140 caractères par demi-heure |
|
282 |
xmpp_send(\"sms:$$ref[0]:$$ref[1]"); |
|
283 |
log_bot("envoi à $$ref[0] : $$ref[1]"); |
|
284 |
sleep 10; # en attendant la maîtrise de cond_wait et cond_signal: cond_signal() called on unlocked variable at ./bot line 348 |
|
285 |
# TODO cond_wait($next_sms); # attend le top |
|
286 |
} |
|
287 |
} |
|
288 | ||
289 |
sub is_authorized { |
|
290 |
my ($requestor) = @_; |
|
291 |
my @results = sql_request("SELECT * FROM __authorized__ WHERE phone = '$requestor'"); |
|
292 |
return (scalar(@results) == 1); |
|
293 |
} |
|
294 | ||
295 |
sub authorized_on_table { |
|
296 |
my %request = @_; |
|
297 |
$request{writeable} = (defined($request{writeable})) ? "AND write_auth = '1'" : ""; |
|
298 |
my @results = sql_request("SELECT * FROM __tables__ WHERE table_id = '$request{table}' AND phone = '$request{id}' $request{writeable}"); |
|
299 |
if (scalar(@results) == 0) { |
|
300 |
my @list = sql_request("SELECT * FROM __tables__ WHERE phone = '$request{id}'"); |
|
301 |
my $list_str = ""; |
|
302 |
foreach (@list) { |
|
303 |
$list_str .= "\n- $_->{table_id}"; |
|
304 |
} |
|
305 |
${$request{error}} = sprintf("%s%s%s%s", |
|
306 |
"désolé, $request{table} n'est pas autorisé pour toi", |
|
307 |
($request{writeable} ne "")? " en écriture" : "", |
|
308 |
"... ou n'existe pas:", |
|
309 |
$list_str); |
|
310 |
} |
|
311 |
return (scalar(@results) == 1); |
|
312 |
} |
|
313 | ||
314 |
sub is_table { |
|
315 |
my %request = @_; |
|
316 |
my @results = sql_request("SHOW TABLES WHERE Tables_in_sms = '$request{table}'"); |
|
317 |
if (scalar(@results) == 0) { |
|
318 |
${$request{error}} = "$request{table} n'existe pas... essaie la commande 'liste' pour voir tes tables"; |
|
319 |
} |
|
320 |
return (scalar(@results) == 1); |
|
321 |
} |
|
322 | ||
323 |
sub copy { |
|
324 |
my $request = shift; |
|
325 |
my $rmsg = ""; |
|
326 |
if (authorized_on_table(table => $request->{origin}, id => $request->{phone}, error => \$rmsg)) { |
|
327 |
if (! is_table(table => $request->{destination}, error => \$rmsg)) { |
|
328 |
sql_request("CREATE TABLE $request->{destination} SELECT * FROM $request->{origin}"); |
|
329 |
sql_request("INSERT INTO __tables__ (phone,table_id,creation_date,update_date,comment,write_auth) values('" |
|
330 |
. $request->{phone} . "','" |
|
331 |
. $request->{destination} . "','" |
|
332 |
. strftime("%Y-%m-%d %H:%M:%S", localtime) . "','" |
|
333 |
. strftime("%Y-%m-%d %H:%M:%S", localtime) . "','" |
|
334 |
. $request->{comment} . "','1')" |
|
335 |
); |
|
336 |
$rmsg = "copie de $request->{origin} vers $request->{destination} faite"; |
|
337 |
} |
|
338 |
else { # on change le message d'erreur fourni par is_table() |
|
339 |
$rmsg = "$request->{destination} existe déjà !"; |
|
340 |
} |
|
341 |
} |
|
342 |
$to_gtalksms_queue->enqueue([$request->{phone}, $rmsg]); |
|
343 |
} |
|
344 | ||
345 |
sub insert { |
|
346 |
my $request = shift; |
|
347 |
my $rmsg = ""; |
|
348 |
if (authorized_on_table(table => $request->{table}, id => $request->{phone}, writeable => 1, error => \$rmsg)) { |
|
349 |
my $contact_number = 0; |
|
350 |
foreach my $contact (split("\n", $request->{body})) { |
|
351 |
my ($firstname, $lastname, $phone, $gender) = split(";", $contact); |
|
352 |
sql_request("INSERT INTO $request->{table} (firstname,lastname,phone,gender) values ($firstname, $lastname, $phone, $gender)"); |
|
353 |
$contact_number++; |
|
354 |
} |
|
355 |
$rmsg = "$contact_number contacts ajoutés dans $request->{table}" |
|
356 |
} |
|
357 |
$to_gtalksms_queue->enqueue([$request->{phone}, $rmsg]); |
|
358 |
} |
|
359 | ||
360 |
sub react_on_message { |
|
361 |
my ($hashref , $request) = @_; |
|
362 |
for my $regex (keys(%$hashref)) { |
|
363 |
if ($request->{body} =~ m/$regex/i) { |
|
364 |
$request->{body} =~ s/$regex//i; |
|
365 |
$hashref->{$regex}(); |
|
366 |
return 1; # true |
|
367 |
} |
|
368 |
} |
|
369 |
return 0; # false |
|
370 |
} |
|
371 | ||
372 |
sub messageCB { |
|
373 |
my ($sid, $msg) = @_; |
|
374 |
$from_gtalksms_queue->enqueue($msg) if $msg->DefinedBody(); |
|
375 |
} |
|
376 | ||
377 |
sub from_gtalksms_parse { |
|
378 |
while (my $msg = $from_gtalksms_queue->dequeue) { |
|
379 |
my %request = (body => $msg->GetBody); |
|
380 |
my %part_from_gtalksms = ( |
|
381 |
'^Message\s+de\s+\+33([67]\d{8})\s+:\W*' => sub { # Message de +33612345678 : |
|
382 |
$request{phone} = "0" . $1; |
|
383 |
$request{phone_owner} = ''; |
|
384 |
my @results = sql_request("SELECT * FROM section WHERE phone = '$request{phone}'"); |
|
385 |
my $number_of_candidates = @results; |
|
386 |
$number_of_candidates == 0 and return; |
|
387 |
$request{phone_owner} .= '('; |
|
388 |
foreach (@results) { |
|
389 |
$request{phone_owner} .= "$_->{firstname} $_->{lastname}"; |
|
390 |
--$number_of_candidates > 0 and $request{phone_owner} .= ' ou '; |
|
391 |
} |
|
392 |
$request{phone_owner} .= ')'; |
|
393 |
log_bot("message de $request{phone} $request{phone_owner}"); |
|
394 |
}, |
|
395 |
'^SMS "(.+)" pour (0\d{9}) délivré\.$' => sub { # SMS "un contenu de SMS" pour 0612345678 délivré. |
|
396 |
log_bot("message $1 délivré pour $2"); |
|
397 |
# TODO cond_signal($next_sms); |
|
398 |
}, |
|
399 |
'^Le destinataire par défaut est (\+33|0)\d{9}$' => sub { # Le destinataire par défaut est 0612345678: inutile |
|
400 |
return; |
|
401 |
}, |
|
402 |
); |
|
403 |
my %part_from_user = ( |
|
404 |
'^stoppe le bousin$' => sub { |
|
405 |
log_bot("arrêt demandé par $request{phone} $request{phone_owner}"); |
|
406 |
$bot->Disconnect(); |
|
407 |
}, |
|
408 |
'^\s*envoi\s+[aà]\s+(\w+)\s*:\W*' => sub { |
|
409 |
$request{table} = lc $1; |
|
410 |
&massive_send_sms(\%request); |
|
411 |
}, |
|
412 |
'^\s*sms\s+pour\s+(0\d{9})\s*:(.+)$' => sub { |
|
413 |
$to_gtalksms_queue->enqueue([$1, $2]); |
|
414 |
}, |
|
415 |
'^\s*copie\s+(\w+)\s+en\s+(\w+)(.*)$' => sub { |
|
416 |
$request{origin} = lc $1; |
|
417 |
$request{destination} = lc $2; |
|
418 |
$request{comment} = $3 =~ s/^\s*//r; |
|
419 |
©(\%request); |
|
420 |
}, |
|
421 |
'^\s*ajoute\s+dans\+(\w+)\s*:\n' => sub { |
|
422 |
$request{table} = lc $1; |
|
423 |
&insert(\%request); |
|
424 |
}, |
|
425 |
'^\s*ping\s*$' => sub { |
|
426 |
log_bot("envoi d'un pong à $request{phone} $request{phone_owner}"); |
|
remplacement de nom de varia...
|
427 |
$to_gtalksms_queue->enqueue([$request{phone}, "pong ($phone_status)"]); |
initial commit
|
428 |
}, |
429 |
); |
|
430 | ||
431 |
if (react_on_message(\%part_from_gtalksms, \%request)) { |
|
432 |
if (defined $request{phone} and !(is_authorized($request{phone}) and react_on_message(\%part_from_user, \%request))) { |
|
433 |
$request{subject} = "SMS recu de $request{phone} $request{phone_owner}"; |
|
434 |
$mail_queue->enqueue(\%request); |
|
435 |
} |
|
436 |
} |
|
437 |
else { |
|
438 |
log_bot("message de type inconnu: $request{body}") unless $request{body} eq ""; |
|
439 |
} |
|
440 | ||
441 |
undef %request; |
|
442 |
} |
|
443 |
} |
|
444 | ||
445 |
$from_gtalksms->detach; # gère la file des événements produits par GTalkSMS |
|
446 |
$to_gtalksms->detach; # gère la file des envois de SMS par GTalkSMS |
|
447 |
$mail->detach; # gère la file des mails |
|
448 |
$bot->SetMessageCallBacks(chat => \&messageCB); |
|
449 | ||
450 |
#print "Logged in to $hostName:$portNumber...\n"; |
|
451 |
$bot->PresenceSend(); |
|
452 |
my $roster = $bot->Roster; |
|
remplacement de nom de varia...
|
453 |
$roster->add($cfg::config{xmpp}->{phoneBuddy}); |
initial commit
|
454 | |
455 |
while(defined($bot->Process())) { |
|
456 |
$bot->RosterGet(); |
|
remplacement de nom de varia...
|
457 |
my $status = $roster->query($cfg::config{xmpp}->{phoneBuddy},'resources'); |
458 |
$phone_status = $status->{GTalkSMS}->{status} =~ s/^GTalkSMS - //r if $status; |
|
initial commit
|
459 |
} |