[packages/mailcap.git] / run-mailcap

#! /usr/bin/perl
###############################################################################
#
#  Run-Mailcap:  Run a program specified in the mailcap file based on a mime
#  type.
#
#  Written by Brian White <bcwhite@pobox.com>
#  This file has been placed in the public domain (the only true "free").
#
###############################################################################


$debug=0;
$norun=0;
$pager=0;
$etcmimetyp="/etc/mime.types";
$shrmimetyp="/usr/share/etc/mime.types";
$locmimetyp="/usr/local/etc/mime.types";
$usrmimetyp="$ENV{HOME}/.mime.types";
$xtermprgrm="/usr/bin/x-terminal-emulator"; # xterm?
$defmimetyp="application/octet-stream";
$quotedsemi=chr(255);
$quotedprct=chr(254);
$retcode=0;


%patterntypes =
(
 '(^|/)crontab[^/]+$'                           => 'text/x-crontab',            #'
 '/man\d*/'                                     => 'application/x-troff-man',   #'
 '\.\d[^\.]*$'                                  => 'application/x-troff-man',   #'
);


sub Usage {
    my($error) = @_;
    print STDERR $error,"\n\n" if $error;

    print STDERR "Use: $0 <--action=VAL> [--debug] [MIME-TYPE:[ENCODING:]]FILE [...]\n\n";
    print STDERR "Options:\n";
    print STDERR "  action        specify what action to do on these files (default=view)\n";
    print STDERR "  debug         be verbose about what's going on\n";
    print STDERR "  pager         ignore any \"copiousoutput\" directives and use a \"pager\"\n";
    print STDERR "  norun         just print but don't execute the command (useful with --debug)\n";
    print STDERR "\n";
    print STDERR "Mime-Type:\n";
    print STDERR "  any standard mime type designation in the form <class>/<subtype> -- if\n";
    print STDERR "  not specified, it will be determined from the filename extension\n\n";
    print STDERR "Encoding:\n";
    print STDERR "  how the file (and type) has been encoded (only \"gzip\", \"bzip\", \"bzip2\"\n";
    print STDERR "  and \"compress\" are supported) -- if not specified, it will be determined\n";
    print STDERR "  from the filename extension\n\n";

    exit ($error ? 1 : 0);
}


sub EncodingForFile {
    my($file) = @_;
    my $encoding;

    if ($file =~ m/\.gz$/)  { $encoding = "gzip";       }
    if ($file =~ m/\.bz$/)  { $encoding = "bzip";       }
    if ($file =~ m/\.bz2$/) { $encoding = "bzip2";      }
    if ($file =~ m/\.Z$/)   { $encoding = "compress";   }

    print STDERR " - file \"$file\" has encoding \"$encoding\"\n" if $debug && $encoding;

    return $encoding;
}


sub ReadMimetypes {
    my($file) = @_;

    return unless -r $file;

    print STDERR " - Reading mime.types file \"$file\"...\n" if $debug;
    open(MIMETYPES,"<$file") || die "Error: could not read \"$file\" -- $!\n";
    while (<MIMETYPES>) {
        chomp;
        s/\#.*$//;
        next if (m/^\s*$/);

        $_=lc($_);
        my($type,@exts) = split;

        foreach (@exts) {
            $mimetypes{$_} = $type unless exists $mimetypes{$_};
        }
    }
    close MIMETYPES;
}


sub ReadMailcap {
    my($file) = @_;
    my $line = "";

    return unless -r $file;

    print STDERR " - Reading mailcap file \"$file\"...\n" if $debug;
    open(MAILCAP,"<$file") || die "Error: could not read \"$file\" -- $!\n";
    while (<MAILCAP>) {
        chomp;
        s/^\s+// if $line;
        $line .= $_;
        next unless $line;
        if ($line =~ m/^\s*\#/) {
            $line = "";
            next;
        }
        if ($line =~ m/\\$/) {
            $line =~ s/\\$//;
        } else {
            $line =~ s/\\;/$quotedsemi/go;
            $line =~ s/\\%/$quotedprct/go;
            push @mailcap,$line;
            $line = "";
        }
    }
    close MAILCAP;
}


sub TempFile {
    my($template) = @_;
    my($cmd,$head,$tail,$tmpfile);
    $template = "" unless (defined $template);

    ($head,$tail) = split(/%s/,$template,2);

#   $tmpfile = POSIX::tmpnam($name);
#   unlink($tmpfile);

    $cmd  = "mktemp -t ";	# -t is depreciated, but --tmpdir would not be handled by older mktemp
    $cmd .= "$head" if $head;
    $cmd .= ".$tail" if $tail;
    $cmd .= "XXXXXX";

    $tmpfile = `$cmd`;
    chomp($tmpfile);

#   $tmpfile = $ENV{TMPDIR};
#   $tmpfile = "/tmp" unless $tmpfile;
#   $tmpfile.= "/$name";
#   unlink($tmpfile);

    return $tmpfile;
}


sub SaveStdin {
    my($match) = @_;
    my($tmpfile,$amt,$buf);

    $tmpfile = $1 if ($match =~ m/nametemplate=(.*?)\s*($|;)/);
    $tmpfile = TempFile($tmpfile);
    open(TMPFILE,">$tmpfile") || die "Error: could not write \"$tmpfile\" -- $!\n";
    do {
        $amt = read(STDIN,$buf,102400);
        print TMPFILE $buf if $amt;
    } while ($amt != 0);
    close(TMPFILE);

    return $tmpfile;
}


sub DecodeFile {
    my($efile,$encoding,$action) = @_;
    my($file,$res);

    $file = $efile;
    $file =~ s!^.*/!!;          # remove leading directories
    $file =~ s!\.[^\.]*$!!;     # remove encoding extension
    $file =~ s!^\.?[^\.]*!%s!;  # replace name with placeholder
    $file = undef if ($efile eq '-');
    my $tmpfile = TempFile($file);

    print STDERR " - decoding \"$efile\" as \"$tmpfile\"\n" if $debug;

#   unlink($tmpfile); # should still be acceptable for "compose" output even if exists
    return $tmpfile if (($efile ne '-' && ! -e $efile) || $action eq 'compose');

    if ($encoding eq "gzip") {
        if ($efile eq '-') {
            $res = system "gzip -d >\Q$tmpfile\E";
        } else {
            $res = system "gzip -dc \Q$efile\E >\Q$tmpfile\E";
        }
    } elsif ($encoding eq "bzip") {
        if ($efile eq '-') {
            $res = system "bzip -d >\Q$tmpfile\E";
        } else {
            $res = system "bzip -dc <\Q$efile\E >\Q$tmpfile\E";
        }
    } elsif ($encoding eq "bzip2") {
        if ($efile eq '-') {
            $res = system "bzip2 -d >\Q$tmpfile\E";
        } else {
            $res = system "bzip2 -dc <\Q$efile\E >\Q$tmpfile\E";
        }
    } elsif ($encoding eq "compress") {
        if ($efile eq '-') {
            $res = system "uncompress >\Q$tmpfile\E";
        } else {
            $res = system "uncompress <\Q$efile\E >\Q$tmpfile\E";
        }
    } else {
        die "Fatal: unknown encoding \"$encoding\" at";
    }

    $res = int($res/256);
    if ($res != 0) {
        print STDERR "Error: could not decode \"$efile\" -- $!\n";
        $retcode = 2 if ($retcode < 2);
        unlink($tmpfile);
        return;
    }

#   chmod 0600,$tmpfile; # done already by TempFile
    return $tmpfile;
}


sub EncodeFile {
    my($dfile,$efile,$encoding) = @_;
    my($res);

    print STDERR " - encoding \"$dfile\" as \"$efile\"\n";

    if ($encoding eq "gzip") {
        if ($efile eq '-') {
            $res = system "gzip -c \Q$dfile\E";
        } else {
            $res = system "gzip -c \Q$dfile\E >\Q$efile\E";
        }
    } elsif ($encoding eq "compress") {
        if ($efile eq '-') {
            $res = system "compress <\Q$dfile\E";
        } else {
            $res = system "compress <\Q$dfile\E >\Q$efile\E";
        }
    } else {
        die "Fatal: unknown encoding \"$encoding\" at";
    }

    $res = int($res/256);
    if ($res != 0) {
        print STDERR "Error: could not encode \"$efile\" (left as \"$dfile\")\n";
        $retcode = 2 if ($retcode < 2);
        return;
    }

    return $dfile;
}


sub ExtensionMimetype {
    my($ext) = @_;
    my($typ);

    unless ($donemimetypes) {
        ReadMimetypes($usrmimetyp);
        ReadMimetypes($locmimetyp);
        ReadMimetypes($shrmimetyp);
        ReadMimetypes($etcmimetyp);
        $donemimetypes = 1;
    }

    $typ = $mimetypes{lc($ext)};

    print STDERR " - extension \"$ext\" maps to mime-type \"$typ\"\n" if $debug;
    return $typ;
}


sub PatternMimetype {
    my($file) = @_;
    my($key,$val);

    while (($key,$val) = each %patterntypes) {
        if ($file =~ m!$key!i) {
            print STDERR " - file \"$file\" maps to mime-type \"$val\"\n" if $debug;
            return $val;
        }
    }

    print STDERR " - file \"$file\" does not conform to any known pattern\n" if $debug;
    return;
}


sub FileMimetype {
    my($file) = @_;
    my($ext)  = ($file =~ m!\.([^/\.]+)$!);

    my $type;

    $type = ExtensionMimetype($ext) if $ext;
    $type = PatternMimetype($file) unless $type;

    return $type;
}


@files = ();
foreach (@ARGV) {
    print STDERR " - parsing parameter \"$_\"\n" if $debug;
    if (m!^(-h|--help)$!) {
        Usage();
        exit(0);
    } elsif (m!^--(.*?)=(.*)$!) {
        print STDERR "Warning: definition of \"$1=$2\" overrides value \"${$1}\"\n" if ($ {$1} && $ {$1} != $2);
        $ {$1}=$2;
    } elsif (m!^--(.*?)$!) {
        print STDERR "Warning: definition of \"$1=$2\" overrides value \"${$1}\"\n" if ($ {$1} && $ {$1} != 1);
        $ {$1}=1;
    } elsif (m!^[^/:]+/[^/:]+:[^/:]+:!) {
        push @files,$_;
    } elsif (m!^([^/:]+/[^/:]+):(.*)! && ! -e $_) {
        my $file = $_;
        my $type = $1;
        my $file = $2;
        my $code = EncodingForFile($file);
        push @files,"${type}:${code}:${file}";
        print STDERR " - file \"$file\" does not exist -- assuming mime-type specification of \"${type}\"\n" if $debug;
    } else {
        my $file = $_;
        my $code = EncodingForFile($file);
        my $type;
        if ($code) {
            my $efile = $file;
            $efile =~ s/\.[^\.]+$//;
            $type = FileMimetype($efile);
        } else {
            $type = FileMimetype($file);
        }
        if ($type) {
            push @files,"${type}:${code}:${file}";
        } else {
            print STDERR "Warning: unknown mime-type for \"$file\" -- using \"$defmimetyp\"\n";
            push @files,"${defmimetyp}:${code}:${file}";
        }
    }
}

unless ($action) {
       if ($0 =~ m!(^|/)view$!)     { $action="view";   }
    elsif ($0 =~ m!(^|/)see$!)      { $action="view";   }
    elsif ($0 =~ m!(^|/)cat$!)      { $action="cat";    }
    elsif ($0 =~ m!(^|/)edit$!)     { $action="edit";   }
    elsif ($0 =~ m!(^|/)change$!)   { $action="edit";   }
    elsif ($0 =~ m!(^|/)compose$!)  { $action="compose";}
    elsif ($0 =~ m!(^|/)print$!)    { $action="print";  }
    elsif ($0 =~ m!(^|/)create$!)   { $action="compose";}
    else                            { $action="view";   }
}


$mailcaps = $ENV{MAILCAPS};
$mailcaps = "$ENV{HOME}/.mailcap:/etc/mailcap:/usr/local/etc/mailcap:/usr/share/etc/mailcap:/usr/etc/mailcap" unless $mailcaps;
foreach (split(/:/,$mailcaps)) {
    ReadMailcap($_);
}

foreach (@files) {
    my($type,$code,$file) = m/^(.*?):(.*?):(.*)$/;
    print STDERR "Processing file \"$file\" of type \"$type\" (encoding=",$code?$code:"none",")...\n" if $debug;

    if ($file ne '-') {
        if ($action eq 'compose' || $action eq 'edit') {
            if (-e $file) {
                if (! -w $file) {
                    print STDERR "Error: no write permission for file \"$file\"\n";
                    $retcode = 2 if ($retcode < 2);
                    next;
                }
            } else {
                if (open(TEST,">$file")) {
                    close(TEST);
                    unlink($file);
                } else {
                    print STDERR "Error: no write permission for file \"$file\"\n";
                    $retcode = 2 if ($retcode < 2);
                    next;
                }
            }
        } else {
            if (! -e $file) {
                print STDERR "Error: no such file \"$file\"\n";
                $retcode = 2 if ($retcode < 2);
                next;
            }
            if (! -r $file) {
                print STDERR "Error: no read permission for file \"$file\"\n";
                $retcode = 2 if ($retcode < 2);
                next;
            }
        }
    }

    my(@matches,$entry,$res,$efile);
    if ($code) {
        $efile = $file;
        $file  = DecodeFile($efile,$code,$action);
        next unless $file;
    }

    foreach $entry (@mailcap) {
        $entry =~ m/^(.*?)\s*;/;
        $_ = "\Q$1\E"; s/\\\*/\.\*/g;
        push @matches,$entry if ($type =~ m!^$_$!i);
    }
    @matches = grep(/\Q$action\E=/,@matches) unless ($action eq "view" || $action eq "cat");

    my $done=0;
    my $fail=0;
    foreach $match (@matches) {
        my $comm;
        print STDERR " - checking mailcap entry \"$match\"\n" if $debug;
        if ($action eq "view" || $action eq "cat") {
            ($comm) = ($match =~ m/^.*?;\s*(.*?)\s*($|;)/);
        } else {
            ($comm) = ($match =~ m/\Q$action\E=(.*?)\s*($|;)/);
        }
        next if (!$comm || $comm =~ m!(^|/)false$!i);
        print STDERR " - program to execute: $comm\n" if $debug;

	if ($action eq 'cat' && $match !~ m/;\s*copiousoutput\s*($|;)/) {
	    print STDERR " - \"copiousoutput\" is required for \"cat\" action\n" if $debug;
	    $fail++;
	    next;
	}

        my($tmpfile,$tmplink);
        if ($action ne 'print' && $match =~ m/;\s*needsterminal\s*($|;)/ && ! -t STDOUT) {
            if ($ENV{DISPLAY}) {
                $comm = "$xtermprgrm -T '$file ($type)' -e $0 --action=$action '${type}:%s'";
            } else {
                print STDERR " - no terminal available for rule (needsterminal)\n" if $debug;
                $fail++;
                next;
            }
        } elsif ($action eq 'view' && $pager && $match =~ m/;\s*copiousoutput\s*($|;)/ && $type ne 'text/plain') {
            $comm .= " | $0 --action=$action text/plain:-";
        }

        if ($match =~ m/;\s*test=(.*?)\s*($|;)/) {
            my $test;
            print STDERR " - running test: $1 " if $debug;
            $test   = system "$1 >/dev/null 2>&1";
            $test >>= 8;
            print STDERR " (result=$test=",($test!=0?"false":"true"),")\n" if $debug;
            if ($test) {
                $fail++;
                next;
            }
        }

        if ($file ne "-") {
            if ($comm =~ m/[^%]%s/) {
                if ($file =~ m![^ a-z0-9,.:/@%^+=_-]!i) {
                    $match =~ m/nametemplate=(.*?)\s*($|;)/;
                    my $prefix = $1;
                    my $linked = 0;
                    while (!$linked) {
                        $tmplink = TempFile($prefix);
                        unlink($tmplink);
                        if ($file =~ m!^/!) {
                            $linked = symlink($file,$tmplink);
                        } else {
                            my $pwd = `/bin/pwd`;
                            chomp($pwd);
                            $linked = symlink("$pwd/$file",$tmplink);
                        }
                    }
                    print STDERR " - filename contains shell meta-characters; aliased to '$tmplink'\n" if $debug;
                    $comm =~ s/([^%])%s/$1$tmplink/g;
                } else {
                    $comm =~ s/([^%])%s/$1"$file"/g;
                }
            } else {
                if ($comm =~ m/\|/) {
                    $comm =~ s/\|/<\Q$file\E \|/;
                } else {
                    $comm .= " <\Q$file\E";
                }
                if ($action eq 'edit' || $action eq 'compose') {
                    $comm .= " >\Q$file\E";
                }
            }
        } else {
            if ($comm =~ m/[^%]%s/) {
                $tmpfile = SaveStdin($match);
                $comm =~ s/([^%])%s/$1$tmpfile/g;
            } else {
                # no name means same as "-"... read from stdin
            }
        }

        $comm =~ s!([^%])%t!$1$type!g;
        $comm =~ s!([^%])%F!$1!g;
        $comm =~ s!%{(.*?)}!$_="'$ENV{$1}'";s/\`//g;s/\'\'//g;$_!ge;
        $comm =~ s!\\(.)!$1!g;
        $comm =~ s!\'\'!\'!g;
        $comm =~ s!$quotedsemi!;!go;
        $comm =~ s!$quotedprct!%!go;

        print STDERR " - executing: $comm\n" if $debug;
	if ($norun) {
	    print $comm,"\n";
	    $res = 0;
	} else {
	    $res = system $comm;
	    $res = int($res/256);
	}
        if ($res != 0) {
            print STDERR "Warning: program returned non-zero exit code \#$res\n";
            $retcode = $res;
        }
        $done=1;
        unlink $tmpfile if $tmpfile;
        unlink $tmplink if $tmplink;
        last;
    }

    if (!$done) {
        if ($fail) {
            print STDERR "Error: no \"$action\" rule for type \"$type\" passed its test case\n";
            print STDERR "       (for more information, add \"--debug=1\" on the command line)\n";
            $retcode = 3 if ($retcode < 3);
        } else {
            print STDERR "Error: no \"$action\" mailcap rules found for type \"$type\"\n";
            $retcode = 3 if ($retcode < 3);
        }
        unlink $file if $code;
        $retcode = 1 unless $retcode;
        next;
    }

    if ($code) {
        if ($action eq 'edit' || $action eq 'compose') {
            my $file = EncodeFile($file,$efile,$code);
            unlink $file if $file;
        } else {
            unlink $file;
        }
    }
}

exit($retcode);
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
	12
	13	$debug=0;
98afa569 TP	14	$norun=0;
98afa569 TP	15	$pager=0;
c85fa412 TP	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";
98afa569 TP	44	print STDERR " pager ignore any \"copiousoutput\" directives and use a \"pager\"\n";
98afa569 TP	45	print STDERR " norun just print but don't execute the command (useful with --debug)\n";
c85fa412 TP	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
a672689e TP	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";
c85fa412 TP	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"; }
98afa569	364	elsif ($0 =~ m!(^\|/)cat$!) { $action="cat"; }
c85fa412 TP	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	}
98afa569	428	@matches = grep(/\Q$action\E=/,@matches) unless ($action eq "view" \|\| $action eq "cat");
c85fa412 TP	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;
98afa569	435	if ($action eq "view" \|\| $action eq "cat") {
c85fa412 TP	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
98afa569 TP	443	if ($action eq 'cat' && $match !~ m/;\scopiousoutput\s($\|;)/) {
	444	print STDERR " - \"copiousoutput\" is required for \"cat\" action\n" if $debug;
	445	$fail++;
	446	next;
	447	}
c85fa412 TP	448
	449	my($tmpfile,$tmplink);
	450	if ($action ne 'print' && $match =~ m/;\sneedsterminal\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	}
98afa569 TP	458	} elsif ($action eq 'view' && $pager && $match =~ m/;\scopiousoutput\s($\|;)/ && $type ne 'text/plain') {
	459	$comm .= " \| $0 --action=$action text/plain:-";
	460	}
	461
	462	if ($match =~ m/;\stest=(.?)\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	}
c85fa412 TP	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 {
5fdfbdab	494	$comm =~ s/([^%])%s/$1"$file"/g;
c85fa412 TP	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;
98afa569 TP	524	if ($norun) {
	525	print $comm,"\n";
	526	$res = 0;
	527	} else {
	528	$res = system $comm;
	529	$res = int($res/256);
	530	}
c85fa412 TP	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);