#!/usr/bin/env perl

# v1.0 by Timo Sirainen, public domain

# some maildir filenames created by .. courier? maildrop? .. has file sizes
# that don't match the file's real size. this script finds such files and
# renames them. if they're found from dovecot-uidlist, they're also renamed
# within there, so their IMAP UID doesn't change either. the POP3 UIDL
# is also optionally preserved then.

use File::Basename;
use strict;

my $maildirlock_path = "/usr/local/libexec/dovecot/maildirlock";
my $preserve_pop3_uidl = 1;

sub scan_maildir {
  my ($dir, $renames) = @_;

  my @files;
  if (opendir my $dh, $dir) {
    @files = readdir($dh);
    closedir $dh;
  }
  foreach my $fname (@files) {
    next if ($fname eq "." || $fname eq "..");
    
    next if ($fname !~ /^([^:]*),S=(\d+)[^:]*(.*)$/);
    my ($base_fname_no_size, $fname_size, $flags) = ($1, $2, $3);
    
    my $path = "$dir/$fname";
    my @stat = stat($path);
    next if scalar @stat == 0;
    
    my $real_size = $stat[7];
    next if $real_size == $fname_size;
    
    my $newfname = "$base_fname_no_size$flags";
    my $newpath = "$dir/$newfname";
    $$renames{$path} = $newpath;
  }
}

sub dovecot_uidlist_fix {
  my ($path, $renames) = @_;
  
  my %base_renames;
  foreach my $src (keys %{$renames}) {
    my $fname = basename($src);
    $fname =~ s/:.*$//;
    
    my $dest = $$renames{$src};
    my $dest_fname = basename($dest);
    $dest_fname =~ s/:.*$//;

    $base_renames{$fname} = $dest_fname;
  }
  
  my $uidlist_path = "$path/dovecot-uidlist";
  my $uidlist_tmp = "$path/dovecot-uidlist.tmp2";
  open my $fin, $uidlist_path || return;
  my $fout;
  if (!open $fout, ">$uidlist_tmp") {
    close $fin;
    return;
  }
  my $hdr = <$fin>;
  print $fout $hdr;
  while (<$fin>) {
    chomp $_;
    if (/^(\d+) ([^:]*)?:(.*)$/) {
      my ($uid, $extra, $fname) = ($1, $2, $3);
      
      my $base_fname = $fname;
      $base_fname =~ s/:.*$//;
      my $new_fname = $base_renames{$base_fname};
      if (!$new_fname || !$preserve_pop3_uidl || $extra =~ /\bP/) {
	$fname = $new_fname if ($new_fname);
	print $fout "$uid $extra:$fname\n";
      } else {
	$fname =~ s/:.*$//;
	print $fout "$uid P$fname $extra:$new_fname\n";
      }
    } else {
      print $fout "$_\n";
    }
  }
  close $fin;
  close $fout;
  
  rename($uidlist_tmp, $uidlist_path);
}

sub maildir_fix_once {
  my ($path) = @_;

  my $retry = 0;
  my %renames;
  scan_maildir("$path/new", \%renames);
  scan_maildir("$path/cur", \%renames);

  return 0 if (scalar keys %renames == 0);
  
  open my $output, "-|", $maildirlock_path, ($path, "30");
  my $pid = <$output>;
  close $output;
  
  foreach my $src (keys %renames) {
    my $dest = $renames{$src};
    $retry = 1 if (!rename($src, $dest));
  }
  
  dovecot_uidlist_fix($path, \%renames);
  
  kill 15, $pid;
  return $retry;
}

sub maildir_fix {
  my ($path) = @_;
  
  if (maildir_fix_once($path)) {
    if (maildir_fix_once($path)) {
      print STDERR "Fixing failed: $path\n";
    }
  }
}

if (scalar @ARGV == 0) {
  print STDERR "Usage: maildir-size-fix.pl /path/to/Maildir\n";
  exit 1
}

my $dir = $ARGV[0];
maildir_fix($dir);
if (opendir my $dh, $dir) {
  foreach my $fname (readdir($dh)) {
    next if ($fname !~ /^\.[^\.]/);
    my $path = "$dir/$fname";
    maildir_fix($path) if (-d $path);
  }
  closedir $dh;
}