diff --git a/.gitignore b/.gitignore index d344ba6..e69de29 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +0,0 @@ -config.json diff --git a/Dockerfile b/Dockerfile new file mode 100644 index 0000000..a581caa --- /dev/null +++ b/Dockerfile @@ -0,0 +1,68 @@ +FROM phusion/baseimage:0.9.0 +MAINTAINER Romain Pignolet + +WORKDIR /root + +RUN apt-get update +RUN apt-get -y install build-essential \ + libanyevent-httpd-perl \ + libdata-uuid-libuuid-perl \ + libdatetime-perl \ + libdbd-sqlite3-perl \ + libdbi-perl \ + libemail-address-perl \ + libemail-mime-perl \ + libhtml-parser-perl \ + libhtml-strip-perl \ + libhttp-tiny-perl \ + libhttp-date-perl \ + libimage-size-perl \ + libio-socket-ssl-perl \ + libjson-perl \ + libjson-xs-perl \ + liblocale-gettext-perl \ + libswitch-perl \ + libexpat1-dev \ + git \ + nginx + +RUN cpan; true + +RUN curl -L -O http://search.cpan.org/CPAN/authors/id/C/CI/CINDY/AnyEvent-HTTPD-SendMultiHeaderPatch-v0.1.2.tar.gz && \ + tar xf AnyEvent-HTTPD-SendMultiHeaderPatch-v0.1.2.tar.gz && \ + cd AnyEvent-HTTPD-SendMultiHeaderPatch-v0.1.2 && \ + perl Makefile.PL && \ + make install + +RUN git clone https://github.com/brong/Net-CardDAVTalk.git && \ + cd Net-CardDAVTalk && \ + perl Makefile.PL && \ + make install + +RUN perl -MCPAN -e 'my $c = "CPAN::HandleConfig"; $c->load(doit => 1, autoconfig => 1); $c->edit(prerequisites_policy => "follow"); $c->edit(build_requires_install_policy => "yes"); $c->commit' + +RUN cpan Class::ReturnValue Class::Accessor Set::Infinite \ + DateTime::Set DateTime::Event::Recurrence DateTime::TimeZone DateTime::Event::ICal \ + Text::vFile::asData Test::LongString Test::Warn \ + Data::ICal UNIVERSAL::require Mail::IMAPTalk XML::Parser \ + XML::SemanticDiff XML::Spice Email::Sender::Transport::SMTPS \ + Net::DAVTalk Net::CalDAVTalk AnyEvent::HTTPD::CookiePatch \ + AnyEvent::IMAP Cookie::Baker Date::Parse HTML::GenerateUtil \ + Email::Sender:Simple Moose IO:All AnyEvent:HTTP Net::Server::PreFork \ + List::Pairwise IO::LockedFile Template EV Net::DNS || true + +RUN mkdir -p /home/jmap/data + +COPY . /home/jmap/jmap-perl + +WORKDIR /home/jmap/jmap-perl + +RUN rm /etc/nginx/sites-enabled/default + +COPY docker/nginx.conf /etc/nginx/sites-enabled/ + +COPY docker/entrypoint.sh /root/ + +EXPOSE 80 + +ENTRYPOINT ["sh", "/root/entrypoint.sh"] diff --git a/INSTALL b/INSTALL index 66283ff..74410f9 100644 --- a/INSTALL +++ b/INSTALL @@ -3,23 +3,23 @@ Debian install instructions (port to your own OS as you like) # Might need some software too apt-get install build-essential \ - libanyevent-httpd-perl \ - libdata-uuid-libuuid-perl \ - libdatetime-perl \ - libdbd-sqlite3-perl \ - libdbi-perl \ - libemail-address-perl \ - libemail-mime-perl \ - libhtml-parser-perl \ - libhtml-strip-perl \ - libhttp-tiny-perl \ - libhttp-date-perl \ - libimage-size-perl \ - libio-socket-ssl-perl \ - libjson-perl \ - libjson-xs-perl \ - liblocale-gettext-perl \ - libswitch-perl + libanyevent-httpd-perl \ + libdata-uuid-libuuid-perl \ + libdatetime-perl \ + libdbd-sqlite3-perl \ + libdbi-perl \ + libemail-address-perl \ + libemail-mime-perl \ + libhtml-parser-perl \ + libhtml-strip-perl \ + libhttp-tiny-perl \ + libhttp-date-perl \ + libimage-size-perl \ + libio-socket-ssl-perl \ + libjson-perl \ + libjson-xs-perl \ + liblocale-gettext-perl \ + libswitch-perl cpan AnyEvent::HTTPD::CookiePatch cpan AnyEvent::IMAP @@ -40,7 +40,7 @@ config.example to config.json and replace XXX and YYY with your details. Replace /etc/nginx/sites-available/default with the a symlink to nginx.conf -Run bin/blocking.pl in one screen +Run bin/apiendpoint.pl in one screen Run bin/server.pl in another screen There's various stuff hard coded too, oh well diff --git a/JMAP/API.pm b/JMAP/API.pm index 3e9939e..59b6f89 100644 --- a/JMAP/API.pm +++ b/JMAP/API.pm @@ -3,10 +3,13 @@ package JMAP::API; use JMAP::DB; -use JSON; use strict; use warnings; use Encode; +use HTML::GenerateUtil qw(escape_html); +use JSON::XS; + +my $json = JSON::XS->new->utf8->canonical(); sub new { my $class = shift; @@ -15,32 +18,38 @@ sub new { return bless {db => $db}, ref($class) || $class; } +sub setid { + my $Self = shift; + my $key = shift; + my $val = shift; + $Self->{idmap}{"#$key"} = $val; +} + sub idmap { my $Self = shift; my $key = shift; - if (@_) { - $Self->{idmap}{$key} = shift; - } - return exists $Self->{idmap}{$key} ? $Self->{idmap}{$key} : $key; + return unless $key; + my $val = exists $Self->{idmap}{$key} ? $Self->{idmap}{$key} : $key; + return $val; } sub getAccounts { my $Self = shift; my $args = shift; - my $dbh = $Self->{db}->dbh(); - + $Self->begin(); my $user = $Self->{db}->get_user(); + $Self->commit(); my @list; push @list, { - id => $Self->{db}->{accountId}, + id => $Self->{db}->accountid(), name => $user->{displayname} || $user->{email}, isPrimary => $JSON::true, isReadOnly => $JSON::false, hasMail => $JSON::true, - hasContacts => $JSON::false, - hasCalendars => $JSON::false, + hasContacts => $JSON::true, + hasCalendars => $JSON::true, }; return ['accounts', { @@ -49,13 +58,22 @@ sub getAccounts { }]; } +sub refreshSyncedCalendars { + my $Self = shift; + + $Self->{db}->sync_calendars(); + + # no response + return (); +} + sub getPreferences { my $Self = shift; my $args = shift; - my $dbh = $Self->{db}->dbh(); - + $Self->begin(); my $user = $Self->{db}->get_user(); + $Self->commit(); my @list; @@ -68,9 +86,9 @@ sub getSavedSearches { my $Self = shift; my $args = shift; - my $dbh = $Self->{db}->dbh(); - + $Self->begin(); my $user = $Self->{db}->get_user(); + $Self->commit(); my @list; @@ -84,9 +102,9 @@ sub getPersonalities { my $Self = shift; my $args = shift; - my $dbh = $Self->{db}->dbh(); - + $Self->begin(); my $user = $Self->{db}->get_user(); + $Self->commit(); my @list; push @list, { @@ -96,7 +114,7 @@ sub getPersonalities { email => $user->{email}, name => $user->{displayname} || $user->{email}, textSignature => "-- \ntext sig", - textSignature => "-- \nhtml sig", + htmlSignature => "--
html sig", replyTo => $user->{email}, autoBcc => "", addBccOnSMTP => $JSON::false, @@ -121,49 +139,64 @@ sub getPersonalities { }]; } +sub begin { + my $Self = shift; + $Self->{db}->begin(); +} + +sub commit { + my $Self = shift; + $Self->{db}->commit(); +} + +sub _transError { + my $Self = shift; + if ($Self->{db}->in_transaction()) { + $Self->{db}->rollback(); + } + return @_; +} + sub getMailboxes { my $Self = shift; my $args = shift; + $Self->begin(); my $dbh = $Self->{db}->dbh(); my $user = $Self->{db}->get_user(); my $accountid = $Self->{db}->accountid(); - return ['error', {type => 'accountNotFound'}] + return $Self->_transError(['error', {type => 'accountNotFound'}]) if ($args->{accountId} and $args->{accountId} ne $accountid); - my $data = $dbh->selectall_arrayref("SELECT jmailboxid, parentid, name, role, precedence, mustBeOnly, mayDelete, mayRename, mayAdd, mayRemove, mayChild, mayRead FROM jmailboxes WHERE active = 1"); + my $newState = "$user->{jstateMailbox}"; + + my $data = $dbh->selectall_arrayref("SELECT * FROM jmailboxes WHERE active = 1", {Slice => {}}); my %ids; if ($args->{ids}) { - %ids = map { $_ => 1 } @{$args->{ids}}; + %ids = map { $Self->idmap($_) => 1 } @{$args->{ids}}; } else { - %ids = map { $_->[0] => 1 } @$data; + %ids = map { $_->{jmailboxid} => 1 } @$data; } - my %byrole = map { $_->[3] => $_->[0] } grep { $_->[3] } @$data; + my %byrole = map { $_->{role} => $_->{jmailboxid} } grep { $_->{role} } @$data; my @list; my %ONLY_MAILBOXES; foreach my $item (@$data) { - next unless delete $ids{$item->[0]}; - $ONLY_MAILBOXES{$item->[0]} = $item->[5]; + next unless delete $ids{$item->{jmailboxid}}; + $ONLY_MAILBOXES{$item->{jmailboxid}} = $item->{mustBeOnlyMailbox}; my %rec = ( - id => "$item->[0]", - parentId => ($item->[1] ? "$item->[1]" : undef), - name => $item->[2], - role => $item->[3], - precedence => $item->[4], - mustBeOnlyMailbox => $item->[5] ? $JSON::true : $JSON::false, - mayDeleteMailbox => $item->[6] ? $JSON::true : $JSON::false, - mayRenameMailbox => $item->[7] ? $JSON::true : $JSON::false, - mayAddMessages => $item->[8] ? $JSON::true : $JSON::false, - mayRemoveMessages => $item->[9] ? $JSON::true : $JSON::false, - mayCreateChild => $item->[10] ? $JSON::true : $JSON::false, - mayReadMessageList => $item->[11] ? $JSON::true : $JSON::false, + id => "$item->{jmailboxid}", + parentId => ($item->{parentId} ? "$item->{parentId}" : undef), + name => $item->{name}, + role => $item->{role}, + sortOrder => $item->{sortOrder}, + (map { $_ => ($item->{$_} ? $JSON::true : $JSON::false) } qw(mustBeOnlyMailbox mayReadItems mayAddItems mayRemoveItems mayCreateChild mayRename mayDelete)), ); foreach my $key (keys %rec) { @@ -171,16 +204,16 @@ sub getMailboxes { } if (_prop_wanted($args, 'totalMessages')) { - ($rec{totalMessages}) = $dbh->selectrow_array("SELECT COUNT(DISTINCT msgid) FROM jmessages JOIN jmessagemap USING (msgid) WHERE jmailboxid = ? AND jmessages.active = 1 AND jmessagemap.active = 1", {}, $item->[0]); + ($rec{totalMessages}) = $dbh->selectrow_array("SELECT COUNT(DISTINCT msgid) FROM jmessages JOIN jmessagemap USING (msgid) WHERE jmailboxid = ? AND jmessages.active = 1 AND jmessagemap.active = 1", {}, $item->{jmailboxid}); $rec{totalMessages} += 0; } if (_prop_wanted($args, 'unreadMessages')) { - ($rec{unreadMessages}) = $dbh->selectrow_array("SELECT COUNT(DISTINCT msgid) FROM jmessages JOIN jmessagemap USING (msgid) WHERE jmailboxid = ? AND jmessages.isUnread = 1 AND jmessages.active = 1 AND jmessagemap.active = 1", {}, $item->[0]); + ($rec{unreadMessages}) = $dbh->selectrow_array("SELECT COUNT(DISTINCT msgid) FROM jmessages JOIN jmessagemap USING (msgid) WHERE jmailboxid = ? AND jmessages.isUnread = 1 AND jmessages.active = 1 AND jmessagemap.active = 1", {}, $item->{jmailboxid}); $rec{unreadMessages} += 0; } if (_prop_wanted($args, 'totalThreads')) { - ($rec{totalThreads}) = $dbh->selectrow_array("SELECT COUNT(DISTINCT thrid) FROM jmessages JOIN jmessagemap USING (msgid) WHERE jmailboxid = ? AND jmessages.active = 1 AND jmessagemap.active = 1", {}, $item->[0]); + ($rec{totalThreads}) = $dbh->selectrow_array("SELECT COUNT(DISTINCT thrid) FROM jmessages JOIN jmessagemap USING (msgid) WHERE jmailboxid = ? AND jmessages.active = 1 AND jmessagemap.active = 1", {}, $item->{jmailboxid}); $rec{totalThreads} += 0; } @@ -188,13 +221,14 @@ sub getMailboxes { # so long as they aren't in an ONLY_MAILBOXES folder if (_prop_wanted($args, 'unreadThreads')) { my $folderlimit = ''; - if ($ONLY_MAILBOXES{$item->[0]}) { - $folderlimit = "AND jmessagemap.jmailboxid = $item->[0]"; + if ($ONLY_MAILBOXES{$item->{jmailboxid}}) { + $folderlimit = "AND jmessagemap.jmailboxid = " . $dbh->quote($item->{jmailboxid}); } else { my @ids = grep { $ONLY_MAILBOXES{$_} } sort keys %ONLY_MAILBOXES; - $folderlimit = "AND jmessagemap.jmailboxid NOT IN (" . join(',', @ids) . ")" if @ids; + $folderlimit = "AND jmessagemap.jmailboxid NOT IN (" . join(',', map { $dbh->quote($_) } @ids) . ")" if @ids; } - ($rec{unreadThreads}) = $dbh->selectrow_array("SELECT COUNT(DISTINCT thrid) FROM jmessages JOIN jmessagemap USING (msgid) WHERE jmailboxid = $item->[0] AND jmessages.active = 1 AND jmessagemap.active = 1 AND thrid IN (SELECT thrid FROM jmessages JOIN jmessagemap USING (msgid) WHERE isUnread = 1 AND jmessages.active = 1 AND jmessagemap.active = 1 $folderlimit)"); + my $sql ="SELECT COUNT(DISTINCT thrid) FROM jmessages JOIN jmessagemap USING (msgid) WHERE jmailboxid = ? AND jmessages.active = 1 AND jmessagemap.active = 1 AND thrid IN (SELECT thrid FROM jmessages JOIN jmessagemap USING (msgid) WHERE isUnread = 1 AND jmessages.active = 1 AND jmessagemap.active = 1 $folderlimit)"; + ($rec{unreadThreads}) = $dbh->selectrow_array($sql, {}, $item->{jmailboxid}); $rec{unreadThreads} += 0; } @@ -202,10 +236,12 @@ sub getMailboxes { } my %missingids = %ids; + $Self->commit(); + return ['mailboxes', { list => \@list, accountId => $accountid, - state => "$user->{jhighestmodseq}", + state => $newState, notFound => (%missingids ? [map { "$_" } keys %missingids] : undef), }]; } @@ -214,8 +250,10 @@ sub getIdentities { my $Self = shift; my $args = shift; + $Self->begin(); my $user = $Self->{db}->get_user(); my $accountid = $Self->{db}->accountid(); + $Self->commit(); return ['identities', { accountId => $accountid, @@ -233,54 +271,49 @@ sub getIdentities { sub getMailboxUpdates { my $Self = shift; my $args = shift; - my $dbh = $Self->{db}->dbh(); + $Self->begin(); + my $dbh = $Self->{db}->dbh(); my $user = $Self->{db}->get_user(); my $accountid = $Self->{db}->accountid(); - return ['error', {type => 'accountNotFound'}] + return $Self->_transError(['error', {type => 'accountNotFound'}]) if ($args->{accountId} and $args->{accountId} ne $accountid); + my $newState = "$user->{jstateMailbox}"; + my $sinceState = $args->{sinceState}; - return ['error', {type => 'invalidArguments'}] + return $Self->_transError(['error', {type => 'invalidArguments'}]) if not $args->{sinceState}; - return ['error', {type => 'cannotCalculateChanges'}] + return $Self->_transError(['error', {type => 'cannotCalculateChanges', newState => $newState}]) if ($user->{jdeletedmodseq} and $sinceState <= $user->{jdeletedmodseq}); - my $data = $dbh->selectall_arrayref("SELECT jmailboxid, jmodseq, jcountsmodseq, active FROM jmailboxes ORDER BY jmailboxid"); + my $data = $dbh->selectall_arrayref("SELECT * FROM jmailboxes WHERE jmodseq > ?1 OR jcountsmodseq > ?1", {Slice => {}}, $sinceState); my @changed; my @removed; my $onlyCounts = 1; foreach my $item (@$data) { - if ($item->[1] > $sinceState) { - if ($item->[3]) { - push @changed, $item->[0]; - $onlyCounts = 0; - } - else { - push @removed, $item->[0]; - } + if ($item->{active}) { + push @changed, $item->{jmailboxid}; + $onlyCounts = 0 if $item->{jmodseq} > $sinceState; } - elsif (($item->[2] || 0) > $sinceState) { - if ($item->[3]) { - push @changed, $item->[0]; - } - else { - push @removed, $item->[0]; - } + else { + push @removed, $item->{jmailboxid}; } } + $Self->commit(); + my @res = (['mailboxUpdates', { accountId => $accountid, oldState => "$sinceState", - newState => "$user->{jhighestmodseq}", + newState => $newState, changed => [map { "$_" } @changed], removed => [map { "$_" } @removed], onlyCountsChanged => $onlyCounts ? JSON::true : JSON::false, }]); - if (@changed and $args->{fetchMailboxes}) { + if (@changed and $args->{fetchRecords}) { my %items = ( accountid => $accountid, ids => \@changed, @@ -288,8 +321,8 @@ sub getMailboxUpdates { if ($onlyCounts) { $items{properties} = [qw(totalMessages unreadMessages totalThreads unreadThreads)]; } - elsif ($args->{fetchMailboxProperties}) { - $items{properties} = $args->{fetchMailboxProperties}; + elsif ($args->{fetchRecordProperties}) { + $items{properties} = $args->{fetchRecordProperties}; } push @res, $Self->getMailboxes(\%items); } @@ -299,19 +332,60 @@ sub getMailboxUpdates { sub setMailboxes { my $Self = shift; - return ['error', {type => 'notImplemented'}]; + my $args = shift; + + $Self->begin(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + $Self->commit(); + + my $create = $args->{create} || {}; + my $update = $args->{update} || {}; + my $destroy = $args->{destroy} || []; + + $Self->{db}->begin_superlock(); + + my ($created, $notCreated) = $Self->{db}->create_mailboxes($create); + $Self->setid($_, $created->{$_}{id}) for keys %$created; + my ($updated, $notUpdated) = $Self->{db}->update_mailboxes($update, sub { $Self->idmap(shift) }); + my ($destroyed, $notDestroyed) = $Self->{db}->destroy_mailboxes($destroy); + + $Self->{db}->sync_imap(); + + $Self->{db}->end_superlock(); + + my @res; + push @res, ['mailboxesSet', { + accountId => $accountid, + oldState => undef, # proxy can't guarantee the old state + newState => undef, # or give a new state + created => $created, + notCreated => $notCreated, + updated => $updated, + notUpdated => $notUpdated, + destroyed => $destroyed, + notDestroyed => $notDestroyed, + }]; + + return @res; } sub _build_sort { my $Self = shift; - my $sortargs = shift; - return 'internaldate desc' unless $sortargs; + my $sortargs = shift || []; my %fieldmap = ( id => 'msgid', - date => 'internaldate', + date => 'msgdate', size => 'msgsize', isflagged => 'isFlagged', isunread => 'isUnread', + subject => 'sortsubject', + from => 'msgfrom', + to => 'msgto', ); my @items; $sortargs = [$sortargs] unless ref $sortargs; @@ -322,8 +396,7 @@ sub _build_sort { die unless $fieldmap{$field}; push @items, "$fieldmap{$field} $dir"; } - # XXX - sort by the from/subject fields - # XXX - threads? + push @items, "msgid desc"; # guarantee stable return join(', ', @items); } @@ -331,28 +404,129 @@ sub _load_mailbox { my $Self = shift; my $id = shift; + $Self->begin(); my $data = $Self->{db}->dbh->selectall_arrayref("SELECT msgid,jmodseq,active FROM jmessagemap WHERE jmailboxid = ?", {}, $id); + $Self->commit(); return { map { $_->[0] => $_ } @$data }; } +sub _load_hasatt { + my $Self = shift; + $Self->begin(); + my $data = $Self->{db}->dbh->selectcol_arrayref("SELECT msgid FROM jrawmessage WHERE hasAttachment = 1"); + $Self->commit(); + return { map { $_ => 1 } @$data }; +} + sub _match { my $Self = shift; my ($item, $condition, $storage) = @_; return $Self->_match_operator($item, $condition, $storage) if $condition->{operator}; - # XXX - condition handling code if ($condition->{inMailboxes}) { - my $match = 0; - foreach my $id (@{$condition->{inMailboxes}}) { + my $inall = 1; + foreach my $id (map { $Self->idmap($_) } @{$condition->{inMailboxes}}) { $storage->{mailbox}{$id} ||= $Self->_load_mailbox($id); - next unless $storage->{mailbox}{$id}{$item->[0]}[2]; #active - $match = 1; + next if $storage->{mailbox}{$id}{$item->{msgid}}[2]; #active + $inall = 0; } - return 0 unless $match; + return 0 unless $inall; + } + + if ($condition->{notInMailboxes}) { + my $inany = 0; + foreach my $id (map { $Self->idmap($_) } @{$condition->{notInMailboxes}}) { + $storage->{mailbox}{$id} ||= $Self->_load_mailbox($id); + next unless $storage->{mailbox}{$id}{$item->{msgid}}[2]; #active + $inany = 1; + } + return 0 if $inany; + } + + if ($condition->{before}) { + my $time = str2time($condition->{before})->epoch(); + return 0 unless $time < $item->{internaldate}; + } + + if ($condition->{after}) { + my $time = str2time($condition->{before})->epoch(); + return 0 unless $time >= $item->{internaldate}; + } + + if ($condition->{minSize}) { + return 0 unless $item->{msgsize} >= $condition->{minSize}; } - if ($condition->{isUnseen}) { + if ($condition->{maxSize}) { + return 0 unless $item->{msgsize} < $condition->{maxSize}; + } + + if ($condition->{isFlagged}) { + # XXX - threaded versions? + return 0 unless $item->{isFlagged}; + } + + if ($condition->{isUnread}) { + # XXX - threaded versions? + return 0 unless $item->{isUnread}; + } + + if ($condition->{isAnswered}) { # XXX - threaded versions? + return 0 unless $item->{isAnswered}; + } + + if ($condition->{isDraft}) { + # XXX - threaded versions? + return 0 unless $item->{isDraft}; + } + + if ($condition->{hasAttachment}) { + $storage->{hasatt} ||= $Self->_load_hasatt(); + return 0 unless $storage->{hasatt}{$item->{msgid}}; + # XXX - hasAttachment + } + + if ($condition->{text}) { + $storage->{textsearch}{$condition->{text}} ||= $Self->{db}->imap_search('text', $condition->{text}); + return 0 unless $storage->{textsearch}{$condition->{text}}{$item->{msgid}}; + } + + if ($condition->{from}) { + $storage->{fromsearch}{$condition->{from}} ||= $Self->{db}->imap_search('from', $condition->{from}); + return 0 unless $storage->{fromsearch}{$condition->{from}}{$item->{msgid}}; + } + + if ($condition->{to}) { + $storage->{tosearch}{$condition->{to}} ||= $Self->{db}->imap_search('to', $condition->{to}); + return 0 unless $storage->{tosearch}{$condition->{to}}{$item->{msgid}}; + } + + if ($condition->{cc}) { + $storage->{ccsearch}{$condition->{cc}} ||= $Self->{db}->imap_search('cc', $condition->{cc}); + return 0 unless $storage->{ccsearch}{$condition->{cc}}{$item->{msgid}}; + } + + if ($condition->{bcc}) { + $storage->{bccsearch}{$condition->{bcc}} ||= $Self->{db}->imap_search('bcc', $condition->{bcc}); + return 0 unless $storage->{bccsearch}{$condition->{bcc}}{$item->{msgid}}; + } + + if ($condition->{subject}) { + $storage->{subjectsearch}{$condition->{subject}} ||= $Self->{db}->imap_search('subject', $condition->{subject}); + return 0 unless $storage->{subjectsearch}{$condition->{subject}}{$item->{msgid}}; + } + + if ($condition->{body}) { + $storage->{bodysearch}{$condition->{body}} ||= $Self->{db}->imap_search('body', $condition->{body}); + return 0 unless $storage->{bodysearch}{$condition->{body}}{$item->{msgid}}; + } + + if ($condition->{header}) { + my $cond = $condition->{header}; + $cond->[1] = '' if @$cond == 1; + $storage->{headersearch}{"@$cond"} ||= $Self->{db}->imap_search('header', @$cond); + return 0 unless $storage->{headersearch}{"@$cond"}{$item->{msgid}}; } return 1; @@ -396,9 +570,9 @@ sub _collapse { my @res; my %seen; foreach my $item (@$data) { - next if $seen{$item->[1]}; + next if $seen{$item->{thrid}}; push @res, $item; - $seen{$item->[1]} = 1; + $seen{$item->{thrid}} = 1; } return \@res; } @@ -407,27 +581,31 @@ sub getMessageList { my $Self = shift; my $args = shift; + $Self->begin(); my $dbh = $Self->{db}->dbh(); my $user = $Self->{db}->get_user(); my $accountid = $Self->{db}->accountid(); - return ['error', {type => 'accountNotFound'}] + return $Self->_transError(['error', {type => 'accountNotFound'}]) if ($args->{accountId} and $args->{accountId} ne $accountid); - return ['error', {type => 'invalidArguments'}] + my $newState = "$user->{jstateMailbox}"; + + return $Self->_transError(['error', {type => 'invalidArguments'}]) if (exists $args->{position} and exists $args->{anchor}); - return ['error', {type => 'invalidArguments'}] - if (not exists $args->{position} and not exists $args->{anchor}); - return ['error', {type => 'invalidArguments'}] + return $Self->_transError(['error', {type => 'invalidArguments'}]) if (exists $args->{anchor} and not exists $args->{anchorOffset}); - return ['error', {type => 'invalidArguments'}] + return $Self->_transError(['error', {type => 'invalidArguments'}]) if (not exists $args->{anchor} and exists $args->{anchorOffset}); my $start = $args->{position} || 0; - return ['error', {type => 'invalidArguments'}] if $start < 0; + return $Self->_transError(['error', {type => 'invalidArguments'}]) if $start < 0; my $sort = $Self->_build_sort($args->{sort}); - my $data = $dbh->selectall_arrayref("SELECT msgid,thrid FROM jmessages WHERE active = 1 ORDER BY $sort"); + my $data = $dbh->selectall_arrayref("SELECT * FROM jmessages WHERE active = 1 ORDER BY $sort", {Slice => {}}); + + # commit before applying the filter, because it might call out for searches + $Self->commit(); $data = $Self->_filter($data, $args->{filter}, {}) if $args->{filter}; $data = $Self->_collapse($data) if $args->{collapseThreads}; @@ -440,15 +618,16 @@ sub getMessageList { $start = 0 if $start < 0; goto gotit; } - return ['error', {type => 'anchorNotFound'}]; + return $Self->_transError(['error', {type => 'anchorNotFound'}]); } gotit: + my $end = $args->{limit} ? $start + $args->{limit} - 1 : $#$data; $end = $#$data if $end > $#$data; - my @result = map { $data->[$_][0] } $start..$end; - my @thrid = map { $data->[$_][1] } $start..$end; + my @result = map { $data->[$_]{msgid} } $start..$end; + my @thrid = map { $data->[$_]{thrid} } $start..$end; my @res; push @res, ['messageList', { @@ -456,7 +635,7 @@ gotit: filter => $args->{filter}, sort => $args->{sort}, collapseThreads => $args->{collapseThreads}, - state => "$user->{jhighestmodseq}", + state => $newState, canCalculateUpdates => $JSON::true, position => $start, total => scalar(@$data), @@ -485,26 +664,32 @@ sub getMessageListUpdates { my $Self = shift; my $args = shift; + $Self->begin(); my $dbh = $Self->{db}->dbh(); my $user = $Self->{db}->get_user(); my $accountid = $Self->{db}->accountid(); - return ['error', {type => 'accountNotFound'}] + return $Self->_transError(['error', {type => 'accountNotFound'}]) if ($args->{accountId} and $args->{accountId} ne $accountid); - return ['error', {type => 'invalidArguments'}] + my $newState = "$user->{jstateMailbox}"; + + return $Self->_transError(['error', {type => 'invalidArguments'}]) if not $args->{sinceState}; - return ['error', {type => 'cannotCalculateChanges'}] + return $Self->_transError(['error', {type => 'cannotCalculateChanges', newState => $newState}]) if ($user->{jdeletedmodseq} and $args->{sinceState} <= $user->{jdeletedmodseq}); my $start = $args->{position} || 0; - return ['error', {type => 'invalidArguments'}] if $start < 0; + return $Self->_transError(['error', {type => 'invalidArguments'}]) + if $start < 0; my $sort = $Self->_build_sort($args->{sort}); - my $data = $dbh->selectall_arrayref("SELECT msgid,thrid,jmodseq,active FROM jmessages ORDER BY $sort"); + my $data = $dbh->selectall_arrayref("SELECT * FROM jmessages ORDER BY $sort", {Slice => {}}); + + $Self->commit(); # now we have the same sorted data set. What we DON'T have is knowing that a message used to be in the filter, - # but no longer is (aka isUnseen). There's no good way to do this :( So we have to assume that every message + # but no longer is (aka isUnread). There's no good way to do this :( So we have to assume that every message # which is changed and NOT in the dataset used to be... # we also have to assume that it MIGHT have been the exemplar... @@ -524,53 +709,52 @@ sub getMessageListUpdates { # non-deleted, unchanged message) my %finished; foreach my $item (@$data) { - my ($msgid, $thrid, $jmodseq, $active) = @$item; - # we don't have to tell anything about finished threads, not even check them for membership in the search - next if $finished{$thrid}; + next if $finished{$item->{thrid}}; # deleted is the same as not in filter for our purposes - my $isin = $active ? ($args->{filter} ? $Self->_match($item, $args->{filter}, $storage) : 1) : 0; + my $isin = $item->{active} ? ($args->{filter} ? $Self->_match($item, $args->{filter}, $storage) : 1) : 0; # only exemplars count for the total - we need to know total even if not telling any more - if ($isin and not $exemplar{$thrid}) { + if ($isin and not $exemplar{$item->{thrid}}) { $total++; - $exemplar{$thrid} = $msgid; + $exemplar{$item->{thrid}} = $item->{msgid}; } next unless $tell; # jmodseq greater than sinceState is a change - my $changed = ($jmodseq > $args->{sinceState}); + my $changed = ($item->{jmodseq} > $args->{sinceState}); + my $isnew = ($item->{jcreated} > $args->{sinceState}); if ($changed) { # if it's in AND it's the exemplar, it's been added - if ($isin and $exemplar{$thrid} eq $msgid) { - push @added, {messageId => "$msgid", threadId => "$thrid", index => $total-1}; - push @removed, {messageId => "$msgid", threadId => "$thrid"}; + if ($isin and $exemplar{$item->{thrid}} eq $item->{msgid}) { + push @added, {messageId => "$item->{msgid}", threadId => "$item->{thrid}", index => $total-1}; + push @removed, {messageId => "$item->{msgid}", threadId => "$item->{thrid}"}; $changes++; } # otherwise it's removed else { - push @removed, {messageId => "$msgid", threadId => "$thrid"}; + push @removed, {messageId => "$item->{msgid}", threadId => "$item->{thrid}"}; $changes++; } } # unchanged and isin, final candidate for old exemplar! elsif ($isin) { # remove it unless it's also the current exemplar - if ($exemplar{$thrid} ne $msgid) { - push @removed, {messageId => "$msgid", threadId => "$thrid"}; + if ($exemplar{$item->{thrid}} ne $item->{msgid}) { + push @removed, {messageId => "$item->{msgid}", threadId => "$item->{thrid}"}; $changes++; } # and we're done - $finished{$thrid} = 1; + $finished{$item->{thrid}} = 1; } if ($args->{maxChanges} and $changes > $args->{maxChanges}) { - return ['error', {type => 'tooManyChanges'}]; + return $Self->_transError(['error', {type => 'cannotCalculateChanges', newState => $newState}]); } - if ($args->{upToMessageId} and $args->{upToMessageId} eq $msgid) { + if ($args->{upToMessageId} and $args->{upToMessageId} eq $item->{msgid}) { # stop mentioning changes $tell = 0; } @@ -580,34 +764,34 @@ sub getMessageListUpdates { # non-collapsed case else { foreach my $item (@$data) { - my ($msgid, $thrid, $jmodseq, $active) = @$item; # deleted is the same as not in filter for our purposes - my $isin = $active ? ($args->{filter} ? $Self->_match($item, $args->{filter}, $storage) : 1) : 0; + my $isin = $item->{active} ? ($args->{filter} ? $Self->_match($item, $args->{filter}, $storage) : 1) : 0; # all active messages count for the total $total++ if $isin; next unless $tell; # jmodseq greater than sinceState is a change - my $changed = ($jmodseq > $args->{sinceState}); + my $changed = ($item->{jmodseq} > $args->{sinceState}); + my $isnew = ($item->{jcreated} > $args->{sinceState}); if ($changed) { if ($isin) { - push @added, {messageId => "$msgid", threadId => "$thrid", index => $total-1}; - push @removed, {messageId => "$msgid", threadId => "$thrid"}; + push @added, {messageId => "$item->{msgid}", threadId => "$item->{thrid}", index => $total-1}; + push @removed, {messageId => "$item->{msgid}", threadId => "$item->{thrid}"}; $changes++; } else { - push @removed, {messageId => "$msgid", threadId => "$thrid"}; + push @removed, {messageId => "$item->{msgid}", threadId => "$item->{thrid}"}; $changes++; } } if ($args->{maxChanges} and $changes > $args->{maxChanges}) { - return ['error', {type => 'tooManyChanges'}]; + return $Self->_transError(['error', {type => 'cannotCalculateChanges', newState => $newState}]); } - if ($args->{upToMessageId} and $args->{upToMessageId} eq $msgid) { + if ($args->{upToMessageId} and $args->{upToMessageId} eq $item->{msgid}) { # stop mentioning changes $tell = 0; } @@ -621,7 +805,7 @@ sub getMessageListUpdates { sort => $args->{sort}, collapseThreads => $args->{collapseThreads}, oldState => "$args->{sinceState}", - newState => "$user->{jhighestmodseq}", + newState => $newState, removed => \@removed, added => \@added, total => $total, @@ -630,18 +814,74 @@ sub getMessageListUpdates { return @res; } +sub _extract_terms { + my $filter = shift; + return () unless $filter; + my @list; + push @list, _extract_terms($filter->{conditions}); + push @list, $filter->{body} if $filter->{body}; + push @list, $filter->{text} if $filter->{text}; + push @list, $filter->{subject} if $filter->{subject}; + return @list; +} + +sub getSearchSnippets { + my $Self = shift; + my $args = shift; + + my $messages = $Self->getMessages({ + accountId => $args->{accountId}, + ids => $args->{messageIds}, + properties => ['subject', 'textBody', 'preview'], + }); + + return $messages unless $messages->[0] eq 'messages'; + $messages->[0] = 'searchSnippets'; + delete $messages->[1]{state}; + $messages->[1]{filter} = $args->{filter}; + $messages->[1]{collapseThreads} = $args->{collapseThreads}, # work around client bug + + my @terms = _extract_terms($args->{filter}); + my $str = join("|", @terms); + my $tag = 'mark'; + foreach my $item (@{$messages->[1]{list}}) { + $item->{messageId} = delete $item->{id}; + my $text = delete $item->{textBody}; + $item->{subject} = escape_html($item->{subject}); + $item->{preview} = escape_html($item->{preview}); + next unless @terms; + $item->{subject} =~ s{\b($str)\b}{<$tag>$1}gsi; + if ($text =~ m{(.{0,20}\b(?:$str)\b.*)}gsi) { + $item->{preview} = substr($1, 0, 200); + $item->{preview} =~ s{^\s+}{}gs; + $item->{preview} =~ s{\s+$}{}gs; + $item->{preview} =~ s{[\r\n]+}{ -- }gs; + $item->{preview} =~ s{\s+}{ }gs; + $item->{preview} = escape_html($item->{preview}); + $item->{preview} =~ s{\b($str)\b}{<$tag>$1}gsi; + } + $item->{body} = $item->{preview}; # work around client bug + } + + return $messages; +} + sub getMessages { my $Self = shift; my $args = shift; + $Self->begin(); my $dbh = $Self->{db}->dbh(); my $user = $Self->{db}->get_user(); my $accountid = $Self->{db}->accountid(); - return ['error', {type => 'accountNotFound'}] + return $Self->_transError(['error', {type => 'accountNotFound'}]) if ($args->{accountId} and $args->{accountId} ne $accountid); - return ['error', {type => 'invalidArguments'}] unless $args->{ids}; + my $newState = "$user->{jstateMessage}"; + + return $Self->_transError(['error', {type => 'invalidArguments'}]) + unless $args->{ids}; #properties: String[] A list of properties to fetch for each message. # XXX - lots to do about properties here @@ -654,7 +894,7 @@ sub getMessages { } $need_content = 1 if ($args->{properties} and grep { m/^headers\./ } @{$args->{properties}}); my %msgidmap; - foreach my $msgid (@{$args->{ids}}) { + foreach my $msgid (map { $Self->idmap($_) } @{$args->{ids}}) { next if $seenids{$msgid}; $seenids{$msgid} = 1; my $data = $dbh->selectrow_hashref("SELECT * FROM jmessages WHERE msgid = ?", {}, $msgid); @@ -715,13 +955,15 @@ sub getMessages { $item->{size} = $data->{msgsize}; } - if (_prop_wanted($args, 'rawUrl')) { - $item->{rawUrl} = "https://proxy.jmap.io/raw/$accountid/$msgid"; + if (_prop_wanted($args, 'blobId')) { + $item->{blobId} = "m-$msgid"; } push @list, $item; } + $Self->commit(); + # need to load messages from the server if ($need_content) { my $content = $Self->{db}->fill_messages(map { $_->{id} } @list); @@ -753,7 +995,7 @@ sub getMessages { my %wanted; foreach my $prop (@{$args->{properties}}) { next unless $prop =~ m/^headers\.(.*)/; - $item->{headers} ||= {}; # avoid zero matched headers bug + $item->{headers} ||= {}; # avoid zero matched headers bug $wanted{lc $1} = 1; } foreach my $key (keys %{$data->{headers}}) { @@ -773,7 +1015,7 @@ sub getMessages { return ['messages', { list => \@list, accountId => $accountid, - state => "$user->{jhighestmodseq}", + state => $newState, notFound => (%missingids ? [keys %missingids] : undef), }]; } @@ -784,27 +1026,44 @@ sub getRawMessage { my $selector = shift; my $msgid = $selector; + return () unless $msgid =~ s/^([mf])-//; + my $source = $1; my $part; my $filename; - if ($msgid =~ s{/([^/]+)/?(.*)}{}) { - $part = $1; - $filename = $2; + if ($msgid =~ s{/(.*)}{}) { + $filename = $1; + } + if ($msgid =~ s{-(.*)}{}) { + $part = $1; } - my $dbh = $Self->{db}->dbh(); - my ($content) = $dbh->selectrow_array("SELECT rfc822 FROM jrawmessage WHERE msgid = ?", {}, $msgid); - return unless $content; + my ($type, $data); + if ($source eq 'f') { + ($type, $data) = $Self->get_file($msgid); + } + else { + ($type, $data) = $Self->{db}->get_raw_message($msgid, $part); + } - my ($type, $data) = $Self->{db}->get_raw_message($content, $part); return ($type, $data, $filename); } +sub get_file { + my $Self = shift; + my $jfileid = shift; + + my $dbh = $Self->{db}->dbh(); + my ($type, $content) = $dbh->selectrow_array("SELECT type, content FROM jfiles WHERE jfileid = ?", {}, $jfileid); + return unless $content; + return ($type, $content); +} + # or this sub uploadFile { my $Self = shift; my ($type, $content) = @_; # XXX filehandle? - return $Self->upload_file($type, $content); + return $Self->{db}->put_file($type, $content); } sub downloadFile { @@ -820,16 +1079,19 @@ sub getMessageUpdates { my $Self = shift; my $args = shift; + $Self->begin(); my $dbh = $Self->{db}->dbh(); my $user = $Self->{db}->get_user(); my $accountid = $Self->{db}->accountid(); - return ['error', {type => 'accountNotFound'}] + return $Self->_transError(['error', {type => 'accountNotFound'}]) if ($args->{accountId} and $args->{accountId} ne $accountid); - return ['error', {type => 'invalidArguments'}] + my $newState = "$user->{jstateMessage}"; + + return $Self->_transError(['error', {type => 'invalidArguments'}]) if not $args->{sinceState}; - return ['error', {type => 'cannotCalculateChanges'}] + return $Self->_transError(['error', {type => 'cannotCalculateChanges', newState => $newState}]) if ($user->{jdeletedmodseq} and $args->{sinceState} <= $user->{jdeletedmodseq}); my $sql = "SELECT msgid,active FROM jmessages WHERE jmodseq > ?"; @@ -837,7 +1099,7 @@ sub getMessageUpdates { my $data = $dbh->selectall_arrayref($sql, {}, $args->{sinceState}); if ($args->{maxChanges} and @$data > $args->{maxChanges}) { - return ['error', {type => 'tooManyChanges'}]; + return $Self->_transError(['error', {type => 'cannotCalculateChanges', newState => $newState}]); } my @changed; @@ -852,20 +1114,22 @@ sub getMessageUpdates { } } + $Self->commit(); + my @res; push @res, ['messageUpdates', { accountId => $accountid, oldState => "$args->{sinceState}", - newState => "$user->{jhighestmodseq}", + newState => $newState, changed => [map { "$_" } @changed], removed => [map { "$_" } @removed], }]; - if ($args->{fetchMessages}) { + if ($args->{fetchRecords}) { push @res, $Self->getMessages({ accountid => $accountid, ids => \@changed, - properties => $args->{fetchMessageProperties}, + properties => $args->{fetchRecordProperties}, }) if @changed; } @@ -876,40 +1140,46 @@ sub setMessages { my $Self = shift; my $args = shift; + $Self->begin(); + my $user = $Self->{db}->get_user(); my $accountid = $Self->{db}->accountid(); - return ['error', {type => 'accountNotFound'}] + return $Self->_transError(['error', {type => 'accountNotFound'}]) if ($args->{accountId} and $args->{accountId} ne $accountid); + $Self->commit(); + my $create = $args->{create} || {}; my $update = $args->{update} || {}; - my $delete = $args->{delete} || []; + my $destroy = $args->{destroy} || []; + + $Self->{db}->begin_superlock(); - # XXX - idmap support my ($created, $notCreated) = $Self->{db}->create_messages($create); - my ($updated, $notUpdated) = $Self->{db}->update_messages($update); - my ($deleted, $notDeleted) = $Self->{db}->delete_messages($delete); + $Self->setid($_, $created->{$_}{id}) for keys %$created; + my ($updated, $notUpdated) = $Self->{db}->update_messages($update, sub { $Self->idmap(shift) }); + my ($destroyed, $notDestroyed) = $Self->{db}->destroy_messages($destroy); - $Self->{db}->sync(); + $Self->{db}->sync_imap(); + + $Self->{db}->end_superlock(); foreach my $cid (sort keys %$created) { my $msgid = $created->{$cid}{id}; - $created->{$cid}{rawUrl} = "https://proxy.jmap.io/raw/$accountid/$msgid"; + $created->{$cid}{blobId} = "m-$msgid"; } my @res; push @res, ['messagesSet', { accountId => $accountid, oldState => undef, # proxy can't guarantee the old state - # this is actually the state BEFORE the changes, so the client will get a spurious duplicate of the change, but there's - # no nice way to avoid that... - newState => "$user->{jhighestmodseq}", + newState => undef, # or give a new state created => $created, notCreated => $notCreated, updated => $updated, notUpdated => $notUpdated, - deleted => $deleted, - notDeleted => $notDeleted, + destroyed => $destroyed, + notDestroyed => $notDestroyed, }]; return @res; @@ -919,22 +1189,27 @@ sub importMessage { my $Self = shift; my $args = shift; + $Self->begin(); + my $user = $Self->{db}->get_user(); my $accountid = $Self->{db}->accountid(); - return ['error', {type => 'accountNotFound'}] + return $Self->_transError(['error', {type => 'accountNotFound'}]) if ($args->{accountId} and $args->{accountId} ne $accountid); - return ['error', {type => 'invalidArguments'}] + return $Self->_transError(['error', {type => 'invalidArguments'}]) if not $args->{file}; - return ['error', {type => 'invalidArguments'}] + return $Self->_transError(['error', {type => 'invalidArguments'}]) if not $args->{mailboxIds}; my ($type, $message) = $Self->get_file($args->{file}); - return ['error', {type => 'notFound'}] + return $Self->_transError(['error', {type => 'notFound'}]) if (not $type or $type ne 'message/rfc822'); + $Self->commit(); + # import to a normal mailbox (or boxes) - my ($msgid, $thrid) = $Self->import_message($message, $args->{mailboxIds}, + my @ids = map { $Self->idmap($_) } @{$args->{mailboxIds}}; + my ($msgid, $thrid) = $Self->import_message($message, \@ids, isUnread => $args->{isUnread}, isFlagged => $args->{isFlagged}, isAnswered => $args->{isAnswered}, @@ -952,25 +1227,30 @@ sub importMessage { sub copyMessages { my $Self = shift; - return ['error', {type => 'notImplemented'}]; + return $Self->_transError(['error', {type => 'notImplemented'}]); } sub reportMessages { my $Self = shift; my $args = shift; + $Self->begin(); + my $user = $Self->{db}->get_user(); my $accountid = $Self->{db}->accountid(); - return ['error', {type => 'accountNotFound'}] + return $Self->_transError(['error', {type => 'accountNotFound'}]) if ($args->{accountId} and $args->{accountId} ne $accountid); - return ['error', {type => 'invalidArguments'}] + return $Self->_transError(['error', {type => 'invalidArguments'}]) if not $args->{messageIds}; - return ['error', {type => 'invalidArguments'}] + return $Self->_transError(['error', {type => 'invalidArguments'}]) if not exists $args->{asSpam}; - my ($reported, $notfound) = $Self->report_messages($args->{messageIds}, $args->{asSpam}); + $Self->commit(); + + my @ids = map { $Self->idmap($_) } @{$args->{messageIds}}; + my ($reported, $notfound) = $Self->report_messages(\@ids, $args->{asSpam}); my @res; push @res, ['messagesReported', { @@ -987,24 +1267,27 @@ sub getThreads { my $Self = shift; my $args = shift; + $Self->begin(); my $dbh = $Self->{db}->dbh(); my $user = $Self->{db}->get_user(); my $accountid = $Self->{db}->accountid(); - return ['error', {type => 'accountNotFound'}] + return $Self->_transError(['error', {type => 'accountNotFound'}]) if ($args->{accountId} and $args->{accountId} ne $accountid); + my $newState = "$user->{jstateThread}"; + # XXX - error if no IDs my @list; my %seenids; my %missingids; my @allmsgs; - foreach my $thrid (@{$args->{ids}}) { + foreach my $thrid (map { $Self->idmap($_) } @{$args->{ids}}) { next if $seenids{$thrid}; $seenids{$thrid} = 1; - my $data = $dbh->selectall_arrayref("SELECT msgid,isDraft,msgmessageid,msginreplyto FROM jmessages WHERE thrid = ? ORDER BY internaldate", {}, $thrid); - unless ($data) { + my $data = $dbh->selectall_arrayref("SELECT * FROM jmessages WHERE thrid = ? AND active = 1 ORDER BY internaldate", {Slice => {}}, $thrid); + unless (@$data) { $missingids{$thrid} = 1; next; } @@ -1012,23 +1295,25 @@ sub getThreads { my @msgs; my %seenmsgs; foreach my $item (@$data) { - next unless $item->[1]; - push @{$drafts{$item->[3]}}, $item->[0]; + next unless $item->{isDraft}; + next unless $item->{msginreplyto}; # push the rest of the drafts to the end + push @{$drafts{$item->{msginreplyto}}}, $item->{msgid}; } foreach my $item (@$data) { - next if $item->[1]; - push @msgs, $item->[0]; - $seenmsgs{$item->[0]} = 1; - if (my $draftmsgs = $drafts{$item->[2]}) { + next if $item->{isDraft}; + push @msgs, $item->{msgid}; + $seenmsgs{$item->{msgid}} = 1; + next unless $item->{msgmessageid}; + if (my $draftmsgs = $drafts{$item->{msgmessageid}}) { push @msgs, @$draftmsgs; $seenmsgs{$_} = 1 for @$draftmsgs; } } # make sure unlinked drafts aren't forgotten! foreach my $item (@$data) { - next if $seenmsgs{$item->[0]}; - push @msgs, $item->[0]; - $seenmsgs{$item->[0]} = 1; + next if $seenmsgs{$item->{msgid}}; + push @msgs, $item->{msgid}; + $seenmsgs{$item->{msgid}} = 1; } push @list, { id => "$thrid", @@ -1037,11 +1322,13 @@ sub getThreads { push @allmsgs, @msgs; } + $Self->commit(); + my @res; push @res, ['threads', { list => \@list, accountId => $accountid, - state => "$user->{jhighestmodseq}", + state => $newState, notFound => (%missingids ? [keys %missingids] : undef), }]; @@ -1060,40 +1347,43 @@ sub getThreadUpdates { my $Self = shift; my $args = shift; + $Self->begin(); my $dbh = $Self->{db}->dbh(); my $user = $Self->{db}->get_user(); my $accountid = $Self->{db}->accountid(); - return ['error', {type => 'accountNotFound'}] + return $Self->_transError(['error', {type => 'accountNotFound'}]) if ($args->{accountId} and $args->{accountId} ne $accountid); - return ['error', {type => 'invalidArguments'}] + my $newState = "$user->{jstateThread}"; + + return $Self->_transError(['error', {type => 'invalidArguments'}]) if not $args->{sinceState}; - return ['error', {type => 'cannotCalculateChanges'}] + return $Self->_transError(['error', {type => 'cannotCalculateChanges', newState => $newState}]) if ($user->{jdeletedmodseq} and $args->{sinceState} <= $user->{jdeletedmodseq}); - my $sql = "SELECT thrid,active FROM jmessages WHERE jmodseq > ?"; + my $sql = "SELECT * FROM jmessages WHERE jmodseq > ?"; if ($args->{maxChanges}) { $sql .= " LIMIT " . (int($args->{maxChanges}) + 1); } - my $data = $dbh->selectall_arrayref($sql, {}, $args->{sinceState}); + my $data = $dbh->selectall_arrayref($sql, {Slice => {}}, $args->{sinceState}); if ($args->{maxChanges} and @$data > $args->{maxChanges}) { - return ['error', {type => 'tooManyChanges'}]; + return $Self->_transError(['error', {type => 'cannotCalculateChanges', newState => $newState}]); } my %threads; my %delcheck; foreach my $row (@$data) { - $threads{$row->[0]} = 1; - $delcheck{$row->[0]} = 1 unless $row->[1]; + $threads{$row->{msgid}} = 1; + $delcheck{$row->{msgid}} = 1 unless $row->{active}; } my @removed; foreach my $key (keys %delcheck) { - my ($exists) = $dbh->selectrow_array("SELECT COUNT(*) FROM jmessages WHERE thrid = ? AND active = 1", {}, $key); + my ($exists) = $dbh->selectrow_array("SELECT COUNT(DISTINCT msgid) FROM jmessages JOIN jmessagemap WHERE thrid = ? AND jmessages.active = 1 AND jmessagemap.active = 1", {}, $key); unless ($exists) { delete $threads{$key}; push @removed, $key; @@ -1102,16 +1392,18 @@ sub getThreadUpdates { my @changed = keys %threads; + $Self->commit(); + my @res; push @res, ['threadUpdates', { accountId => $accountid, oldState => $args->{sinceState}, - newState => "$user->{jhighestmodseq}", + newState => $newState, changed => \@changed, removed => \@removed, }]; - if ($args->{fetchThreads}) { + if ($args->{fetchRecords}) { push @res, $Self->getThreads({ accountid => $accountid, ids => \@changed, @@ -1130,4 +1422,950 @@ sub _prop_wanted { return 0; } +sub getCalendarPreferences { + return ['calendarPreferences', { + autoAddCalendarId => '', + autoAddInvitations => JSON::false, + autoAddGroupId => JSON::null, + autoRSVPGroupId => JSON::null, + autoRSVP => JSON::false, + autoUpdate => JSON::false, + birthdaysAreVisible => JSON::false, + defaultAlerts => [], + defaultAllDayAlerts => [], + defaultCalendarId => '', + firstDayOfWeek => 1, + markReadAndFileAutoAdd => JSON::false, + markReadAndFileAutoUpdate => JSON::false, + onlyAutoAddIfInGroup => JSON::false, + onlyAutoRSVPIfInGroup => JSON::false, + showWeekNumbers => JSON::false, + timeZone => JSON::null, + useTimeZones => JSON::false, + }]; +} + +sub getCalendars { + my $Self = shift; + my $args = shift; + + $Self->begin(); + my $dbh = $Self->{db}->dbh(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + my $newState = "$user->{jstateCalendar}"; + + my $data = $dbh->selectall_arrayref("SELECT jcalendarid, name, color, isVisible, mayReadFreeBusy, mayReadItems, mayAddItems, mayModifyItems, mayRemoveItems, mayDelete, mayRename FROM jcalendars WHERE active = 1"); + + my %ids; + if ($args->{ids}) { + %ids = map { $Self->idmap($_) => 1 } @{$args->{ids}}; + } + else { + %ids = map { $_->[0] => 1 } @$data; + } + + my @list; + + foreach my $item (@$data) { + next unless delete $ids{$item->[0]}; + + my %rec = ( + id => "$item->[0]", + name => $item->[1], + color => $item->[2], + isVisible => $item->[3] ? $JSON::true : $JSON::false, + mayReadFreeBusy => $item->[4] ? $JSON::true : $JSON::false, + mayReadItems => $item->[5] ? $JSON::true : $JSON::false, + mayAddItems => $item->[6] ? $JSON::true : $JSON::false, + mayModifyItems => $item->[7] ? $JSON::true : $JSON::false, + mayRemoveItems => $item->[8] ? $JSON::true : $JSON::false, + mayDelete => $item->[9] ? $JSON::true : $JSON::false, + mayRename => $item->[10] ? $JSON::true : $JSON::false, + ); + + foreach my $key (keys %rec) { + delete $rec{$key} unless _prop_wanted($args, $key); + } + + push @list, \%rec; + } + my %missingids = %ids; + + $Self->commit(); + + return ['calendars', { + list => \@list, + accountId => $accountid, + state => $newState, + notFound => (%missingids ? [map { "$_" } keys %missingids] : undef), + }]; +} + +sub getCalendarUpdates { + my $Self = shift; + my $args = shift; + + $Self->begin(); + my $dbh = $Self->{db}->dbh(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + my $newState = "$user->{jstateCalendar}"; + + my $sinceState = $args->{sinceState}; + return $Self->_transError(['error', {type => 'invalidArguments'}]) + if not $args->{sinceState}; + return $Self->_transError(['error', {type => 'cannotCalculateChanges', newState => $newState}]) + if ($user->{jdeletedmodseq} and $sinceState <= $user->{jdeletedmodseq}); + + my $data = $dbh->selectall_arrayref("SELECT jcalendarid, jmodseq, active FROM jcalendars ORDER BY jcalendarid"); + + my @changed; + my @removed; + my $onlyCounts = 1; + foreach my $item (@$data) { + if ($item->[1] > $sinceState) { + if ($item->[3]) { + push @changed, $item->[0]; + $onlyCounts = 0; + } + else { + push @removed, $item->[0]; + } + } + elsif (($item->[2] || 0) > $sinceState) { + if ($item->[3]) { + push @changed, $item->[0]; + } + else { + push @removed, $item->[0]; + } + } + } + + $Self->commit(); + + my @res = (['calendarUpdates', { + accountId => $accountid, + oldState => "$sinceState", + newState => $newState, + changed => [map { "$_" } @changed], + removed => [map { "$_" } @removed], + }]); + + if (@changed and $args->{fetchRecords}) { + my %items = ( + accountid => $accountid, + ids => \@changed, + ); + push @res, $Self->getCalendars(\%items); + } + + return @res; +} + +sub _event_match { + my $Self = shift; + my ($item, $condition, $storage) = @_; + + # XXX - condition handling code + if ($condition->{inCalendars}) { + my $match = 0; + foreach my $id (@{$condition->{inCalendars}}) { + next unless $item->[1] eq $id; + $match = 1; + } + return 0 unless $match; + } + + return 1; +} + +sub _event_filter { + my $Self = shift; + my ($data, $filter, $storage) = @_; + my @res; + foreach my $item (@$data) { + next unless $Self->_event_match($item, $filter, $storage); + push @res, $item; + } + return \@res; +} + +sub getCalendarEventList { + my $Self = shift; + my $args = shift; + + $Self->begin(); + my $dbh = $Self->{db}->dbh(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + my $newState = "$user->{jstateCalendarEvent}"; + + my $start = $args->{position} || 0; + return $Self->_transError(['error', {type => 'invalidArguments'}]) + if $start < 0; + + my $data = $dbh->selectall_arrayref("SELECT eventuid,jcalendarid FROM jevents WHERE active = 1 ORDER BY eventuid"); + + $data = $Self->_event_filter($data, $args->{filter}, {}) if $args->{filter}; + + my $end = $args->{limit} ? $start + $args->{limit} - 1 : $#$data; + $end = $#$data if $end > $#$data; + + my @result = map { $data->[$_][0] } $start..$end; + + $Self->commit(); + + my @res; + push @res, ['calendarEventList', { + accountId => $accountid, + filter => $args->{filter}, + state => $newState, + position => $start, + total => scalar(@$data), + calendarEventIds => [map { "$_" } @result], + }]; + + if ($args->{fetchCalendarEvents}) { + push @res, $Self->getCalendarEvents({ + ids => \@result, + properties => $args->{fetchCalendarEventProperties}, + }) if @result; + } + + return @res; +} + +sub getCalendarEvents { + my $Self = shift; + my $args = shift; + + $Self->begin(); + my $dbh = $Self->{db}->dbh(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + my $newState = "$user->{jstateCalendarEvent}"; + + return $Self->_transError(['error', {type => 'invalidArguments'}]) + unless $args->{ids}; + #properties: String[] A list of properties to fetch for each message. + + my %seenids; + my %missingids; + my @list; + foreach my $eventid (map { $Self->idmap($_) } @{$args->{ids}}) { + next if $seenids{$eventid}; + $seenids{$eventid} = 1; + my $data = $dbh->selectrow_hashref("SELECT * FROM jevents WHERE eventuid = ?", {}, $eventid); + unless ($data) { + $missingids{$eventid} = 1; + next; + } + + my $item = decode_json($data->{payload}); + + foreach my $key (keys %$item) { + delete $item->{$key} unless _prop_wanted($args, $key); + } + + $item->{id} = $eventid; + $item->{calendarId} = "$data->{jcalendarid}" if _prop_wanted($args, "calendarId"); + + push @list, $item; + } + + $Self->commit(); + + return ['calendarEvents', { + list => \@list, + accountId => $accountid, + state => $newState, + notFound => (%missingids ? [keys %missingids] : undef), + }]; +} + +sub getCalendarEventUpdates { + my $Self = shift; + my $args = shift; + + $Self->begin(); + my $dbh = $Self->{db}->dbh(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + my $newState = "$user->{jstateCalendarEvent}"; + + return $Self->_transError(['error', {type => 'invalidArguments'}]) + if not $args->{sinceState}; + return $Self->_transError(['error', {type => 'cannotCalculateChanges', newState => $newState}]) + if ($user->{jdeletedmodseq} and $args->{sinceState} <= $user->{jdeletedmodseq}); + + my $sql = "SELECT eventuid,active FROM jevents WHERE jmodseq > ?"; + + my $data = $dbh->selectall_arrayref($sql, {}, $args->{sinceState}); + + if ($args->{maxChanges} and @$data > $args->{maxChanges}) { + return $Self->_transError(['error', {type => 'cannotCalculateChanges', newState => $newState}]); + } + + $Self->commit(); + + my @changed; + my @removed; + + foreach my $row (@$data) { + if ($row->[1]) { + push @changed, $row->[0]; + } + else { + push @removed, $row->[0]; + } + } + + my @res; + push @res, ['calendarEventUpdates', { + accountId => $accountid, + oldState => "$args->{sinceState}", + newState => $newState, + changed => [map { "$_" } @changed], + removed => [map { "$_" } @removed], + }]; + + if ($args->{fetchCalendarEvents}) { + push @res, $Self->getCalendarEvents({ + accountid => $accountid, + ids => \@changed, + properties => $args->{fetchCalendarEventProperties}, + }) if @changed; + } + + return @res; +} + +sub getAddressbooks { + my $Self = shift; + my $args = shift; + + $Self->begin(); + my $dbh = $Self->{db}->dbh(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + # we have no datatype for this yet + my $newState = "$user->{jhighestmodseq}"; + + my $data = $dbh->selectall_arrayref("SELECT jaddressbookid, name, isVisible, mayReadItems, mayAddItems, mayModifyItems, mayRemoveItems, mayDelete, mayRename FROM jaddressbooks WHERE active = 1"); + + my %ids; + if ($args->{ids}) { + %ids = map { $Self->($_) => 1 } @{$args->{ids}}; + } + else { + %ids = map { $_->[0] => 1 } @$data; + } + + my @list; + + foreach my $item (@$data) { + next unless delete $ids{$item->[0]}; + + my %rec = ( + id => "$item->[0]", + name => $item->[1], + isVisible => $item->[2] ? $JSON::true : $JSON::false, + mayReadItems => $item->[3] ? $JSON::true : $JSON::false, + mayAddItems => $item->[4] ? $JSON::true : $JSON::false, + mayModifyItems => $item->[5] ? $JSON::true : $JSON::false, + mayRemoveItems => $item->[6] ? $JSON::true : $JSON::false, + mayDelete => $item->[7] ? $JSON::true : $JSON::false, + mayRename => $item->[8] ? $JSON::true : $JSON::false, + ); + + foreach my $key (keys %rec) { + delete $rec{$key} unless _prop_wanted($args, $key); + } + + push @list, \%rec; + } + my %missingids = %ids; + + $Self->commit(); + + return ['addressbooks', { + list => \@list, + accountId => $accountid, + state => $newState, + notFound => (%missingids ? [map { "$_" } keys %missingids] : undef), + }]; +} + +sub getAddressbookUpdates { + my $Self = shift; + my $args = shift; + + $Self->begin(); + my $dbh = $Self->{db}->dbh(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + # we have no datatype for you yet + my $newState = "$user->{jhighestmodseq}"; + + my $sinceState = $args->{sinceState}; + return $Self->_transError(['error', {type => 'invalidArguments'}]) + if not $args->{sinceState}; + return $Self->_transError(['error', {type => 'cannotCalculateChanges', newState => $newState}]) + if ($user->{jdeletedmodseq} and $sinceState <= $user->{jdeletedmodseq}); + + my $data = $dbh->selectall_arrayref("SELECT jaddressbookid, jmodseq, active FROM jaddressbooks ORDER BY jaddressbookid"); + + my @changed; + my @removed; + my $onlyCounts = 1; + foreach my $item (@$data) { + if ($item->[1] > $sinceState) { + if ($item->[3]) { + push @changed, $item->[0]; + $onlyCounts = 0; + } + else { + push @removed, $item->[0]; + } + } + elsif (($item->[2] || 0) > $sinceState) { + if ($item->[3]) { + push @changed, $item->[0]; + } + else { + push @removed, $item->[0]; + } + } + } + + $Self->commit(); + + my @res = (['addressbookUpdates', { + accountId => $accountid, + oldState => "$sinceState", + newState => $newState, + changed => [map { "$_" } @changed], + removed => [map { "$_" } @removed], + }]); + + if (@changed and $args->{fetchRecords}) { + my %items = ( + accountid => $accountid, + ids => \@changed, + ); + push @res, $Self->getAddressbooks(\%items); + } + + return @res; +} + +sub _contact_match { + my $Self = shift; + my ($item, $condition, $storage) = @_; + + # XXX - condition handling code + if ($condition->{inAddressbooks}) { + my $match = 0; + foreach my $id (@{$condition->{inAddressbooks}}) { + next unless $item->[1] eq $id; + $match = 1; + } + return 0 unless $match; + } + + return 1; +} + +sub _contact_filter { + my $Self = shift; + my ($data, $filter, $storage) = @_; + my @res; + foreach my $item (@$data) { + next unless $Self->_contact_match($item, $filter, $storage); + push @res, $item; + } + return \@res; +} + +sub getContactList { + my $Self = shift; + my $args = shift; + + $Self->begin(); + my $dbh = $Self->{db}->dbh(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + my $newState = "$user->{jstateContact}"; + + my $start = $args->{position} || 0; + return $Self->_transError(['error', {type => 'invalidArguments'}]) + if $start < 0; + + my $data = $dbh->selectall_arrayref("SELECT contactuid,jaddressbookid FROM jcontacts WHERE active = 1 ORDER BY contactuid"); + + $data = $Self->_event_filter($data, $args->{filter}, {}) if $args->{filter}; + + my $end = $args->{limit} ? $start + $args->{limit} - 1 : $#$data; + $end = $#$data if $end > $#$data; + + my @result = map { $data->[$_][0] } $start..$end; + + $Self->commit(); + + my @res; + push @res, ['contactList', { + accountId => $accountid, + filter => $args->{filter}, + state => $newState, + position => $start, + total => scalar(@$data), + contactIds => [map { "$_" } @result], + }]; + + if ($args->{fetchContacts}) { + push @res, $Self->getContacts({ + ids => \@result, + properties => $args->{fetchContactProperties}, + }) if @result; + } + + return @res; +} + +sub getContacts { + my $Self = shift; + my $args = shift; + + $Self->begin(); + my $dbh = $Self->{db}->dbh(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + my $newState = "$user->{jstateContact}"; + + #properties: String[] A list of properties to fetch for each message. + + my $data = $dbh->selectall_hashref("SELECT * FROM jcontacts WHERE active = 1", 'contactuid', {Slice => {}}); + + my %want; + if ($args->{ids}) { + %want = map { $Self->idmap($_) => 1 } @{$args->{ids}}; + } + else { + %want = %$data; + } + + my @list; + foreach my $id (keys %want) { + next unless $data->{$id}; + delete $want{$id}; + + my $item = decode_json($data->{$id}{payload}); + + foreach my $key (keys %$item) { + delete $item->{$key} unless _prop_wanted($args, $key); + } + + $item->{id} = $id; + + push @list, $item; + } + $Self->commit(); + + return ['contacts', { + list => \@list, + accountId => $accountid, + state => $newState, + notFound => (%want ? [keys %want] : undef), + }]; +} + +sub getContactUpdates { + my $Self = shift; + my $args = shift; + + $Self->begin(); + my $dbh = $Self->{db}->dbh(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + my $newState = "$user->{jstateContact}"; + + return $Self->_transError(['error', {type => 'invalidArguments'}]) + if not $args->{sinceState}; + return $Self->_transError(['error', {type => 'cannotCalculateChanges', newState => $newState}]) + if ($user->{jdeletedmodseq} and $args->{sinceState} <= $user->{jdeletedmodseq}); + + my $sql = "SELECT contactuid,active FROM jcontacts WHERE jmodseq > ?"; + + my $data = $dbh->selectall_arrayref($sql, {}, $args->{sinceState}); + + if ($args->{maxChanges} and @$data > $args->{maxChanges}) { + return $Self->_transError(['error', {type => 'cannotCalculateChanges', newState => $newState}]); + } + $Self->commit(); + + my @changed; + my @removed; + + foreach my $row (@$data) { + if ($row->[1]) { + push @changed, $row->[0]; + } + else { + push @removed, $row->[0]; + } + } + + my @res; + push @res, ['contactUpdates', { + accountId => $accountid, + oldState => "$args->{sinceState}", + newState => $newState, + changed => [map { "$_" } @changed], + removed => [map { "$_" } @removed], + }]; + + if ($args->{fetchRecords}) { + push @res, $Self->getContacts({ + accountid => $accountid, + ids => \@changed, + properties => $args->{fetchRecordProperties}, + }) if @changed; + } + + return @res; +} + +sub getContactGroups { + my $Self = shift; + my $args = shift; + + $Self->begin(); + my $dbh = $Self->{db}->dbh(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + my $newState = "$user->{jstateContactGroup}"; + + #properties: String[] A list of properties to fetch for each message. + + my $data = $dbh->selectall_hashref("SELECT * FROM jcontactgroups WHERE active = 1", 'groupuid', {Slice => {}}); + + my %want; + if ($args->{ids}) { + %want = map { $Self->idmap($_) => 1 } @{$args->{ids}}; + } + else { + %want = %$data; + } + + my @list; + foreach my $id (keys %want) { + next unless $data->{$id}; + delete $want{$id}; + + my $item = {}; + $item->{id} = $id; + + if (_prop_wanted($args, 'name')) { + $item->{name} = $data->{$id}{name}; + } + + if (_prop_wanted($args, 'contactIds')) { + my $ids = $dbh->selectcol_arrayref("SELECT contactuid FROM jcontactgroupmap WHERE groupuid = ?", {}, $id); + $item->{contactIds} = $ids; + } + + push @list, $item; + } + $Self->commit(); + + return ['contactGroups', { + list => \@list, + accountId => $accountid, + state => $newState, + notFound => (%want ? [keys %want] : undef), + }]; +} + +sub getContactGroupUpdates { + my $Self = shift; + my $args = shift; + + $Self->begin(); + my $dbh = $Self->{db}->dbh(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + my $newState = "$user->{jstateContactGroup}"; + + return $Self->_transError(['error', {type => 'invalidArguments'}]) + if not $args->{sinceState}; + return $Self->_transError(['error', {type => 'cannotCalculateChanges', newState => $newState}]) + if ($user->{jdeletedmodseq} and $args->{sinceState} <= $user->{jdeletedmodseq}); + + my $sql = "SELECT groupuid,active FROM jcontactgroups WHERE jmodseq > ?"; + + my $data = $dbh->selectall_arrayref($sql, {}, $args->{sinceState}); + + if ($args->{maxChanges} and @$data > $args->{maxChanges}) { + return $Self->_transError(['error', {type => 'cannotCalculateChanges', newState => $newState}]); + } + + my @changed; + my @removed; + + foreach my $row (@$data) { + if ($row->[1]) { + push @changed, $row->[0]; + } + else { + push @removed, $row->[0]; + } + } + $Self->commit(); + + my @res; + push @res, ['contactGroupUpdates', { + accountId => $accountid, + oldState => "$args->{sinceState}", + newState => $newState, + changed => [map { "$_" } @changed], + removed => [map { "$_" } @removed], + }]; + + if ($args->{fetchRecords}) { + push @res, $Self->getContactGroups({ + accountid => $accountid, + ids => \@changed, + properties => $args->{fetchRecordProperties}, + }) if @changed; + } + + return @res; +} + +sub setContactGroups { + my $Self = shift; + my $args = shift; + + $Self->begin(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + $Self->commit(); + + my $create = $args->{create} || {}; + my $update = $args->{update} || {}; + my $destroy = $args->{destroy} || []; + + $Self->{db}->begin_superlock(); + + my ($created, $notCreated) = $Self->{db}->create_contact_groups($create); + $Self->setid($_, $created->{$_}{id}) for keys %$created; + my ($updated, $notUpdated) = $Self->{db}->update_contact_groups($update, sub { $Self->idmap(shift) }); + my ($destroyed, $notDestroyed) = $Self->{db}->destroy_contact_groups($destroy); + + $Self->{db}->sync_addressbooks(); + + $Self->{db}->end_superlock(); + + my @res; + push @res, ['contactGroupsSet', { + accountId => $accountid, + oldState => undef, # proxy can't guarantee the old state + newState => undef, # or give a new state + created => $created, + notCreated => $notCreated, + updated => $updated, + notUpdated => $notUpdated, + destroyed => $destroyed, + notDestroyed => $notDestroyed, + }]; + + return @res; +} + +sub setContacts { + my $Self = shift; + my $args = shift; + + $Self->begin(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + $Self->commit(); + + my $create = $args->{create} || {}; + my $update = $args->{update} || {}; + my $destroy = $args->{destroy} || []; + + $Self->{db}->begin_superlock(); + + my ($created, $notCreated) = $Self->{db}->create_contacts($create); + $Self->setid($_, $created->{$_}{id}) for keys %$created; + my ($updated, $notUpdated) = $Self->{db}->update_contacts($update, sub { $Self->idmap(shift) }); + my ($destroyed, $notDestroyed) = $Self->{db}->destroy_contacts($destroy); + + $Self->{db}->sync_addressbooks(); + + $Self->{db}->end_superlock(); + + my @res; + push @res, ['contactsSet', { + accountId => $accountid, + oldState => undef, # proxy can't guarantee the old state + newState => undef, # or give a new state + created => $created, + notCreated => $notCreated, + updated => $updated, + notUpdated => $notUpdated, + destroyed => $destroyed, + notDestroyed => $notDestroyed, + }]; + + return @res; +} + +sub setCalendarEvents { + my $Self = shift; + my $args = shift; + + $Self->begin(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + $Self->commit(); + + my $create = $args->{create} || {}; + my $update = $args->{update} || {}; + my $destroy = $args->{destroy} || []; + + $Self->{db}->begin_superlock(); + + my ($created, $notCreated) = $Self->{db}->create_calendar_events($create); + $Self->setid($_, $created->{$_}{id}) for keys %$created; + my ($updated, $notUpdated) = $Self->{db}->update_calendar_events($update, sub { $Self->idmap(shift) }); + my ($destroyed, $notDestroyed) = $Self->{db}->destroy_calendar_events($destroy); + + $Self->{db}->sync_calendars(); + + $Self->{db}->end_superlock(); + + my @res; + push @res, ['calendarEventsSet', { + accountId => $accountid, + oldState => undef, # proxy can't guarantee the old state + newState => undef, # or give a new state + created => $created, + notCreated => $notCreated, + updated => $updated, + notUpdated => $notUpdated, + destroyed => $destroyed, + notDestroyed => $notDestroyed, + }]; + + return @res; +} + +sub setCalendars { + my $Self = shift; + my $args = shift; + + $Self->begin(); + + my $user = $Self->{db}->get_user(); + my $accountid = $Self->{db}->accountid(); + return $Self->_transError(['error', {type => 'accountNotFound'}]) + if ($args->{accountId} and $args->{accountId} ne $accountid); + + $Self->commit(); + + my $create = $args->{create} || {}; + my $update = $args->{update} || {}; + my $destroy = $args->{destroy} || []; + + $Self->{db}->begin_superlock(); + + my ($created, $notCreated) = $Self->{db}->create_calendars($create); + $Self->setid($_, $created->{$_}{id}) for keys %$created; + my ($updated, $notUpdated) = $Self->{db}->update_calendars($update, sub { $Self->idmap(shift) }); + my ($destroyed, $notDestroyed) = $Self->{db}->destroy_calendars($destroy); + + $Self->{db}->sync_calendars(); + + $Self->{db}->end_superlock(); + + my @res; + push @res, ['calendarsSet', { + accountId => $accountid, + oldState => undef, # proxy can't guarantee the old state + newState => undef, # or give a new state + created => $created, + notCreated => $notCreated, + updated => $updated, + notUpdated => $notUpdated, + destroyed => $destroyed, + notDestroyed => $notDestroyed, + }]; + + return @res; +} + 1; diff --git a/JMAP/DB.pm b/JMAP/DB.pm index 36891d3..b03fb06 100644 --- a/JMAP/DB.pm +++ b/JMAP/DB.pm @@ -9,7 +9,9 @@ use Data::Dumper; use DBI; use Carp qw(confess); -use JSON::XS qw(encode_json decode_json); +use Data::UUID::LibUUID; +use IO::LockedFile; +use JSON::XS qw(decode_json); use Email::MIME; # seriously, it's parsable, get over it $Email::MIME::ContentType::STRICT_PARAMS = 0; @@ -20,12 +22,31 @@ use Encode; use Encode::MIME::Header; use DateTime; use Date::Parse; +use Net::CalDAVTalk; +use Net::CardDAVTalk::VCard; +use MIME::Base64 qw(encode_base64 decode_base64); + +my $json = JSON::XS->new->utf8->canonical(); + +my %TABLE2GROUPS = ( + jmessages => ['Message', 'Thread'], + jmailboxes => ['Mailbox'], + jmessagemap => ['Mailbox'], + jrawmessage => [], + jfiles => [], # for now + jcalendars => ['Calendar'], + jevents => ['CalendarEvent'], + jaddressbooks => [], # not directly + jcontactgroups => ['ContactGroup'], + jcontactgroupmap => ['ContactGroup'], + jcontacts => ['Contact'], +); sub new { my $class = shift; my $accountid = shift || die; + my $Self = bless { accountid => $accountid, start => time() }, ref($class) || $class; my $dbh = DBI->connect("dbi:SQLite:dbname=/home/jmap/data/$accountid.sqlite3"); - my $Self = bless { accountid => $accountid, dbh => $dbh, start => time() }, ref($class) || $class; $Self->_initdb($dbh); return $Self; } @@ -57,32 +78,65 @@ sub log { sub dbh { my $Self = shift; - return $Self->{dbh}; + confess("NOT IN TRANSACTION") unless $Self->{t}; + return $Self->{t}{dbh}; +} + +sub in_transaction { + my $Self = shift; + return $Self->{t} ? 1 : 0; +} + +sub begin_superlock { + my $Self = shift; + my $accountid = $Self->accountid(); + $Self->{superlock} = IO::LockedFile->new(">/home/jmap/data/$accountid.lock"); +} + +sub end_superlock { + my $Self = shift; + delete $Self->{superlock}; } sub begin { my $Self = shift; confess("ALREADY IN TRANSACTION") if $Self->{t}; - $Self->dbh->begin_work(); - $Self->{t} = {}; + my $accountid = $Self->accountid(); + # we need this because sqlite locking isn't as robust as you might hope + $Self->{t} = {lock => $Self->{superlock} || IO::LockedFile->new(">/home/jmap/data/$accountid.lock")}; + $Self->{t}{dbh} = DBI->connect("dbi:SQLite:dbname=/home/jmap/data/$accountid.sqlite3"); + $Self->{t}{dbh}->begin_work(); } sub commit { my $Self = shift; confess("NOT IN TRANSACTION") unless $Self->{t}; - $Self->dbh->commit(); - my $t = delete $Self->{t}; # push an update if anything to tell.. + my $t = $Self->{t}; if ($t->{modseq} and $Self->{change_cb}) { - $Self->{change_cb}->($Self, "$t->{modseq}"); # aka stateString + my %map; + my %dbdata = (jhighestmodseq => $t->{modseq}); + my $state = "$t->{modseq}"; + foreach my $table (keys %{$t->{tables}}) { + foreach my $group (@{$TABLE2GROUPS{$table}}) { + $map{$group} = $state; + $dbdata{"jstate$group"} = $state; + } + } + + $Self->dupdate('account', \%dbdata); + $Self->{change_cb}->($Self, \%map) unless $Self->{t}->{backfilling}; } + + $Self->{t}{dbh}->commit(); + delete $Self->{t}; } sub rollback { my $Self = shift; confess("NOT IN TRANSACTION") unless $Self->{t}; - $Self->dbh->rollback(); + $Self->{t}{dbh}->rollback(); delete $Self->{t}; } @@ -90,28 +144,27 @@ sub rollback { sub reset { my $Self = shift; return unless $Self->{t}; - $Self->dbh->rollback(); + $Self->{t}{dbh}->rollback(); delete $Self->{t}; } sub dirty { my $Self = shift; - confess("NOT IN TRANSACTION") unless $Self->{t}; + my $table = shift || die 'need to have a table to dirty'; unless ($Self->{t}{modseq}) { my $user = $Self->get_user(); $user->{jhighestmodseq}++; - $Self->dbh->do("UPDATE account SET jhighestmodseq = ?", {}, $user->{jhighestmodseq}); $Self->{t}{modseq} = $user->{jhighestmodseq}; $Self->log('debug', "dirty at $user->{jhighestmodseq}"); } + $Self->{t}{tables}{$table} = $Self->{t}{modseq}; return $Self->{t}{modseq}; } sub get_user { my $Self = shift; - confess("NOT IN TRANSACTION") unless $Self->{t}; unless ($Self->{t}{user}) { - $Self->{t}{user} = $Self->dbh->selectrow_hashref("SELECT email,displayname,picture,jhighestmodseq,jdeletedmodseq FROM account"); + $Self->{t}{user} = $Self->dbh->selectrow_hashref("SELECT * FROM account"); } # bootstrap unless ($Self->{t}{user}) { @@ -124,80 +177,13 @@ sub get_user { return $Self->{t}{user}; } -sub get_mailboxes { - my $Self = shift; - confess("NOT IN TRANSACTION") unless $Self->{t}; - unless ($Self->{t}{mailboxes}) { - $Self->{t}{mailboxes} = $Self->dbh->selectall_hashref("SELECT jmailboxid, jmodseq, label, name, parentid, nummessages, numumessages, numthreads, numuthreads, active FROM jmailboxes", 'jmailboxid', {Slice => {}}); - } - return $Self->{t}{mailboxes}; -} - -sub get_mailbox { - my $Self = shift; - my $jmailboxid = shift; - return $Self->get_mailboxes->{$jmailboxid}; -} - -sub add_mailbox { - my $Self = shift; - my ($name, $label, $parentid) = @_; - - my $mailboxes = $Self->get_mailboxes(); - - confess("ALREADY EXISTS $name in $parentid") if grep { $_->{name} eq $name and $_->{parentid} == $parentid } values %$mailboxes; - - my $data = { - name => $name, - label => $label, - parentid => $parentid, - nummessages => 0, - numthreads => 0, - numumessages => 0, - numuthreads => 0, - active => 1, - }; - - my $id = $data->{jmailboxid} = $Self->dinsert('jmailboxes', $data); - $Self->{t}{mailboxes}{$id} = $data; - - return $id; -} - -sub update_mailbox { - my $Self = shift; - my $jmailboxid = shift; - my $fields = shift; - - my $mailbox = $Self->get_mailbox($jmailboxid); - confess("INVALID ID $jmailboxid") unless $mailbox; - confess("NOT ACTIVE $jmailboxid") unless $mailbox->{active}; - - foreach my $key (keys %$fields) { - $mailbox->{$key} = $fields->{$key}; - } - - unless ($mailbox->{active}) { - # XXX - sanity check all? - confess("Still messages") if $mailbox->{nummessages}; - } - - $Self->dmaybedirty('jmailboxes', $mailbox, {jmailboxid => $jmailboxid}); -} - -sub delete_mailbox { - my $Self = shift; - my $jmailboxid = shift; - return $Self->update_mailbox($jmailboxid, {active => 0}); -} - sub add_message { my $Self = shift; my ($data, $mailboxes) = @_; return unless @$mailboxes; # no mailboxes, no message - $Self->dmake('jmessages', $data, $Self->{backfilling}); + $Self->dmake('jmessages', $data); foreach my $mailbox (@$mailboxes) { $Self->add_message_to_mailbox($data->{msgid}, $mailbox); } @@ -212,37 +198,6 @@ sub add_message_to_mailbox { $Self->dmaybeupdate('jmailboxes', {jcountsmodseq => $data->{jmodseq}}, {jmailboxid => $jmailboxid}); } -sub get_raw_message { - my $Self = shift; - my $rfc822 = shift; - my $part = shift; - - return ('message/rfc822', $rfc822) unless $part; - - my $eml = Email::MIME->new($rfc822); - return find_part($eml, $part); -} - -sub add_raw_message { - my $Self = shift; - my $msgid = shift; - my $rfc822 = shift; - - my $eml = Email::MIME->new($rfc822); - my $message = $Self->parse_message($msgid, $eml); - - # fiddle the top-level fields - my $data = { - msgid => $msgid, - rfc822 => $rfc822, - parsed => encode_json($message), - }; - - $Self->dinsert('jrawmessage', $data); - - return $message; -} - sub parse_date { my $Self = shift; my $date = shift; @@ -250,9 +205,8 @@ sub parse_date { } sub isodate { - my $Selft = shift; - my $epoch = shift; - return unless $epoch; # no 1970, punk + my $Self = shift; + my $epoch = shift || time(); my $date = DateTime->from_epoch( epoch => $epoch ); return $date->iso8601(); @@ -263,7 +217,7 @@ sub parse_emails { my $emails = shift; my @addrs = eval { Email::Address->parse($emails) }; - return map { { name => Encode::decode_utf8($_->name()), email => $_->address() } } @addrs; + return map { { name => Encode::decode('MIME-Header', $_->name()), email => $_->address() } } @addrs; } sub parse_message { @@ -287,8 +241,8 @@ sub parse_message { bcc => [$Self->parse_emails($eml->header('Bcc'))], from => [$Self->parse_emails($eml->header('From'))]->[0], replyTo => [$Self->parse_emails($eml->header('Reply-To'))]->[0], - subject => decode('MIME-Header', $eml->header('Subject')), - date => $Self->isodate($Self->parse_date($eml->header('Date'))), + subject => scalar(decode('MIME-Header', $eml->header('Subject'))), + date => scalar($Self->isodate($Self->parse_date($eml->header('Date')))), preview => $preview, textBody => $textpart, htmlBody => $htmlpart, @@ -312,25 +266,6 @@ sub headers { return \%data; } -sub find_part { - my $eml = shift; - my $target = shift; - my $part = shift; - my $num = 0; - foreach my $sub ($eml->subparts()) { - $num++; - my $id = $part ? "$part.$num" : $num; - my $type = $sub->content_type(); - $type =~ s/;.*//; - return ($type, $sub->body()) if ($id eq $target); - if ($type =~ m{^multipart/}) { - my @res = find_part($sub, $id); - return @res if @res; - } - } - return (); -} - sub attachments { my $Self = shift; my $messageid = shift; @@ -339,6 +274,19 @@ sub attachments { my $messages = shift; my $num = 0; my @res; + + my $draftatt = $eml->header('X-JMAP-Draft-Attachments'); + if ($draftatt) { + eval { + my $json = decode_base64($draftatt); + my $attach = decode_json($json); + push @res, @$attach; + }; + if ($@) { + warn "FAILED TO PARSE $draftatt => $@"; + } + } + foreach my $sub ($eml->subparts()) { $num++; my $type = $sub->content_type(); @@ -384,13 +332,15 @@ sub attachments { push @res, { id => $id, type => $type, - url => "https://proxy.jmap.io/raw/$accountid/$messageid/$id/$filename", + url => "https://$ENV{jmaphost}/raw/$accountid/m-$messageid-$id/$filename", # XXX dep + blobId => "m-$messageid-$id", name => $filename, size => length($body), isInline => $isInline, %extra, }; } + return @res; } @@ -402,11 +352,18 @@ sub _clean { return $text; } +sub _body_str { + my $eml = shift; + my $str = eval { $eml->body_str() }; + return $str if $str; + return Encode::decode('us-ascii', $eml->body_raw()); +} + sub textpart { my $eml = shift; my $type = $eml->content_type() || 'text/plain'; if ($type =~ m{^text/plain}i) { - return _clean($type, $eml->body_str()); + return _clean($type, _body_str($eml)); } foreach my $sub ($eml->subparts()) { my $res = textpart($sub); @@ -419,7 +376,7 @@ sub htmlpart { my $eml = shift; my $type = $eml->content_type() || 'text/plain'; if ($type =~ m{^text/html}i) { - return _clean($type, $eml->body_str()); + return _clean($type, _body_str($eml)); } foreach my $sub ($eml->subparts()) { my $res = htmlpart($sub); @@ -440,11 +397,11 @@ sub preview { my $eml = shift; my $type = $eml->content_type() || 'text/plain'; if ($type =~ m{text/plain}i) { - my $text = _clean($type, $eml->body_str()); + my $text = _clean($type, _body_str($eml)); return make_preview($text); } if ($type =~ m{text/html}i) { - my $text = _clean($type, $eml->body_str()); + my $text = _clean($type, _body_str($eml)); return make_preview(htmltotext($text)); } foreach my $sub ($eml->subparts()) { @@ -464,6 +421,7 @@ sub hasatt { my $eml = shift; my $type = $eml->content_type() || 'text/plain'; return 1 if $type =~ m{(image|video|application)/}; + return 1 if $eml->header('X-JMAP-Draft-Attachments'); foreach my $sub ($eml->subparts()) { my $res = hasatt($sub); return $res if $res; @@ -476,7 +434,7 @@ sub delete_message_from_mailbox { my ($msgid, $jmailboxid) = @_; my $data = {active => 0}; - $Self->ddirty('jmessagemap', $data, {msgid => $msgid, jmailboxid => $jmailboxid}); + $Self->dmaybedirty('jmessagemap', $data, {msgid => $msgid, jmailboxid => $jmailboxid}); $Self->dmaybeupdate('jmailboxes', {jcountsmodseq => $data->{jmodseq}}, {jmailboxid => $jmailboxid}); } @@ -484,10 +442,7 @@ sub change_message { my $Self = shift; my ($msgid, $data, $newids) = @_; - # doesn't work if only IDs have changed :( - #return unless $Self->dmaybedirty('jmessages', $data, {msgid => $msgid}); - - $Self->ddirty('jmessages', $data, {msgid => $msgid}); + my $bump = $Self->dmaybedirty('jmessages', $data, {msgid => $msgid}); my $oldids = $Self->dbh->selectcol_arrayref("SELECT jmailboxid FROM jmessagemap WHERE msgid = ? AND active = 1", {}, $msgid); my %old = map { $_ => 1 } @$oldids; @@ -495,7 +450,7 @@ sub change_message { foreach my $jmailboxid (@$newids) { if (delete $old{$jmailboxid}) { # just bump the modseq - $Self->dmaybeupdate('jmailboxes', {jcountsmodseq => $data->{jmodseq}}, {jmailboxid => $jmailboxid}); + $Self->dmaybeupdate('jmailboxes', {jcountsmodseq => $data->{jmodseq}}, {jmailboxid => $jmailboxid}) if $bump; } else { $Self->add_message_to_mailbox($msgid, $jmailboxid); @@ -525,26 +480,97 @@ sub _mkemail { sub _makemsg { my $Self = shift; my $args = shift; - - my %replyHeaders; - if ($args->{inReplyToMessageId}) { - # XXX - get replyheaders - } - - my $MIME = Email::Simple->create( - header => [ - From => _mkone($args->{from}), - To => _mkemail($args->{to}), - Cc => _mkemail($args->{cc}), - Bcc => _mkemail($args->{bcc}), - Subject => $args->{subject}, - %{$args->{headers} || {}}, - ], - body => $args->{textBody} || $args->{htmlBody}, + my $isDraft = shift; + + my $header = [ + From => _mkone($args->{from}), + To => _mkemail($args->{to}), + Cc => _mkemail($args->{cc}), + Bcc => _mkemail($args->{bcc}), + Subject => $args->{subject}, + Date => Date::Format::time2str("%a, %d %b %Y %H:%M:%S %z", $args->{msgdate}), + 'Message-Id' => $args->{msgmessageid}, + %{$args->{headers} || {}}, + ]; + + # massive switch + my $MIME; + my $htmlpart; + my $text = $args->{textBody} ? $args->{textBody} : JMAP::DB::htmltotext($args->{htmlBody}); + my $textpart = Email::MIME->create( + attributes => { + content_type => 'text/plain', + charset => 'UTF-8', + }, + body => $text, ); - # XXX - attachments + if ($args->{htmlBody}) { + $htmlpart = Email::MIME->create( + attributes => { + content_type => 'text/html', + charset => 'UTF-8', + }, + body => $args->{htmlBody}, + ); + } + + my @attachments = $args->{attachments} ? @{$args->{attachments}} : (); + + if (@attachments and not $isDraft) { + my $encoded = encode_base64($json->encode(\@attachments), ''); + push @$header, "X-JMAP-Draft-Attachments" => $encoded; + @attachments = (); + } + + if (@attachments) { + # most complex case + if ($htmlpart) { + my $msgparts = Email::MIME->create( + attributes => { + content_type => 'multipart/alternative' + }, + parts => [$textpart, $htmlpart], + ); + # XXX - attachments + $MIME = Email::MIME->create( + header_str => [@$header, 'Content-Type' => 'multipart/mixed'], + parts => [$msgparts], + ); + } + else { + # XXX - attachments + $MIME = Email::MIME->create( + header_str => [@$header, 'Content-Type' => 'multipart/mixed'], + parts => [$textpart], + ); + } + } + else { + if ($htmlpart) { + $MIME = Email::MIME->create( + attributes => { + content_type => 'multipart/alternative', + }, + header_str => $header, + parts => [$textpart, $htmlpart], + ); + } + else { + $MIME = Email::MIME->create( + attributes => { + content_type => 'text/plain', + charset => 'UTF-8', + }, + header_str => $header, + body => $args->{textBody}, + ); + } + } + + my $res = $MIME->as_string(); + $res =~ s/\r?\n/\r\n/gs; - return $MIME->as_string(); + return $res; } # NOTE: this can ONLY be used to create draft messages @@ -554,15 +580,37 @@ sub create_messages { my %created; my %notCreated; - my $dbh = $Self->dbh(); + return ({}, {}) unless %$args; + + $Self->begin(); # XXX - get draft mailbox ID - my ($draftid) = $dbh->selectrow_array("SELECT jmailboxid FROM jmailboxes WHERE role = ?", {}, "drafts"); + my ($draftid) = $Self->dbh->selectrow_array("SELECT jmailboxid FROM jmailboxes WHERE role = ?", {}, "drafts"); + my %todo; foreach my $cid (keys %$args) { my $item = $args->{$cid}; + if ($item->{inReplyToMessageId}) { + my ($replymessageid) = $Self->dbh->selectrow_array("SELECT msgmessageid FROM jmessages WHERE msgid = ?", {}, $item->{inReplyToMessageId}); + unless ($replymessageid) { + $notCreated{$cid} = 'inReplyToNotFound'; + next; + } + $item->{headers}{'In-Reply-To'} = $replymessageid; + $item->{headers}{'References'} = $replymessageid; + # XXX - references + } + $item->{msgdate} = time(); + $item->{msgmessageid} = new_uuid_string() . "\@$ENV{jmaphost}"; my $message = $Self->_makemsg($item); # XXX - let's just assume goodness for now - lots of error handling to add + $todo{$cid} = $message; + } + + $Self->commit(); + + foreach my $cid (keys %todo) { + my $message = $todo{$cid}; my ($msgid, $thrid) = $Self->import_message($message, [$draftid], isUnread => 0, isAnswered => 0, @@ -584,7 +632,7 @@ sub update_messages { die "Virtual method"; } -sub delete_messages { +sub destroy_messages { my $Self = shift; die "Virtual method"; } @@ -607,7 +655,111 @@ sub report_messages { return ($msgids, []); } -sub create_file { +sub parse_event { + my $Self = shift; + my $raw = shift; + my $CalDAV = Net::CalDAVTalk->new(url => 'http://localhost/'); # empty caldav + my ($event) = $CalDAV->vcalendarToEvents($raw); + return $event; +} + +sub set_event { + my $Self = shift; + my $jcalendarid = shift; + my $event = shift; + my $eventuid = delete $event->{uid}; + $Self->dmake('jevents', { + eventuid => $eventuid, + jcalendarid => $jcalendarid, + payload => $json->encode($event), + }); +} + +sub delete_event { + my $Self = shift; + my $jcalendarid = shift; # doesn't matter + my $eventuid = shift; + return $Self->dmaybedirty('jevents', {active => 0}, {eventuid => $eventuid}); +} + +sub parse_card { + my $Self = shift; + my $raw = shift; + my ($card) = Net::CardDAVTalk::VCard->new_fromstring($raw); + + my %hash; + + $hash{uid} = $card->uid(); + $hash{kind} = $card->VKind(); + + if ($hash{kind} eq 'contact') { + $hash{lastName} = $card->VLastName(); + $hash{firstName} = $card->VFirstName(); + $hash{prefix} = $card->VTitle(); + + $hash{company} = $card->VCompany(); + $hash{department} = $card->VDepartment(); + + $hash{emails} = [$card->VEmails()]; + $hash{addresses} = [$card->VAddresses()]; + $hash{phones} = [$card->VPhones()]; + $hash{online} = [$card->VOnline()]; + + $hash{nickname} = $card->VNickname(); + $hash{birthday} = $card->VBirthday(); + $hash{notes} = $card->VNotes(); + } + else { + $hash{name} = $card->VFN(); + $hash{members} = [$card->VGroupContactUIDs()]; + } + + return \%hash; +} + +sub set_card { + my $Self = shift; + my $jaddressbookid = shift; + my $card = shift; + my $carduid = delete $card->{uid}; + my $kind = delete $card->{kind}; + if ($kind eq 'contact') { + $Self->dmake('jcontacts', { + contactuid => $carduid, + jaddressbookid => $jaddressbookid, + payload => $json->encode($card), + }); + } + else { + $Self->dmake('jcontactgroups', { + groupuid => $carduid, + jaddressbookid => $jaddressbookid, + name => $card->{name}, + }); + $Self->ddelete('jcontactgroupmap', {groupuid => $carduid}); + foreach my $item (@{$card->{members}}) { + $Self->dinsert('jcontactgroupmap', { + groupuid => $carduid, + contactuid => $item, + }); + } + } +} + +sub delete_card { + my $Self = shift; + my $jaddressbookid = shift; # doesn't matter + my $carduid = shift; + my $kind = shift; + if ($kind eq 'contact') { + $Self->dmaybedirty('jcontacts', {active => 0}, {contactuid => $carduid, jaddressbookid => $jaddressbookid}); + } + else { + $Self->dmaybedirty('jcontactgroups', {active => 0}, {groupuid => $carduid, jaddressbookid => $jaddressbookid}); + } +} + +sub put_file { my $Self = shift; my $type = shift; my $content = shift; @@ -615,13 +767,17 @@ sub create_file { my $size = length($content); + $Self->begin(); + # XXX - no dedup on sha1 here yet my $id = $Self->dinsert('jfiles', { type => $type, size => $size, content => $content, expires => $expires }); + $Self->commit(); + return { - id => $id, + id => "$id", type => $type, - expires => $expires, + expires => scalar($Self->isodate($expires)), size => $size, }; } @@ -643,8 +799,6 @@ sub dinsert { my $Self = shift; my ($table, $values) = @_; - confess("NOT IN TRANSACTION") unless $Self->{t}; - $values->{mtime} = time(); my @keys = sort keys %$values; @@ -661,8 +815,10 @@ sub dinsert { # dinsert with a modseq sub dmake { my $Self = shift; - my ($table, $values, $backfilling) = @_; - $values->{jmodseq} = $backfilling ? 1 : $Self->dirty(); + my ($table, $values) = @_; + my $modseq = $Self->dirty($table); + $values->{jcreated} = $modseq; + $values->{jmodseq} = $modseq; $values->{active} = 1; return $Self->dinsert($table, $values); } @@ -676,9 +832,10 @@ sub dupdate { $values->{mtime} = time(); my @keys = sort keys %$values; - my @lkeys = sort keys %$limit; + my @lkeys = $limit ? sort keys %$limit : (); - my $sql = "UPDATE $table SET " . join (', ', map { "$_ = ?" } @keys) . " WHERE " . join(' AND ', map { "$_ = ?" } @lkeys); + my $sql = "UPDATE $table SET " . join (', ', map { "$_ = ?" } @keys); + $sql .= " WHERE " . join(' AND ', map { "$_ = ?" } @lkeys) if @lkeys; $Self->log('debug', $sql, _dbl(map { $values->{$_} } @keys), _dbl(map { $limit->{$_} } @lkeys)); @@ -689,13 +846,15 @@ sub filter_values { my $Self = shift; my ($table, $values, $limit) = @_; - # copy so we don't edit the original - my %values = %$values; + # copy so we don't edit the originals + my %values = $values ? %$values : (); - my @keys = sort keys %$values; - my @lkeys = sort keys %$limit; + my @keys = sort keys %values; + my @lkeys = $limit ? sort keys %$limit : (); - my $sql = "SELECT " . join(', ', @keys) . " FROM $table WHERE " . join(' AND ', map { "$_ = ?" } @lkeys); + my $sql = "SELECT " . join(', ', @keys) . " FROM $table"; + $sql .= " WHERE " . join(' AND ', map { "$_ = ?" } @lkeys) if @lkeys; + $Self->log('debug', $sql, _dbl(map { $limit->{$_} } @lkeys)); my $data = $Self->dbh->selectrow_hashref($sql, {}, map { $limit->{$_} } @lkeys); foreach my $key (@keys) { delete $values{$key} if $limit->{$key}; # in the limit, no point setting again @@ -719,7 +878,7 @@ sub dmaybeupdate { sub ddirty { my $Self = shift; my ($table, $values, $limit) = @_; - $values->{jmodseq} = $Self->dirty(); + $values->{jmodseq} = $Self->dirty($table); return $Self->dupdate($table, $values, $limit); } @@ -730,24 +889,59 @@ sub dmaybedirty { my $filtered = $Self->filter_values($table, $values, $limit); return unless %$filtered; - $filtered->{jmodseq} = $values->{jmodseq} = $Self->dirty(); + $filtered->{jmodseq} = $values->{jmodseq} = $Self->dirty($table); return $Self->dupdate($table, $filtered, $limit); } -sub ddelete { +sub dnuke { my $Self = shift; my ($table, $limit) = @_; - confess("NOT IN TRANSACTION") unless $Self->{t}; + my $modseq = $Self->dirty($table); + + my @lkeys = sort keys %$limit; + my $sql = "UPDATE $table SET active = 0, jmodseq = ? WHERE active = 1"; + $sql .= " AND " . join(' AND ', map { "$_ = ?" } @lkeys) if @lkeys; + + $Self->log('debug', $sql, _dbl($modseq), _dbl(map { $limit->{$_} } @lkeys)); + + $Self->dbh->do($sql, {}, $modseq, map { $limit->{$_} } @lkeys); +} + +sub ddelete { + my $Self = shift; + my ($table, $limit) = @_; my @lkeys = sort keys %$limit; - my $sql = "DELETE FROM $table WHERE " . join(' AND ', map { "$_ = ?" } @lkeys); + my $sql = "DELETE FROM $table"; + $sql .= " WHERE " . join(' AND ', map { "$_ = ?" } @lkeys) if @lkeys; $Self->log('debug', $sql, _dbl(map { $limit->{$_} } @lkeys)); $Self->dbh->do($sql, {}, map { $limit->{$_} } @lkeys); } +sub dget { + my $Self = shift; + my ($table, $limit) = @_; + + my @lkeys = sort keys %$limit; + my $sql = "SELECT * FROM $table"; + $sql .= " WHERE " . join(' AND ', map { "$_ = ?" } @lkeys) if @lkeys; + + $Self->log('debug', $sql, _dbl(map { $limit->{$_} } @lkeys)); + + my $data = $Self->dbh->selectall_arrayref($sql, {Slice => {}}, map { $limit->{$_} } @lkeys); + return $data; +} + +# selectrow_arrayref? Nah +sub dgetone { + my $Self = shift; + my $res = $Self->dget(@_); + return $res->[0]; +} + sub _initdb { my $Self = shift; my $dbh = shift; @@ -771,6 +965,8 @@ CREATE TABLE IF NOT EXISTS jmessages ( msgmessageid TEXT, msgdate INTEGER, msgsize INTEGER, + sortsubject TEXT, + jcreated INTEGER, jmodseq INTEGER, mtime DATE, active BOOLEAN @@ -778,21 +974,23 @@ CREATE TABLE IF NOT EXISTS jmessages ( EOF $dbh->do("CREATE INDEX IF NOT EXISTS jthrid ON jmessages (thrid)"); + $dbh->do("CREATE INDEX IF NOT EXISTS jmsgmessageid ON jmessages (msgmessageid)"); $dbh->do(<do(<do(<do(<do(<do(<do(<do("CREATE INDEX IF NOT EXISTS jcontactmap ON jcontactgroupmap (contactuid)"); + + $dbh->do(< 1 } qw(\\HasChildren \\HasNoChildren \\NoSelect); -my %ROLE_MAP = ( - '\\Inbox' => 'inbox', - '\\Drafts' => 'drafts', - '\\Spam' => 'spam', - '\\Trash' => 'trash', - '\\AllMail' => 'archive', - '\\Sent' => 'sent', -); - -sub DESTROY { - my $Self = shift; - if ($Self->{imap}) { - $Self->{imap}->logout(); - } -} - -sub setuser { - my $Self = shift; - my ($username, $refresh_token, $displayname, $picture) = @_; - my $data = $Self->dbh->selectrow_arrayref("SELECT username, refresh_token FROM iserver"); - if ($data and $data->[0]) { - $Self->dmaybeupdate('iserver', {username => $username, refresh_token => $refresh_token}); - } - else { - $Self->dinsert('iserver', { - username => $username, - refresh_token => $refresh_token, - }); - } - my $user = $Self->dbh->selectrow_arrayref("SELECT email, displayname FROM account"); - if ($user and $user->[0]) { - $Self->dmaybeupdate('account', {email => $username, displayname => $displayname, picture => $picture}); - } - else { - $Self->dinsert('account', { - email => $username, - displayname => $displayname, - picture => $picture, - jdeletedmodseq => 0, - jhighestmodseq => 1, - }); - } -} - -my $O; -sub O { - unless ($O) { - my $data = io->file("/home/jmap/jmap-perl/config.json")->slurp; - my $config = decode_json($data); - $O = OAuth2::Tiny->new(%$config); - } - return $O; +sub new { + my $class = shift; + my $Self = $class->SUPER::new(@_); + $Self->{is_gmail} = 1; + return $Self; } sub access_token { my $Self = shift; - my $username = shift; - my $refresh_token = shift; - - unless ($refresh_token) { - ($username, $refresh_token) = $Self->dbh->selectrow_array("SELECT username, refresh_token FROM iserver"); - } - - my $O = $Self->O(); - my $data = $O->refresh($refresh_token); - - return ['gmail', $username, $data->{access_token}]; -} - -sub connect { - my $Self = shift; - - if ($Self->{imap}) { - $Self->{lastused} = time(); - return $Self->{imap}; - } - - for (1..3) { - $Self->log('debug', "Looking for server for $Self->{accountid}"); - my $data = $Self->dbh->selectrow_arrayref("SELECT username, refresh_token, lastfoldersync FROM iserver"); - die "UNKNOWN SERVER for $Self->{accountid}" unless ($data and $data->[0]); - $Self->log('debug', "getting access token for $data->[0]"); - my $token = $Self->access_token($data->[0], $data->[1]); - my $port = 993; - my $usessl = $port != 143; # we use SSL for anything except default - $Self->log('debug', "getting imaptalk"); - $Self->{imap} = Mail::GmailTalk->new( - Server => 'imap.gmail.com', - Port => $port, - Username => $data->[0], - Password => $token->[2], # bogus, but here we go... - # not configurable right now... - UseSSL => $usessl, - UseBlocking => $usessl, - ); - next unless $Self->{imap}; - $Self->log('debug', "Connected as $data->[0]"); - $Self->begin(); - $Self->sync_folders(); - $Self->dmaybeupdate('iserver', {lastfoldersync => time()}, {username => $data->[0]}); - $Self->commit(); - $Self->{lastused} = time(); - return $Self->{imap}; - } - - die "Could not connect to IMAP server: $@"; -} - -sub send_email { - my $Self = shift; - my $rfc822 = shift; - my $data = $Self->dbh->selectrow_arrayref("SELECT username, refresh_token FROM iserver"); - die "UNKNOWN SERVER for $Self->{accountid}" unless ($data and $data->[0]); - my $token = $Self->access_token($data->[0], $data->[1]); - die "not gmail" unless $token->[0] eq 'gmail'; - - my $email = Email::Simple->new($rfc822); - sendmail($email, { - from => $data->[0], - transport => Email::Sender::Transport::GmailSMTP->new({ - host => 'smtp.gmail.com', - port => 465, - ssl => 1, - sasl_username => $token->[1], - access_token => $token->[2], - }) - }); -} - -# synchronise list from IMAP server to local folder cache -# call in transaction -sub sync_folders { - my $Self = shift; - - my $dbh = $Self->dbh(); - my $imap = $Self->{imap}; - - my @folders = $imap->xlist('', '*'); - my $ifolders = $dbh->selectall_arrayref("SELECT ifolderid, sep, imapname, label FROM ifolders"); - my %ibylabel = map { $_->[3] => $_ } @$ifolders; - my %seen; - - foreach my $folder (@folders) { - my ($role) = grep { not $KNOWN_SPECIALS{lc $_} } @{$folder->[0]}; - my $label = $role || $folder->[2]; - my $id = $ibylabel{$label}[0]; - if ($id) { - $Self->dmaybeupdate('ifolders', {sep => $folder->[1], imapname => $folder->[2]}, {ifolderid => $id}); - } - else { - $id = $Self->dinsert('ifolders', {sep => $folder->[1], imapname => $folder->[2], label => $label}); - } - $seen{$id} = 1; - } - - foreach my $folder (@$ifolders) { - my $id = $folder->[0]; - next if $seen{$id}; - $dbh->do("DELETE FROM ifolders WHERE ifolderid = ?", {}, $id); - } - - $Self->sync_jmailboxes(); -} - -our %PROTECTED_MAILBOXES = map { $_ => 1 } qw(inbox trash archive junk); -our %ONLY_MAILBOXES = map { $_ => 1 } qw(trash); -our %NO_RENAME = map { $_ => 1 } qw(inbox); - -# synchronise from the imap folder cache to the jmap mailbox listing -# call in transaction -sub sync_jmailboxes { - my $Self = shift; - my $dbh = $Self->dbh(); - my $ifolders = $dbh->selectall_arrayref("SELECT ifolderid, sep, imapname, label, jmailboxid FROM ifolders"); - my $jmailboxes = $dbh->selectall_arrayref("SELECT jmailboxid, name, parentid, role, active FROM jmailboxes"); - - my %jbyid; - my %roletoid; - my %byname; - foreach my $mailbox (@$jmailboxes) { - $jbyid{$mailbox->[0]} = $mailbox; - $roletoid{$mailbox->[3]} = $mailbox->[0] if $mailbox->[3]; - $byname{$mailbox->[2]||'0'}{$mailbox->[1]} = $mailbox->[0]; - } - - my %seen; - foreach my $folder (@$ifolders) { - # check for roles first - my $role = $ROLE_MAP{$folder->[3]}; - my @bits = split $folder->[1], $folder->[2]; - my $id = 0; - my $parentid = 0; - my $name; - my $precedence = 3; - $precedence = 1 if ($role||'' eq 'inbox'); - while (my $item = shift @bits) { - if ($item eq '[Gmail]') { - $precedence = 2 if $role; - next; - } - $name = $item; - $parentid = $id; - $id = $byname{$parentid}{$name}; - unless ($id) { - if (@bits) { - # need to create intermediate folder ... - $id = $Self->dmake('jmailboxes', {name => $name, parentid => $parentid}); - $byname{$parentid}{$name} = $id; - } - } - } - next unless $name; - my %details = ( - name => $name, - parentid => $parentid, - precedence => $precedence, - mustBeOnly => $ONLY_MAILBOXES{$role||''}, - mayDelete => (not $PROTECTED_MAILBOXES{$role||''}), - mayRename => (not $NO_RENAME{$role||''}), - mayAdd => 1, - mayRemove => 1, - mayChild => 0, - mayRead => 1, - ); - if ($id) { - if ($role and $roletoid{$role} and $roletoid{$role} != $id) { - # still gotta move it - $id = $roletoid{$role}; - $Self->ddirty('jmailboxes', {active => 1, %details}, {jmailboxid => $id}); - } - elsif (not $folder->[4]) { - # reactivate! - $Self->ddirty('jmailboxes', {active => 1}, {jmailboxid => $id}); - } - } - else { - # case: role - we need to see if there's a case for moving this thing - if ($role and $roletoid{$role}) { - $id = $roletoid{$role}; - $Self->ddirty('jmailboxes', {active => 1, %details}, {jmailboxid => $id}); - } - else { - $id = $Self->dmake('jmailboxes', {role => $role, %details}); - $byname{$parentid}{$name} = $id; - $roletoid{$role} = $id if $role; - } - } - $seen{$id} = 1; - $Self->dmaybeupdate('ifolders', {jmailboxid => $id}, {ifolderid => $folder->[0]}); - } - - my $haveoutbox = 0; - foreach my $mailbox (@$jmailboxes) { - my $id = $mailbox->[0]; - if (($mailbox->[3]||'') eq 'outbox') { - $haveoutbox = 1; - next; - } - next if $seen{$id}; - $Self->dupdate('jmailboxes', {active => 0}, {jmailboxid => $id}); - } - - unless ($haveoutbox) { - $Self->dmake('jmailboxes', { - role => "outbox", - name => "Outbox", - parentid => 0, - precedence => 1, - mustBeOnly => 0, - mayDelete => 0, - mayRename => 0, - mayAdd => 1, - mayRemove => 1, - mayChild => 0, # don't go fiddling around - mayRead => 1, - }); - } -} - -sub labels { - my $Self = shift; - unless ($Self->{t}{labels}) { - my $data = $Self->dbh->selectall_arrayref("SELECT label, ifolderid, jmailboxid, imapname FROM ifolders"); - $Self->{t}{labels} = { map { lc $_->[0] => [$_->[1], $_->[2], $_->[3]] } @$data }; - } - return $Self->{t}{labels}; -} - -sub sync { - my $Self = shift; - my $imap = $Self->{imap}; - my $labels = $Self->labels(); - - # there's some special casing to care about here... we force the \\Trash label on Trash UIDs - $Self->do_folder($labels->{"\\allmail"}[0]); - if ($labels->{"\\trash"}[0]) { - $Self->do_folder($labels->{"\\trash"}[0], "\\Trash"); - } -} - -sub backfill { - my $Self = shift; - my $old = $Self->dbh->selectcol_arrayref("SELECT ifolderid FROM ifolders WHERE uidnext > 1 AND uidfirst > 1"); - foreach my $ifolderid (@$old) { - warn "SYNCING OLD FOLDER $ifolderid\n"; - $Self->do_folder($ifolderid); - } -} - -sub firstsync { - my $Self = shift; - my $imap = $Self->{imap}; - my $labels = $Self->labels(); - - my $ifolderid = $labels->{"\\allmail"}[0]; - $Self->do_folder($ifolderid, undef, 50); - - my $msgids = $Self->dbh->selectcol_arrayref("SELECT msgid FROM imessages WHERE ifolderid = ? ORDER BY uid DESC LIMIT 50", {}, $ifolderid); - - # pre-load the INBOX! - $Self->fill_messages(@$msgids); -} - -sub do_folder { - my $Self = shift; - my $ifolderid = shift; - my $forcelabel = shift; - my $batchsize = shift || 500; - - Carp::confess("NO FOLDERID") unless $ifolderid; - my $imap = $Self->{imap}; - my $dbh = $Self->dbh(); - - my ($imapname, $olduidfirst, $olduidnext, $olduidvalidity, $oldhighestmodseq) = $dbh->selectrow_array("SELECT imapname, uidfirst, uidnext, uidvalidity, highestmodseq FROM ifolders WHERE ifolderid = ?", {}, $ifolderid); - die "NO SUCH FOLDER $ifolderid" unless $imapname; - $olduidfirst ||= 0; - - my $r = $imap->examine($imapname); - die "EXAMINE FAILED $r" unless (lc($r) eq 'ok' or lc($r) eq 'read-only'); - - my $uidvalidity = $imap->get_response_code('uidvalidity'); - my $uidnext = $imap->get_response_code('uidnext'); - my $highestmodseq = $imap->get_response_code('highestmodseq') || 0; - my $exists = $imap->get_response_code('exists') || 0; - - if ($olduidvalidity and $olduidvalidity != $uidvalidity) { - $oldhighestmodseq = 0; - $olduidfirst = 0; - $olduidnext = 1; - # XXX - delete all the data for this folder and re-sync it - } - elsif ($olduidfirst == 1 and $oldhighestmodseq and $highestmodseq == $oldhighestmodseq) { - $Self->log('debug', "Nothing to do for $imapname at $highestmodseq"); - return 0; # yay, nothing to do - } - - $olduidfirst = $uidnext unless $olduidfirst; - $olduidnext = $uidnext unless $olduidnext; - - my $uidfirst = $olduidfirst; - if ($olduidfirst > 1) { - $uidfirst = $olduidfirst - $batchsize; - $uidfirst = 1 if $uidfirst < 1; - my $to = $olduidfirst - 1; - $Self->log('debug', "FETCHING $imapname: $uidfirst:$to"); - my $new = $imap->fetch("$uidfirst:$to", '(uid flags internaldate envelope rfc822.size x-gm-msgid x-gm-thrid x-gm-labels)') || {}; - $Self->{backfilling} = 1; - foreach my $uid (sort { $a <=> $b } keys %$new) { - $Self->new_record($ifolderid, $uid, $new->{$uid}{'flags'}, $forcelabel ? [$forcelabel] : $new->{$uid}{'x-gm-labels'}, $new->{$uid}{envelope}, str2time($new->{$uid}{internaldate}), $new->{$uid}{'x-gm-msgid'}, $new->{$uid}{'x-gm-thrid'}, $new->{$uid}{'rfc822.size'}); - } - delete $Self->{backfilling}; - } - - if ($olduidnext > $olduidfirst) { - my $to = $olduidnext - 1; - my @extra; - push @extra, "(changedsince $oldhighestmodseq)" if $oldhighestmodseq; - $Self->log('debug', "UPDATING $imapname: $uidfirst:$to"); - my $changed = $imap->fetch("$uidfirst:$to", "(flags x-gm-labels)", @extra) || {}; - foreach my $uid (sort { $a <=> $b } keys %$changed) { - $Self->changed_record($ifolderid, $uid, $changed->{$uid}{'flags'}, $forcelabel ? [$forcelabel] : $changed->{$uid}{'x-gm-labels'}); - } - } - - if ($uidnext > $olduidnext) { - my $to = $uidnext - 1; - $Self->log('debug', "FETCHING $imapname: $olduidnext:$to"); - my $new = $imap->fetch("$olduidnext:$to", '(uid flags internaldate envelope rfc822.size x-gm-msgid x-gm-thrid x-gm-labels)') || {}; - foreach my $uid (sort { $a <=> $b } keys %$new) { - $Self->new_record($ifolderid, $uid, $new->{$uid}{'flags'}, $forcelabel ? [$forcelabel] : $new->{$uid}{'x-gm-labels'}, $new->{$uid}{envelope}, str2time($new->{$uid}{internaldate}), $new->{$uid}{'x-gm-msgid'}, $new->{$uid}{'x-gm-thrid'}, $new->{$uid}{'rfc822.size'}); - } - } - - # need to make changes before counting - my ($count) = $dbh->selectrow_array("SELECT COUNT(*) FROM imessages WHERE ifolderid = ?", {}, $ifolderid); - if ($count != $exists) { - my $to = $uidnext - 1; - $Self->log('debug', "COUNTING $imapname: $uidfirst:$to (something deleted)"); - my $uids = $imap->search("UID", "$uidfirst:$to"); - my $data = $dbh->selectcol_arrayref("SELECT uid FROM imessages WHERE ifolderid = ?", {}, $ifolderid); - my %exists = map { $_ => 1 } @$uids; - foreach my $uid (@$data) { - next if $exists{$uid}; - $Self->deleted_record($ifolderid, $uid); - } - } - - $Self->dupdate('ifolders', {highestmodseq => $highestmodseq, uidfirst => $uidfirst, uidnext => $uidnext, uidvalidity => $uidvalidity}, {ifolderid => $ifolderid}); - - return $uidfirst; -} - -sub changed_record { - my $Self = shift; - my ($folder, $uid, $flaglist, $labellist) = @_; - - my $flags = encode_json([sort @$flaglist]); - my $labels = encode_json([sort @$labellist]); - - my ($msgid) = $Self->{dbh}->selectrow_array("SELECT msgid FROM imessages WHERE ifolderid = ? AND uid = ?", {}, $folder, $uid); - - $Self->dmaybeupdate('imessages', {flags => $flags, labels => $labels}, {ifolderid => $folder, uid => $uid}); - - $Self->apply_data($msgid, $flaglist, $labellist); -} - -sub import_message { - my $Self = shift; - my $message = shift; - my $mailboxIds = shift; - my %flags = @_; - - my $dbh = $Self->{dbh}; - my $imap = $Self->{imap}; - - my $folderdata = $dbh->selectall_arrayref("SELECT ifolderid, imapname, label, jmailboxid FROM ifolders"); - my %foldermap = map { $_->[0] => $_ } @$folderdata; - my %jmailmap = map { $_->[3] => $_ } grep { $_->[3] } @$folderdata; - - # store to the first named folder - we can use labels on gmail to add to other folders later. - my $foldername = $jmailmap{$mailboxIds->[0]}[1]; - $imap->select($foldername); - - my @flags; - push @flags, "\\Seen" unless $flags{isUnread}; - push @flags, "\\Answered" if $flags{isAnswered}; - push @flags, "\\Flagged" if $flags{isFlagged}; - - my $internaldate = time(); # XXX - allow setting? - my $date = Date::Format::time2str('%e-%b-%Y %T %z', $internaldate); - $imap->append($foldername, "(@flags)", $date, { Literal => $message }); - my $uid = $imap->get_response_code('appenduid'); - - if (@$mailboxIds > 1) { - my $labels = join(" ", grep { lc $_ ne '\\allmail' } map { $jmailmap{$_}[2] || $jmailmap{$_}[1] } @$mailboxIds); - $imap->store($uid->[1], "X-GM-LABELS", "($labels)"); - } - - my $new = $imap->fetch($uid->[1], '(x-gm-msgid x-gm-thrid)'); - my $msgid = $new->{$uid->[1]}{'x-gm-msgid'}; - my $thrid = $new->{$uid->[1]}{'x-gm-thrid'}; - - return ($msgid, $thrid); -} - -sub update_messages { - my $Self = shift; - my $changes = shift; - - my @updated; - my %notUpdated; - - my $dbh = $Self->{dbh}; - my $imap = $Self->{imap}; - - my %updatemap; - foreach my $msgid (keys %$changes) { - my ($ifolderid, $uid) = $dbh->selectrow_array("SELECT ifolderid, uid FROM imessages WHERE msgid = ?", {}, $msgid); - $updatemap{$ifolderid}{$uid} = [$changes->{$msgid}, $msgid]; - } - - my $folderdata = $dbh->selectall_arrayref("SELECT ifolderid, imapname, label, jmailboxid FROM ifolders"); - my %foldermap = map { $_->[0] => $_ } @$folderdata; - my %jmailmap = map { $_->[3] => $_ } grep { $_->[3] } @$folderdata; - - foreach my $ifolderid (keys %updatemap) { - # XXX - merge similar actions? - my $imapname = $foldermap{$ifolderid}[1]; - die "NO SUCH FOLDER $ifolderid" unless $imapname; - - # we're writing here! - my $r = $imap->select($imapname); - die "SELECT FAILED $r" unless lc($r) eq 'ok'; - - # XXX - error handling - foreach my $uid (sort keys %{$updatemap{$ifolderid}}) { - my $action = $updatemap{$ifolderid}{$uid}[0]; - my $msgid = $updatemap{$ifolderid}{$uid}[1]; - if (exists $action->{isUnread}) { - my $act = $action->{isUnread} ? "-flags" : "+flags"; # reverse - my $res = $imap->store($uid, $act, "(\\Seen)"); - } - if (exists $action->{isFlagged}) { - my $act = $action->{isFlagged} ? "+flags" : "-flags"; - $imap->store($uid, $act, "(\\Flagged)"); - } - if (exists $action->{isAnswered}) { - my $act = $action->{isAnswered} ? "+flags" : "-flags"; - $imap->store($uid, $act, "(\\Answered)"); - } - if (exists $action->{mailboxIds}) { - my $labels = join(" ", grep { lc $_ ne '\\allmail' } map { $jmailmap{$_}[2] || $jmailmap{$_}[1] } @{$action->{mailboxIds}}); - $imap->store($uid, "X-GM-LABELS", "($labels)"); - } - push @updated, $msgid; - } - $imap->unselect(); - } - - return (\@updated, \%notUpdated); -} - -sub delete_messages { - my $Self = shift; - my $ids = shift; - - my $dbh = $Self->{dbh}; - my $imap = $Self->{imap}; - - my @deleted; - my %notDeleted; - - my %deletemap; - foreach my $msgid (@$ids) { - my ($ifolderid, $uid) = $dbh->selectrow_array("SELECT ifolderid, uid FROM imessages WHERE msgid = ?", {}, $msgid); - $deletemap{$ifolderid}{$uid} = 1; - } - - my $folderdata = $dbh->selectall_arrayref("SELECT ifolderid, imapname, label, jmailboxid FROM ifolders"); - my %foldermap = map { $_->[0] => $_ } @$folderdata; - my %jmailmap = map { $_->[3] => $_ } grep { $_->[3] } @$folderdata; - - foreach my $ifolderid (keys %deletemap) { - # XXX - merge similar actions? - my $imapname = $foldermap{$ifolderid}[1]; - die "NO SUCH FOLDER $ifolderid" unless $imapname; - - # we're writing here! - my $r = $imap->select($imapname); - die "SELECT FAILED $r" unless lc($r) eq 'ok'; - - my $uids = [sort keys %{$deletemap{$ifolderid}}]; - if (@$uids) { - $imap->store($uids, "+flags", "(\\Deleted)"); - $imap->uidexpunge($uids); - } - $imap->unselect(); - } - - return (\@deleted, \%notDeleted); -} - -sub deleted_record { - my $Self = shift; - my ($folder, $uid) = @_; - - my ($msgid) = $Self->{dbh}->selectrow_array("SELECT msgid FROM imessages WHERE ifolderid = ? AND uid = ?", {}, $folder, $uid); - - $Self->ddelete('imessages', {ifolderid => $folder, uid => $uid}); - - $Self->apply_data($msgid, [], []); -} - -sub new_record { - my $Self = shift; - my ($ifolderid, $uid, $flaglist, $labellist, $envelope, $internaldate, $msgid, $thrid, $size) = @_; - - my $flags = encode_json([sort @$flaglist]); - my $labels = encode_json([sort @$labellist]); - - my $data = { - ifolderid => $ifolderid, - uid => $uid, - flags => $flags, - labels => $labels, - internaldate => $internaldate, - msgid => $msgid, - thrid => $thrid, - envelope => encode_json($envelope), - size => $size, - }; - - # XXX - what about dupes? - $Self->dinsert('imessages', $data); - - $Self->apply_data($msgid, $flaglist, $labellist); -} - -sub apply_data { - my $Self = shift; - my ($msgid, $flaglist, $labellist) = @_; - @$labellist = ('\\allmail') unless @$labellist; - - my %flagdata = ( - isUnread => 1, - isFlagged => 0, - isAnswered => 0, - isDraft => 0, - ); - foreach my $flag (@$flaglist) { - $flagdata{isUnread} = 0 if lc $flag eq '\\seen'; - $flagdata{isFlagged} = 1 if lc $flag eq '\\flagged'; - $flagdata{isAnswered} = 1 if lc $flag eq '\\answered'; - $flagdata{isDraft} = 1 if lc $flag eq '\\draft'; - } - - my $labels = $Self->labels(); - my @jmailboxids = grep { $_ } map { $labels->{lc $_}[1] } @$labellist; - - my ($old) = $Self->{dbh}->selectrow_array("SELECT msgid FROM jmessages WHERE msgid = ? AND active = 1", {}, $msgid); - - $Self->log('debug', "DATA (@jmailboxids) for $msgid"); - - if ($old) { - $Self->log('debug', "changing $msgid"); - return $Self->change_message($msgid, \%flagdata, \@jmailboxids); - } - else { - $Self->log('debug', "adding $msgid"); - my $data = $Self->dbh->selectrow_hashref("SELECT thrid,internaldate,size,envelope FROM imessages WHERE msgid = ?", {}, $msgid); - return $Self->add_message({ - msgid => $msgid, - internaldate => $data->{internaldate}, - thrid => $data->{thrid}, - msgsize => $data->{size}, - _envelopedata($data->{envelope}), - %flagdata, - }, \@jmailboxids); - } -} - -sub _envelopedata { - my $envelope = decode_json(shift); - return ( - msgsubject => decode('MIME-Header', $envelope->{Subject}), - msgfrom => $envelope->{From}, - msgto => $envelope->{To}, - msgcc => $envelope->{Cc}, - msgbcc => $envelope->{Bcc}, - msgdate => str2time($envelope->{Date}), - msginreplyto => $envelope->{'In-Reply-To'}, - msgmessageid => $envelope->{'Message-ID'}, - ); -} - -sub fill_messages { - my $Self = shift; - my @ids = @_; - - my $data = $Self->dbh->selectall_arrayref("SELECT msgid, parsed FROM jrawmessage WHERE msgid IN (" . join(', ', map { "?" } @ids) . ")", {}, @ids); - my %result; - foreach my $line (@$data) { - $result{$line->[0]} = decode_json($line->[1]); - } - my @need = grep { not $result{$_} } @ids; - - return \%result unless @need; - - my $uids = $Self->dbh->selectall_arrayref("SELECT ifolderid, uid, msgid FROM imessages WHERE msgid IN (" . join(', ', map { "?" } @need) . ")", {}, @need); - my %udata; - foreach my $row (@$uids) { - $udata{$row->[0]}{$row->[1]} = $row->[2]; - } - - my $imap = $Self->{imap}; - foreach my $ifolderid (sort keys %udata) { - my ($imapname) = $Self->dbh->selectrow_array("SELECT imapname FROM ifolders WHERE ifolderid = ?", {}, $ifolderid); - my $uhash = $udata{$ifolderid}; - - die "NO folder $ifolderid" unless $imapname; - my $r = $imap->examine($imapname); - die "EXAMINE FAILED $r" unless lc($r) eq 'ok'; - - my $messages = $imap->fetch(join(',', sort { $a <=> $b } keys %$uhash), "rfc822"); - - foreach my $uid (keys %$messages) { - warn "FETCHED BODY FOR $uid\n"; - my $rfc822 = $messages->{$uid}{rfc822}; - my $msgid = $uhash->{$uid}; - $result{$msgid} = $Self->add_raw_message($msgid, $rfc822); - } - } - - my @stillneed = grep { not $result{$_} } @ids; - - return \%result; -} - -sub _initdb { - my $Self = shift; - my $dbh = shift; - - $Self->SUPER::_initdb($dbh); - - # XXX - password encryption? - $dbh->do(<do(<begin(); + my ($hostname, $username, $password) = $Self->dbh->selectrow_array("SELECT imapHost, username, password FROM iserver"); + $Self->commit(); - $dbh->do(<refresh($password); + return [$hostname, $username, $data->{access_token}]; } 1; diff --git a/JMAP/ImapDB.pm b/JMAP/ImapDB.pm index 23aa5d5..99e3002 100644 --- a/JMAP/ImapDB.pm +++ b/JMAP/ImapDB.pm @@ -7,105 +7,129 @@ package JMAP::ImapDB; use base qw(JMAP::DB); use DBI; -use Mail::IMAPTalk; use Date::Parse; -use JSON::XS qw(encode_json decode_json); +use JSON::XS qw(decode_json); use Data::UUID::LibUUID; use OAuth2::Tiny; +use Digest::SHA qw(sha1_hex); use Encode; use Encode::MIME::Header; -use Digest::SHA qw(sha1_hex); +use AnyEvent; +use AnyEvent::Socket; +use Date::Format; +use Data::Dumper; +use JMAP::Sync::Gmail; +use JMAP::Sync::Standard; + +my $json = JSON::XS->new->utf8->canonical(); + +our $TAG = 1; -# XXX - specialuse, this is just for iCloud for now +# special use or name magic my %ROLE_MAP = ( 'inbox' => 'inbox', + 'drafts' => 'drafts', + 'draft' => 'drafts', + 'draft messages' => 'drafts', + + 'bulk' => 'spam', + 'bulk mail' => 'spam', 'junk' => 'spam', - 'deleted messages' => 'trash', + 'junk mail' => 'spam', + 'spam' => 'spam', + 'spam mail' => 'spam', + 'spam messages' => 'spam', + 'archive' => 'archive', - 'sent messages' => 'sent', + 'sent' => 'sent', 'sent items' => 'sent', + 'sent messages' => 'sent', + + 'deleted messages' => 'trash', 'trash' => 'trash', -); -sub DESTROY { - my $Self = shift; - if ($Self->{imap}) { - $Self->{imap}->logout(); - } -} + '\\inbox' => 'inbox', + '\\trash' => 'trash', + '\\sent' => 'sent', + '\\junk' => 'spam', + '\\spam' => 'spam', + '\\archive' => 'archive', + '\\drafts' => 'drafts', +); sub setuser { my $Self = shift; - my ($hostname, $username, $password) = @_; - my $data = $Self->dbh->selectrow_arrayref("SELECT hostname, username, password FROM iserver"); - if ($data and $data->[0]) { - $Self->dmaybeupdate('iserver', {hostname => $hostname, username => $username, password => $password}); + my $args = shift; + # XXX - picture, etc + + $Self->begin(); + + my $data = $Self->dgetone('iserver'); + if ($data) { + $Self->dmaybeupdate('iserver', $args); } else { - $Self->dinsert('iserver', { - hostname => $hostname, - username => $username, - password => $password, - }); + $Self->dinsert('iserver', $args); } - my $user = $Self->dbh->selectrow_arrayref("SELECT email FROM account"); - if ($user and $user->[0]) { - $Self->dmaybeupdate('account', {email => $username}); + + my $user = $Self->dgetone('account'); + if ($user) { + $Self->dmaybeupdate('account', {email => $args->{username}}); } else { $Self->dinsert('account', { - email => $username, + email => $args->{username}, jdeletedmodseq => 0, jhighestmodseq => 1, }); } + + $Self->commit(); } sub access_token { my $Self = shift; - my ($hostname, $username, $password) = $Self->dbh->selectrow_array("SELECT hostname, username, password FROM iserver"); + $Self->begin(); + my $data = $Self->dgetone('iserver'); + $Self->commit(); - return [$hostname, $username, $password]; + return [$data->{imapHost}, $data->{username}, $data->{password}]; } -sub connect { +sub access_data { my $Self = shift; - if ($Self->{imap}) { - $Self->{lastused} = time(); - return $Self->{imap}; - } + $Self->begin(); + my $data = $Self->dgetone('iserver'); + $Self->commit(); - for (1..3) { - $Self->log('debug', "Looking for server for $Self->{accountid}"); - my $data = $Self->dbh->selectrow_arrayref("SELECT hostname, username, password, lastfoldersync FROM iserver"); - die "UNKNOWN SERVER for $Self->{accountid}" unless ($data and $data->[0]); - my $port = 993; - my $usessl = $port != 143; # we use SSL for anything except default - $Self->log('debug', "getting imaptalk\n"); - $Self->{imap} = Mail::IMAPTalk->new( - Server => $data->[0], - Port => $port, - Username => $data->[1], - Password => $data->[2], - # not configurable right now... - UseSSL => $usessl, - UseBlocking => $usessl, - ); - next unless $Self->{imap}; - $Self->log('debug', "Connected to $data->[0] as $data->[1]"); - eval { $Self->{imap}->enable('condstore') }; - $Self->begin(); - $Self->sync_folders(); - $Self->dmaybeupdate('iserver', {lastfoldersync => time()}, {username => $data->[0]}); - $Self->commit(); - $Self->{lastused} = time(); - return $Self->{imap}; + return $data; +} + +# synchronous backend for now +sub backend_cmd { + my $Self = shift; + my $cmd = shift; + my @args = @_; + + use Carp; + Carp::confess("in transaction") if $Self->in_transaction(); + + unless ($Self->{backend}) { + my $config = $Self->access_data(); + my $backend; + if ($config->{imapHost} eq 'imap.gmail.com') { + $backend = JMAP::Sync::Gmail->new($config) || die "failed to setup $config->{username}"; + } else { + $backend = JMAP::Sync::Standard->new($config) || die "failed to setup $config->{username}"; + } + $Self->{backend} = $backend; } - die "Could not connect to IMAP server: $@"; + die "No such command $cmd" unless $Self->{backend}->can($cmd); + return $Self->{backend}->$cmd(@args); } # synchronise list from IMAP server to local folder cache @@ -113,31 +137,57 @@ sub connect { sub sync_folders { my $Self = shift; - my $dbh = $Self->dbh(); - my $imap = $Self->{imap}; + my $data = $Self->backend_cmd('folders'); + my ($prefix, $folders) = @$data; + + $Self->begin(); - my @folders = $imap->list('', '*'); - my $ifolders = $dbh->selectall_arrayref("SELECT ifolderid, sep, imapname, label FROM ifolders"); - my %ibylabel = map { $_->[3] => $_ } @$ifolders; + my $ifolders = $Self->dget('ifolders'); + my %ibylabel = map { $_->{label} => $_ } @$ifolders; my %seen; - foreach my $folder (@folders) { - my $role = $ROLE_MAP{lc $folder->[2]}; - my $label = $role || $folder->[2]; - my $id = $ibylabel{$label}[0]; + my %getstatus; + foreach my $name (sort keys %$folders) { + my $sep = $folders->{$name}[0]; + my $label = $folders->{$name}[1]; + my $id = $ibylabel{$label}{ifolderid}; if ($id) { - $Self->dmaybeupdate('ifolders', {sep => $folder->[1], imapname => $folder->[2]}, {ifolderid => $id}); + $Self->dmaybeupdate('ifolders', {sep => $sep, imapname => $name}, {ifolderid => $id}); } else { - $id = $Self->dinsert('ifolders', {sep => $folder->[1], imapname => $folder->[2], label => $label}); + $id = $Self->dinsert('ifolders', {sep => $sep, imapname => $name, label => $label}); } $seen{$id} = 1; + unless ($ibylabel{$label}{uidvalidity}) { + # no uidvalidity, we need to get status for this one + $getstatus{$name} = $id; + } } foreach my $folder (@$ifolders) { - my $id = $folder->[0]; + my $id = $folder->{ifolderid}; next if $seen{$id}; - $dbh->do("DELETE FROM ifolders WHERE ifolderid = ?", {}, $id); + $Self->ddelete('ifolders', {ifolderid => $id}); + } + + $Self->dmaybeupdate('iserver', {imapPrefix => $prefix, lastfoldersync => time()}); + + $Self->commit(); + + if (keys %getstatus) { + my $data = $Self->backend_cmd('imap_status', [keys %getstatus]); + $Self->begin(); + foreach my $name (keys %$data) { + my $status = $data->{$name}; + next unless ref($status) eq 'HASH'; + $Self->dmaybeupdate('ifolders', { + uidvalidity => $status->{uidvalidity}, + uidnext => $status->{uidnext}, + uidfirst => $status->{uidnext}, + highestmodseq => $status->{highestmodseq}, + }, {ifolderid => $getstatus{$name}}); + } + $Self->commit(); } $Self->sync_jmailboxes(); @@ -147,149 +197,557 @@ sub sync_folders { # call in transaction sub sync_jmailboxes { my $Self = shift; - my $dbh = $Self->dbh(); - my $ifolders = $dbh->selectall_arrayref("SELECT ifolderid, sep, imapname, label, jmailboxid FROM ifolders"); - my $jmailboxes = $dbh->selectall_arrayref("SELECT jmailboxid, name, parentid, role, active FROM jmailboxes"); + $Self->begin(); + my $ifolders = $Self->dget('ifolders'); + my $jmailboxes = $Self->dget('jmailboxes'); my %jbyid; my %roletoid; my %byname; foreach my $mailbox (@$jmailboxes) { - $jbyid{$mailbox->[0]} = $mailbox; - $roletoid{$mailbox->[3]} = $mailbox->[0] if $mailbox->[3]; - $byname{$mailbox->[2]}{$mailbox->[1]} = $mailbox->[0]; + $jbyid{$mailbox->{jmailboxid}} = $mailbox; + $roletoid{$mailbox->{role}} = $mailbox->{jmailboxid} if $mailbox->{role}; + $byname{$mailbox->{parentId}}{$mailbox->{name}} = $mailbox->{jmailboxid}; } my %seen; foreach my $folder (@$ifolders) { - my $fname = $folder->[2]; - $fname =~ s/^INBOX\.//; + next if lc $folder->{label} eq "\\allmail"; # we don't show this folder + my $fname = $folder->{imapname}; # check for roles first - my @bits = split "[$folder->[1]]", $fname; - my $role = $ROLE_MAP{lc $fname}; + my @bits = split "[$folder->{sep}]", $fname; + shift @bits if ($bits[0] eq 'INBOX' and $bits[1]); # really we should be stripping the actual prefix, if any + shift @bits if $bits[0] eq '[Gmail]'; # we special case this GMail magic + next unless @bits; # also skip the magic '[Gmail]' top-level + my $role = $ROLE_MAP{lc $folder->{label}}; my $id = 0; - my $parentid = 0; + my $parentId = 0; my $name; - my $precedence = 3; - $precedence = 2 if $role; - $precedence = 1 if ($role||'') eq 'inbox'; + my $sortOrder = 3; + $sortOrder = 2 if $role; + $sortOrder = 1 if ($role||'') eq 'inbox'; while (my $item = shift @bits) { + $seen{$id} = 1 if $id; $name = $item; - $parentid = $id; - $id = $byname{$parentid}{$name}; + $parentId = $id; + $id = $byname{$parentId}{$name}; unless ($id) { if (@bits) { # need to create intermediate folder ... # XXX - label noselect? - $id = $Self->dmake('jmailboxes', {name => $name, precedence => 4, parentid => $parentid}); - $byname{$parentid}{$name} = $id; + $id = $Self->dmake('jmailboxes', {name => $name, sortOrder => 4, parentId => $parentId}); + $byname{$parentId}{$name} = $id; } } } next unless $name; my %details = ( name => $name, - parentid => $parentid, - precedence => $precedence, - mustBeOnly => 1, - mayDelete => 0, - mayRename => 0, - mayAdd => 1, - mayRemove => 1, - mayChild => 0, - mayRead => 1, + parentId => $parentId, + sortOrder => $sortOrder, + mustBeOnlyMailbox => 1, + mayReadItems => 1, + mayAddItems => 1, + mayRemoveItems => 1, + mayCreateChild => 1, + mayRename => $role ? 0 : 1, + mayDelete => $role ? 0 : 1, ); if ($id) { if ($role and $roletoid{$role} and $roletoid{$role} != $id) { # still gotta move it $id = $roletoid{$role}; - $Self->ddirty('jmailboxes', {active => 1, %details}, {jmailboxid => $id}); + $Self->dmaybedirty('jmailboxes', {active => 1, %details}, {jmailboxid => $id}); } - elsif (not $folder->[4]) { + elsif (not $folder->{active}) { # reactivate! - $Self->ddirty('jmailboxes', {active => 1}, {jmailboxid => $id}); + $Self->dmaybedirty('jmailboxes', {active => 1}, {jmailboxid => $id}); } } else { # case: role - we need to see if there's a case for moving this thing if ($role and $roletoid{$role}) { $id = $roletoid{$role}; - $Self->ddirty('jmailboxes', {active => 1, %details}, {jmailboxid => $id}); + $Self->dmaybedirty('jmailboxes', {active => 1, %details}, {jmailboxid => $id}); } else { $id = $Self->dmake('jmailboxes', {role => $role, %details}); - $byname{$parentid}{$name} = $id; + $byname{$parentId}{$name} = $id; $roletoid{$role} = $id if $role; } } $seen{$id} = 1; - $Self->dmaybeupdate('ifolders', {jmailboxid => $id}, {ifolderid => $folder->[0]}); + $Self->dmaybeupdate('ifolders', {jmailboxid => $id}, {ifolderid => $folder->{ifolderid}}); + } + + if ($roletoid{'outbox'}) { + $seen{$roletoid{'outbox'}} = 1; + } + else { + # outbox - magic + my $outbox = { + parentId => 0, + name => 'Outbox', + role => 'outbox', + sortOrder => 2, + mustBeOnlyMailbox => 1, + mayReadItems => 1, + mayAddItems => 1, + mayRemoveItems => 1, + mayCreateChild => 0, + mayRename => 0, + mayDelete => 0, + }; + my $id = $Self->dmake('jmailboxes', $outbox); + $seen{$id} = 1; + $roletoid{'outbox'} = $id; + } + + if ($roletoid{'archive'}) { + $seen{$roletoid{'archive'}} = 1; + } + else { + # archive - magic + my $archive = { + parentId => 0, + name => 'Archive', + role => 'archive', + sortOrder => 2, + mustBeOnlyMailbox => 1, + mayReadItems => 1, + mayAddItems => 1, + mayRemoveItems => 1, + mayCreateChild => 0, + mayRename => 0, + mayDelete => 0, + }; + my $id = $Self->dmake('jmailboxes', $archive); + $seen{$id} = 1; + $roletoid{'archive'} = $id; } foreach my $mailbox (@$jmailboxes) { - my $id = $mailbox->[0]; + my $id = $mailbox->{jmailboxid}; + next unless $mailbox->{active}; next if $seen{$id}; $Self->dupdate('jmailboxes', {active => 0}, {jmailboxid => $id}); } + + $Self->commit(); +} + +# synchronise list from CalDAV server to local folder cache +sub sync_calendars { + my $Self = shift; + + my $calendars = $Self->backend_cmd('get_calendars', []); + return unless $calendars; + + $Self->begin(); + + my $icalendars = $Self->dget('icalendars'); + my %byhref = map { $_->{href} => $_ } @$icalendars; + + my %seen; + my %todo; + foreach my $calendar (@$calendars) { + my $id = $calendar->{href} ? $byhref{$calendar->{href}}{icalendarid} : 0; + my $data = { + isReadOnly => $calendar->{isReadOnly}, + href => $calendar->{href}, + color => $calendar->{color}, + name => $calendar->{name}, + syncToken => $calendar->{syncToken}, + }; + if ($id) { + $Self->dmaybeupdate('icalendars', $data, {icalendarid => $id}); + my $token = $byhref{$calendar->{href}}{syncToken}; + if ($token eq $calendar->{syncToken}) { + $seen{$id} = 1; + next; + } + } + else { + $id = $Self->dinsert('icalendars', $data); + } + $todo{$id} = $calendar->{href}; + $seen{$id} = 1; + } + + foreach my $calendar (@$icalendars) { + my $id = $calendar->{icalendarid}; + next if $seen{$id}; + $Self->ddelete('icalendars', {icalendarid => $id}); + } + + $Self->sync_jcalendars(); + + $Self->commit(); + + $Self->do_calendars(\%todo); +} + +# synchronise from the imap folder cache to the jmap mailbox listing +# call in transaction +sub sync_jcalendars { + my $Self = shift; + + my $icalendars = $Self->dget('icalendars'); + my $jcalendars = $Self->dget('jcalendars'); + + my %jbyid; + foreach my $calendar (@$jcalendars) { + $jbyid{$calendar->{jcalendarid}} = $calendar; + } + + my %seen; + foreach my $calendar (@$icalendars) { + my $data = { + name => $calendar->{name}, + color => $calendar->{color}, + isVisible => 1, + mayReadFreeBusy => 1, + mayReadItems => 1, + mayAddItems => 1, + mayModifyItems => 1, + mayRemoveItems => 1, + mayDelete => 1, + mayRename => 1, + }; + my $id = $calendar->{jcalendarid}; + if ($id && $jbyid{$id}) { + $Self->dmaybedirty('jcalendars', $data, {jcalendarid => $id}); + } + else { + $id = $Self->dmake('jcalendars', $data); + $Self->dupdate('icalendars', {jcalendarid => $id}, {icalendarid => $calendar->{icalendarid}}); + } + $seen{$id} = 1; + } + + foreach my $calendar (@$jcalendars) { + my $id = $calendar->{jcalendarid}; + next if $seen{$id}; + $Self->dnuke('jcalendars', {jcalendarid => $id}); + $Self->dnuke('jevents', {jcalendarid => $id}); + } +} + +sub do_calendars { + my $Self = shift; + my $cals = shift; + + my %allparsed; + my %allevents; + foreach my $href (sort values %$cals) { + my $events = $Self->backend_cmd('get_events', $href); + # parse events before we lock + my %parsed = map { $_ => $Self->parse_event($events->{$_}) } keys %$events; + $allparsed{$href} = \%parsed; + $allevents{$href} = $events; + } + + $Self->begin(); + foreach my $id (keys %$cals) { + my $href = $cals->{$id}; + my ($jcalendarid) = $Self->dbh->selectrow_array("SELECT jcalendarid FROM icalendars WHERE icalendarid = ?", {}, $id); + my $exists = $Self->dget('ievents', {icalendarid => $id}); + my %res = map { $_->{resource} => $_ } @$exists; + + foreach my $resource (keys %{$allparsed{$href}}) { + my $data = delete $res{$resource}; + my $raw = $allevents{$href}{$resource}; + my $event = $allparsed{$href}{$resource}; + my $uid = $event->{uid}; + my $item = { + icalendarid => $id, + uid => $uid, + resource => $resource, + content => encode_utf8($raw), + }; + if ($data) { + my $eid = $data->{ieventid}; + next if $raw eq decode_utf8($data->{content}); + $Self->dmaybeupdate('ievents', $item, {ieventid => $eid}); + } + else { + $Self->dinsert('ievents', $item); + } + $Self->set_event($jcalendarid, $event); + } + + foreach my $resource (keys %res) { + my $data = delete $res{$resource}; + my $id = $data->{ieventid}; + $Self->ddelete('ievents', {ieventid => $id}); + $Self->delete_event($jcalendarid, $data->{uid}); + } + } + + $Self->commit(); +} + +# synchronise list from CardDAV server to local folder cache +# call in transaction +sub sync_addressbooks { + my $Self = shift; + + my $addressbooks = $Self->backend_cmd('get_addressbooks', []); + return unless $addressbooks; + + $Self->begin(); + + my $iaddressbooks = $Self->dget('iaddressbooks'); + my %byhref = map { $_->{href} => $_ } @$iaddressbooks; + + my %seen; + my %todo; + foreach my $addressbook (@$addressbooks) { + my $id = $byhref{$addressbook->{href}}{iaddressbookid}; + my $data = { + isReadOnly => $addressbook->{isReadOnly}, + href => $addressbook->{href}, + name => $addressbook->{name}, + syncToken => $addressbook->{syncToken}, + }; + if ($id) { + $Self->dmaybeupdate('iaddressbooks', $data, {iaddressbookid => $id}); + my $token = $byhref{$addressbook->{href}}{syncToken}; + if ($token eq $addressbook->{syncToken}) { + $seen{$id} = 1; + next; + } + } + else { + $id = $Self->dinsert('iaddressbooks', $data); + } + $todo{$id} = $addressbook->{href}; + $seen{$id} = 1; + } + + foreach my $addressbook (@$iaddressbooks) { + my $id = $addressbook->{iaddressbookid}; + next if $seen{$id}; + $Self->ddelete('iaddressbooks', {iaddressbookid => $id}); + } + + $Self->sync_jaddressbooks(); + + $Self->commit(); + + $Self->do_addressbooks(\%todo); +} + +# synchronise from the imap folder cache to the jmap mailbox listing +# call in transaction +sub sync_jaddressbooks { + my $Self = shift; + + my $iaddressbooks = $Self->dget('iaddressbooks'); + my $jaddressbooks = $Self->dget('jaddressbooks'); + + my %jbyid; + foreach my $addressbook (@$jaddressbooks) { + next unless $addressbook->{jaddressbookid}; + $jbyid{$addressbook->{jaddressbookid}} = $addressbook; + } + + my %seen; + foreach my $addressbook (@$iaddressbooks) { + my $aid = $addressbook->{iaddressbookid}; + my $data = { + name => $addressbook->{name}, + isVisible => 1, + mayReadItems => 1, + mayAddItems => 1, + mayModifyItems => 1, + mayRemoveItems => 1, + mayDelete => 0, + mayRename => 0, + }; + my $jid = $addressbook->{jaddressbookid}; + if ($jid && $jbyid{$jid}) { + $Self->dmaybedirty('jaddressbooks', $data, {jaddressbookid => $jid}); + $seen{$jid} = 1; + } + else { + $jid = $Self->dmake('jaddressbooks', $data); + $Self->dupdate('iaddressbooks', {jaddressbookid => $jid}, {iaddressbookid => $aid}); + $seen{$jid} = 1; + } + } + + foreach my $addressbook (@$jaddressbooks) { + my $jid = $addressbook->{jaddressbookid}; + next if $seen{$jid}; + $Self->dnuke('jaddressbooks', {jaddressbookid => $jid}); + $Self->dnuke('jcontactgroups', {jaddressbookid => $jid}); + $Self->dnuke('jcontacts', {jaddressbookid => $jid}); + } +} + +sub do_addressbooks { + my $Self = shift; + my $books = shift; + + my %allcards; + my %allparsed; + foreach my $href (sort values %$books) { + my $cards = $Self->backend_cmd('get_cards', $href); + # parse before locking + my %parsed = map { $_ => $Self->parse_card($cards->{$_}) } keys %$cards; + $allparsed{$href} = \%parsed; + $allcards{$href} = $cards; + } + + $Self->begin(); + + foreach my $id (keys %$books) { + my $href = $books->{$id}; + my ($jaddressbookid) = $Self->dbh->selectrow_array("SELECT jaddressbookid FROM iaddressbooks WHERE iaddressbookid = ?", {}, $id); + my $exists = $Self->dget('icards', {iaddressbookid => $id}); + my %res = map { $_->{resource} => $_ } @$exists; + + foreach my $resource (keys %{$allparsed{$href}}) { + my $data = delete $res{$resource}; + my $raw = $allcards{$href}{$resource}; + my $card = $allparsed{$href}{$resource}; + my $uid = $card->{uid}; + my $kind = $card->{kind}; + my $item = { + iaddressbookid => $id, + resource => $resource, + uid => $uid, + kind => $kind, + content => encode_utf8($raw), + }; + if ($data) { + my $cid = $data->{icardid}; + next if $raw eq decode_utf8($data->{content}); + $Self->dmaybeupdate('icards', $item, {icardid => $cid}); + } + else { + $Self->dinsert('icards', $item); + } + $Self->set_card($jaddressbookid, $card); + } + + foreach my $resource (keys %res) { + my $data = delete $res{$resource}; + my $cid = $data->{icardid}; + $Self->ddelete('icards', {icardid => $cid}); + $Self->delete_card($jaddressbookid, $data->{uid}, $data->{kind}); + } + } + + $Self->commit(); } sub labels { my $Self = shift; - unless ($Self->{t}{labels}) { - my $data = $Self->dbh->selectall_arrayref("SELECT label, ifolderid, jmailboxid, imapname FROM ifolders"); - $Self->{t}{labels} = { map { lc $_->[0] => [$_->[1], $_->[2], $_->[3]] } @$data }; + unless ($Self->{labels}) { + my $data = $Self->dget('ifolders'); + $Self->{labels} = { map { $_->{label} => [$_->{ifolderid}, $_->{jmailboxid}, $_->{imapname}] } @$data }; } - return $Self->{t}{labels}; + return $Self->{labels}; } -sub sync { +sub sync_imap { my $Self = shift; - my $imap = $Self->{imap}; - my $data = $Self->dbh->selectall_arrayref("SELECT ifolderid,label FROM ifolders"); + + $Self->begin(); + my $data = $Self->dget('ifolders'); + if ($Self->{is_gmail}) { + $data = [ grep { lc $_->{label} eq '\\allmail' or lc $_->{label} eq '\\trash' } @$data ]; + } + $Self->commit(); + + my @imapnames = map { $_->{imapname} } @$data; + my $status = $Self->backend_cmd('imap_status', \@imapnames); foreach my $row (@$data) { - $Self->do_folder(@$row); + # XXX - better handling of UIDvalidity change? + next if ($status->{$row->{imapname}}{uidvalidity} == $row->{uidvalidity} and $status->{$row->{imapname}}{highestmodseq} and $status->{$row->{imapname}}{highestmodseq} == $row->{highestmodseq}); + my $label = $row->{label}; + $label = undef if lc $label eq '\\allmail'; + $Self->do_folder($row->{ifolderid}, $label); } } sub backfill { my $Self = shift; - my $data = $Self->dbh->selectall_arrayref("SELECT ifolderid,label FROM ifolders WHERE uidnext > 1 AND uidfirst > 1 ORDER BY mtime"); + + $Self->begin(); + my $data = $Self->dbh->selectall_arrayref("SELECT * FROM ifolders WHERE uidnext > 1 AND uidfirst > 1 ORDER BY mtime", {Slice => {}}); + if ($Self->{is_gmail}) { + $data = [ grep { lc $_->{label} eq '\\allmail' or lc $_->{label} eq '\\trash' } @$data ]; + } + $Self->commit(); + + return unless @$data; + + #DB::enable_profile(); my $rest = 500; foreach my $row (@$data) { - $rest -= $Self->do_folder(@$row, $rest); + my $id = $row->{ifolderid}; + my $label = $row->{label}; + $label = undef if lc $label eq '\\allmail'; + $rest -= $Self->do_folder($id, $label, $rest); last if $rest < 10; } + #DB::disable_profile(); + #exit 0; + + return 1; } sub firstsync { my $Self = shift; - my $imap = $Self->{imap}; - my $labels = $Self->labels(); - my $ifolderid = $labels->{"inbox"}[0]; - $Self->do_folder($ifolderid, "inbox", 50); + $Self->sync_folders(); + + $Self->begin(); + my $data = $Self->dget('ifolders'); + $Self->commit(); - my $msgids = $Self->dbh->selectcol_arrayref("SELECT msgid FROM imessages WHERE ifolderid = ? ORDER BY uid DESC LIMIT 50", {}, $ifolderid); + if ($Self->{is_gmail}) { + my ($folder) = grep { lc $_->{label} eq '\\allmail' } @$data; + $Self->do_folder($folder->{ifolderid}, undef, 50) if $folder; + } + else { + my ($folder) = grep { lc $_->{imapname} eq 'inbox' } @$data; + $Self->do_folder($folder->{ifolderid}, $folder->{label}, 50) if $folder; + } +} - # pre-load the INBOX! - $Self->fill_messages(@$msgids); +sub _trimh { + my $val = shift; + return '' unless defined $val; + $val =~ s{\s+$}{}; + $val =~ s{^\s+}{}; + return $val; } sub calcmsgid { my $Self = shift; - my $envelope = shift; - my $json = JSON::XS->new->allow_nonref->canonical; - my $coded = $json->encode($envelope); - my $msgid = sha1_hex($coded); - - my $replyto = lc($envelope->{'In-Reply-To'} || ''); - my $messageid = lc($envelope->{'Message-ID'} || ''); - my ($thrid) = $Self->dbh->selectrow_array("SELECT DISTINCT thrid FROM ithread WHERE messageid IN (?, ?)", {}, $replyto, $messageid); - $thrid ||= $msgid; + my $imapname = shift; + my $uid = shift; + my $data = shift; + my $envelope = $data->{envelope}; + my $coded = $json->encode([$envelope]); + my $base = substr(sha1_hex($coded), 0, 9); + my $msgid = "m$base"; + + my $replyto = _trimh($envelope->{'In-Reply-To'}); + my $messageid = _trimh($envelope->{'Message-ID'}); + my $encsub = Encode::decode('MIME-Header', $envelope->{Subject}); + my $sortsub = _normalsubject($encsub); + my ($thrid) = $Self->dbh->selectrow_array("SELECT DISTINCT thrid FROM ithread WHERE messageid IN (?, ?) AND sortsubject = ?", {}, $replyto, $messageid, $sortsub); + # XXX - merging? subject-checking? We have a subject here + $thrid ||= "t$base"; foreach my $id ($replyto, $messageid) { next if $id eq ''; - $Self->dbh->do("INSERT OR IGNORE INTO ithread (messageid, thrid) VALUES (?, ?)", {}, $id, $thrid); + $Self->dbh->do("INSERT OR IGNORE INTO ithread (messageid, thrid, sortsubject) VALUES (?, ?, ?)", {}, $id, $thrid, $sortsub); } return ($msgid, $thrid); @@ -302,211 +760,434 @@ sub do_folder { my $batchsize = shift; Carp::confess("NO FOLDERID") unless $ifolderid; - my $imap = $Self->{imap}; - my $dbh = $Self->dbh(); + $Self->begin(); + + my $data = $Self->dgetone('ifolders', {ifolderid => $ifolderid}); + die "NO SUCH FOLDER $ifolderid" unless $data; + my $imapname = $data->{imapname}; + my $uidfirst = $data->{uidfirst}; + my $uidvalidity = $data->{uidvalidity}; + my $uidnext = $data->{uidnext}; + my $highestmodseq = $data->{highestmodseq}; + + my %fetches; + my @immutable = qw(internaldate envelope rfc822.size); + my @mutable; + if ($Self->{is_gmail}) { + push @immutable, qw(x-gm-msgid x-gm-thrid); + push @mutable, qw(x-gm-labels); + } - my ($imapname, $olduidfirst, $olduidnext, $olduidvalidity, $oldhighestmodseq) = $dbh->selectrow_array("SELECT imapname, uidfirst, uidnext, uidvalidity, highestmodseq FROM ifolders WHERE ifolderid = ?", {}, $ifolderid); - die "NO SUCH FOLDER $ifolderid" unless $imapname; - $olduidfirst ||= 0; + if ($batchsize) { + if ($uidfirst > 1) { + my $end = $uidfirst - 1; + $uidfirst -= $batchsize; + $uidfirst = 1 if $uidfirst < 1; + $fetches{backfill} = [$uidfirst, $end, [@immutable, @mutable]]; + } + } + else { + $fetches{new} = [$uidnext, '*', [@immutable, @mutable]]; + $fetches{update} = [$uidfirst, $uidnext - 1, [@mutable], $highestmodseq]; + } - my $r = $imap->examine($imapname); + $Self->commit(); - my $uidvalidity = $imap->get_response_code('uidvalidity'); - my $uidnext = $imap->get_response_code('uidnext'); - my $highestmodseq = $imap->get_response_code('highestmodseq') || 0; - my $exists = $imap->get_response_code('exists') || 0; + return unless keys %fetches; - if ($olduidvalidity and $olduidvalidity != $uidvalidity) { - $oldhighestmodseq = 0; - $olduidfirst = 0; - $olduidnext = 1; - # XXX - delete all the data for this folder and re-sync it - } - elsif ($olduidfirst == 1 and $oldhighestmodseq and $highestmodseq == $oldhighestmodseq) { - $Self->log('debug', "Nothing to do for $imapname at $highestmodseq"); - return 0; # yay, nothing to do + my $res = $Self->backend_cmd('imap_fetch', $imapname, { + uidvalidity => $uidvalidity, + highestmodseq => $highestmodseq, + uidnext => $uidnext, + }, \%fetches); + + if ($res->{newstate}{uidvalidity} != $uidvalidity) { + # going to want to nuke everything for the existing folder and create this - but for now, just die + die "UIDVALIDITY CHANGED $imapname: $uidvalidity => $res->{newstate}{uidvalidity}"; } - $olduidfirst = $uidnext unless $olduidfirst; - $olduidnext = $uidnext unless $olduidnext; + $Self->begin(); + $Self->{t}{backfilling} = 1 if $batchsize; - my $uidfirst = $olduidfirst; my $didold = 0; - if ($olduidfirst > 1 and $batchsize) { - $uidfirst = $olduidfirst - $batchsize; - $uidfirst = 1 if $uidfirst < 1; - my $to = $olduidfirst - 1; - $Self->log('debug', "FETCHING $imapname: $uidfirst:$to"); - my $new = $imap->fetch("$uidfirst:$to", '(uid flags internaldate envelope rfc822.size)') || {}; - $Self->{backfilling} = 1; + if ($res->{backfill}) { + my $new = $res->{backfill}[1]; + my $count = 0; foreach my $uid (sort { $a <=> $b } keys %$new) { - my ($msgid, $thrid) = $Self->calcmsgid($new->{$uid}{envelope}); + $count++; + # release the lock frequently so we don't starve the API + if ($count > 50) { + $Self->commit(); + $Self->begin(); + $Self->{t}{backfilling} = 1; + $count = 0; + } + my ($msgid, $thrid, @labels); + if ($Self->{is_gmail}) { + ($msgid, $thrid) = ($new->{$uid}{"x-gm-msgid"}, $new->{$uid}{"x-gm-thrid"}); + @labels = $forcelabel ? ($forcelabel) : @{$new->{$uid}{"x-gm-labels"}}; + } + else { + ($msgid, $thrid) = $Self->calcmsgid($imapname, $uid, $new->{$uid}); + @labels = ($forcelabel); + } $didold++; - $Self->new_record($ifolderid, $uid, $new->{$uid}{'flags'}, [$forcelabel], $new->{$uid}{envelope}, str2time($new->{$uid}{internaldate}), $msgid, $thrid, $new->{$uid}{'rfc822.size'}); + $Self->new_record($ifolderid, $uid, $new->{$uid}{'flags'}, \@labels, $new->{$uid}{envelope}, str2time($new->{$uid}{internaldate}), $msgid, $thrid, $new->{$uid}{'rfc822.size'}); } - delete $Self->{backfilling}; } - if ($olduidnext > $olduidfirst) { - my $to = $olduidnext - 1; - my @extra; - push @extra, "(changedsince $oldhighestmodseq)" if $oldhighestmodseq; - $Self->log('debug', "UPDATING $imapname: $uidfirst:$to"); - my $changed = $imap->fetch("$uidfirst:$to", "(flags)", @extra) || {}; + if ($res->{update}) { + my $changed = $res->{update}[1]; foreach my $uid (sort { $a <=> $b } keys %$changed) { - $Self->changed_record($ifolderid, $uid, $changed->{$uid}{'flags'}, [$forcelabel]); + my @labels = ($forcelabel); + if ($Self->{is_gmail}) { + @labels = $forcelabel ? ($forcelabel) : @{$changed->{$uid}{"x-gm-labels"}}; + } + $Self->changed_record($ifolderid, $uid, $changed->{$uid}{'flags'}, \@labels); } } - if ($uidnext > $olduidnext) { - my $to = $uidnext - 1; - $Self->log('debug', "FETCHING $imapname: $olduidnext:$to"); - my $new = $imap->fetch("$olduidnext:$to", '(uid flags internaldate envelope rfc822.size)') || {}; + if ($res->{new}) { + my $new = $res->{new}[1]; foreach my $uid (sort { $a <=> $b } keys %$new) { - my ($msgid, $thrid) = $Self->calcmsgid($new->{$uid}{envelope}); - $Self->new_record($ifolderid, $uid, $new->{$uid}{'flags'}, [$forcelabel], $new->{$uid}{envelope}, str2time($new->{$uid}{internaldate}), $msgid, $thrid, $new->{$uid}{'rfc822.size'}); + my ($msgid, $thrid, @labels); + if ($Self->{is_gmail}) { + ($msgid, $thrid) = ($new->{$uid}{"x-gm-msgid"}, $new->{$uid}{"x-gm-thrid"}); + @labels = $forcelabel ? ($forcelabel) : @{$new->{$uid}{"x-gm-labels"}}; + } + else { + ($msgid, $thrid) = $Self->calcmsgid($imapname, $uid, $new->{$uid}); + @labels = ($forcelabel); + } + $Self->new_record($ifolderid, $uid, $new->{$uid}{'flags'}, \@labels, $new->{$uid}{envelope}, str2time($new->{$uid}{internaldate}), $msgid, $thrid, $new->{$uid}{'rfc822.size'}); } } + $Self->dupdate('ifolders', {highestmodseq => $res->{newstate}{highestmodseq}, uidfirst => $uidfirst, uidnext => $res->{newstate}{uidnext}}, {ifolderid => $ifolderid}); + + $Self->commit(); + + return $didold if $batchsize; + # need to make changes before counting - my ($count) = $dbh->selectrow_array("SELECT COUNT(*) FROM imessages WHERE ifolderid = ?", {}, $ifolderid); - if ($count != $exists) { + $Self->begin(); + my ($count) = $Self->dbh->selectrow_array("SELECT COUNT(*) FROM imessages WHERE ifolderid = ?", {}, $ifolderid); + $Self->commit(); + # if we don't know everything, we have to ALWAYS check or moves break + if ($uidfirst != 1 or $count != $res->{newstate}{exists}) { + # welcome to the future + $uidnext = $res->{newstate}{uidnext}; my $to = $uidnext - 1; $Self->log('debug', "COUNTING $imapname: $uidfirst:$to (something deleted)"); - my $uids = $imap->search("UID", "$uidfirst:$to"); - my $data = $dbh->selectcol_arrayref("SELECT uid FROM imessages WHERE ifolderid = ?", {}, $ifolderid); + my $res = $Self->backend_cmd('imap_count', $imapname, $uidvalidity, "$uidfirst:$to"); + $Self->begin(); + my $uids = $res->{data}; + my $data = $Self->dbh->selectcol_arrayref("SELECT uid FROM imessages WHERE ifolderid = ? AND uid >= ? AND uid <= ?", {}, $ifolderid, $uidfirst, $to); my %exists = map { $_ => 1 } @$uids; foreach my $uid (@$data) { next if $exists{$uid}; $Self->deleted_record($ifolderid, $uid); } + $Self->commit(); + } +} + +sub imap_search { + my $Self = shift; + my @search = @_; + + if ($Self->{is_gmail}) { + if ($search[0] eq 'text') { + @search = ('x-gm-raw', $search[1]); + } + if ($search[0] eq 'from') { + @search = ('x-gm-raw', "from:$search[1]"); + } + if ($search[0] eq 'to') { + @search = ('x-gm-raw', "to:$search[1]"); + } + if ($search[0] eq 'cc') { + @search = ('x-gm-raw', "cc:$search[1]"); + } + if ($search[0] eq 'subject') { + @search = ('x-gm-raw', "subject:$search[1]"); + } + if ($search[0] eq 'body') { + @search = ('x-gm-raw', $search[1]); + } } - $Self->dupdate('ifolders', {highestmodseq => $highestmodseq, uidfirst => $uidfirst, uidnext => $uidnext, uidvalidity => $uidvalidity}, {ifolderid => $ifolderid}); + $Self->begin(); + my $data = $Self->dget('ifolders'); + if ($Self->{is_gmail}) { + $data = [ grep { lc $_->{label} eq '\\allmail' or lc $_->{label} eq '\\trash' } @$data ]; + } + $Self->commit(); + + my %matches; + foreach my $item (@$data) { + my $from = $item->{uidfirst}; + my $to = $item->{uidnext}-1; + my $res = $Self->backend_cmd('imap_search', $item->{imapname}, 'uid', "$from:$to", @search); + # XXX - uidvaldity changed + next unless $res->[2] == $item->{uidvalidity}; + $Self->begin(); + foreach my $uid (@{$res->[3]}) { + my ($msgid) = $Self->dbh->selectrow_array("SELECT msgid FROM imessages WHERE ifolderid = ? and uid = ?", {}, $item->{ifolderid}, $uid); + $matches{$msgid} = 1; + } + $Self->commit(); + } - return $didold; + return \%matches; } sub changed_record { my $Self = shift; my ($folder, $uid, $flaglist, $labellist) = @_; - my $flags = encode_json([sort @$flaglist]); - my $labels = encode_json([sort @$labellist]); + my $flags = $json->encode([grep { lc $_ ne '\\recent' } sort @$flaglist]); + my $labels = $json->encode([sort @$labellist]); - my ($msgid) = $Self->{dbh}->selectrow_array("SELECT msgid FROM imessages WHERE ifolderid = ? AND uid = ?", {}, $folder, $uid); + return unless $Self->dmaybeupdate('imessages', {flags => $flags, labels => $labels}, {ifolderid => $folder, uid => $uid}); - $Self->dmaybeupdate('imessages', {flags => $flags, labels => $labels}, {ifolderid => $folder, uid => $uid}); + my ($msgid) = $Self->dbh->selectrow_array("SELECT msgid FROM imessages WHERE ifolderid = ? AND uid = ?", {}, $folder, $uid); $Self->apply_data($msgid, $flaglist, $labellist); } +sub import_message { + my $Self = shift; + my $rfc822 = shift; + my $mailboxIds = shift; + my %flags = @_; + + $Self->begin(); + my $folderdata = $Self->dget('ifolders'); + $Self->commit(); + + my %foldermap = map { $_->{ifolderid} => $_ } @$folderdata; + my %jmailmap = map { $_->{jmailboxid} => $_ } grep { $_->{jmailboxid} } @$folderdata; + + # store to the first named folder - we can use labels on gmail to add to other folders later. + my ($id, @others) = @$mailboxIds; + my $imapname = $jmailmap{$id}{imapname}; + + my @flags; + push @flags, "\\Seen" unless $flags{isUnread}; + push @flags, "\\Answered" if $flags{isAnswered}; + push @flags, "\\Flagged" if $flags{isFlagged}; + push @flags, "\\Draft" if $flags{isDraft}; + + my $internaldate = time(); # XXX - allow setting? + my $date = Date::Format::time2str('%e-%b-%Y %T %z', $internaldate); + + my $data = $Self->backend_cmd('imap_append', $imapname, "(@flags)", $date, $rfc822); + # XXX - compare $data->[2] with uidvalidity + my $uid = $data->[3]; + + # make sure we're up to date: XXX - imap only + if ($Self->{is_gmail}) { + my ($am) = grep { lc $_->{label} eq '\\allmail' } @$folderdata; + $Self->do_folder($am->{ifolderid}, undef); + } + else { + my $fdata = $jmailmap{$mailboxIds->[0]}; + $Self->do_folder($fdata->{ifolderid}, $fdata->{label}); + } + + $Self->begin(); + my ($msgid, $thrid) = $Self->dbh->selectrow_array("SELECT msgid, thrid FROM imessages WHERE ifolderid = ? AND uid = ?", {}, $jmailmap{$id}{ifolderid}, $uid); + $Self->commit(); + + # save us having to download it again - drop out of transaction so we don't wait on the parse + my $eml = Email::MIME->new($rfc822); + my $message = $Self->parse_message($msgid, $eml); + + $Self->begin(); + $Self->dinsert('jrawmessage', { + msgid => $msgid, + parsed => $json->encode($message), + hasAttachment => $message->{hasAttachment}, + }); + $Self->commit(); + + return ($msgid, $thrid); +} + sub update_messages { my $Self = shift; my $changes = shift; + my $idmap = shift; - my $dbh = $Self->{dbh}; - my $imap = $Self->{imap}; + return ([], {}) unless %$changes; + + $Self->begin(); my %updatemap; + my %notchanged; foreach my $msgid (keys %$changes) { - my ($ifolderid, $uid) = $dbh->selectrow_array("SELECT ifolderid, uid FROM imessages WHERE msgid = ?", {}, $msgid); - $updatemap{$ifolderid}{$uid} = $changes->{$msgid}; + my ($ifolderid, $uid) = $Self->dbh->selectrow_array("SELECT ifolderid, uid FROM imessages WHERE msgid = ?", {}, $msgid); + if ($ifolderid and $uid) { + $updatemap{$ifolderid}{$uid} = $msgid; + } + else { + $notchanged{$msgid} = {type => 'notFound', description => "No such message on server"}; + } } - my $folderdata = $dbh->selectall_arrayref("SELECT ifolderid, imapname, label, jmailboxid FROM ifolders"); - my %foldermap = map { $_->[0] => $_ } @$folderdata; - my %jmailmap = map { $_->[3] => $_ } @$folderdata; + my $folderdata = $Self->dget('ifolders'); + my %foldermap = map { $_->{ifolderid} => $_ } @$folderdata; + my %jmailmap = map { $_->{jmailboxid} => $_ } grep { $_->{jmailboxid} } @$folderdata; + my $jmapdata = $Self->dget('jmailboxes'); + my %jidmap = map { $_->{jmailboxid} => $_->{role} } @$jmapdata; + my %jrolemap = map { $_->{role} => $_->{jmailboxid} } grep { $_->{role} } @$jmapdata; + $Self->commit(); + + my @changed; foreach my $ifolderid (keys %updatemap) { # XXX - merge similar actions? - my $imapname = $foldermap{$ifolderid}[1]; - die "NO SUCH FOLDER $ifolderid" unless $imapname; - - # we're writing here! - my $r = $imap->select($imapname); + my $imapname = $foldermap{$ifolderid}{imapname}; + my $uidvalidity = $foldermap{$ifolderid}{uidvalidity}; foreach my $uid (sort keys %{$updatemap{$ifolderid}}) { - my $action = $updatemap{$ifolderid}{$uid}; + my $msgid = $updatemap{$ifolderid}{$uid}; + my $action = $changes->{$msgid}; + unless ($imapname and $uidvalidity) { + $notchanged{$msgid} = {type => 'notFound', description => "No folder found"}; + next; + } if (exists $action->{isUnread}) { - my $act = $action->{isUnread} ? "-flags" : "+flags"; # reverse - $Self->log('debug', "STORING $act SEEN for $uid"); - my $res = $imap->store($uid, $act, "(\\Seen)"); + my $bool = !$action->{isUnread}; + my @flags = ("\\Seen"); + $Self->log('debug', "STORING $bool @flags for $uid"); + $Self->backend_cmd('imap_update', $imapname, $uidvalidity, $uid, $bool, \@flags); } if (exists $action->{isFlagged}) { - my $act = $action->{isFlagged} ? "+flags" : "-flags"; - $Self->log('debug', "STORING $act FLAGGED for $uid"); - $imap->store($uid, $act, "(\\Flagged)"); + my $bool = $action->{isFlagged}; + my @flags = ("\\Flagged"); + $Self->log('debug', "STORING $bool @flags for $uid"); + $Self->backend_cmd('imap_update', $imapname, $uidvalidity, $uid, $bool, \@flags); } if (exists $action->{isAnswered}) { - my $act = $action->{isAnswered} ? "+flags" : "-flags"; - $Self->log('debug', "STORING $act ANSWERED for $uid"); - $imap->store($uid, $act, "(\\Answered)"); + my $bool = $action->{isAnswered}; + my @flags = ("\\Answered"); + $Self->log('debug', "STORING $bool @flags for $uid"); + $Self->backend_cmd('imap_update', $imapname, $uidvalidity, $uid, $bool, \@flags); } if (exists $action->{mailboxIds}) { - my $id = $action->{mailboxIds}->[0]; # there can be only one - my $newfolder = $foldermap{$id}[1]; - $imap->copy($uid, $newfolder); # UIDPLUS? Also the ID changes - $imap->store($uid, '+flags', "(\\Deleted)"); - $imap->uidexpunge($uid); + # jmailboxid + my @mboxes = map { $idmap->($_) } @{$action->{mailboxIds}}; + my ($has_outbox) = grep { $jidmap{$_} eq 'outbox' } @mboxes; + my (@others) = grep { $jidmap{$_} ne 'outbox' } @mboxes; + if ($has_outbox) { + # move to sent when we're done + push @others, $jmailmap{$jrolemap{'sent'}}{jmailboxid}; + + my ($type, $rfc822) = $Self->get_raw_message($msgid); + # XXX - add attachments - we might actually want the parsed message and then realise the attachments... + $Self->backend_cmd('send_email', $rfc822); + + # strip the \Draft flag + + $Self->backend_cmd('imap_update', $imapname, $uidvalidity, $uid, 0, ["\\Draft"]); + + $Self->begin(); + # add the \Answered flag to our in-reply-to + my ($updateid) = $Self->dbh->selectrow_array("SELECT msginreplyto FROM jmessages WHERE msgid = ?", {}, $msgid); + goto done unless $updateid; + my ($updatemsgid) = $Self->dbh->selectrow_array("SELECT msgid FROM jmessages WHERE msgmessageid = ?", {}, $updateid); + goto done unless $updatemsgid; + my ($ifolderid, $updateuid) = $Self->dbh->selectrow_array("SELECT ifolderid, uid FROM imessages WHERE msgid = ?", {}, $updatemsgid); + goto done unless $ifolderid; + my $updatename = $foldermap{$ifolderid}{imapname}; + my $updatevalidity = $foldermap{$ifolderid}{uidvalidity}; + goto done unless $updatename; + $Self->commit(); + $Self->backend_cmd('imap_update', $updatename, $updatevalidity, $updateuid, 1, ["\\Answered"]); + } + done: + $Self->reset(); # bogus, but otherwise we need to commit on all the done commands + if ($Self->{is_gmail}) { + # because 'archive' is synthetic on gmail we strip it here + (@others) = grep { $jidmap{$_} ne 'archive' } @others; + my @labels = grep { $_ and lc $_ ne '\\allmail' } map { $jmailmap{$_}{label} } @others; + $Self->backend_cmd('imap_labels', $imapname, $uidvalidity, $uid, \@labels); + } + else { + my $id = $others[0]; + my $newfolder = $jmailmap{$id}{imapname}; + $Self->backend_cmd('imap_move', $imapname, $uidvalidity, $uid, $newfolder); + } } + # XXX - handle errors from backend commands + push @changed, $msgid; } - $imap->unselect(); } + + return (\@changed, \%notchanged); } -sub delete_messages { +sub destroy_messages { my $Self = shift; my $ids = shift; - my $dbh = $Self->{dbh}; - my $imap = $Self->{imap}; + return ([], {}) unless @$ids; - my %deletemap; + $Self->begin(); + my %destroymap; + my %notdestroyed; foreach my $msgid (@$ids) { - my ($ifolderid, $uid) = $dbh->selectrow_array("SELECT ifolderid, uid FROM imessages WHERE msgid = ?", {}, $msgid); - $deletemap{$ifolderid}{$uid} = 1; + my ($ifolderid, $uid) = $Self->dbh->selectrow_array("SELECT ifolderid, uid FROM imessages WHERE msgid = ?", {}, $msgid); + if ($ifolderid and $uid) { + $destroymap{$ifolderid}{$uid} = $msgid; + } + else { + $notdestroyed{$msgid} = {type => 'notFound', description => "No such message on server"}; + } } - my $folderdata = $dbh->selectall_arrayref("SELECT ifolderid, imapname, label, jmailboxid FROM ifolders"); + my $folderdata = $Self->dget('ifolders'); my %foldermap = map { $_->[0] => $_ } @$folderdata; - my %jmailmap = map { $_->[3] => $_ } grep { $_->[3] } @$folderdata; + my %jmailmap = map { $_->[4] => $_ } grep { $_->[4] } @$folderdata; + + $Self->commit(); - foreach my $ifolderid (keys %deletemap) { + my @destroyed; + foreach my $ifolderid (keys %destroymap) { # XXX - merge similar actions? my $imapname = $foldermap{$ifolderid}[1]; - die "NO SUCH FOLDER $ifolderid" unless $imapname; - - # we're writing here! - my $r = $imap->select($imapname); - die "SELECT FAILED $r" unless lc($r) eq 'ok'; - - my $uids = [sort keys %{$deletemap{$ifolderid}}]; - if (@$uids) { - $imap->store($uids, "+flags", "(\\Deleted)"); - $imap->uidexpunge($uids); + my $uidvalidity = $foldermap{$ifolderid}[2]; + unless ($imapname) { + $notdestroyed{$_} = {type => 'notFound', description => "No folder"} for values %{$destroymap{$ifolderid}}; } - $imap->unselect(); + my $uids = [sort keys %{$destroymap{$ifolderid}}]; + $Self->backend_cmd('imap_move', $imapname, $uidvalidity, $uids, undef); # no destination folder + push @destroyed, values %{$destroymap{$ifolderid}}; } + + return (\@destroyed, \%notdestroyed); } sub deleted_record { my $Self = shift; my ($folder, $uid) = @_; - my ($msgid) = $Self->{dbh}->selectrow_array("SELECT msgid FROM imessages WHERE ifolderid = ? AND uid = ?", {}, $folder, $uid); + my ($msgid) = $Self->dbh->selectrow_array("SELECT msgid FROM imessages WHERE ifolderid = ? AND uid = ?", {}, $folder, $uid); + return unless $msgid; $Self->ddelete('imessages', {ifolderid => $folder, uid => $uid}); - $Self->apply_data($msgid, [], []); + $Self->delete_message($msgid); } sub new_record { my $Self = shift; my ($ifolderid, $uid, $flaglist, $labellist, $envelope, $internaldate, $msgid, $thrid, $size) = @_; - my $flags = encode_json([sort @$flaglist]); - my $labels = encode_json([sort @$labellist]); + my $flags = $json->encode([grep { lc $_ ne '\\recent' } sort @$flaglist]); + my $labels = $json->encode([sort @$labellist]); my $data = { ifolderid => $ifolderid, @@ -516,7 +1197,7 @@ sub new_record { internaldate => $internaldate, msgid => $msgid, thrid => $thrid, - envelope => encode_json($envelope), + envelope => $json->encode($envelope), size => $size, }; @@ -530,6 +1211,9 @@ sub apply_data { my $Self = shift; my ($msgid, $flaglist, $labellist) = @_; + # spurious temporary old message during move + return if grep { lc $_ eq '\\deleted' } @$flaglist; + my %flagdata = ( isUnread => 1, isFlagged => 0, @@ -544,9 +1228,16 @@ sub apply_data { } my $labels = $Self->labels(); - my @jmailboxids = grep { $_ } map { $labels->{lc $_}[1] } @$labellist; + my @list = @$labellist; + # gmail empty list means archive at our end + my @jmailboxids = grep { $_ } map { $labels->{$_}[1] } @list; + + # check for archive folder for gmail + if ($Self->{is_gmail} and not @list) { + @jmailboxids = $Self->dbh->selectrow_array("SELECT jmailboxid FROM jmailboxes WHERE role = 'archive'"); + } - my ($old) = $Self->{dbh}->selectrow_array("SELECT msgid FROM jmessages WHERE msgid = ? AND active = 1", {}, $msgid); + my ($old) = $Self->dbh->selectrow_array("SELECT msgid FROM jmessages WHERE msgid = ? AND active = 1", {}, $msgid); $Self->log('debug', "DATA (@jmailboxids) for $msgid"); @@ -568,18 +1259,37 @@ sub apply_data { } } +sub _normalsubject { + my $sub = shift; + return unless defined $sub; + + # Re: and friends + $sub =~ s/^[ \t]*[A-Za-z0-9]+://g; + # [LISTNAME] and friends + $sub =~ s/^[ \t]*\\[[^]]+\\]//g; + # Australian security services and frenemies + $sub =~ s/[\\[(SEC|DLM)=[^]]+\\][ \t]*$//g; + # any old whitespace + $sub =~ s/[ \t\r\n]+//g; + + return $sub; +} + sub _envelopedata { - my $envelope = decode_json(shift); - my $encsub = decode('MIME-Header', $envelope->{Subject}); + my $data = shift; + my $envelope = decode_json($data || "{}"); + my $encsub = Encode::decode('MIME-Header', $envelope->{Subject}); + my $sortsub = _normalsubject($encsub); return ( msgsubject => $encsub, + sortsubject => $sortsub, msgfrom => $envelope->{From}, msgto => $envelope->{To}, msgcc => $envelope->{Cc}, msgbcc => $envelope->{Bcc}, msgdate => str2time($envelope->{Date}), - msginreplyto => $envelope->{'In-Reply-To'}, - msgmessageid => $envelope->{'Message-ID'}, + msginreplyto => _trimh($envelope->{'In-Reply-To'}), + msgmessageid => _trimh($envelope->{'Message-ID'}), ); } @@ -587,6 +1297,10 @@ sub fill_messages { my $Self = shift; my @ids = @_; + return {} unless @ids; + + $Self->begin(); + my $data = $Self->dbh->selectall_arrayref("SELECT msgid, parsed FROM jrawmessage WHERE msgid IN (" . join(', ', map { "?" } @ids) . ")", {}, @ids); my %result; foreach my $line (@$data) { @@ -594,37 +1308,572 @@ sub fill_messages { } my @need = grep { not $result{$_} } @ids; - return \%result unless @need; - - my $uids = $Self->dbh->selectall_arrayref("SELECT ifolderid, uid, msgid FROM imessages WHERE msgid IN (" . join(', ', map { "?" } @need) . ")", {}, @need); my %udata; - foreach my $row (@$uids) { - $udata{$row->[0]}{$row->[1]} = $row->[2]; + if (@need) { + my $uids = $Self->dbh->selectall_arrayref("SELECT ifolderid, uid, msgid FROM imessages WHERE msgid IN (" . join(', ', map { "?" } @need) . ")", {}, @need); + foreach my $row (@$uids) { + $udata{$row->[0]}{$row->[1]} = $row->[2]; + } } - my $imap = $Self->{imap}; + my %foldermap; foreach my $ifolderid (sort keys %udata) { - my ($imapname) = $Self->dbh->selectrow_array("SELECT imapname FROM ifolders WHERE ifolderid = ?", {}, $ifolderid); my $uhash = $udata{$ifolderid}; + my $uids = join(',', sort { $a <=> $b } grep { not $result{$uhash->{$_}} } keys %$uhash); + next unless $uids; + my ($imapname, $uidvalidity) = $Self->dbh->selectrow_array("SELECT imapname, uidvalidity FROM ifolders WHERE ifolderid = ?", {}, $ifolderid); + next unless $imapname; + $foldermap{$ifolderid} = [$imapname, $uidvalidity]; + } + + # drop out of transaction to actually fetch the data + $Self->commit(); + + return \%result unless keys %udata; - die "NO folder $ifolderid" unless $imapname; - my $r = $imap->examine($imapname); + my %parsed; + foreach my $ifolderid (sort keys %udata) { + my $uhash = $udata{$ifolderid}; + my $uids = join(',', sort { $a <=> $b } grep { not $result{$uhash->{$_}} } keys %$uhash); + next unless $uids; - my $messages = $imap->fetch(join(',', sort { $a <=> $b } keys %$uhash), "rfc822"); + my $data = $foldermap{$ifolderid}; + next unless $data; - foreach my $uid (keys %$messages) { - warn "FETCHED BODY FOR $uid\n"; - my $rfc822 = $messages->{$uid}{rfc822}; + my ($imapname, $uidvalidity) = @$data; + my $res = $Self->backend_cmd('imap_fill', $imapname, $uidvalidity, $uids); + foreach my $uid (keys %{$res->{data}}) { + my $rfc822 = $res->{data}{$uid}; + next unless $rfc822; my $msgid = $uhash->{$uid}; - $result{$msgid} = $Self->add_raw_message($msgid, $rfc822); + next if $result{$msgid}; + my $eml = Email::MIME->new($rfc822); + $parsed{$msgid} = $Self->parse_message($msgid, $eml); } } + $Self->begin(); + foreach my $msgid (sort keys %parsed) { + my $message = $parsed{$msgid}; + $Self->dinsert('jrawmessage', { + msgid => $msgid, + parsed => $json->encode($message), + hasAttachment => $message->{hasAttachment}, + }); + $result{$msgid} = $parsed{$msgid}; + } + $Self->commit(); + + # XXX - handle not getting data that we need? my @stillneed = grep { not $result{$_} } @ids; return \%result; } +sub find_type { + my $message = shift; + my $part = shift; + + return $message->{type} if ($message->{id} || '') eq $part; + + foreach my $sub (@{$message->{attachments}}) { + my $type = find_type($sub, $part); + return $type if $type; + } +} + +sub get_raw_message { + my $Self = shift; + my $msgid = shift; + my $part = shift; + + $Self->begin(); + my ($imapname, $uidvalidity, $uid) = $Self->dbh->selectrow_array("SELECT imapname, uidvalidity, uid FROM ifolders JOIN imessages USING (ifolderid) WHERE msgid = ?", {}, $msgid); + $Self->commit(); + return unless $imapname; + + my $type = 'message/rfc822'; + if ($part) { + my $parsed = $Self->fill_messages($msgid); + $type = find_type($parsed->{$msgid}, $part); + } + + my $res = $Self->backend_cmd('imap_getpart', $imapname, $uidvalidity, $uid, $part); + + return ($type, $res->{data}); +} + +sub create_mailboxes { + my $Self = shift; + my $new = shift; + + return ({}, {}) unless keys %$new; + + $Self->begin(); + my %idmap; + my %notcreated; + foreach my $cid (keys %$new) { + my $mailbox = $new->{$cid}; + + my $imapname = $mailbox->{name}; + if ($mailbox->{parentId}) { + my ($parentName, $sep) = $Self->dbh->selectrow_array("SELECT imapname, sep FROM ifolders WHERE jmailboxid = ?", {}, $mailbox->{parentId}); + # XXX - errors + $imapname = "$parentName$sep$imapname"; + } + else { + my ($prefix) = $Self->dbh->selectrow_array("SELECT imapPrefix FROM iserver"); + $imapname = "$prefix$imapname"; + } + $idmap{$imapname} = $cid; # need to resolve this after the sync + } + + $Self->commit(); + + foreach my $imapname (sort keys %idmap) { + # XXX - handle errors... + my $res = $Self->backend_cmd('create_mailbox', $imapname); + } + + # (in theory we could save this until the end and resolve the names in after the renames and deletes... but it does mean + # we can't use ids as referenes...) + $Self->sync_folders() if keys %idmap; + + $Self->begin(); + my %createmap; + foreach my $imapname (keys %idmap) { + my $cid = $idmap{$imapname}; + my ($jid) = $Self->dbh->selectrow_array("SELECT jmailboxid FROM ifolders WHERE imapname = ?", {}, $imapname); + $createmap{$cid} = $jid; + } + $Self->commit(); + + return (\%createmap, \%notcreated); +} + +sub update_mailboxes { + my $Self = shift; + my $update = shift; + my $idmap = shift; + + return ([], {}) unless %$update; + + $Self->begin(); + + my @changed; + my %notchanged; + my %namemap; + # XXX - reorder the crap out of this if renaming multiple mailboxes due to deep rename + foreach my $id (keys %$update) { + my $mailbox = $update->{$id}; + my $imapname = $mailbox->{name}; + next unless (defined $imapname and $imapname ne ''); + my $parentId = $mailbox->{parentId}; + ($parentId) = $Self->dbh->selectrow_array("SELECT parentId FROM jmailboxes WHERE jmailboxid = ?", {}, $id) + unless exists $mailbox->{parentId}; + if ($parentId) { + $parentId = $idmap->($parentId); + my ($parentName, $sep) = $Self->dbh->selectrow_array("SELECT imapname, sep FROM ifolders WHERE jmailboxid = ?", {}, $parentId); + # XXX - errors + $imapname = "$parentName$sep$imapname"; + } + else { + my ($prefix) = $Self->dbh->selectrow_array("SELECT imapPrefix FROM iserver"); + $prefix = '' unless $prefix; + $imapname = "$prefix$imapname"; + } + + my ($oldname) = $Self->dbh->selectrow_array("SELECT imapname FROM ifolders WHERE jmailboxid = ?", {}, $id); + + $namemap{$oldname} = $imapname; + + push @changed, $id; + } + + $Self->commit(); + + foreach my $oldname (sort keys %namemap) { + my $imapname = $namemap{$oldname}; + $Self->backend_cmd('rename_mailbox', $oldname, $imapname) if $oldname ne $imapname; + } + + $Self->sync_folders() if @changed; + + return (\@changed, \%notchanged); +} + +sub destroy_mailboxes { + my $Self = shift; + my $destroy = shift; + + return ([], {}) unless @$destroy; + + $Self->begin(); + + my @destroyed; + my %notdestroyed; + my %namemap; + foreach my $id (@$destroy) { + my ($oldname) = $Self->dbh->selectrow_array("SELECT imapname FROM ifolders WHERE jmailboxid = ?", {}, $id); + $namemap{$oldname} = 1; + push @destroyed, $id; + } + + $Self->commit(); + + # we reverse so we delete children before parents + foreach my $oldname (reverse sort keys %namemap) { + # XXX - handle errors + $Self->backend_cmd('delete_mailbox', $oldname); + } + + $Self->sync_folders() if @destroyed; + + return (\@destroyed, \%notdestroyed); +} + +sub create_calendar_events { + my $Self = shift; + my $new = shift; + + return ({}, {}) unless keys %$new; + + $Self->begin(); + + my %todo; + my %createmap; + my %notcreated; + foreach my $cid (keys %$new) { + my $calendar = $new->{$cid}; + my ($href) = $Self->dbh->selectrow_array("SELECT href FROM icalendars WHERE icalendarid = ?", {}, $calendar->{calendarId}); + unless ($href) { + $notcreated{$cid} = {type => 'notFound', description => "No such calendar on server"}; + next; + } + my $uid = new_uuid_string(); + + $todo{$href} = {%$calendar, uid => $uid}; + + $createmap{$cid} = { id => $uid }; + } + + $Self->commit(); + + foreach my $href (sort keys %todo) { + $Self->backend_cmd('new_event', $href, $todo{$href}); + } + + return (\%createmap, \%notcreated); +} + +sub update_calendar_events { + my $Self = shift; + my $update = shift; + my $idmap = shift; + + return ([], {}) unless %$update; + + $Self->begin(); + + my %todo; + my @changed; + my %notchanged; + foreach my $uid (keys %$update) { + my $calendar = $update->{$uid}; + my ($resource) = $Self->dbh->selectrow_array("SELECT resource FROM ievents WHERE uid = ?", {}, $uid); + unless ($resource) { + $notchanged{$uid} = {type => 'notFound', description => "No such event on server"}; + next; + } + + $todo{$resource} = $calendar; + + push @changed, $uid; + } + + $Self->commit(); + + foreach my $href (sort keys %todo) { + $Self->backend_cmd('update_event', $href, $todo{$href}); + } + + return (\@changed, \%notchanged); +} + +sub destroy_calendar_events { + my $Self = shift; + my $destroy = shift; + + return ([], {}) unless @$destroy; + + $Self->begin(); + + my %todo; + my @destroyed; + my %notdestroyed; + foreach my $uid (@$destroy) { + my ($resource) = $Self->dbh->selectrow_array("SELECT resource FROM ievents WHERE uid = ?", {}, $uid); + unless ($resource) { + $notdestroyed{$uid} = {type => 'notFound', description => "No such event on server"}; + next; + } + + $todo{$resource} = 1; + + push @destroyed, $uid; + } + + $Self->commit(); + + foreach my $href (sort keys %todo) { + $Self->backend_cmd('delete_event', $href); + } + + return (\@destroyed, \%notdestroyed); +} + +sub create_contact_groups { + my $Self = shift; + my $new = shift; + + return ({}, {}) unless keys %$new; + + $Self->begin(); + + my %todo; + my %createmap; + my %notcreated; + foreach my $cid (keys %$new) { + my $contact = $new->{$cid}; + #my ($href) = $Self->dbh->selectrow_array("SELECT href FROM iaddressbooks WHERE iaddressbookid = ?", {}, $contact->{addressbookId}); + my ($href) = $Self->dbh->selectrow_array("SELECT href FROM iaddressbooks"); + unless ($href) { + $notcreated{$cid} = {type => 'notFound', description => "No such addressbook on server"}; + next; + } + my ($card) = Net::CardDAVTalk::VCard->new(); + my $uid = new_uuid_string(); + $card->uid($uid); + $card->VKind('group'); + $card->VFN($contact->{name}) if exists $contact->{name}; + if (exists $contact->{contactIds}) { + my @ids = @{$contact->{contactIds}}; + $card->VGroupContactUIDs(\@ids); + } + + $todo{$href} = $card; + + $createmap{$cid} = { id => $uid }; + } + + $Self->commit(); + + foreach my $href (sort keys %todo) { + $Self->backend_cmd('new_card', $href, $todo{$href}); + } + + return (\%createmap, \%notcreated); +} + +sub update_contact_groups { + my $Self = shift; + my $changes = shift; + my $idmap = shift; + + return ([], {}) unless %$changes; + + $Self->begin(); + + my %todo; + my @changed; + my %notchanged; + foreach my $carduid (keys %$changes) { + my $contact = $changes->{$carduid}; + my ($resource, $content) = $Self->dbh->selectrow_array("SELECT resource, content FROM icards WHERE uid = ?", {}, $carduid); + unless ($resource) { + $notchanged{$carduid} = {type => 'notFound', description => "No such card on server"}; + next; + } + my ($card) = Net::CardDAVTalk::VCard->new_fromstring($content); + $card->VKind('group'); + $card->VFN($contact->{name}) if exists $contact->{name}; + if (exists $contact->{contactIds}) { + my @ids = map { $idmap->($_) } @{$contact->{contactIds}}; + $card->VGroupContactUIDs(\@ids); + } + + $todo{$resource} = $card; + push @changed, $carduid; + } + + $Self->commit(); + + foreach my $href (sort keys %todo) { + $Self->backend_cmd('update_card', $href, $todo{$href}); + } + + return (\@changed, \%notchanged); +} + +sub destroy_contact_groups { + my $Self = shift; + my $destroy = shift; + + return ([], {}) unless @$destroy; + + $Self->begin(); + + my %todo; + my @destroyed; + my %notdestroyed; + foreach my $carduid (@$destroy) { + my ($resource, $content) = $Self->dbh->selectrow_array("SELECT resource, content FROM icards WHERE uid = ?", {}, $carduid); + unless ($resource) { + $notdestroyed{$carduid} = {type => 'notFound', description => "No such card on server"}; + next; + } + $todo{$resource} = 1; + push @destroyed, $carduid; + } + + $Self->commit(); + + foreach my $href (sort keys %todo) { + $Self->backend_cmd('delete_card', $href); + } + + return (\@destroyed, \%notdestroyed); +} + +sub create_contacts { + my $Self = shift; + my $new = shift; + + return ({}, {}) unless keys %$new; + + $Self->begin(); + + my %createmap; + my %notcreated; + my %todo; + foreach my $cid (keys %$new) { + my $contact = $new->{$cid}; + my ($href) = $Self->dbh->selectrow_array("SELECT href FROM iaddressbooks"); + unless ($href) { + $notcreated{$cid} = {type => 'notFound', description => "No such addressbook on server"}; + next; + } + my ($card) = Net::CardDAVTalk::VCard->new(); + my $uid = new_uuid_string(); + $card->uid($uid); + $card->VLastName($contact->{lastName}) if exists $contact->{lastName}; + $card->VFirstName($contact->{firstName}) if exists $contact->{firstName}; + $card->VTitle($contact->{prefix}) if exists $contact->{prefix}; + + $card->VCompany($contact->{company}) if exists $contact->{company}; + $card->VDepartment($contact->{department}) if exists $contact->{department}; + + $card->VEmails(@{$contact->{emails}}) if exists $contact->{emails}; + $card->VAddresses(@{$contact->{addresses}}) if exists $contact->{addresses}; + $card->VPhones(@{$contact->{phones}}) if exists $contact->{phones}; + $card->VOnline(@{$contact->{online}}) if exists $contact->{online}; + + $card->VNickname($contact->{nickname}) if exists $contact->{nickname}; + $card->VBirthday($contact->{birthday}) if exists $contact->{birthday}; + $card->VNotes($contact->{notes}) if exists $contact->{notes}; + + $createmap{$cid} = { id => $uid }; + $todo{$href} = $card; + } + + $Self->commit(); + + foreach my $href (sort keys %todo) { + $Self->backend_cmd('new_card', $href, $todo{$href}); + } + + return (\%createmap, \%notcreated); +} + +sub update_contacts { + my $Self = shift; + my $changes = shift; + my $idmap = shift; + + return ([], {}) unless %$changes; + + $Self->begin(); + + my %todo; + my @changed; + my %notchanged; + foreach my $carduid (keys %$changes) { + my $contact = $changes->{$carduid}; + my ($resource, $content) = $Self->dbh->selectrow_array("SELECT resource, content FROM icards WHERE uid = ?", {}, $carduid); + unless ($resource) { + $notchanged{$carduid} = {type => 'notFound', description => "No such card on server"}; + next; + } + my ($card) = Net::CardDAVTalk::VCard->new_fromstring($content); + $card->VLastName($contact->{lastName}) if exists $contact->{lastName}; + $card->VFirstName($contact->{firstName}) if exists $contact->{firstName}; + $card->VTitle($contact->{prefix}) if exists $contact->{prefix}; + + $card->VCompany($contact->{company}) if exists $contact->{company}; + $card->VDepartment($contact->{department}) if exists $contact->{department}; + + $card->VEmails(@{$contact->{emails}}) if exists $contact->{emails}; + $card->VAddresses(@{$contact->{addresses}}) if exists $contact->{addresses}; + $card->VPhones(@{$contact->{phones}}) if exists $contact->{phones}; + $card->VOnline(@{$contact->{online}}) if exists $contact->{online}; + + $card->VNickname($contact->{nickname}) if exists $contact->{nickname}; + $card->VBirthday($contact->{birthday}) if exists $contact->{birthday}; + $card->VNotes($contact->{notes}) if exists $contact->{notes}; + + $todo{$resource} = $card; + push @changed, $carduid; + } + + $Self->commit(); + + foreach my $href (sort keys %todo) { + $Self->backend_cmd('update_card', $href, $todo{$href}); + } + + return (\@changed, \%notchanged); +} + +sub destroy_contacts { + my $Self = shift; + my $destroy = shift; + + return ([], {}) unless @$destroy; + + $Self->begin(); + + my %todo; + my @destroyed; + my %notdestroyed; + foreach my $carduid (@$destroy) { + my ($resource, $content) = $Self->dbh->selectrow_array("SELECT resource, content FROM icards WHERE uid = ?", {}, $carduid); + unless ($resource) { + $notdestroyed{$carduid} = {type => 'notFound', description => "No such card on server"}; + next; + } + $todo{$resource} = 1; + push @destroyed, $carduid; + } + + $Self->commit(); + + foreach my $href (sort keys %todo) { + $Self->backend_cmd('delete_card', $href); + } + + return (\@destroyed, \%notdestroyed); +} + sub _initdb { my $Self = shift; my $dbh = shift; @@ -636,7 +1885,15 @@ sub _initdb { CREATE TABLE IF NOT EXISTS iserver ( username TEXT PRIMARY KEY, password TEXT, - hostname TEXT, + imapHost TEXT, + imapPort INTEGER, + imapSSL INTEGER, + imapPrefix TEXT, + smtpHost TEXT, + smtpPort INTEGER, + smtpSSL INTEGER, + caldavURL TEXT, + carddavURL TEXT, lastfoldersync DATE, mtime DATE NOT NULL ); @@ -674,12 +1931,72 @@ CREATE TABLE IF NOT EXISTS imessages ( mtime DATE NOT NULL ); EOF + +# not used for Gmail, but it doesn't hurt to have it $dbh->do(<do(<do(<do("CREATE INDEX IF NOT EXISTS ieventuid ON ievents (uid)"); + + $dbh->do(<do(<do("CREATE INDEX IF NOT EXISTS icarduid ON icards (uid)"); + } 1; diff --git a/JMAP/Sync/Common.pm b/JMAP/Sync/Common.pm new file mode 100644 index 0000000..316a70b --- /dev/null +++ b/JMAP/Sync/Common.pm @@ -0,0 +1,550 @@ +#!/usr/bin/perl -c + +use strict; +use warnings; + +package JMAP::Sync::Common; + +use Mail::IMAPTalk; +use Email::Simple; +use Email::Sender::Simple qw(sendmail); +use Email::Sender::Transport::SMTPS; +use Net::CalDAVTalk; +use Net::CardDAVTalk; + +my %KNOWN_SPECIALS = map { lc $_ => 1 } qw(\\HasChildren \\HasNoChildren \\NoSelect \\NoInferiors); + +sub new { + my $Class = shift; + my $auth = shift; + return bless { auth => $auth }, ref($Class) || $Class; +} + +sub DESTROY { + my $Self = shift; + if ($Self->{imap}) { + $Self->{imap}->logout(); + delete $Self->{imap}; + } +} + +sub _unselect { + my $Self = shift; + my $imap = shift; + if ($imap->capability->{unselect}) { + $imap->unselect(); + } + else { + $imap->close(); + } +} + +sub disconnect { + my $Self = shift; + if ($Self->{imap}) { + $Self->{imap}->logout(); + delete $Self->{imap}; + } +} + +sub get_calendars { + my $Self = shift; + my $talk = $Self->connect_calendars(); + return unless $talk; + + my $data = $talk->GetCalendars(Sync => 1); + + return $data; +} + +sub get_events { + my $Self = shift; + my $collection = shift; + my $talk = $Self->connect_calendars(); + return unless $talk; + + $collection =~ s{/$}{}; + my $data = $talk->GetEvents($collection, Full => 1); + + my %res; + foreach my $item (@$data) { + $res{$item->{id}} = $item->{_raw}; + } + + return \%res; +} + +sub new_event { + my $Self = shift; + my $collection = shift; # is collection of the calendar + my $event = shift; + $collection =~ s{/$}{}; + + my $talk = $Self->connect_calendars(); + return unless $talk; + + $talk->NewEvent($collection, $event); +} + +sub update_event { + my $Self = shift; + my $resource = shift; + my $event = shift; + + my $talk = $Self->connect_calendars(); + return unless $talk; + + $talk->UpdateEvent($resource, $event); +} + +sub delete_event { + my $Self = shift; + my $resource = shift; + + my $talk = $Self->connect_calendars(); + return unless $talk; + + $talk->DeleteEvent($resource); # XXX - we pass more properties for no good reason to this API +} + +sub get_addressbooks { + my $Self = shift; + my $talk = $Self->connect_contacts(); + return unless $talk; + + my $data = $talk->GetAddressBooks(Sync => 1); + + return $data; +} + +sub get_cards { + my $Self = shift; + my $collection = shift; + my $talk = $Self->connect_contacts(); + return unless $talk; + + $collection =~ s{/$}{}; + my $data = $talk->GetContacts($collection); + + my %res; + foreach my $item (@$data) { + $res{$item->{CPath}} = $item->{_raw}; + } + + return \%res; +} + +sub new_card { + my $Self = shift; + my $collection = shift; + my $card = shift; + $collection =~ s{/$}{}; + + my $talk = $Self->connect_contacts(); + return unless $talk; + + $talk->NewContact($collection, $card); +} + +sub update_card { + my $Self = shift; + my $resource = shift; + my $card = shift; + + my $talk = $Self->connect_contacts(); + return unless $talk; + + $talk->UpdateContact($resource, $card); +} + +sub delete_card { + my $Self = shift; + my $resource = shift; + + my $talk = $Self->connect_contacts(); + return unless $talk; + + $talk->DeleteContact($resource); +} + +# read folder list from the server +sub folders { + my $Self = shift; + my $force = shift; + + my $imap = $Self->connect_imap(); + + my $namespace = $imap->namespace(); + my $prefix = $namespace->[0][0][0]; + my $listcmd = $imap->capability()->{xlist} ? 'xlist' : 'list'; + my @folders = $imap->$listcmd('', '*'); + + my %folders; + foreach my $folder (@folders) { + my ($role) = grep { not $KNOWN_SPECIALS{lc $_} } @{$folder->[0]}; + my $name = $folder->[2]; + my $label; + if ($role) { + $label = $role; + } + else { + $label = $folder->[2]; + $label =~ s{^$prefix}{}; + $label =~ s{^[$folder->[1]]}{}; # just in case prefix was missing sep + } + $folders{$name} = [$folder->[1], $label]; + } + + return [$prefix, \%folders]; +} + +sub capability { + my $Self = shift; + my $imap = $Self->connect_imap(); + return $imap->capability(); +} + +sub imap_noop { + my $Self = shift; + my $folders = shift; + + my $imap = $Self->connect_imap(); + + $imap->noop(); +} + +sub imap_status { + my $Self = shift; + my $folders = shift; + + my $imap = $Self->connect_imap(); + + my @fields = qw(uidvalidity uidnext messages); + push @fields, "highestmodseq" if ($imap->capability->{condstore} or $imap->capability->{xymhighestmodseq}); + my $data = $imap->multistatus("(@fields)", @$folders); + + return $data; +} + +# no newname == delete +sub imap_update { + my $Self = shift; + my $imapname = shift; + my $olduidvalidity = shift || 0; + my $uids = shift; + my $isAdd = shift; + my $flags = shift; + + my $imap = $Self->connect_imap(); + + my $r = $imap->select($imapname); + die "SELECT FAILED $imapname" unless $r; + + my $uidvalidity = $imap->get_response_code('uidvalidity') + 0; + + my %res = ( + imapname => $imapname, + olduidvalidity => $olduidvalidity, + newuidvalidity => $uidvalidity, + ); + + if ($olduidvalidity != $uidvalidity) { + return \%res; + } + + $imap->store($uids, $isAdd ? "+flags" : "-flags", "(@$flags)"); + $Self->_unselect($imap); + + $res{updated} = $uids; + + return \%res; +} + +sub imap_fill { + my $Self = shift; + my $imapname = shift; + my $olduidvalidity = shift || 0; + my $uids = shift; + + my $imap = $Self->connect_imap(); + + my $r = $imap->examine($imapname); + die "EXAMINE FAILED $imapname" unless $r; + + my $uidvalidity = $imap->get_response_code('uidvalidity') + 0; + + my %res = ( + imapname => $imapname, + olduidvalidity => $olduidvalidity, + newuidvalidity => $uidvalidity, + ); + + if ($olduidvalidity != $uidvalidity) { + return \%res; + } + + my $data = $imap->fetch($uids, "rfc822"); + $Self->_unselect($imap); + + my %ids; + foreach my $uid (keys %$data) { + $ids{$uid} = $data->{$uid}{rfc822}; + } + $res{data} = \%ids; + return \%res; +} + +sub imap_getpart { + my $Self = shift; + my $imapname = shift; + my $olduidvalidity = shift || 0; + my $uid = shift; + my $part = shift; + + my $imap = $Self->connect_imap(); + + my $r = $imap->examine($imapname); + die "EXAMINE FAILED $imapname" unless $r; + + my $uidvalidity = $imap->get_response_code('uidvalidity') + 0; + + my %res = ( + imapname => $imapname, + olduidvalidity => $olduidvalidity, + newuidvalidity => $uidvalidity, + ); + + if ($olduidvalidity != $uidvalidity) { + return \%res; + } + + my $key = $part ? "BINARY[$part]" : "RFC822"; + my $data = $imap->fetch($uid, $key); + $Self->_unselect($imap); + + my $datakey = $part ? 'binary' : 'rfc822'; + $res{data} = $data->{$uid}{$datakey}; + + return \%res; +} + +sub imap_count { + my $Self = shift; + my $imapname = shift; + my $olduidvalidity = shift || 0; + my $uids = shift; + + my $imap = $Self->connect_imap(); + + my $r = $imap->examine($imapname); + die "EXAMINE FAILED $imapname" unless $r; + + my $uidvalidity = $imap->get_response_code('uidvalidity') + 0; + + my %res = ( + imapname => $imapname, + olduidvalidity => $olduidvalidity, + newuidvalidity => $uidvalidity, + ); + + if ($olduidvalidity != $uidvalidity) { + return \%res; + } + + my $data = $imap->search('uid', $uids); + $Self->_unselect($imap); + + $res{data} = $data; + return \%res; +} + +# no newname == delete +sub imap_move { + my $Self = shift; + my $imapname = shift; + my $olduidvalidity = shift || 0; + my $uids = shift; + my $newname = shift; + + my $imap = $Self->connect_imap(); + + my $r = $imap->select($imapname); + die "SELECT FAILED $imapname" unless $r; + + my $uidvalidity = $imap->get_response_code('uidvalidity') + 0; + + my %res = ( + imapname => $imapname, + newname => $newname, + olduidvalidity => $olduidvalidity, + newuidvalidity => $uidvalidity, + ); + + if ($olduidvalidity != $uidvalidity) { + return \%res; + } + + if ($newname) { + # move + if ($imap->capability->{move}) { + my $res = $imap->move($uids, $newname); + unless ($res) { + $res{notMoved} = $uids; + return \%res; + } + } + else { + my $res = $imap->copy($uids, $newname); + unless ($res) { + $res{notMoved} = $uids; + return \%res; + } + $imap->store($uids, "+flags", "(\\seen \\deleted)"); + $imap->uidexpunge($uids); + } + } + else { + $imap->store($uids, "+flags", "(\\seen \\deleted)"); + $imap->uidexpunge($uids); + } + $Self->_unselect($imap); + + $res{moved} = $uids; + + return \%res; +} + +sub imap_fetch { + my $Self = shift; + my $imapname = shift; + my $state = shift || {}; + my $fetch = shift || {}; + + my $imap = $Self->connect_imap(); + + my $r = $imap->examine($imapname); + die "EXAMINE FAILED $imapname" unless $r; + + my $uidvalidity = $imap->get_response_code('uidvalidity') + 0; + my $uidnext = $imap->get_response_code('uidnext') + 0; + my $highestmodseq = $imap->get_response_code('highestmodseq') || 0; + my $exists = $imap->get_response_code('exists') || 0; + + my %res = ( + imapname => $imapname, + oldstate => $state, + newstate => { + uidvalidity => $uidvalidity + 0, + uidnext => $uidnext + 0, + highestmodseq => $highestmodseq + 0, + exists => $exists + 0, + }, + ); + + if (($state->{uidvalidity} || 0) != $uidvalidity) { + warn "UIDVALID $state->{uidvalidity} $uidvalidity\n"; + $res{uidfail} = 1; + return \%res; + } + + foreach my $key (keys %$fetch) { + my $item = $fetch->{$key}; + my $from = $item->[0]; + my $to = $item->[1]; + $to = $uidnext - 1 if $to eq '*'; + next if $from > $to; + my @flags = qw(uid flags); + push @flags, @{$item->[2]} if $item->[2]; + next if ($highestmodseq and $item->[3] and $item->[3] == $highestmodseq); + my @extra; + push @extra, "(changedsince $item->[3])" if ($item->[3] and $imap->capability->{condstore}); + my $data = $imap->fetch("$from:$to", "(@flags)", @extra) || {}; + $res{$key} = [$item, $data]; + } + $Self->_unselect($imap); + + return \%res; +} + +sub imap_append { + my $Self = shift; + my $imapname = shift; + my $flags = shift; + my $internaldate = shift; + my $rfc822 = shift; + + my $imap = $Self->connect_imap(); + + my $r = $imap->append($imapname, $flags, $internaldate, {'Literal' => $rfc822}); + die "APPEND FAILED $r" unless (lc($r) eq 'ok' or lc($r) eq 'appenduid'); # what's with that?? + + my $response = $imap->get_response_code('appenduid'); + my ($uidvalidity, $uid) = @$response; + + # XXX - fetch the x-gm-msgid or envelope from the server so we know the + # the ID that the server gave this message + + return ['append', $imapname, $uidvalidity, $uid]; +} + +sub imap_search { + my $Self = shift; + my $imapname = shift; + my @expr = @_; + + my $imap = $Self->connect_imap(); + + my $r = $imap->examine($imapname); + die "EXAMINE FAILED $imapname" unless $r; + + # XXX - check uidvalidity + my $uidvalidity = $imap->get_response_code('uidvalidity') + 0; + my $uidnext = $imap->get_response_code('uidnext') + 0; + my $highestmodseq = $imap->get_response_code('highestmodseq') || 0; + my $exists = $imap->get_response_code('exists') || 0; + + if ($imap->capability->{'search=fuzzy'}) { + @expr = ('fuzzy', [@expr]); + } + + my $uids = $imap->search('charset', 'utf-8', @expr); + $Self->_unselect($imap); + + return ['search', $imapname, $uidvalidity, $uids]; +} + +sub create_mailbox { + my $Self = shift; + my $imapname = shift; + + my $imap = $Self->connect_imap(); + + $imap->create($imapname); + + return []; +} + +sub rename_mailbox { + my $Self = shift; + my $oldname = shift; + my $imapname = shift; + + my $imap = $Self->connect_imap(); + + $imap->rename($oldname, $imapname); + + return []; +} + +sub delete_mailbox { + my $Self = shift; + my $imapname = shift; + + my $imap = $Self->connect_imap(); + + $imap->delete($imapname); + + return []; +} + +1; diff --git a/JMAP/Sync/Gmail.pm b/JMAP/Sync/Gmail.pm index 6d36bae..99f0398 100644 --- a/JMAP/Sync/Gmail.pm +++ b/JMAP/Sync/Gmail.pm @@ -4,61 +4,69 @@ use strict; use warnings; package JMAP::Sync::Gmail; -use base qw(JMAP::DB); +use base qw(JMAP::Sync::Common); use Mail::GmailTalk; -use JSON::XS qw(encode_json decode_json); +use JSON::XS qw(decode_json); use Email::Simple; use Email::Sender::Simple qw(sendmail); use Email::Sender::Transport::GmailSMTP; -use Net::GmailCalendars; -use Net::GmailContacts; - -my %KNOWN_SPECIALS = map { lc $_ => 1 } qw(\\HasChildren \\HasNoChildren \\NoSelect); - -sub new { - my $Class = shift; - my $auth = shift; - return bless { auth => $auth }, ref($Class) || $Class; +use Net::CalDAVTalk; +use Net::CardDAVTalk; +use OAuth2::Tiny; +use IO::All; + +my $O; +sub O { + unless ($O) { + my $data = io->file("/home/jmap/jmap-perl/config.json")->slurp; + my $config = decode_json($data); + $O = OAuth2::Tiny->new(%$config); + } + return $O; } -sub DESTROY { +sub access_token { my $Self = shift; - if ($Self->{imap}) { - $Self->{imap}->logout(); + unless ($Self->{access_token}) { + my $refresh_token = $Self->{auth}{password}; + my $O = $Self->O(); + my $data = $O->refresh($refresh_token); + $Self->{access_token} = $data->{access_token}; } + return $Self->{access_token}; } -sub get_calendars { +sub connect_calendars { my $Self = shift; - if ($self->{calendars}) { + if ($Self->{calendars}) { $Self->{lastused} = time(); return $Self->{calendars}; } - $Self->{calendars} = Net::GmailCalendars->new( + $Self->{calendars} = Net::CalDAVTalk->new( user => $Self->{auth}{username}, - access_token => $Self->{auth}{access_token}, - url => "https://apidata.googleusercontent.com/caldav/v2", + access_token => $Self->access_token(), + url => $Self->{auth}{caldavURL}, expandurl => 1, ); return $Self->{calendars}; } -sub get_contacts { +sub connect_contacts { my $Self = shift; - if ($self->{contacts}) { + if ($Self->{contacts}) { $Self->{lastused} = time(); return $Self->{contacts}; } - $Self->{contacts} = Net::GmailContacts->new( + $Self->{contacts} = Net::CardDAVTalk->new( user => $Self->{auth}{username}, - access_token => $Self->{auth}{access_token}, - url => "https://www.googleapis.com/.well-known/carddav", + access_token => $Self->access_token(), + url => $Self->{auth}{carddavURL}, expandurl => 1, ); @@ -74,33 +82,19 @@ sub connect_imap { } for (1..3) { - $Self->log('debug', "Looking for server for $Self->{auth}{username}"); - my $port = 993; - my $usessl = $port != 143; # we use SSL for anything except default - $Self->log('debug', "getting imaptalk"); + my $port = $Self->{auth}{imapPort}; + my $usessl = 1; $Self->{imap} = Mail::GmailTalk->new( - Server => 'imap.gmail.com', + Server => $Self->{auth}{imapHost}, Port => $port, Username => $Self->{auth}{username}, - Password => $Self->{auth}{access_token}, + Password => $Self->access_token(), # not configurable right now... UseSSL => $usessl, UseBlocking => $usessl, ); next unless $Self->{imap}; - $Self->log('debug', "Connected as $Self->{auth}{username}"); $Self->{lastused} = time(); - my @folders = $Self->{imap}->xlist('', '*'); - - delete $Self->{folders}; - delete $Self->{labels}; - foreach my $folder (@folders) { - my ($role) = grep { not $KNOWN_SPECIALS{lc $_} } @{$folder->[0]}; - my $name = $folder->[2]; - my $label = $role || $folder->[2]; - $Self->{folders}{$name} = $label; - $Self->{labels}{$label} = $name; - } return $Self->{imap}; } @@ -115,119 +109,47 @@ sub send_email { sendmail($email, { from => $Self->{auth}{username}, transport => Email::Sender::Transport::GmailSMTP->new({ - host => 'smtp.gmail.com', - port => 465, + helo => $ENV{jmaphost}, + host => $Self->{auth}{smtpHost}, + port => $Self->{auth}{smtpPort}, ssl => 1, sasl_username => $Self->{auth}{username}, - access_token => $Self->{auth}{access_token}, + access_token => $Self->access_token(), }) }); } -# read folder list from the server -sub folders { - my $Self = shift; - $Self->connect_imap(); - return $Self->{folders}; -} - -sub labels { - my $Self = shift; - $Self->connect_imap(); - return $Self->{labels}; -} - -sub fetch_status { - my $Self = shift; - my $justfolders = shift; - - my $imap = $Self->connect_imap(); - - my $folders = $Self->folders; - if ($justfolders) { - my %data = map { $_ => $folders->{$_} } - grep { exists $folders->{$_} } - @$justfolders; - $folders = \%data; - } - - my $fields = "(uidvalidity uidnext highestmodseq messages)"; - my $data = $imap->multistatus($fields, sort keys %$folders); - - return $data; -} - -sub fetch_folder { +sub imap_labels { my $Self = shift; my $imapname = shift; - my $state = shift || { uidvalidity => 0 }; + my $olduidvalidity = shift || 0; + my $uids = shift; + my $labels = shift; my $imap = $Self->connect_imap(); - my $r = $imap->examine($imapname); - die "EXAMINE FAILED $r" unless (lc($r) eq 'ok' or lc($r) eq 'read-only'); - - my $uidvalidity = $imap->get_response_code('uidvalidity'); - my $uidnext = $imap->get_response_code('uidnext'); - my $highestmodseq = $imap->get_response_code('highestmodseq') || 0; - my $exists = $imap->get_response_code('exists') || 0; - - if ($state->{uidvalidity} != $uidvalidity) { - # force a delete/recreate and resync - $state = { - uidvalidity => $uidvalidity. - highestmodseq => 0, - uidnext => 0, - exists => 0, - }; - } + my $r = $imap->select($imapname); + die "SELECT FAILED $imapname" unless $r; - if ($highestmodseq and $highestmodseq == $state->{highestmodseq}) { - $Self->log('debug', "Nothing to do for $imapname at $highestmodseq"); - return {}; # yay, nothing to do - } + my $uidvalidity = $imap->get_response_code('uidvalidity') + 0; - my $changed = {}; - if ($state->{uidnext} > 1) { - my $from = 1; - my $to = $state->{uidnext} - 1; - my @extra; - push @extra, "(changedsince $state->{highestmodseq})" if $state->{highestmodseq}; - $Self->log('debug', "UPDATING $imapname: $from:$to"); - $changed = $imap->fetch("$from:$to", "(uid flags x-gm-labels)", @extra) || {}; - } + my %res = ( + imapname => $imapname, + olduidvalidity => $olduidvalidity, + newuidvalidity => $uidvalidity, + ); - my $new = {}; - if ($uidnext > $state->{uidnext}) { - my $from = $state->{uidnext}; - my $to = $uidnext - 1; # or just '*' - $Self->log('debug', "FETCHING $imapname: $from:$to"); - $new = $imap->fetch("$from:$to", '(uid flags internaldate envelope rfc822.size x-gm-msgid x-gm-thrid x-gm-labels)') || {}; + if ($olduidvalidity != $uidvalidity) { + return \%res; } - my $alluids = undef; - if ($state->{exists} + scalar(keys %$new) > $exists) { - # some messages were deleted - my $from = 1; - my $to = $uidnext - 1; - # XXX - you could do some clever UID vs position queries to bisect this out, but it - # would need more data than we have here - $Self->log('debug', "COUNTING $imapname: $from:$to (something deleted)"); - $alluids = $imap->search("UID", "$from:$to"); - } + $imap->store($uids, "x-gm-labels", "(@$labels)"); + $Self->_unselect($imap); + + $res{updated} = $uids; - return { - oldstate => $state, - newstate => { - highestmodseq => $highestmodseq, - uidvalidity => $uidvalidity. - uidnext => $uidnext, - exists => $exists, - }, - changed => $changed, - new => $new, - ($alluids ? (alluids => $alluids) : ()), - }; + return \%res; } + 1; diff --git a/JMAP/Sync/Standard.pm b/JMAP/Sync/Standard.pm new file mode 100644 index 0000000..13e196e --- /dev/null +++ b/JMAP/Sync/Standard.pm @@ -0,0 +1,109 @@ +#!/usr/bin/perl -c + +use strict; +use warnings; + +package JMAP::Sync::Standard; +use base qw(JMAP::Sync::Common); + +use Mail::IMAPTalk; +use Email::Simple; +use Email::Sender::Simple qw(sendmail); +use Email::Sender::Transport::SMTPS; +use Net::CalDAVTalk; +use Net::CardDAVTalk; + +sub connect_calendars { + my $Self = shift; + + return unless $Self->{auth}{caldavURL}; + + if ($Self->{calendars}) { + $Self->{lastused} = time(); + return $Self->{calendars}; + } + + $Self->{calendars} = Net::CalDAVTalk->new( + user => $Self->{auth}{username}, + password => $Self->{auth}{password}, + url => $Self->{auth}{caldavURL}, + expandurl => 1, + ); + + return $Self->{calendars}; +} + +sub connect_contacts { + my $Self = shift; + + return unless $Self->{auth}{carddavURL}; + + if ($Self->{contacts}) { + $Self->{lastused} = time(); + return $Self->{contacts}; + } + + $Self->{contacts} = Net::CardDAVTalk->new( + user => $Self->{auth}{username}, + password => $Self->{auth}{password}, + url => $Self->{auth}{carddavURL}, + expandurl => 1, + ); + + return $Self->{contacts}; +} + +sub connect_imap { + my $Self = shift; + my $force = shift; + + if ($Self->{imap} and not $force) { + $Self->{lastused} = time(); + return $Self->{imap}; + } + + $Self->{imap}->disconnect() if $Self->{imap}; + delete $Self->{imap}; + + for (1..3) { + my $usessl = $Self->{auth}{imapSSL} - 1; # IDs for Mail::IMAPTalk are one lower than our internal format + $Self->{imap} = Mail::IMAPTalk->new( + Server => $Self->{auth}{imapHost}, + Port => $Self->{auth}{imapPort}, + Username => $Self->{auth}{username}, + Password => $Self->{auth}{password}, + UseSSL => $usessl, + UseBlocking => $usessl, + ); + next unless $Self->{imap}; + $Self->{lastused} = time(); + return $Self->{imap}; + } + + die "Could not connect to IMAP server: $@"; +} + + +sub send_email { + my $Self = shift; + my $rfc822 = shift; + + my $ssl; + $ssl = 'ssl' if $Self->{auth}{smtpSSL} == 2; + $ssl = 'starttls' if $Self->{auth}{smtpSSL} == 3; + my $email = Email::Simple->new($rfc822); + my $detail = { + helo => $ENV{jmaphost}, + host => $Self->{auth}{smtpHost}, + port => $Self->{auth}{smtpPort}, + ssl => $ssl, + sasl_username => $Self->{auth}{username}, + sasl_password => $Self->{auth}{password}, + }; + sendmail($email, { + from => $Self->{auth}{username}, + transport => Email::Sender::Transport::SMTPS->new($detail), + }); +} + +1; diff --git a/Mail/IMAPTalk.pm b/Mail/IMAPTalk.pm deleted file mode 100755 index 9f34b90..0000000 --- a/Mail/IMAPTalk.pm +++ /dev/null @@ -1,5060 +0,0 @@ -package Mail::IMAPTalk; - -=head1 NAME - -Mail::IMAPTalk - IMAP client interface with lots of features - -=head1 SYNOPSIS - - use Mail::IMAPTalk; - - $IMAP = Mail::IMAPTalk->new( - Server => $IMAPServer, - Username => 'foo', - Password => 'bar', - ) || die "Failed to connect/login to IMAP server"; - - # Append message to folder - open(my $F, 'rfc822msg.txt'); - $IMAP->append($FolderName, $F) || dir $@; - close($F); - - # Select folder and get first unseen message - $IMAP->select($FolderName) || die $@; - $MsgId = $IMAP->search('not', 'seen')->[0]; - - # Get message envelope and print some details - $MsgEV = $IMAP->fetch($MsgId, 'envelope')->{$MsgId}->{envelope}; - print "From: " . $MsgEv->{From}; - print "To: " . $MsgEv->{To}; - print "Subject: " . $MsgEv->{Subject}; - - # Get message body structure - $MsgBS = $IMAP->fetch($MsgId, 'bodystructure')->{$MsgId}->{bodystructure}; - - # Find imap part number of text part of message - $MsgTxtHash = Mail::IMAPTalk::find_message($MsgBS); - $MsgPart = $MsgTxtHash->{text}->{'IMAP-Partnum'}; - - # Retrieve message text body - $MsgTxt = $IMAP->fetch($MsgId, "body[$MsgPart]")->{$MsgId}->{body}; - - $IMAP->logout(); - -=head1 DESCRIPTION - -This module communicates with an IMAP server. Each IMAP server command -is mapped to a method of this object. - -Although other IMAP modules exist on CPAN, this has several advantages -over other modules. - -=over 4 - -=item * - -It parses the more complex IMAP structures like envelopes and body -structures into nice Perl data structures. - -=item * - -It correctly supports atoms, quoted strings and literals at any -point. Some parsers in other modules aren't fully IMAP compatiable -and may break at odd times with certain messages on some servers. - -=item * - -It allows large return values (eg. attachments on a message) -to be read directly into a file, rather than into memory. - -=item * - -It includes some helper functions to find the actual text/plain -or text/html part of a message out of a complex MIME structure. -It also can find a list of attachements, and CID links for HTML -messages with attached images. - -=item * - -It supports decoding of MIME headers to Perl utf-8 strings automatically, -so you don't have to deal with MIME encoded headers (enabled optionally). - -=back - -While the IMAP protocol does allow for asynchronous running of commands, this -module is designed to be used in a synchronous manner. That is, you issue a -command by calling a method, and the command will block until the appropriate -response is returned. The method will then return the parsed results from -the given command. - -=cut - -# Export {{{ -require Exporter; -@ISA = qw(Exporter); -%EXPORT_TAGS = ( - Default => [ qw(get_body_part find_message build_cid_map generate_cid) ] -); -Exporter::export_ok_tags('Default'); - -my $AlwaysTrace = 0; - -sub import { - # Test for special case if need UTF8 support - our $AlreadyLoadedEncode; - my $Class = shift(@_); - - my %Parameters = map { $_ => 1 } @_; - - if (delete($Parameters{':utf8support'})) { - if (!$AlreadyLoadedEncode) { - eval "use Encode qw(decode decode_utf8);"; - $AlreadyLoadedEncode = 1; - } - } - - if (delete($Parameters{':trace'})) { - $AlwaysTrace = 1; - } - - @_ = ($Class, keys(%Parameters)); - - goto &Exporter::import; -} - -our $VERSION = '2.01'; -# }}} - -# Use modules {{{ -use Fcntl qw(:DEFAULT); -use Socket; -use IO::Select; -use IO::Handle; -use IO::Socket; -use Digest; -use Data::Dumper; - -# Choose the best socket class to use (all of these are sub-classes of IO::Socket) -my $DefSocketClass; -BEGIN { - for (qw(IO::Socket::IP IO::Socket::INET6 IO::Socket::INET)) { - if (eval "use $_; 1;") { $DefSocketClass = $_; last; } - } -} - -# Use Time::HiRes if available to handle select restarts -eval 'use Time::HiRes qw(time);'; - -use strict; -use warnings; -# }}} - -=head1 CLASS OVERVIEW - -The object methods have been broken in several sections. - -=head2 Sections - -=over 4 - -=item CONSTANTS - -Lists the available constants the class uses. - -=item CONSTRUCTOR - -Explains all the options available when constructing a new instance of the -C class. - -=item CONNECTION CONTROL METHODS - -These are methods which control the overall IMAP connection object, such -as logging in and logging out, how results are parsed, how folder names and -message id's are treated, etc. - -=item IMAP FOLDER COMMAND METHODS - -These are methods to inspect, add, delete and rename IMAP folders on -the server. - -=item IMAP MESSAGE COMMAND METHODS - -These are methods to retrieve, delete, move and add messages to/from -IMAP folders. - -=item HELPER METHODS - -These are extra methods that users of this class might find useful. They -generally do extra parsing on returned structures to provide higher -level functionality. - -=item INTERNAL METHODS - -These are methods used internally by the C object to get work -done. They may be useful if you need to extend the class yourself. Note that -internal methods will always 'die' if they encounter any errors. - -=item INTERNAL SOCKET FUNCTIONS - -These are functions used internally by the C object -to read/write data to/from the IMAP connection socket. The class does -its own buffering so if you want to read/write to the IMAP socket, you -should use these functions. - -=item INTERNAL PARSING FUNCTIONS - -These are functions used to parse the results returned from the IMAP server -into Perl style data structures. - -=back - -=head2 Method results - -All methods return undef on failure. There are four main modes of failure: - -=over 4 - -=item 1. An error occurred reading/writing to a socket. Maybe the server -closed it, or you're not connected to any server. - -=item 2. An error occurred parsing the response of an IMAP command. This is -usually only a problem if your IMAP server returns invalid data. - -=item 3. An IMAP command didn't return an 'OK' response. - -=item 4. The socket read operation timed out waiting for a response from -the server. - -=back - -In each case, some readable form of error text is placed in $@, or you -can call the C method. For commands which return -responses (e.g. fetch, getacl, etc), the result is returned. See each -command for details of the response result. For commands -with no response but which succeed (e.g. setacl, rename, etc) the result -'ok' is generally returned. - -=head2 Method parameters - -All methods which send data to the IMAP server (e.g. C, C, -etc) have their arguments processed before they are sent. Arguments may be -specified in several ways: - -=over 4 - -=item B - -The value is first checked and quoted if required. Values containing -[\000\012\015] are turned into literals, values containing -[\000-\040\{\} \%\*\"] are quoted by surrounding with a "..." pair -(any " themselves are turned into \"). undef is turned into NIL - -=item B - -The contents of the file is sent as an IMAP literal. Note that -because IMAPTalk has to know the length of the file being sent, -this must be a true file reference that can be seeked and not -just some stream. The entire file will be sent regardless of the -current seek point. - -=item B - -The string/data in the referenced item should be sent as is, no quoting will -occur, and the data won't be sent as quoted or as a literal regardless -of the contents of the string/data. - -=item B - -Emits an opening bracket, and then each item in the array separated -by a space, and finally a closing bracket. Each item in the array -is processed by the same methods, so can be a scalar, file ref, -scalar ref, another array ref, etc. - -=item B - -The hash reference should contain only 1 item. The key is a text -string which specifies what to do with the value item of the hash. - -=over 4 - -=item * 'Literal' - -The string/data in the value is sent as an IMAP literal -regardless of the actual data in the string/data. - -=item * 'Quote' - -The string/data in the value is sent as an IMAP quoted string -regardless of the actual data in the string/data. - -=back - -Examples: - - # Password is automatically quoted to "nasty%*\"passwd" - $IMAP->login("joe", 'nasty%*"passwd'); - # Append $MsgTxt as string - $IMAP->append("inbox", { Literal => $MsgTxt }) - # Append MSGFILE contents as new message - $IMAP->append("inbox", \*MSGFILE ]) - -=back - -=cut - -=head1 CONSTANTS - -These constants relate to the standard 4 states that an IMAP connection can -be in. They are passed and returned from the C method. See RFC 3501 -for more details about IMAP connection states. - -=over 4 - -=item I - -Current not connected to any server. - -=item I - -Connected to a server, but not logged in. - -=item I - -Connected and logged into a server, but not current folder. - -=item I - -Connected, logged in and have 'select'ed a current folder. - -=back - -=cut - -# Constants for the possible states the connection can be in {{{ -# Object not connected -use constant Unconnected => 0; -# connected; not logged in -use constant Connected => 1; -# logged in; no mailbox selected -use constant Authenticated => 2; -# mailbox selected -use constant Selected => 3; - -# What a link break is on the network connection -use constant LB => "\015\012"; -use constant LBLEN => length(LB); - -# Regexps used to determine if header is MIME encoded (we remove . from -# especials because of dumb ANSI_X3.4-1968 encoding) -my $RFC2047Token = qr/[^\x00-\x1f\(\)\<\>\@\,\;\:\"\/\[\]\?\=\ ]+/; -my $NeedDecodeUTF8Regexp = qr/=\?$RFC2047Token\?$RFC2047Token\?[^\?]*\?=/; - -# Known untagged responses -my %UntaggedResponses = map { $_ => 1 } qw(exists expunge recent); - -# Default responses -my %RespDefaults = ('annotation' => 'hash', 'metadata' => 'hash', 'fetch' => 'hash', 'list' => 'array', 'lsub' => 'array', 'sort' => 'array', 'search' => 'array'); - -# }}} - -=head1 CONSTRUCTOR - -=over 4 - -=cut - -=item Inew(%Options)> - -Creates new Mail::IMAPTalk object. The following options are supported. - -=item B - -=over 4 - -=item B - -The hostname or IP address to connect to. This must be supplied unless -the B option is supplied. - -=item B - -The port number on the host to connect to. Defaults to 143 if not supplied -or 993 if not supplied and UseSSL is true. - -=item B - -If true, use an IO::Socket::SSL connection. All other SSL_* arguments -are passed to the IO::Socket::SSL constructor. - -=item B - -An existing socket to use as the connection to the IMAP server. If you -supply the B option, you should not supply a B or B -option. - -This is useful if you want to create an SSL socket connection using -IO::Socket::SSL and then pass in the connected socket to the new() call. - -It's also useful in conjunction with the C method -described below for reusing the same socket beyond the lifetime of the IMAPTalk -object. See a description in the section C method for -more information. - -You must have write flushing enabled for any -socket you pass in here so that commands will actually be sent, -and responses received, rather than just waiting and eventually -timing out. you can do this using the Perl C call and -$| ($AUTOFLUSH) variable as shown below. - - my $ofh = select($Socket); $| = 1; select ($ofh); - -=item B - -For historical reasons, when reading from a socket, the module -sets the socket to non-blocking and does a select(). If you're -using an SSL socket that doesn't work, so you have to set -UseBlocking to true to use blocking reads instead. - -=item B - -If you supply a C option, you can specify the IMAP state the -socket is currently in, namely one of 'Unconnected', 'Connected', -'Authenticated' or 'Selected'. This defaults to 'Connected' if not -supplied and the C option is supplied. - -=item B - -If supplied and true, and a socket is supplied via the C -option, checks that a greeting line is supplied by the server -and reads the greeting line. - -=back - -=item B - -=over 4 - -=item B - -The username to connect to the IMAP server as. If not supplied, no login -is attempted and the IMAP object is left in the B state. -If supplied, you must also supply the B option and a login -is attempted. If the login fails, the connection is closed and B -is returned. If you want to do something with a connection even if the -login fails, don't pass a B option, but instead use the B -method described below. - -=item B - -The password to use to login to the account. - -=back - -=item B - -=over 4 - -=item B - -Control whether message ids are message uids or not. This is 1 (on) by -default because generally that's how most people want to use it. This affects -most commands that require/use/return message ids (e.g. B, B, -B, etc) - -=item B - -If supplied, sets the root folder prefix. This is the same as calling -C with the value passed. If no value is supplied, -C is called with no value. See the C -method for more details. - -=item B - -If supplied, sets the folder name text string separator character. -Passed as the second parameter to the C method. - -=item B - -If supplied, passed along with RootFolder to the C -method. - -=item B - -If supplied, passed along with RootFolder to the C -method. - -=back - -Examples: - - $imap = Mail::IMAPTalk->new( - Server => 'foo.com', - Port => 143, - Username => 'joebloggs', - Password => 'mypassword', - Separator => '.', - RootFolder => 'inbox', - CaseInsensitive => 1) - || die "Connection to foo.com failed. Reason: $@"; - - $imap = Mail::IMAPTalk->new( - Socket => $SSLSocket, - State => Mail::IMAPTalk::Authenticated, - Uid => 0) - || die "Could not query on existing socket. Reason: $@"; - -=cut -sub new { - my $Proto = shift; - my $Class = ref($Proto) || $Proto; - my %Args = @_; - - # Two main possible new() modes. Either connect to server - # or use existing socket passed - $Args{Server} || $Args{Socket} - || die "No 'Server' or 'Socket' specified"; - $Args{Server} && $Args{Socket} - && die "Can not specify 'Server' and 'Socket' simultaneously"; - - # Set ourself to empty to start with - my $Self = {}; - bless ($Self, $Class); - - # Empty buffer - $Self->{ReadBuf} = ''; - - # Create new socket to server - my $Socket; - if ($Args{Server}) { - - # Set starting state - $Self->state(Unconnected); - - my %SocketOpts; - my $DefaultPort = 143; - my $SocketClass = $DefSocketClass; - - if (my $SSLOpt = $Args{UseSSL}) { - $SSLOpt = $SSLOpt eq '1' ? '' : " qw($SSLOpt)"; - eval "use IO::Socket::SSL$SSLOpt; 1;" || return undef; - $SocketClass = "IO::Socket::SSL"; - $DefaultPort = 993; - $SocketOpts{$_} = $Args{$_} for grep { /^SSL_/ } keys %Args; - } - - $SocketOpts{PeerHost} = $Self->{Server} = $Args{Server} || die "No Server name given"; - $SocketOpts{PeerPort} = $Self->{Port} = $Args{Port} || $DefaultPort; - - $Socket = ${SocketClass}->new(%SocketOpts) || return undef; - - # Force flushing after every write to the socket - my $ofh = select($Socket); $| = 1; select ($ofh); - - # Set to connected state - $Self->state(Connected); - } - - # We have an existing socket - else { - # Copy socket - $Socket = $Args{Socket}; - delete $Args{Socket}; - - # Set state - $Self->state(exists $Args{State} ? $Args{State} : Connected); - } - - $Self->{Socket} = $Socket; - - # Save socket for later use and create IO::Select - $Self->{Select} = IO::Select->new(); - $Self->{Select}->add($Socket); - $Self->{LocalFD} = fileno($Socket); - $Self->{UseBlocking} = $Args{UseBlocking}; - $Self->{Pedantic} = $Args{Pedantic}; - - # Do this now, so we trace greeting line as well - $Self->set_tracing($AlwaysTrace); - - # Process greeting - if ($Args{Server} || $Args{ExpectGreeting}) { - $Self->{CmdId} = "*"; - my ($CompletionResp, $DataResp) = $Self->_parse_response(''); - return undef if $CompletionResp !~ /^ok/i; - } - - # Start counter when sending commands - $Self->{CmdId} = 1; - - # Set base modes - $Self->uid(exists($Args{Uid}) ? $Args{Uid} : 1); - $Self->parse_mode(Envelope => 1, BodyStructure => 1, Annotation => 1); - $Self->{CurrentFolder} = ''; - $Self->{CurrentFolderMode} = ''; - - # Login first if specified - if ($Args{Username}) { - # If login fails, just return undef - $Self->login(@Args{'Username', 'Password'}) || return undef; - } - - # Set root folder and separator (if supplied) - $Self->set_root_folder( - $Args{RootFolder}, $Args{Separator}, $Args{CaseInsensitive}, $Args{AltRootRegexp}); - - return $Self; -} - -=back -=cut - -=head1 CONNECTION CONTROL METHODS - -=over 4 -=cut - -=item I - -Attempt to login user specified username and password. - -Currently there is only plain text password login support. If someone can -give me a hand implementing others (like DIGEST-MD5, CRAM-MD5, etc) please -contact me (see details below). - -=cut -sub login { - my $Self = shift; - my ($User, $Pwd) = @_; - my $PwdArr = { 'Quote' => $Pwd }; - - # Clear cached capability responses and the like - delete $Self->{Cache}; - - # Call standard command. Return undef if login failed - $Self->_imap_cmd("login", 0, "", $User, $PwdArr) - || return undef; - - # Set to authenticated if successful - $Self->state(Authenticated); - - return 1; -} - -=item I - -Log out of IMAP server. This usually closes the servers connection as well. - -=cut -sub logout { - my $Self = shift; - # Callback to say we're switching folders - $Self->cb_switch_folder($Self->{CurrentFolder}, ''); - $Self->_imap_cmd('logout', 0, ''); - # Returns the socket, which we immediately discard to close - $Self->release_socket(1); - return 1; -} - -=item I - -Set/get the current IMAP connection state. Returned or passed value should be -one of the constants (Unconnected, Connected, Authenticated, Selected). - -=cut -sub state { - my $Self = shift; - $Self->{State} = $_[0] if defined $_[0]; - return (defined($Self->{State}) ? $Self->{State} : ''); -} - -=item I - -Get/set the UID status of all UID possible IMAP commands. -If set to 1, all commands that can take a UID are set to 'UID Mode', -where any ID sent to IMAPTalk is assumed to be a UID. - -=cut -sub uid { - $_[0]->{Uid} = $_[1]; - return 1; -} - -=item I - -This method returns the IMAP servers capability command results. -The result is a hash reference of (lc(Capability) => 1) key value pairs. -This means you can do things like: - - if ($IMAP->capability()->{quota}) { ... } - -to test if the server has the QUOTA capability. If you just want a list of -capabilities, use the Perl 'keys' function to get a list of keys from the -returned hash reference. - -=cut -sub capability { - my $Self = shift; - - # If we've already executed the capability command once, just return the results - return $Self->{Cache}->{capability} - if exists $Self->{Cache}->{capability}; - - # Otherwise execute capability command - my $Capability = $Self->_imap_cmd("capability", 0, "capability"); - - # Better be a hash-ref... - ($Capability && ref($Capability) eq 'HASH') || return {}; - - # Save for any future queries and return - return ($Self->{Cache}->{capability} = $Capability); -} - -=item I - -Returns the result of the IMAP servers namespace command. - -=cut -sub namespace { - my $Self = shift; - - # If we've already executed the capability command once, just return the results - return $Self->{Cache}->{namespace} - if exists $Self->{Cache}->{namespace}; - - $Self->_require_capability('namespace') || return undef; - - # Otherwise execute capability command - my $Namespace = $Self->_imap_cmd("namespace", 0, "namespace"); - - # Save for any future queries and return - return ($Self->{Cache}->{namespace} = $Namespace); -} - -=item I - -Perform the standard IMAP 'noop' command which does nothing. - -=cut -sub noop { - my $Self = shift; - return $Self->_imap_cmd("noop", 0, "", @_); -} - -=item I - -Enabled the given imap extension - -=cut -sub enable { - my $Self = shift; - my $Feature = shift; - - # If we've already executed the enable command once, just return the results - return $Self->{Cache}->{enable}->{$Feature} - if exists $Self->{Cache}->{enable}->{$Feature}; - - $Self->_require_capability($Feature) || return undef; - - my $Result = $Self->_imap_cmd("enable", 0, "enabled", $Feature); - $Self->{Cache}->{enable} = $Result; - - return $Result && $Result->{$Feature}; -} - -=item I - -Returns true if the current socket connection is still open (e.g. the socket -hasn't been closed this end or the other end due to a timeout). - -=cut -sub is_open { - my $Self = shift; - - $Self->_trace("A: is_open test\n") if $Self->{Trace}; - - while (1) { - - # Ensure no data was left in our own read buffer - if ($Self->{ReadLine}) { - $Self->_trace("A: unexpected data in read buffer - '" .$Self->{ReadLine}. "'\n") - if $Self->{Trace}; - die "IMAPTalk: Unexpected data in read buffer '" . $Self->{ReadLine} . "'"; - } - $Self->{ReadLine} = undef; - - # See if there's any data to read - local $Self->{Timeout} = 0; - - # If no sockets with data, must be blocked, so must be connected - my $Atom = eval { $Self->_next_atom(); }; - - # If a timeout, socket is still connected and open - if ($@ && ($@ =~ /timed out/)) { - $Self->_trace("A: is_open test received timeout, still open\n") - if $Self->{Trace}; - return 1; - } - - # Other error, assume it's closed - if ($@) { - $Self->_trace("A: is_open test received error - $@\n") - if $Self->{Trace}; - $Self->{Socket}->close() if $Self->{Socket}; - $Self->{Socket} = undef; - $Self->state(Unconnected); - return undef; - } - - # There was something, find what it was - $Atom = $Self->_remaining_line(); - - $Self->_trace("A: is_open test returned data - '$Atom'\n") - if $Self->{Trace}; - - $Atom || die "IMAPTalk: Unexpected response while checking connection - $Atom"; - - # If it's a bye, we're being closed - if ($Atom =~ /^bye/i) { - $Self->_trace("A: is_open test received 'bye' response\n") - if $Self->{Trace}; - $Self->{Socket}->close(); - $Self->{Socket} = undef; - $Self->state(Unconnected); - return undef; - } - - # Otherwise it was probably some sort of alert, - # check again - } - -} - -=item I - -Change the root folder prefix. Some IMAP servers require that all user -folders/mailboxes live under a root folder prefix (current versions of -B for example use 'INBOX' for personal folders and 'user' for other -users folders). If no value is specified, it sets it to ''. You might -want to use the B method to find out what roots are -available. The $CaseInsensitive argument is a flag that determines -whether the root folder should be matched in a case sensitive or -insensitive way. See below. - -Setting this affects all commands that take a folder argument. Basically -if the foldername begins with root folder prefix (case sensitive or -insensitive based on the second argument), it's left as is, -otherwise the root folder prefix and separator char are prefixed to the -folder name. - -The AltRootRegexp is a regexp that if the start of the folder name matches, -does not have $RootFolder preprended. You can use this to protect -other namespaces in your IMAP server. - -Examples: - - # This is what cyrus uses - $IMAP->set_root_folder('inbox', '.', 1, 'user'); - - # Selects 'Inbox' (because 'Inbox' eq 'inbox' case insensitive) - $IMAP->select('Inbox'); - # Selects 'inbox.blah' - $IMAP->select('blah'); - # Selects 'INBOX.fred' (because 'INBOX' eq 'inbox' case insensitive) - #IMAP->select('INBOX.fred'); # Selects 'INBOX.fred' - # Selects 'user.john' (because 'user' is alt root) - #IMAP->select('user.john'); # Selects 'user.john' - -=cut -sub set_root_folder { - my ($Self, $RootFolder, $Separator, $CaseInsensitive, $AltRootRegexp) = @_; - - $RootFolder = '' if !defined($RootFolder); - $Separator = '' if !defined($Separator); - $AltRootRegexp = '' if !defined($AltRootRegexp); - - # Strip of the Separator, if the IMAP-Server already appended it - $RootFolder =~ s/\Q$Separator\E$//; - - $Self->{RootFolder} = $RootFolder; - $Self->{AltRootRegexp} = $AltRootRegexp; - $Self->{Separator} = $Separator; - $Self->{CaseInsensitive} = $CaseInsensitive; - - # A little tricky. We want to promote INBOX.blah -> blah, but - # we have to be careful not to loose things like INBOX.inbox - # which we leave alone - - # INBOX -> INBOX - # INBOX.blah -> blah - # INBOX.inbox -> INBOX.inbox - # INBOX.INBOX -> INBOX.INBOX - # INBOX.inbox.inbox -> INBOX.inbox.inbox - # INBOX.inbox.blah -> INBOX.blah - # user.xyz -> user.xyz - - # RootFolderMatch - # If folder passed in doesn't match this, then prepend $RootFolder . $Separator - # eg prepend inbox. if folder !/^inbox(\.inbox)*$|^user$|^user\./ - - # UnrootFolderMatch - # If folder returned matches this, strip $RootFolder . $Separator - # eg strip inbox. if folder /^inbox\.(?!inbox(\.inbox)*)/ - - my ($RootFolderMatch, $UnrootFolderMatch, $RootFolderNormalise); - if ($RootFolder) { - if ($CaseInsensitive) { - $RootFolderMatch = qr/\Q${RootFolder}\E(?i:\Q${Separator}${RootFolder}\E)*/i; - $UnrootFolderMatch = qr/^\Q${RootFolder}${Separator}\E(?!${RootFolderMatch}$)/i; - $RootFolderNormalise = qr/^\Q${RootFolder}\E(\Q${Separator}\E|$)/i; - } else { - $RootFolderMatch = qr/\Q${RootFolder}\E(?:\Q${Separator}${RootFolder}\E)*/; - $UnrootFolderMatch = qr/^\Q${RootFolder}${Separator}\E(?!${RootFolderMatch}$)/; - $RootFolderNormalise = qr/^\Q${RootFolder}(?:\Q${Separator}\E|$)/; - } - - $RootFolderMatch = qr/^${RootFolderMatch}$/; - if ($AltRootRegexp) { - $RootFolderMatch = qr/$RootFolderMatch|^(?:${AltRootRegexp})$|^(?:${AltRootRegexp})\Q${Separator}\E/; - } - - } - @$Self{qw(RootFolderMatch UnrootFolderMatch RootFolderNormalise)} - = ($RootFolderMatch, $UnrootFolderMatch, $RootFolderNormalise); - - return 1; -} - -=item I<_set_separator($Separator)> - -Checks if the given separator is the same as the one we used before. -If not, it calls set_root_folder to recreate the settings with the new -Separator. - -=cut -sub _set_separator { - my ($Self,$Separator) = @_; - - #Nothing to do, if we have the same Separator as before - return 1 if (defined($Separator) && ($Self->{Separator} eq $Separator)); - return $Self->set_root_folder($Self->{RootFolder}, $Separator, - $Self->{CaseInsensitive}, $Self->{AltRootRegexp}); -} - -=item I - -Sets the mode whether to read literals as file handles or scalars. - -You should pass a filehandle here that any literal will be read into. To -turn off literal reads into a file handle, pass a 0. - -Examples: - - # Read rfc822 text of message 3 into file - # (note that the file will have /r/n line terminators) - open(F, ">messagebody.txt"); - $IMAP->literal_handle_control(\*F); - $IMAP->fetch(3, 'rfc822'); - $IMAP->literal_handle_control(0); - -=cut -sub literal_handle_control { - my $Self = shift; - $Self->{LiteralControl} = $_[0] if defined $_[0]; - return $Self->{LiteralControl} ? 1 : 0; -} - -=item I - -Release IMAPTalk's ownership of the current socket it's using so it's not -disconnected on DESTROY. This returns the socket, and makes sure that the -IMAPTalk object doesn't hold a reference to it any more and the connection -state is set to "Unconnected". - -This means you can't call any methods on the IMAPTalk object any more. - -If the socket is being released and being closed, then $Close is set to true. - -=cut -sub release_socket { - my $Self = shift; - - # Remove from the select object - $Self->{Select}->remove($Self->{Socket}) if ref($Self->{Select}); - my $Socket = $Self->{Socket}; - - # Delete any knowledge of the socket in our instance - delete $Self->{Socket}; - delete $Self->{Select}; - - $Self->_trace("A: Release socket, fileno=" . fileno($Socket) . "\n") - if $Self->{Trace}; - - # Set into no connection state - $Self->state(Mail::IMAPTalk::Unconnected); - - return $Socket; -} - -=item I - -Returns a text string which describes the last error that occurred. - -=cut -sub get_last_error { - my $Self = shift; - return $Self->{LastError}; -} - -=item I - -Returns the last completion response to the tagged command. - -This is either the string "ok", "no" or "bad" (always lower case) - -=cut -sub get_last_completion_response { - my $Self = shift; - return $Self->{LastRespCode}; -} - -=item I - -Returns the extra response data generated by a previous call. This is -most often used after calling B - - - User - + Email + - Pass - + Password + Submit - +

The JMAP proxy is a work in a progress. It is currently stable enough to test out and get a feel for JMAP in action. All the methods in the spec are implemented, though some atomic guarantees are not possible with other users accessing your servers at the same time

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
APIComments
getMailboxesComplete. Says you can't create child mailboxes or delete it, because setMailboxes doesn't exist.
getMailboxUpdatesComplete.
setMailboxesNot Implemented.
getMessageList and getMessageListUpdatesPartial. Many sorts and filters aren't supported. Sort by date and filter by mailbox work.
getMessages and getMessageUpdatesPartial. Attachment handling and HTML escaping is incomplete
setMessagesPartial. Can change isUnread and isFlagged, and change inMailboxes (move messages). No compose support
getThreads and getThreadUpdatesComplete. Not the most efficient implementation, but working fine
+

The eventual goal is to have a proxy you can stick in front of any IMAP server and get a usable JMAP out the other end. The proxy supports Gmail and modern IMAP implementations (it will be quite inefficient if they don't implement CONDSTORE). Source code is available on GitHub and is MIT licensed.

- +

The web client hooked up for this demo is a simple example (no compose, contacts, calendars). It is also MIT licenced and available on GitHub. The code is unminified, so takes much longer to initially load than it would in a production setting, but can be viewed with standard web-dev tools. These can also show the data exchanges being made to load the data and get delta updates.

+ +

The service is not running with all of the security measures employed on a production site such as FastMail, so DO NOT USE THIS PROXY FOR ACCOUNTS WITH SENSITIVE DATA.

+ +

When you create your account, the most recent 50 emails will be downloaded in their entirety, so the first page should be snappy immediately. After that, you are redirected to the landing page. A background task will continue to pull in batches of messages and add them to your account, so you will see older messages appear while you are using the interface.

+ + diff --git a/htdocs/landing.html b/htdocs/landing.html index 2838445..a8d4a73 100644 --- a/htdocs/landing.html +++ b/htdocs/landing.html @@ -3,24 +3,35 @@ - + JMAP Proxy -
+ +
+ + +Fork me on GitHub +
+

Good work, your JMAP proxy account is now set up

-

$INFO - (back to main page)

+

[% info %] - (back to proxy login page)

-

To access the account, POST with the JMAP protocol to https://proxy.jmap.io/jmap/$UUID/ - there is no need to use any other form of authentication, the UUID is used by itself for privacy. Yes, we know this isn't enough security for a public service (and we need to implement the JMAP auth spec!), but it will do for testing.

+

Access your account with the open source client.

-

Alternatively, you can use the FastMail web client example. Please bookmark this launch page first, as the client link may change. You can always get to it via here!

+

You can also POST with the JMAP protocol to https://[% jmaphost %]/jmap/[% uuid %]/ – there is no need to use any other form of authentication, the UUID is used by itself for privacy. Yes, we know this isn't enough security for a public service (and we need to implement the JMAP auth spec!), but it will do for testing.

-

Please note: it may take a few minutes before the API responds to requests, because it needs to do an initial sync of all mailbox envelope data.

- -

If you need to reset your account or want to delete all your data, please go to https://proxy.jmap.io/delete/$UUID. It will redirect you to the homepage when the account is wiped.

+

Please note: it may take a few minutes before the API responds to requests, because it needs to do an initial sync of mailbox envelope data.

+

If you need to reset your account or want to delete all your data, please go to https://[% jmaphost %]/delete/[% uuid %]. It will redirect you to the homepage when the account is wiped.

diff --git a/htdocs/main.css b/htdocs/main.css index 6c01802..90125df 100644 --- a/htdocs/main.css +++ b/htdocs/main.css @@ -13,7 +13,7 @@ blockquote { html { background: #fff; color: #1f1f1f; - font: 15px/1.55 "Open Sans", "Helvetica Neue", Arial, sans-serif; + font: 16px/1.55 "Source Sans Pro", "Helvetica Neue", Arial, sans-serif; } table { margin: 10px 0 15px 0; @@ -45,9 +45,9 @@ h3, h4, h5, h6 { - color: #404040; - line-height: 1.2; margin: 15px 0; + line-height: 1.2; + color: #404040; } h1 { border-bottom: 1px solid #eee; @@ -76,24 +76,24 @@ li { margin: 5px 0; } blockquote { - padding: 13px 13px 21px 15px; margin-bottom: 18px; + padding: 13px 13px 21px 15px; font-family:georgia,serif; font-style: italic; } blockquote:before { content:"\201C"; - font-size:40px; margin-left:-10px; - font-family:georgia,serif; color:#eee; + font-family:georgia,serif; + font-size:40px; } blockquote p { - font-size: 14px; - font-weight: 300; - line-height: 18px; margin-bottom: 0; + line-height: 18px; + font-size: 15px; font-style: italic; + font-weight: 300; } code, pre { font-family: Menlo, Monaco, Andale Mono, Courier New, monospace; @@ -150,8 +150,8 @@ sup { top: 0; left: 0; right: 0; - height: 44px; - line-height: 44px; + height: 49px; + line-height: 49px; border-bottom: 1px solid #1f1f1f; background: #366683; color: #fff; @@ -159,7 +159,7 @@ sup { #logo { padding: 0 30px; font-size: 32px; - font-weight: bold; + font-weight: 600; } #nav { position: absolute; @@ -182,6 +182,7 @@ sup { margin: 0 3px; padding: 0 10px; color: #fff; + font-size: 17px; text-decoration: none; } .nav-link:hover { @@ -198,14 +199,14 @@ sup { } #last-update { margin: -7px 0 15px; - font-size: 13px; + font-size: 14px; text-align: center; } /* Sidebar (Table of Contents) */ aside { position: fixed; overflow: auto; - top: 45px; + top: 50px; bottom: 0; width: 229px; border-right: 1px solid #eee; @@ -216,7 +217,7 @@ sup { margin: 0; padding: 15px 0; list-style: none; - font-size: 13px; + font-size: 14px; } .toc-selected { position: absolute; diff --git a/htdocs/signup.html b/htdocs/signup.html new file mode 100644 index 0000000..469ea52 --- /dev/null +++ b/htdocs/signup.html @@ -0,0 +1,76 @@ + + + + + + + +JMAP Proxy + + +
+ + +Fork me on GitHub +
+
+ +

Set hosts

+ +Please confirm host details below. + +
+ + + + + + + + + + + + + + + + + + + + + +
IMAP + + + +
SMTP + + + +
CalDAV
CardDAV
Submit + + + + +
+
+ +
+ + diff --git a/nginx.conf b/nginx.conf index 62c5573..8f7b902 100644 --- a/nginx.conf +++ b/nginx.conf @@ -1,118 +1,118 @@ server { - listen 80; - server_name proxy.jmap.io; - location / { - rewrite ^/$ https://proxy.jmap.io/ redirect; - } + listen 80; + server_name proxy.jmap.io; + location / { + rewrite ^/$ https://proxy.jmap.io/ redirect; + } } server { - listen 443; - - ssl on; - ssl_certificate /etc/ssl/certs/proxy.jmap.io.crt; - ssl_certificate_key /etc/ssl/private/proxy.jmap.io.key; - - root /home/jmap/jmap-perl/htdocs/; - index index.html index.htm; - - server_name proxy.jmap.io; - - location / { - # First attempt to serve request as file, then - # as directory, then fall back to displaying a 404. - try_files $uri $uri/ /index.html; - } - - location = / { - if ( $request_method = 'OPTIONS' ) { - add_header 'Access-Control-Allow-Origin' '*'; - # -D GAPING_SECURITY_HOLE - add_header 'Access-Control-Allow-Headers' $http_access_control_request_headers; - add_header 'Access-Control-Allow-Methods' 'POST, GET, OPTIONS'; - add_header 'Access-Control-Max-Age' 600; - add_header 'Content-Type' 'text/plain; charset=UTF-8'; - add_header 'Content-Length' 0; - return 204; - } - # First attempt to serve request as file, then - # as directory, then fall back to displaying a 404. - proxy_pass http://127.0.0.1:9000/home; - } - - location /events/ { - if ( $request_method = 'OPTIONS' ) { - add_header 'Access-Control-Allow-Origin' '*'; - # -D GAPING_SECURITY_HOLE - add_header 'Access-Control-Allow-Headers' $http_access_control_request_headers; - add_header 'Access-Control-Allow-Methods' 'POST, GET, OPTIONS'; - add_header 'Access-Control-Max-Age' 600; - add_header 'Content-Type' 'text/plain; charset=UTF-8'; - add_header 'Content-Length' 0; - return 204; - } - # Immediately send backend responses back to client - proxy_buffering off; - # Disable keepalive to browser - keepalive_timeout 0; - # It's a long lived backend connection with potentially a long time between - # push events, make sure proxy doesn't timeout - proxy_read_timeout 7200; - - proxy_pass http://127.0.0.1:9001/events/; - } - - location /files/ { - proxy_pass http://127.0.0.1:9000/files/; - } - - location /jmap/ { - if ( $request_method = 'OPTIONS' ) { - add_header 'Access-Control-Allow-Origin' '*'; - # -D GAPING_SECURITY_HOLE - add_header 'Access-Control-Allow-Headers' $http_access_control_request_headers; - add_header 'Access-Control-Allow-Methods' 'POST, GET, OPTIONS'; - add_header 'Access-Control-Max-Age' 600; - add_header 'Content-Type' 'text/plain; charset=UTF-8'; - add_header 'Content-Length' 0; - return 204; - } - proxy_pass http://127.0.0.1:9000/jmap/; - } - - location /upload/ { - proxy_pass http://127.0.0.1:9000/upload/; - } - - location /raw/ { - proxy_pass http://127.0.0.1:9000/raw/; - } - - location /A { - proxy_pass http://127.0.0.1:9000/A; - } - - location /J { - proxy_pass http://127.0.0.1:9000/J; - } - - location /U { - proxy_pass http://127.0.0.1:9000/U; - } - - location /register { - proxy_pass http://127.0.0.1:9000/register; - } - - location /signup { - proxy_pass http://127.0.0.1:9000/signup; - } - - location /delete { - proxy_pass http://127.0.0.1:9000/delete; - } - - location /cb { - proxy_pass http://127.0.0.1:9000/cb; - } + listen 443; + + ssl on; + ssl_certificate /etc/ssl/certs/proxy.jmap.io.crt; + ssl_certificate_key /etc/ssl/private/proxy.jmap.io.key; + + root /home/jmap/jmap-perl/htdocs/; + index index.html index.htm; + + server_name proxy.jmap.io; + + location / { + # First attempt to serve request as file, then + # as directory, then fall back to displaying a 404. + try_files $uri $uri/ /index.html; + } + + location = / { + if ( $request_method = 'OPTIONS' ) { + add_header 'Access-Control-Allow-Origin' '*'; + # -D GAPING_SECURITY_HOLE + add_header 'Access-Control-Allow-Headers' $http_access_control_request_headers; + add_header 'Access-Control-Allow-Methods' 'POST, GET, OPTIONS'; + add_header 'Access-Control-Max-Age' 600; + add_header 'Content-Type' 'text/plain; charset=UTF-8'; + add_header 'Content-Length' 0; + return 204; + } + # First attempt to serve request as file, then + # as directory, then fall back to displaying a 404. + proxy_pass http://127.0.0.1:9000/home; + } + + location /events/ { + if ( $request_method = 'OPTIONS' ) { + add_header 'Access-Control-Allow-Origin' '*'; + # -D GAPING_SECURITY_HOLE + add_header 'Access-Control-Allow-Headers' $http_access_control_request_headers; + add_header 'Access-Control-Allow-Methods' 'POST, GET, OPTIONS'; + add_header 'Access-Control-Max-Age' 600; + add_header 'Content-Type' 'text/plain; charset=UTF-8'; + add_header 'Content-Length' 0; + return 204; + } + # Immediately send backend responses back to client + proxy_buffering off; + # Disable keepalive to browser + keepalive_timeout 0; + # It's a long lived backend connection with potentially a long time between + # push events, make sure proxy doesn't timeout + proxy_read_timeout 7200; + + proxy_pass http://127.0.0.1:9001/events/; + } + + location /files/ { + proxy_pass http://127.0.0.1:9000/files/; + } + + location /jmap/ { + if ( $request_method = 'OPTIONS' ) { + add_header 'Access-Control-Allow-Origin' '*'; + # -D GAPING_SECURITY_HOLE + add_header 'Access-Control-Allow-Headers' $http_access_control_request_headers; + add_header 'Access-Control-Allow-Methods' 'POST, GET, OPTIONS'; + add_header 'Access-Control-Max-Age' 600; + add_header 'Content-Type' 'text/plain; charset=UTF-8'; + add_header 'Content-Length' 0; + return 204; + } + proxy_pass http://127.0.0.1:9000/jmap/; + } + + location /upload/ { + proxy_pass http://127.0.0.1:9000/upload/; + } + + location /raw/ { + proxy_pass http://127.0.0.1:9000/raw/; + } + + location /A { + proxy_pass http://127.0.0.1:9000/A; + } + + location /J { + proxy_pass http://127.0.0.1:9000/J; + } + + location /U { + proxy_pass http://127.0.0.1:9000/U; + } + + location /register { + proxy_pass http://127.0.0.1:9000/register; + } + + location /signup { + proxy_pass http://127.0.0.1:9000/signup; + } + + location /delete { + proxy_pass http://127.0.0.1:9000/delete; + } + + location /cb { + proxy_pass http://127.0.0.1:9000/cb; + } }