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