VPF::Уникальный идентификатор письма и каталога в IMAP4

Majestio

Дата 30.10.2020, 18:57 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

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

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

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

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

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

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

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

код Perl

10:

11:

12:

13:

14:

15:

16:

17:

18:

19:

20:

21:

22:

23:

24:

25:

26:

27:

28:

29:

30:

31:

32:

33:

34:

35:

36:

37:

38:

39:

40:

41:

42:

43:

44:

45:

46:

47:

48:

49:

50:

51:

52:

53:

54:

55:

56:

57:

58:

59:

60:

61:

62:

63:

64:

65:

66:

67:

68:

69:

70:

71:

72:

73:

74:

75:

76:

77:

78:

79:

80:

81:

82:

83:

84:

85:

86:

87:

88:

89:

90:

91:

92:

93:

94:

95:

96:

97:

98:

99:

100:

101:

102:

103:

104:

105:

106:

107:

108:

109:

110:

111:

112:

113:

114:

115:

116:

117:

118:

119:

120:

121:

122:

123:

124:

125:

126:

127:

128:

129:

130:

131:

132:

133:

134:

135:

136:

137:

138:

139:

140:

#!/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

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Администрирование Web серверов и Web служб \| Следующая тема »