Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Уникальный идентификатор письма и каталога в IMAP4 
:(
    Опции темы
Majestio
  Дата 30.10.2020, 18:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 75
Регистрация: 19.12.2010

Репутация: нет
Всего: нет



Встал вопрос создания резервных копий одного из почтовых ящиков с доступом по IMAP4. Идет активная переписка и почтовый ящик постоянно забивается по квоте. Приходится вручную чистить. Но удаленные письма с некоторой периодичностью бывают востребованы.

Сейчас я написал скрипт на Perl, который вытягивает все письма со всех каталогов IMAP4, раскладывает по каталогам на диске. Потом я все это архивирую. Недостаток: в разных архивах одни и те же письма иногда дублируются.

Есть ли какой способ получить или сформировать уникальный идентификатор для каталога и для письма при доступе по IMAP4?

Почему и для каталога? Нужно разделить каталоги, которые удалялись, а потом создавались с одинаковыми именами.

Возможно кому-то понадобится архивировать почту по IMAP4, делюсь своим скриптом:

Код

#!/usr/bin/perl

use strict;
use utf8;

use FileHandle;
use IO::File;
use Mail::IMAPClient;
use Mail::IMAPClient::BodyStructure; 
use IO::Socket;
use IO::Socket::SSL;
use Data::Dumper;
use File::Path;
use DateTime::Format::DateParse;
use Encode qw/encode decode/;

# Конфиги
my $hostname = 'imap4.server.tld';
my $username = 'username';
my $password = 'password';
my $ssl = 1;
my $tmp = "X:/Work/imap4-grab/mailbox/$username";
my @toc = ();

select(STDOUT);
binmode(STDOUT,':utf8');
$| = 1;

# Открываем сокет почтового сервера
my $socket = OpenMailServer($hostname, $username, $password, $ssl) or die "Не могу открыть сокет почтового сервера: $@\n";

# Открываем соединение по IMAP4
my $imap = OpenImap4Connection($socket, $username, $password) or die "Не могу инициализировать IMAP4 соединение: $@\n";

# Проверка авторизации на почтовом IMAP4 сервере
$imap->IsAuthenticated() or die "Не могу авторизоваться на IMAP4 сервере: $@\n";

# Получаем список папок на почтовой IMAP4 учетной записи
my @folders = $imap->folders->@* or die "Не могу получить список папок в почтовой IMAP4 учетной записи: $@\n";
print "Total IMAP4 dirs: ".scalar(@folders)."\n\n";

# Cоздаем каталог для временных файлов
rmtree($tmp); mkpath($tmp, 0, 0777);

# Обрабатываем сообщения в папках
my $counter = 0;
foreach my $i (@folders) {
  $counter++;
  mkdir("$tmp/$counter");
  ProcessFolder($imap, $tmp, $counter, $i);
}

#Записываем оглавление
my $toc_text = "Папка^Кто^Тема^Дата^Время^Файл\n";
for my $i (@toc) {
  $toc_text .= join("^",@{$i})."\n";
}
my $fh = FileHandle->new();
open $fh, ">:utf8", "$tmp/toc.txt" or die "Could not open \"$tmp/toc.txt\": $!\n";
print $fh $toc_text;
$fh->close();

print "\nDone.\n";

# Закрываем соединение с почтовым IMAP4 сервером
$imap->done();

# Выход 
exit 0;

############################################################################
# OpenMailServer - открывает сокет почтового сервера
############################################################################
sub OpenMailServer {
  my ($hostname, $username, $password, $ssl) = @_;
  my $ret = undef;
  $ret = ($ssl) ? IO::Socket::SSL->new(PeerAddr => $hostname,
                                       PeerPort => 993,
                                       Timeout => 15) :
                  IO::Socket::INET->new(PeerAddr => $hostname,
                                       PeerPort => 143,
                                       Timeout => 15);
  return $ret;
}
############################################################################
# OpenImap4Connection - открывает соединение по IMAP4
############################################################################
sub OpenImap4Connection {
  my ($socket, $username, $password) = @_;
  my $ret = undef;
  #my $dh = IO::File->new(">debugging.output") or die "Can't open debugging.output: $!\n";
  $ret = Mail::IMAPClient->new(Socket   => $socket,
                               User     => $username,
                               Password => $password,
                               #Debug=> "yes, please",
                               #Debug_fh => $dh,
                               Timeout => 15);
  return $ret;
}
############################################################################
# ProcessFolder - обработка сообщений отдельной папки учетки IMAP4 сервера
############################################################################
sub ProcessFolder {
  my ($imap, $tmp, $counter, $box) = @_;
  die "Не могу выбрать папку \"$box\": $@\n" unless($imap->select($box));
  my ($cur,$cnt) = (1,$imap->message_count($box));
  print " process \"$box\" ($cnt) ... ";
  foreach my $i ($imap->search('ALL')) {
    my $dt = DateTime::Format::DateParse->parse_datetime($imap->date($i));
    my $date = "1980.01.01";
    my $time = "00:00:00";
    my $ftime = "00.00.00";
    if (defined($dt)) {
      $date = sprintf("%04d.%02d.%02d",$dt->year(), $dt->month(), $dt->day());
      $time = sprintf("%02d:%02d:%02d",$dt->hour(), $dt->minute(), $dt->second());
      $ftime = sprintf("%02d.%02d.%02d",$dt->hour(), $dt->minute(), $dt->second());
    }
    my @chars = ("a".."z");
    my $name; $name .= $chars[rand @chars] for 1..3;
    $name = $date."-".$ftime."-".$name.".eml";
    my $hashref = $imap->parse_headers($i,"Date","Subject","From","Sender");
    my $sender = decode('MIME-Header', ${$hashref}{'From'}[0]);
    my $subject = decode('MIME-Header', $imap->subject($i));
    print "\r process \"$box\" ($cnt) ... $cur";
    WriteFile("$tmp/$counter/$name", $i, $imap);
    $cur++;
    push @toc,[$box,$sender,$subject,$date,$time,"=ГИПЕРССЫЛКА(\"file://$tmp/$counter/$name\";\"$name\")"];
  }
  print "\r process \"$box\" ($cnt) ... Ok      \n";
}
############################################################################
# WriteFile - запись сообщения в файл
############################################################################
sub WriteFile {
  my ($name, $id, $imap) = @_;
  my $fh = FileHandle->new("> $name");
  die "Ошибка открытия файла на запись" unless(defined $fh);
  $imap->message_to_file($fh,$id) or die "Не могу записать сообщение в файл: $@\n";
  $fh->close;
}


Может ткнете носом в нужный RFC, где об этом почитать? smile 
PM MAIL WWW   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Администрирование Web серверов и Web служб | Следующая тема »


 




[ Время генерации скрипта: 0.0905 ]   [ Использовано запросов: 20 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.