Filename | /usr/local/src/github.com/foswiki/core/lib/Foswiki/Sandbox.pm |
Statements | Executed 9177 statements in 94.2s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
78 | 2 | 1 | 94.1s | 94.1s | CORE:readline (opcode) | Foswiki::Sandbox::
78 | 2 | 1 | 87.8ms | 87.8ms | CORE:open (opcode) | Foswiki::Sandbox::
1457 | 10 | 6 | 20.6ms | 25.1ms | untaintUnchecked | Foswiki::Sandbox::
39 | 2 | 1 | 14.3ms | 94.2s | sysCommand | Foswiki::Sandbox::
1 | 1 | 1 | 10.9ms | 26.3ms | BEGIN@39 | Foswiki::Sandbox::
1968 | 8 | 1 | 6.88ms | 6.88ms | CORE:match (opcode) | Foswiki::Sandbox::
39 | 1 | 1 | 6.41ms | 12.5ms | _cleanUpFilePath | Foswiki::Sandbox::
39 | 1 | 1 | 5.79ms | 19.6ms | _buildCommandLine | Foswiki::Sandbox::
39 | 1 | 1 | 2.48ms | 2.48ms | CORE:unlink (opcode) | Foswiki::Sandbox::
117 | 3 | 1 | 2.05ms | 2.05ms | CORE:close (opcode) | Foswiki::Sandbox::
34 | 7 | 3 | 943µs | 2.22ms | untaint | Foswiki::Sandbox::
234 | 1 | 1 | 339µs | 339µs | CORE:regcomp (opcode) | Foswiki::Sandbox::
3 | 1 | 1 | 50µs | 271µs | validateWebName | Foswiki::Sandbox::
3 | 1 | 1 | 40µs | 205µs | validateTopicName | Foswiki::Sandbox::
1 | 1 | 1 | 27µs | 37µs | BEGIN@33 | Foswiki::Sandbox::
1 | 1 | 1 | 22µs | 22µs | _assessPipeSupport | Foswiki::Sandbox::
1 | 1 | 1 | 20µs | 66µs | BEGIN@35 | Foswiki::Sandbox::
1 | 1 | 1 | 18µs | 42µs | BEGIN@34 | Foswiki::Sandbox::
1 | 1 | 1 | 16µs | 409µs | BEGIN@36 | Foswiki::Sandbox::
1 | 1 | 1 | 16µs | 120µs | BEGIN@45 | Foswiki::Sandbox::
1 | 1 | 1 | 10µs | 10µs | BEGIN@38 | Foswiki::Sandbox::
1 | 1 | 1 | 10µs | 10µs | BEGIN@41 | Foswiki::Sandbox::
0 | 0 | 0 | 0s | 0s | _safeDie | Foswiki::Sandbox::
0 | 0 | 0 | 0s | 0s | normalizeFileName | Foswiki::Sandbox::
0 | 0 | 0 | 0s | 0s | sanitizeAttachmentName | Foswiki::Sandbox::
0 | 0 | 0 | 0s | 0s | validateAttachmentName | Foswiki::Sandbox::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # See bottom of file for license and copyright information | ||||
2 | |||||
3 | =begin TML | ||||
4 | |||||
5 | ---+ package Foswiki::Sandbox | ||||
6 | |||||
7 | This package provides an interface to the outside world. All calls to | ||||
8 | system functions, or handling of file names, should be brokered by | ||||
9 | the =sysCommand= function in this package. | ||||
10 | |||||
11 | API version $Date$ (revision $Rev$) | ||||
12 | |||||
13 | *Since* _date_ indicates where functions or parameters have been added since | ||||
14 | the baseline of the API (TWiki release 4.2.3). The _date_ indicates the | ||||
15 | earliest date of a Foswiki release that will support that function or | ||||
16 | parameter. | ||||
17 | |||||
18 | *Deprecated* _date_ indicates where a function or parameters has been | ||||
19 | [[http://en.wikipedia.org/wiki/Deprecation][deprecated]]. Deprecated | ||||
20 | functions will still work, though they should | ||||
21 | _not_ be called in new plugins and should be replaced in older plugins | ||||
22 | as soon as possible. Deprecated parameters are simply ignored in Foswiki | ||||
23 | releases after _date_. | ||||
24 | |||||
25 | *Until* _date_ indicates where a function or parameter has been removed. | ||||
26 | The _date_ indicates the latest date at which Foswiki releases still supported | ||||
27 | the function or parameter. | ||||
28 | |||||
29 | =cut | ||||
30 | |||||
31 | package Foswiki::Sandbox; | ||||
32 | |||||
33 | 2 | 47µs | 2 | 47µs | # spent 37µs (27+10) within Foswiki::Sandbox::BEGIN@33 which was called:
# once (27µs+10µs) by Foswiki::BEGIN@608 at line 33 # spent 37µs making 1 call to Foswiki::Sandbox::BEGIN@33
# spent 10µs making 1 call to strict::import |
34 | 2 | 45µs | 2 | 67µs | # spent 42µs (18+24) within Foswiki::Sandbox::BEGIN@34 which was called:
# once (18µs+24µs) by Foswiki::BEGIN@608 at line 34 # spent 42µs making 1 call to Foswiki::Sandbox::BEGIN@34
# spent 24µs making 1 call to warnings::import |
35 | 2 | 48µs | 2 | 112µs | # spent 66µs (20+46) within Foswiki::Sandbox::BEGIN@35 which was called:
# once (20µs+46µs) by Foswiki::BEGIN@608 at line 35 # spent 66µs making 1 call to Foswiki::Sandbox::BEGIN@35
# spent 46µs making 1 call to Assert::import |
36 | 2 | 55µs | 2 | 802µs | # spent 409µs (16+393) within Foswiki::Sandbox::BEGIN@36 which was called:
# once (16µs+393µs) by Foswiki::BEGIN@608 at line 36 # spent 409µs making 1 call to Foswiki::Sandbox::BEGIN@36
# spent 393µs making 1 call to Error::import |
37 | |||||
38 | 2 | 43µs | 1 | 10µs | # spent 10µs within Foswiki::Sandbox::BEGIN@38 which was called:
# once (10µs+0s) by Foswiki::BEGIN@608 at line 38 # spent 10µs making 1 call to Foswiki::Sandbox::BEGIN@38 |
39 | 2 | 290µs | 2 | 26.5ms | # spent 26.3ms (10.9+15.4) within Foswiki::Sandbox::BEGIN@39 which was called:
# once (10.9ms+15.4ms) by Foswiki::BEGIN@608 at line 39 # spent 26.3ms making 1 call to Foswiki::Sandbox::BEGIN@39
# spent 192µs making 1 call to Exporter::import |
40 | |||||
41 | 2 | 46µs | 1 | 10µs | # spent 10µs within Foswiki::Sandbox::BEGIN@41 which was called:
# once (10µs+0s) by Foswiki::BEGIN@608 at line 41 # spent 10µs making 1 call to Foswiki::Sandbox::BEGIN@41 |
42 | |||||
43 | # Set to 1 to trace commands to STDERR, and redirect STDERR from | ||||
44 | # the command subprocesses to /tmp/foswiki_sandbox.log | ||||
45 | 2 | 3.77ms | 2 | 224µs | # spent 120µs (16+104) within Foswiki::Sandbox::BEGIN@45 which was called:
# once (16µs+104µs) by Foswiki::BEGIN@608 at line 45 # spent 120µs making 1 call to Foswiki::Sandbox::BEGIN@45
# spent 104µs making 1 call to constant::import |
46 | |||||
47 | 1 | 1µs | our $REAL_SAFE_PIPE_OPEN; | ||
48 | 1 | 800ns | our $EMULATED_SAFE_PIPE_OPEN; | ||
49 | 1 | 800ns | our $SAFE; | ||
50 | 1 | 800ns | our $CMDQUOTE; # leave undef until _assessPipeSupport has run | ||
51 | |||||
52 | # TODO: Sandbox module should probably use custom 'die' handler so that | ||||
53 | # output goes only to web server error log - otherwise it might give | ||||
54 | # useful debugging information to someone developing an exploit. | ||||
55 | |||||
56 | # Assess pipe support for =$os=, setting flags for platform features | ||||
57 | # that help. | ||||
58 | # spent 22µs within Foswiki::Sandbox::_assessPipeSupport which was called:
# once (22µs+0s) by Foswiki::Sandbox::sysCommand at line 522 | ||||
59 | |||||
60 | # filter the support based on what platforms are proven not to work. | ||||
61 | |||||
62 | 6 | 24µs | $REAL_SAFE_PIPE_OPEN = 1; | ||
63 | $EMULATED_SAFE_PIPE_OPEN = 1; | ||||
64 | |||||
65 | # Detect ActiveState and Strawberry perl. (Cygwin perl returns "cygwin" for $^O) | ||||
66 | if ( $^O eq 'MSWin32' ) { | ||||
67 | $REAL_SAFE_PIPE_OPEN = 0; | ||||
68 | $EMULATED_SAFE_PIPE_OPEN = 0; | ||||
69 | } | ||||
70 | |||||
71 | # 'Safe' means no need to filter in on this platform - check | ||||
72 | # sandbox status at time of filtering | ||||
73 | $SAFE = ( $REAL_SAFE_PIPE_OPEN || $EMULATED_SAFE_PIPE_OPEN ) ? 1 : 0; | ||||
74 | |||||
75 | # Shell quoting - shell used only on non-safe platforms | ||||
76 | if ( | ||||
77 | $Foswiki::cfg{OS} eq 'UNIX' | ||||
78 | || ( $Foswiki::cfg{OS} eq 'WINDOWS' | ||||
79 | && $Foswiki::cfg{DetailedOS} eq 'cygwin' ) | ||||
80 | ) | ||||
81 | { | ||||
82 | $CMDQUOTE = "'"; | ||||
83 | } | ||||
84 | else { | ||||
85 | $CMDQUOTE = '"'; | ||||
86 | } | ||||
87 | } | ||||
88 | |||||
89 | =begin TML | ||||
90 | |||||
91 | ---++ StaticMethod untaintUnchecked ( $string ) -> $untainted | ||||
92 | |||||
93 | Untaints =$string= without any checks. If $string is | ||||
94 | undefined, return undef. | ||||
95 | |||||
96 | This function doesn't perform *any* checks on the data being untainted. | ||||
97 | Callers *must* ensure that =$string= does not contain any dangerous content, | ||||
98 | such as interpolation characters, if it is to be used in potentially | ||||
99 | unsafe operations. | ||||
100 | |||||
101 | =cut | ||||
102 | |||||
103 | # spent 25.1ms (20.6+4.50) within Foswiki::Sandbox::untaintUnchecked which was called 1457 times, avg 17µs/call:
# 1068 times (15.5ms+3.27ms) by Foswiki::Contrib::MailerContrib::WebNotify::_load at line 389 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Contrib/MailerContrib/WebNotify.pm, avg 18µs/call
# 160 times (2.00ms+468µs) by Foswiki::Templates::_readTemplateFile at line 456 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Templates.pm, avg 15µs/call
# 72 times (905µs+218µs) by Foswiki::Render::internalLink at line 589 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Render.pm, avg 16µs/call
# 40 times (311µs+28µs) by Foswiki::Render::_handleWikiWord at line 727 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Render.pm, avg 8µs/call
# 39 times (837µs+232µs) by Foswiki::Sandbox::_cleanUpFilePath at line 255, avg 27µs/call
# 32 times (411µs+102µs) by Foswiki::Render::_handleSquareBracketedLink at line 885 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Render.pm, avg 16µs/call
# 20 times (315µs+88µs) by Foswiki::Templates::_readTemplateFile at line 402 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Templates.pm, avg 20µs/call
# 20 times (234µs+59µs) by Foswiki::Templates::_readTemplateFile at line 404 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Templates.pm, avg 15µs/call
# 5 times (95µs+28µs) by Foswiki::Users::TopicUserMapping::getLoginName at line 224 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Users/TopicUserMapping.pm, avg 25µs/call
# once (20µs+5µs) by Foswiki::LoginManager::loadSession at line 352 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/LoginManager.pm | ||||
104 | 4371 | 26.4ms | my ($string) = @_; | ||
105 | |||||
106 | 1424 | 4.50ms | if ( defined($string) && $string =~ /^(.*)$/s ) { # spent 4.50ms making 1424 calls to Foswiki::Sandbox::CORE:match, avg 3µs/call | ||
107 | return $1; | ||||
108 | } | ||||
109 | return $string; | ||||
110 | } | ||||
111 | |||||
112 | =begin TML | ||||
113 | |||||
114 | ---++ StaticMethod untaint ( $datum, \&method, ... ) -> $untainted | ||||
115 | |||||
116 | Calls &$method($datum, ...) and if it returns a non-undef result, returns | ||||
117 | that result after untainting it. Otherwise returns undef. | ||||
118 | |||||
119 | \&method can indicate a validation problem in a couple of ways. First, it | ||||
120 | can throw an exception. Second, it can return undef, which then causes | ||||
121 | the untaint function to return undef. | ||||
122 | |||||
123 | =cut | ||||
124 | |||||
125 | # spent 2.22ms (943µs+1.28) within Foswiki::Sandbox::untaint which was called 34 times, avg 65µs/call:
# 28 times (776µs+755µs) by Foswiki::Form::createField at line 303 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Form.pm, avg 55µs/call
# once (25µs+161µs) by Foswiki::new at line 1828 of /usr/local/src/github.com/foswiki/core/lib/Foswiki.pm
# once (33µs+134µs) by Foswiki::new at line 1818 of /usr/local/src/github.com/foswiki/core/lib/Foswiki.pm
# once (34µs+72µs) by Foswiki::Store::Interfaces::QueryAlgorithm::getListOfWebs at line 483 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Store/Interfaces/QueryAlgorithm.pm
# once (28µs+66µs) by Foswiki::Form::new at line 82 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Form.pm
# once (24µs+49µs) by Foswiki::new at line 1824 of /usr/local/src/github.com/foswiki/core/lib/Foswiki.pm
# once (22µs+44µs) by Foswiki::Form::new at line 84 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Form.pm | ||||
126 | 204 | 1.02ms | my $datum = shift; | ||
127 | my $method = shift; | ||||
128 | 34 | 122µs | ASSERT( ref($method) ) if DEBUG; # spent 122µs making 34 calls to Assert::ASSERTS_OFF, avg 4µs/call | ||
129 | return $datum unless defined $datum; | ||||
130 | |||||
131 | # Untaint the datum before validating it | ||||
132 | 34 | 156µs | return undef unless $datum =~ /^(.*)$/s; # spent 156µs making 34 calls to Foswiki::Sandbox::CORE:match, avg 5µs/call | ||
133 | 34 | 1.00ms | return &$method( $1, @_ ); # spent 526µs making 28 calls to Foswiki::Form::__ANON__[/usr/local/src/github.com/foswiki/core/lib/Foswiki/Form.pm:302], avg 19µs/call
# spent 271µs making 3 calls to Foswiki::Sandbox::validateWebName, avg 90µs/call
# spent 205µs making 3 calls to Foswiki::Sandbox::validateTopicName, avg 68µs/call | ||
134 | } | ||||
135 | |||||
136 | =begin TML | ||||
137 | |||||
138 | ---++ StaticMethod validateWebName($name) -> $web | ||||
139 | |||||
140 | Check that the name is valid for use as a web name. Method used for | ||||
141 | validation with untaint(). Returns the name, or undef if it is invalid. | ||||
142 | |||||
143 | =cut | ||||
144 | |||||
145 | # spent 271µs (50+221) within Foswiki::Sandbox::validateWebName which was called 3 times, avg 90µs/call:
# 3 times (50µs+221µs) by Foswiki::Sandbox::untaint at line 133, avg 90µs/call | ||||
146 | 6 | 48µs | my $web = shift; | ||
147 | 3 | 221µs | return $web if Foswiki::isValidWebName( $web, 1 ); # spent 221µs making 3 calls to Foswiki::isValidWebName, avg 74µs/call | ||
148 | return; | ||||
149 | } | ||||
150 | |||||
151 | =begin TML | ||||
152 | |||||
153 | ---++ StaticMethod validateTopicName($name) -> $topic | ||||
154 | |||||
155 | Check that the name is valid for use as a topic name. Method used for | ||||
156 | validation with untaint(). Returns the name, or undef if it is invalid. | ||||
157 | |||||
158 | =cut | ||||
159 | |||||
160 | # spent 205µs (40+165) within Foswiki::Sandbox::validateTopicName which was called 3 times, avg 68µs/call:
# 3 times (40µs+165µs) by Foswiki::Sandbox::untaint at line 133, avg 68µs/call | ||||
161 | 6 | 38µs | my $topic = shift; | ||
162 | 3 | 165µs | return $topic if Foswiki::isValidTopicName( $topic, 1 ); # spent 165µs making 3 calls to Foswiki::isValidTopicName, avg 55µs/call | ||
163 | return; | ||||
164 | } | ||||
165 | |||||
166 | =begin TML | ||||
167 | |||||
168 | ---++ StaticMethod validateAttachmentName($name) -> $attachment | ||||
169 | |||||
170 | Check that the name is valid for use as an attachment name. Method used for | ||||
171 | validation with untaint(). Returns the name, or undef if it is invalid. | ||||
172 | |||||
173 | Note that the name may contain path separators. This is to permit validation | ||||
174 | of an attachment that is stored in a subdirectory somewhere under the | ||||
175 | standard Web/Topic/attachment level e.g | ||||
176 | Web/Topic/attachmentdir/subdir/attachment.gif. While such attachments cannot | ||||
177 | be created via the UI, they *can* be created manually on the server. | ||||
178 | |||||
179 | The individual path components are filtered by $Foswiki::cfg{NameFilter} | ||||
180 | |||||
181 | =cut | ||||
182 | |||||
183 | sub validateAttachmentName { | ||||
184 | my $string = shift; | ||||
185 | |||||
186 | return undef unless $string; | ||||
187 | |||||
188 | # Attachment names are always relative to web/topic, so leading /'s | ||||
189 | # are simply an expression of that root. | ||||
190 | $string =~ s/^\/+//; | ||||
191 | |||||
192 | my @dirs = split( /\/+/, $string ); | ||||
193 | my @result; | ||||
194 | foreach my $component (@dirs) { | ||||
195 | return undef unless defined($component) && $component ne ''; | ||||
196 | next if $component eq '.'; | ||||
197 | if ( $component eq '..' ) { | ||||
198 | if ( scalar(@result) ) { | ||||
199 | |||||
200 | # path name is relative within its own length - we can | ||||
201 | # do that | ||||
202 | pop(@result); | ||||
203 | } | ||||
204 | else { | ||||
205 | |||||
206 | # Illegal relative path name | ||||
207 | return undef; | ||||
208 | } | ||||
209 | } | ||||
210 | else { | ||||
211 | |||||
212 | # Filter nasty characters | ||||
213 | $component =~ s/$Foswiki::cfg{NameFilter}//g; | ||||
214 | push( @result, $component ); | ||||
215 | } | ||||
216 | } | ||||
217 | |||||
218 | #SMELL: there is a proper way to do this.... File::Spec | ||||
219 | return join( '/', @result ); | ||||
220 | } | ||||
221 | |||||
222 | # Validate, clean up and untaint filename passed to an external command | ||||
223 | # spent 12.5ms (6.41+6.09) within Foswiki::Sandbox::_cleanUpFilePath which was called 39 times, avg 321µs/call:
# 39 times (6.41ms+6.09ms) by Foswiki::Sandbox::_buildCommandLine at line 369, avg 321µs/call | ||||
224 | 1833 | 6.90ms | my $string = shift; | ||
225 | return '' unless defined $string; | ||||
226 | 39 | 995µs | my ( $volume, $dirs, $file ) = File::Spec->splitpath($string); # spent 995µs making 39 calls to File::Spec::Unix::splitpath, avg 26µs/call | ||
227 | my @result; | ||||
228 | my $first = 1; | ||||
229 | 39 | 330µs | foreach my $component ( File::Spec->splitdir($dirs) ) { # spent 330µs making 39 calls to File::Spec::Unix::splitdir, avg 8µs/call | ||
230 | next unless ( defined($component) && $component ne '' || $first ); | ||||
231 | $first = 0; | ||||
232 | $component ||= ''; | ||||
233 | next if $component eq '.'; | ||||
234 | 468 | 743µs | if ( $component eq '..' ) { # spent 404µs making 234 calls to Foswiki::Sandbox::CORE:match, avg 2µs/call
# spent 339µs making 234 calls to Foswiki::Sandbox::CORE:regcomp, avg 1µs/call | ||
235 | throw Error::Simple( 'relative path in filename ' . $string ); | ||||
236 | } | ||||
237 | elsif ( $component =~ /$Foswiki::cfg{NameFilter}/ ) { | ||||
238 | throw Error::Simple( 'illegal characters in file name component "' | ||||
239 | . $component | ||||
240 | . '" of filename ' | ||||
241 | . $string ); | ||||
242 | } | ||||
243 | push( @result, $component ); | ||||
244 | } | ||||
245 | |||||
246 | if ( scalar(@result) ) { | ||||
247 | 39 | 2.44ms | $dirs = File::Spec->catdir(@result); # spent 2.44ms making 39 calls to File::Spec::Unix::catdir, avg 62µs/call | ||
248 | } | ||||
249 | else { | ||||
250 | $dirs = ''; | ||||
251 | } | ||||
252 | 39 | 518µs | $string = File::Spec->catpath( $volume, $dirs, $file ); # spent 518µs making 39 calls to File::Spec::Unix::catpath, avg 13µs/call | ||
253 | |||||
254 | # Validated, can safely untaint | ||||
255 | 39 | 1.07ms | return untaintUnchecked($string); # spent 1.07ms making 39 calls to Foswiki::Sandbox::untaintUnchecked, avg 27µs/call | ||
256 | } | ||||
257 | |||||
258 | =begin TML | ||||
259 | |||||
260 | ---++ StaticMethod normalizeFileName( $string ) -> $filename | ||||
261 | |||||
262 | Throws an exception if =$string= contains filtered characters, as | ||||
263 | defined by =$Foswiki::cfg{NameFilter}= | ||||
264 | |||||
265 | The returned string is not tainted, but it may contain shell | ||||
266 | metacharacters and even control characters. | ||||
267 | |||||
268 | *DEPRECATED* - provided for compatibility only. Do not use! | ||||
269 | If you want to validate an attachment, use | ||||
270 | untaint($name, \&validateAttachmentName) | ||||
271 | |||||
272 | =cut | ||||
273 | |||||
274 | sub normalizeFileName { | ||||
275 | return _cleanUpFilePath(@_); | ||||
276 | } | ||||
277 | |||||
278 | =begin TML | ||||
279 | |||||
280 | ---++ StaticMethod sanitizeAttachmentName($fname) -> ($fileName, $origName) | ||||
281 | |||||
282 | Given a file name received in a query parameter, sanitise it. Returns | ||||
283 | the sanitised name together with the basename before sanitisation. | ||||
284 | |||||
285 | Sanitation includes removal of all leading path components, | ||||
286 | filtering illegal characters and mapping client | ||||
287 | file names to a subset of legal server file names. | ||||
288 | |||||
289 | Avoid using this if you can; encoding attachment names this way is badly | ||||
290 | broken, much better to use point-of-source validation to ensure only valid | ||||
291 | attachment names are ever uploaded. | ||||
292 | |||||
293 | =cut | ||||
294 | |||||
295 | sub sanitizeAttachmentName { | ||||
296 | my $fileName = shift; # Full pathname if browser is IE | ||||
297 | |||||
298 | # Homegrown split equivalent because File::Spec functions will assume that | ||||
299 | # directory path is using / in UNIX and \ in Windows as defined in the HOST | ||||
300 | # environment. And we don't know the client OS. Problem is specific to IE | ||||
301 | # which sends the full original client path when you upload files. See | ||||
302 | # Item2859 and Item2225 before trying again to use File::Spec functions and | ||||
303 | # remember to test with IE. | ||||
304 | # This should take care of any silly ../ shenanigans | ||||
305 | $fileName =~ s{[\\/]+$}{}; # Get rid of trailing slash/backslash (unlikely) | ||||
306 | $fileName =~ s!^.*[\\/]!!; # Get rid of leading directory components | ||||
307 | |||||
308 | my $origName = $fileName; | ||||
309 | |||||
310 | # Change spaces to underscore | ||||
311 | $fileName =~ s/ /_/go; | ||||
312 | |||||
313 | # See Foswiki.pm filenameInvalidCharRegex definition and/or Item11185 | ||||
314 | #$fileName =~ s/$Foswiki::regex{filenameInvalidCharRegex}//go; | ||||
315 | $fileName =~ s/$Foswiki::cfg{NameFilter}//go; | ||||
316 | |||||
317 | # Append .txt to some files | ||||
318 | $fileName =~ s/$Foswiki::cfg{UploadFilter}/$1\.txt/goi; | ||||
319 | |||||
320 | # Untaint | ||||
321 | $fileName = untaintUnchecked($fileName); | ||||
322 | |||||
323 | return ( $fileName, $origName ); | ||||
324 | } | ||||
325 | |||||
326 | # spent 19.6ms (5.79+13.8) within Foswiki::Sandbox::_buildCommandLine which was called 39 times, avg 503µs/call:
# 39 times (5.79ms+13.8ms) by Foswiki::Sandbox::sysCommand at line 525, avg 503µs/call | ||||
327 | 1521 | 7.10ms | my ( $template, %params ) = @_; | ||
328 | my @arguments; | ||||
329 | |||||
330 | $template ||= ''; | ||||
331 | |||||
332 | for my $tmplarg ( split /\s+/, $template ) { | ||||
333 | next if $tmplarg eq ''; # ignore leading/trailing whitespace | ||||
334 | |||||
335 | # Split single argument into its parts. It may contain | ||||
336 | # multiple substitutions. | ||||
337 | |||||
338 | 78 | 400µs | my @tmplarg = $tmplarg =~ /([^%]+|%[^%]+%)/g; # spent 400µs making 78 calls to Foswiki::Sandbox::CORE:match, avg 5µs/call | ||
339 | my @targs; | ||||
340 | for my $t (@tmplarg) { | ||||
341 | 99 | 564µs | if ( $t =~ /%(.*?)(?:\|([A-Z]))?%/ ) { # spent 564µs making 99 calls to Foswiki::Sandbox::CORE:match, avg 6µs/call | ||
342 | |||||
343 | # implicit untaint of template OK | ||||
344 | my ( $p, $flag ) = ( $1, $2 ); | ||||
345 | if ( !exists $params{$p} ) { | ||||
346 | throw Error::Simple( 'unknown parameter name ' . $p ); | ||||
347 | } | ||||
348 | my $type = ref $params{$p}; | ||||
349 | my @params; | ||||
350 | if ( $type eq '' ) { | ||||
351 | @params = ( $params{$p} ); | ||||
352 | } | ||||
353 | elsif ( $type eq 'ARRAY' ) { | ||||
354 | @params = @{ $params{$p} }; | ||||
355 | } | ||||
356 | else { | ||||
357 | throw Error::Simple( $type . ' reference passed in ' . $p ); | ||||
358 | } | ||||
359 | |||||
360 | for my $param (@params) { | ||||
361 | unless ($flag) { | ||||
362 | push @targs, $param; | ||||
363 | next; | ||||
364 | } | ||||
365 | if ( $flag eq 'U' ) { | ||||
366 | push @targs, untaintUnchecked($param); | ||||
367 | } | ||||
368 | elsif ( $flag eq 'F' ) { | ||||
369 | 39 | 12.5ms | $param = _cleanUpFilePath($param); # spent 12.5ms making 39 calls to Foswiki::Sandbox::_cleanUpFilePath, avg 321µs/call | ||
370 | |||||
371 | # Some command interpreters are too stupid to deal | ||||
372 | # with filenames that start with a non-alphanumeric | ||||
373 | 39 | 137µs | $param = "./$param" if $param =~ /^[^\w\/\\]/; # spent 137µs making 39 calls to Foswiki::Sandbox::CORE:match, avg 4µs/call | ||
374 | push @targs, $param; | ||||
375 | } | ||||
376 | elsif ( $flag eq 'N' ) { | ||||
377 | |||||
378 | # Generalized number. | ||||
379 | 21 | 143µs | if ( $param =~ /^([0-9A-Fa-f.x+\-]{0,30})$/ ) { # spent 143µs making 21 calls to Foswiki::Sandbox::CORE:match, avg 7µs/call | ||
380 | push @targs, $1; | ||||
381 | } | ||||
382 | else { | ||||
383 | throw Error::Simple( | ||||
384 | "invalid number argument '$param' $t"); | ||||
385 | } | ||||
386 | } | ||||
387 | elsif ( $flag eq 'S' ) { | ||||
388 | |||||
389 | # "Harmless" string. Aggressively filter-in on unsafe | ||||
390 | # platforms. | ||||
391 | if ( $SAFE || $param =~ /^[-0-9A-Za-z.+_]+$/ ) { | ||||
392 | push @targs, untaintUnchecked($param); | ||||
393 | } | ||||
394 | else { | ||||
395 | throw Error::Simple( | ||||
396 | "invalid string argument '$param' $t"); | ||||
397 | } | ||||
398 | } | ||||
399 | elsif ( $flag eq 'D' ) { | ||||
400 | |||||
401 | # RCS date. | ||||
402 | if ( | ||||
403 | $param =~ m|^(\d\d\d\d/\d\d/\d\d \d\d:\d\d:\d\d)$| ) | ||||
404 | { | ||||
405 | push @targs, $1; | ||||
406 | } | ||||
407 | else { | ||||
408 | throw Error::Simple( | ||||
409 | "invalid date argument '$param' $t"); | ||||
410 | } | ||||
411 | } | ||||
412 | else { | ||||
413 | throw Error::Simple( 'illegal flag in ' . $t ); | ||||
414 | } | ||||
415 | } | ||||
416 | } | ||||
417 | else { | ||||
418 | push @targs, $t; | ||||
419 | } | ||||
420 | } | ||||
421 | |||||
422 | # Recombine the argument if the template argument contained | ||||
423 | # multiple parts. | ||||
424 | |||||
425 | if ( @tmplarg == 1 ) { | ||||
426 | push @arguments, @targs; | ||||
427 | } | ||||
428 | else { | ||||
429 | 21 | 88µs | map { ASSERT( defined($_) ) } @targs if (DEBUG); # spent 88µs making 21 calls to Assert::ASSERTS_OFF, avg 4µs/call | ||
430 | push @arguments, join( '', @targs ); | ||||
431 | } | ||||
432 | } | ||||
433 | |||||
434 | return @arguments; | ||||
435 | } | ||||
436 | |||||
437 | # Catch and redirect error reports from programs and argument processing, | ||||
438 | # to avert the risk of exposing server paths to a hacker. | ||||
439 | sub _safeDie { | ||||
440 | print STDERR $_[0]; | ||||
441 | die | ||||
442 | 'Foswiki experienced a fatal error. Please check your webserver error logs for details.'; | ||||
443 | } | ||||
444 | |||||
445 | =begin TML | ||||
446 | |||||
447 | ---++ StaticMethod sysCommand( $class, $template, %params ) -> ( $data, $exit, $stderr ) | ||||
448 | |||||
449 | Invokes the program described by =$template= | ||||
450 | and =%params=, and returns the output of the program and an exit code. | ||||
451 | STDOUT is returned. STDERR is returned *if possible* (or is undef if not). | ||||
452 | $class is ignored, and is only present for compatibility. | ||||
453 | |||||
454 | The caller has to ensure that the invoked program does not react in a | ||||
455 | harmful way to the passed arguments. =sysCommand= merely | ||||
456 | ensures that the shell does not interpret any of the passed arguments. | ||||
457 | |||||
458 | $template is a template command-line for the program, which contains | ||||
459 | typed tokens that are replaced with parameter values passed in the | ||||
460 | =sysCommand= call. For example, | ||||
461 | <verbatim> | ||||
462 | my ( $output, $exit ) = Foswiki::Sandbox->sysCommand( | ||||
463 | $command, | ||||
464 | FILENAME => $filename ); | ||||
465 | </verbatim> | ||||
466 | where =$command= is a template for the command - for example, | ||||
467 | <verbatim> | ||||
468 | /usr/bin/rcs -i -t-none -kb %FILENAME|F% | ||||
469 | </verbatim> | ||||
470 | =$template= is split at whitespace, and '%VAR%' strings contained in it | ||||
471 | are replaced with =$params{VAR}=. =%params= values may consist of scalars and | ||||
472 | array references. Array references are dereferenced and the | ||||
473 | array elements are inserted. '%VAR%' can optionally take the form '%VAR|T%', | ||||
474 | where FLAG is a single character type flag. Permitted type flags are | ||||
475 | * =U= untaint without further checks -- dangerous, | ||||
476 | * =F= normalize as file name, | ||||
477 | * =N= generalized number, | ||||
478 | * =S= simple, short string, | ||||
479 | * =D= RCS format date | ||||
480 | |||||
481 | =cut | ||||
482 | |||||
483 | # TODO: get emulated pipes or even backticks working on ActivePerl... | ||||
484 | |||||
485 | # spent 94.2s (14.3ms+94.2) within Foswiki::Sandbox::sysCommand which was called 39 times, avg 2.42s/call:
# 21 times (7.84ms+47.6s) by Foswiki::Store::VC::RcsWrapHandler::getInfo at line 329 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Store/VC/RcsWrapHandler.pm, avg 2.27s/call
# 18 times (6.43ms+46.6s) by Foswiki::Store::VC::RcsWrapHandler::_numRevisions at line 366 of /usr/local/src/github.com/foswiki/core/lib/Foswiki/Store/VC/RcsWrapHandler.pm, avg 2.59s/call | ||||
486 | 1209 | 94.2s | 39 | 250µs | ASSERT( scalar(@_) % 2 == 0 ) if DEBUG; # spent 250µs making 39 calls to Assert::ASSERTS_OFF, avg 6µs/call |
487 | my ( $ignore, $template, %params ) = @_; | ||||
488 | |||||
489 | #local $SIG{__DIE__} = &_safeDie; | ||||
490 | |||||
491 | my $data = ''; # Output | ||||
492 | my $handle; # Holds filehandle to read from process | ||||
493 | my $exit = 0; # Exit status of child process | ||||
494 | |||||
495 | return '' unless $template; | ||||
496 | |||||
497 | # Implicit untaint OK; $template is safe | ||||
498 | 39 | 580µs | $template =~ /^(.*?)(?:\s+(.*))?$/; # spent 580µs making 39 calls to Foswiki::Sandbox::CORE:match, avg 15µs/call | ||
499 | my $path = $1; | ||||
500 | my $pTmpl = $2; | ||||
501 | my $cmd; | ||||
502 | |||||
503 | # Writing to a cache file is the only way I can find of redirecting | ||||
504 | # STDERR. | ||||
505 | |||||
506 | # Note: Use of the file handle $fh returned here would be safer than | ||||
507 | # using the file name. But it is less portable, so filename wil have to do. | ||||
508 | 39 | 31.8ms | my ( $fh, $stderrCache ) = tempfile( # spent 31.8ms making 39 calls to File::Temp::tempfile, avg 815µs/call | ||
509 | "STDERR.$$.XXXXXXXXXX", | ||||
510 | DIR => "$Foswiki::cfg{WorkingDir}/tmp", | ||||
511 | UNLINK => 0 | ||||
512 | ); | ||||
513 | 39 | 237µs | close $fh; # spent 237µs making 39 calls to Foswiki::Sandbox::CORE:close, avg 6µs/call | ||
514 | |||||
515 | # Item5449: A random key known by both parent and child. | ||||
516 | # Used to make it possible that the parent detects when | ||||
517 | # child execution fails. Child can't throw exceptions | ||||
518 | # cause they are separated processes, so it's up to | ||||
519 | # the parent. | ||||
520 | my $key = int( rand(255) ) + 1; | ||||
521 | |||||
522 | 1 | 22µs | _assessPipeSupport() unless defined $CMDQUOTE; # spent 22µs making 1 call to Foswiki::Sandbox::_assessPipeSupport | ||
523 | |||||
524 | # Build argument list from template | ||||
525 | 39 | 19.6ms | my @args = _buildCommandLine( $pTmpl, %params ); # spent 19.6ms making 39 calls to Foswiki::Sandbox::_buildCommandLine, avg 503µs/call | ||
526 | if ($REAL_SAFE_PIPE_OPEN) { | ||||
527 | |||||
528 | # Real safe pipes, open from process directly - works | ||||
529 | # for most Unix/Linux Perl platforms and on Cygwin. Based on | ||||
530 | # perlipc(1). | ||||
531 | |||||
532 | # Note that there doesn't seem to be any way to redirect | ||||
533 | # STDERR when using safe pipes. | ||||
534 | |||||
535 | 39 | 86.3ms | my $pid = open( $handle, '-|' ); # spent 86.3ms making 39 calls to Foswiki::Sandbox::CORE:open, avg 2.21ms/call | ||
536 | |||||
537 | throw Error::Simple( 'open of pipe failed: ' . $! ) unless defined $pid; | ||||
538 | |||||
539 | if ($pid) { | ||||
540 | |||||
541 | # Parent - read data from process filehandle | ||||
542 | local $/ = undef; # set to read to EOF | ||||
543 | 39 | 94.1s | $data = <$handle>; # spent 94.1s making 39 calls to Foswiki::Sandbox::CORE:readline, avg 2.41s/call | ||
544 | 39 | 1.65ms | close $handle; # spent 1.65ms making 39 calls to Foswiki::Sandbox::CORE:close, avg 42µs/call | ||
545 | $exit = ( $? >> 8 ); | ||||
546 | if ( $exit == $key && $data =~ /$key: (.*)/ ) { | ||||
547 | throw Error::Simple("exec of $template failed: $1"); | ||||
548 | } | ||||
549 | } | ||||
550 | else { | ||||
551 | |||||
552 | # Child - run the command | ||||
553 | untie(*STDERR); | ||||
554 | open( STDERR, '>', $stderrCache ) | ||||
555 | || die "Can't redirect STDERR: '$!'"; | ||||
556 | |||||
557 | unless ( exec( $path, @args ) ) { | ||||
558 | syswrite( STDOUT, $key . ": $!\n" ); | ||||
559 | exit($key); | ||||
560 | } | ||||
561 | |||||
562 | # can never get here | ||||
563 | } | ||||
564 | |||||
565 | } | ||||
566 | elsif ($EMULATED_SAFE_PIPE_OPEN) { | ||||
567 | |||||
568 | # Safe pipe emulation mostly on Windows platforms | ||||
569 | |||||
570 | # Create pipe | ||||
571 | my $readHandle; | ||||
572 | my $writeHandle; | ||||
573 | |||||
574 | pipe( $readHandle, $writeHandle ) | ||||
575 | || throw Error::Simple( 'could not create pipe: ' . $! ); | ||||
576 | |||||
577 | my $pid = fork(); | ||||
578 | throw Error::Simple( 'fork() failed: ' . $! ) unless defined($pid); | ||||
579 | |||||
580 | if ($pid) { | ||||
581 | |||||
582 | # Parent - read data from process filehandle and remove newlines | ||||
583 | |||||
584 | close($writeHandle) or die; | ||||
585 | |||||
586 | local $/ = undef; # set to read to EOF | ||||
587 | $data = <$readHandle>; | ||||
588 | close($readHandle); | ||||
589 | $pid = wait; # wait for child process so we can get exit status | ||||
590 | $exit = ( $? >> 8 ); | ||||
591 | if ( $exit == $key && $data =~ /$key: (.*)/ ) { | ||||
592 | throw Error::Simple( 'exec failed: ' . $1 ); | ||||
593 | } | ||||
594 | |||||
595 | } | ||||
596 | else { | ||||
597 | |||||
598 | # Child - run the command, stdout to pipe | ||||
599 | |||||
600 | # close the read side of the pipe and streams inherited from parent | ||||
601 | close($readHandle) || die; | ||||
602 | |||||
603 | # Despite documentation apparently to the contrary, closing | ||||
604 | # STDOUT first makes the subsequent open useless. So don't. | ||||
605 | # When running tests -log, then STDOUT is tied to an object | ||||
606 | # that tees the output. Unfortunately, what we need here is a plain | ||||
607 | # file handle, so we need to make sure we untie it. untie is a | ||||
608 | # NOP if STDOUT is not tied. | ||||
609 | untie(*STDOUT); | ||||
610 | untie(*STDERR); | ||||
611 | |||||
612 | open( STDOUT, ">&=", fileno($writeHandle) ) or die; | ||||
613 | |||||
614 | open( STDERR, '>', $stderrCache ) | ||||
615 | || die "Can't kill STDERR: $!"; | ||||
616 | |||||
617 | unless ( exec( $path, @args ) ) { | ||||
618 | syswrite( STDOUT, $key . ": $!\n" ); | ||||
619 | exit($key); | ||||
620 | } | ||||
621 | |||||
622 | # can never get here | ||||
623 | } | ||||
624 | |||||
625 | } | ||||
626 | else { | ||||
627 | |||||
628 | # No safe pipes available, use the shell as last resort (with | ||||
629 | # earlier filtering in unless administrator forced filtering out) | ||||
630 | |||||
631 | # This appears to be the only way to get ActiveStatePerl working | ||||
632 | # Escape the cmd quote using \ | ||||
633 | if ( $CMDQUOTE eq '"' ) { | ||||
634 | |||||
635 | # DOS shell :-( Tried dozens of ways of trying to get the quotes | ||||
636 | # right, but it just won't play nicely | ||||
637 | $cmd = $path . ' "' . join( '" "', @args ) . '"'; | ||||
638 | } | ||||
639 | else { | ||||
640 | $cmd = | ||||
641 | $path . ' ' | ||||
642 | . $CMDQUOTE | ||||
643 | . join( | ||||
644 | $CMDQUOTE . ' ' . $CMDQUOTE, | ||||
645 | map { s/$CMDQUOTE/\\$CMDQUOTE/go; $_ } @args | ||||
646 | ) . $CMDQUOTE; | ||||
647 | } | ||||
648 | |||||
649 | if ( ( $Foswiki::cfg{DetailedOS} eq 'MSWin32' ) | ||||
650 | && ( length($cmd) > 8191 ) ) | ||||
651 | { | ||||
652 | |||||
653 | #heck, on pre WinXP its only 2048 - http://support.microsoft.com/kb/830473 | ||||
654 | print STDERR | ||||
655 | "WARNING: Sandbox::sysCommand commandline probably too long (" | ||||
656 | . length($cmd) . ")\n"; | ||||
657 | ASSERT( length($cmd) < 8191 ) if DEBUG; | ||||
658 | } | ||||
659 | |||||
660 | open( my $oldStderr, '>&STDERR' ) || die "Can't steal STDERR: $!"; | ||||
661 | |||||
662 | open( STDERR, '>', $stderrCache ) | ||||
663 | || die "Can't redirect STDERR: $!"; | ||||
664 | |||||
665 | $data = `$cmd`; | ||||
666 | |||||
667 | # restore STDERR | ||||
668 | close(STDERR); | ||||
669 | open( STDERR, '>&', $oldStderr ) || die "Can't restore STDERR: $!"; | ||||
670 | close($oldStderr); | ||||
671 | |||||
672 | $exit = ( $? >> 8 ); | ||||
673 | |||||
674 | # Do *not* return the error message; it contains sensitive path info. | ||||
675 | print STDERR "\n$cmd failed: $exit\n" if ( TRACE && $exit ); | ||||
676 | } | ||||
677 | |||||
678 | if (TRACE) { | ||||
679 | $cmd ||= | ||||
680 | $path . ' ' | ||||
681 | . $CMDQUOTE | ||||
682 | . join( $CMDQUOTE . ' ' . $CMDQUOTE, @args ) | ||||
683 | . $CMDQUOTE; | ||||
684 | $data ||= ''; | ||||
685 | print STDERR $cmd, ' -> ', $data, "\n"; | ||||
686 | } | ||||
687 | |||||
688 | my $stderr; | ||||
689 | 39 | 1.45ms | if ( open( $handle, '<', $stderrCache ) ) { # spent 1.45ms making 39 calls to Foswiki::Sandbox::CORE:open, avg 37µs/call | ||
690 | local $/; | ||||
691 | 39 | 1.05ms | $stderr = <$handle>; # spent 1.05ms making 39 calls to Foswiki::Sandbox::CORE:readline, avg 27µs/call | ||
692 | 39 | 158µs | close($handle); # spent 158µs making 39 calls to Foswiki::Sandbox::CORE:close, avg 4µs/call | ||
693 | } | ||||
694 | 39 | 2.48ms | unlink($stderrCache); # spent 2.48ms making 39 calls to Foswiki::Sandbox::CORE:unlink, avg 64µs/call | ||
695 | |||||
696 | return ( $data, $exit, $stderr ); | ||||
697 | } | ||||
698 | |||||
699 | 1 | 6µs | 1; | ||
700 | __END__ | ||||
# spent 2.05ms within Foswiki::Sandbox::CORE:close which was called 117 times, avg 18µs/call:
# 39 times (1.65ms+0s) by Foswiki::Sandbox::sysCommand at line 544, avg 42µs/call
# 39 times (237µs+0s) by Foswiki::Sandbox::sysCommand at line 513, avg 6µs/call
# 39 times (158µs+0s) by Foswiki::Sandbox::sysCommand at line 692, avg 4µs/call | |||||
# spent 6.88ms within Foswiki::Sandbox::CORE:match which was called 1968 times, avg 3µs/call:
# 1424 times (4.50ms+0s) by Foswiki::Sandbox::untaintUnchecked at line 106, avg 3µs/call
# 234 times (404µs+0s) by Foswiki::Sandbox::_cleanUpFilePath at line 234, avg 2µs/call
# 99 times (564µs+0s) by Foswiki::Sandbox::_buildCommandLine at line 341, avg 6µs/call
# 78 times (400µs+0s) by Foswiki::Sandbox::_buildCommandLine at line 338, avg 5µs/call
# 39 times (580µs+0s) by Foswiki::Sandbox::sysCommand at line 498, avg 15µs/call
# 39 times (137µs+0s) by Foswiki::Sandbox::_buildCommandLine at line 373, avg 4µs/call
# 34 times (156µs+0s) by Foswiki::Sandbox::untaint at line 132, avg 5µs/call
# 21 times (143µs+0s) by Foswiki::Sandbox::_buildCommandLine at line 379, avg 7µs/call | |||||
sub Foswiki::Sandbox::CORE:open; # opcode | |||||
sub Foswiki::Sandbox::CORE:readline; # opcode | |||||
# spent 339µs within Foswiki::Sandbox::CORE:regcomp which was called 234 times, avg 1µs/call:
# 234 times (339µs+0s) by Foswiki::Sandbox::_cleanUpFilePath at line 234, avg 1µs/call | |||||
# spent 2.48ms within Foswiki::Sandbox::CORE:unlink which was called 39 times, avg 64µs/call:
# 39 times (2.48ms+0s) by Foswiki::Sandbox::sysCommand at line 694, avg 64µs/call |