| 1 | ################################################################################ |
1 | ################################################################################ |
| 2 | # WeBWorK Online Homework Delivery System |
2 | # WeBWorK Online Homework Delivery System |
| 3 | # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ |
3 | # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ |
| 4 | # $CVSHeader$ |
4 | # $CVSHeader: webwork-modperl/lib/WeBWorK/CourseEnvironment.pm,v 1.23 2003/12/09 01:12:30 sh002i Exp $ |
| 5 | # |
5 | # |
| 6 | # This program is free software; you can redistribute it and/or modify it under |
6 | # This program is free software; you can redistribute it and/or modify it under |
| 7 | # the terms of either: (a) the GNU General Public License as published by the |
7 | # the terms of either: (a) the GNU General Public License as published by the |
| 8 | # Free Software Foundation; either version 2, or (at your option) any later |
8 | # Free Software Foundation; either version 2, or (at your option) any later |
| 9 | # version, or (b) the "Artistic License" which comes with this package. |
9 | # version, or (b) the "Artistic License" which comes with this package. |
| … | |
… | |
| 52 | |
52 | |
| 53 | # Compile the "include" function with all opcodes available. |
53 | # Compile the "include" function with all opcodes available. |
| 54 | my $include = q[ sub include { |
54 | my $include = q[ sub include { |
| 55 | my ($file) = @_; |
55 | my ($file) = @_; |
| 56 | my $fullPath = "].$webworkRoot.q[/$file"; |
56 | my $fullPath = "].$webworkRoot.q[/$file"; |
| 57 | # This regex matches any string that: |
57 | # This regex matches any string that begins with "../", |
| 58 | # : begins with ../ |
58 | # ends with "/..", contains "/../", or is "..". |
| 59 | # : ends with /.. |
|
|
| 60 | # : contains /../, or |
|
|
| 61 | # : is .. |
|
|
| 62 | if ($fullPath =~ m!(?:^|/)\.\.(?:/|$)!) { |
59 | if ($fullPath =~ m!(?:^|/)\.\.(?:/|$)!) { |
| 63 | die "Included file $file has potentially insecure path: contains \"..\""; |
60 | die "Included file $file has potentially insecure path: contains \"..\""; |
| 64 | } else { |
61 | } else { |
| 65 | local @INC = (); |
62 | local @INC = (); |
| 66 | do $fullPath or die "\n\n Couldn't include $fullPath. Has it been created from a distribution file?\n\n"; |
63 | unless (my $result = do $fullPath) { |
|
|
64 | # FIXME: "do" is misbehaving: if there's a syntax error, $@ |
|
|
65 | # should be set to the error string, but it's not getting set. |
|
|
66 | # $! is set to an odd error message "Broken pipe" or something. |
|
|
67 | # On the command line, both $! and $@ are set in the case of a |
|
|
68 | # syntax error. This just means that errors will be confusing. |
|
|
69 | $! and die "Failed to read include file $fullPath: $! (has it been created from the corresponding .dist file?)"; |
|
|
70 | $@ and die "Failed to compile include file $fullPath: $@"; |
|
|
71 | die "Include file $fullPath did not return a true value."; |
|
|
72 | } |
| 67 | } |
73 | } |
| 68 | } ]; |
74 | } ]; |
| 69 | |
75 | |
| 70 | my $maskBackup = $safe->mask; |
76 | my $maskBackup = $safe->mask; |
| 71 | $safe->mask(empty_opset); |
77 | $safe->mask(empty_opset); |
| 72 | $safe->reval($include); |
78 | $safe->reval($include); |
|
|
79 | $@ and die "Failed to reval include subroutine: $@"; |
| 73 | $safe->mask($maskBackup); |
80 | $safe->mask($maskBackup); |
| 74 | |
81 | |
| 75 | # determine location of globalEnvironmentFile |
82 | # determine location of globalEnvironmentFile |
| 76 | my $globalEnvironmentFile = "$webworkRoot/conf/global.conf"; |
83 | my $globalEnvironmentFile = "$webworkRoot/conf/global.conf"; |
| 77 | |
84 | |
Parent Directory
| 
Revision Log
| 
Patch