← Index
NYTProf Performance Profile   « line view »
For ./view
  Run on Fri Jul 31 19:05:14 2015
Reported on Fri Jul 31 19:08:09 2015

Filename/var/www/foswiki11/lib/Foswiki/Sandbox.pm
StatementsExecuted 2780677 statements in 44.1s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1643242.5s45.4sFoswiki::Sandbox::::sysCommandFoswiki::Sandbox::sysCommand
46084111.51s2.63sFoswiki::Sandbox::::_cleanUpFilePathFoswiki::Sandbox::_cleanUpFilePath
16411274ms2.91sFoswiki::Sandbox::::_buildCommandLineFoswiki::Sandbox::_buildCommandLine
46541125144ms144msFoswiki::Sandbox::::untaintUncheckedFoswiki::Sandbox::untaintUnchecked
1116.30ms12.0msFoswiki::Sandbox::::BEGIN@37Foswiki::Sandbox::BEGIN@37
185741.96ms4.54msFoswiki::Sandbox::::untaintFoswiki::Sandbox::untaint
182111.14ms2.30msFoswiki::Sandbox::::validateWebNameFoswiki::Sandbox::validateWebName
11136µs36µsFoswiki::Sandbox::::validateAttachmentNameFoswiki::Sandbox::validateAttachmentName
11115µs32µsFoswiki::Sandbox::::BEGIN@31Foswiki::Sandbox::BEGIN@31
21112µs59µsFoswiki::Sandbox::::validateTopicNameFoswiki::Sandbox::validateTopicName
11111µs18µsFoswiki::Sandbox::::BEGIN@32Foswiki::Sandbox::BEGIN@32
1119µs125µsFoswiki::Sandbox::::BEGIN@34Foswiki::Sandbox::BEGIN@34
1118µs28µsFoswiki::Sandbox::::BEGIN@33Foswiki::Sandbox::BEGIN@33
1118µs8µsFoswiki::Sandbox::::_assessPipeSupportFoswiki::Sandbox::_assessPipeSupport
1118µs39µsFoswiki::Sandbox::::BEGIN@43Foswiki::Sandbox::BEGIN@43
1115µs5µsFoswiki::Sandbox::::BEGIN@36Foswiki::Sandbox::BEGIN@36
1114µs4µsFoswiki::Sandbox::::BEGIN@39Foswiki::Sandbox::BEGIN@39
0000s0sFoswiki::Sandbox::::_safeDieFoswiki::Sandbox::_safeDie
0000s0sFoswiki::Sandbox::::normalizeFileNameFoswiki::Sandbox::normalizeFileName
0000s0sFoswiki::Sandbox::::sanitizeAttachmentNameFoswiki::Sandbox::sanitizeAttachmentName
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
11*Since* _date_ indicates where functions or parameters have been added since
12the baseline of the API (TWiki release 4.2.3). The _date_ indicates the
13earliest date of a Foswiki release that will support that function or
14parameter.
15
16*Deprecated* _date_ indicates where a function or parameters has been
17[[http://en.wikipedia.org/wiki/Deprecation][deprecated]]. Deprecated
18functions will still work, though they should
19_not_ be called in new plugins and should be replaced in older plugins
20as soon as possible. Deprecated parameters are simply ignored in Foswiki
21releases after _date_.
22
23*Until* _date_ indicates where a function or parameter has been removed.
24The _date_ indicates the latest date at which Foswiki releases still supported
25the function or parameter.
26
27=cut
28
29package Foswiki::Sandbox;
30
31230µs248µs
# spent 32µs (15+16) within Foswiki::Sandbox::BEGIN@31 which was called: # once (15µs+16µs) by Foswiki::BEGIN@631 at line 31
use strict;
# spent 32µs making 1 call to Foswiki::Sandbox::BEGIN@31 # spent 16µs making 1 call to strict::import
32226µs225µs
# spent 18µs (11+7) within Foswiki::Sandbox::BEGIN@32 which was called: # once (11µs+7µs) by Foswiki::BEGIN@631 at line 32
use warnings;
# spent 18µs making 1 call to Foswiki::Sandbox::BEGIN@32 # spent 7µs making 1 call to warnings::import
33229µs247µs
# spent 28µs (8+19) within Foswiki::Sandbox::BEGIN@33 which was called: # once (8µs+19µs) by Foswiki::BEGIN@631 at line 33
use Assert;
# spent 28µs making 1 call to Foswiki::Sandbox::BEGIN@33 # spent 19µs making 1 call to Assert::import
34232µs2241µs
# spent 125µs (9+116) within Foswiki::Sandbox::BEGIN@34 which was called: # once (9µs+116µs) by Foswiki::BEGIN@631 at line 34
use Error qw( :try );
# spent 125µs making 1 call to Foswiki::Sandbox::BEGIN@34 # spent 116µs making 1 call to Error::import
35
36220µs15µs
# spent 5µs within Foswiki::Sandbox::BEGIN@36 which was called: # once (5µs+0s) by Foswiki::BEGIN@631 at line 36
use File::Spec ();
# spent 5µs making 1 call to Foswiki::Sandbox::BEGIN@36
372129µs112.0ms
# spent 12.0ms (6.30+5.66) within Foswiki::Sandbox::BEGIN@37 which was called: # once (6.30ms+5.66ms) by Foswiki::BEGIN@631 at line 37
use File::Temp ();
# spent 12.0ms making 1 call to Foswiki::Sandbox::BEGIN@37
38
39225µs14µs
# spent 4µs within Foswiki::Sandbox::BEGIN@39 which was called: # once (4µs+0s) by Foswiki::BEGIN@631 at line 39
use Foswiki ();
# spent 4µs making 1 call to Foswiki::Sandbox::BEGIN@39
40
41# Set to 1 to trace commands to STDERR, and redirect STDERR from
42# the command subprocesses to /tmp/foswiki_sandbox.log
4322.20ms270µs
# spent 39µs (8+31) within Foswiki::Sandbox::BEGIN@43 which was called: # once (8µs+31µs) by Foswiki::BEGIN@631 at line 43
use constant TRACE => 0;
# spent 39µs making 1 call to Foswiki::Sandbox::BEGIN@43 # spent 31µs making 1 call to constant::import
44
451100nsour $REAL_SAFE_PIPE_OPEN;
461100nsour $EMULATED_SAFE_PIPE_OPEN;
471100nsour $SAFE;
481100nsour $CMDQUOTE; # leave undef until _assessPipeSupport has run
49
50# TODO: Sandbox module should probably use custom 'die' handler so that
51# output goes only to web server error log - otherwise it might give
52# useful debugging information to someone developing an exploit.
53
54# Assess pipe support for =$os=, setting flags for platform features
55# that help.
56
# spent 8µs within Foswiki::Sandbox::_assessPipeSupport which was called: # once (8µs+0s) by Foswiki::Sandbox::sysCommand at line 520
sub _assessPipeSupport {
57
58 # filter the support based on what platforms are proven not to work.
59
601400ns $REAL_SAFE_PIPE_OPEN = 1;
6111µs $EMULATED_SAFE_PIPE_OPEN = 1;
62
63# Detect ActiveState and Strawberry perl. (Cygwin perl returns "cygwin" for $^O)
6411µs if ( $^O eq 'MSWin32' ) {
65 $REAL_SAFE_PIPE_OPEN = 0;
66 $EMULATED_SAFE_PIPE_OPEN = 0;
67 }
68
69 # 'Safe' means no need to filter in on this platform - check
70 # sandbox status at time of filtering
7111µs $SAFE = ( $REAL_SAFE_PIPE_OPEN || $EMULATED_SAFE_PIPE_OPEN ) ? 1 : 0;
72
73 # Shell quoting - shell used only on non-safe platforms
7415µs if (
75 $Foswiki::cfg{OS} eq 'UNIX'
76 || ( $Foswiki::cfg{OS} eq 'WINDOWS'
77 && $Foswiki::cfg{DetailedOS} eq 'cygwin' )
78 )
79 {
801700ns $CMDQUOTE = "'";
81 }
82 else {
83 $CMDQUOTE = '"';
84 }
85}
86
87=begin TML
88
89---++ StaticMethod untaintUnchecked ( $string ) -> $untainted
90
91Untaints =$string= without any checks. If $string is
92undefined, return undef.
93
94This function doesn't perform *any* checks on the data being untainted.
95Callers *must* ensure that =$string= does not contain any dangerous content,
96such as interpolation characters, if it is to be used in potentially
97unsafe operations.
98
99=cut
100
101
# spent 144ms within Foswiki::Sandbox::untaintUnchecked which was called 46541 times, avg 3µs/call: # 46084 times (141ms+0s) by Foswiki::Sandbox::_cleanUpFilePath at line 253, avg 3µs/call # 120 times (1.06ms+0s) by Foswiki::Sandbox::_buildCommandLine at line 363, avg 9µs/call # 98 times (350µs+0s) by Foswiki::Templates::_readTemplateFile at line 446 of /var/www/foswiki11/lib/Foswiki/Templates.pm, avg 4µs/call # 94 times (626µs+0s) by Foswiki::Templates::_readTemplateFile at line 402 of /var/www/foswiki11/lib/Foswiki/Templates.pm, avg 7µs/call # 94 times (213µs+0s) by Foswiki::Templates::_readTemplateFile at line 404 of /var/www/foswiki11/lib/Foswiki/Templates.pm, avg 2µs/call # 17 times (94µs+0s) by Foswiki::Render::_handleSquareBracketedLink at line 897 of /var/www/foswiki11/lib/Foswiki/Render.pm, avg 6µs/call # 17 times (76µs+0s) by Foswiki::Render::internalLink at line 599 of /var/www/foswiki11/lib/Foswiki/Render.pm, avg 4µs/call # 7 times (52µs+0s) by Foswiki::Plugins::DirectedGraphPlugin::commonTagsHandler at line 347 of /var/www/foswiki11/lib/Foswiki/Plugins/DirectedGraphPlugin.pm, avg 7µs/call # 7 times (22µs+0s) by Foswiki::Plugins::DirectedGraphPlugin::commonTagsHandler at line 348 of /var/www/foswiki11/lib/Foswiki/Plugins/DirectedGraphPlugin.pm, avg 3µs/call # once (16µs+0s) by Foswiki::Plugins::DirectedGraphPlugin::initPlugin at line 133 of /var/www/foswiki11/lib/Foswiki/Plugins/DirectedGraphPlugin.pm # once (12µs+0s) by Foswiki::Users::TopicUserMapping::getLoginName at line 224 of /var/www/foswiki11/lib/Foswiki/Users/TopicUserMapping.pm # once (4µs+0s) by Foswiki::Plugins::DirectedGraphPlugin::initPlugin at line 134 of /var/www/foswiki11/lib/Foswiki/Plugins/DirectedGraphPlugin.pm
sub untaintUnchecked {
1024654116.2ms my ($string) = @_;
103
10446541244ms if ( defined($string) && $string =~ /^(.*)$/s ) {
105 return $1;
106 }
107 return $string;
108}
109
110=begin TML
111
112---++ StaticMethod untaint ( $datum, \&method, ... ) -> $untainted
113
114Calls &$method($datum, ...) and if it returns a non-undef result, returns
115that result after untainting it. Otherwise returns undef.
116
117\&method can indicate a validation problem in a couple of ways. First, it
118can throw an exception. Second, it can return undef, which then causes
119the untaint function to return undef.
120
121=cut
122
123
# spent 4.54ms (1.96+2.58) within Foswiki::Sandbox::untaint which was called 185 times, avg 25µs/call: # 100 times (960µs+1.18ms) by Foswiki::Store::VC::Handler::getWebNames at line 547 of /var/www/foswiki11/lib/Foswiki/Store/VC/Handler.pm, avg 21µs/call # 41 times (298µs+432µs) by Foswiki::Search::InfoCache::_getListOfWebs at line 473 of /var/www/foswiki11/lib/Foswiki/Search/InfoCache.pm, avg 18µs/call # 40 times (650µs+816µs) by Foswiki::Search::InfoCache::_getListOfWebs at line 484 of /var/www/foswiki11/lib/Foswiki/Search/InfoCache.pm, avg 37µs/call # once (23µs+38µs) by Foswiki::Store::getWorkArea at line 135 of /var/www/foswiki11/lib/Foswiki/Store.pm # once (13µs+47µs) by Foswiki::new at line 1894 of /var/www/foswiki11/lib/Foswiki.pm # once (8µs+44µs) by Foswiki::new at line 1904 of /var/www/foswiki11/lib/Foswiki.pm # once (7µs+18µs) by Foswiki::new at line 1900 of /var/www/foswiki11/lib/Foswiki.pm
sub untaint {
124185138µs my $datum = shift;
12518555µs my $method = shift;
126185222µs185185µs ASSERT( ref($method) ) if DEBUG;
# spent 185µs making 185 calls to Assert::ASSERTS_OFF, avg 998ns/call
12718548µs return $datum unless defined $datum;
128
129 # Untaint the datum before validating it
130185413µs return undef unless $datum =~ /^(.*)$/s;
131185786µs1852.39ms return &$method( $1, @_ );
# spent 2.30ms making 182 calls to Foswiki::Sandbox::validateWebName, avg 13µs/call # spent 59µs making 2 calls to Foswiki::Sandbox::validateTopicName, avg 30µs/call # spent 36µs making 1 call to Foswiki::Sandbox::validateAttachmentName
132}
133
134=begin TML
135
136---++ StaticMethod validateWebName($name) -> $web
137
138Check that the name is valid for use as a web name. Method used for
139validation with untaint(). Returns the name, or undef if it is invalid.
140
141=cut
142
143
# spent 2.30ms (1.14+1.16) within Foswiki::Sandbox::validateWebName which was called 182 times, avg 13µs/call: # 182 times (1.14ms+1.16ms) by Foswiki::Sandbox::untaint at line 131, avg 13µs/call
sub validateWebName {
144182198µs my $web = shift;
145182718µs1821.16ms return $web if Foswiki::isValidWebName( $web, 1 );
# spent 1.16ms making 182 calls to Foswiki::isValidWebName, avg 6µs/call
146 return;
147}
148
149=begin TML
150
151---++ StaticMethod validateTopicName($name) -> $topic
152
153Check that the name is valid for use as a topic name. Method used for
154validation with untaint(). Returns the name, or undef if it is invalid.
155
156=cut
157
158
# spent 59µs (12+47) within Foswiki::Sandbox::validateTopicName which was called 2 times, avg 30µs/call: # 2 times (12µs+47µs) by Foswiki::Sandbox::untaint at line 131, avg 30µs/call
sub validateTopicName {
15922µs my $topic = shift;
16028µs247µs return $topic if Foswiki::isValidTopicName( $topic, 1 );
# spent 47µs making 2 calls to Foswiki::isValidTopicName, avg 23µs/call
161 return;
162}
163
164=begin TML
165
166---++ StaticMethod validateAttachmentName($name) -> $attachment
167
168Check that the name is valid for use as an attachment name. Method used for
169validation with untaint(). Returns the name, or undef if it is invalid.
170
171Note that the name may contain path separators. This is to permit validation
172of an attachment that is stored in a subdirectory somewhere under the
173standard Web/Topic/attachment level e.g
174Web/Topic/attachmentdir/subdir/attachment.gif. While such attachments cannot
175be created via the UI, they *can* be created manually on the server.
176
177The individual path components are filtered by $Foswiki::cfg{NameFilter}
178
179=cut
180
181
# spent 36µs within Foswiki::Sandbox::validateAttachmentName which was called: # once (36µs+0s) by Foswiki::Sandbox::untaint at line 131
sub validateAttachmentName {
18212µs my $string = shift;
183
1841700ns return undef unless $string;
185
186 # Attachment names are always relative to web/topic, so leading /'s
187 # are simply an expression of that root.
1881800ns $string =~ s/^\/+//;
189
19014µs my @dirs = split( /\/+/, $string );
1911400ns my @result;
19213µs foreach my $component (@dirs) {
19311µs return undef unless defined($component) && $component ne '';
1941500ns next if $component eq '.';
19512µs if ( $component eq '..' ) {
196 if ( scalar(@result) ) {
197
198 # path name is relative within its own length - we can
199 # do that
200 pop(@result);
201 }
202 else {
203
204 # Illegal relative path name
205 return undef;
206 }
207 }
208 else {
209
210 # Filter nasty characters
211116µs $component =~ s/$Foswiki::cfg{NameFilter}//g;
21211µs push( @result, $component );
213 }
214 }
215
216 #SMELL: there is a proper way to do this.... File::Spec
21718µs return join( '/', @result );
218}
219
220# Validate, clean up and untaint filename passed to an external command
221
# spent 2.63s (1.51+1.12) within Foswiki::Sandbox::_cleanUpFilePath which was called 46084 times, avg 57µs/call: # 46084 times (1.51s+1.12s) by Foswiki::Sandbox::_buildCommandLine at line 367, avg 57µs/call
sub _cleanUpFilePath {
2224608413.3ms my $string = shift;
223460846.23ms return '' unless defined $string;
2244608498.2ms46084244ms my ( $volume, $dirs, $file ) = File::Spec->splitpath($string);
# spent 244ms making 46084 calls to File::Spec::Unix::splitpath, avg 5µs/call
225460845.56ms my @result;
226460849.66ms my $first = 1;
22746084152ms4608497.4ms foreach my $component ( File::Spec->splitdir($dirs) ) {
# spent 97.4ms making 46084 calls to File::Spec::Unix::splitdir, avg 2µs/call
22841467384.1ms next unless ( defined($component) && $component ne '' || $first );
22932254936.2ms $first = 0;
23032254934.3ms $component ||= '';
23132254937.6ms next if $component eq '.';
232322549133ms if ( $component eq '..' ) {
233 throw Error::Simple( 'relative path in filename ' . $string );
234 }
235 elsif ( $component =~ /$Foswiki::cfg{NameFilter}/ ) {
236 throw Error::Simple( 'illegal characters in file name component "'
237 . $component
238 . '" of filename '
239 . $string );
240 }
241322549150ms push( @result, $component );
242 }
243
24446084101ms46084509ms if ( scalar(@result) ) {
# spent 509ms making 46084 calls to File::Spec::Unix::catdir, avg 11µs/call
245 $dirs = File::Spec->catdir(@result);
246 }
247 else {
248 $dirs = '';
249 }
2504608491.5ms46084126ms $string = File::Spec->catpath( $volume, $dirs, $file );
# spent 126ms making 46084 calls to File::Spec::Unix::catpath, avg 3µs/call
251
252 # Validated, can safely untaint
25346084199ms46084141ms return untaintUnchecked($string);
# spent 141ms making 46084 calls to Foswiki::Sandbox::untaintUnchecked, avg 3µs/call
254}
255
256=begin TML
257
258---++ StaticMethod normalizeFileName( $string ) -> $filename
259
260Throws an exception if =$string= contains filtered characters, as
261defined by =$Foswiki::cfg{NameFilter}=
262
263The returned string is not tainted, but it may contain shell
264metacharacters and even control characters.
265
266*DEPRECATED* - provided for compatibility only. Do not use!
267If you want to validate an attachment, use
268untaint($name, \&validateAttachmentName)
269
270=cut
271
272sub normalizeFileName {
273 return _cleanUpFilePath(@_);
274}
275
276=begin TML
277
278---++ StaticMethod sanitizeAttachmentName($fname) -> ($fileName, $origName)
279
280Given a file name received in a query parameter, sanitise it. Returns
281the sanitised name together with the basename before sanitisation.
282
283Sanitation includes removal of all leading path components,
284filtering illegal characters and mapping client
285file names to a subset of legal server file names.
286
287Avoid using this if you can; encoding attachment names this way is badly
288broken, much better to use point-of-source validation to ensure only valid
289attachment names are ever uploaded.
290
291=cut
292
293sub sanitizeAttachmentName {
294 my $fileName = shift; # Full pathname if browser is IE
295
296 # Homegrown split equivalent because File::Spec functions will assume that
297 # directory path is using / in UNIX and \ in Windows as defined in the HOST
298 # environment. And we don't know the client OS. Problem is specific to IE
299 # which sends the full original client path when you upload files. See
300 # Item2859 and Item2225 before trying again to use File::Spec functions and
301 # remember to test with IE.
302 # This should take care of any silly ../ shenanigans
303 $fileName =~ s{[\\/]+$}{}; # Get rid of trailing slash/backslash (unlikely)
304 $fileName =~ s!^.*[\\/]!!; # Get rid of leading directory components
305
306 my $origName = $fileName;
307
308 # Change spaces to underscore
309 $fileName =~ s/ /_/go;
310
311 # See Foswiki.pm filenameInvalidCharRegex definition and/or Item11185
312 #$fileName =~ s/$Foswiki::regex{filenameInvalidCharRegex}//go;
313 $fileName =~ s/$Foswiki::cfg{NameFilter}//go;
314
315 # Append .txt to some files
316 $fileName =~ s/$Foswiki::cfg{UploadFilter}/$1\.txt/goi;
317
318 # Untaint
319 $fileName = untaintUnchecked($fileName);
320
321 return ( $fileName, $origName );
322}
323
324
# spent 2.91s (274ms+2.63) within Foswiki::Sandbox::_buildCommandLine which was called 164 times, avg 17.7ms/call: # 164 times (274ms+2.63s) by Foswiki::Sandbox::sysCommand at line 523, avg 17.7ms/call
sub _buildCommandLine {
325164464µs my ( $template, %params ) = @_;
32616455µs my @arguments;
327
32816446µs $template ||= '';
329
330164992µs for my $tmplarg ( split /\s+/, $template ) {
331808257µs next if $tmplarg eq ''; # ignore leading/trailing whitespace
332
333 # Split single argument into its parts. It may contain
334 # multiple substitutions.
335
3368082.36ms my @tmplarg = $tmplarg =~ /([^%]+|%[^%]+%)/g;
337808106µs my @targs;
338808596µs for my $t (@tmplarg) {
3398302.42ms if ( $t =~ /%(.*?)(?:\|([A-Z]))?%/ ) {
340
341 # implicit untaint of template OK
342306575µs my ( $p, $flag ) = ( $1, $2 );
343306233µs if ( !exists $params{$p} ) {
344 throw Error::Simple( 'unknown parameter name ' . $p );
345 }
346306283µs my $type = ref $params{$p};
34730653µs my @params;
3483066.37ms if ( $type eq '' ) {
349 @params = ( $params{$p} );
350 }
351 elsif ( $type eq 'ARRAY' ) {
352 @params = @{ $params{$p} };
353 }
354 else {
355 throw Error::Simple( $type . ' reference passed in ' . $p );
356 }
357
3583062.44ms for my $param (@params) {
359462265.62ms unless ($flag) {
360 push @targs, $param;
361 next;
362 }
3634622636.1ms1201.06ms if ( $flag eq 'U' ) {
# spent 1.06ms making 120 calls to Foswiki::Sandbox::untaintUnchecked, avg 9µs/call
364 push @targs, untaintUnchecked($param);
365 }
366 elsif ( $flag eq 'F' ) {
3674608454.9ms460842.63s $param = _cleanUpFilePath($param);
# spent 2.63s making 46084 calls to Foswiki::Sandbox::_cleanUpFilePath, avg 57µs/call
368
369 # Some command interpreters are too stupid to deal
370 # with filenames that start with a non-alphanumeric
3714608427.5ms $param = "./$param" if $param =~ /^[^\w\/\\]/;
3724608429.5ms push @targs, $param;
373 }
374 elsif ( $flag eq 'N' ) {
375
376 # Generalized number.
37722144µs if ( $param =~ /^([0-9A-Fa-f.x+\-]{0,30})$/ ) {
378 push @targs, $1;
379 }
380 else {
381 throw Error::Simple(
382 "invalid number argument '$param' $t");
383 }
384 }
385 elsif ( $flag eq 'S' ) {
386
387 # "Harmless" string. Aggressively filter-in on unsafe
388 # platforms.
389 if ( $SAFE || $param =~ /^[-0-9A-Za-z.+_]+$/ ) {
390 push @targs, untaintUnchecked($param);
391 }
392 else {
393 throw Error::Simple(
394 "invalid string argument '$param' $t");
395 }
396 }
397 elsif ( $flag eq 'D' ) {
398
399 # RCS date.
400 if (
401 $param =~ m|^(\d\d\d\d/\d\d/\d\d \d\d:\d\d:\d\d)$| )
402 {
403 push @targs, $1;
404 }
405 else {
406 throw Error::Simple(
407 "invalid date argument '$param' $t");
408 }
409 }
410 else {
411 throw Error::Simple( 'illegal flag in ' . $t );
412 }
413 }
414 }
415 else {
416524437µs push @targs, $t;
417 }
418 }
419
420 # Recombine the argument if the template argument contained
421 # multiple parts.
422
4238087.33ms if ( @tmplarg == 1 ) {
424 push @arguments, @targs;
425 }
426 else {
4272258µs2248µs map { ASSERT( defined($_) ) } @targs if (DEBUG);
# spent 48µs making 22 calls to Assert::ASSERTS_OFF, avg 2µs/call
4282280µs push @arguments, join( '', @targs );
429 }
430 }
431
4321646.62ms return @arguments;
433}
434
435# Catch and redirect error reports from programs and argument processing,
436# to avert the risk of exposing server paths to a hacker.
437sub _safeDie {
438 print STDERR $_[0];
439 die
440'Foswiki experienced a fatal error. Please check your webserver error logs for details.';
441}
442
443=begin TML
444
445---++ StaticMethod sysCommand( $class, $template, %params ) -> ( $data, $exit, $stderr )
446
447Invokes the program described by =$template=
448and =%params=, and returns the output of the program and an exit code.
449STDOUT is returned. STDERR is returned *if possible* (or is undef if not).
450$class is ignored, and is only present for compatibility.
451
452The caller has to ensure that the invoked program does not react in a
453harmful way to the passed arguments. =sysCommand= merely
454ensures that the shell does not interpret any of the passed arguments.
455
456$template is a template command-line for the program, which contains
457typed tokens that are replaced with parameter values passed in the
458=sysCommand= call. For example,
459<verbatim>
460 my ( $output, $exit ) = Foswiki::Sandbox->sysCommand(
461 $command,
462 FILENAME => $filename );
463</verbatim>
464where =$command= is a template for the command - for example,
465<verbatim>
466/usr/bin/rcs -i -t-none -kb %FILENAME|F%
467</verbatim>
468=$template= is split at whitespace, and '%VAR%' strings contained in it
469are replaced with =$params{VAR}=. =%params= values may consist of scalars and
470array references. Array references are dereferenced and the
471array elements are inserted. '%VAR%' can optionally take the form '%VAR|T%',
472where FLAG is a single character type flag. Permitted type flags are
473 * =U= untaint without further checks -- dangerous,
474 * =F= normalize as file name,
475 * =N= generalized number,
476 * =S= simple, short string,
477 * =D= RCS format date
478
479=cut
480
481# TODO: get emulated pipes or even backticks working on ActivePerl...
482
483
# spent 45.4s (42.5+2.98) within Foswiki::Sandbox::sysCommand which was called 164 times, avg 277ms/call: # 120 times (32.0s+2.94s) by Foswiki::Store::SearchAlgorithms::Forking::search at line 109 of /var/www/foswiki11/lib/Foswiki/Store/SearchAlgorithms/Forking.pm, avg 291ms/call # 22 times (5.44s+24.4ms) by Foswiki::Store::VC::RcsWrapHandler::_numRevisions at line 360 of /var/www/foswiki11/lib/Foswiki/Store/VC/RcsWrapHandler.pm, avg 249ms/call # 22 times (4.99s+15.7ms) by Foswiki::Store::VC::RcsWrapHandler::getInfo at line 323 of /var/www/foswiki11/lib/Foswiki/Store/VC/RcsWrapHandler.pm, avg 227ms/call
sub sysCommand {
484164379µs164322µs ASSERT( scalar(@_) % 2 == 0 ) if DEBUG;
# spent 322µs making 164 calls to Assert::ASSERTS_OFF, avg 2µs/call
485164888µs my ( $ignore, $template, %params ) = @_;
486
487 #local $SIG{__DIE__} = &_safeDie;
488
48916494µs my $data = ''; # Output
49016442µs my $handle; # Holds filehandle to read from process
49116471µs my $exit = 0; # Exit status of child process
492
49316445µs return '' unless $template;
494
495 # Implicit untaint OK; $template is safe
4961641.61ms $template =~ /^(.*?)(?:\s+(.*))?$/;
497164751µs my $path = $1;
498164498µs my $pTmpl = $2;
49916453µs my $cmd;
500
501 # Writing to a cache file is the only way I can find of redirecting
502 # STDERR.
503
504 # Note: Use of the file handle $fh returned here would be safer than
505 # using the file name. But it is less portable, so filename wil have to do.
5061642.50ms16468.2ms my ( $fh, $stderrCache ) = File::Temp::tempfile(
# spent 68.2ms making 164 calls to File::Temp::tempfile, avg 416µs/call
507 "STDERR.$$.XXXXXXXXXX",
508 DIR => "$Foswiki::cfg{WorkingDir}/tmp",
509 UNLINK => 0
510 );
5111641.27ms close $fh;
512
513 # Item5449: A random key known by both parent and child.
514 # Used to make it possible that the parent detects when
515 # child execution fails. Child can't throw exceptions
516 # cause they are separated processes, so it's up to
517 # the parent.
518164351µs my $key = int( rand(255) ) + 1;
519
520164134µs18µs _assessPipeSupport() unless defined $CMDQUOTE;
# spent 8µs making 1 call to Foswiki::Sandbox::_assessPipeSupport
521
522 # Build argument list from template
5231645.40ms1642.91s my @args = _buildCommandLine( $pTmpl, %params );
# spent 2.91s making 164 calls to Foswiki::Sandbox::_buildCommandLine, avg 17.7ms/call
524164228µs if ($REAL_SAFE_PIPE_OPEN) {
525
526 # Real safe pipes, open from process directly - works
527 # for most Unix/Linux Perl platforms and on Cygwin. Based on
528 # perlipc(1).
529
530 # Note that there doesn't seem to be any way to redirect
531 # STDERR when using safe pipes.
532
533164205ms my $pid = open( $handle, '-|' );
534
535164109µs throw Error::Simple( 'open of pipe failed: ' . $! ) unless defined $pid;
536
5371641.47ms if ($pid) {
538
539 # Parent - read data from process filehandle
5401643.05ms local $/ = undef; # set to read to EOF
54116442.1s $data = <$handle>;
54216419.6ms close $handle;
5431641.86ms $exit = ( $? >> 8 );
5441642.34ms if ( $exit == $key && $data =~ /$key: (.*)/ ) {
545 throw Error::Simple("exec of $template failed: $1");
546 }
547 }
548 else {
549
550 # Child - run the command
551 untie(*STDERR);
552 open( STDERR, '>', $stderrCache )
553 || die "Can't redirect STDERR: '$!'";
554
555 unless ( exec( $path, @args ) ) {
556 syswrite( STDOUT, $key . ": $!\n" );
557 exit($key);
558 }
559
560 # can never get here
561 }
562
563 }
564 elsif ($EMULATED_SAFE_PIPE_OPEN) {
565
566 # Safe pipe emulation mostly on Windows platforms
567
568 # Create pipe
569 my $readHandle;
570 my $writeHandle;
571
572 pipe( $readHandle, $writeHandle )
573 || throw Error::Simple( 'could not create pipe: ' . $! );
574
575 my $pid = fork();
576 throw Error::Simple( 'fork() failed: ' . $! ) unless defined($pid);
577
578 if ($pid) {
579
580 # Parent - read data from process filehandle and remove newlines
581
582 close($writeHandle) or die;
583
584 local $/ = undef; # set to read to EOF
585 $data = <$readHandle>;
586 close($readHandle);
587 $pid = wait; # wait for child process so we can get exit status
588 $exit = ( $? >> 8 );
589 if ( $exit == $key && $data =~ /$key: (.*)/ ) {
590 throw Error::Simple( 'exec failed: ' . $1 );
591 }
592
593 }
594 else {
595
596 # Child - run the command, stdout to pipe
597
598 # close the read side of the pipe and streams inherited from parent
599 close($readHandle) || die;
600
601 # Despite documentation apparently to the contrary, closing
602 # STDOUT first makes the subsequent open useless. So don't.
603 # When running tests -log, then STDOUT is tied to an object
604 # that tees the output. Unfortunately, what we need here is a plain
605 # file handle, so we need to make sure we untie it. untie is a
606 # NOP if STDOUT is not tied.
607 untie(*STDOUT);
608 untie(*STDERR);
609
610 open( STDOUT, ">&=", fileno($writeHandle) ) or die;
611
612 open( STDERR, '>', $stderrCache )
613 || die "Can't kill STDERR: $!";
614
615 unless ( exec( $path, @args ) ) {
616 syswrite( STDOUT, $key . ": $!\n" );
617 exit($key);
618 }
619
620 # can never get here
621 }
622
623 }
624 else {
625
626 # No safe pipes available, use the shell as last resort (with
627 # earlier filtering in unless administrator forced filtering out)
628
629 # This appears to be the only way to get ActiveStatePerl working
630 # Escape the cmd quote using \
631 if ( $CMDQUOTE eq '"' ) {
632
633 # DOS shell :-( Tried dozens of ways of trying to get the quotes
634 # right, but it just won't play nicely
635 $cmd = $path . ' "' . join( '" "', @args ) . '"';
636 }
637 else {
638 $cmd =
639 $path . ' '
640 . $CMDQUOTE
641 . join(
642 $CMDQUOTE . ' ' . $CMDQUOTE,
643 map { s/$CMDQUOTE/\\$CMDQUOTE/go; $_ } @args
644 ) . $CMDQUOTE;
645 }
646
647 if ( ( $Foswiki::cfg{DetailedOS} eq 'MSWin32' )
648 && ( length($cmd) > 8191 ) )
649 {
650
651 #heck, on pre WinXP its only 2048 - http://support.microsoft.com/kb/830473
652 print STDERR
653 "WARNING: Sandbox::sysCommand commandline probably too long ("
654 . length($cmd) . ")\n";
655 ASSERT( length($cmd) < 8191 ) if DEBUG;
656 }
657
658 open( my $oldStderr, '>&STDERR' ) || die "Can't steal STDERR: $!";
659
660 open( STDERR, '>', $stderrCache )
661 || die "Can't redirect STDERR: $!";
662
663 $data = `$cmd`;
664
665 # restore STDERR
666 close(STDERR);
667 open( STDERR, '>&', $oldStderr ) || die "Can't restore STDERR: $!";
668 close($oldStderr);
669
670 $exit = ( $? >> 8 );
671
672 # Do *not* return the error message; it contains sensitive path info.
673 print STDERR "\n$cmd failed: $exit\n" if ( TRACE && $exit );
674 }
675
676 if (TRACE) {
677 $cmd ||=
678 $path . ' '
679 . $CMDQUOTE
680 . join( $CMDQUOTE . ' ' . $CMDQUOTE, @args )
681 . $CMDQUOTE;
682 $data ||= '';
683 print STDERR $cmd, ' -> ', $data, "\n";
684 }
685
686164320µs my $stderr;
6871646.39ms if ( open( $handle, '<', $stderrCache ) ) {
688164808µs local $/;
6891644.90ms $stderr = <$handle>;
6901641.62ms close($handle);
691 }
69216413.5ms unlink($stderrCache);
693
69416438.5ms return ( $data, $exit, $stderr );
695}
696
69713µs1;
698__END__