| … | |
… | |
| 14 | |
14 | |
| 15 | use strict; |
15 | use strict; |
| 16 | use warnings; |
16 | use warnings; |
| 17 | use Safe; |
17 | use Safe; |
| 18 | use WeBWorK::Utils qw(readFile); |
18 | use WeBWorK::Utils qw(readFile); |
|
|
19 | use Opcode qw(empty_opset); |
| 19 | |
20 | |
| 20 | # new($invocant, $webworkRoot, $webworkURLRoot, $pgRoot, $courseName) |
21 | # new($invocant, $webworkRoot, $webworkURLRoot, $pgRoot, $courseName) |
| 21 | # $invocant implicitly set by caller |
22 | # $invocant implicitly set by caller |
| 22 | # $webworkRoot directory that contains the WeBWorK distribution |
23 | # $webworkRoot directory that contains the WeBWorK distribution |
| 23 | # $webworkURLRoot URL that points to the WeBWorK system |
24 | # $webworkURLRoot URL that points to the WeBWorK system |
| … | |
… | |
| 36 | $safe->reval("\$webworkRoot = '$webworkRoot'"); |
37 | $safe->reval("\$webworkRoot = '$webworkRoot'"); |
| 37 | $safe->reval("\$webworkURLRoot = '$webworkURLRoot'"); |
38 | $safe->reval("\$webworkURLRoot = '$webworkURLRoot'"); |
| 38 | $safe->reval("\$pgRoot = '$pgRoot'"); |
39 | $safe->reval("\$pgRoot = '$pgRoot'"); |
| 39 | $safe->reval("\$courseName = '$courseName'"); |
40 | $safe->reval("\$courseName = '$courseName'"); |
| 40 | |
41 | |
| 41 | # This crazy code to create &include in the safe compartment |
42 | # Compile the "include" function with all opcodes available. |
| 42 | # would have been crazier, but Safe->varglob doesn't do what it's |
43 | my $include = "sub include { |
| 43 | # authors think it does. |
|
|
| 44 | |
|
|
| 45 | # This needs to be a closure so that it has a $webworkRoot variable |
|
|
| 46 | # that can't be modified by the code in the safe compartment. |
|
|
| 47 | # You can only include relative to webworkRoot. |
|
|
| 48 | local *include = sub { |
|
|
| 49 | my ($file) = @_; |
44 | my (\$file) = \@_; |
| 50 | my $fullPath = "$webworkRoot/$file"; |
45 | my \$fullPath = \"$webworkRoot/\$file\"; |
|
|
46 | # This regex matches any string that: |
|
|
47 | # : begins with ../ |
|
|
48 | # : ends with /.. |
|
|
49 | # : contains /../, or |
|
|
50 | # : is .. |
| 51 | if ($fullPath =~ m/(?:^|\/)..(?:\/|$)/) { |
51 | if (\$fullPath =~ m!(?:^|/)..(?:/|\$)!) { |
| 52 | die "Included file $file has potentially insecure path: contains '/..' or '../'"; |
52 | die \"Included file \$file has potentially insecure path: contains '..'\"; |
| 53 | } else { |
53 | } else { |
|
|
54 | local \@INC = (); |
| 54 | do $fullPath; |
55 | do \$fullPath; |
| 55 | } |
56 | } |
| 56 | }; |
57 | }"; |
|
|
58 | |
|
|
59 | my $maskBackup = $safe->mask; |
|
|
60 | $safe->mask(empty_opset); |
| 57 | $safe->share('&include'); |
61 | $safe->reval($include); |
|
|
62 | $safe->mask($maskBackup); |
| 58 | |
63 | |
| 59 | # determine location of globalEnvironmentFile |
64 | # determine location of globalEnvironmentFile |
| 60 | my $globalEnvironmentFile = "$webworkRoot/conf/global.conf"; |
65 | my $globalEnvironmentFile = "$webworkRoot/conf/global.conf"; |
| 61 | |
66 | |
| 62 | # read and evaluate the global environment file |
67 | # read and evaluate the global environment file |