use fields qw(imapd logged_in ibx long_cb -login_tag
-idle_tag -idle_max);
use PublicInbox::Eml;
+use PublicInbox::EmlContentFoo qw(parse_content_disposition);
use PublicInbox::DS qw(now);
use PublicInbox::Syscall qw(EPOLLIN EPOLLONESHOT);
+use Text::ParseWords qw(parse_line);
use Errno qw(EAGAIN);
my $Address;
for my $mod (qw(Email::Address::XS Mail::Address)) {
sub cmd_logout ($$) {
my ($self, $tag) = @_;
delete $self->{logged_in};
- $self->write(\"* BYE logging out\r\n$tag OK logout completed\r\n");
+ $self->write(\"* BYE logging out\r\n$tag OK Logout done\r\n");
$self->shutdn; # PublicInbox::DS::shutdn
undef;
}
sub cmd_capability ($$) {
my ($self, $tag) = @_;
- '* '.capa($self)."\r\n$tag OK\r\n";
+ '* '.capa($self)."\r\n$tag OK Capability done\r\n";
}
-sub cmd_noop ($$) { "$_[1] OK NOOP completed\r\n" }
+sub cmd_noop ($$) { "$_[1] OK Noop done\r\n" }
# called by PublicInbox::InboxIdle
sub on_inbox_unlock {
# IDLE seems allowed by dovecot w/o a mailbox selected *shrug*
my $ibx = $self->{ibx} or return "$tag BAD no mailbox selected\r\n";
$ibx->subscribe_unlock(fileno($self->{sock}), $self);
+ $self->{imapd}->idler_start;
$self->{-idle_tag} = $tag;
$self->{-idle_max} = $ibx->mm->max // 0;
"+ idling\r\n"
return "$tag BAD internal bug\r\n";
};
$ibx->unsubscribe_unlock(fileno($self->{sock}));
- "$idle_tag OK Idle completed\r\n";
+ "$idle_tag OK Idle done\r\n";
}
sub cmd_examine ($$$) {
$ret .= "* OK [UNSEEN $max]\r\n" if $max;
$ret .= "* OK [UIDNEXT $uidnext]\r\n" if defined $uidnext;
$ret .= "* OK [UIDVALIDITY $uidvalidity]\r\n" if defined $uidvalidity;
- $ret .= "$tag OK [READ-ONLY] EXAMINE/SELECT complete\r\n";
+ $ret .= "$tag OK [READ-ONLY] EXAMINE/SELECT done\r\n";
}
sub _esc ($) {
) . ')';
}
+sub _esc_hash ($) {
+ my ($hash) = @_;
+ if ($hash && scalar keys %$hash) {
+ $hash = [ %$hash ]; # flatten hash into 1-dimensional array
+ '(' . join(' ', map { _esc($_) } @$hash) . ')';
+ } else {
+ 'NIL';
+ }
+}
+
+sub body_disposition ($) {
+ my ($eml) = @_;
+ my $cd = $eml->header_raw('Content-Disposition') or return 'NIL';
+ $cd = parse_content_disposition($cd);
+ my $buf = '('._esc($cd->{type});
+ $buf .= ' ' . _esc_hash(delete $cd->{attributes});
+ $buf .= ')';
+}
+
+sub body_leaf ($$;$) {
+ my ($eml, $structure, $hold) = @_;
+ my $buf = '';
+ $eml->{is_submsg} and # parent was a message/(rfc822|news|global)
+ $buf .= eml_envelope($eml). ' ';
+ my $ct = $eml->ct;
+ $buf .= '('._esc($ct->{type}).' ';
+ $buf .= _esc($ct->{subtype});
+ $buf .= ' ' . _esc_hash(delete $ct->{attributes});
+ $buf .= ' ' . _esc($eml->header_raw('Content-ID'));
+ $buf .= ' ' . _esc($eml->header_raw('Content-Description'));
+ my $cte = $eml->header_raw('Content-Transfer-Encoding') // '7bit';
+ $buf .= ' ' . _esc($cte);
+ $buf .= ' ' . $eml->{imap_body_len};
+ $buf .= ' '.($eml->body_raw =~ tr/\n/\n/) if lc($ct->{type}) eq 'text';
+
+ # for message/(rfc822|global|news), $hold[0] should have envelope
+ $buf .= ' ' . (@$hold ? join('', @$hold) : 'NIL') if $hold;
+
+ if ($structure) {
+ $buf .= ' '._esc($eml->header_raw('Content-MD5'));
+ $buf .= ' '. body_disposition($eml);
+ $buf .= ' '._esc($eml->header_raw('Content-Language'));
+ $buf .= ' '._esc($eml->header_raw('Content-Location'));
+ }
+ $buf .= ')';
+}
+
+sub body_parent ($$$) {
+ my ($eml, $structure, $hold) = @_;
+ my $ct = $eml->ct;
+ my $type = lc($ct->{type});
+ if ($type eq 'multipart') {
+ my $buf = '(';
+ $buf .= @$hold ? join('', @$hold) : 'NIL';
+ $buf .= ' '._esc($ct->{subtype});
+ if ($structure) {
+ $buf .= ' '._esc_hash(delete $ct->{attributes});
+ $buf .= ' '.body_disposition($eml);
+ $buf .= ' '._esc($eml->header_raw('Content-Language'));
+ $buf .= ' '._esc($eml->header_raw('Content-Location'));
+ }
+ $buf .= ')';
+ @$hold = ($buf);
+ } else { # message/(rfc822|global|news)
+ @$hold = (body_leaf($eml, $structure, $hold));
+ }
+}
+
+# this is gross, but we need to process the parent part AFTER
+# the child parts are done
+sub bodystructure_prep {
+ my ($p, $q) = @_;
+ my ($eml, $depth) = @$p; # ignore idx
+ # set length here, as $eml->{bdy} gets deleted for message/rfc822
+ $eml->{imap_body_len} = length($eml->body_raw);
+ push @$q, $eml, $depth;
+}
+
+# for FETCH BODY and FETCH BODYSTRUCTURE
+sub fetch_body ($;$) {
+ my ($eml, $structure) = @_;
+ my @q;
+ $eml->each_part(\&bodystructure_prep, \@q, 0, 1);
+ my $cur_depth = 0;
+ my @hold;
+ do {
+ my ($part, $depth) = splice(@q, -2);
+ my $is_mp_parent = $depth == ($cur_depth - 1);
+ $cur_depth = $depth;
+
+ if ($is_mp_parent) {
+ body_parent($part, $structure, \@hold);
+ } else {
+ unshift @hold, body_leaf($part, $structure);
+ }
+ } while (@q);
+ join('', @hold);
+}
+
sub uid_fetch_cb { # called by git->cat_async
my ($bref, $oid, $type, $size, $fetch_m_arg) = @_;
my ($self, undef, $ibx, undef, undef, $msgs, $want) = @$fetch_m_arg;
$self->msg_more(" $f {".length($$bref)."}\r\n");
$self->msg_more($$bref);
}
- # TODO BODY/BODYSTRUCTURE, specific headers
+ $want->{BODYSTRUCTURE} and
+ $self->msg_more(' BODYSTRUCTURE '.fetch_body($eml, 1));
+ $want->{BODY} and
+ $self->msg_more(' BODY '.fetch_body($eml));
+ if (my $partial = $want->{-partial}) {
+ partial_emit($self, $partial, $eml);
+ }
$self->msg_more(")\r\n");
}
1;
}
+sub cmd_status ($$$;@) {
+ my ($self, $tag, $mailbox, @items) = @_;
+ my $ibx = $self->{imapd}->{groups}->{$mailbox} or
+ return "$tag NO Mailbox doesn't exist: $mailbox\r\n";
+ return "$tag BAD no items\r\n" if !scalar(@items);
+ ($items[0] !~ s/\A\(//s || $items[-1] !~ s/\)\z//s) and
+ return "$tag BAD invalid args\r\n";
+
+ my $mm = $ibx->mm;
+ my ($max, @it);
+ for my $it (@items) {
+ $it = uc($it);
+ push @it, $it;
+ if ($it =~ /\A(?:MESSAGES|UNSEEN|RECENT)\z/) {
+ push(@it, ($max //= $mm->max // 0));
+ } elsif ($it eq 'UIDNEXT') {
+ push(@it, ($max //= $mm->max // 0) + 1);
+ } elsif ($it eq 'UIDVALIDITY') {
+ push(@it, $mm->created_at //
+ return("$tag BAD UIDVALIDITY\r\n"));
+ } else {
+ return "$tag BAD invalid item\r\n";
+ }
+ }
+ return "$tag BAD no items\r\n" if !@it;
+ "* STATUS $mailbox (".join(' ', @it).")\r\n" .
+ "$tag OK Status done\r\n";
+}
+
+my %patmap = ('*' => '.*', '%' => '[^\.]*');
+sub cmd_list ($$$$) {
+ my ($self, $tag, $refname, $wildcard) = @_;
+ my $l = $self->{imapd}->{inboxlist};
+ if ($refname eq '' && $wildcard eq '') {
+ # request for hierarchy delimiter
+ $l = [ qq[* LIST (\\Noselect) "." ""\r\n] ];
+ } elsif ($refname ne '' || $wildcard ne '*') {
+ $wildcard =~ s!([^a-z0-9_])!$patmap{$1} // "\Q$1"!eig;
+ $l = [ grep(/ \Q$refname\E$wildcard\r\n\z/s, @$l) ];
+ }
+ \(join('', @$l, "$tag OK List done\r\n"));
+}
+
+sub eml_index_offs_i { # PublicInbox::Eml::each_part callback
+ my ($p, $all) = @_;
+ my ($eml, undef, $idx) = @$p;
+ if ($idx && lc($eml->ct->{type}) eq 'multipart') {
+ $eml->{imap_bdy} = $eml->{bdy} // \'';
+ }
+ $all->{$idx} = $eml; # $idx => Eml
+}
+
+# prepares an index for BODY[$SECTION_IDX] fetches
+sub eml_body_idx ($$) {
+ my ($eml, $section_idx) = @_;
+ my $idx = $eml->{imap_all_parts} //= do {
+ my $all = {};
+ $eml->each_part(\&eml_index_offs_i, $all, 0, 1);
+ # top-level of multipart, BODY[0] not allowed (nz-number)
+ delete $all->{0};
+ $all;
+ };
+ $idx->{$section_idx};
+}
+
+# BODY[($SECTION_IDX)?(.$SECTION_NAME)?]<$offset.$bytes>
+sub partial_body {
+ my ($eml, $section_idx, $section_name) = @_;
+ if (defined $section_idx) {
+ $eml = eml_body_idx($eml, $section_idx) or return;
+ }
+ if (defined $section_name) {
+ if ($section_name eq 'MIME') {
+ # RFC 3501 6.4.5 states:
+ # The MIME part specifier MUST be prefixed
+ # by one or more numeric part specifiers
+ return unless defined $section_idx;
+ return $eml->header_obj->as_string . "\r\n";
+ }
+ my $bdy = $eml->{bdy} // $eml->{imap_bdy} // \'';
+ $eml = PublicInbox::Eml->new($$bdy);
+ if ($section_name eq 'TEXT') {
+ return $eml->body_raw;
+ } elsif ($section_name eq 'HEADER') {
+ return $eml->header_obj->as_string . "\r\n";
+ } else {
+ die "BUG: bad section_name=$section_name";
+ }
+ }
+ ${$eml->{bdy} // $eml->{imap_bdy} // \''};
+}
+
+# similar to what's in PublicInbox::Eml::re_memo, but doesn't memoize
+# to avoid OOM with malicious users
+sub hdrs_regexp ($) {
+ my ($hdrs) = @_;
+ my $names = join('|', map { "\Q$_" } split(/[ \t]+/, $hdrs));
+ qr/^(?:$names):[ \t]*[^\n]*\r?\n # 1st line
+ # continuation lines:
+ (?:[^:\n]*?[ \t]+[^\n]*\r?\n)*
+ /ismx;
+}
+
+# BODY[($SECTION_IDX.)?HEADER.FIELDS.NOT ($HDRS)]<$offset.$bytes>
+sub partial_hdr_not {
+ my ($eml, $section_idx, $hdrs) = @_;
+ 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 .= "\r\n";
+}
+
+# BODY[($SECTION_IDX.)?HEADER.FIELDS ($HDRS)]<$offset.$bytes>
+sub partial_hdr_get {
+ my ($eml, $section_idx, $hdrs) = @_;
+ 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");
+}
+
+sub partial_prepare ($$$) {
+ my ($partial, $want, $att) = @_;
+
+ # recombine [ "BODY[1.HEADER.FIELDS", "(foo", "bar)]" ]
+ # back to: "BODY[1.HEADER.FIELDS (foo bar)]"
+ return unless $att =~ /\ABODY(?:\.PEEK)?\[/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
+ \](?:<([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
+ (?: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 ];
+ } else {
+ undef;
+ }
+}
+
+sub partial_emit ($$$) {
+ my ($self, $partial, $eml) = @_;
+ for (@$partial) {
+ my ($k, $cb, @args) = @$_;
+ my ($offset, $len) = splice(@args, -2);
+ # $cb is partial_body|partial_hdr_get|partial_hdr_not
+ my $str = $cb->($eml, @args) // '';
+ if (defined $offset) {
+ if (defined $len) {
+ $str = substr($str, $offset, $len);
+ $k =~ s/\.$len>\z/>/ or warn
+"BUG: unable to remove `.$len>' from `$k'";
+ } else {
+ $str = substr($str, $offset);
+ $len = length($str);
+ }
+ } else {
+ $len = length($str);
+ }
+ $self->msg_more(" $k {$len}\r\n");
+ $self->msg_more($str);
+ }
+}
+
sub cmd_uid_fetch ($$$;@) {
my ($self, $tag, $range, @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";
}
- my %want = map {;
- my $x = $FETCH_ATT{uc($_)} or return "$tag BAD param: $_\r\n";
- %$x;
- } @want;
+ my (%partial, %want);
+ while (defined(my $att = shift @want)) {
+ $att = uc($att);
+ my $x = $FETCH_ATT{$att};
+ if ($x) {
+ %want = (%want, %$x);
+ } elsif (!partial_prepare(\%partial, \@want, $att)) {
+ return "$tag BAD param: $att\r\n";
+ }
+ }
+
+ # stabilize partial order for consistency and ease-of-debugging:
+ if (scalar keys %partial) {
+ $want{-partial} = [ map {
+ [ $_, @{$partial{$_}} ]
+ } sort keys %partial ];
+ }
+
my ($beg, $end);
my $msgs = [];
if ($range =~ /\A([0-9]+):([0-9]+)\z/s) {
} 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\r\n";
+ 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\r\n";
+ return "$tag BAD fetch range\r\n";
}
long_response($self, \&uid_fetch_m, $tag, $ibx,
\$beg, $end, $msgs, \%want);
if (scalar(@$uids)) {
$self->msg_more(join(' ', '', @$uids));
} else {
- $self->write(\"\r\n$tag OK\r\n");
+ $self->write(\"\r\n$tag OK Search done\r\n");
undef;
}
}
if (@$uids) {
$self->msg_more(join('', map { " $_->[0]" } @$uids));
} else {
- $self->write(\"\r\n$tag OK\r\n");
+ $self->write(\"\r\n$tag OK Search done\r\n");
undef;
}
}
} elsif ($rest[0] =~ /\A[0-9]+\z/s) {
my $uid = $rest[0];
$uid = $ibx->over->get_art($uid) ? " $uid" : '';
- "* SEARCH$uid\r\n$tag OK\r\n";
+ "* SEARCH$uid\r\n$tag OK Search done\r\n";
} else {
- "$tag BAD\r\n";
+ "$tag BAD Error\r\n";
}
} else {
- "$tag BAD\r\n";
+ "$tag BAD Error\r\n";
}
}
# returns 1 if we can continue, 0 if not due to buffered writes or disconnect
sub process_line ($$) {
my ($self, $l) = @_;
- my ($tag, $req, @args) = split(/[ \t]+/, $l);
+ my ($tag, $req, @args) = parse_line('[ \t]+', 0, $l);
+ pop(@args) if (@args && !defined($args[-1]));
if (@args && uc($req) eq 'UID') {
$req .= "_".(shift @args);
}