src/vfs/extfs/helpers/mailfs.in

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