[Roma.pm] Roma Digest, Vol 64, Issue 13
Luca Marchesan
l.marchesan at srmsitalia.interbusiness.it
Mon Mar 28 03:49:41 PDT 2011
Niente, giustamente la mail da gmail viene rigettata. Avete un indirizzo
a cui inviare senza questi problemi? Oppure, come posso fare?
Luca
Il giorno lun, 28/03/2011 alle 12.37 +0200, Luca Marchesan ha scritto:
> Ragazzi, scusatemi ma credo di aver fatto una cazzata non dandovi i
> giusti input e output.
> A questo punto vi incollo più sotto nuovamente il testo dello script e
> invio dal mio account gmail a questo indirizzo una mail che viene
> "sbiancata" dallo script stesso. Arriverà inviando da dominio gmail?
>
> Grazie ancora,
> Luca
>
> ############INIZIO script "mailshrink":
>
> #!/usr/bin/perl -w
>
> =head1 NAME
>
> mailshrink - remove superfluous text from email
>
> =head1 SYNOPSIS
>
> someprocess | mailshrink [-o output_dir] -
>
> =head1 DESCRIPTION
>
> mailshrink - remove superfluous text from email
>
> =head1 COMMAND LINE OPTIONS
>
> =over 8
>
> =item B<-o> <output_dir>
>
> output dir for decoded attachments.
>
> =back
>
> =head1 AUTHOR
>
> Andreas Koenig suggested this, and wrote the original code.
>
> Eryq perverted the hell out of it
>
> Luca Berruti <lberruti at publinet.it>
>
> =cut
>
> use strict;
> use Getopt::Std;
> use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
>
> use constant {
> BASE_URL => 'https://151.99.248.212/mails',
> BASE_OUTPUT_DIR => '/var/spool/srv/mails',
> RANDOM_LENGTH => 10,
> CFG_FILE => '.withattach',
> };
>
> use vars qw($opt_o);
> use MIME::Parser;
>
> use String::Random;
> use File::Basename;
> use Cwd;
>
> sub shrink_header {
> my @fields = ('Date', 'From', 'To', 'Cc', 'Subject', 'Message-ID',
> 'In-Reply-To');
> my @mime_fields = ('Content-Type', 'Content-Transfer-Encoding',
> 'MIME-Version');
> my ($header, $show_mime) = @_;
> $show_mime = 0 unless ($show_mime);
>
> push(@fields, @mime_fields) if $show_mime;
> foreach(@fields) {
> my $field = $header->get($_);
> print "$_: " . $field if $field;
> }
> print "\n";
> 1;
> }
>
> sub zip_me {
> my $path = shift;
> my ($filename, $dirname, $suffix) = fileparse($path);
> if (($path =~ /\.(zip|rar|7z)$/) ||
> ($filename eq "") ||
> ($dirname eq "")) {
> return $path
> }
> my $old_pwd = getcwd();
> chdir $dirname;
> my $zip = Archive::Zip->new();
> $zip->addFile($filename);
> my $zip_name = $filename . '.zip';
> if ( $zip->writeToFileNamed($zip_name) == AZ_OK ) {
> $path = $dirname.$zip_name;
> }
> chdir $old_pwd;
> return $path;
> }
>
> sub content_as_link {
> my $path = shift;
> my $size = ($path ? (-s $path) : '???');
> my $url = $path;
> $url =~ s/^${\(BASE_OUTPUT_DIR)}/${\(BASE_URL)}/;
> $url =~ s/\s/%20/g;
> my $contents = sprintf(
> "This is an attachment, %d bytes long.\n" .
> "It is stored on %s.\n\n",
> $size, $path ? $url : 'core');
> return Data => $contents;
> }
>
> sub content_as_zip {
> my $path = shift;
> return Path => $path,
> Type => "application/zip",
> Encoding => "base64";
> }
>
> #------------------------------
> #
> # recurse_entity ENTITY, NAME
> #
> # Recursive routine for processing an entity.
> #
> sub recurse_entity {
> my ($entity, $show_text, $with_attach) = @_;
> $show_text = 0 unless ($show_text);
>
> # Get MIME type...
> my ($type, $subtype) = split('/', $entity->head->mime_type);
> # Output the body:
> my @to_keep = ();
> my $entity_ref = \$entity;
> my @parts = $entity->parts;
> if (@parts) { # multipart...
> my $i;
> foreach $i (0 .. $#parts) {
> push(@to_keep,
> recurse_entity($parts[$i], $i == 0 ? 1 : 0,
> $with_attach));
> # XXX alternative are losts...
> last if ($subtype =~ /^alternative$/);
> }
> # delete unneeded parts...
> $entity_ref = \$entity->parts(\@to_keep);
> } else { # single part...
> unless ($show_text && ($type =~ /^(text|message)$/)) {
> my $body = $entity->bodyhandle;
> my $path = zip_me($body->path);
> $body->purge unless ($path eq $body->path);
> my %content = $with_attach ?
> content_as_zip($path) : content_as_link($path);
> $entity_ref = \$entity->attach(%content);
> }
> }
> return $$entity_ref;
> }
>
> sub one_time_string {
> my $length = shift;
> my $passwd = new String::Random;
> my $randregex = sprintf('[A-Za-z0-9]{%d}', $length);
> return $passwd->randregex($randregex);
> }
>
> sub with_attach {
> open(F, "$ENV{HOME}/" . CFG_FILE) or return 0;
> my @lines = <F>;
> close(F);
> chomp($lines[0]);
> return $lines[0] eq '1' ? 1 : 0;
> }
>
> sub main {
> print STDERR "(reading from stdin)\n" if (-t STDIN);
> # Usage?
> # $ARGV[0] or die <<EOF;
> #
> #Usage:
> # mimeencode [-d] encoding <infile >outfile
> #
> #EOF
> getopts("o:");
> my $otp = one_time_string(RANDOM_LENGTH);
> my $output_dir = ($opt_o ? $opt_o : BASE_OUTPUT_DIR . '/' . $otp);
>
> $CFG::with_attach = with_attach();
>
> umask 0007;
>
> # Create a new MIME parser:
> my $parser = new MIME::Parser;
>
> # Create and set the output directory:
> (-d $output_dir) or mkdir $output_dir,0770 or die "mkdir: $!";
> (-w $output_dir) or die "can't write to directory";
> $parser->output_dir($output_dir);
>
> # first line: mbox header file
> my $line = <STDIN>;
> print $line;
>
> #MIME::Tools->debugging(1);
> # Read the MIME message:
> my $entity = $parser->read(\*STDIN) or die "couldn't parse MIME
> stream";
>
> shrink_header($entity->head, 1);
> recurse_entity($entity, 1, $CFG::with_attach);
> $entity->print_body(\*STDOUT);
> }
> exit(&main ? 0 : -1);
>
> 1;
>
> ###################FINE script
>
>
>
> Il giorno mer, 23/03/2011 alle 12.00 -0700, roma-request at pm.org ha
> scritto:
> > Send Roma mailing list submissions to
> > roma at pm.org
> >
> > To subscribe or unsubscribe via the World Wide Web, visit
> > http://mail.pm.org/mailman/listinfo/roma
> > or, via email, send a message with subject or body 'help' to
> > roma-request at pm.org
> >
> > You can reach the person managing the list at
> > roma-owner at pm.org
> >
> > When replying, please edit your Subject line so it is more specific
> > than "Re: Contents of Roma digest..."
> >
> >
> > Today's Topics:
> >
> > 1. Re: problema script perl (Leo Cacciari)
> > 2. Re: problema script perl (Christoph Wernli)
> >
> >
> > ----------------------------------------------------------------------
> >
> > Message: 1
> > Date: Wed, 23 Mar 2011 12:52:01 +0100
> > From: Leo Cacciari <leo.cacciari at gmail.com>
> > To: roma at pm.org
> > Subject: Re: [Roma.pm] problema script perl
> > Message-ID: <4D89DEE1.40005 at gmail.com>
> > Content-Type: text/plain; charset="utf-8"
> >
> > Il 03/23/2011 12:33 PM, Luca Marchesan ha scritto:
> > > Ciao ragazzi, questa lista d? supporto a chi come me non ne sa nulla di
> > > perl ma deve risolvere un problema relativo ad uno script?
> > > Spero di si, cos? vi espongo il problema:
> > > sul mail server che da poco mi trovo ad amministrare c'? uno script
> > > chiamato mailshrink che svolge le seguenti funzioni:
> > > 1. elimina dal testo tutte le parti inutili
> > > 2. se la mail ha una allegato e questo non ? zippato, lo zippa
> > > 3. se il valore scritto nel file .withattach ? impostato a 0, prende
> > > l'allegato, lo strippa dalla mail, lo stora su /var/spool/srv/mails ed
> > > inserisce nel testo della mail il link per scaricarlo.
> > >
> > > Problema: abbiamo rilevato che diverse mail, non tutte, anzich? essere
> > > "ottimizzate" dallo script, vengono completamente cancellate. Restano
> > > solo intestazioni e allegati. In pratica il client visualizza solo
> > > mittente, destinatario e allegato.
> > >
> > > Bisognerebbe eliminare dallo script la funzione di ottimizzazione del
> > > testo (punto 1) e lasciare solo le funzioni relative agli allegati
> > > (punti 2 e 3).
> > >
> > > Vi allego lo script (mailshrink.txt), il testo della mail (input) che
> > > data in pasto a mailshrink viene sbiancata e il testo dell'output di
> > > mailshrink (output).
> > >
> > > Mi potete dare una mano?
> > >
> > >
> > > Grazie in ogni caso
> > >
> > > Luca
> > >
> > >
> > > _______________________________________________
> > > Roma mailing list
> > > Roma at pm.org
> > > http://mail.pm.org/mailman/listinfo/roma
> > Ciao,
> > da quello che capisco a una prima occhiata, direi che non dipende dallo
> > script ma dall'abitudine di alcuni clienti di posta elettronica che
> > mandano il testo della mail in un attacment mime (in realt? due
> > attacment, uno di tipo txt l'altro di tipo html). Infatti se guardi
> > nella directory di output, trovi che il testo della mail ? l?: nel file
> > msg-9711-1.txt (e c'? una copia nel formato html in msg-9711-2.html).
> >
> > TH
> >
> > --
> > Leo Cacciari
> > Aliae nationes servitutem pati possunt populi romani est propria libertas
> >
> > -------------- next part --------------
> > An HTML attachment was scrubbed...
> > URL: <http://mail.pm.org/pipermail/roma/attachments/20110323/10650ae0/attachment-0001.html>
> >
> > ------------------------------
> >
> > Message: 2
> > Date: Wed, 23 Mar 2011 13:02:33 +0100
> > From: Christoph Wernli <cwernli at gmail.com>
> > To: roma at pm.org
> > Subject: Re: [Roma.pm] problema script perl
> > Message-ID: <C823A659-E0CC-47A6-9064-23EFDAB32014 at gmail.com>
> > Content-Type: text/plain; charset=iso-8859-1
> >
> > On Mar 23, 2011, at 12:52 PM, Leo Cacciari wrote:
> >
> > > Infatti se guardi nella directory di output, trovi che il testo della mail ? l?: nel file msg-9711-1.txt (e c'? una copia nel formato html in msg-9711-2.html).
> >
> >
> > E da questo segue: meglio proteggere correttamente le directory che contengono delle mail, altrimenti tutto il mondo le va a leggere...
> >
> > -Christoph
> >
>
More information about the Roma
mailing list