imap: FETCH: support comma-delimited ranges

The RFC 3501 `sequence-set' definition allows comma-delimited
ranges, so we'll support it in case clients send them.

Coalescing overlapping ranges isn't required, so we won't
support it as such an attempt to save bandwidth would waste
memory on the server, instead.

diff --git a/lib/PublicInbox/IMAP.pm b/lib/PublicInbox/IMAP.pm
index 51ab8b8c2f2eae4e9c11dee582cd2af9383ddc2e..917833f7c470bfc1c6d573f6dc165b277af4b1db 100644 (file)
--- a/lib/PublicInbox/IMAP.pm
+++ b/lib/PublicInbox/IMAP.pm
@@ -61,6 +61,9 @@ for my $att (keys %FETCH_ATT) {
        $FETCH_ATT{$att} = \%h;
 }
 
+my $valid_range = '[0-9]+|[0-9]+:[0-9]+|[0-9]+:\*';
+$valid_range = qr/\A(?:$valid_range)(?:,(?:$valid_range))*\z/;
+
 sub greet ($) {
        my ($self) = @_;
        my $capa = capa($self);
@@ -387,7 +390,7 @@ sub requeue_once ($) {
 
 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 ($self, undef, $ibx, $msgs, undef, $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
@@ -441,15 +444,48 @@ sub uid_fetch_cb { # called by git->cat_async via git_async_msg
        requeue_once($self);
 }
 
+sub range_step ($$) {
+       my ($ibx, $range_csv) = @_;
+       my ($beg, $end, $range);
+       if ($$range_csv =~ s/\A([^,]+),//) {
+               $range = $1;
+       } else {
+               $range = $$range_csv;
+               $$range_csv = undef;
+       }
+       if ($range =~ /\A([0-9]+):([0-9]+)\z/) {
+               ($beg, $end) = ($1, $2);
+       } elsif ($range =~ /\A([0-9]+):\*\z/) {
+               ($beg, $end) =  ($1, $ibx->mm->max // 0);
+       } elsif ($range =~ /\A[0-9]+\z/) {
+               $beg = $end = $range;
+       } else {
+               return 'BAD fetch range';
+       }
+       [ $beg, $end, $$range_csv ];
+}
+
+sub refill_range ($$$) {
+       my ($ibx, $msgs, $range_info) = @_;
+       my ($beg, $end, $range_csv) = @$range_info;
+       if (scalar(@$msgs = @{$ibx->over->query_xover($beg, $end)})) {
+               $range_info->[0] = $msgs->[-1]->{num} + 1;
+               return;
+       }
+       return 'OK Fetch done' if !$range_csv;
+       my $next_range = range_step($ibx, \$range_csv);
+       return $next_range if !ref($next_range); # error
+       @$range_info = @$next_range;
+       undef; # keep looping
+}
+
 sub uid_fetch_m { # long_response
-       my ($self, $tag, $ibx, $beg, $end, $msgs, $want) = @_;
-       if (!@$msgs) { # refill
-               @$msgs = @{$ibx->over->query_xover($$beg, $end)};
-               if (!@$msgs) {
-                       $self->write(\"$tag OK Fetch done\r\n");
+       my ($self, $tag, $ibx, $msgs, $range_info, $want) = @_;
+       while (!@$msgs) { # rare
+               if (my $end = refill_range($ibx, $msgs, $range_info)) {
+                       $self->write(\"$tag $end\r\n");
                        return;
                }
-               $$beg = $msgs->[-1]->{num} + 1;
        }
        git_async_msg($ibx, $msgs->[0], \&uid_fetch_cb, \@_);
 }
@@ -635,7 +671,7 @@ sub partial_emit ($$$) {
 }
 
 sub fetch_common ($$$$) {
-       my ($self, $tag, $range, $want) = @_;
+       my ($self, $tag, $range_csv, $want) = @_;
        my $ibx = $self->{ibx} or return "$tag BAD No mailbox selected\r\n";
        if ($want->[0] =~ s/\A\(//s) {
                $want->[-1] =~ s/\)\z//s or return "$tag BAD no rparen\r\n";
@@ -658,41 +694,27 @@ sub fetch_common ($$$$) {
                        [ $_, @{$partial{$_}} ]
                } sort keys %partial ];
        }
-
-       my ($beg, $end);
-       my $msgs = [];
-       if ($range =~ /\A([0-9]+):([0-9]+)\z/s) {
-               ($beg, $end) = ($1, $2);
-       } elsif ($range =~ /\A([0-9]+):\*\z/s) {
-               ($beg, $end) =  ($1, $ibx->mm->max // 0);
-       } elsif ($range =~ /\A[0-9]+\z/) {
-               my $smsg = $ibx->over->get_art($range) or
-                       return "$tag OK Fetch done\r\n"; # really OK(!)
-               push @$msgs, $smsg;
-               ($beg, $end) = ($range, 0);
-       } else {
-               return "$tag BAD fetch range\r\n";
-       }
-       [ $tag, $ibx, \$beg, $end, $msgs, \%want ];
+       $range_csv = 'bad' if $range_csv !~ $valid_range;
+       my $range_info = range_step($ibx, \$range_csv);
+       return "$tag $range_info\r\n" if !ref($range_info);
+       [ $tag, $ibx, [], $range_info, \%want ];
 }
 
 sub cmd_uid_fetch ($$$;@) {
-       my ($self, $tag, $range, @want) = @_;
-       my $args = fetch_common($self, $tag, $range, \@want);
+       my ($self, $tag, $range_csv, @want) = @_;
+       my $args = fetch_common($self, $tag, $range_csv, \@want);
        ref($args) eq 'ARRAY' ?
                long_response($self, \&uid_fetch_m, @$args) :
                $args; # error
 }
 
 sub seq_fetch_m { # long_response
-       my ($self, $tag, $ibx, $beg, $end, $msgs, $want) = @_;
-       if (!@$msgs) { # refill
-               @$msgs = @{$ibx->over->query_xover($$beg, $end)};
-               if (!@$msgs) {
-                       $self->write(\"$tag OK Fetch done\r\n");
+       my ($self, $tag, $ibx, $msgs, $range_info, $want) = @_;
+       while (!@$msgs) { # rare
+               if (my $end = refill_range($ibx, $msgs, $range_info)) {
+                       $self->write(\"$tag $end\r\n");
                        return;
                }
-               $$beg = $msgs->[-1]->{num} + 1;
        }
        my $seq = $want->{-seqno}++;
        my $cur_num = $msgs->[0]->{num};
@@ -711,11 +733,11 @@ sub seq_fetch_m { # long_response
 }
 
 sub cmd_fetch ($$$;@) {
-       my ($self, $tag, $range, @want) = @_;
-       my $args = fetch_common($self, $tag, $range, \@want);
+       my ($self, $tag, $range_csv, @want) = @_;
+       my $args = fetch_common($self, $tag, $range_csv, \@want);
        ref($args) eq 'ARRAY' ? do {
                my $want = $args->[-1];
-               $want->{-seqno} = ${$args->[2]}; # $$beg
+               $want->{-seqno} = $args->[3]->[0]; # $beg == $range_info->[0];
                long_response($self, \&seq_fetch_m, @$args)
        } : $args; # error
 }

diff --git a/t/imapd.t b/t/imapd.t
index 8172a91923d3777de714a989ed03d5716942f75d..7af14f1b1504729894e7c4a7ddb47b62111d07d4 100644 (file)
--- a/t/imapd.t
+++ b/t/imapd.t
@@ -309,6 +309,8 @@ EOF
 # message sequence numbers :<
 is($mic->Uid(0), 0, 'disable UID on '.ref($mic));
 ok($mic->reconnect, 'reconnected');
+$ret = $mic->fetch_hash('1,2:3', 'RFC822') or BAIL_OUT "FETCH $@";
+is(scalar keys %$ret, 3, 'got all 3 messages with comma-separated sequence');
 $ret = $mic->fetch_hash('1:*', 'RFC822') or BAIL_OUT "FETCH $@";
 is(scalar keys %$ret, 3, 'got all 3 messages');
 {