apps / sms / bot /
Newer Older
541 lines | 19.3kb
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 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...
admin cloud-section (root) authored on 2016-12-13
19
$ENV{PWD} = "" if not defined $ENV{PWD};
initial commit
admin cloud-section (root) authored on 2016-12-10
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...
admin cloud-section (root) authored on 2016-12-13
40
my $phone_status : shared = "";
initial commit
admin cloud-section (root) authored on 2016-12-10
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;
temps d'attente aléatoire en...
admin cloud-section (root) authored on 2018-04-02
239
        sleep 60;
initial commit
admin cloud-section (root) authored on 2016-12-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...
admin cloud-section (root) authored on 2016-12-13
249
            to => $cfg::config{xmpp}->{phoneBuddy}, 
initial commit
admin cloud-section (root) authored on 2016-12-10
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";
possibilité de répondre par ...
admin cloud-section (root) authored on 2018-04-02
263
        print MAIL "Reply-To: $request->{email}\n" if ($request->{email} ne '');
initial commit
admin cloud-section (root) authored on 2016-12-10
264
        print MAIL "$request->{body}\n";
265
        close(MAIL);
266
        log_bot("mail envoyé à $request->{to}");
267
    }
268
}
269

            
270
sub wait_open_time ($$) {
271
    my ($close_hour, $open_hour) = @_;
fix: heures silencieuses
admin cloud-section (root) authored on 2018-11-25
272
    my @lt = localtime;
273
    while ($lt[2] >= $close_hour or $lt[2] <= $open_hour) {
initial commit
admin cloud-section (root) authored on 2016-12-10
274
        sleep 1800;
275
    }
276
}
277

            
278
sub xmpp_send_sms {
279
    while (my $ref = $to_gtalksms_queue->dequeue) {
280
        wait_open_time(21, 8); # pas d'envoi entre 21h et 8h
281
#        TODO lock($next_sms);
282
#        TODO $next_sms = $$ref[0];
temps d'attente aléatoire en...
admin cloud-section (root) authored on 2018-04-02
283
#        control_sms_flow(\$$ref[1], 30, 1800); # pas plus de 30 messages de 140 caractères par demi-heure
initial commit
admin cloud-section (root) authored on 2016-12-10
284
        xmpp_send(\"sms:$$ref[0]:$$ref[1]");
285
        log_bot("envoi à $$ref[0] : $$ref[1]");
temps d'attente aléatoire en...
admin cloud-section (root) authored on 2018-04-02
286
        sleep 60 + int(rand(30)); # en attendant la maîtrise de cond_wait et cond_signal: cond_signal() called on unlocked variable at ./bot line 348
initial commit
admin cloud-section (root) authored on 2016-12-10
287
#        TODO cond_wait($next_sms); # attend le top 
288
    }
289
}
290

            
291
sub is_authorized {
sms/action: envoi du mail de...
admin cloud-section (root) authored on 2017-02-17
292
    my ($request) = @_;
293
    my @results = sql_request("SELECT * FROM __authorized__ WHERE phone = '$request->{phone}'");
294
    if (scalar(@results) == 1) {
295
        $request->{address} = $results[0]->{address};
296
        return 1;
297
    }
298
    else {
299
        return 0;
300
    }
initial commit
admin cloud-section (root) authored on 2016-12-10
301
}
302

            
303
sub authorized_on_table {
304
    my %request = @_;
305
    $request{writeable} = (defined($request{writeable})) ? "AND write_auth = '1'" : "";
306
    my @results = sql_request("SELECT * FROM __tables__ WHERE table_id = '$request{table}' AND phone = '$request{id}' $request{writeable}");
307
    if (scalar(@results) == 0) {
308
        my @list = sql_request("SELECT * FROM __tables__ WHERE phone = '$request{id}'");
309
        my $list_str = "";
310
        foreach (@list) {
311
            $list_str .= "\n- $_->{table_id}";
312
        }
313
        ${$request{error}} = sprintf("%s%s%s%s", 
314
                "désolé, $request{table} n'est pas autorisé pour toi", 
315
                ($request{writeable} ne "")? " en écriture" : "", 
316
                "... ou n'existe pas:",
317
                $list_str);
318
    }
319
    return (scalar(@results) == 1);
320
}
321

            
322
sub is_table {
323
    my %request = @_;
324
    my @results = sql_request("SHOW TABLES WHERE Tables_in_sms = '$request{table}'");
325
    if (scalar(@results) == 0) {
326
        ${$request{error}} = "$request{table} n'existe pas... essaie la commande 'liste' pour voir tes tables";
327
    }
328
    return (scalar(@results) == 1);
329
}
330

            
331
sub copy {
332
    my $request = shift;
333
    my $rmsg = "";
334
    if (authorized_on_table(table => $request->{origin}, id => $request->{phone}, error => \$rmsg)) {
335
        if (! is_table(table => $request->{destination}, error => \$rmsg)) {
336
            sql_request("CREATE TABLE $request->{destination} SELECT * FROM $request->{origin}");
337
            sql_request("INSERT INTO __tables__ (phone,table_id,creation_date,update_date,comment,write_auth) values('"
338
                    . $request->{phone} . "','"
339
                    . $request->{destination} . "','"
340
                    . strftime("%Y-%m-%d %H:%M:%S", localtime) . "','"
341
                    . strftime("%Y-%m-%d %H:%M:%S", localtime) . "','"
342
                    . $request->{comment} . "','1')"
343
                    );
344
            $rmsg = "copie de $request->{origin} vers $request->{destination} faite";
345
        }
346
        else { # on change le message d'erreur fourni par is_table()
347
            $rmsg = "$request->{destination} existe déjà !"; 
348
        }
349
    }
350
    $to_gtalksms_queue->enqueue([$request->{phone}, $rmsg]);
351
}
352

            
353
sub insert {
354
    my $request = shift;
355
    my $rmsg = "";
356
    if (authorized_on_table(table => $request->{table}, id => $request->{phone}, writeable => 1, error => \$rmsg)) {
357
        my $contact_number = 0;
358
        foreach my $contact (split("\n", $request->{body})) {
359
            my ($firstname, $lastname, $phone, $gender) = split(";", $contact);
360
            sql_request("INSERT INTO $request->{table} (firstname,lastname,phone,gender) values ($firstname, $lastname, $phone, $gender)");
361
            $contact_number++;
362
        }
363
        $rmsg = "$contact_number contacts ajoutés dans $request->{table}"
364
    }
365
    $to_gtalksms_queue->enqueue([$request->{phone}, $rmsg]);
366
}
367

            
368
sub react_on_message {
369
    my ($hashref , $request) = @_;
370
    for my $regex (keys(%$hashref)) {
371
        if ($request->{body} =~ m/$regex/i) {
372
            $request->{body} =~ s/$regex//i;
373
            $hashref->{$regex}();
374
            return 1; # true
375
        }
376
    }
377
    return 0; # false
378
}
379

            
380
sub messageCB {
381
    my ($sid, $msg) = @_;
382
    $from_gtalksms_queue->enqueue($msg) if $msg->DefinedBody();
383
}
384

            
385
sub from_gtalksms_parse {
386
    while (my $msg = $from_gtalksms_queue->dequeue) {
387
        my %request = (body => $msg->GetBody);
388
        my %part_from_gtalksms = (
passage des regex dans le fi...
admin cloud-section (root) authored on 2017-02-17
389
            $cfg::gtalksms{"from"} => sub { # Message de +33612345678 :
initial commit
admin cloud-section (root) authored on 2016-12-10
390
                $request{phone} = "0" . $1;
391
                $request{phone_owner} = '';
possibilité de répondre par ...
admin cloud-section (root) authored on 2018-04-02
392
                $request{email} = '';
initial commit
admin cloud-section (root) authored on 2016-12-10
393
                my @results = sql_request("SELECT * FROM section WHERE phone = '$request{phone}'");
394
                my $number_of_candidates = @results;
395
                $number_of_candidates == 0 and return;
396
                $request{phone_owner} .= '(';
397
                foreach (@results) {
398
                    $request{phone_owner} .= "$_->{firstname} $_->{lastname}";
399
                    --$number_of_candidates > 0 and $request{phone_owner} .= ' ou ';
possibilité de répondre par ...
admin cloud-section (root) authored on 2018-04-02
400
                    $request{email} = $_->{email};
initial commit
admin cloud-section (root) authored on 2016-12-10
401
                } 
passage des regex dans le fi...
admin cloud-section (root) authored on 2017-02-17
402
                $request{"phone_owner"} .= ')';
initial commit
admin cloud-section (root) authored on 2016-12-10
403
                log_bot("message de $request{phone} $request{phone_owner}");
404
            },
passage des regex dans le fi...
admin cloud-section (root) authored on 2017-02-17
405
            $cfg::gtalksms{"delivered"} => sub { # SMS "un contenu de SMS" pour 0612345678 délivré.
initial commit
admin cloud-section (root) authored on 2016-12-10
406
                log_bot("message $1 délivré pour $2");
407
# TODO cond_signal($next_sms);
408
            },
passage des regex dans le fi...
admin cloud-section (root) authored on 2017-02-17
409
            $cfg::gtalksms{forget} => sub { # Le destinataire par défaut est 0612345678: inutile
initial commit
admin cloud-section (root) authored on 2016-12-10
410
                return;
411
            },
412
        );
signal d'envoi immédiat du m...
admin cloud-section (root) authored on 2017-02-18
413

            
414
        my %sms_action = (
415
            "create flag" => sub {
416
                my ($flag) = @_;
417
                my $gid = getgrnam("sms-action");
418
                mkdir $cfg::sms_action{flagdir};
419
                chmod 0770, $cfg::sms_action{flagdir};
420
                chown $>, $gid, $cfg::sms_action{flagdir};
421

            
422
                open(FLAG, ">" . $cfg::sms_action{flagdir} . "/" . $cfg::sms_action{flag});
423
                chmod 0660, $cfg::sms_action{flagdir} . "/" . $cfg::sms_action{flag};
424
                chown $>, $gid, $cfg::sms_action{flagdir} . "/" . $cfg::sms_action{flag};
425

            
426
                print FLAG $$flag if defined $flag;
427
                close FLAG;
428
            },
429
            "start action" => sub {
430
                # 0 = false
431
                return ! system("sudo /bin/systemctl start action.service");
432
            },
433
            "get locker" => sub {
434
                open FLAG, $cfg::sms_action{flagdir} . "/" . $cfg::sms_action{flag};
435
                my $locker = '';
436
                my $intro_ = '';
437
                while (<FLAG>) {
438
                    if (/^firstname:(.+)$/) {
439
                        $locker = " par " . $1;
440
                    }
441
                    if (/^intro:(.+)$/) {
442
                        $intro_ = " de test ($1)";
443
                    }
444
                }
445
                close FLAG;
446
                return "l'envoi " . $intro_ . " est déjà prévu" . $locker . ", abandon";
447
            },
448
        );
449

            
initial commit
admin cloud-section (root) authored on 2016-12-10
450
        my %part_from_user = (
passage des regex dans le fi...
admin cloud-section (root) authored on 2017-02-17
451
            $cfg::user{"stop"} => sub {
initial commit
admin cloud-section (root) authored on 2016-12-10
452
                log_bot("arrêt demandé par $request{phone} $request{phone_owner}");
453
                $bot->Disconnect();
454
            },
passage des regex dans le fi...
admin cloud-section (root) authored on 2017-02-17
455
            $cfg::user{"message de groupe"} => sub {
initial commit
admin cloud-section (root) authored on 2016-12-10
456
                $request{table} = lc $1;
457
                &massive_send_sms(\%request);
458
            },
passage des regex dans le fi...
admin cloud-section (root) authored on 2017-02-17
459
            $cfg::user{"message pour un destinataire"} => sub {
initial commit
admin cloud-section (root) authored on 2016-12-10
460
                $to_gtalksms_queue->enqueue([$1, $2]);
461
            },
passage des regex dans le fi...
admin cloud-section (root) authored on 2017-02-17
462
            $cfg::user{"copie d'une base"} => sub {
initial commit
admin cloud-section (root) authored on 2016-12-10
463
                $request{origin} = lc $1;
464
                $request{destination} = lc $2;
465
                $request{comment} = $3 =~ s/^\s*//r;
466
                &copy(\%request);
467
            },
passage des regex dans le fi...
admin cloud-section (root) authored on 2017-02-17
468
            $cfg::user{"ajout d'une entrée dans un base"} => sub {
initial commit
admin cloud-section (root) authored on 2016-12-10
469
                $request{table} = lc $1;
470
                &insert(\%request);
471
            },
passage des regex dans le fi...
admin cloud-section (root) authored on 2017-02-17
472
            $cfg::user{"ping"} => sub {
initial commit
admin cloud-section (root) authored on 2016-12-10
473
                log_bot("envoi d'un pong à $request{phone} $request{phone_owner}");
remplacement de nom de varia...
admin cloud-section (root) authored on 2016-12-13
474
                $to_gtalksms_queue->enqueue([$request{phone}, "pong ($phone_status)"]);
initial commit
admin cloud-section (root) authored on 2016-12-10
475
            },
passage des regex dans le fi...
admin cloud-section (root) authored on 2017-02-17
476
            $cfg::user{"test intro pour action"} => sub {
sms/action: envoi du mail de...
admin cloud-section (root) authored on 2017-02-17
477
                my $intro = $1;
signal d'envoi immédiat du m...
admin cloud-section (root) authored on 2017-02-18
478
                if (! -r $cfg::sms_action{flag_prefix} . $intro . $cfg::sms_action{flag_suffix}) {
sms/action: envoi du mail de...
admin cloud-section (root) authored on 2017-02-17
479
                    $to_gtalksms_queue->enqueue([$request{phone}, "l'intro $intro n'existe pas, abandon"]);
480
                    return;
481
                }
séparation de la configurati...
admin cloud-section (root) authored on 2017-02-17
482
                if (-r $cfg::sms_action{flagdir} . "/" . $cfg::sms_action{flag}) {
signal d'envoi immédiat du m...
admin cloud-section (root) authored on 2017-02-18
483
                    $to_gtalksms_queue->enqueue([$request{phone}, $sms_action{"get locker"}()]);
sms/action: envoi du mail de...
admin cloud-section (root) authored on 2017-02-17
484
                }
485
                else {
486
                    log_bot("demande envoi du mail des actions avec intro $intro depuis $request{phone} $request{phone_owner} à $request{address}");
signal d'envoi immédiat du m...
admin cloud-section (root) authored on 2017-02-18
487
                    my $flag_content = "to:" . $request{address} . "\nintro:" . $intro . "\nfirstname:" . $request{phone} . " " . $request{phone_owner};
488
                    $sms_action{"create flag"}(\$flag_content);
489
                    if ($sms_action{"start action"}()) {
490
                        $to_gtalksms_queue->enqueue([$request{phone}, "le mail de test des actions avec intro $intro envoyé à $request{address}"]);
491
                    }
492
                    else {
493
                        $to_gtalksms_queue->enqueue([$request{phone}, "problème: le mail de test des actions avec intro $intro pour $request{address}, n'est probablement pas parti"]);
494
                    }
sms/action: envoi du mail de...
admin cloud-section (root) authored on 2017-02-17
495
                }
496
            },
passage des regex dans le fi...
admin cloud-section (root) authored on 2017-02-17
497
            $cfg::user{"envoi normal pour action"} => sub {
séparation de la configurati...
admin cloud-section (root) authored on 2017-02-17
498
                if (-r $cfg::sms_action{flagdir} . "/" . $cfg::sms_action{flag}) {
signal d'envoi immédiat du m...
admin cloud-section (root) authored on 2017-02-18
499
                    $to_gtalksms_queue->enqueue([$request{phone}, $sms_action{"get locker"}()]);
sms/action: envoi du mail de...
admin cloud-section (root) authored on 2017-02-17
500
                }
501
                else {
502
                    log_bot("demande envoi du mail des actions depuis $request{phone} $request{phone_owner}");
signal d'envoi immédiat du m...
admin cloud-section (root) authored on 2017-02-18
503
                    $sms_action{"create flag"}();
504
                    if ($sms_action{"start action"}()) {
505
                        $to_gtalksms_queue->enqueue([$request{phone}, "le mail des actions est parti"]);
506
                    }
507
                    else {
508
                        $to_gtalksms_queue->enqueue([$request{phone}, "problème: le mail des actions n'est probablement pas parti"]);
509
                    }
sms/action: envoi du mail de...
admin cloud-section (root) authored on 2017-02-17
510
                }
511
            },
initial commit
admin cloud-section (root) authored on 2016-12-10
512
        );
513

            
514
        if (react_on_message(\%part_from_gtalksms, \%request)) {
sms/action: envoi du mail de...
admin cloud-section (root) authored on 2017-02-17
515
            if (defined $request{phone} and !(is_authorized(\%request) and react_on_message(\%part_from_user, \%request))) {
initial commit
admin cloud-section (root) authored on 2016-12-10
516
                $request{subject} = "SMS recu de $request{phone} $request{phone_owner}";
517
                $mail_queue->enqueue(\%request);
518
            }
519
        }
520
        else {
521
            log_bot("message de type inconnu: $request{body}") unless $request{body} eq "";
522
        }
523

            
524
        undef %request;
525
    }
526
}
527

            
528
$from_gtalksms->detach; # gère la file des événements produits par GTalkSMS
529
$to_gtalksms->detach;   # gère la file des envois de SMS par GTalkSMS
530
$mail->detach;          # gère la file des mails
changement d'API Perl XMPP
admin cloud-section (root) authored on 2018-04-02
531
$bot->SetMessageCallBacks(message => \&messageCB);
initial commit
admin cloud-section (root) authored on 2016-12-10
532

            
533
$bot->PresenceSend();
534
my $roster = $bot->Roster;
remplacement de nom de varia...
admin cloud-section (root) authored on 2016-12-13
535
$roster->add($cfg::config{xmpp}->{phoneBuddy});
initial commit
admin cloud-section (root) authored on 2016-12-10
536

            
537
while(defined($bot->Process())) { 
538
    $bot->RosterGet();
remplacement de nom de varia...
admin cloud-section (root) authored on 2016-12-13
539
    my $status = $roster->query($cfg::config{xmpp}->{phoneBuddy},'resources');
540
    $phone_status = $status->{GTalkSMS}->{status} =~ s/^GTalkSMS - //r if $status;
initial commit
admin cloud-section (root) authored on 2016-12-10
541
}