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