This might help, am starting with the output followed by the code:
Output:
#################### CODE: ####################
print "Hello World!\n"
#################### ERRORS ####################
WARNING: It is strongly suggested that you use strict, warnings and di
+agnostics
#################### OUTPUT ####################
Hello World!
#################### CODE: ####################
use strict ;
use warnings ;
print "Hello World!\n";
#################### ERRORS ####################
#################### OUTPUT ####################
Hello World!
#################### CODE: ####################
use strict ;
use warnings ;
prints "Hello World!\n";
#################### ERRORS ####################
String found where operator expected at input_script1361120797.pl line
+ 6, near "prints "Hello World!\n""
(Do you need to predeclare prints?)
syntax error at input_script1361120797.pl line 6, near "prints "Hello
+World!\n""
Execution of input_script1361120797.pl aborted due to compilation erro
+rs.
#################### OUTPUT ####################
#################### CODE: ####################
`rm`
#################### ERRORS ####################
Nice Try!
#################### OUTPUT ####################
#################### CODE: ####################
system( "rm" ) ;
#################### ERRORS ####################
Nice Try!
#################### OUTPUT ####################
#################### CODE: ####################
use strict ;
use warnings ;
my @arr = ( 0 .. 10 ) ;
foreach my $elem ( @arr ) {
print $elem . "\n";
}
#################### ERRORS ####################
#################### OUTPUT ####################
0
1
2
3
4
5
6
7
8
9
10
Program
use strict ;
use warnings ;
my @code = (
q{ print "Hello World!\n" } ,
q{
use strict ;
use warnings ;
print "Hello World!\n";
} ,
q{
use strict ;
use warnings ;
prints "Hello World!\n";
} ,
q{
`rm`
} ,
q{
system( "rm" ) ;
} ,
q{
use strict ;
use warnings ;
my @arr = ( 0 .. 10 ) ;
foreach my $elem ( @arr ) {
print $elem . "\n";
}
}
) ;
foreach my $code ( @code ) {
my ( $errors, $output ) = evaluate_perl_program( $code ) ;
print '
#################### CODE: ####################
' . $code . '
#################### ERRORS ####################
' . $errors . '
#################### OUTPUT ####################
' . $output . "\n";
}
exit() ;
sub evaluate_perl_program {
my $code = shift ;
my $errors = '' ;
my $output = '' ;
if( my $errors = _code_not_secure( $code ) ) {
return ( $errors, '' ) ;
}
$code = '#! ... perl -T ' . "\n" . $code ; # Ensure
+taint
if( my $basics_not_in_place = _check_for_code_basics( $code ) ) {
$errors .=
'WARNING: It is strongly suggested that you use strict, warnin
+gs and diagnostics' . "\n" ;
}
my $exec_file_location = '' ; # Insert
+location of Temp Dir here.
my $rand_variable = time ; # Set to
+time so you can match to apache logs, use rand() if preferred.
my $exec_file_name = 'input_script' . time . '.pl' ;
open( my $exec_file_handle, ">", $exec_file_location . $exec_file_
+name ) or die( "Unable to open $exec_file_location$exec_file_name" )
+;
print $exec_file_handle $code ;
close( $exec_file_handle ) ;
`perl -T $exec_file_location$exec_file_name > out.$rand_variable 2
+> err.$rand_variable` ; ## Add full path to perl here.
open( my $script_outfile_handle, $exec_file_location . 'out.' . $r
+and_variable ) or die ( "Failed to open $exec_file_location" . 'out.'
+ . "$rand_variable" ) ;
my @output = <$script_outfile_handle>;
$output = join( '', @output ) ;
open( my $script_errfile_handle, $exec_file_location . 'err.' . $r
+and_variable ) or die ( "Failed to open $exec_file_location" . 'err.'
+ . "$rand_variable" ) ;
my @errors = <$script_errfile_handle>;
$errors .= join( '', @errors ) ;
return ( $errors, $output ) ;
}
sub _code_not_secure {
my $code = shift ;
if( $code =~ /^#\!.*?/ ) {
return 'Do not include perl location in your script';
}
if( ( $code =~ /system\s*?\(.*?rm/ ) or ( $code =~ /`.*?rm`.*?/ )
+) {
return 'Nice Try!';
}
if( ( $code =~ /system\s*?\(/ ) or ( $code =~ /`/ ) ) {
return 'System calls not allowed in script';
}
return 0 ;
}
sub _check_for_code_basics {
my $code = shift ;
return 1 unless(
( $code =~ /use\s+strict/ ) and
( $code =~ /use\s+warnings/ )
);
return 0;
}