🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: es.comp.os.linux.programacion
Article #14904

Script para mensajes SMS a móviles (esms): nueva versión

#14904
From: batsman
Date: Thu, 07 Sep 2000 01:55
325 lines
11065 bytes
-----BEGIN PGP SIGNED MESSAGE-----


Una vez m�s, la pasarela web-2-sms que usa esms (Terra) ha cambiado.
He hecho una nueva versi�n que soluciona el problema. Ahora mismo no
puedo actualizar la p�gina de esms en http://esms.sourceforge.net, as�
que env�o adjunto el script (es peque�o).

[Para aquellos que desconocen esms:

 es un peque�o script para enviar mensajes a m�viles, con las siguientes
 ventajas respecto a las tradicionales p�ginas de env�o (tipo
 Terra/amenapolis/navegalia...):
  - mensajes de m�s de 160 caracteres, se fragmentan y se env�an uno a
    uno con control de errores
  - elimina la publicidad (mensajes promocionales del gateway empleado)
  - sin l�mites de env�o: tantos mensajes como quieras en el tiempo que
    quieras, no como en las p�ginas web que s�lo te dejan unos pocos
    cada 10 minutos, y no m�s de uno por minuto
  - agenda de nombres (fichero de alias nombre/tel�fono)
  - acepta datos de la entrada est�ndar: facilita su uso en scripts, 
    para que nos env�e el subject de los emails al m�vil, o (mi
    ejemplo favorito) para enviar un mensaje a la novia/o autom�ticamente
    (fortune -s -m love | esms minovia)
  - bueno, bonito, barato :)

  M�s info en http://esms.sourceforge.net .
]

Aqu� va el script:


#!/usr/bin/perl
#     esms, env�o de mensajes a m�viles de Espa�a 
#     Copyright (C) 2000 Mauricio Julio Fern�ndez Pradier
#
#         This program is free software; you can redistribute it and/or
#     modify it under the terms of the GNU General Public License as
#     published by the Free Software Foundation; either version 2 of the
#     License, or (at your option) any later version.
#
#         This program is distributed in the hope that it will be
#     useful, but WITHOUT ANY WARRANTY; without even the implied
#     warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#     See the GNU General Public License for more details.
#
#         You should have received a copy of the GNU General Public
#     License along with this program; if not, write to the Free
#     Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

use CGI;
use Text::Wrap qw(wrap $columns);
use LWP::UserAgent;
use HTTP::Request::Common qw(POST GET);
use IO::Socket;

use strict;

my $debug = 1;

sub pretty_print()
{
 my $mensaje = pop @_;
 print 
 "-------------------------------------------------------------------------\n" .
 "$mensaje\n" . 
 "-------------------------------------------------------------------------\n";
}

sub ajustar_fecha()
{
 ##my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = @_;
 ##     0    1    2    3     4     5     6     7     8 
 $_[5] = $_[5]+1900; 							    
 $_[4] = $_[4]+1;
 my $i;
 for ($i=4; $i>=0; $i--) {
	$_[$i] = "0" . $_[$i] if ($_[$i]<10);
 }
}

sub obtener_telefono
{
  my $alias = pop @_;
  my $fichero;
  $fichero = $ENV{"HOME"} . "/.esmsalias";
  print "Abriendo fichero de alias $fichero.\n";
  print "Buscando tel�fono de $alias.\n";
  open(INPUT, $fichero);
  while (<INPUT>) {
	chop($_);
        ##	print "Le�da l�nea $_.\n";
  	if ( /$alias/ ) {
		s/^$alias //g;
		s/ //g;
		s/\t//g;
		close(INPUT);
		return $_;
	}
  }
  close(INPUT);
  return 0;	
}


sub obtiene_cookies
{

 my $sock = new IO::Socket::INET (PeerAddr => 'www.terra.es',
 				  PeerPort => 'http(80)',
				  Proto    => 'tcp');
 if (!$sock) { 
 	die "Error al establecer la conexi�n. " . 
		"No se pudo obtener la clave de env�o.\n"; 
 	return -1;
 }
 $sock->autoflush(1);
 $sock->print("GET /sms/ HTTP/1.0\n\n");
 
 my $cabecera;
 # leemos 1024 bytes, los cookies estar�n all� seguro
 $sock->read($cabecera,1024); 
 
 undef $sock; # cerramos el socket, a la porra el resto de la p�gina
 my @parts = split /\n/, $cabecera;
 my @cookies;
 
 foreach( @parts ) {
##   print "Analizando l�nea $_\n";
	if ( /^Set-Cookie:/ ) {
		s/^Set-Cookie: //;
		my @tmp = split /\;/ , $_;
##		print "Insertando l�nea $tmp[0]\n";
		push @cookies, $tmp[0];
	}
 }
 return @cookies;	

}

sub prueba_conexion()
{
 
 my $sock = new IO::Socket::INET (PeerAddr => 'www.terra.es',
 				  PeerPort => 'http(80)',
				  Proto    => 'tcp');
 print("Verificando conexi�n.");
 if($sock == 0) {
	print(
"\n=====================================================================\n" .
"No es posible establecer la conexi�n con el servidor en este momento.\n" .
"El mensaje no ser� enviado.\n" . 
"=====================================================================\n\n");
	undef $sock;
	return -1;
 }
 print(".. correcta.\n");
 undef $sock;
 return 0;
}


sub enviar_mensaje
{
 my ($linea, $telefono,$repeat) = @_;
 my $remote;


 my $l=length($linea);
 my $n;
 for ($n=$l; $n<160; $n++) {
	$linea=$linea . " ";
 }
 $l=length($linea); 
 if ($repeat == 0) {
    if ($debug) {
    	print "No se pudo enviar el mensaje, cancelando env�o de:\n";
	&pretty_print($linea);
    }
    return;
 }
 my $ua = new LWP::UserAgent;
 $ua->agent("Mozilla/5.0 " . $ua->agent);
 # $ua->proxy("http", "http://localhost:8080/");
 
 my @cookies = &obtiene_cookies();
 print "Protecci�n desactivada.\n" if ($debug);
 my $req = POST 'http://www.terra.es/sms/entrega.cfm', [ telefono => $telefono, 
    fecha => "CHANGEME", 
    mensaje => $linea];
 
 $req->header ( Referer => "http://www.terra.es/sms/portada.cfm" ); 
 $req->header ( Cookie => "$cookies[0]; $cookies[1]; $cookies[2]");
# print "Usando c�digo $cookies[0] y $cookies[1]\n";

 my $seconds = time();
 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
 	= gmtime($seconds+36000);
 &ajustar_fecha ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
 my $cfecha = "%7Bts+%27$year%2D$mon%2D$mday+$hour%3A$min%3A$sec%27%7D";
 
 ${$req->content_ref} =~ s/CHANGEME/$cfecha/g;
 # Pass request to the user agent and get a response back 
 my $res = $ua->request($req);

 # Check the outcome of the response
 if ($res->content =~ /correctamente/) {
     print "Mensaje enviado correctamente\n" if ($debug);
     return 1;
 } elsif ($repeat > 1) {
     print "Error al enviar mensaje. " . 
     	"Comienzo de rutina de reintento.\n" if ($debug);
     my $i;
     for ($i=0; $i<3; $i++) {
         return 1 if (&enviar_mensaje($linea,$telefono,1) == 1);
	 print "Reintentando env�o.\n" if ($debug);
     }
 #    sleep(1);
     return &enviar_mensaje($linea,$telefono,$repeat-1);
 }
 if ($debug) {
 	print ( "Error al enviar el mensaje:\n" );
	&pretty_print($linea);
 }
 return 0;
}


if ($ARGV[0] eq "") {
	print "esms 0.8, Copyright � 2000 Mauricio Julio Fern�ndez Pradier\n";
	print "esms comes with ABSOLUTELY NO WARRANTY. This is free software,\n";
	print "and you are welcome to redistribute it under certain conditions.\n";
	print "\n";
	print "Uso: esms <telefono> [columnas]\n";
	print "Por defecto se usan 155 columnas\n";
	print "Ejemplo:\n";
	print " fortune -s | esms 123456789 60\n";
	print " uname -a | esms Linus \n";
	print "\nEste �ltimo buscar� 'Linus' en el fichero de alias\n";
	print	"\t\t" . $ENV{"HOME"} . "/.esmsalias\n";
	print "Ejemplo de .esmsalias:\n";
	print "yo      123456789\n";
	print "Linus   1111111111\n";
	exit(0);
}
my $telefono = $ARGV[0];
my $name = $telefono;
if ( $telefono !~ /[0-9]+/ ) {
	$telefono = &obtener_telefono($telefono);
}
print "Obtenido tel�fono: $telefono.\n";
if ($telefono == 0)
{
	print "No se pudo encontrar el telefono asociado a $name.\n";
	exit(1);
}

my $col = $ARGV[1];
if ($col) { $columns = $col; } else { $columns = 155; }

my @in = <STDIN>;
my $mensaje = join ('', @in);
               
$mensaje =~ s/\n/\�/g;
$mensaje =~ s/\t/ /g;
my $linea = wrap ("","",$mensaje);
my @lineas = split(/\n/,$linea);
my $numlineas = @lineas;
$mensaje =~ s/\�/\n/g;
$| = 1; ## turn auto-flush on

&prueba_conexion();
print "Env�o de mensaje a m�vil\n";
print "Tel�fono: $telefono\n";
print "Mensaje:\n";
&pretty_print($mensaje);

print "El mensaje ha sido fragmentado en $numlineas paquetes.\n" 
    if ($numlineas > 1); 
print "El mensaje no ha sido fragmentado.\n" 
    if ($numlineas == 1); 

sleep(1);

sub espera 
{
    my $tiempo=1;
    print "Esperando $tiempo segundo...\n" if ($debug);
    sleep($tiempo); ## wait after each message part
}

for (my $i=1; $i<$numlineas+1; $i++) {
    &espera() if ($i>1); 
    $lineas[$i-1] =~ s/\�/\n/g;
    &enviar_mensaje("$lineas[$i-1]\n$i/$numlineas MFP",
    		    $telefono,2);
}

if ($debug) {
    print "\n";
    close(STDOUT);
};

- -- 
              _           _                             
             | |__   __ _| |_ ___ _ __ ___   __ _ _ __  
             | '_ \ / _` | __/ __| '_ ` _ \ / _` | '_ \ 
             | |_) | (_| | |_\__ \ | | | | | (_| | | | |
             |_.__/ \__,_|\__|___/_| |_| |_|\__,_|_| |_|

             Real email: batsman dot geo at yahoo dot com

-----BEGIN PGP SIGNATURE-----
Version: 2.6.3ia
Charset: noconv
Comment: Public key via email: send mail with Subject: [PGPKEY]

iQEVAwUBObcPxL0Y27yr0iefAQGaLAf/aPNt+5TsXjwzP7+DR3QgALUhFDc1l2UM
Z5iHUBrE85ALMuxwFQKH+fOLgFRd8A21fVO9Njn4YsCK4P0h0T2ttMKoDvenKIRk
c0WkUrgqq+cf6C7NsIUCNkc22+iXA+yTF6GNd9qVW6NbRXKBJgfzj3MAmDzy1eyA
4/xm/f0yxOznAcD/liV0KLYdp+jIfSE7JdnAvO6BYGdIVTBswnA0Ip63fFoLr1gm
OHwwA8Z3hOJ071satsd1aLc/4nyuTeiD9krFhDTnB8vS/F6uZvxYkRFx0f5bi0Vj
Z7dL69mps5IBXXk+MFtzDuAJ+H0GUPjot7s/RNeaDIzJVsV2XKQUSg==
=TAPu
-----END PGP SIGNATURE-----
Technical Details
Message-ID: <a437p8.mgk.ln@simpsons4ever>
Path: arc1-ca.pugleaf.net!supernews.google.com!sn-xit-02!sn-east!sn-xit-uk!supernews.com!194.42.224.136.MISMATCH!diablo.netcom.net.uk!netcom.net.uk!colt.net!newspeer.clara.net!news.clara.net!ldn-newsfeed.speedport.net!newsfeed.speedport.net!naxos.belnet.be!news.belnet.be!news.rediris.es!newsfeed.mad.ttd.net!telenews.teleline.es!not-for-mail

Show Full Headers
Complete Article Headers
X-Google-Language: SPANISH,ASCII
X-Google-Thread: f86c8,a7a89fea874ea7f1,start
X-Google-Attributes: gidf86c8,public
X-Google-ArrivalTime: 2000-09-06 18:54:32 PST
Path: arc1-ca.pugleaf.net!supernews.google.com!sn-xit-02!sn-east!sn-xit-uk!supernews.com!194.42.224.136.MISMATCH!diablo.netcom.net.uk!netcom.net.uk!colt.net!newspeer.clara.net!news.clara.net!ldn-newsfeed.speedport.net!newsfeed.speedport.net!naxos.belnet.be!news.belnet.be!news.rediris.es!newsfeed.mad.ttd.net!telenews.teleline.es!not-for-mail
From: batsman@simpsons.for.ever (batsman)
Newsgroups: es.comp.os.linux.programacion
Subject: Script para mensajes SMS a móviles (esms): nueva versión
Organization: Debian 2.2 Potato (disponible el 15 de agosto :-)
Reply-To: see_signature-mira_firma-lire_signature-lesen_sie_die_Unterschrift-bIng_yIlaD
Keywords: new version update beta tester collaboration
Summary: prueba esms si tienes los webs en su sitio }:->
Mime-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Content-Transfer-Encoding: 8bit
User-Agent: slrn/0.9.6.2 (Linux)
Message-ID: <a437p8.mgk.ln@simpsons4ever>
Lines: 325
Date: Thu, 07 Sep 2000 01:55:58 GMT
NNTP-Posting-Host: 193.152.149.176
X-Complaints-To: usenet@teleline.es
X-Trace: telenews.teleline.es 968291758 193.152.149.176 (Thu, 07 Sep 2000 03:55:58 MET DST)
NNTP-Posting-Date: Thu, 07 Sep 2000 03:55:58 MET DST