This documentation is for Dovecot v2.x, see wiki1 for v1.x documentation.

Attachment 'uw2dovecot.pl'

Download

   1 #!/usr/bin/perl -w
   2 
   3 use strict;
   4 use Getopt::Std;
   5 use Time::Local;
   6 use File::Find;
   7 use File::Path;
   8 use File::Basename;
   9 
  10 my %opts;
  11 my $inbox;
  12 my $uwmaildir;
  13 my $subscriptions;
  14 my $maildir;
  15 my $separator;
  16 my $replacement;
  17 my @inbox_stat;
  18 my @maildir_stat;
  19 my $hostname;
  20 my $totalmsgs = 0;
  21 my %months = (
  22 	'Jan' => 0,
  23 	'Feb' => 1,
  24 	'Mar' => 2,
  25 	'Apr' => 3,
  26 	'May' => 4,
  27 	'Jun' => 5,
  28 	'Jul' => 6,
  29 	'Aug' => 7,
  30 	'Sep' => 8,
  31 	'Oct' => 9,
  32 	'Nov' => 10,
  33 	'Dec' => 11
  34 );
  35 
  36 # mix format:
  37 #	.mixmeta:
  38 #		V UIDVALIDITY(hex)
  39 #		K key0 key1 key2
  40 #	.mixindex:
  41 #		:uid:yyyymmddhhmmss[-+]zzzz:rfcsize:fileid:offset:mixhdrsz:hdrsz:
  42 #	.mixstatus:
  43 #		:uid:keywordflags:sysflags:modval:
  44 #		keywordflags from .mixmeta
  45 #		sysflags:
  46 #			0x01 = SEEN
  47 #			0x02 = TRASH
  48 #			0x04 = FLAG
  49 #			0x08 = REPLIED
  50 #			0x10 = OLD (cur, else new)
  51 #			0x20 = DRAFT (not used)
  52 #
  53 # mbx format:
  54 #	all data has \r\n
  55 #	*mbx*
  56 #	VVVVVVVVUUUUUUUU (V=VALIDITY, U=NEXT UID but often lazy assignment)
  57 #	key0
  58 #	key1
  59 #	...
  60 #	key29
  61 #	pad to 2048 bytes, last 10 bytes can be LASTPID\r\n
  62 #	DD-MMM-YYYY HH:MM:SS [+-]ZZZZ,length(dec);kkkkkkkkssss-uuuuuuuu
  63 #	msg
  64 #	...
  65 #
  66 # mbox format:
  67 #	From_ lines at begining of each message
  68 #	can have:
  69 #	X-IMAP: UIDVALIDITY MEXTUID (often lazy assignment)
  70 #	X-IMAPbase: UIDVALIDITY NEXTUID (lazy and indicates pseudo message)
  71 #	Status: FLAGS
  72 #	X-Status: FLAGS
  73 #	X-Keywords: key ...
  74 #
  75 # .mailboxlist:
  76 #	folder (strip mail/, convert / to separator)
  77 #	...
  78 #
  79 # dovecot-keywords:
  80 #	number(dec) keyword
  81 #	...
  82 # dovecot-uidlist:
  83 #	1 UIDVALIDITY(dec) NEXT
  84 #	uid(dec) filename
  85 # subscriptions
  86 #	folder
  87 #	...
  88 # cur
  89 #	timestamp.uid.hostname:2,flags
  90 #	flags = F(lag), R(eplied), S(een), T(rash), a-z (keywords)
  91 # new
  92 #	timestamp.uid.hostname
  93 # .sub.folder:
  94 #	maildirfolder (exists to make dovecot happy)
  95 #	dovecot-keywords (as above)
  96 #	dovecot-uidlist (as above)
  97 
  98 sub convert($$$) {
  99 	my $mailbox = shift(@_);
 100 	my $outdir = shift(@_);
 101 	my $subfolder = shift(@_);
 102 	my $uidvalidity;
 103 	my @keywords;
 104 	my $line;
 105 	my %msgs;
 106 	if (-d $mailbox) {
 107 		eval {
 108 			open(META, '<', "$mailbox/.mixmeta") || die "Can't open $mailbox/.mixmeta";
 109 			open(INDEX, '<', "$mailbox/.mixindex") || die "Can't open $mailbox/.mixindex";
 110 			open(STATUS, '<', "$mailbox/.mixstatus") || die "Can't open $mailbox/.mixstatus";
 111 		};
 112 		if ($@) {
 113 			warn $@;
 114 			return;
 115 		}
 116 		while ($line = <META>) {
 117 			if ($line =~ m/^V([[:xdigit:]]{8})\r\n$/) {
 118 				$uidvalidity = hex($1);
 119 			} elsif ($line =~ m/^K(.*)\r\n$/) {
 120 				@keywords = split(' ', $1);
 121 			}
 122 		}
 123 		close(META);
 124 		if (!defined($uidvalidity)) {
 125 			warn "$mailbox: No uidvalidity";
 126 			return;
 127 		}
 128 		while ($line = <INDEX>) {
 129 			my $tmpvals;
 130 			my $hdr;
 131 			if ($line =~ m/^:([[:xdigit:]]{8}):(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)([-+])(\d\d)(\d\d):([[:xdigit:]]{8}):([[:xdigit:]]{8}):([[:xdigit:]]{8}):([[:xdigit:]]{8}):([[:xdigit:]]{8}):\r\n$/) {
 132 				my $uidl = $1;
 133 				$tmpvals = {
 134 					'timestamp' => timegm($7, $6, $5, $4, $3-1, $2) + (($8 eq '-' ? 1 : -1)*($9 * 60 + $10)*60),
 135 					'size' => hex($11),
 136 					'filename' => "$mailbox/.mix$12",
 137 					'offset' => hex($13),
 138 					'skip' => hex($14),
 139 				};
 140 				eval {
 141 					open(MSGFILE, '<', $tmpvals->{'filename'}) || die "Can't open ".$tmpvals->{'filename'};
 142 					seek(MSGFILE, $tmpvals->{'offset'}, 0) || die "Can't seek to ".$tmpvals->{'offset'};
 143 					read(MSGFILE, $hdr, $tmpvals->{'skip'}) || die "Can't read ".$tmpvals->{'skip'}."bytes from ".$tmpvals->{'filename'};
 144 					($hdr eq ":msg:$1:$2$3$4$5$6$7$8$9$10:$11:\r\n") || die "Header/index mismatch for $uidl in ".$tmpvals->{'filename'};
 145 					close(MSGFILE);
 146 				};
 147 				if ($@) {
 148 					warn "Skipping message: $@";
 149 					next;
 150 				}
 151 				$msgs{$uidl} = $tmpvals;
 152 			}
 153 		}
 154 		close(INDEX);
 155 		while ($line = <STATUS>) {
 156 			if ($line =~ m/^:([[:xdigit:]]{8}):([[:xdigit:]]{8}):([[:xdigit:]]{4}):([[:xdigit:]]{8}):\r\n$/) {
 157 				if (!defined($msgs{$1})) {
 158 					# .mixstatus file can have entries for deleted messages
 159 					next;
 160 				}
 161 				$msgs{$1}{'new'} = !(hex($3) & 0x10);
 162 				$msgs{$1}{'flags'} =
 163 					((hex($3) & 0x1) ? 'S' : '').
 164 					((hex($3) & 0x2) ? 'T' : '').
 165 					((hex($3) & 0x4) ? 'F' : '').
 166 					((hex($3) & 0x8) ? 'R' : '');
 167 				foreach my $i (0 .. 25) {
 168 					if (hex($2) & (1 << $i)) {
 169 						$msgs{$1}{'flags'} .= chr(ord('a') + $i);
 170 					}
 171 				}
 172 			}
 173 		}
 174 		close(STATUS);
 175 		$totalmsgs += scalar(keys(%msgs));
 176 		print "$mailbox: Converting mix file (".scalar(keys(%msgs))." messages)\n" if $opts{'v'};
 177 	} else {
 178 		close(MAILBOX); #force $. reset
 179 		open(MAILBOX, '<', $mailbox);
 180 		$line = <MAILBOX>;
 181 		if (!defined($line)) {
 182 			print "$mailbox: Empty file (0 messages)\n" if $opts{'v'};
 183 		} elsif ($line eq "*mbx*\r\n") {
 184 			$line = <MAILBOX>;
 185 			if ($line =~ /^([[:xdigit:]]{8})([[:xdigit:]]{8})\r\n$/) {
 186 				$uidvalidity = hex($1);
 187 			} else {
 188 				warn "$mailbox: Bogus UID line";
 189 				return;
 190 			}
 191 			foreach my $n (0 .. 29) {
 192 				$line = <MAILBOX>;
 193 				$line =~ s/\r\n//;
 194 				if ($line ne '') {
 195 					push(@keywords, $line);
 196 				}
 197 			}
 198 			seek(MAILBOX, 2048, 0);
 199 			my $lazyuid = 0;
 200 			while ($line = <MAILBOX>) {
 201 				if ($line =~ m/( \d|\d\d)-(\w\w\w)-(\d\d\d\d) (\d\d):(\d\d):(\d\d) ([+-])(\d\d)(\d\d),(\d+);([[:xdigit:]]{8})([[:xdigit:]]{4})-([[:xdigit:]]{8})\r\n$/) {
 202 					if ($13 eq '00000000') {
 203 						$lazyuid++;
 204 					} else {
 205 						$lazyuid = hex($13);
 206 					}
 207 					my $hexuid = sprintf('%08x', $lazyuid);
 208 					$msgs{$hexuid} = {
 209 						'timestamp' => timegm($6, $5, $4, $1+0, $months{$2}, $3) + (($8 eq '-' ? 1 : -1)*($8 * 60 + $9)*60),
 210 						'size' => $10,
 211 						'filename' => $mailbox,
 212 						'offset' => tell(MAILBOX),
 213 						'skip' => 0,
 214 						'new' => !(hex($12) & 0x10),
 215 						'flags' =>
 216 							((hex($12) & 0x1) ? 'S' : '').
 217 							((hex($12) & 0x2) ? 'T' : '').
 218 							((hex($12) & 0x4) ? 'F' : '').
 219 							((hex($12) & 0x8) ? 'R' : ''),
 220 					};
 221 					foreach my $i (0 .. 25) {
 222 						if (hex($11) & (1 << $i)) {
 223 							$msgs{$hexuid}{'flags'} .= chr(ord('a') + $i);
 224 						}
 225 					}
 226 					seek(MAILBOX, $msgs{$hexuid}{'size'}, 1);
 227 				} else {
 228 					warn "Bogus line in mbx";
 229 				}
 230 			}
 231 			$totalmsgs += scalar(keys(%msgs));
 232 			print "$mailbox: Converting mbx file (".scalar(keys(%msgs))." messages)\n" if $opts{'v'};
 233 		} elsif ($line =~ m/^From /) {
 234 			seek(MAILBOX, 0, 0);
 235 			my $lazyuid = 0;
 236 			my $tmpoffset;
 237 			my $tmptimestamp;
 238 			my %tmpkeywords = ();
 239 			my $tmpflags;
 240 			my $tmpnew;
 241 			my $pseudomsg;
 242 			my $end = 0;
 243 			my $inheader = 0;
 244 			$uidvalidity = time();
 245 			while ($line = <MAILBOX>) {
 246 				if ($line =~ m/^From (?:\S+)\s+... ... (?: \d|\d\d) \d\d:\d\d:\d\d \d\d\d\d(?: [+-]\d\d\d\d)?\n$/) {
 247 					if ($end > 0 && !$pseudomsg) {
 248 						# found end of current message, capture info
 249 						my $hexuid = sprintf('%08x', $lazyuid);
 250 						$msgs{$hexuid} = {
 251 							'timestamp' => $tmptimestamp,
 252 							'size' => $end - $tmpoffset,
 253 							'filename' => $mailbox,
 254 							'offset' => $tmpoffset,
 255 							'skip' => 0,
 256 							'new' => $tmpnew,
 257 							'flags' => $tmpflags
 258 						};
 259 					}
 260 					# capture $n vars here, just to avoid confusion, but to confuse, (?:) is grouping without capturing
 261 					$line =~ m/^From (?:\S+)\s+... (...) ( \d|\d\d) (\d\d):(\d\d):(\d\d) (\d\d\d\d)(?: ([+-])(\d\d)(\d\d))?\n$/;
 262 					$tmpoffset = tell(MAILBOX);
 263 					$inheader = 1;
 264 					$tmptimestamp = timegm($5, $4, $3, $2+0, $months{$1}, $6) + (defined($8) ? (($7 eq '-' ? 1 : -1)*($8 * 60 + $9)*60) : 0);
 265 					$tmpflags = '';
 266 					$tmpnew = 1;
 267 					$lazyuid++;
 268 					$pseudomsg = 0;
 269 				} elsif ($inheader) {
 270 					if ($line =~ m/X-IMAP(base)?: (\d+) (\d+)\n$/) {
 271 						$uidvalidity = $2;
 272 						# X-IMAP: means pseudo message
 273 						if (!defined($1)) {
 274 							$pseudomsg = 1;
 275 							$lazyuid = 0;
 276 						}
 277 					} elsif ($line =~ m/X-Keywords:\s+(.*)\n$/) {
 278 						foreach my $kw (split(' ', $1)) {
 279 							if (!defined($tmpkeywords{$kw})) {
 280 								$tmpkeywords{$kw} = scalar(@keywords);
 281 								push(@keywords, $kw);
 282 							}
 283 							if ($tmpkeywords{$kw} < 26) {
 284 								$tmpflags .= chr(ord('a') + $tmpkeywords{$kw});
 285 							}
 286 						}
 287 					} elsif ($line =~ m/X-UID: (\d+)\n$/) {
 288 						$lazyuid = $1;
 289 					} elsif ($line =~ m/^(X-)?Status: (\S+)/) {
 290 						foreach my $f (split(//, $2)) {
 291 							if ($f eq 'R') {
 292 								$tmpflags .= 'S';
 293 							} elsif ($f eq 'A') {
 294 								$tmpflags .= 'R';
 295 							} elsif ($f eq 'F') {
 296 								$tmpflags .= 'F';
 297 							} elsif ($f eq 'D') {
 298 								$tmpflags .= 'T';
 299 							} elsif ($f eq 'O') {
 300 								$tmpnew = 0;
 301 							}
 302 						}
 303 					} elsif ($line =~ m/^\n$/) {
 304 						$inheader = 0;
 305 						$end = tell(MAILBOX);
 306 					}
 307 				} else {
 308 					$end = tell(MAILBOX);
 309 				}
 310 			}
 311 			# catch last message (if one)
 312 			if ($end > 0 && !$pseudomsg) {
 313 				# found end of current message, capture info
 314 				my $hexuid = sprintf('%08x', $lazyuid);
 315 				$msgs{$hexuid} = {
 316 					'timestamp' => $tmptimestamp,
 317 					'size' => $end - $tmpoffset,
 318 					'filename' => $mailbox,
 319 					'offset' => $tmpoffset,
 320 					'skip' => 0,
 321 					'new' => $tmpnew,
 322 					'flags' => $tmpflags
 323 				};
 324 			}
 325 			$totalmsgs += scalar(keys(%msgs));
 326 			print "$mailbox: Converting mbox file (".scalar(keys(%msgs))." messages)\n" if $opts{'v'};
 327 		} else {
 328 			print "$mailbox: Unknown file format, skipping\n" if $opts{'v'};
 329 			return;
 330 		}
 331 	}
 332 	eval {
 333 		mkpath($outdir);
 334 	};
 335 	if ($@) {
 336 		warn $@;
 337 		return;
 338 	}
 339 	if (scalar(@keywords) > 26) {
 340 		warn "$mailbox: Too many keywords, only first 26 will be kept";
 341 		@keywords=@keywords[0 .. 25];
 342 	}
 343 	if (scalar(@keywords) > 0) {
 344 		open(KEYWORDS, '>', "$outdir/dovecot-keywords");
 345 		foreach my $kn (0 .. $#keywords) {
 346 			print KEYWORDS "$kn ${keywords[$kn]}\n";
 347 		}
 348 		close(KEYWORDS);
 349 	}
 350 	mkdir("$outdir/tmp");
 351 	mkdir("$outdir/new");
 352 	mkdir("$outdir/cur");
 353 	if ($subfolder) {
 354 		open(SUBFOLDER, '>', "$outdir/maildirfolder");
 355 		close(SUBFOLDER);
 356 	}
 357 	if (scalar(keys(%msgs))) {
 358 		my $maxuidl = 0;
 359 		foreach my $uidl (sort(keys(%msgs))) {
 360 			if (hex($uidl) > $maxuidl) {
 361 				$maxuidl = hex($uidl);
 362 			}
 363 		}
 364 		open(UIDLIST, '>', "$outdir/dovecot-uidlist");
 365 		print UIDLIST "1 $uidvalidity ".($maxuidl + 1)."\n";
 366 		foreach my $uidl (sort(keys(%msgs))) {
 367 			my $msg = $msgs{$uidl};
 368 			my $data;
 369 			eval {
 370 				open(MSG, '<', $msg->{'filename'}) || die "Can't open ".$msg->{'filename'};
 371 				seek(MSG, $msg->{'offset'}+$msg->{'skip'}, 0) || die "Can't seek to ".($msg->{'offset'}+$msg->{'skip'});
 372 				read(MSG, $data, $msg->{'size'}) || die "Can't read ".$msg->{'size'}." bytes from ".$msg->{'filename'};
 373 				close(MSG);
 374 			};
 375 			if ($@) {
 376 				warn $@;
 377 				next;
 378 			}
 379 			$data =~ s/\r\n/\n/g;
 380 			my $filebase = $msg->{'timestamp'}.'.'.$uidl.'.'.$hostname;
 381 			if (!$msg->{'new'}) {
 382 				$filebase .= ':2,'.$msg->{'flags'};
 383 			}
 384 			my $filename = $outdir.'/'.($msg->{'new'} ? 'new' : 'cur').'/'.$filebase;
 385 			print UIDLIST hex($uidl)." $filebase\n";
 386 			open(NEWFILE, '>', $filename);
 387 			print NEWFILE $data;
 388 			close(NEWFILE);
 389 			utime($msg->{'timestamp'}, $msg->{'timestamp'}, $filename);
 390 		}
 391 		close(UIDLIST);
 392 	}
 393 }
 394 
 395 sub findfunc() {
 396 	my @s = stat($_);
 397 	# check for maildir and prune
 398 	if ($s[1] == $maildir_stat[1] && $s[0] == $maildir_stat[0]) {
 399 		$File::Find::prune = 1;
 400 		return;
 401 	}
 402 	# skip inbox
 403 	if ($s[1] == $inbox_stat[1] && $s[0] == $inbox_stat[0]) {
 404 		return;
 405 	}
 406 	if (basename($_) =~ m/^\.mix/) {
 407 		return;
 408 	}
 409 	if (-d $_ && ! -e $_.'/.mixstatus') {
 410 		return;
 411 	}
 412 	my $tmpnam = $File::Find::name;
 413 	$tmpnam =~ s/^\Q$uwmaildir\E\///;
 414 	if ($separator eq '/') {
 415 		convert($File::Find::name, $maildir.'/'.$tmpnam, 1);
 416 	} else {
 417 		$tmpnam =~ s/\Q$separator/$replacement/g;
 418 		$tmpnam =~ s/\//$separator/g;
 419 		convert($File::Find::name, $maildir.'/'.$separator.$tmpnam, 1);
 420 	}
 421 }
 422 
 423 #
 424 # main body
 425 #
 426 
 427 getopts('hi:u:s:m:p:r:v', \%opts);
 428 if (defined($opts{'h'})) {
 429 	print "Usage:\n";
 430 	print "\t-h (help)\n";
 431 	print "\t-i inbox [INBOX]\n";
 432 	print "\t-u uwmaildir [mail] ('' to skip)\n";
 433 	print "\t-s subscriptions [.mailboxlist] ('' to skip)\n";
 434 	print "\t-m maildir [Maildir]\n";
 435 	print "\t-p path-separator [.] (use / if using LAYOUT=fs, anything else may not work as expected)\n";
 436 	print "\t-r replacement [_] (replacement for path-separator, for listescape plugin, make sure to quote \\ properly)\n";
 437 	print "\t-v (verbose)\n";
 438 	print "\n";
 439 	print "maildir must not exist\n";
 440 	print "assumes that job is being run as user owning all files\n";
 441 	print "conversion is completely non-destructive, all original files are left intact\n";
 442 	exit 0;
 443 }
 444 $inbox = defined($opts{'i'}) ? $opts{'i'} : 'INBOX';
 445 $uwmaildir = defined($opts{'u'}) ? $opts{'u'} : 'mail';
 446 $subscriptions = defined($opts{'s'}) ? $opts{'s'} : '.mailboxlist';
 447 $maildir = defined($opts{'m'}) ? $opts{'m'} : 'Maildir';
 448 $separator = defined($opts{'p'}) ? $opts{'p'} : '.';
 449 $replacement = defined($opts{'r'}) ? $opts{'r'} : '_';
 450 chomp($hostname = `hostname`);
 451 
 452 die "$maildir must not exist" if (-e $maildir);
 453 die "$inbox doesn't exist" if (! -e $inbox);
 454 die "$uwmaildir doesn't exist" if ($uwmaildir ne '' && ! -d $uwmaildir);
 455 die "$subscriptions doesn't exist" if ($subscriptions ne '' && ! -e $subscriptions);
 456 
 457 umask(077);
 458 
 459 convert($inbox, $maildir, 0);
 460 
 461 # get dev/ino info for inbox and maildir so if we happen to be converting . we don't convert them as well
 462 @inbox_stat = stat($inbox);
 463 @maildir_stat = stat($maildir);
 464 
 465 #if (-d $inbox) {
 466 #	find({ 'wanted' => \&findfunc, 'no_chdir' => 1 }, $inbox);
 467 #}
 468 
 469 if ($uwmaildir ne '') {
 470 	find({ 'wanted' => \&findfunc, 'no_chdir' => 1 }, $uwmaildir);
 471 }
 472 
 473 if ($subscriptions ne '') {
 474 	if (open(SUBS, '<', $subscriptions)) {
 475 		eval {
 476 			open(NEWSUBS, '>', "$maildir/subscriptions") || die "Can't open $maildir/subscriptions";
 477 		};
 478 		if ($@) {
 479 			warn $@;
 480 		} else {
 481 			my $line;
 482 			while ($line = <SUBS>) {
 483 				$line =~ s/^\Q$uwmaildir\E\///;
 484 				if ($separator ne '/') {
 485 					$line =~ s/\Q$separator/$replacement/g;
 486 					$line =~ s/\//$separator/g;
 487 				}
 488 				print NEWSUBS $line;
 489 			}
 490 		}
 491 		close(SUBS);
 492 		close(NEWSUBS);
 493 	} else {
 494 		warn "Can't open $subscriptions"
 495 	}
 496 }
 497 
 498 print "Total conversion: $totalmsgs messages\n" if ($opts{'v'});

New Attachment

File to upload
Rename to
Overwrite existing attachment of same name
What do you do to prevent spam?

Attached Files

To refer to attachments on a page, use attachment:filename, as shown below in the list of files. Do NOT use the URL of the [get] link, since this is subject to change and can break easily.
  • [get | view] (2017-03-28 09:32:57, 13.5 KB) [[attachment:uw2dovecot.pl]]
 All files | Selected Files: delete move to page copy to page