Foro - Perl en Español

por **jcovenas** » 2013-06-11 08:40 @403

Estimados, nuevamente escribo para consultar sobre un script de Perl que, aunque un poco viejito, me pareció muy útil.

El script recibe la dirección del remitente en $ARGV[0], el número de teléfono como $ARGV[1] y el cuerpo del mensaje en STDIN.

Sólo debemos recibir un mensaje por usuario, luego envía el cuerpo del mensaje al dæmon gnokii-smsd para su envío por sms.

El inconveniente que tengo es que al recibir el correo formateado en HTML, envía "Basurita" al sms. Sin embargo, sí funciona cuando se envía el mensaje sin formato de texto.

Me gustaría que pudieran ayudarme a entender el código para realizar las modificaciones adecuadas. También me gustaría saber si se puede activar el log que parece traer, no me refiero al syslog. Muchísimas gracias.

Adjunto el script.

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl -Tw
#
# sms transport for postfix
# uses gnokii for delivery
#
#-------------------------------------------------------------------
# Jeremy Laidman, AnswerZ
# Version 1.0 - March 2003
#
# Installation into postfix:
#
# 1) Copy this script into /usr/local/sbin/sms-transport.
#
# 2) Create the user "sms" with their own group "sms", eg:
#       useradd -r sms -c "SMS Delivery User for Postfix"
#
# 3) Add these lines
#       /etc/postfix/transport:
#               sms     sms:localhost
#
#       /etc/postfix/master.cf
#               sms     unix    -       n       n       -       1       pipe
#                  flags= user=sms:uucp argv=/usr/local/sbin/sms-transport $sender $user
#    Note that the group "uucp" needs to match the group that owns
#    the serial device configured by /etc/gnokii.conf, eg /dev/ttyS0.
#
# 4) Add "sms" to mynetworks parameter in main.cf, eg:
#       mydestination = $myhostname, localhost.$mydomain, sms
#
# 5) Run "postfix reload".
#
# 6) Send mail to [email protected]
#
# 7) Create alias entries mapping usernames to numbers
#       /etc/postfix/aliases
#               freddy: [email protected]
#
# <img src="http://perlenespanol.com/foro/images/smilies/icon_cool.gif" alt="8)" title="Cool" /> Run "newaliases".
#
# 9) Send mail to freddy.
#
#-------------------------------------------------------------------
# Configuration Options Here (will be in config file one day)
 
# if non-empty, will reject messages not from matching addresses
# a leading dot means any subdomain
# if empty, allows from anyone
# if non-mepty there's an implicit '' => 'deny'
 
$senders_file = "/usr/local/etc/sms-transport.senders";
$msgdel_file  = "/usr/local/etc/sms-transport.msgdel";
 
$gnokii_path = "/usr/local/bin/gnokii";
 
#$gnokii_path="/usr/bin/gnokii-test";
$maxsmschars = 158;                    # 160 seems to cause some problems
 
$debug = 0;
 
my %sender_addresses;
my @msgdel;
 
#-------------------------------------------------------------------
 
# We receive the sender address as @ARGV[0], the number as @ARGV[1]
# and the message body on STDIN.  We should only receive one message
# per user.
#
# All headers are stripped and only the body is sent.
#
# Any recipients in the wrong format are bounced with EX_NOUSER=67.
# Errors in calling gnokii are assumed to be temporary and are answered
# with EX_TEMPFAIL=75.  Messages with senders (from-space) that don't
# end in anything in the local domains list are bounced with EX_NOPERM=77.
#
#-------------------------------------------------------------------
#
# Constants for returning status back to postfix.
# (see sysexits.h for the full list)
$EX_NOUSER   = 67;
$EX_TEMPFAIL = 75;
$EX_NOPERM   = 77;
$EX_NOINPUT  = 66;
 
#-------------------------------------------------------------------
 
my $sender;
my $recipient;
my $message;
 
#-------------------------------------------------------------------
 
#require 'syslog.pl';
$myname   = "sms-transport";
$facility = 'mail';
my $mypid = $$;                        # global, even when we fork
 
#openlog($myname,'cons,pid',$facility);
 
sub syslog {
    my ( $level, $msg ) = @_;
    my $pri = $facility . "." . $level;
    $ENV{'HOME'}     = "/tmp";
    $ENV{'PATH'}     = "";
    $ENV{'BASH_ENV'} = "";
 
    # the way we're calling system makes it easy to trust $msg
    # as long as it's not too big, so we just untaint it
    if ( $msg =~ /(.*)/s ) {
        $msg = $1;
    }
    else {
        die "Problem with untainting log message\n";
    }
    $msg =~ s/\n/ /g;
    $msg = substr( $msg, 0, 255 )
        if length($msg) > 255;
    system( "/usr/bin/logger", "-p", $pri, "-t", $myname . "[" . $mypid . "]", "--", $msg );
}
 
sub bailout {
    my ( $rc, $msg ) = @_;
    print STDERR "$msg", "\n";
    syslog( 'error', $msg );
 
    #   closelog();
    exit $rc;
}
 
sub check_perms {
    my $sender = lc(shift);
    my $test;
    return 1 unless scalar(%sender_addresses);
 
    # strip enclosing brackets except for <>
    if ( $sender =~ /<[^>]+>/ ) {
        $sender = $1;
    }
 
    foreach $test ( keys %sender_addresses ) {
        $test = lc($test);
        if ( $test =~ /\@/ ) {
 
            # an email address
            return 1
                if $test eq $sender;
        }
        else {
 
            # a domain
            $sender =~ s/^.*@//;
            if ( $test =~ /^\./ ) {
 
                # allow subdomains
                return 1
                    if $test eq $sender;
                return 1
                    if $test eq substr( $sender, -length($test) );
            }
            else {
 
                # exact match only
                return 1
                    if $test eq $sender;
            }
        }
    }
    return 0;                          # failed
}
 
sub process_email {
    my $in_headers = 1;
    my $msg        = "";
    my $subject    = "";
    my $sender;
    my $linenum = 0;
 
    while (<STDIN>) {
        chomp;
        if ($in_headers) {
 
            # headers
            if ( length($_) == 0 ) {
                $in_headers = 0;
                next;
            }
            if ( $_ =~ /^subject:\s*/ ) {
                $subject = $';
            }
        }
        else {
 
            # body
            $msg .= "\r\n" if $msg =~ /\S/;
            $msg .= $_;
        }
        last if $linenum++ > 500;
    }
 
    # no body?  return subject
    $msg = $subject if ( !length($msg) );
 
    return $msg;
}
 
sub send_message {
    my $recipient_num = shift;
    my $message       = shift;
 
    if ( length($message) > $maxsmschars ) {
        syslog( 'info', "Truncated message from " . length($message) . " to " . $maxsmschars . "-3 chars\n" );
        $message = substr( $message, 0, $maxsmschars - 3 ) . "...";
    }
 
    # gnokii expects message on stdin
    $pid = open( GNOKII, "|-" );
    if ($pid) {                        # parent
        print GNOKII "$message";
 
        #open(FILE,">/tmp/testmsg"); print FILE "$message"; close(FILE);
        close GNOKII or bailout( $EX_TEMPFAIL, "Unable to send message to $gnokii_path" );
    }
    else {                             # child
        ( -x $gnokii_path )
            || bailout( $EX_TEMPFAIL, "Unable to exec $gnokii_path: $!" );
        $ENV{'HOME'} = "/tmp";
        $ENV{'PATH'} = "";
 
        # force into uucp and lock groups
        # FIXME: should be configurable or automagic
        #my $groups="54 233 14";
        #syslog('info',"Changing groups from [".$(."] to [$groups]");
        #$) = $groups;
        exec( $gnokii_path, "--sendsms", "$recipient_num" )
            || bailout( $EX_TEMPFAIL, "Unable to exec $gnokii_path: $!" );
 
        # will never get here
    }
}
 
sub clean_message {
    my $msg = shift;
    $msg =~ s/(\r\n)+$//;              # remove trailing crlf
                                       # delete message bits that we don't want
    my $regex;
    my $changed = 0;
    foreach $regex (@msgdel) {
        syslog( 'debug', "Testing if msg [$msg] matches /$regex/" )
            if $debug;
        if ( $msg =~ s/$regex// ) {
            $changed++;
        }
    }
    if ($changed) {
        syslog( 'debug', "Message deletions - new message: [$msg]\n" )
            if $debug;
    }
    return $msg;
}
 
#-------------------------------------------------------------------
 
$0 .= "";
 
$sender_given    = $ARGV[0];
$recipient_given = $ARGV[1];
if ( defined($sender_given) and $sender_given =~ /([-A-Za-z0-9_+]+\@[-A-Za-z0-9.]+)/ ) {
    $sender = $1;                      # now is untainted
}
else {
    bailout( $EX_NOUSER, "Sender address not given" )
        if !defined($sender_given);
    bailout( $EX_NOUSER, "Invalid sender address: $sender_given" );
}
if ( defined($recipient_given) and $recipient_given =~ /^(\d+)/ ) {
    $recipient = $1;                   # now is untainted
}
else {
    bailout( $EX_NOUSER, "Mobile number not given" )
        if !defined($recipient_given);
    bailout( $EX_NOUSER, "Not a mobile number: <$recipient_given>" );
    exit $EX_NOUSER;
}
 
open( FILE, "<$senders_file" ) or die "Unable to get list of senders from $senders_file: $!\n";
while (<FILE>) {
    chomp;
    next if /^\s*#/;
    next if /^\s*$/;
 
    # lines are colon-delimited, like aliases
    my ( $addr, $perm );
    ( $addr, $perm ) = split(/\s*:\s*/);
    next unless defined($addr) and length($addr);
    next unless defined($perm) and length($perm);
    $perm = lc($perm);
    if ( $perm =~ /(permit|deny)/ ) {
        $sender_addresses{$addr} = $1;
    }
}
close(FILE);
 
if ( open( FILE, "<$msgdel_file" ) ) {
    while (<FILE>) {
        chomp;
        next if /^\s*#/;
        next if /^\s*$/;
 
        # each line is a regex
        push @msgdel, $_;
    }
    close(FILE);
    syslog( 'debug', "Message deletions read in: " . join( ',', @msgdel ) . "\n" )
        if $debug;
}
 
$message = process_email;
$message = clean_message($message);
length($message)
    || bailout( $EX_NOINPUT, "No message body - nothing to send" );
 
syslog( 'info', "Said <$sender> to <$recipient>:\n[$message] " . length($message) . " chars\n" );
 
if ( !check_perms($sender) ) {
    bailout( $EX_NOPERM, "Permission denied for <$sender>" );
}
 
send_message( $recipient, $message );
syslog( 'info', "GNOKII sent message OK\n" );
 
# ALl OK if it got this far.
#closelog();
 
Coloreado en 0.013 segundos,  usando GeSHi 1.0.8.4

recibir el correo electrónico y esperar que el cuerpo del mensaje esté en formato MIME multipart
si no está en ese formato, tratar el cuerpo del mensaje como de solo texto
si está en ese formato, localizar la parte de solo texto
si está esa parte de solo texto, usarlo como fuente para el SMS
si no está la parte de solo texto, o no está en formato , buscar la parte escrita en HTML
extraer el texto de la parte HTML y usarlo como fuente para el SMS

Una forma fácil y rápida de resolverlo, pero no segura, es filtrar todo el contenido HTML, con la esperanza de que solo quede el texto.

Algo así:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

    $msg =~ s{<.+?>}{}g;                   # eliminar todo el marcado HTML
    $msg =~ s{\s+}{ }g;                    # reducir todos los conjuntos de espacios en blanco, a uno solo
Coloreado en 0.001 segundos,  usando GeSHi 1.0.8.4

por **jcovenas** » 2013-06-11 21:02 @918

Muchas gracias, estimado. Una consulta: cuando se refiere a no seguro, ¿se refiere a que es posible que la indicada expresión regular podría dar errores incontrolados o a que es probable perder datos (como los adjuntos)?

Gracias por la ayuda.

por **explorer** » 2013-06-12 05:22 @265

No, no me refiero a eso, sino a que con esas dos líneas no es suficiente para garantizar que estamos extrayendo el texto que nos interesa mandar por SMS. Por ejemplo, los adjuntos se suelen enviar en formato uuencode, que es una ristra de caracteres de 7 bits, por lo que para la expresión regular serán iguales a un texto.

También, si se trata de un correo electrónico con formato MIME multipart, los propios delimitadores de cada parte están escritos con caracteres normales, y eso tampoco lo sabe la expresión regular.

La expresión regular no cometerá fallos. Solo hace lo que le hemos pedido: quitar el marcado HTML, nada más.

por **jcovenas** » 2013-06-19 16:41 @736

Hola de nuevo.

Apliqué las expresiones regulares pero al parecer no hace ninguna limpieza.

Por otro lado, dado que mi script toma el mensaje de STDIN, ¿cómo puedo ver lo que contiene esa variable a fin de ver qué es lo está reteniendo realmente y empezar a limpiar el indicado mensaje?

por **explorer** » 2013-06-19 20:58 @915

jcovenas escribiste:Apliqué las expresiones regulares pero al parecer no hace ninguna limpieza.

Quizás es que no había nada que limpiar. ¿Puedes poner un ejemplo de lo que se recibe por la entrada estándar? Puede ser algo inventado, o falsear los datos sensibles.

jcovenas escribiste:Por otro lado, dado que mi script toma el mensaje de STDIN, ¿cómo puedo ver lo que contiene esa variable a fin de ver qué es lo está reteniendo realmente y empezar a limpiar el indicado mensaje?

Puedes poner un print() en el lugar adecuado para que lo mande a la salida estándar o hacia un archivo de registro de actividad.

Foro - Perl en Español

Transporte SMS

Transporte SMS

Publicidad

Re: Transporte SMS

Re: Transporte SMS

Re: Transporte SMS

Re: Transporte SMS

Re: Transporte SMS

¿Quién está conectado?