"Fossies" - the Fresh Open Source Software Archive

Member "sendpage-1.001001/email2page" (3 Jan 2008, 4529 Bytes) of package /linux/privat/old/sendpage-1.001001.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #!/usr/local/bin/perl
    2 #
    3 # tool designed to re-write emails into pages
    4 #
    5 # $Id: email2page 158 2004-01-16 02:03:20Z nemies $
    6 #
    7 # Copyright (C) 2000-2004 Kees Cook
    8 # kees@outflux.net, http://outflux.net/
    9 #
   10 # This program is free software; you can redistribute it and/or
   11 # modify it under the terms of the GNU General Public License
   12 # as published by the Free Software Foundation; either version 2
   13 # of the License, or (at your option) any later version.
   14 #
   15 # This program is distributed in the hope that it will be useful,
   16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18 # GNU General Public License for more details.
   19 #
   20 # You should have received a copy of the GNU General Public License
   21 # along with this program; if not, write to the Free Software
   22 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
   23 # http://www.gnu.org/copyleft/gpl.html
   24 
   25 =head1 NAME
   26 
   27 email2page - converts RFC822 email text into text suitable for paging
   28 
   29 =head1 SYNOPSIS
   30 
   31 email2page [-C CONF] [-h]
   32 
   33 =head1 OPTIONS
   34 
   35 =over 4
   36 
   37 =item -C CONF
   38 
   39 Read the configuration file CONF instead of /etc/email2page.conf for the
   40 rewriting rules.
   41 
   42 =item -h
   43 
   44 Display a summary of all the available command line options (and there
   45 sure aren't many).
   46 
   47 =back
   48 
   49 =head1 DESCRIPTION
   50 
   51 This tool is used to break down an email into a shortened version, using
   52 a configurable set of rewriting rules, found in /etc/email2page.conf.
   53 email2page reads STDIN, and writes to STDOUT.  Any errors will be reported
   54 on STDERR.  It was designed to be used with 'sendpage'.
   55 
   56 =head1 AUTHOR
   57 
   58 Kees Cook <kees@outflux.net>
   59 
   60 =head1 BUGS
   61 
   62 All the bugs with the program will probably come from the config file, as
   63 several of the items are run with Perl's 'eval' statement.  Please see the
   64 documentation in the /etc/email2page.conf file.
   65 
   66 =head1 COPYRIGHT
   67 
   68 email2page is free software; it can be used under the terms of the GNU
   69 General Public License.
   70 
   71 =head1 SEE ALSO
   72 
   73 perl(1), sendpage(1), Mail::Internet(3)
   74 
   75 =cut
   76 
   77 use Getopt::Std;
   78 use Mail::Internet;
   79 use Mail::Header;
   80 use IO::File;
   81 
   82 my %opts;
   83 my $VERSION="0.1";
   84 
   85 sub Usage {
   86     die "Usage: $0 [OPTIONS]
   87 
   88 version $VERSION
   89 
   90 Parses an email message based on the values of the conf file.  Reads stdin
   91 and produces results to stdout.
   92 
   93 -C CONF             read CONF instead of /etc/email2page.conf
   94 -h                  you're reading it already.  :)
   95 
   96 ";
   97 }
   98 
   99 my $maxlines=0;         # how many lines to process of the body
  100 my $prefix="";          # prefix written to page text
  101 my $suffix="";          # suffix written to page text
  102 my $headerjoin="|";     # how to join header tags in the page text
  103 my $headbodyjoin="\n";      # how to join the header and body section
  104 my @headrules=();       # rules for handling header tags
  105 my @bodyrules=();       # rules for handling body text
  106 
  107 # get our options
  108 if (!getopts('hC:',\%opts) || $opts{h}) {
  109         Usage();
  110 }
  111 
  112 $opts{C}="/etc/email2page.conf" unless ($opts{C});
  113 
  114 $fh = new IO::File $opts{C}, "r";
  115 if (!defined($fh)) {
  116     die "Cannot read '$opts{C}' file: $!\n";
  117 }
  118 $num=0;
  119 foreach $line (<$fh>) {
  120     chomp($line);
  121     $num++;
  122     # skip comments and blanks
  123     next if ($line =~ /^\s*#/ || $line =~ /^\s*$/);
  124 
  125     ($cmd,$arg)=split(/:/,$line,2);
  126 
  127     if ($cmd eq "headerjoin") {
  128         $headerjoin=$arg;
  129     }
  130     elsif ($cmd eq "headbodyjoin") {
  131         $headbodyjoin=$arg;
  132     }
  133     elsif ($cmd eq "header") {
  134         push(@headrules,$arg);
  135     }
  136     elsif ($cmd eq "body") {
  137         push(@bodyrules,$arg);
  138     }
  139     elsif ($cmd eq "prefix") {
  140         $prefix=$arg;
  141     }
  142     elsif ($cmd eq "suffix") {
  143         $suffix=$arg;
  144     }
  145     elsif ($cmd eq "maxlines") {
  146         $maxlines=$arg;
  147     }
  148     else {
  149         warn "unknown command '$cmd' in '$opts{C}', line $num\n";
  150     }
  151 }
  152 undef $fh;
  153 
  154 # read in our email message
  155 my $mail=Mail::Internet->new(\*STDIN);
  156 my $head=$mail->head();
  157 my $body=$mail->body();
  158 @body=@$body;
  159 
  160 # trim the body down to "maxlines"
  161 if ($maxlines > 0 && $#body > $maxlines) {
  162     splice @body, $maxlines;
  163 }
  164 
  165 my @okheads=();
  166 
  167 # handle rewriting the headers
  168 foreach $tag ($head->tags()) {
  169     foreach $index (0 .. ($head->count($tag)-1)) {
  170         $matched=0;
  171         $text="$tag: ".$head->get($tag,$index);
  172         chomp($text);
  173         foreach $rule (@headrules) {
  174             if (eval "\$text =~ $rule") {
  175                 $matched=1;
  176             }
  177         }
  178         if ($matched) {
  179             push(@okheads,$text);
  180         }
  181     }
  182 }
  183 
  184 # handle rewriting the body
  185 foreach $rule (@bodyrules) {
  186     foreach $index (0 .. $#body) {
  187         eval "\$body[$index] =~ $rule";
  188     }
  189 }
  190 
  191 $result=eval $prefix;
  192 $result.=eval "join($headerjoin,\@okheads)";
  193 $result.=eval $headbodyjoin;
  194 $result.=join("",@body);
  195 $result.=eval $suffix;
  196 
  197 print $result;