← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/local/src/github.com/foswiki/core/bin/view
  Run on Sun Dec 4 17:17:59 2011
Reported on Sun Dec 4 17:26:33 2011

Filename/usr/local/src/github.com/foswiki/core/lib/Foswiki/Sandbox.pm
StatementsExecuted 9177 statements in 94.2s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
782194.1s94.1sFoswiki::Sandbox::::CORE:readlineFoswiki::Sandbox::CORE:readline (opcode)
782187.8ms87.8msFoswiki::Sandbox::::CORE:openFoswiki::Sandbox::CORE:open (opcode)
145710620.6ms25.1msFoswiki::Sandbox::::untaintUncheckedFoswiki::Sandbox::untaintUnchecked
392114.3ms94.2sFoswiki::Sandbox::::sysCommandFoswiki::Sandbox::sysCommand
11110.9ms26.3msFoswiki::Sandbox::::BEGIN@39Foswiki::Sandbox::BEGIN@39
1968816.88ms6.88msFoswiki::Sandbox::::CORE:matchFoswiki::Sandbox::CORE:match (opcode)
39116.41ms12.5msFoswiki::Sandbox::::_cleanUpFilePathFoswiki::Sandbox::_cleanUpFilePath
39115.79ms19.6msFoswiki::Sandbox::::_buildCommandLineFoswiki::Sandbox::_buildCommandLine
39112.48ms2.48msFoswiki::Sandbox::::CORE:unlinkFoswiki::Sandbox::CORE:unlink (opcode)
117312.05ms2.05msFoswiki::Sandbox::::CORE:closeFoswiki::Sandbox::CORE:close (opcode)
3473943µs2.22msFoswiki::Sandbox::::untaintFoswiki::Sandbox::untaint
23411339µs339µsFoswiki::Sandbox::::CORE:regcompFoswiki::Sandbox::CORE:regcomp (opcode)
31150µs271µsFoswiki::Sandbox::::validateWebNameFoswiki::Sandbox::validateWebName
31140µs205µsFoswiki::Sandbox::::validateTopicNameFoswiki::Sandbox::validateTopicName
11127µs37µsFoswiki::Sandbox::::BEGIN@33Foswiki::Sandbox::BEGIN@33
11122µs22µsFoswiki::Sandbox::::_assessPipeSupportFoswiki::Sandbox::_assessPipeSupport
11120µs66µsFoswiki::Sandbox::::BEGIN@35Foswiki::Sandbox::BEGIN@35
11118µs42µsFoswiki::Sandbox::::BEGIN@34Foswiki::Sandbox::BEGIN@34
11116µs409µsFoswiki::Sandbox::::BEGIN@36Foswiki::Sandbox::BEGIN@36
11116µs120µsFoswiki::Sandbox::::BEGIN@45Foswiki::Sandbox::BEGIN@45
11110µs10µsFoswiki::Sandbox::::BEGIN@38Foswiki::Sandbox::BEGIN@38
11110µs10µsFoswiki::Sandbox::::BEGIN@41Foswiki::Sandbox::BEGIN@41
0000s0sFoswiki::Sandbox::::_safeDieFoswiki::Sandbox::_safeDie
0000s0sFoswiki::Sandbox::::normalizeFileNameFoswiki::Sandbox::normalizeFileName
0000s0sFoswiki::Sandbox::::sanitizeAttachmentNameFoswiki::Sandbox::sanitizeAttachmentName
0000s0sFoswiki::Sandbox::::validateAttachmentNameFoswiki::Sandbox::validateAttachmentName
Call graph for these subroutines as a Graphviz dot language file.
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
7This package provides an interface to the outside world. All calls to
8system functions, or handling of file names, should be brokered by
9the =sysCommand= function in this package.
10
11API version $Date$ (revision $Rev$)
12
13*Since* _date_ indicates where functions or parameters have been added since
14the baseline of the API (TWiki release 4.2.3). The _date_ indicates the
15earliest date of a Foswiki release that will support that function or
16parameter.
17
18*Deprecated* _date_ indicates where a function or parameters has been
19[[http://en.wikipedia.org/wiki/Deprecation][deprecated]]. Deprecated
20functions will still work, though they should
21_not_ be called in new plugins and should be replaced in older plugins
22as soon as possible. Deprecated parameters are simply ignored in Foswiki
23releases after _date_.
24
25*Until* _date_ indicates where a function or parameter has been removed.
26The _date_ indicates the latest date at which Foswiki releases still supported
27the function or parameter.
28
29=cut
30
31package Foswiki::Sandbox;
32
33247µs247µ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
use strict;
# spent 37µs making 1 call to Foswiki::Sandbox::BEGIN@33 # spent 10µs making 1 call to strict::import
34245µs267µ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
use warnings;
# spent 42µs making 1 call to Foswiki::Sandbox::BEGIN@34 # spent 24µs making 1 call to warnings::import
35248µs2112µ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
use Assert;
# spent 66µs making 1 call to Foswiki::Sandbox::BEGIN@35 # spent 46µs making 1 call to Assert::import
36255µs2802µ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
use Error qw( :try );
# spent 409µs making 1 call to Foswiki::Sandbox::BEGIN@36 # spent 393µs making 1 call to Error::import
37
38243µs110µs
# spent 10µs within Foswiki::Sandbox::BEGIN@38 which was called: # once (10µs+0s) by Foswiki::BEGIN@608 at line 38
use File::Spec ();
# spent 10µs making 1 call to Foswiki::Sandbox::BEGIN@38
392290µs226.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
use File::Temp qw( tempfile );
# spent 26.3ms making 1 call to Foswiki::Sandbox::BEGIN@39 # spent 192µs making 1 call to Exporter::import
40
41246µs110µs
# spent 10µs within Foswiki::Sandbox::BEGIN@41 which was called: # once (10µs+0s) by Foswiki::BEGIN@608 at line 41
use Foswiki ();
# 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
4523.77ms2224µ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
use constant TRACE => 0;
# spent 120µs making 1 call to Foswiki::Sandbox::BEGIN@45 # spent 104µs making 1 call to constant::import
46
4711µsour $REAL_SAFE_PIPE_OPEN;
481800nsour $EMULATED_SAFE_PIPE_OPEN;
491800nsour $SAFE;
501800nsour $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
sub _assessPipeSupport {
59
60 # filter the support based on what platforms are proven not to work.
61
62624µ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
93Untaints =$string= without any checks. If $string is
94undefined, return undef.
95
96This function doesn't perform *any* checks on the data being untainted.
97Callers *must* ensure that =$string= does not contain any dangerous content,
98such as interpolation characters, if it is to be used in potentially
99unsafe 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
sub untaintUnchecked {
104437126.4ms my ($string) = @_;
105
10614244.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
116Calls &$method($datum, ...) and if it returns a non-undef result, returns
117that result after untainting it. Otherwise returns undef.
118
119\&method can indicate a validation problem in a couple of ways. First, it
120can throw an exception. Second, it can return undef, which then causes
121the 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
sub untaint {
1262041.02ms my $datum = shift;
127 my $method = shift;
12834122µ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
13234156µs return undef unless $datum =~ /^(.*)$/s;
# spent 156µs making 34 calls to Foswiki::Sandbox::CORE:match, avg 5µs/call
133341.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
140Check that the name is valid for use as a web name. Method used for
141validation 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
sub validateWebName {
146648µs my $web = shift;
1473221µ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
155Check that the name is valid for use as a topic name. Method used for
156validation 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
sub validateTopicName {
161638µs my $topic = shift;
1623165µ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
170Check that the name is valid for use as an attachment name. Method used for
171validation with untaint(). Returns the name, or undef if it is invalid.
172
173Note that the name may contain path separators. This is to permit validation
174of an attachment that is stored in a subdirectory somewhere under the
175standard Web/Topic/attachment level e.g
176Web/Topic/attachmentdir/subdir/attachment.gif. While such attachments cannot
177be created via the UI, they *can* be created manually on the server.
178
179The individual path components are filtered by $Foswiki::cfg{NameFilter}
180
181=cut
182
183sub 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
sub _cleanUpFilePath {
22418336.90ms my $string = shift;
225 return '' unless defined $string;
22639995µ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;
22939330µ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 '.';
234468743µ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) ) {
247392.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 }
25239518µ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
255391.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
262Throws an exception if =$string= contains filtered characters, as
263defined by =$Foswiki::cfg{NameFilter}=
264
265The returned string is not tainted, but it may contain shell
266metacharacters and even control characters.
267
268*DEPRECATED* - provided for compatibility only. Do not use!
269If you want to validate an attachment, use
270untaint($name, \&validateAttachmentName)
271
272=cut
273
274sub normalizeFileName {
275 return _cleanUpFilePath(@_);
276}
277
278=begin TML
279
280---++ StaticMethod sanitizeAttachmentName($fname) -> ($fileName, $origName)
281
282Given a file name received in a query parameter, sanitise it. Returns
283the sanitised name together with the basename before sanitisation.
284
285Sanitation includes removal of all leading path components,
286filtering illegal characters and mapping client
287file names to a subset of legal server file names.
288
289Avoid using this if you can; encoding attachment names this way is badly
290broken, much better to use point-of-source validation to ensure only valid
291attachment names are ever uploaded.
292
293=cut
294
295sub 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
sub _buildCommandLine {
32715217.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
33878400µ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) {
34199564µ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' ) {
3693912.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
37339137µ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.
37921143µ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 {
4292188µ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.
439sub _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
449Invokes the program described by =$template=
450and =%params=, and returns the output of the program and an exit code.
451STDOUT is returned. STDERR is returned *if possible* (or is undef if not).
452$class is ignored, and is only present for compatibility.
453
454The caller has to ensure that the invoked program does not react in a
455harmful way to the passed arguments. =sysCommand= merely
456ensures that the shell does not interpret any of the passed arguments.
457
458$template is a template command-line for the program, which contains
459typed 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>
466where =$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
471are replaced with =$params{VAR}=. =%params= values may consist of scalars and
472array references. Array references are dereferenced and the
473array elements are inserted. '%VAR%' can optionally take the form '%VAR|T%',
474where 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
sub sysCommand {
486120994.2s39250µ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
49839580µ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.
5083931.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 );
51339237µ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
522122µs _assessPipeSupport() unless defined $CMDQUOTE;
# spent 22µs making 1 call to Foswiki::Sandbox::_assessPipeSupport
523
524 # Build argument list from template
5253919.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
5353986.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
5433994.1s $data = <$handle>;
# spent 94.1s making 39 calls to Foswiki::Sandbox::CORE:readline, avg 2.41s/call
544391.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;
689391.45ms if ( open( $handle, '<', $stderrCache ) ) {
# spent 1.45ms making 39 calls to Foswiki::Sandbox::CORE:open, avg 37µs/call
690 local $/;
691391.05ms $stderr = <$handle>;
# spent 1.05ms making 39 calls to Foswiki::Sandbox::CORE:readline, avg 27µs/call
69239158µs close($handle);
# spent 158µs making 39 calls to Foswiki::Sandbox::CORE:close, avg 4µs/call
693 }
694392.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
69916µs1;
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
sub Foswiki::Sandbox::CORE:close; # opcode
# 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:match; # opcode
# spent 87.8ms within Foswiki::Sandbox::CORE:open which was called 78 times, avg 1.13ms/call: # 39 times (86.3ms+0s) by Foswiki::Sandbox::sysCommand at line 535, avg 2.21ms/call # 39 times (1.45ms+0s) by Foswiki::Sandbox::sysCommand at line 689, avg 37µs/call
sub Foswiki::Sandbox::CORE:open; # opcode
# spent 94.1s within Foswiki::Sandbox::CORE:readline which was called 78 times, avg 1.21s/call: # 39 times (94.1s+0s) by Foswiki::Sandbox::sysCommand at line 543, avg 2.41s/call # 39 times (1.05ms+0s) by Foswiki::Sandbox::sysCommand at line 691, avg 27µs/call
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
sub Foswiki::Sandbox::CORE:regcomp; # opcode
# 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
sub Foswiki::Sandbox::CORE:unlink; # opcode