#!/usr/bin/perl -w

use strict;
use warnings;

package Cyrus::ImapReplica;

use Mail::IMAPTalk;
use Date::Parse;
use Cyrus::SyncClient;
use File::Temp;
use IO::File;

sub new {
  my $class = shift;

  my $tempdir = File::Temp::tempdir(CLEANUP => 1);

  return bless {
    prefix => 'INBOX', 
    tempdir => $tempdir,
  }, ref($class) || $class;
}

sub source {
  my $Self = shift;
  my ($server, $username, $password) = @_;

  die "Need a server, username and password" unless
    ($server and $username and $password);

  $Self->{imap_server} = $server; # IO::Socket::INET compatible
  $Self->{imap_username} = $username;
  $Self->{imap_password} = $password;

  return;
}

sub target {
  my $Self = shift;
  my ($account, $server, $username, $password) = @_;

  die "Need an account, server, username and password" unless
    ($account and $server and $username and $password);

  $Self->{target_user} = $account;
  $Self->{sync_server} = $server; # IO::Socket::INET compatible
  $Self->{sync_username} = $username;
  $Self->{sync_password} = $password;

  return;
}

sub get_sync {
  my $Self = shift;

  unless ($Self->{sync}) {
    $Self->{sync} = Cyrus::SyncClient->new(
      $Self->{sync_server},
      $Self->{sync_username},
      $Self->{sync_password},
    );
    if ($Self->{verbose}) {
      $Self->{sync}{verbose} = $Self->{verbose};
    }
  }

  return $Self->{sync};
}

sub folder_map {
  my $Self = shift;
  my $cb = shift;

  $Self->{folder_map} = $cb;
}

sub imap_filter {
  my $Self = shift;
  my $cb = shift;

  $Self->{imap_filter} = $cb;
}

sub imap_io {
  my $Self = shift;

  unless ($Self->{imap_io}) {
    my $it = Mail::IMAPTalk->new(
      Server => $Self->{imap_server},
      Username => $Self->{imap_username},
      Password => $Self->{imap_password},
      Uid => 1,
    );
    die "Failed to connect to imap" unless $it;
    $Self->{imap_io} = $it;
  }
  
  return $Self->{imap_io};
}

sub get_imap_folders {
  my $Self = shift;
  my $it = $Self->imap_io();
  my @folders = map { $_->[2] } $it->list($Self->{prefix}, '*');
  unless (grep { $_ eq 'INBOX' } @folders) {
    push @folders, 'INBOX';
  }
  if ($Self->{imap_filter}) {
    @folders = grep { $Self->{imap_filter}($_) } @folders;
  }
  return { map { $Self->sync_name($_) => $_ } @folders };
}

sub get_imap_sub {
  my $Self = shift;
  my $it = $Self->imap_io();
  my @folders = map { $_->[2] } $it->lsub($Self->{prefix}, '*');
  unless (grep { $_ eq 'INBOX' } @folders) {
    push @folders, 'INBOX';
  }
  if ($Self->{imap_filter}) {
    @folders = grep { $Self->{imap_filter}($_) } @folders;
  }
  return { map { $Self->sync_name($_) => $_ } @folders };
}

sub examine_imap {
  my $Self = shift;
  my $folder = shift;
  my $it = $Self->imap_io();
  my $status = $it->status($folder, '(uidvalidity uidnext)');
  my $uidnext = $status->{uidnext};
  my $val = $status->{uidvalidity};
  return unless $it->select($folder);
  my %ret = (
    uidvalidity => $val || time(),
    lastuid => $uidnext - 1,
    contents => {},
  );
  my $data = $it->fetch('1:*', 'flags');
  foreach my $uid (keys %$data) {
    $ret{contents}{$uid}{flags} = pf($data->{$uid}{flags});
  }
  return \%ret;
}

sub run {
  my $Self = shift;
  my $sync = $Self->get_sync();

  my $target_user = $Self->{target_user};

  $sync->lock();
  my ($sfolders, $ssub) = $sync->user($target_user);
  my $mappedsub = { map { $Self->sync_name($_) => $ssub->{$_} } keys %$ssub };
  my $ifolders = $Self->get_imap_folders();
  my $sub = $Self->get_imap_sub();

  if ($Self->{delete_missing}) {
    foreach my $folder (sort keys %$sfolders) {
      unless ($ifolders->{$folder}) {
        $sync->delete($folder);
      }
    }
  }
  foreach my $folder (sort keys %$ifolders) {
    my $imapfolder = $ifolders->{$folder};
    my $imapdata = $Self->examine_imap($imapfolder);
    next unless ($imapdata and $imapdata->{uidvalidity});
    my $syncdata = $sfolders->{$folder};
    my $quota;
    # check validity matches
    if ($syncdata) {
      if ($imapdata->{uidvalidity} != $syncdata->{uidvalidity}) {
        $quota = $syncdata->{quota};
        $syncdata = undef;
        $sync->delete($folder);
      }
    }

    # created if needed
    unless ($syncdata) {
      my $uidvalidity = $imapdata->{uidvalidity};
      eval { $sync->create($folder, {uidvalidity => $uidvalidity}) };
      next if $@;
      $syncdata = {
        uidvalidity => $uidvalidity || time(),
        lastuid => 0,
        contents => {},
      };
      if ($quota) {
        $sync->setquota($folder, $quota); # keep the same quota :)
      }
    }

    # select the folder for operations - it's either already here or
    # been created by the above
    $sync->select($folder);

    # now sync the messages
    my @expunge;
    foreach my $uid (sort { $a <=> $b } keys %{$syncdata->{contents}}) {
      unless ($imapdata->{contents}{$uid}) {
        push @expunge, $uid;
      }
    }
    while (@expunge) {
      my @uids = splice(@expunge, 0, 64);
      $sync->expunge(@uids);
    }

    my $lastuid = $imapdata->{lastuid};
    my $uidvalidity = $imapdata->{uidvalidity};
    my $time = time();
    my @fetch;
    my @setflags;
    foreach my $uid (sort { $a <=> $b } keys %{$imapdata->{contents}}) {
      if ($syncdata->{contents}{$uid}) {
        unless (flag_eq($imapdata->{contents}{$uid}{flags}, $syncdata->{contents}{$uid}{flags})) {
          push @setflags, $uid;
        }
      }
      else {
        # NEED TO FETCH THE MESSAGE!
        push @fetch, $uid;
      }
    }

    while (@setflags) {
      my @uids = splice(@setflags, 0, 64);
      $sync->setflags({ map { $_ => $imapdata->{contents}{$_}{flags} } @uids });
    }

    # make sure UIDLAST gets updated either way
    unless (@fetch or $imapdata->{lastuid} == $syncdata->{lastuid}) {
      $sync->uidlast($imapdata->{lastuid}, $time);
    }

    while (@fetch) {
      my @uids = splice(@fetch, 0, 64);
      my $alldata = $Self->fetch_messages($imapfolder, @uids);
      my %map;
      foreach my $uid (@uids) {
        my $data = $alldata->{$uid};
        my $if = $imapdata->{contents}{$uid}{flags};
        my $body = $data->{body};
        my $internaldate = str2time($data->{internaldate});
        my $sentdate = str2time($data->{envelope}{Date});
        unless ($sentdate) {
          $sentdate = $internaldate;
          print "INVALID SENTDATE $folder $uid: $data->{envelope}{Date}, setting to INTERNALDATE\n";
        }
        $map{$uid} = {
          internaldate => $internaldate,
          sentdate => $sentdate,
          body => $body,
          flags => $if,
        };
      }
      $sync->upload(@fetch ? $uids[-1] : $lastuid, $uidvalidity, \%map);
    }
  
    # set the seen state for the folder (always)
    my ($seen, $recent) = seen_str($imapdata->{contents});
    $sync->setseen($target_user, $folder, {lastuid => $recent || $lastuid, seen => $seen});

    if ($sub->{$folder} and not $mappedsub->{$folder}) {
      $sync->addsub($target_user, $folder);
    }
    elsif ($mappedsub->{$folder} and not $sub->{$folder}) {
      $sync->delsub($target_user, $folder);
    }

    # done :)
  }

  $sync->unlock();
}

sub fetch_messages {
  my $Self = shift;
  my $folder = shift;
  my @uids = @_;

  my $it = $Self->imap_io();

  $it->examine($folder) or die "Failed to select $folder";
  $it->literal_handle_control(sub {
    my $bytes = shift;
    return undef unless $bytes > 50000;
    my $io = File::Temp::tempfile(DIR => $Self->{tempdir});
    return $io;
  });
  my $data = $it->fetch("$uids[0]:$uids[-1]", '(internaldate envelope body.peek[])');
  die "No data for $folder $uids[0]:$uids[-1]" unless $data;
  $it->literal_handle_control(0);
  return $data;
}

sub sync_name {
  my $Self = shift;
  my $imapname = shift;
  if ($Self->{folder_map}) {
    return $Self->{folder_map}($imapname);
  }
  else {
    my $target_user = $Self->{target_user};
    my $base = ($target_user =~ m{(.*?)\@(.*)}) ? "$2\!user.$1" : "user.$target_user";
    return $base . substr($imapname, 5); # strip INBOX
  }
}

# helpers

sub pf {
  my $flags = shift;
  return { map { lc($_) => $_ } @$flags };
}

sub flag_eq {
  my $a = shift;
  my $b = shift;

  my @ak = grep { $_ ne "\\seen" and $_ ne "\\recent" } sort keys %$a;
  my @bk = grep { $_ ne "\\seen" and $_ ne "\\recent" } sort keys %$b;

  return join(' ', @ak) eq join(' ', @bk);
}

sub seen_str {
  my $d = shift;

  my @list;
  my $state = 0;
  my $lastuid = 0;
  my $firstuid = 0;
  my $recent = 0;

  foreach my $uid (sort { $a <=> $b } keys %$d) {
    my $seen = exists $d->{$uid}{flags}{"\\seen"};
    if (not $recent and exists $d->{$uid}{flags}{"\\recent"}) {
      $recent = $uid - 1;
    }

    if ($seen and not $state) {
      # becoming true
      $firstuid = $uid;
      $state = 1;
    }
    elsif ($state and not $seen) {
      # becoming false
      push @list, $firstuid eq $lastuid ? $firstuid : "$firstuid:$lastuid";
      $state = 0;
    }

    $lastuid = $uid;
  }

  if ($state) {
    push @list, $firstuid eq $lastuid ? $firstuid : "$firstuid:$lastuid";
  }

  return (join(',', @list), $recent);
}

sub parse_date {
  my $body = shift;
  my $res = find_date($body);
  return $res->epoch() if defined $res;
  return undef;
}

1;
