run-mailcap

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