IkiWiki/Plugin/mailbox.pm

   1 #!/usr/bin/perl
   2 # based on Ikiwiki skeleton plugin.
   3
   4 # Copyright (c) 2008 David Bremner <bremner@unb.ca>
   5 # This file is distributed under the Artistic License/GPL2+
   6
   7 use Email::MIME;
   8 use Email::MIME::Modifier;
   9 package Email::MIMEFolder;
  10 use base 'Email::Folder';
  11 sub bless_message { return  Email::MIME->new($_[1]) };
  12
  13
  14 package IkiWiki::Plugin::mailbox;
  15
  16 use Email::FolderType qw(folder_type);
  17 use IkiWiki 2.00;
  18 use Email::Thread;
  19 use CGI 'escapeHTML';
  20 use File::Temp qw/tempfile/;
  21 use File::MimeInfo::Magic;
  22 use Date::Parse;
  23 use Email::Address;
  24
  25 my %metaheaders;
  26
  27
  28 sub import { #{{{
  29         hook(type => "preprocess", id => "mailbox", call => \&preprocess);
  30         hook(type => "scan", id => "mailbox", call => \&scan);
  31         hook(type => "pagetemplate", id=>"mailbox", call => \&pagetemplate);
  32         hook(type => "htmlize",id=>"mbox",call => \&mbox_htmlize);
  33         IkiWiki::loadplugin("filecheck");
  34 } # }}}
  35
  36 sub scan(@){
  37         my %params=@_;
  38         my $page=$params{page};
  39
  40         my $linktext=$config{url}.'/mailbox.css';
  41
  42         push @{$metaheaders{$page}},
  43                '<link rel="stylesheet" href="'.$linktext.'" type="text/css"/>'
  44 }
  45
  46 sub preprocess (@) { #{{{
  47         my %params=@_;
  48
  49         my $page=$params{page};
  50         my $type=$params{type} || 'Maildir';
  51
  52         my $path=$params{path} ||  error gettext("missing parameter") . " path";
  53
  54         # hmm, this should probably only be inserted once per page.
  55
  56         my $dir=bestpath($page,$params{path}) ||
  57             error("could not find ".$params{path});
  58
  59         $params{path} = $config{srcdir} ."/" . $dir;
  60         $params{type} = $type;
  61
  62         return  format_mailbox(%params);
  63
  64 } # }}}
  65
  66 sub mbox_htmlize(@){
  67     my %params=@_;
  68
  69     my $path=$config{srcdir} . '/' . $params{page}.".mbox";
  70     return format_mailbox(path=>$path,type=>'Mbox',destpage=>$params{page});
  71 }
  72
  73 ### The guts of the plugin
  74 ### parameters
  75 sub format_mailbox(@){
  76     my %params=@_;
  77     my $path=$params{path} || error gettext("missing parameter "). 'path';
  78     my $type=$params{type} || error gettext("missing paramater ")."type";
  79
  80     debug('type='.$type);
  81     my $folder=Email::MIMEFolder->new($path,reader=>'Email::Folder::'.$type) || error("mailbox could not be opened");
  82     my $threader=new Email::Thread($folder->messages);
  83
  84     $threader->thread();
  85
  86     my @roots= sort  { str2time($a->header('Date'))  <=>
  87                            str2time($b->header('Date'))}  ($threader->rootset);
  88
  89     return join "\n", map { format_thread(%params,thread=>$_) } @roots;
  90
  91 }
  92
  93 sub format_thread(@){
  94     my %params=@_;
  95
  96     my $thread=$params{thread} || error gettext("missing parameter") . "thread";
  97
  98     my $output="";
  99
 100     if ($thread->message) {
 101         $output .= format_message(%params,message=>$thread->message);
 102     } else {
 103         $output .= sprintf gettext("Message %s not available"), $thread->messageid;
 104     }
 105
 106     if ($thread->child){
 107         $output .= '<div class="emailthreadindent">' .
 108             format_thread(%params,thread=>$thread->child).
 109             '</div>';
 110     }
 111
 112     if ($thread->next){
 113         $output .= format_thread(%params,thread=>$thread->next);
 114     }
 115     return $output;
 116 }
 117
 118 sub sanitize_address($$){
 119     my $hdrname=shift;
 120     my $val=shift;
 121     my $strategy= $config{mailbox_obfuscation_strategy} || "delete";
 122
 123     return $val if ($strategy eq  "none");
 124
 125     if ($hdrname =~ qr/From|To|Reply-To|CC/){
 126         my @addrs=Email::Address->parse($val);
 127         foreach my $addr (@addrs){
 128             if ($strategy eq "rot13"){
 129                 my $orig=$addr->address;
 130                 $orig =~ y/A-Za-z/N-ZA-Mn-za-m/;
 131                 $addr->address($orig);
 132             } else {
 133                 $addr->address(gettext("address deleted"));
 134             }
 135         }
 136         $val=join(",",map {$_->format;} @addrs);
 137     }
 138     return $val;
 139                      }
 140
 141 sub make_pair($$){
 142     my $message=shift;
 143     my $name=shift;
 144     my $val=$message->header($name);
 145
 146     $val = sanitize_address($name,$val);
 147
 148     $val = escapeHTML($val);
 149
 150     my $hash={'HEADERNAME'=>$name,'VAL'=>$val};
 151     return $hash;
 152 }
 153 sub format_message(@){
 154     my  %params=@_;
 155
 156     my $message=$params{message} ||
 157         error gettext("missing parameter"). "message";
 158
 159
 160     my $dest=$params{destpage} ||
 161         error gettext("missing parameter"). "destpage";
 162
 163     my $keep_headers=$params{headers} || qr/^(subject|from|date)[:]?$/i;
 164
 165     my $template=
 166         template("email.tmpl") || error gettext("missing template");
 167
 168     my $output="";
 169
 170     my @names = grep  {m/$keep_headers/;}  ($message->header_names);
 171
 172     my @headers=map { make_pair($message,$_) } @names;
 173
 174
 175
 176     $template->param(HEADERS=>[@headers]);
 177
 178     my $allowed_attachments=$params{allowed_attachments} ||
 179         "maxsize(100kb) and mimetype(text/plain)";
 180
 181     my @parts=$message->parts;
 182
 183     my $partcount=1;
 184     foreach(@parts){
 185         #this sucks. But someone would need to modify filecheck to
 186         #accept a blob of content. Or maybe hacking with IO::Scalar
 187         my $tmpfile=File::Temp->new();
 188
 189         binmode $tmpfile,':utf8';
 190         print $tmpfile $_->body();
 191
 192         my $allowed=pagespec_match($dest, $allowed_attachments, file=>$tmpfile);
 193
 194         if (!$allowed) {
 195             debug("clobbering attachment $partcount");
 196             $_->content_type_set('text/plain');
 197             $_->body_set("[ omitting part $partcount: $allowed ]");
 198
 199         }
 200         $partcount++;
 201     }
 202     my $body= join("\n", map { $_->body }  @parts);
 203
 204     $template->param(body=>format_body($body));
 205
 206     $output .= $template->output();
 207     return $output;
 208 }
 209
 210 sub format_body($){
 211     my $body=shift;
 212
 213     # it is not completely clear to me the right way to go here.
 214     # passing things straight to markdown is not working all that
 215     # well.
 216     return "<pre>".escapeHTML($body)."</pre>";
 217 }
 218 ### Utilities
 219
 220 # based on bestdir From Arpit Jain
 221 # http://ikiwiki.info/todo/Bestdir_along_with_bestlink_in_IkiWiki.pm/
 222 # need to clarify license
 223 sub bestpath ($$) { #{{{
 224     my $page=shift;
 225        my $link=shift;
 226        my $cwd=$page;
 227
 228        if ($link=~s/^\/+//) {
 229                $cwd="";
 230        }
 231
 232        do {
 233                my $l=$cwd;
 234                $l.="/" if length $l;
 235                $l.=$link;
 236                if (-d "$config{srcdir}/$l" || -f "$config{srcdir}/$l") {
 237                        return $l;
 238                }
 239        } while $cwd=~s!/?[^/]+$!!;
 240
 241        if (length $config{userdir}) {
 242                my $l = "$config{userdir}/".lc($link);
 243
 244                if (-d $l || -f $l) {
 245                        return $l;
 246                }
 247        }
 248
 249        return "";
 250 } #}}}
 251
 252 sub pagetemplate (@) { #{{{
 253         my %params=@_;
 254         my $page=$params{page};
 255         my $destpage=$params{destpage};
 256         my $template=$params{template};
 257
 258
 259         if (defined($config{mailbox_copyright})){
 260             $template->param(COPYRIGHT=>$config{mailbox_copyright});
 261         }
 262
 263         if (exists $metaheaders{$page} && $template->query(name => "meta")) {
 264                 # avoid duplicate meta lines
 265                 my %seen;
 266                 $template->param(meta => join("\n", grep { (! $seen{$_}) && ($seen{$_}=1) } @{$metaheaders{$page}}));
 267         }
 268 }
 269
 270
 271
 272 package Email::FolderType::MH;
 273
 274 sub match {
 275     my $folder = shift;
 276     return 0 if (! -d $folder);
 277     opendir DIR,$folder || error("opendir failed");
 278
 279     while (<DIR>){
 280       return 0 if (!m|\.| && !m|\.\.| && !m|\d+|);
 281     }
 282     return 1;
 283 }
 284
 285
 286
 287 1;