#!/usr/bin/perl -T -w 
# Taint Mode
# The idea of this version of the pirateinfo Perl CGI test lab is to
# explore the functionality of Perl's "taint mode". Notice the -T on
# the first line of this program. The taint mode's on. Try removing
# the -T and comparing what you can get away with.
# The first thing to deal with is that there can be naughty things as
# part of your path and other environment variables. Search for the
# keyword "delete" to see where I take care of that. If I didn't, the
# taint mode would get freaked out and bail from the beginning. 
# Next, look for the section where I sanitize the input param. Try
# using different regexps to see what works with -T and what doesn't.
# What kinds of regexps still allow naughtiness and yet run in -T?
# Those should probably not make it into production code.
# Also, as a bonus here, I'm showing several versions of the file to
# show what happens when using various forms of the open command. This
# allows you to compare what exploits are disabled by choosing better
# ways to access your data.

use strict;
use CGI qw(:standard);
use CGI::Pretty;

# The @ENV list can cause taint mode to abort. This cures many things.
delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)};

print header() . start_html( { 'title'=>'An Ominous Perl CGI Disaster',
                'BGCOLOR'=>'#000000', 'text'=>'#FFFFFF', 'link'=>'#0000FF' } );
print h1('Pirates... Not So Fun') . img({src=>'../pirates/pirate.png'});

# User input. ---------
my $menu= { 'bartroberts.txt'=>'Bart Roberts', 'benhornigold.txt'=>'Ben Hornigold', 
            'edwardteach.txt'=>'Edward Teach', 'henrymorgan.txt'=>'Henry Morgan', 
            'williamkidd.txt'=>'William Kidd'};
$menu= p( scrolling_list( { 'values'=>[keys %$menu], 'labels'=>$menu, 'name'=>'f', } ) );

my $auth= p( 'Enter thy password' . password_field({'name'=>'pw', 'size'=>8 }) );

print startform("POST", "./pirateinfo2.pl") . $auth . $menu. submit() . endform();

# Rough Authentication ---------
&stop unless param(); # Stop if there is no user input.
# Stop if the password is bad.
print h3('Avast Ye!') and &stop unless param('pw') eq "pcof8";

print Dump(); # Built-in CGI.pm function to display all params.

# Begin sanitizing tainted input ==========================================================
my $badfile= param('f');            # TAINTED
#my $filterRE= qr{^(.+)$};          # Completely useless, but illustrates the concept.
#my $filterRE= qr{^([.\/_a-z]+)$};  # Can still navigate to naughty directories with /
my $filterRE= qr{^([._a-z]+)$}; # Much better...

unless ($badfile =~ $filterRE) { # $file is still tainted, but the backreference, $1, isn't
    print h3("Didn't pass the sanitizer... Sorry. Well, not really.");
    &stop;    
} # end unless filter passes 
my $file= $1;             # Now it's clean by using the backreference....

$file= "../pirates/" . $file;
# End sanitize tainted input ==========================================================

           print hr(); #---------------------------
print h3($file); # Output what the userdata is at this point.
# Always use explicit paths for exectutables!
my $wc= qx{ /usr/bin/wc -w < $file };
$wc="who knows how many" unless $wc; 
print h4("This pirate story is $wc words long.");
           print hr(); #---------------------------
open ( FBAD, $file );
print "BAD:" . b($_) . br() while (<FBAD>);
close FBAD;
           print hr(); #---------------------------
open ( FGOOD, "<$file" ); # This is ok too if your Perl doesn't support 3 arg open.
#open ( FGOOD, "<", $file );
print "GOOD:" . b($_) . br() while (<FGOOD>);
close FGOOD;
           print hr(); #---------------------------
my $verybad= qx{ /bin/cat $file };
print "VERYBAD:" . b($verybad) . br ();

&stop;
sub stop {print end_html() and exit;}

