|
Sulla mailing list debian-italian è stato chiesto se era possibile verificare l'esistenza degli indirizzi e-mail contenuti in un file, qualcuno ha proposto una soluzione (quella implementata che vedremo in seguito).
Cosa ci serve:
- un file contenente gli indirizzi e-mail da verificare (io utilizzerò quello del mio mutt)
- un server DNS per ottenere il record MX legato al dominio
- una connessione SMTP per lanciare il comando VRFY e
- il dominio a cui appartiene il client su cui gira il programma
Gli ultimi tre punti ci fanno subito venire in mente Net::DNS, Net::SMTP e Net::Domain, quindi per prima cosa diamo una veloce sfogliata al perldoc di questi tre moduli. Sono tutti molto semplici da utilizzare, possiamo vedere fin da subito che Net::DNS dispone della funzione mx che fa proprio al caso nostro, Net::SMTP della funzione verify e Net::Domain di hostfqdn. Quindi per iniziare:
#!/usr/bin/perl -w
use strict;
use Net::DNS;
use Net::SMTP;
use Net::Domain qw(hostfqdn);
Per ottenere gli indirizzi e-mail dal file utilizzeremo una regular expression che vedremo sotto.
Assembliamo il tutto
Innanzitutto il formato delle righe del file contenente gli indirizzi è:
alias mattia Mattia Dongili <dongili@supereva.it>
Dobbiamo analizzarlo e costruire una struttura dati comoda per il successivo uso: estrarre il record MX, collegarci e lanciare il comando VRFY su ogni indirizzo dello stesso dominio. La struttura adatta a questo è chiaramente un hash di arrayref dove la chiave dell'hash è il dominio e l'array contiene gli username da verificare; questo ci permette di raggruppare tutti gli indirizzi appartenenti allo stesso dominio ottimizzando poi le connessioni SMTP: con un'unica connessione possiamo lanciare N volte il comando VRFY. Andiamo avanti:
Una piccola utility per analizzare le opzioni da riga comando (si, sono molto pigro...):
use Getopt::Long;
in questo hash salviamo la struttura dati ottenuta dal parsing del file (hash di arrayref):
my %addrs;
dichiariamo la variabile che conterrà il nome del file e un flag che attiva la stampa di informazioni di debug, entrambi ottenuti da riga comando:
my $address_file;
my $debug = 0; # default disattivato
finalmente l'analisi delle opzioni passate da riga di comando e la verifica della valorizzazione di $address_file. Se qualcosa va storto stampiamo l'help:
if (!GetOptions ("file=s" => \$address_file, "debug" => \$debug)
|| !$address_file) {
print <<EOHELP;
usage: $0 -f <file> [-d]
EOHELP
exit 0;
}
apriamo il file e scorriamolo riga per riga:
open(FP, "<$address_file") || die "$^E ($address_file)";
while (<FP>) {
ora analizziamo la singola riga per estrapolare l'indirizzo e-mail nelle sue due parti di utente@dominio:
if ( /
^ # Inizio riga
alias.*?< # scartiamo il primo token nel
# nostro esempio
# 'alias mattia Mattia Dongili <'
([a-zA-Z0-9_\.-]+?) # nome utente dell'indirizzo
# (salvato in $1),
# nel nostro esempio 'dongili'
\@ # chiocciola :)
([a-zA-Z0-9\.-]+?\.\w{2,3}) # parte dominio dell'indirizzo
# (salvato in $2), nel nostro
# esempio 'supereva.it'
> # scartiamo anche l'ultimo
# carattere
$ # Fine riga
/x ) {
aggiungiamo il nome utente appena letto all'array corrispondente al suo
dominio:
push( @{ $addrs{$2} }, $1);
se e` fallita l'analisi della riga stampiamo un warning:
} else {
warn "wrong line format: $_\n";
}
}
non dimentichiamoci la chiusura del file:
close FP;
ed infine se non abbiamo trovato nessun indirizzo e-mail usciamo
die "No email address found" unless keys(%addrs);
Una volta costruita la nostra struttura dati procediamo scorrendola per chiave (il dominio) e verifichiamo ogni indirizzo, quindi:
il ciclo principale:
foreach my $domain (keys(%addrs)) {
facciamo una query al nostro DNS server sul record MX ottenendo l'elenco di MX del dominio in questione in @mxs:
my $res = Net::DNS::Resolver->new;
my @mxs = mx($res, $domain);
stampiamo un warning se l'array di MX e` vuoto:
if (!@mxs) {
warn "Can't find MX records for $domain ",
($res->errorstring ne 'NOERROR' ? $res->errorstring : ""), "\n";
}
altrimenti colleghiamoci al primo server che ci e` stato indicato dal DNS:
else {
# Inizio sessione SMTP
print $mxs[0]->exchange,"\n";
my $smtp = Net::SMTP->new($mxs[0]->exchange,
Hello => hostfqdn(),
Timeout => 30,
Debug => $debug,
);
lanciamo il comando VRFY per ogni indirizzo associato a questo dominio:
if ($smtp) {
foreach (@{ $addrs{$domain} }) {
# VRFY
if ($smtp->verify("$_\@$domain")) {
print "$_\@$domain exists\n";
} else {
print "Cannot VRFY $_\@$domain\n";
}
}
# Fine sessione SMTP
$smtp->quit;
} else {
print "No SMTP connection for ", $mxs[0]->exchange, "\n";
}
chiudiamo un po` di parentesi:
} # fine else
} # fine freach
Tutto qui.
Conclusioni
E` stato facile no?
Purtroppo però questa soluzione si scontra con lo stato attuale della rete internet che ormai è un covo di spammatori e virus, e dunque i comandi che sono stati utilizzati per verificare gli indirizzi sono in realtà disabilitati sulla maggioranza degli SMTP server. Inoltre alcuni SMTP server ritengono che le troppe VRFY siano un abuso e tendono a disabilitare l'accesso a chi lo fa. Per questo in realtà la verifica degli indirizzi e-mail non si può fare ™.
Credits
Devo ammettere che l'uso di Net::Domain non è venuto in mente a me ma al poliedrico Bronto, grazie anche a Larsen per la revisione e i consigli.
Codice
#!/usr/bin/perl -w
use strict;
use Net::DNS;
use Net::SMTP;
use Net::Domain qw(hostfqdn);
use Getopt::Long;
my %addrs;
my $address_file;
my $debug = 0;
if (!GetOptions ("file=s" => \$address_file, "debug" => \$debug)
|| !$address_file) {
print <<EOHELP;
usage: $0 -f <file> [-d]
EOHELP
exit 0;
}
open(FP, "<$address_file") || die "$^E ($address_file)";
while (<FP>) {
if ( /
^ # Inizio riga
alias.*?< # scartiamo il primo token nel
# nostro esempio
# 'alias mattia Mattia Dongili <'
([a-zA-Z0-9_\.-]+?) # nome utente dell'indirizzo
# (salvato in $1),
# nel nostro esempio 'dongili'
\@ # chiocciola :)
([a-zA-Z0-9\.-]+?\.\w{2,3}) # parte dominio dell'indirizzo
# (salvato in $2), nel nostro
# esempio 'supereva.it'
> # scartiamo anche l'ultimo
# carattere
$ # Fine riga
/x ) {
push( @{ $addrs{$2} }, $1);
} else {
warn "wrong line format: $_\n";
}
}
close FP;
die "No email address found" unless keys(%addrs);
foreach my $domain (keys(%addrs)) {
my $res = Net::DNS::Resolver->new;
my @mxs = mx($res, $domain);
if (!@mxs) {
warn "Can't find MX records for $domain ",
($res->errorstring ne 'NOERROR' ? $res->errorstring : ""), "\n";
}
else {
# Inizio sessione SMTP
print $mxs[0]->exchange,"\n";
my $smtp = Net::SMTP->new($mxs[0]->exchange,
Hello => hostfqdn(),
Timeout => 30,
Debug => $debug,
);
if ($smtp) {
foreach (@{ $addrs{$domain} }) {
# VRFY
if ($smtp->verify("$_\@$domain")) {
print "$_\@$domain exists\n";
} else {
print "Cannot VRFY $_\@$domain\n";
}
}
# Fine sessione SMTP
$smtp->quit;
} else {
print "No SMTP connection for ", $mxs[0]->exchange, "\n";
}
}
}
Inviato da mattia il 04.07.04 18:48
Ti è piaciuto questo articolo? Iscriviti al feed!
|