File Coverage

File:/usr/bin/print
Coverage:20.5%

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