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