how to extract email addresses from GMail

[ulrith]

Давненько я не писал тут инструкций для начинающего спаммера. Вот допустим копишь ты в GMail письма, метишь их какой-нибудь label. И внезапно решаешь нежно проспамить авторов писем, для чего нужно как-то собрать их e-mail-ы. Что делать? Сам GMail такой возможности, ясен бох, не предоставляет. В гугле обнаруживается нарядный сайтег, который любезно согласен это сделать за опциональный донейшн.

Я, конечно, дуб дубом в информационной безопасности, но всё-таки не настолько чтобы отдать свой логин-пароль главной почты неизвестному дяде. Как бы последний не уверял, что он его сразу же забудет. (Хотя я ему, кстати, даже верю.) Пришлось писать скриптег. Поизучал программку юзера gxmsgx, наткнулся на целую кладезь полезного кода, и в результате получилось вот что:

#!/usr/bin/perl
# gmail-extract.pl - perl script for extraction of email addresses from GMail account (by ulrith, 2010)

use strict;
use Mail::IMAPClient; # apt-get install libmail-imapclient-perl
use IO::Socket::SSL;
use Date::Parse;
use Getopt::Std;

sub usage {

print STDOUT "usage:\n";
print STDOUT " ./gmail-extract.pl -u user\@gmail.com -p password\n";
print STDOUT " Optional arguments:\n";
print STDOUT " -l label (parse messages with GMail label 'label' only)\n";
print STDOUT " -f date_from (parse messages after 'date_from' date only)\n";
print STDOUT " -t date_to (parse messages before 'date_to' date only)\n";
exit;
}

my %opts;
getopt('uplft', \%opts);

my $username = $opts{'u'} or usage();
my $password = $opts{'p'} or usage();
my $label = $opts{'l'}||'INBOX';
my $date_from = str2time($opts{'f'})||0;
my $date_to = str2time($opts{'t'})||time();

my $socket = IO::Socket::SSL->new(
PeerAddr => 'imap.gmail.com',
PeerPort => 993,
)
or die "socket(): $@";

my $client = Mail::IMAPClient->new(
Socket => $socket,
User => $username,
Password => $password,
)
or die "new(): $@";

if ($client->IsAuthenticated()) {
my $msgs = {};
my $emails = {};

$client->select($label);
$client->fetch_hash("RFC822.HEADER", $msgs) or die "Fetch hash error: ", $client->LastError, "\n";

foreach my $m (keys %$msgs) {
$msgs->{$m}{"RFC822.HEADER"} =~ /Date: (.*)\n/;
my $date = str2time($1);
$msgs->{$m}{"RFC822.HEADER"} =~ /From: (.*)\n/;
my $from = $1;
if ($from =~ /.*<(.*)>/) { $from = $1; }
$emails->{$from} = $date;
};

foreach my $e (keys %$emails) {
if ($date_from < $emails->{$e} && $emails->{$e} < $date_to) { print STDOUT $e, "\n"; }
};

}

$client->logout();

У меня там всё по-взрослому, с usage help, так что объяснять порядок использования не буду - сами разберётесь.