]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/IMAP.pm
imap: support LSUB command
[public-inbox.git] / lib / PublicInbox / IMAP.pm
index 2aa7ab346c1fb1462cdc3391906d513047e84796..51ab8b8c2f2eae4e9c11dee582cd2af9383ddc2e 100644 (file)
@@ -21,8 +21,10 @@ use PublicInbox::Eml;
 use PublicInbox::EmlContentFoo qw(parse_content_disposition);
 use PublicInbox::DS qw(now);
 use PublicInbox::Syscall qw(EPOLLIN EPOLLONESHOT);
+use PublicInbox::GitAsyncCat;
 use Text::ParseWords qw(parse_line);
 use Errno qw(EAGAIN);
+
 my $Address;
 for my $mod (qw(Email::Address::XS Mail::Address)) {
        eval "require $mod" or next;
@@ -33,9 +35,6 @@ die "neither Email::Address::XS nor Mail::Address loaded: $@" if !$Address;
 sub LINE_MAX () { 512 } # does RFC 3501 have a limit like RFC 977?
 
 my %FETCH_NEED_BLOB = ( # for future optimization
-       'BODY.PEEK[HEADER]' => 1,
-       'BODY.PEEK[TEXT]' => 1,
-       'BODY.PEEK[]' => 1,
        'BODY[HEADER]' => 1,
        'BODY[TEXT]' => 1,
        'BODY[]' => 1,
@@ -124,6 +123,12 @@ sub cmd_login ($$$$) {
        login_success($self, $tag);
 }
 
+sub cmd_close ($$) {
+       my ($self, $tag) = @_;
+       delete $self->{ibx} ? "$tag OK Close done\r\n"
+                               : "$tag BAD No mailbox\r\n";
+}
+
 sub cmd_logout ($$) {
        my ($self, $tag) = @_;
        delete $self->{logged_in};
@@ -364,14 +369,30 @@ EOF
        \$ret;
 }
 
-sub uid_fetch_cb { # called by git->cat_async
+sub requeue_once ($) {
+       my ($self) = @_;
+       # COMPRESS users all share the same DEFLATE context.
+       # Flush it here to ensure clients don't see
+       # each other's data
+       $self->zflush;
+
+       # no recursion, schedule another call ASAP,
+       # but only after all pending writes are done.
+       # autovivify wbuf:
+       my $new_size = push(@{$self->{wbuf}}, \&long_step);
+
+       # wbuf may be populated by $cb, no need to rearm if so:
+       $self->requeue if $new_size == 1;
+}
+
+sub uid_fetch_cb { # called by git->cat_async via git_async_msg
        my ($bref, $oid, $type, $size, $fetch_m_arg) = @_;
        my ($self, undef, $ibx, undef, undef, $msgs, $want) = @$fetch_m_arg;
        my $smsg = shift @$msgs or die 'BUG: no smsg';
        if (!defined($oid)) {
                # it's possible to have TOCTOU if an admin runs
                # public-inbox-(edit|purge), just move onto the next message
-               return unless defined $want->{-seqno};
+               return requeue_once($self) unless defined $want->{-seqno};
                $bref = dummy_message($smsg->{num}, $ibx);
        } else {
                $smsg->{blob} eq $oid or die "BUG: $smsg->{blob} != $oid";
@@ -388,8 +409,8 @@ sub uid_fetch_cb { # called by git->cat_async
        $want->{INTERNALDATE} and
                $self->msg_more(' INTERNALDATE "'.$smsg->internaldate.'"');
        $want->{FLAGS} and $self->msg_more(' FLAGS ()');
-       for ('RFC822', 'BODY[]', 'BODY.PEEK[]') {
-               next unless $want->{$_};
+       for ('RFC822', 'BODY[]') {
+               $want->{$_} or next;
                $self->msg_more(" $_ {".length($$bref)."}\r\n");
                $self->msg_more($$bref);
        }
@@ -399,14 +420,14 @@ sub uid_fetch_cb { # called by git->cat_async
        $want->{ENVELOPE} and
                $self->msg_more(' ENVELOPE '.eml_envelope($eml));
 
-       for my $f ('RFC822.HEADER', 'BODY[HEADER]', 'BODY.PEEK[HEADER]') {
-               next unless $want->{$f};
-               $self->msg_more(" $f {".length(${$eml->{hdr}})."}\r\n");
+       for ('RFC822.HEADER', 'BODY[HEADER]') {
+               $want->{$_} or next;
+               $self->msg_more(" $_ {".length(${$eml->{hdr}})."}\r\n");
                $self->msg_more(${$eml->{hdr}});
        }
-       for my $f ('RFC822.TEXT', 'BODY[TEXT]') {
-               next unless $want->{$f};
-               $self->msg_more(" $f {".length($$bref)."}\r\n");
+       for ('RFC822.TEXT', 'BODY[TEXT]') {
+               $want->{$_} or next;
+               $self->msg_more(" $_ {".length($$bref)."}\r\n");
                $self->msg_more($$bref);
        }
        $want->{BODYSTRUCTURE} and
@@ -417,6 +438,7 @@ sub uid_fetch_cb { # called by git->cat_async
                partial_emit($self, $partial, $eml);
        }
        $self->msg_more(")\r\n");
+       requeue_once($self);
 }
 
 sub uid_fetch_m { # long_response
@@ -429,11 +451,7 @@ sub uid_fetch_m { # long_response
                }
                $$beg = $msgs->[-1]->{num} + 1;
        }
-       my $git = $ibx->git;
-       $git->cat_async_begin; # TODO: actually make async
-       $git->cat_async($msgs->[0]->{blob}, \&uid_fetch_cb, \@_);
-       $git->cat_async_wait;
-       1;
+       git_async_msg($ibx, $msgs->[0], \&uid_fetch_cb, \@_);
 }
 
 sub cmd_status ($$$;@) {
@@ -479,6 +497,11 @@ sub cmd_list ($$$$) {
        \(join('', @$l, "$tag OK List done\r\n"));
 }
 
+sub cmd_lsub ($$$$) {
+       my (undef, $tag) = @_; # same args as cmd_list
+       "$tag OK Lsub done\r\n";
+}
+
 sub eml_index_offs_i { # PublicInbox::Eml::each_part callback
        my ($p, $all) = @_;
        my ($eml, undef, $idx) = @$p;
@@ -541,25 +564,23 @@ sub hdrs_regexp ($) {
 
 # BODY[($SECTION_IDX.)?HEADER.FIELDS.NOT ($HDRS)]<$offset.$bytes>
 sub partial_hdr_not {
-       my ($eml, $section_idx, $hdrs) = @_;
+       my ($eml, $section_idx, $hdrs_re) = @_;
        if (defined $section_idx) {
                $eml = eml_body_idx($eml, $section_idx) or return;
        }
        my $str = $eml->header_obj->as_string;
-       my $re = hdrs_regexp($hdrs);
-       $str =~ s/$re//g;
+       $str =~ s/$hdrs_re//g;
        $str .= "\r\n";
 }
 
 # BODY[($SECTION_IDX.)?HEADER.FIELDS ($HDRS)]<$offset.$bytes>
 sub partial_hdr_get {
-       my ($eml, $section_idx, $hdrs) = @_;
+       my ($eml, $section_idx, $hdrs_re) = @_;
        if (defined $section_idx) {
                $eml = eml_body_idx($eml, $section_idx) or return;
        }
        my $str = $eml->header_obj->as_string;
-       my $re = hdrs_regexp($hdrs);
-       join('', ($str =~ m/($re)/g), "\r\n");
+       join('', ($str =~ m/($hdrs_re)/g), "\r\n");
 }
 
 sub partial_prepare ($$$) {
@@ -567,24 +588,23 @@ sub partial_prepare ($$$) {
 
        # recombine [ "BODY[1.HEADER.FIELDS", "(foo", "bar)]" ]
        # back to: "BODY[1.HEADER.FIELDS (foo bar)]"
-       return unless $att =~ /\ABODY(?:\.PEEK)?\[/s;
+       return unless $att =~ /\ABODY\[/s;
        until (rindex($att, ']') >= 0) {
                my $next = shift @$want or return;
                $att .= ' ' . uc($next);
        }
-       if ($att =~ /\ABODY(?:\.PEEK)?\[
-                               ([0-9]+(?:\.[0-9]+)*)? # 1 - section_idx
-                               (?:\.(HEADER|MIME|TEXT))? # 2 - section_name
+       if ($att =~ /\ABODY\[([0-9]+(?:\.[0-9]+)*)? # 1 - section_idx
+                       (?:\.(HEADER|MIME|TEXT))? # 2 - section_name
                        \](?:<([0-9]+)(?:\.([0-9]+))?>)?\z/sx) { # 3, 4
                $partial->{$att} = [ \&partial_body, $1, $2, $3, $4 ];
-       } elsif ($att =~ /\ABODY(?:\.PEEK)?\[
-                               (?:([0-9]+(?:\.[0-9]+)*)\.)? # 1 - section_idx
+       } elsif ($att =~ /\ABODY\[(?:([0-9]+(?:\.[0-9]+)*)\.)? # 1 - section_idx
                                (?:HEADER\.FIELDS(\.NOT)?)\x20 # 2
                                \(([A-Z0-9\-\x20]+)\) # 3 - hdrs
                        \](?:<([0-9]+)(?:\.([0-9]+))?>)?\z/sx) { # 4 5
-               $partial->{$att} = [ $2 ? \&partial_hdr_not
-                                       : \&partial_hdr_get,
-                                       $1, $3, $4, $5 ];
+               my $tmp = $partial->{$att} = [ $2 ? \&partial_hdr_not
+                                               : \&partial_hdr_get,
+                                               $1, undef, $4, $5 ];
+               $tmp->[2] = hdrs_regexp($3);
        } else {
                undef;
        }
@@ -623,6 +643,7 @@ sub fetch_common ($$$$) {
        my (%partial, %want);
        while (defined(my $att = shift @$want)) {
                $att = uc($att);
+               $att =~ s/\ABODY\.PEEK\[/BODY\[/; # we're read-only
                my $x = $FETCH_ATT{$att};
                if ($x) {
                        %want = (%want, %$x);
@@ -633,7 +654,7 @@ sub fetch_common ($$$$) {
 
        # stabilize partial order for consistency and ease-of-debugging:
        if (scalar keys %partial) {
-               $want{-partial} = [ map {
+               $want{-partial} = [ map {;
                        [ $_, @{$partial{$_}} ]
                } sort keys %partial ];
        }
@@ -676,20 +697,17 @@ sub seq_fetch_m { # long_response
        my $seq = $want->{-seqno}++;
        my $cur_num = $msgs->[0]->{num};
        if ($cur_num == $seq) { # as expected
-               my $git = $ibx->git;
-               $git->cat_async_begin; # TODO: actually make async
-               $git->cat_async($msgs->[0]->{blob}, \&uid_fetch_cb, \@_);
-               $git->cat_async_wait;
+               git_async_msg($ibx, $msgs->[0], \&uid_fetch_cb, \@_);
        } elsif ($cur_num > $seq) {
                # send dummy messages until $seq catches up to $cur_num
                my $smsg = bless { num => $seq, ts => 0 }, 'PublicInbox::Smsg';
                unshift @$msgs, $smsg;
                my $bref = dummy_message($seq, $ibx);
                uid_fetch_cb($bref, undef, undef, undef, \@_);
+               $smsg; # blessed response since uid_fetch_cb requeues
        } else { # should not happen
                die "BUG: cur_num=$cur_num < seq=$seq";
        }
-       1; # more messages on the way
 }
 
 sub cmd_fetch ($$$;@) {
@@ -809,17 +827,8 @@ sub long_step {
        } elsif ($more) { # $self->{wbuf}:
                $self->update_idle_time;
 
-               # COMPRESS users all share the same DEFLATE context.
-               # Flush it here to ensure clients don't see
-               # each other's data
-               $self->zflush;
-
-               # no recursion, schedule another call ASAP, but only after
-               # all pending writes are done.  autovivify wbuf:
-               my $new_size = push(@{$self->{wbuf}}, \&long_step);
-
-               # wbuf may be populated by $cb, no need to rearm if so:
-               $self->requeue if $new_size == 1;
+               # control passed to $more may be a GitAsyncCat object
+               requeue_once($self) if !ref($more);
        } else { # all done!
                delete $self->{long_cb};
                my $elapsed = now() - $t0;