]>
Commit | Line | Data |
---|---|---|
c85fa412 TP |
1 | #! /usr/bin/perl |
2 | ############################################################################### | |
3 | # | |
4 | # Run-Mailcap: Run a program specified in the mailcap file based on a mime | |
5 | # type. | |
6 | # | |
7 | # Written by Brian White <bcwhite@pobox.com> | |
8 | # This file has been placed in the public domain (the only true "free"). | |
9 | # | |
10 | ############################################################################### | |
11 | ||
77cff387 TP |
12 | use Encode qw(decode); |
13 | use I18N::Langinfo qw(langinfo CODESET); | |
14 | use File::Spec; | |
c85fa412 | 15 | |
77cff387 | 16 | $debug=($ENV{RUN_MAILCAP_DEBUG} || 0); |
98afa569 | 17 | $norun=0; |
77cff387 | 18 | $nopager=0; |
c85fa412 TP |
19 | $etcmimetyp="/etc/mime.types"; |
20 | $shrmimetyp="/usr/share/etc/mime.types"; | |
21 | $locmimetyp="/usr/local/etc/mime.types"; | |
22 | $usrmimetyp="$ENV{HOME}/.mime.types"; | |
23 | $xtermprgrm="/usr/bin/x-terminal-emulator"; # xterm? | |
24 | $defmimetyp="application/octet-stream"; | |
25 | $quotedsemi=chr(255); | |
26 | $quotedprct=chr(254); | |
27 | $retcode=0; | |
28 | ||
29 | ||
c85fa412 TP |
30 | |
31 | sub Usage { | |
32 | my($error) = @_; | |
33 | print STDERR $error,"\n\n" if $error; | |
34 | ||
35 | print STDERR "Use: $0 <--action=VAL> [--debug] [MIME-TYPE:[ENCODING:]]FILE [...]\n\n"; | |
36 | print STDERR "Options:\n"; | |
37 | print STDERR " action specify what action to do on these files (default=view)\n"; | |
38 | print STDERR " debug be verbose about what's going on\n"; | |
77cff387 | 39 | print STDERR " nopager ignore any \"copiousoutput\" directives and never use a \"pager\"\n"; |
98afa569 | 40 | print STDERR " norun just print but don't execute the command (useful with --debug)\n"; |
c85fa412 TP |
41 | print STDERR "\n"; |
42 | print STDERR "Mime-Type:\n"; | |
43 | print STDERR " any standard mime type designation in the form <class>/<subtype> -- if\n"; | |
44 | print STDERR " not specified, it will be determined from the filename extension\n\n"; | |
45 | print STDERR "Encoding:\n"; | |
77cff387 TP |
46 | print STDERR " how the file (and type) has been encoded (only \"gzip\", \"bzip2,\"\n"; |
47 | print STDERR " \"xz\" and \"compress\" are supported) -- if not specified, it will be\n"; | |
48 | print STDERR " determined from the filename extension\n\n"; | |
c85fa412 TP |
49 | |
50 | exit ($error ? 1 : 0); | |
51 | } | |
52 | ||
53 | ||
54 | ||
55 | sub EncodingForFile { | |
56 | my($file) = @_; | |
57 | my $encoding; | |
58 | ||
59 | if ($file =~ m/\.gz$/) { $encoding = "gzip"; } | |
c85fa412 | 60 | if ($file =~ m/\.bz2$/) { $encoding = "bzip2"; } |
77cff387 | 61 | if ($file =~ m/\.xz$/) { $encoding = "xz"; } |
c85fa412 TP |
62 | if ($file =~ m/\.Z$/) { $encoding = "compress"; } |
63 | ||
64 | print STDERR " - file \"$file\" has encoding \"$encoding\"\n" if $debug && $encoding; | |
65 | ||
66 | return $encoding; | |
67 | } | |
68 | ||
69 | ||
70 | ||
71 | sub ReadMimetypes { | |
72 | my($file) = @_; | |
73 | ||
c85fa412 | 74 | print STDERR " - Reading mime.types file \"$file\"...\n" if $debug; |
77cff387 TP |
75 | unless (open(MIMETYPES,'<',$file)) { |
76 | # Quietly ignore an unreadable file, perhaps non-existent, perhaps | |
77 | # permission denied. | |
78 | print STDERR " could not read \"$file\" -- $!\n" if $debug; | |
79 | return; | |
80 | } | |
81 | ||
c85fa412 TP |
82 | while (<MIMETYPES>) { |
83 | chomp; | |
84 | s/\#.*$//; | |
85 | next if (m/^\s*$/); | |
86 | ||
87 | $_=lc($_); | |
88 | my($type,@exts) = split; | |
89 | ||
90 | foreach (@exts) { | |
91 | $mimetypes{$_} = $type unless exists $mimetypes{$_}; | |
92 | } | |
93 | } | |
94 | close MIMETYPES; | |
95 | } | |
96 | ||
97 | ||
98 | ||
99 | sub ReadMailcap { | |
100 | my($file) = @_; | |
101 | my $line = ""; | |
102 | ||
c85fa412 | 103 | print STDERR " - Reading mailcap file \"$file\"...\n" if $debug; |
77cff387 TP |
104 | unless (open(MAILCAP,'<',$file)) { |
105 | # Quietly ignore an unreadable file, perhaps non-existent, perhaps | |
106 | # permission denied. | |
107 | print STDERR " could not read \"$file\" -- $!\n" if $debug; | |
108 | return; | |
109 | } | |
110 | ||
c85fa412 TP |
111 | while (<MAILCAP>) { |
112 | chomp; | |
113 | s/^\s+// if $line; | |
114 | $line .= $_; | |
115 | next unless $line; | |
116 | if ($line =~ m/^\s*\#/) { | |
117 | $line = ""; | |
118 | next; | |
119 | } | |
120 | if ($line =~ m/\\$/) { | |
121 | $line =~ s/\\$//; | |
122 | } else { | |
123 | $line =~ s/\\;/$quotedsemi/go; | |
124 | $line =~ s/\\%/$quotedprct/go; | |
125 | push @mailcap,$line; | |
126 | $line = ""; | |
127 | } | |
128 | } | |
129 | close MAILCAP; | |
130 | } | |
131 | ||
132 | ||
133 | ||
134 | sub TempFile { | |
135 | my($template) = @_; | |
136 | my($cmd,$head,$tail,$tmpfile); | |
137 | $template = "" unless (defined $template); | |
138 | ||
139 | ($head,$tail) = split(/%s/,$template,2); | |
140 | ||
141 | # $tmpfile = POSIX::tmpnam($name); | |
142 | # unlink($tmpfile); | |
143 | ||
77cff387 TP |
144 | $cmd = "tempfile --mode=600"; |
145 | $cmd .= " --prefix $head" if $head; | |
146 | $cmd .= " --suffix $tail" if $tail; | |
c85fa412 TP |
147 | |
148 | $tmpfile = `$cmd`; | |
149 | chomp($tmpfile); | |
150 | ||
151 | # $tmpfile = $ENV{TMPDIR}; | |
152 | # $tmpfile = "/tmp" unless $tmpfile; | |
153 | # $tmpfile.= "/$name"; | |
154 | # unlink($tmpfile); | |
155 | ||
156 | return $tmpfile; | |
157 | } | |
158 | ||
159 | ||
160 | ||
161 | sub SaveStdin { | |
162 | my($match) = @_; | |
163 | my($tmpfile,$amt,$buf); | |
164 | ||
165 | $tmpfile = $1 if ($match =~ m/nametemplate=(.*?)\s*($|;)/); | |
166 | $tmpfile = TempFile($tmpfile); | |
167 | open(TMPFILE,">$tmpfile") || die "Error: could not write \"$tmpfile\" -- $!\n"; | |
168 | do { | |
169 | $amt = read(STDIN,$buf,102400); | |
170 | print TMPFILE $buf if $amt; | |
171 | } while ($amt != 0); | |
172 | close(TMPFILE); | |
173 | ||
174 | return $tmpfile; | |
175 | } | |
176 | ||
177 | ||
178 | ||
179 | sub DecodeFile { | |
180 | my($efile,$encoding,$action) = @_; | |
181 | my($file,$res); | |
182 | ||
183 | $file = $efile; | |
184 | $file =~ s!^.*/!!; # remove leading directories | |
185 | $file =~ s!\.[^\.]*$!!; # remove encoding extension | |
186 | $file =~ s!^\.?[^\.]*!%s!; # replace name with placeholder | |
187 | $file = undef if ($efile eq '-'); | |
188 | my $tmpfile = TempFile($file); | |
189 | ||
190 | print STDERR " - decoding \"$efile\" as \"$tmpfile\"\n" if $debug; | |
191 | ||
192 | # unlink($tmpfile); # should still be acceptable for "compose" output even if exists | |
193 | return $tmpfile if (($efile ne '-' && ! -e $efile) || $action eq 'compose'); | |
194 | ||
195 | if ($encoding eq "gzip") { | |
196 | if ($efile eq '-') { | |
197 | $res = system "gzip -d >\Q$tmpfile\E"; | |
198 | } else { | |
199 | $res = system "gzip -dc \Q$efile\E >\Q$tmpfile\E"; | |
200 | } | |
c85fa412 TP |
201 | } elsif ($encoding eq "bzip2") { |
202 | if ($efile eq '-') { | |
203 | $res = system "bzip2 -d >\Q$tmpfile\E"; | |
204 | } else { | |
205 | $res = system "bzip2 -dc <\Q$efile\E >\Q$tmpfile\E"; | |
206 | } | |
77cff387 TP |
207 | } elsif ($encoding eq "xz") { |
208 | if ($efile eq '-') { | |
209 | $res = system "xz -d >\Q$tmpfile\E"; | |
210 | } else { | |
211 | $res = system "xz -dc <\Q$efile\E >\Q$tmpfile\E"; | |
212 | } | |
c85fa412 TP |
213 | } elsif ($encoding eq "compress") { |
214 | if ($efile eq '-') { | |
215 | $res = system "uncompress >\Q$tmpfile\E"; | |
216 | } else { | |
217 | $res = system "uncompress <\Q$efile\E >\Q$tmpfile\E"; | |
218 | } | |
219 | } else { | |
220 | die "Fatal: unknown encoding \"$encoding\" at"; | |
221 | } | |
222 | ||
223 | $res = int($res/256); | |
224 | if ($res != 0) { | |
225 | print STDERR "Error: could not decode \"$efile\" -- $!\n"; | |
226 | $retcode = 2 if ($retcode < 2); | |
227 | unlink($tmpfile); | |
228 | return; | |
229 | } | |
230 | ||
231 | # chmod 0600,$tmpfile; # done already by TempFile | |
232 | return $tmpfile; | |
233 | } | |
234 | ||
235 | ||
236 | ||
237 | sub EncodeFile { | |
238 | my($dfile,$efile,$encoding) = @_; | |
239 | my($res); | |
240 | ||
241 | print STDERR " - encoding \"$dfile\" as \"$efile\"\n"; | |
242 | ||
243 | if ($encoding eq "gzip") { | |
244 | if ($efile eq '-') { | |
245 | $res = system "gzip -c \Q$dfile\E"; | |
246 | } else { | |
247 | $res = system "gzip -c \Q$dfile\E >\Q$efile\E"; | |
248 | } | |
77cff387 TP |
249 | } elsif ($encoding eq "xz") { |
250 | if ($efile eq '-') { | |
251 | $res = system "xz < \Q$dfile\E"; | |
252 | } else { | |
253 | $res = system "xz < \Q$dfile\E >\Q$efile\E"; | |
254 | } | |
c85fa412 TP |
255 | } elsif ($encoding eq "compress") { |
256 | if ($efile eq '-') { | |
257 | $res = system "compress <\Q$dfile\E"; | |
258 | } else { | |
259 | $res = system "compress <\Q$dfile\E >\Q$efile\E"; | |
260 | } | |
261 | } else { | |
262 | die "Fatal: unknown encoding \"$encoding\" at"; | |
263 | } | |
264 | ||
265 | $res = int($res/256); | |
266 | if ($res != 0) { | |
267 | print STDERR "Error: could not encode \"$efile\" (left as \"$dfile\")\n"; | |
268 | $retcode = 2 if ($retcode < 2); | |
269 | return; | |
270 | } | |
271 | ||
272 | return $dfile; | |
273 | } | |
274 | ||
275 | ||
276 | ||
277 | sub ExtensionMimetype { | |
77cff387 TP |
278 | my($file) = @_; |
279 | my($ext) = ($file =~ m!\.([^/\.]+)$!); | |
c85fa412 | 280 | my($typ); |
77cff387 TP |
281 | if ($ext) { |
282 | unless ($donemimetypes) { | |
283 | ReadMimetypes($usrmimetyp); | |
284 | ReadMimetypes($locmimetyp); | |
285 | ReadMimetypes($shrmimetyp); | |
286 | ReadMimetypes($etcmimetyp); | |
287 | $donemimetypes = 1; | |
288 | } | |
289 | $typ = $mimetypes{lc($ext)}; | |
290 | print STDERR " - extension \"$ext\" maps to mime-type \"$typ\"\n" if $debug; | |
c85fa412 | 291 | } |
c85fa412 TP |
292 | return $typ; |
293 | } | |
294 | ||
295 | ||
296 | ||
77cff387 | 297 | sub MagicMimetype { |
c85fa412 | 298 | my($file) = @_; |
77cff387 | 299 | my($typ); |
c85fa412 | 300 | |
77cff387 TP |
301 | if (`which file`) { |
302 | open(READER, "-|", "file", "-b", "--mime-type", "-e", "tokens", "-L", "-z", $file); | |
303 | $typ = <READER>; | |
304 | chomp $typ; | |
305 | print STDERR " - file command returned mime-type \"$typ\"\n" if $debug; | |
c85fa412 | 306 | } |
77cff387 | 307 | return $typ; |
c85fa412 TP |
308 | } |
309 | ||
310 | ||
311 | ||
312 | @files = (); | |
313 | foreach (@ARGV) { | |
314 | print STDERR " - parsing parameter \"$_\"\n" if $debug; | |
315 | if (m!^(-h|--help)$!) { | |
316 | Usage(); | |
317 | exit(0); | |
318 | } elsif (m!^--(.*?)=(.*)$!) { | |
319 | print STDERR "Warning: definition of \"$1=$2\" overrides value \"${$1}\"\n" if ($ {$1} && $ {$1} != $2); | |
320 | $ {$1}=$2; | |
321 | } elsif (m!^--(.*?)$!) { | |
322 | print STDERR "Warning: definition of \"$1=$2\" overrides value \"${$1}\"\n" if ($ {$1} && $ {$1} != 1); | |
323 | $ {$1}=1; | |
324 | } elsif (m!^[^/:]+/[^/:]+:[^/:]+:!) { | |
325 | push @files,$_; | |
326 | } elsif (m!^([^/:]+/[^/:]+):(.*)! && ! -e $_) { | |
327 | my $file = $_; | |
328 | my $type = $1; | |
329 | my $file = $2; | |
330 | my $code = EncodingForFile($file); | |
331 | push @files,"${type}:${code}:${file}"; | |
332 | print STDERR " - file \"$file\" does not exist -- assuming mime-type specification of \"${type}\"\n" if $debug; | |
333 | } else { | |
334 | my $file = $_; | |
335 | my $code = EncodingForFile($file); | |
336 | my $type; | |
337 | if ($code) { | |
338 | my $efile = $file; | |
339 | $efile =~ s/\.[^\.]+$//; | |
77cff387 | 340 | $type = ExtensionMimetype($efile); |
c85fa412 | 341 | } else { |
77cff387 | 342 | $type = ExtensionMimetype($file); |
c85fa412 | 343 | } |
77cff387 | 344 | $type = MagicMimetype($file) unless $type; |
c85fa412 TP |
345 | if ($type) { |
346 | push @files,"${type}:${code}:${file}"; | |
347 | } else { | |
348 | print STDERR "Warning: unknown mime-type for \"$file\" -- using \"$defmimetyp\"\n"; | |
349 | push @files,"${defmimetyp}:${code}:${file}"; | |
350 | } | |
351 | } | |
352 | } | |
353 | ||
77cff387 TP |
354 | # Pass --debug to sub-calls to this program. |
355 | $ENV{RUN_MAILCAP_DEBUG} = 1 if $debug; | |
356 | ||
c85fa412 | 357 | unless ($action) { |
77cff387 TP |
358 | if ($0 =~ m!(^|/)(mime-)?view$!) { $action="view"; } |
359 | elsif ($0 =~ m!(^|/)(mime-)?see$!) { $action="view"; } | |
360 | elsif ($0 =~ m!(^|/)(mime-)?cat$!) { $action="cat"; } | |
361 | elsif ($0 =~ m!(^|/)(mime-)?edit$!) { $action="edit"; } | |
362 | elsif ($0 =~ m!(^|/)(mime-)?change$!) { $action="edit"; } | |
363 | elsif ($0 =~ m!(^|/)(mime-)?compose$!) { $action="compose";} | |
364 | elsif ($0 =~ m!(^|/)(mime-)?print$!) { $action="print"; } | |
365 | elsif ($0 =~ m!(^|/)(mime-)?create$!) { $action="compose";} | |
366 | else { $action="view"; } | |
c85fa412 TP |
367 | } |
368 | ||
369 | ||
370 | $mailcaps = $ENV{MAILCAPS}; | |
371 | $mailcaps = "$ENV{HOME}/.mailcap:/etc/mailcap:/usr/local/etc/mailcap:/usr/share/etc/mailcap:/usr/etc/mailcap" unless $mailcaps; | |
372 | foreach (split(/:/,$mailcaps)) { | |
373 | ReadMailcap($_); | |
374 | } | |
375 | ||
376 | foreach (@files) { | |
377 | my($type,$code,$file) = m/^(.*?):(.*?):(.*)$/; | |
378 | print STDERR "Processing file \"$file\" of type \"$type\" (encoding=",$code?$code:"none",")...\n" if $debug; | |
379 | ||
380 | if ($file ne '-') { | |
381 | if ($action eq 'compose' || $action eq 'edit') { | |
382 | if (-e $file) { | |
383 | if (! -w $file) { | |
384 | print STDERR "Error: no write permission for file \"$file\"\n"; | |
385 | $retcode = 2 if ($retcode < 2); | |
386 | next; | |
387 | } | |
388 | } else { | |
389 | if (open(TEST,">$file")) { | |
390 | close(TEST); | |
391 | unlink($file); | |
392 | } else { | |
393 | print STDERR "Error: no write permission for file \"$file\"\n"; | |
394 | $retcode = 2 if ($retcode < 2); | |
395 | next; | |
396 | } | |
397 | } | |
398 | } else { | |
399 | if (! -e $file) { | |
400 | print STDERR "Error: no such file \"$file\"\n"; | |
401 | $retcode = 2 if ($retcode < 2); | |
402 | next; | |
403 | } | |
404 | if (! -r $file) { | |
405 | print STDERR "Error: no read permission for file \"$file\"\n"; | |
406 | $retcode = 2 if ($retcode < 2); | |
407 | next; | |
408 | } | |
409 | } | |
410 | } | |
411 | ||
412 | my(@matches,$entry,$res,$efile); | |
413 | if ($code) { | |
414 | $efile = $file; | |
415 | $file = DecodeFile($efile,$code,$action); | |
416 | next unless $file; | |
417 | } | |
418 | ||
419 | foreach $entry (@mailcap) { | |
420 | $entry =~ m/^(.*?)\s*;/; | |
421 | $_ = "\Q$1\E"; s/\\\*/\.\*/g; | |
422 | push @matches,$entry if ($type =~ m!^$_$!i); | |
423 | } | |
98afa569 | 424 | @matches = grep(/\Q$action\E=/,@matches) unless ($action eq "view" || $action eq "cat"); |
c85fa412 TP |
425 | |
426 | my $done=0; | |
427 | my $fail=0; | |
77cff387 | 428 | my $needsterminal; |
c85fa412 TP |
429 | foreach $match (@matches) { |
430 | my $comm; | |
431 | print STDERR " - checking mailcap entry \"$match\"\n" if $debug; | |
98afa569 | 432 | if ($action eq "view" || $action eq "cat") { |
c85fa412 TP |
433 | ($comm) = ($match =~ m/^.*?;\s*(.*?)\s*($|;)/); |
434 | } else { | |
435 | ($comm) = ($match =~ m/\Q$action\E=(.*?)\s*($|;)/); | |
436 | } | |
437 | next if (!$comm || $comm =~ m!(^|/)false$!i); | |
438 | print STDERR " - program to execute: $comm\n" if $debug; | |
439 | ||
98afa569 TP |
440 | if ($action eq 'cat' && $match !~ m/;\s*copiousoutput\s*($|;)/) { |
441 | print STDERR " - \"copiousoutput\" is required for \"cat\" action\n" if $debug; | |
442 | $fail++; | |
443 | next; | |
444 | } | |
c85fa412 TP |
445 | |
446 | my($tmpfile,$tmplink); | |
77cff387 TP |
447 | if ($action ne 'print' && $match =~ m/;\s*needsterminal\s*($|;)/) { |
448 | $needsterminal = 1; | |
449 | if (-t STDOUT) { | |
450 | print STDERR " - needsterminal is satisfied by stdout\n" if $debug; | |
c85fa412 | 451 | } else { |
77cff387 TP |
452 | if ($ENV{DISPLAY}) { |
453 | $comm = "$xtermprgrm -T '$file ($type)' -e $0 --action=$action '${type}:%s'"; | |
454 | } else { | |
455 | print STDERR " - no terminal available for rule (needsterminal)\n" if $debug; | |
456 | $fail++; | |
457 | next; | |
458 | } | |
c85fa412 | 459 | } |
77cff387 TP |
460 | |
461 | } elsif ($action eq 'view' && !$nopager && $match =~ m/;\s*copiousoutput\s*($|;)/ && $type ne 'text/plain') { | |
98afa569 TP |
462 | $comm .= " | $0 --action=$action text/plain:-"; |
463 | } | |
464 | ||
465 | if ($match =~ m/;\s*test=(.*?)\s*($|;)/) { | |
466 | my $test; | |
467 | print STDERR " - running test: $1 " if $debug; | |
468 | $test = system "$1 >/dev/null 2>&1"; | |
469 | $test >>= 8; | |
470 | print STDERR " (result=$test=",($test!=0?"false":"true"),")\n" if $debug; | |
471 | if ($test) { | |
472 | $fail++; | |
473 | next; | |
474 | } | |
c85fa412 TP |
475 | } |
476 | ||
477 | if ($file ne "-") { | |
77cff387 TP |
478 | # Resolve file name to an absolute path |
479 | $file = File::Spec->rel2abs($file); | |
480 | if (decode(langinfo(CODESET()), $file) =~ m![^[:alnum:],.:/@%^+=_-]!i) { | |
481 | $match =~ m/nametemplate=(.*?)\s*($|;)/; | |
482 | my $prefix = $1; | |
483 | my $linked = 0; | |
484 | while (!$linked) { | |
485 | $tmplink = TempFile($prefix); | |
486 | unlink($tmplink); | |
487 | $linked = symlink($file,$tmplink); | |
c85fa412 | 488 | } |
77cff387 TP |
489 | $file = $tmplink; |
490 | print STDERR " - filename contains shell meta-characters; aliased to '$tmplink'\n" if $debug; | |
491 | } | |
492 | if ($comm =~ m/[^%]%s/) { | |
493 | $comm =~ s/([^%])%s/$1$file/g; | |
c85fa412 TP |
494 | } else { |
495 | if ($comm =~ m/\|/) { | |
496 | $comm =~ s/\|/<\Q$file\E \|/; | |
497 | } else { | |
498 | $comm .= " <\Q$file\E"; | |
499 | } | |
500 | if ($action eq 'edit' || $action eq 'compose') { | |
501 | $comm .= " >\Q$file\E"; | |
502 | } | |
503 | } | |
504 | } else { | |
505 | if ($comm =~ m/[^%]%s/) { | |
506 | $tmpfile = SaveStdin($match); | |
507 | $comm =~ s/([^%])%s/$1$tmpfile/g; | |
77cff387 TP |
508 | |
509 | # If needsterminal then redirect stdin to the tty which is | |
510 | # on stdout, rather than leaving it as the input data stream | |
511 | # which has now been read through to EOF. | |
512 | # | |
513 | # Some programs such as "more" and "less" already use | |
514 | # /dev/tty rather than stdin. But "vim" on non-tty stdin | |
515 | # gives a warning message and then leaves the tty in raw | |
516 | # mode on exit. Or "nvi" refuses to run at all unless both | |
517 | # stdin and stdout are the tty. | |
518 | # | |
519 | # RFC 1524 is silent on exactly what a program with | |
520 | # "needsterminal" should expect, but it seems sensible to | |
521 | # arrange that both stdin and stdout are the terminal for | |
522 | # "needsterminal" with "%s". | |
523 | # | |
524 | if ($needsterminal) { | |
525 | $comm .= ' <&1'; | |
526 | } | |
c85fa412 TP |
527 | } else { |
528 | # no name means same as "-"... read from stdin | |
529 | } | |
530 | } | |
531 | ||
532 | $comm =~ s!([^%])%t!$1$type!g; | |
533 | $comm =~ s!([^%])%F!$1!g; | |
77cff387 | 534 | $comm =~ s!%\{(.*?)}!$_="'$ENV{$1}'";s/\`//g;s/\'\'//g;$_!ge; |
c85fa412 TP |
535 | $comm =~ s!\\(.)!$1!g; |
536 | $comm =~ s!\'\'!\'!g; | |
537 | $comm =~ s!$quotedsemi!;!go; | |
538 | $comm =~ s!$quotedprct!%!go; | |
539 | ||
540 | print STDERR " - executing: $comm\n" if $debug; | |
98afa569 TP |
541 | if ($norun) { |
542 | print $comm,"\n"; | |
543 | $res = 0; | |
544 | } else { | |
545 | $res = system $comm; | |
546 | $res = int($res/256); | |
547 | } | |
c85fa412 TP |
548 | if ($res != 0) { |
549 | print STDERR "Warning: program returned non-zero exit code \#$res\n"; | |
550 | $retcode = $res; | |
551 | } | |
552 | $done=1; | |
553 | unlink $tmpfile if $tmpfile; | |
554 | unlink $tmplink if $tmplink; | |
555 | last; | |
556 | } | |
557 | ||
558 | if (!$done) { | |
559 | if ($fail) { | |
560 | print STDERR "Error: no \"$action\" rule for type \"$type\" passed its test case\n"; | |
561 | print STDERR " (for more information, add \"--debug=1\" on the command line)\n"; | |
562 | $retcode = 3 if ($retcode < 3); | |
563 | } else { | |
564 | print STDERR "Error: no \"$action\" mailcap rules found for type \"$type\"\n"; | |
565 | $retcode = 3 if ($retcode < 3); | |
566 | } | |
567 | unlink $file if $code; | |
568 | $retcode = 1 unless $retcode; | |
569 | next; | |
570 | } | |
571 | ||
572 | if ($code) { | |
573 | if ($action eq 'edit' || $action eq 'compose') { | |
574 | my $file = EncodeFile($file,$efile,$code); | |
575 | unlink $file if $file; | |
576 | } else { | |
577 | unlink $file; | |
578 | } | |
579 | } | |
580 | } | |
581 | ||
582 | exit($retcode); |