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 _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));
+
$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 complete\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 complete\r\n"));
+}
+
sub cmd_uid_fetch ($$$;@) {
my ($self, $tag, $range, @want) = @_;
my $ibx = $self->{ibx} or return "$tag BAD No mailbox selected\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);
}