🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

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

Re: Ayuda del algun guru del Python ese o me paso al Perl :)

#16718
From: batsman batsman
Date: Wed, 29 Mar 2000 00:00
228 lines
9075 bytes
-----BEGIN PGP SIGNED MESSAGE-----


    >>>> El Mon, 27 Mar 2000 22:00:07 +0200, un alien�gena
    >>>> intent� hacerse pasar por *puntero_loko,
    >>>> y escribi� en es.comp.os.linux.programacion:

>batsman dijo sobre Re: Ayuda del algun guru del Python ese o me paso al Perl :),
>en fecha: Mon, 27 Mar 2000 18:42:19 GMT
>
>|Por el momento aqu� va la �ltima versi�n del script de env�o por Terra 
>|(FUNCIONA :-)
>|
>
>Muy pero que muy bien monstruo. A ver si me hago la versi�n de linea de
>comandos (sigo en mis trece :) esta semana.

A ver si esto te ahorra el trabajo...


- -------------------------------- CORTAR AQUI ---------------------------------
#!/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);

local $debug = 0;

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;
 $_[4] = "0" . "$_[4]" if ($_[4]<10);
 $_[3] = "0" . "$_[3]" if ($_[3]<10);
 $_[2] = "0" . "$_[2]" if ($_[2]<10);
 $_[1] = "0" . "$_[1]" if ($_[1]<10);
 $_[0] = "0" . "$_[0]" if ($_[0]<10);
 
}

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

 if ($repeat == 0) {
    print "Error al enviar el mensaje: $linea\n" if ($debug);
    return;
 }
 my $ua = new LWP::UserAgent;
 $ua->agent("Mozilla/5.0 " . $ua->agent);
 # $ua->proxy("http", "http://localhost:8080/");
 # Create a request

 my $seconds = time();
 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($seconds);
 &ajustar_fecha ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
 
 #my $fecha = "{ts '$year-$mon-$mday $hour:$min:$sec'}";
 
 my $cookie_monster = GET 'http://www.terra.es/sms/';
 my $res;
 print "Obteniendo c�digo...\n" if ($debug);
 my $i = 0;
 do { 
 	$i++;
 	$res = $ua->request($cookie_monster); 
 } while (!$res->is_success && $i<10); 
 
 my @parts = split /\n/, $res->headers_as_string();
 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];
	}
 }
 print "Protecci�n desactivada.\n" if ($debug);
 my $req = POST 'http://www.terra.es/sms/envio.cfm', [ telefono => $telefono, 
    fecha => "CHANGEME", 
    mensaje => $linea];
 my $cfecha = "%7Bts+%27$year%2D$mon%2D$mday+$hour%3A$min%3A$sec%27%7C";
 
 $req->header ( Referer => "http://www.terra.es/sms/" ); 
 $req->header ( Cookie => "$cookies[0]; $cookies[1]");
 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($seconds+36000);
 &ajustar_fecha ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);

 $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 
 # print "<br><pre>Enviando:" . $req->as_string() . "</pre><br>";
 $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. Reintentando\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);
 }
 print ( "Error al enviar el mensaje: $linea\n" ) if ($debug);
 return 0;
}
if ($ARGC == 0) {
	print "esms 0.1, Copyright � 2000 Mauricio Julio Fern�ndez Pradier\n";
	print "esms comes with ABSOLUTELY NO WARRANTY; for details type `show w'.\n";
	print "This is free software, and you are welcome to redistribute it\n";
	print "under certain conditions; type `show c' for details.\n";
	print "\n";
	print "Uso: esms <telefono>\n";
	print "Ejemplo:\n";
	print " fortune -s | esms 123456789 \n";
	exit(0);
}
my $telefono = $ARGV[0];
my @in = <STDIN>;
my $mensaje = join ('', @in);
               
$columns = 100;
my $linea = wrap ("","",$mensaje);
my @lineas = split(/\n\n/,$linea);
my $numlineas = @lineas;

$| = 1; ## turn auto-flush on

print "Env�o de mensaje a m�vil\n";
print "Tel�fono: $telefono\n";
print "Mensaje:\n $mensaje\n";
print "Enviando mensaje:\n";
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 ($i=1; $i<$numlineas+1; $i++) {
    &espera() if ($i>1);
    &enviar_mensaje("$lineas[$i-1]\n$i/$numlineas\n(c) 2000 MFP",
	 										$telefono,10);
}

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


- -------------------------------- CORTAR AQUI ---------------------------------

El c�digo es feo feo, hay cosas chorras que no valen para nada, podr�a
evitar hacer ciertas cosas, pero creo que funciona y ya no me apetece
darle m�s vueltas. Adem�s, yo uso el interfaz web en una p�gina colgada
de sourceforge, as� el env�o es mucho m�s r�pido... (claro que si tienes
una conexi�n decente :)

No he podido probarlo a�n porque no tengo el m�vil a mano, pero de todas
formas es casi igualito que el script que envi� antes para ser usado desde un
form, y ese *s�* que funciona (probado esta misma ma�ana desde la uni).

Por cierto, me hab�a pasado una cosa muy tonta al subir el script y la p�gina
con el form. En el action puse una referencia a localhost, y al hacer las
pruebas desde casa en realidad estaba llamando al cgi de mi m�quina; por eso
me parec�a que el env�o era mucho m�s lento que antes. Ahora ya he cambiado la
p�gina en cuesti�n y rula bien...
- -- 
              _           _                             
             | |__   __ _| |_ ___ _ __ ___   __ _ _ __  
             | '_ \ / _` | __/ __| '_ ` _ \ / _` | '_ \ 
             | |_) | (_| | |_\__ \ | | | | | (_| | | | |
             |_.__/ \__,_|\__|___/_| |_| |_|\__,_|_| |_|
  ________________________________________________________________
 |Visit   |  http://www.geocities.com/SiliconValley/Vista/2075    |
 |Linux   |  http://www.geocities.com/SiliconValley/Vista/4289    |
  ----------------------------------------------------------------
  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]

iQEVAwUBOOJAur0Y27yr0iefAQHaxAf7BK2zuytL1LcmOhQDlhmJhDlIyEeTxDBA
bODzUu3Hdg40Jc6l9myV/nOwNdwdSG1TH4gx77fujd6EQrb9hs4OBCIrEJ2anfOr
WqTqt54kFpiOUylBlahGN0iXcTSKYfyirsVA94k87+FAYEZ4kjd7UcSDFro1cC3t
bYOXmbMK1HSQQ9nsLYhqzjt3U8U68uJqwr3T4JEW9MXqLop8ZKj4FzLDB3hHyo1b
WaAInG8iiukJeTpOokO6Ss+bDyj48Pyp4gNG7qRSlq250qHPW3eFGCHyXj9Hzpl2
9Zr0uysuI19batxUyiAuPdBMWJ6rZ6XJenxmkpQjT+WNtd6YDyvQ8Q==
=wD0m
-----END PGP SIGNATURE-----
Technical Details
Message-ID: <0cftb8.1t.ln@simpsons4ever>
Path: arc1-ca.pugleaf.net!unknown!not-for-mail
References: <slrn8dfrg7.79g.jajs@Pascual.es> <uhfbb8.1h1.ln@simpsons4ever> <slrn8dk41r.185.jajs@Pascual.es> <rgcob8.lq1.ln@simpsons4ever> <slrn8dvfe7.ma.jajs@Pascual.es>

Show Full Headers
Complete Article Headers
X-Google-Language: SPANISH,ASCII
X-Google-Thread: f86c8,fcc95392be363063
X-Google-Attributes: gidf86c8,public
From: batsman@simpsons4ever. (batsman)
Subject: Re: Ayuda del algun guru del Python ese o me paso al Perl :)
Date: 2000/03/29
Message-ID: <0cftb8.1t.ln@simpsons4ever>
X-Deja-AN: 603928434
Content-Transfer-Encoding: 8bit
References: <slrn8dfrg7.79g.jajs@Pascual.es> <uhfbb8.1h1.ln@simpsons4ever> <slrn8dk41r.185.jajs@Pascual.es> <rgcob8.lq1.ln@simpsons4ever> <slrn8dvfe7.ma.jajs@Pascual.es>
Content-Type: text/plain; charset=iso-8859-1
X-Complaints-To: abuse@news.wanadoo.es
X-Trace: m2newsread.uni2.es 954349388 62.36.40.75 (Wed, 29 Mar 2000 19:03:08 MET DST)
Organization: Wanadoo Usenet News - Visita http://www.wanadoo.es/
Mime-Version: 1.0
Reply-To: see_signature-mira_firma
NNTP-Posting-Date: Wed, 29 Mar 2000 19:03:08 MET DST
Newsgroups: es.comp.os.linux.programacion