[Roma.pm] Roma Digest, Vol 64, Issue 13
Luca Marchesan
l.marchesan at srmsitalia.interbusiness.it
Mon Mar 28 03:37:54 PDT 2011
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