vfs/extfs/mailfs.in

   1 #! @PERL@ -w
   2
   3 use bytes;
   4
   5 # MC extfs for (possibly compressed) Berkeley style mailbox files
   6 # Peter Daum <gator@cs.tu-berlin.de> (Jan 1998, mc-4.1.24)
   7
   8 $zcat="zcat";                 # gunzip to stdout
   9 $bzcat="bzip2 -dc";           # bunzip2 to stdout
  10 $lzcat="lzma -dc";            # unlzma to stdout
  11 $xzcat="xz -dc";              # unxz to stdout
  12 $file="file";                 # "file" command
  13 $TZ='GMT';                    # default timezone (for Date module)
  14
  15 if (eval "require Date::Parse") {
  16     import Date::Parse;
  17     $parse_date=
  18         sub {
  19             local $ftime = str2time($_[0],$TZ);
  20             $_ = localtime($ftime);
  21             /^(...) (...) ([ \d]\d) (\d\d:\d\d):\d\d (\d\d\d\d)$/;
  22             if ($ftime + 6 * 30 * 24 * 60 * 60 < $now ||
  23                 $ftime + 60 * 60 > $now) {
  24                 return "$2 $3 $5";
  25             } else {
  26                 return "$2 $3 $4";
  27             }
  28         }
  29 } elsif (eval "require Date::Manip") {
  30     import Date::Manip;
  31     $parse_date=
  32         sub {
  33             return UnixDate($_[0], "%l"); # "ls -l" format
  34         }
  35 } else {                        # use "light" version
  36     $parse_date= sub {
  37         local $mstring='GeeJanFebMarAprMayJunJulAugSepOctNovDec';
  38         # assumes something like: Mon, 5 Jan 1998 16:08:19 +0200 (GMT+0200)
  39         # if you have mails with another date format, add it here
  40         if (/(\d\d?) ([A-Z][a-z][a-z]) (\d\d\d\d) (\d\d?):(\d\d)/) {
  41             $day = $1;
  42             $month = $2;
  43             $mon = index($mstring,$month) / 3;
  44             $year = $3;
  45             $hour = $4;
  46             $min = $5;
  47             # pass time not year for files younger than roughly 6 months
  48             # but not for files with dates more than 1-2 hours in the future
  49             if ($year * 12 + $mon > $thisyear * 12 + $thismon - 7 &&
  50                 $year * 12 + $mon <= $thisyear * 12 + $thismon &&
  51                 ! (($year * 12 + $mon) * 31 + $day ==
  52                 ($thisyear * 12 + $thismon) * 31 + $thisday &&
  53                 $hour > $thishour + 2)) {
  54                 return "$month $day $hour:$min";
  55             } else {
  56                 return "$month $day $year";
  57             }
  58         }
  59         # Y2K bug.
  60         # Date: Mon, 27 Mar 100 16:30:47 +0000 (GMT)
  61         if (/(\d\d?) ([A-Z][a-z][a-z]) (1?\d\d) (\d\d?):(\d\d)/) {
  62             $day = $1;
  63             $month = $2;
  64             $mon = index($mstring,$month) / 3;
  65             $year = 1900 + $3;
  66             $hour = $4;
  67             $min = $5;
  68             if ($year < 1970) {
  69                 $year += 100;
  70             }
  71             if ($year * 12 + $mon > $thisyear * 12 + $thismon - 7 &&
  72                 $year * 12 + $mon <= $thisyear * 12 + $thismon &&
  73                 ! (($year * 12 + $mon) * 31 + $day ==
  74                 ($thisyear * 12 + $thismon) * 31 + $thisday &&
  75                 $hour > $thishour + 2)) {
  76                 return "$month $day $hour:$min";
  77             } else {
  78                 return "$month $day $year";
  79             }
  80         }
  81         # AOLMail(SM).
  82         # Date: Sat Jul 01 10:06:06 2000
  83         if (/([A-Z][a-z][a-z]) (\d\d?) (\d\d?):(\d\d)(:\d\d)? (\d\d\d\d)/) {
  84             $month = $1;
  85             $mon = index($mstring,$month) / 3;
  86             $day = $2;
  87             $hour = $3;
  88             $min = $4;
  89             $year = $6;
  90             if ($year * 12 + $mon > $thisyear * 12 + $thismon - 7 &&
  91                 $year * 12 + $mon <= $thisyear * 12 + $thismon &&
  92                 ! (($year * 12 + $mon) * 31 + $day ==
  93                 ($thisyear * 12 + $thismon) * 31 + $thisday &&
  94                 $hour > $thishour + 2)) {
  95                 return "$month $day $hour:$min";
  96             } else {
  97                 return "$month $day $year";
  98             }
  99         }
 100         # Fallback
 101         return $fallback;
 102     }
 103 }
 104
 105 sub process_header {
 106     while (<IN>) {
 107         $size+=length;
 108         s/\r$//;
 109         last if /^$/;
 110         die "unexpected EOF\n" if eof;
 111         if (/^date:\s(.*)$/i) {
 112             $date=&$parse_date($1);
 113         } elsif (/^subject:\s(.*)$/i) {
 114             $subj=lc($1);
 115             $subj=~ s/^(re:\s?)+//gi;  # no leading Re:
 116             $subj=~ tr/a-zA-Z0-9//cd; # strip all "special" characters
 117         } elsif (/^from:\s.*?(\w+)\@/i) {
 118             $from=$1;
 119         } elsif (/^to:\s.*?(\w+)\@/i) {
 120             $to=lc($1);
 121         }
 122     }
 123 }
 124
 125 sub print_dir_line {
 126     $from=$to if ($from eq $user); # otherwise, it would look pretty boring
 127     $date=localtime(time) if (!defined $date);
 128     printf "-r-------- 1 $< $< %d %s %3.3d_%.25s\n",
 129     $size, $date, $msg_nr, "${from}_${subj}";
 130
 131 }
 132
 133 sub mailfs_list {
 134     my $blank = 1;
 135     $user=$ENV{USER}||getlogin||getpwuid($<) || "nobody";
 136
 137     while(<IN>) {
 138         s/\r$//;
 139         if($blank && /^from\s+\w+(\.\w+)*@/i) { # Start of header
 140             print_dir_line unless (!$msg_nr);
 141             $size=length;
 142             $msg_nr++;
 143             ($from,$to,$subj,$date)=("none","none","none", "01-01-80");
 144             process_header;
 145             $line=$blank=0;
 146         } else {
 147             $size+=length;
 148             $line++;
 149             $blank= /^$/;
 150         }
 151     }
 152     print_dir_line unless (!$msg_nr);
 153     exit 0;
 154 }
 155
 156 sub mailfs_copyout {
 157     my($source,$dest)=@_;
 158     exit 1 unless (open STDOUT, ">$dest");
 159     ($nr)= ($source =~ /^(\d+)/); # extract message number from "filename"
 160
 161     my $blank = 1;
 162     while(<IN>) {
 163         s/\r$//;
 164         if($blank && /^from\s+\w+(\.\w+)*@/i) {
 165             $msg_nr++;
 166             exit(0) if ($msg_nr > $nr);
 167             $blank= 0;
 168         } else {
 169             $blank= /^$/;
 170         }
 171         print if ($msg_nr == $nr);
 172     }
 173 }
 174
 175 # main {
 176 exit 1 unless ($#ARGV >= 1);
 177 $msg_nr=0;
 178 $cmd=shift;
 179 $mbox_name=shift;
 180 my $mbox_qname = quotemeta ($mbox_name);
 181 $_=`$file $mbox_qname`;
 182
 183 if (/gzip/) {
 184     exit 1 unless (open IN, "$zcat $mbox_qname|");
 185 } elsif (/bzip/) {
 186     exit 1 unless (open IN, "$bzcat $mbox_qname|");
 187 } elsif (/lzma/) {
 188     exit 1 unless (open IN, "$lzcat $mbox_qname|");
 189 } elsif (/xz/) {
 190     exit 1 unless (open IN, "$xzcat $mbox_qname|");
 191 } else {
 192     exit 1 unless (open IN, "<$mbox_name");
 193 }
 194
 195 umask 077;
 196
 197 if($cmd eq "list") {
 198     $now = time;
 199     $_ = localtime($now);
 200     /^... (... [ \d]\d \d\d:\d\d):\d\d \d\d\d\d$/;
 201     $fallback = $1;
 202     $nowstring=`date "+%Y %m %d %H"`;
 203     ($thisyear, $thismon, $thisday, $thishour) = split(/ /, $nowstring);
 204     &mailfs_list;
 205     exit 0;
 206 }
 207 elsif($cmd eq "copyout") { &mailfs_copyout(@ARGV); exit 0; }
 208
 209 exit 1;