apps / sms / bot /
Newer Older
357 lines | 12.645kb
initial commit
admin cloud-section (root) authored on 2016-12-10
1
#!/usr/bin/perl
2

            
3
use strict;
4
use warnings;
5

            
6
use DBI;
7
use POSIX qw/ceil strftime/;
changement de moyen de commu...
seb authored on 2019-12-16
8
use HiPi::Huawei::E3531;
9
use HiPi::Huawei::Errors;
initial commit
admin cloud-section (root) authored on 2016-12-10
10

            
11
use open ':utf8';
12
use open ':std';
13
use utf8;
changement de moyen de commu...
seb authored on 2019-12-16
14

            
fix problème avec dequeue co...
Sébastien authored on 2019-12-22
15
#use Data::Dumper;
initial commit
admin cloud-section (root) authored on 2016-12-10
16

            
17
use threads;
18
use threads::shared;
19
use Thread::Queue;
changement de moyen de commu...
seb authored on 2019-12-16
20
use Thread::Semaphore;
initial commit
admin cloud-section (root) authored on 2016-12-10
21

            
changement de moyen de commu...
seb authored on 2019-12-16
22
my $scriptconf = $0;
initial commit
admin cloud-section (root) authored on 2016-12-10
23
$scriptconf =~ s/\.pl$//;
24
$scriptconf =~ s/$/.conf/;
25
if (-r $scriptconf) {
26
    package cfg;
27
    unless (my $return = do $scriptconf) {
28
        warn "couldn't parse $scriptconf: $@" if $@;
29
        warn "couldn't do $scriptconf: $!"    unless defined $return;
30
        warn "couldn't run $scriptconf"       unless $return;
31
    }
32
}
33
else {
34
    print "pas de config\n";
35
    exit;
36
}
37

            
38
$SIG{INT}=\&terminate;
39

            
changement de moyen de commu...
seb authored on 2019-12-16
40
my $inbox_sms_queue = Thread::Queue->new;
41
my $outbox_sms_queue = Thread::Queue->new;
initial commit
admin cloud-section (root) authored on 2016-12-10
42
my $mail_queue = Thread::Queue->new;
43

            
changement de moyen de commu...
seb authored on 2019-12-16
44
my $mutex = Thread::Semaphore->new();
45
STDERR->autoflush();
initial commit
admin cloud-section (root) authored on 2016-12-10
46

            
changement de moyen de commu...
seb authored on 2019-12-16
47
my $mail = threads->new(\&send_mail);
initial commit
admin cloud-section (root) authored on 2016-12-10
48

            
changement de moyen de commu...
seb authored on 2019-12-16
49
my $inbox_sms = threads->new(\&inbox_sms_parse);
initial commit
admin cloud-section (root) authored on 2016-12-10
50

            
changement de moyen de commu...
seb authored on 2019-12-16
51
my $outbox_sms = threads->new(\&hilink_send_sms);
initial commit
admin cloud-section (root) authored on 2016-12-10
52

            
changement de moyen de commu...
seb authored on 2019-12-16
53
my $hlink = HiPi::Huawei::E3531->new();
initial commit
admin cloud-section (root) authored on 2016-12-10
54

            
55
sub log_bot {
changement de moyen de commu...
seb authored on 2019-12-16
56
    $mutex->down();
57
    print STDERR sprintf("%s\n", shift);
58
    $mutex->up();
initial commit
admin cloud-section (root) authored on 2016-12-10
59
}
60

            
61
sub terminate () {
changement de moyen de commu...
seb authored on 2019-12-16
62
    log_bot($mail_queue->pending() . " mails en attente d'envoi !") if ($mail_queue->pending() > 0);
63
    $mail->exit();
64
    log_bot($inbox_sms_queue->pending() . " SMS en attente de traitement !") if ($inbox_sms_queue->pending() > 0);
65
    $inbox_sms->exit();
66
    log_bot($outbox_sms_queue->pending() . " SMS en attente d'envoi !") if ($outbox_sms_queue->pending() > 0);
67
    $outbox_sms->exit();
68
    log_bot("arrêt");
initial commit
admin cloud-section (root) authored on 2016-12-10
69
    exit 0;
70
}
71

            
72
sub sql_request ($) {
changement de moyen de commu...
seb authored on 2019-12-16
73
    my $msg = shift;
initial commit
admin cloud-section (root) authored on 2016-12-10
74
    my @result;
75
    my $dbh = DBI->connect($cfg::config{db}->{driver}, $cfg::config{db}->{user}, $cfg::config{db}->{password}, {'RaiseError' => 1});
76
    $dbh->{'mysql_enable_utf8'} = 1;
77
    $dbh->do(qq{SET NAMES "utf8"});
changement de moyen de commu...
seb authored on 2019-12-16
78
    my $sth = $dbh->prepare($msg);
initial commit
admin cloud-section (root) authored on 2016-12-10
79
    $sth->execute();
80
    if (defined($sth->{NUM_OF_FIELDS})) {
81
        while (my $ref = $sth->fetchrow_hashref()) {
82
            push @result, $ref;
83
        }
84
    }
85
    $sth->finish();
86
    $dbh->disconnect();
87
    return @result;
88
}
89

            
90
sub massive_send_sms {
changement de moyen de commu...
seb authored on 2019-12-16
91
    my $msg = shift;
92
    if ($outbox_sms_queue->pending() > 0) {
93
        $outbox_sms_queue->insert(0, [$msg->{Phone}, "un envoi massif est déjà en cours, lancé par " . $cfg::config{last_sender} . ", reste " . $outbox_sms_queue->pending() . ", annulation"]);
simplification table + répon...
admin cloud-section (root) authored on 2019-03-17
94
        return;
95
    }
changement de moyen de commu...
seb authored on 2019-12-16
96
    $cfg::config{last_sender} = $msg->{PhoneOwner};
97
    my @results = sql_request("SELECT phone, firstname, gender FROM " . $cfg::config{table} . " WHERE " . $cfg::config{group_prefix} . $msg->{groupe} . " > '0'");
simplification table + répon...
admin cloud-section (root) authored on 2019-03-17
98
    my $qty = scalar(@results);
99
    my $start_msg = "envoi de " . $qty . " SMS (fin prévue entre ". strftime("%H:%M", localtime(time() + $qty * 60)) . " et " . strftime("%H:%M", localtime(time() + $qty * 90)) . ")";
changement de moyen de commu...
seb authored on 2019-12-16
100
    $outbox_sms_queue->enqueue([$msg->{Phone}, $start_msg]);
simplification table + répon...
admin cloud-section (root) authored on 2019-03-17
101
    foreach my $contact (@results) {
102
        $contact->{phone} =~ s/[\s\.]//g;
changement de moyen de commu...
seb authored on 2019-12-16
103
        $_ = $msg->{Content};
simplification table + répon...
admin cloud-section (root) authored on 2019-03-17
104
        s/\@prénom/$contact->{firstname}/g;
corrige problème d'adaptatio...
Sébastien authored on 2024-02-13
105
        if ($contact->{gender} eq 'F') { # @(Féminin,Masculin)
106
            s/@\(([^,]+),[^\)]+\)/$1/g;
réponse prioritaire au ping ...
admin cloud-section (root) authored on 2018-11-25
107
        }
simplification table + répon...
admin cloud-section (root) authored on 2019-03-17
108
        else {
corrige problème d'adaptatio...
Sébastien authored on 2024-02-13
109
            s/@\([^,]+,([^\)]+)\)/$1/g;
initial commit
admin cloud-section (root) authored on 2016-12-10
110
        }
changement de moyen de commu...
seb authored on 2019-12-16
111
        $outbox_sms_queue->enqueue([$contact->{phone}, $_])
initial commit
admin cloud-section (root) authored on 2016-12-10
112
    }
changement de moyen de commu...
seb authored on 2019-12-16
113
    $outbox_sms_queue->enqueue([$msg->{Phone}, "envoi des SMS terminé !"]);
initial commit
admin cloud-section (root) authored on 2016-12-10
114
}
115

            
changement de moyen de commu...
seb authored on 2019-12-16
116
sub send_mail {
fix problème avec dequeue co...
Sébastien authored on 2019-12-22
117
    while (1) {
118
        my $msg = $mail_queue->dequeue_timed(10, 1);
119
        next if ! defined $msg;
changement de moyen de commu...
seb authored on 2019-12-16
120
        defined($msg->{to}) or $msg->{to} = $cfg::config{mail};
121
        open(MAIL, "|msmtp $msg->{to}");
122
        print MAIL "Subject: $msg->{Subject}\n";
123
        print MAIL "Reply-To: $msg->{Email}\n" if ($msg->{Email} ne '');
initial commit
admin cloud-section (root) authored on 2016-12-10
124

            
changement de moyen de commu...
seb authored on 2019-12-16
125
        print MAIL "$msg->{Content}\n";
initial commit
admin cloud-section (root) authored on 2016-12-10
126
        close(MAIL);
changement de moyen de commu...
seb authored on 2019-12-16
127
        log_bot("mail envoyé à $msg->{to}");
initial commit
admin cloud-section (root) authored on 2016-12-10
128
    }
129
}
130

            
131
sub wait_open_time ($$) {
132
    my ($close_hour, $open_hour) = @_;
fix: heures silencieuses
admin cloud-section (root) authored on 2018-11-25
133
    my @lt = localtime;
134
    while ($lt[2] >= $close_hour or $lt[2] <= $open_hour) {
initial commit
admin cloud-section (root) authored on 2016-12-10
135
        sleep 1800;
136
    }
137
}
138

            
changement de moyen de commu...
seb authored on 2019-12-16
139
sub hilink_send_sms {
140
    my $sendbox = HiPi::Huawei::E3531->new();
141
    while (1) {
142
        my $sms = $outbox_sms_queue->dequeue_timed(10, 1);
143
        next if ! defined $sms;
144

            
145
        if ($sendbox->{code}) {
146
            log_bot('sendbox new: ' . HiPi::Huawei::Errors->get_error_message($sendbox->{code}));
147
        }
148
        else {
149
            my $reponse = $sendbox->send_sms($$sms[0], , $$sms[1]);
150
            if ($reponse->{code}) {
151
                log_bot('send_sms: ' . HiPi::Huawei::Errors->get_error_message($reponse->{code}));
152
            }
153

            
154
            log_bot("envoi à $$sms[0] : $$sms[1]");
155
        }
bloque la supervision pendan...
Sébastien authored on 2022-08-20
156
        if ($$sms[1] eq 'envoi des SMS terminé !') {
157
            unlink('/dev/shm/smsbot.envoi_en_cours');
158
        }
changement de moyen de commu...
seb authored on 2019-12-16
159
        sleep 60 + int(rand(30));
initial commit
admin cloud-section (root) authored on 2016-12-10
160
    }
changement de moyen de commu...
seb authored on 2019-12-16
161
    log_bot('fin du thread outbox_sms');
initial commit
admin cloud-section (root) authored on 2016-12-10
162
}
163

            
164
sub is_authorized {
changement de moyen de commu...
seb authored on 2019-12-16
165
    my ($msg) = @_;
166
    my @results = sql_request("SELECT * FROM $cfg::config{table} WHERE phone = '$msg->{Phone}'");
sms/action: envoi du mail de...
admin cloud-section (root) authored on 2017-02-17
167
    if (scalar(@results) == 1) {
simplification table + répon...
admin cloud-section (root) authored on 2019-03-17
168
        my $_results = $results[0];
169
        foreach my $column (keys(%$_results)) {
170
            if ($column =~ /^$cfg::config{group_prefix}/) {
171
                if ($results[0]->{$column} == 2) {
changement de moyen de commu...
seb authored on 2019-12-16
172
                    $msg->{address} = $results[0]->{address};
simplification table + répon...
admin cloud-section (root) authored on 2019-03-17
173
                    return 1; # true
174
                }
175
            }
176
        }
177
        return 0; # false
sms/action: envoi du mail de...
admin cloud-section (root) authored on 2017-02-17
178
    }
179
    else {
simplification table + répon...
admin cloud-section (root) authored on 2019-03-17
180
        return 0; # false
sms/action: envoi du mail de...
admin cloud-section (root) authored on 2017-02-17
181
    }
initial commit
admin cloud-section (root) authored on 2016-12-10
182
}
183

            
184
sub authorized_on_table {
changement de moyen de commu...
seb authored on 2019-12-16
185
    my %msg = @_;
186
    my $table_name = $cfg::config{group_prefix} . $msg{groupe};
187
    my @results = sql_request("SELECT * FROM $cfg::config{table} WHERE phone = '$msg{id}'");
simplification table + répon...
admin cloud-section (root) authored on 2019-03-17
188
    if (scalar(@results) == 1) {
189
        if (! defined($results[0]->{$table_name})) {
changement de moyen de commu...
seb authored on 2019-12-16
190
            $msg{error} = "le groupe $msg{groupe} n'existe pas";
191
            $outbox_sms_queue->insert(0, [$msg{id}, $msg{error}]);
simplification table + répon...
admin cloud-section (root) authored on 2019-03-17
192
            return 0; # false
initial commit
admin cloud-section (root) authored on 2016-12-10
193
        }
194
    }
changement de moyen de commu...
seb authored on 2019-12-16
195
    @results = sql_request("SELECT $table_name FROM $cfg::config{table} WHERE phone = '$msg{id}'");
simplification table + répon...
admin cloud-section (root) authored on 2019-03-17
196
    if (scalar(@results) == 1) {
197
        if ($results[0]->{$table_name} != 2) {
changement de moyen de commu...
seb authored on 2019-12-16
198
            $msg{error} = "désolé, écrire au groupe $msg{groupe} n'est pas autorisé pour toi";
199
            $outbox_sms_queue->insert(0, [$msg{id}, $msg{error}]);
simplification table + répon...
admin cloud-section (root) authored on 2019-03-17
200
            return 0; # false
initial commit
admin cloud-section (root) authored on 2016-12-10
201
        }
simplification table + répon...
admin cloud-section (root) authored on 2019-03-17
202
        else {
203
            return 1; # true
initial commit
admin cloud-section (root) authored on 2016-12-10
204
        }
205
    }
206
}
207

            
208
sub react_on_message {
changement de moyen de commu...
seb authored on 2019-12-16
209
    my ($hashref , $msg) = @_;
initial commit
admin cloud-section (root) authored on 2016-12-10
210
    for my $regex (keys(%$hashref)) {
changement de moyen de commu...
seb authored on 2019-12-16
211
        if ($msg->{Content} =~ m/$regex/i) {
212
            $msg->{Content} =~ s/$regex//i;
initial commit
admin cloud-section (root) authored on 2016-12-10
213
            $hashref->{$regex}();
214
            return 1; # true
215
        }
216
    }
217
    return 0; # false
218
}
219

            
changement de moyen de commu...
seb authored on 2019-12-16
220
sub inbox_sms_parse {
fix problème avec dequeue co...
Sébastien authored on 2019-12-22
221
    while (1) {
222
        my $msg = $inbox_sms_queue->dequeue_timed(10, 1);
223
        next if ! defined $msg;
signal d'envoi immédiat du m...
admin cloud-section (root) authored on 2017-02-18
224

            
initial commit
admin cloud-section (root) authored on 2016-12-10
225
        my %part_from_user = (
passage des regex dans le fi...
admin cloud-section (root) authored on 2017-02-17
226
            $cfg::user{"message de groupe"} => sub {
changement de moyen de commu...
seb authored on 2019-12-16
227
                $msg->{groupe} = lc $1;
228
                if (authorized_on_table(groupe => $msg->{groupe}, id => $msg->{Phone})) {
bloque la supervision pendan...
Sébastien authored on 2022-08-20
229
                    open my $fh, '>', '/dev/shm/smsbot.envoi_en_cours';
230
                    close $fh;
changement de moyen de commu...
seb authored on 2019-12-16
231
                    &massive_send_sms(\%$msg);
simplification table + répon...
admin cloud-section (root) authored on 2019-03-17
232
                }
initial commit
admin cloud-section (root) authored on 2016-12-10
233
            },
passage des regex dans le fi...
admin cloud-section (root) authored on 2017-02-17
234
            $cfg::user{"message pour un destinataire"} => sub {
changement de moyen de commu...
seb authored on 2019-12-16
235
                $outbox_sms_queue->enqueue([$1, $msg->{Content}]);
initial commit
admin cloud-section (root) authored on 2016-12-10
236
            },
supervision du service de SM...
Sébastien authored on 2022-06-03
237
            $cfg::user{"supervision"} => sub {
238
                if ($1 eq 'réception') {
239
                    $outbox_sms_queue->insert(0, [$msg->{Phone}, "supervision envoi"]);
240
                    open my $fh, '>', '/dev/shm/smsbot.reception.ok';
241
                    close $fh;
242
                }
243
                elsif ($1 eq 'envoi') {
244
                    open my $fh, '>', '/dev/shm/smsbot.envoi.ok';
245
                    close $fh;
246
                }
247
            },
passage des regex dans le fi...
admin cloud-section (root) authored on 2017-02-17
248
            $cfg::user{"ping"} => sub {
changement de moyen de commu...
seb authored on 2019-12-16
249
                my $envoi_en_cours = '';
250
                if ($outbox_sms_queue->pending() > 0) {
fix problème avec dequeue co...
Sébastien authored on 2019-12-22
251
#                    for (my $queue_id = $outbox_sms_queue->pending(); $queue_id >= 0; $queue_id--) {
252
#                        log_bot(Dumper($outbox_sms_queue->peek($queue_id)));
253
#                    }
changement de moyen de commu...
seb authored on 2019-12-16
254
                    $envoi_en_cours = "\nenvoi en cours de traitement (reste " . $outbox_sms_queue->pending() . ") ";
255
                    $envoi_en_cours .= "par $cfg::config{last_sender}" if defined($cfg::config{last_sender});
sms/action: envoi du mail de...
admin cloud-section (root) authored on 2017-02-17
256
                }
changement de moyen de commu...
seb authored on 2019-12-16
257
                log_bot("envoi d'un pong à $msg->{Phone} $msg->{PhoneOwner} $envoi_en_cours");
258
                $outbox_sms_queue->insert(0, [$msg->{Phone}, "pong" . $envoi_en_cours]);
sms/action: envoi du mail de...
admin cloud-section (root) authored on 2017-02-17
259
            },
initial commit
admin cloud-section (root) authored on 2016-12-10
260
        );
261

            
changement de moyen de commu...
seb authored on 2019-12-16
262
        $msg->{Phone} =~ s/^\+33/0/;
263
        $msg->{Email} = '';
264

            
265
        my @results = sql_request("SELECT * FROM " . $cfg::config{table} . " WHERE phone = '$msg->{Phone}'");
266
        my $number_of_candidates = @results;
267
        $number_of_candidates == 0 and return;
268
        $msg->{PhoneOwner} = '(';
269
        foreach (@results) {
270
            $msg->{PhoneOwner} .= "$_->{firstname} $_->{lastname}";
271
            --$number_of_candidates > 0 and $msg->{PhoneOwner} .= ' ou ';
272
            $msg->{Email} = $_->{email};
initial commit
admin cloud-section (root) authored on 2016-12-10
273
        }
changement de moyen de commu...
seb authored on 2019-12-16
274
        $msg->{PhoneOwner} .= ')';
275
        $msg->{Subject} = "SMS recu de $msg->{Phone} $msg->{PhoneOwner}";
276

            
277
        if (defined $msg->{Phone} and !(is_authorized(\%$msg) and react_on_message(\%part_from_user, \%$msg))) {
278
            log_bot("message de $msg->{Phone} $msg->{PhoneOwner}");
279
            $mail_queue->enqueue(\%$msg);
initial commit
admin cloud-section (root) authored on 2016-12-10
280
        }
281

            
changement de moyen de commu...
seb authored on 2019-12-16
282
        undef $msg;
initial commit
admin cloud-section (root) authored on 2016-12-10
283
    }
284
}
285

            
changement de moyen de commu...
seb authored on 2019-12-16
286
$inbox_sms->detach;    # gère la file des événements produits par GTalkSMS
287
log_bot("inbox thread ok");
288
$outbox_sms->detach;   # gère la file des envois de SMS par GTalkSMS
289
log_bot("outbox thread ok");
290
$mail->detach;         # gère la file des mails
291
log_bot("mail thread ok");
initial commit
admin cloud-section (root) authored on 2016-12-10
292

            
changement de moyen de commu...
seb authored on 2019-12-16
293
my $loop = 0;
294
log_bot("robot prêt");
295
while ( 1 ) {
initial commit
admin cloud-section (root) authored on 2016-12-10
296

            
changement de moyen de commu...
seb authored on 2019-12-16
297
    $loop++;
298

            
299
    my $notifications = $hlink->check_notifications();
300
    if ($notifications->{code}) {
301
        log_bot('check_notifications: ' . HiPi::Huawei::Errors->get_error_message($notifications->{code}));
simplification table + répon...
admin cloud-section (root) authored on 2019-03-17
302
    }
changement de moyen de commu...
seb authored on 2019-12-16
303
#TODO    elsif ($notifications->{OnlineUpdateStatus} != 10) {
304
#TODO        trouver les significations
305
#TODO    }
306
    elsif ($notifications->{UnreadMessage}) {
307
        my $inbox = $hlink->get_inbox();
308
        if ($inbox->{code}) {
309
            log_bot('get_inbox: ' . HiPi::Huawei::Errors->get_error_message($inbox->{code}));
310
        }
311
        elsif (defined $inbox->{Count} and $inbox->{Count} > 0) {
312
#            log_bot($inbox->{Count} . " messages dans inbox");
313
            for (my $i = 0; $i < $inbox->{Count}; $i++) {
314
#                log_bot("id " . $inbox->{Messages}[$i]->{Index} . ", status: " . $inbox->{Messages}[$i]->{Smstat});
315
                if ($inbox->{Messages}[$i]->{Smstat}) { # message lu
316
                    my $delete = $hlink->delete_sms($inbox->{Messages}[$i]->{Index});
317
                    if ($delete->{code}) {
318
                        log_bot('delete_sms: ' . HiPi::Huawei::Errors->get_error_message($delete->{code}));
319
                    }
320
#                    log_bot("id " . $inbox->{Messages}[$i]->{Index} . " deleted");
321
                }
322
                else {
323
                    $inbox_sms_queue->enqueue($inbox->{Messages}[$i]);
324
#                    log_bot("id " . $inbox->{Messages}[$i]->{Index} . " enqueued");
325
                    my $read = $hlink->set_sms_read($inbox->{Messages}[$i]->{Index});
326
                    if ($read->{code}) {
327
                        log_bot('set_sms_read: ' . HiPi::Huawei::Errors->get_error_message($read->{code}));
328
                    }
329
#                    log_bot("id " . $inbox->{Messages}[$i]->{Index} . " marked as read") if defined $inbox->{Messages}[$i]->{Index};
330
                }
331
            }
332
        }
333
    }
334

            
335
#on vérifie toutes les 30 secondes
336
    sleep 30;
337
    log_bot('outbox_sms not running') unless ($outbox_sms->is_running());
338
    next if ($loop % 20);
339
    $loop = 0;
340

            
341
# nettoyage des envoyés toutes les 10 minutes
342
    my $outbox = $hlink->get_outbox();
343
    if ($outbox->{code}) {
344
        log_bot('get_outbox: ' . HiPi::Huawei::Errors->get_error_message($outbox->{code}));
345
    }
346
    elsif (defined $outbox->{Count} and $outbox->{Count} > 1) {
347
#        log_bot($outbox->{Count} . " messages dans outbox");
348
# on conserve le dernier envoyé
349
        for (my $i = 1; $i < $outbox->{Count}; $i++) {
350
            my $delete = $hlink->delete_sms($outbox->{Messages}[$i]->{Index});
351
            if ($delete->{code}) {
352
                log_bot('delete_sms: ' . HiPi::Huawei::Errors->get_error_message($delete->{code}));
353
            }
354
#            log_bot("id " . $outbox->{Messages}[$i]->{Index} . " deleted");
355
        }
simplification table + répon...
admin cloud-section (root) authored on 2019-03-17
356
    }
initial commit
admin cloud-section (root) authored on 2016-12-10
357
}