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     $template->param(HEADERS=>[@headers]);
 175
 176     my $allowed_attachments=$params{allowed_attachments} ||
 177         "maxsize(100kb) and (mimetype(text/plain) or mimetype(text/html))";
 178
 179     my @rawparts=$message->parts;
 180     my @parts=();
 181
 182     if ($message->content_type =~ m|^multipart/alternative|){
 183         #according to RFC 1521, the last part is the most 'faithful'
 184         while (scalar(@rawparts) && !scalar(@parts)){
 185             my $part=pop(@rawparts);
 186             if (check_part($part,$dest,$allowed_attachments)){
 187                 push(@parts,$part);
 188             }
 189         }
 190     } else {
 191         my $partcount=1;
 192         foreach(@rawparts){
 193             my $allowed=check_part($_,$dest,$allowed_attachments );
 194             if (!$allowed) {
 195                 $_->content_type_set('text/plain');
 196                 $_->body_set("[ omitting part $partcount: $allowed ]");
 197
 198             }
 199             push(@parts,$_);
 200             $partcount++;
 201         }
 202     }
 203
 204     my $body= join("\n", map { format_part($_->content_type, $_->body) }
 205                    @parts);
 206
 207     $template->param(body=>format_body($body));
 208
 209     $output .= $template->output();
 210     return $output;
 211 }
 212
 213 sub check_part($$$){
 214     my $part=shift;
 215     my $dest=shift;
 216     my $allowed_attachments=shift;
 217
 218
 219     #this sucks. But someone would need to modify filecheck to
 220     #accept a blob of content. Or maybe hacking with IO::Scalar
 221
 222     my $tmpfile=File::Temp->new();
 223     binmode $tmpfile,':utf8';
 224     print $tmpfile $part->body();
 225
 226     return pagespec_match($dest, $allowed_attachments, file=>$tmpfile);
 227 }
 228
 229 sub format_part($$){
 230     my $mime_type=shift;
 231     my $body=shift;
 232
 233     my $rval="";
 234
 235     # for debugging:
 236 #     $rval .= "[ $mime_type ]\n";
 237
 238     if ($mime_type =~ "^text/html"){
 239         $rval.= $body;
 240     } else {
 241         $rval .= "<pre>".escapeHTML($body)."</pre>";
 242     }
 243     return $rval;
 244 }
 245 sub format_body($){
 246     my $body=shift;
 247
 248     return $body;
 249
 250 }
 251 ### Utilities
 252
 253 # based on bestdir From Arpit Jain
 254 # http://ikiwiki.info/todo/Bestdir_along_with_bestlink_in_IkiWiki.pm/
 255 # need to clarify license
 256 sub bestpath ($$) { #{{{
 257     my $page=shift;
 258        my $link=shift;
 259        my $cwd=$page;
 260
 261        if ($link=~s/^\/+//) {
 262                $cwd="";
 263        }
 264
 265        do {
 266                my $l=$cwd;
 267                $l.="/" if length $l;
 268                $l.=$link;
 269                if (-d "$config{srcdir}/$l" || -f "$config{srcdir}/$l") {
 270                        return $l;
 271                }
 272        } while $cwd=~s!/?[^/]+$!!;
 273
 274        if (length $config{userdir}) {
 275                my $l = "$config{userdir}/".lc($link);
 276
 277                if (-d $l || -f $l) {
 278                        return $l;
 279                }
 280        }
 281
 282        return "";
 283 } #}}}
 284
 285 sub pagetemplate (@) { #{{{
 286         my %params=@_;
 287         my $page=$params{page};
 288         my $destpage=$params{destpage};
 289         my $template=$params{template};
 290
 291
 292         if ($page =~ /.*comments/  && defined($config{mailbox_copyright})){
 293             $template->param(COPYRIGHT=>$config{mailbox_copyright});
 294         }
 295
 296         if (exists $metaheaders{$page} && $template->query(name => "meta")) {
 297                 # avoid duplicate meta lines
 298                 my %seen;
 299                 $template->param(meta => join("\n", grep { (! $seen{$_}) && ($seen{$_}=1) } @{$metaheaders{$page}}));
 300         }
 301 }
 302
 303
 304
 305 package Email::FolderType::MH;
 306
 307 sub match {
 308     my $folder = shift;
 309     return 0 if (! -d $folder);
 310     opendir DIR,$folder || error("opendir failed");
 311
 312     while (<DIR>){
 313       return 0 if (!m|\.| && !m|\.\.| && !m|\d+|);
 314     }
 315     return 1;
 316 }
 317
 318
 319
 320 1;