« back to all changes in this revision
Viewing changes to run-mailcap
- browse files at revision 4
- compare with another revision
- download diff
- download tarball
- view history from revision 4
- Committer: Bazaar Package Importer
- Author(s): Brian White
- Date: 2008-06-18 15:44:03 UTC
- mfrom: (3.1.2 intrepid)
- Revision ID: james.westby@ubuntu.com-20080618154403-2gvazf5ceitztkds
Tags: 3.44-1
* added new mime.types (closes: 485863, 485929, 472262)
* make default type "application/octet-stream" (closes: 445698)
* added build-depends on debhelper (closes: 484860)
* make default type "application/octet-stream" (closes: 445698)
* added build-depends on debhelper (closes: 484860)
- files added:
- rfcs/rfc1522.txt
- files removed:
- debian/#postinst#
- files modified:
- debian/changelog
added
removed
run-mailcap
15
15
$shrmimetyp="/usr/share/etc/mime.types";
16
16
$locmimetyp="/usr/local/etc/mime.types";
17
17
$usrmimetyp="$ENV{HOME}/.mime.types";
18
$xtermprgrm="/usr/bin/x-terminal-emulator"; # xterm?
19
$defmimetyp="application/*";
18
$xtermprgrm="/usr/bin/x-terminal-emulator"; # xterm?
19
$defmimetyp="application/octet-stream";
20
20
$quotedsemi=chr(255);
21
21
$quotedprct=chr(254);
22
22
$retcode=0;
24
24
25
25
%patterntypes =
26
26
(
27
'(^|/)crontab[^/]+$' => 'text/x-crontab', #'
28
'/man\d*/' => 'application/x-troff-man', #'
29
'\.\d[^\.]*$' => 'application/x-troff-man', #'
27
'(^|/)crontab[^/]+$' => 'text/x-crontab', #'
28
'/man\d*/' => 'application/x-troff-man', #'
29
'\.\d[^\.]*$' => 'application/x-troff-man', #'
30
30
);
31
31
32
32
33
33
34
34
sub Usage {
35
my($error) = @_;
36
print STDERR $error,"\n\n" if $error;
37
38
print STDERR "Use: $0 <--opt=val> [...] [<mime-type>:[<encoding>:]]<file> [...]\n\n";
39
print STDERR "Options:\n";
40
print STDERR " action specify what action to do on these files (default=view)\n";
41
print STDERR " debug be verbose about what's going on (any non-zero value)\n";
42
print STDERR "\n";
43
print STDERR "Mime-Type:\n";
44
print STDERR " any standard mime type designation in the form <class>/<subtype> -- if\n";
45
print STDERR " not specified, it will be determined from the filename extension\n\n";
46
print STDERR "Encoding:\n";
47
print STDERR " how the file (and type) has been encoded (only \"gzip\", \"bzip\", \"bzip2\"\n";
48
print STDERR " and \"compress\" are supported) -- if not specified, it will be determined\n";
49
print STDERR " from the filename extension\n\n";
50
51
exit ($error ? 1 : 0);
35
my($error) = @_;
36
print STDERR $error,"\n\n" if $error;
37
38
print STDERR "Use: $0 <--action=VAL> [--debug] [MIME-TYPE:[ENCODING:]]FILE [...]\n\n";
39
print STDERR "Options:\n";
40
print STDERR " action specify what action to do on these files (default=view)\n";
41
print STDERR " debug be verbose about what's going on\n";
42
print STDERR "\n";
43
print STDERR "Mime-Type:\n";
44
print STDERR " any standard mime type designation in the form <class>/<subtype> -- if\n";
45
print STDERR " not specified, it will be determined from the filename extension\n\n";
46
print STDERR "Encoding:\n";
47
print STDERR " how the file (and type) has been encoded (only \"gzip\", \"bzip\", \"bzip2\"\n";
48
print STDERR " and \"compress\" are supported) -- if not specified, it will be determined\n";
49
print STDERR " from the filename extension\n\n";
50
51
exit ($error ? 1 : 0);
52
52
}
53
53
54
54
55
55
56
56
sub EncodingForFile {
57
my($file) = @_;
58
my $encoding;
59
60
if ($file =~ m/\.gz$/) { $encoding = "gzip"; }
61
if ($file =~ m/\.bz$/) { $encoding = "bzip"; }
62
if ($file =~ m/\.bz2$/) { $encoding = "bzip2"; }
63
if ($file =~ m/\.Z$/) { $encoding = "compress"; }
64
65
print STDERR " - file \"$file\" has encoding \"$encoding\"\n" if $debug && $encoding;
66
67
return $encoding;
57
my($file) = @_;
58
my $encoding;
59
60
if ($file =~ m/\.gz$/) { $encoding = "gzip"; }
61
if ($file =~ m/\.bz$/) { $encoding = "bzip"; }
62
if ($file =~ m/\.bz2$/) { $encoding = "bzip2"; }
63
if ($file =~ m/\.Z$/) { $encoding = "compress"; }
64
65
print STDERR " - file \"$file\" has encoding \"$encoding\"\n" if $debug && $encoding;
66
67
return $encoding;
68
68
}
69
69
70
70
71
71
72
72
sub ReadMimetypes {
73
my($file) = @_;
74
75
return unless -r $file;
76
77
print STDERR " - Reading mime.types file \"$file\"...\n" if $debug;
78
open(MIMETYPES,"<$file") || die "Error: could not read \"$file\" -- $!\n";
79
while (<MIMETYPES>) {
80
chomp; lc; s/\#.*$//;
81
next if (m/^\s*$/);
82
83
my($type,@exts) = split;
84
85
foreach (@exts) {
86
$mimetypes{$_} = $type unless exists $mimetypes{$_};
87
}
88
}
89
close MIMETYPES;
73
my($file) = @_;
74
75
return unless -r $file;
76
77
print STDERR " - Reading mime.types file \"$file\"...\n" if $debug;
78
open(MIMETYPES,"<$file") || die "Error: could not read \"$file\" -- $!\n";
79
while (<MIMETYPES>) {
80
chomp;
81
s/\#.*$//;
82
next if (m/^\s*$/);
83
84
$_=lc($_);
85
my($type,@exts) = split;
86
87
foreach (@exts) {
88
$mimetypes{$_} = $type unless exists $mimetypes{$_};
89
}
90
}
91
close MIMETYPES;
90
92
}
91
93
92
94
93
95
94
96
sub ReadMailcap {
95
my($file) = @_;
96
my $line = "";
97
98
return unless -r $file;
99
100
print STDERR " - Reading mailcap file \"$file\"...\n" if $debug;
101
open(MAILCAP,"<$file") || die "Error: could not read \"$file\" -- $!\n";
102
while (<MAILCAP>) {
103
chomp;
104
s/^\s+// if $line;
105
$line .= $_;
106
next unless $line;
107
if ($line =~ m/^\s*\#/) {
108
$line = "";
109
next;
110
}
111
if ($line =~ m/\\$/) {
112
$line =~ s/\\$//;
113
} else {
114
$line =~ s/\\;/$quotedsemi/go;
115
$line =~ s/\\%/$quotedprct/go;
116
push @mailcap,$line;
117
$line = "";
118
}
119
}
120
close MAILCAP;
97
my($file) = @_;
98
my $line = "";
99
100
return unless -r $file;
101
102
print STDERR " - Reading mailcap file \"$file\"...\n" if $debug;
103
open(MAILCAP,"<$file") || die "Error: could not read \"$file\" -- $!\n";
104
while (<MAILCAP>) {
105
chomp;
106
s/^\s+// if $line;
107
$line .= $_;
108
next unless $line;
109
if ($line =~ m/^\s*\#/) {
110
$line = "";
111
next;
112
}
113
if ($line =~ m/\\$/) {
114
$line =~ s/\\$//;
115
} else {
116
$line =~ s/\\;/$quotedsemi/go;
117
$line =~ s/\\%/$quotedprct/go;
118
push @mailcap,$line;
119
$line = "";
120
}
121
}
122
close MAILCAP;
121
123
}
122
124
123
125
124
126
125
127
sub TempFile {
126
my($template) = @_;
127
my($cmd,$head,$tail,$tmpfile);
128
129
($head,$tail) = split(/%s/,$template,2);
130
131
# $tmpfile = POSIX::tmpnam($name);
132
# unlink($tmpfile);
133
134
$cmd = "tempfile --mode=600";
135
$cmd .= " --prefix $head" if $head;
136
$cmd .= " --suffix $tail" if $tail;
137
138
$tmpfile = `$cmd`;
139
chomp($tmpfile);
140
141
# $tmpfile = $ENV{TMPDIR};
142
# $tmpfile = "/tmp" unless $tmpfile;
143
# $tmpfile.= "/$name";
144
# unlink($tmpfile);
145
146
return $tmpfile;
128
my($template) = @_;
129
my($cmd,$head,$tail,$tmpfile);
130
$template = "" unless (defined $template);
131
132
($head,$tail) = split(/%s/,$template,2);
133
134
# $tmpfile = POSIX::tmpnam($name);
135
# unlink($tmpfile);
136
137
$cmd = "tempfile --mode=600";
138
$cmd .= " --prefix $head" if $head;
139
$cmd .= " --suffix $tail" if $tail;
140
141
$tmpfile = `$cmd`;
142
chomp($tmpfile);
143
144
# $tmpfile = $ENV{TMPDIR};
145
# $tmpfile = "/tmp" unless $tmpfile;
146
# $tmpfile.= "/$name";
147
# unlink($tmpfile);
148
149
return $tmpfile;
147
150
}
148
151
149
152
150
153
151
154
sub SaveStdin {
152
my($match) = @_;
153
my($tmpfile,$amt,$buf);
154
155
$tmpfile = $1 if ($match =~ m/nametemplate=(.*?)\s*($|;)/);
156
$tmpfile = TempFile($tmpfile);
157
open(TMPFILE,">$tmpfile") || die "Error: could not write \"$tmpfile\" -- $!\n";
158
do {
159
$amt = read(STDIN,$buf,102400);
160
print TMPFILE $buf if $amt;
161
} while ($amt != 0);
162
close(TMPFILE);
163
164
return $tmpfile;
155
my($match) = @_;
156
my($tmpfile,$amt,$buf);
157
158
$tmpfile = $1 if ($match =~ m/nametemplate=(.*?)\s*($|;)/);
159
$tmpfile = TempFile($tmpfile);
160
open(TMPFILE,">$tmpfile") || die "Error: could not write \"$tmpfile\" -- $!\n";
161
do {
162
$amt = read(STDIN,$buf,102400);
163
print TMPFILE $buf if $amt;
164
} while ($amt != 0);
165
close(TMPFILE);
166
167
return $tmpfile;
165
168
}
166
169
167
170
168
171
169
172
sub DecodeFile {
170
my($efile,$encoding,$action) = @_;
171
my($file,$res);
172
173
$file = $efile;
174
$file =~ s!^.*/!!; # remove leading directories
175
$file =~ s!\.[^\.]*$!!; # remove encoding extension
176
$file =~ s!^\.?[^\.]*!%s!; # replace name with placeholder
177
$file = undef if ($efile eq '-');
178
my $tmpfile = TempFile($file);
179
180
print STDERR " - decoding \"$efile\" as \"$tmpfile\"\n" if $debug;
181
182
# unlink($tmpfile); # should still be acceptable for "compose" output even if exists
183
return $tmpfile if (($efile ne '-' && ! -e $efile) || $action eq 'compose');
184
185
if ($encoding eq "gzip") {
186
if ($efile eq '-') {
187
$res = system "gzip -d >\Q$tmpfile\E";
188
} else {
189
$res = system "gzip -dc \Q$efile\E >\Q$tmpfile\E";
190
}
191
} elsif ($encoding eq "bzip") {
192
if ($efile eq '-') {
193
$res = system "bzip -d >\Q$tmpfile\E";
194
} else {
195
$res = system "bzip -dc <\Q$efile\E >\Q$tmpfile\E";
196
}
197
} elsif ($encoding eq "bzip2") {
198
if ($efile eq '-') {
199
$res = system "bzip2 -d >\Q$tmpfile\E";
200
} else {
201
$res = system "bzip2 -dc <\Q$efile\E >\Q$tmpfile\E";
202
}
203
} elsif ($encoding eq "compress") {
204
if ($efile eq '-') {
205
$res = system "uncompress >\Q$tmpfile\E";
206
} else {
207
$res = system "uncompress <\Q$efile\E >\Q$tmpfile\E";
208
}
209
} else {
210
die "Fatal: unknown encoding \"$encoding\" at";
211
}
212
213
$res = int($res/256);
214
if ($res != 0) {
215
print STDERR "Error: could not decode \"$efile\" -- $!\n";
216
$retcode = 2 if ($retcode < 2);
217
unlink($tmpfile);
218
return;
219
}
220
221
# chmod 0600,$tmpfile; # done already by TempFile
222
return $tmpfile;
173
my($efile,$encoding,$action) = @_;
174
my($file,$res);
175
176
$file = $efile;
177
$file =~ s!^.*/!!; # remove leading directories
178
$file =~ s!\.[^\.]*$!!; # remove encoding extension
179
$file =~ s!^\.?[^\.]*!%s!; # replace name with placeholder
180
$file = undef if ($efile eq '-');
181
my $tmpfile = TempFile($file);
182
183
print STDERR " - decoding \"$efile\" as \"$tmpfile\"\n" if $debug;
184
185
# unlink($tmpfile); # should still be acceptable for "compose" output even if exists
186
return $tmpfile if (($efile ne '-' && ! -e $efile) || $action eq 'compose');
187
188
if ($encoding eq "gzip") {
189
if ($efile eq '-') {
190
$res = system "gzip -d >\Q$tmpfile\E";
191
} else {
192
$res = system "gzip -dc \Q$efile\E >\Q$tmpfile\E";
193
}
194
} elsif ($encoding eq "bzip") {
195
if ($efile eq '-') {
196
$res = system "bzip -d >\Q$tmpfile\E";
197
} else {
198
$res = system "bzip -dc <\Q$efile\E >\Q$tmpfile\E";
199
}
200
} elsif ($encoding eq "bzip2") {
201
if ($efile eq '-') {
202
$res = system "bzip2 -d >\Q$tmpfile\E";
203
} else {
204
$res = system "bzip2 -dc <\Q$efile\E >\Q$tmpfile\E";
205
}
206
} elsif ($encoding eq "compress") {
207
if ($efile eq '-') {
208
$res = system "uncompress >\Q$tmpfile\E";
209
} else {
210
$res = system "uncompress <\Q$efile\E >\Q$tmpfile\E";
211
}
212
} else {
213
die "Fatal: unknown encoding \"$encoding\" at";
214
}
215
216
$res = int($res/256);
217
if ($res != 0) {
218
print STDERR "Error: could not decode \"$efile\" -- $!\n";
219
$retcode = 2 if ($retcode < 2);
220
unlink($tmpfile);
221
return;
222
}
223
224
# chmod 0600,$tmpfile; # done already by TempFile
225
return $tmpfile;
223
226
}
224
227
225
228
226
229
227
230
sub EncodeFile {
228
my($dfile,$efile,$encoding) = @_;
229
my($res);
230
231
print STDERR " - encoding \"$dfile\" as \"$efile\"\n";
232
233
if ($encoding eq "gzip") {
234
if ($efile eq '-') {
235
$res = system "gzip -c \Q$dfile\E";
236
} else {
237
$res = system "gzip -c \Q$dfile\E >\Q$efile\E";
238
}
239
} elsif ($encoding eq "compress") {
240
if ($efile eq '-') {
241
$res = system "compress <\Q$dfile\E";
242
} else {
243
$res = system "compress <\Q$dfile\E >\Q$efile\E";
244
}
245
} else {
246
die "Fatal: unknown encoding \"$encoding\" at";
247
}
248
249
$res = int($res/256);
250
if ($res != 0) {
251
print STDERR "Error: could not encode \"$efile\" (left as \"$dfile\")\n";
252
$retcode = 2 if ($retcode < 2);
253
return;
254
}
255
256
return $dfile;
231
my($dfile,$efile,$encoding) = @_;
232
my($res);
233
234
print STDERR " - encoding \"$dfile\" as \"$efile\"\n";
235
236
if ($encoding eq "gzip") {
237
if ($efile eq '-') {
238
$res = system "gzip -c \Q$dfile\E";
239
} else {
240
$res = system "gzip -c \Q$dfile\E >\Q$efile\E";
241
}
242
} elsif ($encoding eq "compress") {
243
if ($efile eq '-') {
244
$res = system "compress <\Q$dfile\E";
245
} else {
246
$res = system "compress <\Q$dfile\E >\Q$efile\E";
247
}
248
} else {
249
die "Fatal: unknown encoding \"$encoding\" at";
250
}
251
252
$res = int($res/256);
253
if ($res != 0) {
254
print STDERR "Error: could not encode \"$efile\" (left as \"$dfile\")\n";
255
$retcode = 2 if ($retcode < 2);
256
return;
257
}
258
259
return $dfile;
257
260
}
258
261
259
262
260
263
261
264
sub ExtensionMimetype {
262
my($ext) = @_;
263
my($typ);
264
265
unless ($donemimetypes) {
266
ReadMimetypes($usrmimetyp);
267
ReadMimetypes($locmimetyp);
268
ReadMimetypes($shrmimetyp);
269
ReadMimetypes($etcmimetyp);
270
$donemimetypes = 1;
271
}
272
273
$typ = $mimetypes{lc($ext)};
274
275
print STDERR " - extension \"$ext\" maps to mime-type \"$typ\"\n" if $debug;
276
return $typ;
265
my($ext) = @_;
266
my($typ);
267
268
unless ($donemimetypes) {
269
ReadMimetypes($usrmimetyp);
270
ReadMimetypes($locmimetyp);
271
ReadMimetypes($shrmimetyp);
272
ReadMimetypes($etcmimetyp);
273
$donemimetypes = 1;
274
}
275
276
$typ = $mimetypes{lc($ext)};
277
278
print STDERR " - extension \"$ext\" maps to mime-type \"$typ\"\n" if $debug;
279
return $typ;
277
280
}
278
281
279
282
280
283
281
284
sub PatternMimetype {
282
my($file) = @_;
283
my($key,$val);
284
285
while (($key,$val) = each %patterntypes) {
286
if ($file =~ m!$key!i) {
287
print STDERR " - file \"$file\" maps to mime-type \"$val\"\n" if $debug;
288
return $val;
289
}
290
}
291
292
print STDERR " - file \"$file\" does not conform to any known pattern\n" if $debug;
293
return;
285
my($file) = @_;
286
my($key,$val);
287
288
while (($key,$val) = each %patterntypes) {
289
if ($file =~ m!$key!i) {
290
print STDERR " - file \"$file\" maps to mime-type \"$val\"\n" if $debug;
291
return $val;
292
}
293
}
294
295
print STDERR " - file \"$file\" does not conform to any known pattern\n" if $debug;
296
return;
294
297
}
295
298
296
299
297
300
298
301
sub FileMimetype {
299
my($file) = @_;
300
my($ext) = ($file =~ m!\.([^/\.]+)$!);
301
302
my $type;
303
304
$type = ExtensionMimetype($ext) if $ext;
305
$type = PatternMimetype($file) unless $type;
306
307
return $type;
302
my($file) = @_;
303
my($ext) = ($file =~ m!\.([^/\.]+)$!);
304
305
my $type;
306
307
$type = ExtensionMimetype($ext) if $ext;
308
$type = PatternMimetype($file) unless $type;
309
310
return $type;
308
311
}
309
312
310
313
311
314
315
@files = ();
312
316
foreach (@ARGV) {
313
print STDERR " - parsing parameter \"$_\"\n" if $debug;
314
if (m!^(-h|--help)$!) {
315
Usage();
316
exit(0);
317
} elsif (m!^--(.*?)=(.*)$!) {
318
print STDERR "Warning: definition of \"$1=$2\" overrides value \"${$1}\"\n" if ($ {$1} && $ {$1} != $2);
319
$ {$1}=$2;
320
} elsif (m!^[^/:]+/[^/:]+:[^/:]+:!) {
321
push @files,$_;
322
} elsif (m!^([^/:]+/[^/:]+):(.*)!) {
323
my $type = $1;
324
my $file = $2;
325
my $code = EncodingForFile($file);
326
push @files,"${type}:${code}:${file}";
327
} else {
328
my $file = $_;
329
my $code = EncodingForFile($file);
330
my $type;
331
if ($code) {
332
my $efile = $file;
333
$efile =~ s/\.[^\.]+$//;
334
$type = FileMimetype($efile);
335
} else {
336
$type = FileMimetype($file);
337
}
338
if ($type) {
339
push @files,"${type}:${code}:${file}";
340
} else {
341
print STDERR "Warning: unknown mime-type for \"$file\" -- using \"$defmimetyp\"\n";
342
push @files,"${defmimetyp}:${code}:${file}";
343
}
344
}
317
print STDERR " - parsing parameter \"$_\"\n" if $debug;
318
if (m!^(-h|--help)$!) {
319
Usage();
320
exit(0);
321
} elsif (m!^--(.*?)=(.*)$!) {
322
print STDERR "Warning: definition of \"$1=$2\" overrides value \"${$1}\"\n" if ($ {$1} && $ {$1} != $2);
323
$ {$1}=$2;
324
} elsif (m!^--(.*?)$!) {
325
print STDERR "Warning: definition of \"$1=$2\" overrides value \"${$1}\"\n" if ($ {$1} && $ {$1} != 1);
326
$ {$1}=1;
327
} elsif (m!^[^/:]+/[^/:]+:[^/:]+:!) {
328
push @files,$_;
329
} elsif (m!^([^/:]+/[^/:]+):(.*)! && ! -e $_) {
330
my $file = $_;
331
my $type = $1;
332
my $file = $2;
333
my $code = EncodingForFile($file);
334
push @files,"${type}:${code}:${file}";
335
print STDERR " - file \"$file\" does not exist -- assuming mime-type specification of \"${type}\"\n" if $debug;
336
} else {
337
my $file = $_;
338
my $code = EncodingForFile($file);
339
my $type;
340
if ($code) {
341
my $efile = $file;
342
$efile =~ s/\.[^\.]+$//;
343
$type = FileMimetype($efile);
344
} else {
345
$type = FileMimetype($file);
346
}
347
if ($type) {
348
push @files,"${type}:${code}:${file}";
349
} else {
350
print STDERR "Warning: unknown mime-type for \"$file\" -- using \"$defmimetyp\"\n";
351
push @files,"${defmimetyp}:${code}:${file}";
352
}
353
}
345
354
}
346
355
347
356
unless ($action) {
348
if ($0 =~ m!(^|/)view$!) { $action="view"; }
349
elsif ($0 =~ m!(^|/)see$!) { $action="view"; }
350
elsif ($0 =~ m!(^|/)edit$!) { $action="edit"; }
351
elsif ($0 =~ m!(^|/)change$!) { $action="edit"; }
352
elsif ($0 =~ m!(^|/)compose$!) { $action="compose";}
353
elsif ($0 =~ m!(^|/)print$!) { $action="print"; }
354
elsif ($0 =~ m!(^|/)create$!) { $action="compose";}
355
else { $action="view"; }
357
if ($0 =~ m!(^|/)view$!) { $action="view"; }
358
elsif ($0 =~ m!(^|/)see$!) { $action="view"; }
359
elsif ($0 =~ m!(^|/)edit$!) { $action="edit"; }
360
elsif ($0 =~ m!(^|/)change$!) { $action="edit"; }
361
elsif ($0 =~ m!(^|/)compose$!) { $action="compose";}
362
elsif ($0 =~ m!(^|/)print$!) { $action="print"; }
363
elsif ($0 =~ m!(^|/)create$!) { $action="compose";}
364
else { $action="view"; }
356
365
}
357
366
358
367
359
368
$mailcaps = $ENV{MAILCAPS};
360
369
$mailcaps = "$ENV{HOME}/.mailcap:/etc/mailcap:/usr/local/etc/mailcap:/usr/share/etc/mailcap:/usr/etc/mailcap" unless $mailcaps;
361
370
foreach (split(/:/,$mailcaps)) {
362
ReadMailcap($_);
371
ReadMailcap($_);
363
372
}
364
373
365
374
foreach (@files) {
366
my($type,$code,$file) = m/^(.*?):(.*?):(.*)$/;
367
print STDERR "Processing file \"$file\" of type \"$type\" (encoding=",$code?$code:"none",")...\n" if $debug;
368
369
if ($file ne '-') {
370
if ($action eq 'compose' || $action eq 'edit') {
371
if (-e $file) {
372
if (! -w $file) {
373
print STDERR "Error: no write permission for file \"$file\"\n";
374
$retcode = 2 if ($retcode < 2);
375
next;
376
}
377
} else {
378
if (open(TEST,">$file")) {
379
close(TEST);
380
unlink($file);
381
} else {
382
print STDERR "Error: no write permission for file \"$file\"\n";
383
$retcode = 2 if ($retcode < 2);
384
next;
385
}
386
}
387
} else {
388
if (! -e $file) {
389
print STDERR "Error: no such file \"$file\"\n";
390
$retcode = 2 if ($retcode < 2);
391
next;
392
}
393
if (! -r $file) {
394
print STDERR "Error: no read permission for file \"$file\"\n";
395
$retcode = 2 if ($retcode < 2);
396
next;
397
}
398
}
399
}
400
401
my(@matches,$entry,$res,$efile);
402
if ($code) {
403
$efile = $file;
404
$file = DecodeFile($efile,$code,$action);
405
next unless $file;
406
}
407
408
foreach $entry (@mailcap) {
409
$entry =~ m/^(.*?)\s*;/;
410
$_ = "\Q$1\E"; s/\\\*/\.\*/g;
411
push @matches,$entry if ($type =~ m!^$_$!i);
412
}
413
@matches = grep(/\Q$action\E=/,@matches) unless $action eq "view";
414
415
my $done=0;
416
my $fail=0;
417
foreach $match (@matches) {
418
my $comm;
419
print STDERR " - checking mailcap entry \"$match\"\n" if $debug;
420
if ($action eq "view") {
421
($comm) = ($match =~ m/^.*?;\s*(.*?)\s*($|;)/);
422
} else {
423
($comm) = ($match =~ m/\Q$action\E=(.*?)\s*($|;)/);
424
}
425
next if (!$comm || $comm =~ m!(^|/)false$!i);
426
print STDERR " - program to execute: $comm\n" if $debug;
427
428
if ($match =~ m/;\s*test=(.*?)\s*($|;)/) {
429
my $test;
430
print STDERR " - running test: $1 " if $debug;
431
$test = system "$1 >/dev/null 2>&1";
432
$test >>= 8;
433
print STDERR " (result=$test=",($test!=0?"false":"true"),")\n" if $debug;
434
if ($test) {
435
$fail++;
436
next;
437
}
438
}
439
440
my($tmpfile,$tmplink);
441
if ($action ne 'print' && $match =~ m/;\s*needsterminal\s*($|;)/ && ! -t STDOUT) {
442
if ($ENV{DISPLAY}) {
443
$comm = "$xtermprgrm -T '$file ($type)' -e $0 --action=$action '${type}:%s'";
444
} else {
445
print STDERR " - no terminal available for rule (needsterminal)\n" if $debug;
446
$fail++;
447
next;
448
}
449
} elsif ($action eq 'view' && $match =~ m/;\s*copiousoutput\s*($|;)/) {
450
$comm .= " | $0 --action=$action text/plain:-";
451
}
452
453
if ($file ne "-") {
454
if ($comm =~ m/[^%]%s/) {
455
if ($file =~ m![^ a-z0-9,.:/@%^+=_-]!i) {
456
$match =~ m/nametemplate=(.*?)\s*($|;)/;
457
my $prefix = $1;
458
my $linked = 0;
459
while (!$linked) {
460
$tmplink = TempFile($prefix);
461
unlink($tmplink);
462
if ($file =~ m!^/!) {
463
$linked = symlink($file,$tmplink);
464
} else {
465
my $pwd = `/bin/pwd`;
466
chomp($pwd);
467
$linked = symlink("$pwd/$file",$tmplink);
468
}
469
}
470
print STDERR " - filename contains shell meta-characters; aliased to '$tmplink'\n" if $debug;
471
$comm =~ s/([^%])%s/$1$tmplink/g;
472
} else {
473
$comm =~ s/([^%])%s/$1$file/g;
474
}
475
} else {
476
if ($comm =~ m/\|/) {
477
$comm =~ s/\|/<\Q$file\E \|/;
478
} else {
479
$comm .= " <\Q$file\E";
480
}
481
if ($action eq 'edit' || $action eq 'compose') {
482
$comm .= " >\Q$file\E";
483
}
484
}
485
} else {
486
if ($comm =~ m/[^%]%s/) {
487
$tmpfile = SaveStdin($match);
488
$comm =~ s/([^%])%s/$1$tmpfile/g;
489
} else {
490
# no name means same as "-"... read from stdin
491
}
492
}
493
494
$comm =~ s!([^%])%t!$1$type!g;
495
$comm =~ s!([^%])%F!$1!g;
496
$comm =~ s!%{(.*?)}!$_="'$ENV{$1}'";s/\`//g;$_!ge;
497
$comm =~ s!\\(.)!$1!g;
498
$comm =~ s!\'\'!\'!g;
499
$comm =~ s!$quotedsemi!;!go;
500
$comm =~ s!$quotedprct!%!go;
501
502
print STDERR " - executing: $comm\n" if $debug;
503
$res = system $comm;
504
$res = int($res/256);
505
if ($res != 0) {
506
print STDERR "Warning: program returned non-zero exit code \#$res\n";
507
$retcode = $res;
508
}
509
$done=1;
510
unlink $tmpfile if $tmpfile;
511
unlink $tmplink if $tmplink;
512
last;
513
}
514
515
if (!$done) {
516
if ($fail) {
517
print STDERR "Error: no \"$action\" rule for type \"$type\" passed its test case\n";
518
print STDERR " (for more information, add \"--debug=1\" on the command line)\n";
519
$retcode = 3 if ($retcode < 3);
520
} else {
521
print STDERR "Error: no \"$action\" mailcap rules found for type \"$type\"\n";
522
$retcode = 3 if ($retcode < 3);
523
}
524
unlink $file if $code;
525
$retcode = 1 unless $retcode;
526
next;
527
}
528
529
if ($code) {
530
if ($action eq 'edit' || $action eq 'compose') {
531
my $file = EncodeFile($file,$efile,$code);
532
unlink $file if $file;
533
} else {
534
unlink $file;
535
}
536
}
375
my($type,$code,$file) = m/^(.*?):(.*?):(.*)$/;
376
print STDERR "Processing file \"$file\" of type \"$type\" (encoding=",$code?$code:"none",")...\n" if $debug;
377
378
if ($file ne '-') {
379
if ($action eq 'compose' || $action eq 'edit') {
380
if (-e $file) {
381
if (! -w $file) {
382
print STDERR "Error: no write permission for file \"$file\"\n";
383
$retcode = 2 if ($retcode < 2);
384
next;
385
}
386
} else {
387
if (open(TEST,">$file")) {
388
close(TEST);
389
unlink($file);
390
} else {
391
print STDERR "Error: no write permission for file \"$file\"\n";
392
$retcode = 2 if ($retcode < 2);
393
next;
394
}
395
}
396
} else {
397
if (! -e $file) {
398
print STDERR "Error: no such file \"$file\"\n";
399
$retcode = 2 if ($retcode < 2);
400
next;
401
}
402
if (! -r $file) {
403
print STDERR "Error: no read permission for file \"$file\"\n";
404
$retcode = 2 if ($retcode < 2);
405
next;
406
}
407
}
408
}
409
410
my(@matches,$entry,$res,$efile);
411
if ($code) {
412
$efile = $file;
413
$file = DecodeFile($efile,$code,$action);
414
next unless $file;
415
}
416
417
foreach $entry (@mailcap) {
418
$entry =~ m/^(.*?)\s*;/;
419
$_ = "\Q$1\E"; s/\\\*/\.\*/g;
420
push @matches,$entry if ($type =~ m!^$_$!i);
421
}
422
@matches = grep(/\Q$action\E=/,@matches) unless $action eq "view";
423
424
my $done=0;
425
my $fail=0;
426
foreach $match (@matches) {
427
my $comm;
428
print STDERR " - checking mailcap entry \"$match\"\n" if $debug;
429
if ($action eq "view") {
430
($comm) = ($match =~ m/^.*?;\s*(.*?)\s*($|;)/);
431
} else {
432
($comm) = ($match =~ m/\Q$action\E=(.*?)\s*($|;)/);
433
}
434
next if (!$comm || $comm =~ m!(^|/)false$!i);
435
print STDERR " - program to execute: $comm\n" if $debug;
436
437
if ($match =~ m/;\s*test=(.*?)\s*($|;)/) {
438
my $test;
439
print STDERR " - running test: $1 " if $debug;
440
$test = system "$1 >/dev/null 2>&1";
441
$test >>= 8;
442
print STDERR " (result=$test=",($test!=0?"false":"true"),")\n" if $debug;
443
if ($test) {
444
$fail++;
445
next;
446
}
447
}
448
449
my($tmpfile,$tmplink);
450
if ($action ne 'print' && $match =~ m/;\s*needsterminal\s*($|;)/ && ! -t STDOUT) {
451
if ($ENV{DISPLAY}) {
452
$comm = "$xtermprgrm -T '$file ($type)' -e $0 --action=$action '${type}:%s'";
453
} else {
454
print STDERR " - no terminal available for rule (needsterminal)\n" if $debug;
455
$fail++;
456
next;
457
}
458
} elsif ($action eq 'view' && $match =~ m/;\s*copiousoutput\s*($|;)/) {
459
$comm .= " | $0 --action=$action text/plain:-";
460
}
461
462
if ($file ne "-") {
463
if ($comm =~ m/[^%]%s/) {
464
if ($file =~ m![^ a-z0-9,.:/@%^+=_-]!i) {
465
$match =~ m/nametemplate=(.*?)\s*($|;)/;
466
my $prefix = $1;
467
my $linked = 0;
468
while (!$linked) {
469
$tmplink = TempFile($prefix);
470
unlink($tmplink);
471
if ($file =~ m!^/!) {
472
$linked = symlink($file,$tmplink);
473
} else {
474
my $pwd = `/bin/pwd`;
475
chomp($pwd);
476
$linked = symlink("$pwd/$file",$tmplink);
477
}
478
}
479
print STDERR " - filename contains shell meta-characters; aliased to '$tmplink'\n" if $debug;
480
$comm =~ s/([^%])%s/$1$tmplink/g;
481
} else {
482
$comm =~ s/([^%])%s/$1$file/g;
483
}
484
} else {
485
if ($comm =~ m/\|/) {
486
$comm =~ s/\|/<\Q$file\E \|/;
487
} else {
488
$comm .= " <\Q$file\E";
489
}
490
if ($action eq 'edit' || $action eq 'compose') {
491
$comm .= " >\Q$file\E";
492
}
493
}
494
} else {
495
if ($comm =~ m/[^%]%s/) {
496
$tmpfile = SaveStdin($match);
497
$comm =~ s/([^%])%s/$1$tmpfile/g;
498
} else {
499
# no name means same as "-"... read from stdin
500
}
501
}
502
503
$comm =~ s!([^%])%t!$1$type!g;
504
$comm =~ s!([^%])%F!$1!g;
505
$comm =~ s!%{(.*?)}!$_="'$ENV{$1}'";s/\`//g;s/\'\'//g;$_!ge;
506
$comm =~ s!\\(.)!$1!g;
507
$comm =~ s!\'\'!\'!g;
508
$comm =~ s!$quotedsemi!;!go;
509
$comm =~ s!$quotedprct!%!go;
510
511
print STDERR " - executing: $comm\n" if $debug;
512
$res = system $comm;
513
$res = int($res/256);
514
if ($res != 0) {
515
print STDERR "Warning: program returned non-zero exit code \#$res\n";
516
$retcode = $res;
517
}
518
$done=1;
519
unlink $tmpfile if $tmpfile;
520
unlink $tmplink if $tmplink;
521
last;
522
}
523
524
if (!$done) {
525
if ($fail) {
526
print STDERR "Error: no \"$action\" rule for type \"$type\" passed its test case\n";
527
print STDERR " (for more information, add \"--debug=1\" on the command line)\n";
528
$retcode = 3 if ($retcode < 3);
529
} else {
530
print STDERR "Error: no \"$action\" mailcap rules found for type \"$type\"\n";
531
$retcode = 3 if ($retcode < 3);
532
}
533
unlink $file if $code;
534
$retcode = 1 unless $retcode;
535
next;
536
}
537
538
if ($code) {
539
if ($action eq 'edit' || $action eq 'compose') {
540
my $file = EncodeFile($file,$efile,$code);
541
unlink $file if $file;
542
} else {
543
unlink $file;
544
}
545
}
537
546
}
538
547
539
548
exit($retcode);
Loggerhead is a web-based interface for Breezy
Version: 2.0.1