#!/usr/bin/perl use strict; use warnings; use Net::XMPP; use DBI; use POSIX qw/ceil strftime/; use open ':utf8'; use open ':std'; use utf8; #use Data::Dumper; use threads; use threads::shared; use Thread::Queue; $ENV{PWD} = "" if not defined $ENV{PWD}; my $scriptconf = $ENV{PWD} . "/$0"; $scriptconf =~ s/\.pl$//; $scriptconf =~ s/$/.conf/; if (-r $scriptconf) { package cfg; unless (my $return = do $scriptconf) { warn "couldn't parse $scriptconf: $@" if $@; warn "couldn't do $scriptconf: $!" unless defined $return; warn "couldn't run $scriptconf" unless $return; } } else { print "pas de config\n"; exit; } $SIG{INT}=\&terminate; #my $next_sms :shared; # utilisé pour le top du procahin envoi my $debugLevel = 0; my $phone_status : shared = ""; my $from_gtalksms_queue = Thread::Queue->new; my $to_gtalksms_queue = Thread::Queue->new; my $mail_queue = Thread::Queue->new; my $bot = &xmpp_login($cfg::config{xmpp}->{hostName}, $cfg::config{xmpp}->{portNumber}, $cfg::config{xmpp}->{userName}, $cfg::config{xmpp}->{passWord}, $cfg::config{xmpp}->{componentName}, $cfg::config{xmpp}->{resource}, $cfg::config{xmpp}->{tls}, 1, "", 0, $cfg::config{DEBUG}); $SIG{INT} = sub { $bot->Disconnect; }; my $mail = threads->new(\&ssmtp_send_mail); my $from_gtalksms = threads->new(\&from_gtalksms_parse); my $to_gtalksms = threads->new(\&xmpp_send_sms); sub debug_print { print STDERR "sendxmpp: " . (join ' ', @_) . "\n" if (@_ && ($cfg::config{DEBUG} ||$cfg::config{VERBOSE})); } sub log_bot { # open(LOGFILE,'>>', 'bot.log'); # print LOGFILE sprintf("[%s] %s\n",strftime("%Y-%m-%d %H:%M:%S", localtime), shift); print sprintf("[%s] %s\n",strftime("%Y-%m-%d %H:%M:%S", localtime), shift); # close LOGFILE; } sub xmpp_logout($) { # HACK # messages may not be received if we log out too quickly... sleep 1; my $cnx = shift; $cnx->Disconnect(); xmpp_check_result ('Disconnect',0); # well, nothing to check, really } sub terminate () { my $cnx = shift; debug_print "caught TERM"; xmpp_logout($cnx); exit 0; } sub error_exit { my ($err,$cnx) = @_; print STDERR "$err\n"; xmpp_logout ($cnx) if ($cnx); exit 1; } sub xmpp_check_result { my ($txt, $res, $cnx)=@_; error_exit ("Error '$txt': result undefined") unless (defined $res); # res may be 0 if ($res == 0) { debug_print "$txt"; # result can be true or 'ok' } elsif ((@$res == 1 && $$res[0]) || $$res[0] eq 'ok') { debug_print "$txt: " . $$res[0]; # otherwise, there is some error } else { my $errmsg = $cnx->GetErrorCode() || '?'; error_exit ("Error '$txt': " . join (': ',@$res) . "[$errmsg]", $cnx); } } sub xmpp_login ($$$$$$$$$$$) { my ($host, $port, $user, $pw, $comp, $res, $tls, $no_tls_verify, $tls_ca_path, $ssl, $debug) = @_; my $cnx = new Net::XMPP::Client(debuglevel=>0); error_exit "could not create XMPP client object: $!" unless ($cnx); my $ssl_verify = 0x01; if ($no_tls_verify) { $ssl_verify = 0x00; } debug_print "ssl_verify: $ssl_verify"; debug_print "tls_ca_path: $tls_ca_path"; my @res; my $arghash = { hostname => $host, port => $port, tls => $tls, ssl_verify => $ssl_verify, ssl_ca_path => $tls_ca_path, ssl => $ssl, connectiontype => 'tcpip', componentname => $comp }; delete $arghash->{port} unless $port; if ($arghash->{port}) { @res = $cnx->Connect(%$arghash); error_exit ("Could not connect to '$host' on port $port: $@") unless @res; } else { @res = $cnx->Connect(%$arghash); error_exit ("Could not connect to server '$host': $@") unless @res; } xmpp_check_result("Connect",\@res,$cnx); if ($comp) { my $sid = $cnx->{SESSION}->{id}; $cnx->{STREAM}->{SIDS}->{$sid}->{hostname} = $comp } @res = $cnx->AuthSend(#'hostname' => $host, 'username' => $user, 'password' => $pw, 'resource' => $res); xmpp_check_result('AuthSend',\@res,$cnx); return $cnx; } sub sql_request ($) { my $request = shift; my @result; my $dbh = DBI->connect($cfg::config{db}->{driver}, $cfg::config{db}->{user}, $cfg::config{db}->{password}, {'RaiseError' => 1}); $dbh->{'mysql_enable_utf8'} = 1; $dbh->do(qq{SET NAMES "utf8"}); my $sth = $dbh->prepare($request); $sth->execute(); if (defined($sth->{NUM_OF_FIELDS})) { while (my $ref = $sth->fetchrow_hashref()) { push @result, $ref; } } $sth->finish(); $dbh->disconnect(); return @result; } sub massive_send_sms { my $request = shift; my @results = sql_request("SELECT * FROM __tables__ WHERE phone = '$request->{phone}' AND table_id = '$request->{table}'"); if (scalar(@results) == 1) { my @results = sql_request("SELECT * FROM $request->{table}"); my $start_msg = "envoi de " . scalar(@results) . " SMS (30 max par demi-heure)"; $to_gtalksms_queue->enqueue([$request->{phone}, $start_msg]); foreach my $contact (@results) { $contact->{phone} =~ s/[\s\.]//g; $_ = $request->{body}; s/\@prénom/$contact->{firstname}/g; if ($contact->{gender} eq 'F') { s/\@\(\s*(\w+)\s*,\s*\w+\s*\)/$1/g; } else { s/\@\(\s*\w+\s*,\s*(\w+)\s*\)/$1/g; } $to_gtalksms_queue->enqueue([$contact->{phone}, $_]) } $to_gtalksms_queue->enqueue([$request->{phone}, "envoi des SMS terminé !"]); } else { $to_gtalksms_queue->enqueue([$request->{phone}, "pas la bonne base $request->{table} pour $request->{phone}"]); } } sub control_sms_flow { my ($body, $max, $interval) = @_; my $flow_control="/home/sms/flow.control"; # use bytes; # les caractères UTF-8 peuvent être codés sur plus d'un octet # my $nbr = ceil(length($$body)/140); # taille d'un SMS 140 octets my $nbr = 1; # no bytes; while (1) { my $left = $max; my $t = time; open (FILE, "<", $flow_control); my @lines = ; close FILE; open(FILE, ">", $flow_control); foreach my $line (@lines) { $line =~ /(\d+)/; my $ts = $1; if ($ts + $interval > $t) { $left--; print FILE $line; } } close FILE; log_bot(" ---> to send: $nbr; left: $left"); last if $nbr < $left; sleep 10; } open (FILE,">>", $flow_control); for (my $i = 0; $i < $nbr; $i++) { print FILE time, "\n"; } close FILE; } sub xmpp_send { my $msg = shift; $bot->MessageSend( to => $cfg::config{xmpp}->{phoneBuddy}, from => $cfg::config{xmpp}->{userName} . "@" . $cfg::config{xmpp}->{hostName}, resource => $cfg::config{xmpp}->{resource}, type => 'chat', body => $$msg ); } sub ssmtp_send_mail { while (my $request = $mail_queue->dequeue) { defined($request->{to}) or $request->{to} = $cfg::config{mail}; open(MAIL, "|/usr/lib/sendmail -t"); print MAIL "Subject: $request->{subject}\n"; print MAIL "To: $request->{to}\n"; print MAIL "$request->{body}\n"; close(MAIL); log_bot("mail envoyé à $request->{to}"); } } sub wait_open_time ($$) { my ($close_hour, $open_hour) = @_; while (strftime('%H', localtime) > $close_hour or strftime('%H', localtime) < $open_hour) { sleep 1800; } } sub xmpp_send_sms { while (my $ref = $to_gtalksms_queue->dequeue) { wait_open_time(21, 8); # pas d'envoi entre 21h et 8h # TODO lock($next_sms); # TODO $next_sms = $$ref[0]; control_sms_flow(\$$ref[1], 30, 1800); # pas plus de 30 messages de 140 caractères par demi-heure xmpp_send(\"sms:$$ref[0]:$$ref[1]"); log_bot("envoi à $$ref[0] : $$ref[1]"); sleep 10; # en attendant la maîtrise de cond_wait et cond_signal: cond_signal() called on unlocked variable at ./bot line 348 # TODO cond_wait($next_sms); # attend le top } } sub is_authorized { my ($requestor) = @_; my @results = sql_request("SELECT * FROM __authorized__ WHERE phone = '$requestor'"); return (scalar(@results) == 1); } sub authorized_on_table { my %request = @_; $request{writeable} = (defined($request{writeable})) ? "AND write_auth = '1'" : ""; my @results = sql_request("SELECT * FROM __tables__ WHERE table_id = '$request{table}' AND phone = '$request{id}' $request{writeable}"); if (scalar(@results) == 0) { my @list = sql_request("SELECT * FROM __tables__ WHERE phone = '$request{id}'"); my $list_str = ""; foreach (@list) { $list_str .= "\n- $_->{table_id}"; } ${$request{error}} = sprintf("%s%s%s%s", "désolé, $request{table} n'est pas autorisé pour toi", ($request{writeable} ne "")? " en écriture" : "", "... ou n'existe pas:", $list_str); } return (scalar(@results) == 1); } sub is_table { my %request = @_; my @results = sql_request("SHOW TABLES WHERE Tables_in_sms = '$request{table}'"); if (scalar(@results) == 0) { ${$request{error}} = "$request{table} n'existe pas... essaie la commande 'liste' pour voir tes tables"; } return (scalar(@results) == 1); } sub copy { my $request = shift; my $rmsg = ""; if (authorized_on_table(table => $request->{origin}, id => $request->{phone}, error => \$rmsg)) { if (! is_table(table => $request->{destination}, error => \$rmsg)) { sql_request("CREATE TABLE $request->{destination} SELECT * FROM $request->{origin}"); sql_request("INSERT INTO __tables__ (phone,table_id,creation_date,update_date,comment,write_auth) values('" . $request->{phone} . "','" . $request->{destination} . "','" . strftime("%Y-%m-%d %H:%M:%S", localtime) . "','" . strftime("%Y-%m-%d %H:%M:%S", localtime) . "','" . $request->{comment} . "','1')" ); $rmsg = "copie de $request->{origin} vers $request->{destination} faite"; } else { # on change le message d'erreur fourni par is_table() $rmsg = "$request->{destination} existe déjà !"; } } $to_gtalksms_queue->enqueue([$request->{phone}, $rmsg]); } sub insert { my $request = shift; my $rmsg = ""; if (authorized_on_table(table => $request->{table}, id => $request->{phone}, writeable => 1, error => \$rmsg)) { my $contact_number = 0; foreach my $contact (split("\n", $request->{body})) { my ($firstname, $lastname, $phone, $gender) = split(";", $contact); sql_request("INSERT INTO $request->{table} (firstname,lastname,phone,gender) values ($firstname, $lastname, $phone, $gender)"); $contact_number++; } $rmsg = "$contact_number contacts ajoutés dans $request->{table}" } $to_gtalksms_queue->enqueue([$request->{phone}, $rmsg]); } sub react_on_message { my ($hashref , $request) = @_; for my $regex (keys(%$hashref)) { if ($request->{body} =~ m/$regex/i) { $request->{body} =~ s/$regex//i; $hashref->{$regex}(); return 1; # true } } return 0; # false } sub messageCB { my ($sid, $msg) = @_; $from_gtalksms_queue->enqueue($msg) if $msg->DefinedBody(); } sub from_gtalksms_parse { while (my $msg = $from_gtalksms_queue->dequeue) { my %request = (body => $msg->GetBody); my %part_from_gtalksms = ( '^Message\s+de\s+\+33([67]\d{8})\s+:\W*' => sub { # Message de +33612345678 : $request{phone} = "0" . $1; $request{phone_owner} = ''; my @results = sql_request("SELECT * FROM section WHERE phone = '$request{phone}'"); my $number_of_candidates = @results; $number_of_candidates == 0 and return; $request{phone_owner} .= '('; foreach (@results) { $request{phone_owner} .= "$_->{firstname} $_->{lastname}"; --$number_of_candidates > 0 and $request{phone_owner} .= ' ou '; } $request{phone_owner} .= ')'; log_bot("message de $request{phone} $request{phone_owner}"); }, '^SMS "(.+)" pour (0\d{9}) délivré\.$' => sub { # SMS "un contenu de SMS" pour 0612345678 délivré. log_bot("message $1 délivré pour $2"); # TODO cond_signal($next_sms); }, '^Le destinataire par défaut est (\+33|0)\d{9}$' => sub { # Le destinataire par défaut est 0612345678: inutile return; }, ); my %part_from_user = ( '^stoppe le bousin$' => sub { log_bot("arrêt demandé par $request{phone} $request{phone_owner}"); $bot->Disconnect(); }, '^\s*envoi\s+[aà]\s+(\w+)\s*:\W*' => sub { $request{table} = lc $1; &massive_send_sms(\%request); }, '^\s*sms\s+pour\s+(0\d{9})\s*:(.+)$' => sub { $to_gtalksms_queue->enqueue([$1, $2]); }, '^\s*copie\s+(\w+)\s+en\s+(\w+)(.*)$' => sub { $request{origin} = lc $1; $request{destination} = lc $2; $request{comment} = $3 =~ s/^\s*//r; ©(\%request); }, '^\s*ajoute\s+dans\+(\w+)\s*:\n' => sub { $request{table} = lc $1; &insert(\%request); }, '^\s*ping\s*$' => sub { log_bot("envoi d'un pong à $request{phone} $request{phone_owner}"); $to_gtalksms_queue->enqueue([$request{phone}, "pong ($phone_status)"]); }, ); if (react_on_message(\%part_from_gtalksms, \%request)) { if (defined $request{phone} and !(is_authorized($request{phone}) and react_on_message(\%part_from_user, \%request))) { $request{subject} = "SMS recu de $request{phone} $request{phone_owner}"; $mail_queue->enqueue(\%request); } } else { log_bot("message de type inconnu: $request{body}") unless $request{body} eq ""; } undef %request; } } $from_gtalksms->detach; # gère la file des événements produits par GTalkSMS $to_gtalksms->detach; # gère la file des envois de SMS par GTalkSMS $mail->detach; # gère la file des mails $bot->SetMessageCallBacks(chat => \&messageCB); #print "Logged in to $hostName:$portNumber...\n"; $bot->PresenceSend(); my $roster = $bot->Roster; $roster->add($cfg::config{xmpp}->{phoneBuddy}); while(defined($bot->Process())) { $bot->RosterGet(); my $status = $roster->query($cfg::config{xmpp}->{phoneBuddy},'resources'); $phone_status = $status->{GTalkSMS}->{status} =~ s/^GTalkSMS - //r if $status; }