modules/extfs/mailfs

   1 #!/usr/bin/perl
   2
   3 # MC extfs for (possibly compressed) Berkeley style mailbox files
   4 # Peter Daum <gator@cs.tu-berlin.de> (Jan 1998, mc-4.1.24)
   5
   6 $zcat="zcat";                 # gunzip to stdout
   7 $bzcat="bzip2 -dc";           # bunzip2 to stdout
   8 $file="file";                 # "file" command
   9 $TZ='GMT';                    # default timezone (for Date module)
  10
  11 if (eval "require Date::Parse") { # fancy date parsing available?
  12     import Date::Parse;
  13     $parse_date=
  14         sub {
  15             local $_ =localtime(str2time($_[0],$TZ));
  16             s/^... (.+) (\d\d:\d\d):\d\d (\d\d\d\d)$/$1 $3 $2/;
  17             return $_;
  18         }
  19 } else {                        # use "light" version
  20     $parse_date= sub {
  21         # assumes something like: Mon, 5 Jan 1998 16:08:19 +0200 (GMT+0200)
  22         # if you have mails with another date format, add it here
  23         if (/(\d\d?) ([A-Z][a-z][a-z]) (\d\d\d\d) (\d\d:\d\d):\d\d/) {
  24             return "$2 $1 $3 $4";
  25         }
  26     }
  27 }
  28
  29 sub process_header {
  30     while (<IN>) {
  31         last if /^$/;
  32         die "unexpeced EOF\n" if eof;
  33         if (/^Date: (.*)$/) {
  34             $date=&$parse_date($1);
  35         } elsif (/^Subject: (.*)$/) {
  36             $subj=$1;
  37             $subj=~ s/^(re: ?)+//gi;  # no leading Re:
  38             $subj=~ tr/a-zA-Z0-9//cd; # strip all "special" characters
  39         } elsif (/^From: .*?(\w+)\@/) {
  40             $from=$1;
  41         } elsif (/^To: .*?(\w+)\@/) {
  42             $to=$1;
  43         }
  44     }
  45 }
  46
  47 sub print_dir_line {
  48     $from=$to if ($from eq $user); # otherwise, it would look pretty boring
  49     printf "-r-------- 1 $< $< %d %s %3.3d_%.16s\n",
  50     $line, $date, $msg_nr, "${from}_${subj}";
  51 }
  52
  53 sub mailfs_list {
  54     my $blank = 1;
  55     $user=$ENV{USER}||getlogin||getpwuid($<) || "nobody";
  56
  57     while(1) {
  58         $_=<IN>;
  59         if (!defined($_)) {     # EOF
  60             print_dir_line;
  61             exit 0;
  62         }
  63         if($blank && /^From /) { # Start of header
  64             print_dir_line unless (!$msg_nr);
  65             $msg_nr++;
  66             ($from,$to,$subj,$date)=("none","none","none", "01-01-80");
  67             process_header;
  68             $line=$blank= 0;
  69         } else {
  70             $line++;
  71             $blank= /^$/;
  72         }
  73     }
  74 }
  75
  76 sub mailfs_copyout {
  77     my($source,$dest)=@_;
  78     exit 1 unless (open STDOUT, ">$dest");
  79     ($nr)= ($source =~ /^(\d+)/); # extract message number from "filename"
  80
  81     my $blank = 1;
  82     while(<IN>) {
  83         if($blank && /^From /) {
  84             $msg_nr++;
  85             exit(0) if ($msg_nr > $nr);
  86             $blank= 0;
  87         } else {
  88             $blank= /^$/;
  89         }
  90         print if ($msg_nr == $nr);
  91     }
  92 }
  93
  94 # main {
  95 $msg_nr=0;
  96 $cmd=shift;
  97 $mbox_name=shift;
  98 $_=`$file $mbox_name`;
  99
 100 if (/gzip/) {
 101     exit 1 unless (open IN, "$zcat $mbox_name|");
 102 } elsif (/bzip/) {
 103     exit 1 unless (open IN, "$bzcat $mbox_name|");
 104 } else {
 105     exit 1 unless (open IN, "<$mbox_name");
 106 }
 107
 108 umask 077;
 109
 110 if($cmd eq "list") { &mailfs_list; exit 0; }
 111 elsif($cmd eq "copyout") { &mailfs_copyout(@ARGV); exit 0; }
 112
 113 exit 1;
 114
 115