lib/PublicInbox/LeiToMail.pm

   1 # Copyright (C) 2020 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3
   4 # Writes PublicInbox::Eml objects atomically to a mbox variant or Maildir
   5 package PublicInbox::LeiToMail;
   6 use strict;
   7 use v5.10.1;
   8 use PublicInbox::Eml;
   9
  10 my %kw2char = ( # Maildir characters
  11         draft => 'D',
  12         flagged => 'F',
  13         answered => 'R',
  14         seen => 'S'
  15 );
  16
  17 my %kw2status = (
  18         flagged => [ 'X-Status' => 'F' ],
  19         answered => [ 'X-Status' => 'A' ],
  20         seen => [ 'Status' => 'R' ],
  21         draft => [ 'X-Status' => 'T' ],
  22 );
  23
  24 sub _mbox_hdr_buf ($$$) {
  25         my ($eml, $type, $kw) = @_;
  26         $eml->header_set($_) for (qw(Lines Bytes Content-Length));
  27         my %hdr; # set Status, X-Status
  28         for my $k (@$kw) {
  29                 if (my $ent = $kw2status{$k}) {
  30                         push @{$hdr{$ent->[0]}}, $ent->[1];
  31                 } else { # X-Label?
  32                         warn "TODO: keyword `$k' not supported for mbox\n";
  33                 }
  34         }
  35         while (my ($name, $chars) = each %hdr) {
  36                 $eml->header_set($name, join('', sort @$chars));
  37         }
  38         my $buf = delete $eml->{hdr};
  39
  40         # fixup old bug from import (pre-a0c07cba0e5d8b6a)
  41         $$buf =~ s/\A[\r\n]*From [^\r\n]*\r?\n//s;
  42
  43         substr($$buf, 0, 0, # prepend From line
  44                 "From lei\@$type Thu Jan  1 00:00:00 1970$eml->{crlf}");
  45         $buf;
  46 }
  47
  48 sub write_in_full_atomic ($$) {
  49         my ($fh, $buf) = @_;
  50         defined(my $w = syswrite($fh, $$buf)) or die "write: $!";
  51         $w == length($$buf) or die "short write: $w != ".length($$buf);
  52 }
  53
  54 sub eml2mboxrd ($;$) {
  55         my ($eml, $kw) = @_;
  56         my $buf = _mbox_hdr_buf($eml, 'mboxrd', $kw);
  57         if (my $bdy = delete $eml->{bdy}) {
  58                 $$bdy =~ s/^(>*From )/>$1/gm;
  59                 $$buf .= $eml->{crlf};
  60                 substr($$bdy, 0, 0, $$buf); # prepend header
  61                 $buf = $bdy;
  62         }
  63         $$buf .= $eml->{crlf};
  64         $buf;
  65 }
  66
  67 sub eml2mboxo {
  68         my ($eml, $kw) = @_;
  69         my $buf = _mbox_hdr_buf($eml, 'mboxo', $kw);
  70         if (my $bdy = delete $eml->{bdy}) {
  71                 $$bdy =~ s/^From />From /gm;
  72                 $$buf .= $eml->{crlf};
  73                 substr($$bdy, 0, 0, $$buf); # prepend header
  74                 $buf = $bdy;
  75         }
  76         $$buf .= $eml->{crlf};
  77         $buf;
  78 }
  79
  80 # mboxcl still escapes "From " lines
  81 sub eml2mboxcl {
  82         my ($eml, $kw) = @_;
  83         my $buf = _mbox_hdr_buf($eml, 'mboxcl', $kw);
  84         my $crlf = $eml->{crlf};
  85         if (my $bdy = delete $eml->{bdy}) {
  86                 $$bdy =~ s/^From />From /gm;
  87                 $$buf .= 'Content-Length: '.length($$bdy).$crlf.$crlf;
  88                 substr($$bdy, 0, 0, $$buf); # prepend header
  89                 $buf = $bdy;
  90         }
  91         $$buf .= $crlf;
  92         $buf;
  93 }
  94
  95 # mboxcl2 has no "From " escaping
  96 sub eml2mboxcl2 {
  97         my ($eml, $kw) = @_;
  98         my $buf = _mbox_hdr_buf($eml, 'mboxcl2', $kw);
  99         my $crlf = $eml->{crlf};
 100         if (my $bdy = delete $eml->{bdy}) {
 101                 $$buf .= 'Content-Length: '.length($$bdy).$crlf.$crlf;
 102                 substr($$bdy, 0, 0, $$buf); # prepend header
 103                 $buf = $bdy;
 104         }
 105         $$buf .= $crlf;
 106         $buf;
 107 }
 108
 109 1;