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
I'm tired of too too much wiki spam. How do you definitely get rid of them? (or email tss at iki.fi for the answer)

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