← Index
NYTProf Performance Profile   « line view »
For ./view
  Run on Fri Jul 31 18:42:36 2015
Reported on Fri Jul 31 18:48:14 2015

Filename/var/www/foswikidev/core/lib/Foswiki/Sandbox.pm
StatementsExecuted 3053070 statements in 42.5s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1201140.5s44.4sFoswiki::Sandbox::::sysCommandFoswiki::Sandbox::sysCommand
46040112.00s3.56sFoswiki::Sandbox::::_cleanUpFilePathFoswiki::Sandbox::_cleanUpFilePath
12011283ms3.85sFoswiki::Sandbox::::_buildCommandLineFoswiki::Sandbox::_buildCommandLine
470841710182ms182msFoswiki::Sandbox::::untaintUncheckedFoswiki::Sandbox::untaintUnchecked
1115.86ms9.59msFoswiki::Sandbox::::BEGIN@37Foswiki::Sandbox::BEGIN@37
11284782µs2.41msFoswiki::Sandbox::::untaintFoswiki::Sandbox::untaint
10611546µs1.50msFoswiki::Sandbox::::validateWebNameFoswiki::Sandbox::validateWebName
51128µs96µsFoswiki::Sandbox::::validateTopicNameFoswiki::Sandbox::validateTopicName
11123µs23µsFoswiki::Sandbox::::validateAttachmentNameFoswiki::Sandbox::validateAttachmentName
11114µs28µsFoswiki::Sandbox::::BEGIN@31Foswiki::Sandbox::BEGIN@31
1119µs34µsFoswiki::Sandbox::::BEGIN@33Foswiki::Sandbox::BEGIN@33
1119µs9µsFoswiki::Sandbox::::_assessPipeSupportFoswiki::Sandbox::_assessPipeSupport
1119µs13µsFoswiki::Sandbox::::BEGIN@32Foswiki::Sandbox::BEGIN@32
1118µs107µsFoswiki::Sandbox::::BEGIN@34Foswiki::Sandbox::BEGIN@34
1117µs36µsFoswiki::Sandbox::::BEGIN@50Foswiki::Sandbox::BEGIN@50
1114µs4µsFoswiki::Sandbox::::BEGIN@36Foswiki::Sandbox::BEGIN@36
1114µs4µsFoswiki::Sandbox::::BEGIN@39Foswiki::Sandbox::BEGIN@39
1114µs4µsFoswiki::Sandbox::::BEGIN@41Foswiki::Sandbox::BEGIN@41
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
31228µs243µs
# spent 28µs (14+15) within Foswiki::Sandbox::BEGIN@31 which was called: # once (14µs+15µs) by Foswiki::BEGIN@643 at line 31
use strict;
# spent 28µs making 1 call to Foswiki::Sandbox::BEGIN@31 # spent 14µs making 1 call to strict::import
32223µs218µs
# spent 13µs (9+4) within Foswiki::Sandbox::BEGIN@32 which was called: # once (9µs+4µs) by Foswiki::BEGIN@643 at line 32
use warnings;
# spent 13µs making 1 call to Foswiki::Sandbox::BEGIN@32 # spent 4µs making 1 call to warnings::import
33228µs259µs
# spent 34µs (9+25) within Foswiki::Sandbox::BEGIN@33 which was called: # once (9µs+25µs) by Foswiki::BEGIN@643 at line 33
use Assert;
# spent 34µs making 1 call to Foswiki::Sandbox::BEGIN@33 # spent 25µs making 1 call to Exporter::import
34229µs2205µs
# spent 107µs (8+99) within Foswiki::Sandbox::BEGIN@34 which was called: # once (8µs+99µs) by Foswiki::BEGIN@643 at line 34
use Error qw( :try );
# spent 107µs making 1 call to Foswiki::Sandbox::BEGIN@34 # spent 98µs making 1 call to Error::import
35
36219µs14µs
# spent 4µs within Foswiki::Sandbox::BEGIN@36 which was called: # once (4µs+0s) by Foswiki::BEGIN@643 at line 36
use File::Spec ();
# spent 4µs making 1 call to Foswiki::Sandbox::BEGIN@36
372116µs19.59ms
# spent 9.59ms (5.86+3.74) within Foswiki::Sandbox::BEGIN@37 which was called: # once (5.86ms+3.74ms) by Foswiki::BEGIN@643 at line 37
use File::Temp ();
# spent 9.59ms making 1 call to Foswiki::Sandbox::BEGIN@37
38
39241µs14µs
# spent 4µs within Foswiki::Sandbox::BEGIN@39 which was called: # once (4µs+0s) by Foswiki::BEGIN@643 at line 39
use Foswiki ();
# spent 4µs making 1 call to Foswiki::Sandbox::BEGIN@39
40
41
# spent 4µs within Foswiki::Sandbox::BEGIN@41 which was called: # once (4µs+0s) by Foswiki::BEGIN@643 at line 46
BEGIN {
4214µs if ( $Foswiki::cfg{UseLocale} ) {
43 require locale;
44 import locale();
45 }
46120µs14µs}
# spent 4µs making 1 call to Foswiki::Sandbox::BEGIN@41
47
48# Set to 1 to trace commands to STDERR, and redirect STDERR from
49# the command subprocesses to /tmp/foswiki_sandbox.log
5022.07ms265µs
# spent 36µs (7+29) within Foswiki::Sandbox::BEGIN@50 which was called: # once (7µs+29µs) by Foswiki::BEGIN@643 at line 50
use constant TRACE => 0;
# spent 36µs making 1 call to Foswiki::Sandbox::BEGIN@50 # spent 29µs making 1 call to constant::import
51
521100nsour $REAL_SAFE_PIPE_OPEN;
531100nsour $EMULATED_SAFE_PIPE_OPEN;
541100nsour $SAFE;
551100nsour $CMDQUOTE; # leave undef until _assessPipeSupport has run
56
57# TODO: Sandbox module should probably use custom 'die' handler so that
58# output goes only to web server error log - otherwise it might give
59# useful debugging information to someone developing an exploit.
60
61# Assess pipe support for =$os=, setting flags for platform features
62# that help.
63
# spent 9µs within Foswiki::Sandbox::_assessPipeSupport which was called: # once (9µs+0s) by Foswiki::Sandbox::sysCommand at line 527
sub _assessPipeSupport {
64
65 # filter the support based on what platforms are proven not to work.
66
671700ns $REAL_SAFE_PIPE_OPEN = 1;
681400ns $EMULATED_SAFE_PIPE_OPEN = 1;
69
70# Detect ActiveState and Strawberry perl. (Cygwin perl returns "cygwin" for $^O)
7111µs if ( $^O eq 'MSWin32' ) {
72 $REAL_SAFE_PIPE_OPEN = 0;
73 $EMULATED_SAFE_PIPE_OPEN = 0;
74 }
75
76 # 'Safe' means no need to filter in on this platform - check
77 # sandbox status at time of filtering
7811µs $SAFE = ( $REAL_SAFE_PIPE_OPEN || $EMULATED_SAFE_PIPE_OPEN ) ? 1 : 0;
79
80 # Shell quoting - shell used only on non-safe platforms
8117µs if (
82 $Foswiki::cfg{OS} eq 'UNIX'
83 || ( $Foswiki::cfg{OS} eq 'WINDOWS'
84 && $Foswiki::cfg{DetailedOS} eq 'cygwin' )
85 )
86 {
871700ns $CMDQUOTE = "'";
88 }
89 else {
90 $CMDQUOTE = '"';
91 }
92}
93
94=begin TML
95
96---++ StaticMethod untaintUnchecked ( $string ) -> $untainted
97
98Untaints =$string= without any checks. If $string is
99undefined, return undef.
100
101This function doesn't perform *any* checks on the data being untainted.
102Callers *must* ensure that =$string= does not contain any dangerous content,
103such as interpolation characters, if it is to be used in potentially
104unsafe operations.
105
106=cut
107
108
# spent 182ms within Foswiki::Sandbox::untaintUnchecked which was called 47084 times, avg 4µs/call: # 46040 times (178ms+0s) by Foswiki::Sandbox::_cleanUpFilePath at line 260, avg 4µs/call # 408 times (1.06ms+0s) by Foswiki::Templates::_readTemplateFile at line 489 of /var/www/foswikidev/core/lib/Foswiki/Templates.pm, avg 3µs/call # 120 times (1.48ms+0s) by Foswiki::Sandbox::_buildCommandLine at line 370, avg 12µs/call # 102 times (612µs+0s) by Foswiki::Templates::_readTemplateFile at line 435 of /var/www/foswikidev/core/lib/Foswiki/Templates.pm, avg 6µs/call # 102 times (243µs+0s) by Foswiki::Templates::_readTemplateFile at line 437 of /var/www/foswikidev/core/lib/Foswiki/Templates.pm, avg 2µs/call # 100 times (418µs+0s) by Foswiki::Plugins::DirectedGraphPlugin::commonTagsHandler at line 330 of /var/www/foswikidev/core/lib/Foswiki/Plugins/DirectedGraphPlugin.pm, avg 4µs/call # 100 times (222µs+0s) by Foswiki::Plugins::DirectedGraphPlugin::commonTagsHandler at line 331 of /var/www/foswikidev/core/lib/Foswiki/Plugins/DirectedGraphPlugin.pm, avg 2µs/call # 62 times (200µs+0s) by Foswiki::Contrib::MailerContrib::WebNotify::_load at line 435 of /var/www/foswikidev/core/lib/Foswiki/Contrib/MailerContrib/WebNotify.pm, avg 3µs/call # 18 times (70µs+0s) by Foswiki::Render::_handleSquareBracketedLink at line 1557 of /var/www/foswikidev/core/lib/Foswiki/Render.pm, avg 4µs/call # 18 times (52µs+0s) by Foswiki::Render::internalLink at line 188 of /var/www/foswikidev/core/lib/Foswiki/Render.pm, avg 3µs/call # 7 times (35µs+0s) by Foswiki::Plugin::topicWeb at line 390 of /var/www/foswikidev/core/lib/Foswiki/Plugin.pm, avg 5µs/call # 2 times (7µs+0s) by Foswiki::Plugins::preload at line 174 of /var/www/foswikidev/core/lib/Foswiki/Plugins.pm, avg 3µs/call # once (8µs+0s) by Foswiki::new at line 1995 of /var/www/foswikidev/core/lib/Foswiki.pm # once (6µs+0s) by Foswiki::Users::TopicUserMapping::getLoginName at line 215 of /var/www/foswikidev/core/lib/Foswiki/Users/TopicUserMapping.pm # once (6µs+0s) by Foswiki::Plugins::DirectedGraphPlugin::initPlugin at line 113 of /var/www/foswikidev/core/lib/Foswiki/Plugins/DirectedGraphPlugin.pm # once (4µs+0s) by Foswiki::QUERY at line 26 of /var/www/foswikidev/core/lib/Foswiki/Macros/QUERY.pm # once (3µs+0s) by Foswiki::Plugins::DirectedGraphPlugin::initPlugin at line 114 of /var/www/foswikidev/core/lib/Foswiki/Plugins/DirectedGraphPlugin.pm
sub untaintUnchecked {
1094708416.9ms my ($string) = @_;
110
11147084284ms if ( defined($string) && $string =~ m/^(.*)$/s ) {
112 return $1;
113 }
114 return $string;
115}
116
117=begin TML
118
119---++ StaticMethod untaint ( $datum, \&method, ... ) -> $untainted
120
121Calls &$method($datum, ...) and if it returns a non-undef result, returns
122that result after untainting it. Otherwise returns undef.
123
124\&method can indicate a validation problem in a couple of ways. First, it
125can throw an exception. Second, it can return undef, which then causes
126the untaint function to return undef.
127
128=cut
129
130
# spent 2.41ms (782µs+1.62) within Foswiki::Sandbox::untaint which was called 112 times, avg 21µs/call: # 40 times (429µs+695µs) by Foswiki::Store::Interfaces::QueryAlgorithm::getListOfWebs at line 496 of /var/www/foswikidev/core/lib/Foswiki/Store/Interfaces/QueryAlgorithm.pm, avg 28µs/call # 40 times (195µs+410µs) by Foswiki::Store::Interfaces::QueryAlgorithm::getListOfWebs at line 485 of /var/www/foswikidev/core/lib/Foswiki/Store/Interfaces/QueryAlgorithm.pm, avg 15µs/call # 24 times (109µs+346µs) by Foswiki::Store::Rcs::Handler::getWebNames at line 638 of /var/www/foswikidev/core/lib/Foswiki/Store/Rcs/Handler.pm, avg 19µs/call # 3 times (18µs+76µs) by Foswiki::_parsePath at line 1805 of /var/www/foswikidev/core/lib/Foswiki.pm, avg 31µs/call # 2 times (11µs+53µs) by Foswiki::_parsePath at line 1864 of /var/www/foswikidev/core/lib/Foswiki.pm, avg 32µs/call # once (11µs+23µs) by Foswiki::Store::getWorkArea at line 148 of /var/www/foswikidev/core/lib/Foswiki/Store.pm # once (6µs+10µs) by Foswiki::_parsePath at line 1883 of /var/www/foswikidev/core/lib/Foswiki.pm # once (4µs+9µs) by Foswiki::_parsePath at line 1913 of /var/www/foswikidev/core/lib/Foswiki.pm
sub untaint {
13111246µs my $datum = shift;
13211229µs my $method = shift;
133 ASSERT( ref($method) ) if DEBUG;
13411223µs return $datum unless defined $datum;
135
136 # Untaint the datum before validating it
137112274µs return undef unless $datum =~ m/^(.*)$/s;
138112428µs1121.62ms return &$method( $1, @_ );
# spent 1.50ms making 106 calls to Foswiki::Sandbox::validateWebName, avg 14µs/call # spent 96µs making 5 calls to Foswiki::Sandbox::validateTopicName, avg 19µs/call # spent 23µs making 1 call to Foswiki::Sandbox::validateAttachmentName
139}
140
141=begin TML
142
143---++ StaticMethod validateWebName($name) -> $web
144
145Check that the name is valid for use as a web name. Method used for
146validation with untaint(). Returns the name, or undef if it is invalid.
147
148=cut
149
150
# spent 1.50ms (546µs+958µs) within Foswiki::Sandbox::validateWebName which was called 106 times, avg 14µs/call: # 106 times (546µs+958µs) by Foswiki::Sandbox::untaint at line 138, avg 14µs/call
sub validateWebName {
15110694µs my $web = shift;
152106385µs106958µs return $web if Foswiki::isValidWebName( $web, 1 );
# spent 958µs making 106 calls to Foswiki::isValidWebName, avg 9µs/call
153 return;
154}
155
156=begin TML
157
158---++ StaticMethod validateTopicName($name) -> $topic
159
160Check that the name is valid for use as a topic name. Method used for
161validation with untaint(). Returns the name, or undef if it is invalid.
162
163=cut
164
165
# spent 96µs (28+68) within Foswiki::Sandbox::validateTopicName which was called 5 times, avg 19µs/call: # 5 times (28µs+68µs) by Foswiki::Sandbox::untaint at line 138, avg 19µs/call
sub validateTopicName {
16654µs my $topic = shift;
167517µs568µs return $topic if Foswiki::isValidTopicName( $topic, 1 );
# spent 68µs making 5 calls to Foswiki::isValidTopicName, avg 14µs/call
168 return;
169}
170
171=begin TML
172
173---++ StaticMethod validateAttachmentName($name) -> $attachment
174
175Check that the name is valid for use as an attachment name. Method used for
176validation with untaint(). Returns the name, or undef if it is invalid.
177
178Note that the name may contain path separators. This is to permit validation
179of an attachment that is stored in a subdirectory somewhere under the
180standard Web/Topic/attachment level e.g
181Web/Topic/attachmentdir/subdir/attachment.gif. While such attachments cannot
182be created via the UI, they *can* be created manually on the server.
183
184The individual path components are filtered by $Foswiki::cfg{NameFilter}
185
186=cut
187
188
# spent 23µs within Foswiki::Sandbox::validateAttachmentName which was called: # once (23µs+0s) by Foswiki::Sandbox::untaint at line 138
sub validateAttachmentName {
18911µs my $string = shift;
190
1911400ns return undef unless $string;
192
193 # Attachment names are always relative to web/topic, so leading /'s
194 # are simply an expression of that root.
1951700ns $string =~ s/^\/+//;
196
19712µs my @dirs = split( /\/+/, $string );
1981200ns my @result;
19912µs foreach my $component (@dirs) {
2001600ns return undef unless defined($component) && $component ne '';
2011300ns next if $component eq '.';
20211µs if ( $component eq '..' ) {
203 if ( scalar(@result) ) {
204
205 # path name is relative within its own length - we can
206 # do that
207 pop(@result);
208 }
209 else {
210
211 # Illegal relative path name
212 return undef;
213 }
214 }
215 else {
216
217 # Filter nasty characters
218111µs $component =~ s/$Foswiki::cfg{NameFilter}//g;
2191900ns push( @result, $component );
220 }
221 }
222
223 #SMELL: there is a proper way to do this.... File::Spec
22416µs return join( '/', @result );
225}
226
227# Validate, clean up and untaint filename passed to an external command
228
# spent 3.56s (2.00+1.56) within Foswiki::Sandbox::_cleanUpFilePath which was called 46040 times, avg 77µs/call: # 46040 times (2.00s+1.56s) by Foswiki::Sandbox::_buildCommandLine at line 374, avg 77µs/call
sub _cleanUpFilePath {
2294604013.8ms my $string = shift;
230460407.20ms return '' unless defined $string;
23146040110ms46040292ms my ( $volume, $dirs, $file ) = File::Spec->splitpath($string);
# spent 292ms making 46040 calls to File::Spec::Unix::splitpath, avg 6µs/call
232460406.00ms my @result;
233460409.32ms my $first = 1;
23446040167ms46040257ms foreach my $component ( File::Spec->splitdir($dirs) ) {
# spent 257ms making 46040 calls to File::Spec::Unix::splitdir, avg 6µs/call
235460400102ms next unless ( defined($component) && $component ne '' || $first );
23636832042.0ms $first = 0;
23736832040.1ms $component ||= '';
23836832055.2ms next if $component eq '.';
239368320297ms if ( $component eq '..' ) {
240 throw Error::Simple( 'relative path in filename ' . $string );
241 }
242 elsif ( $component =~ m/$Foswiki::cfg{NameFilter}/ ) {
243 throw Error::Simple( 'illegal characters in file name component "'
244 . $component
245 . '" of filename '
246 . $string );
247 }
248368320214ms push( @result, $component );
249 }
250
25146040111ms46040644ms if ( scalar(@result) ) {
# spent 644ms making 46040 calls to File::Spec::Unix::catdir, avg 14µs/call
252 $dirs = File::Spec->catdir(@result);
253 }
254 else {
255 $dirs = '';
256 }
25746040100ms46040189ms $string = File::Spec->catpath( $volume, $dirs, $file );
# spent 189ms making 46040 calls to File::Spec::Unix::catpath, avg 4µs/call
258
259 # Validated, can safely untaint
26046040211ms46040178ms return untaintUnchecked($string);
# spent 178ms making 46040 calls to Foswiki::Sandbox::untaintUnchecked, avg 4µs/call
261}
262
263=begin TML
264
265---++ StaticMethod normalizeFileName( $string ) -> $filename
266
267Throws an exception if =$string= contains filtered characters, as
268defined by =$Foswiki::cfg{NameFilter}=
269
270The returned string is not tainted, but it may contain shell
271metacharacters and even control characters.
272
273*DEPRECATED* - provided for compatibility only. Do not use!
274If you want to validate an attachment, use
275untaint($name, \&validateAttachmentName)
276
277=cut
278
279sub normalizeFileName {
280 return _cleanUpFilePath(@_);
281}
282
283=begin TML
284
285---++ StaticMethod sanitizeAttachmentName($fname) -> ($fileName, $origName)
286
287Given a file name received in a query parameter, sanitise it. Returns
288the sanitised name together with the basename before sanitisation.
289
290Sanitation includes removal of all leading path components,
291filtering illegal characters and mapping client
292file names to a subset of legal server file names.
293
294Avoid using this if you can; encoding attachment names this way is badly
295broken, much better to use point-of-source validation to ensure only valid
296attachment names are ever uploaded.
297
298=cut
299
300sub sanitizeAttachmentName {
301 my $fileName = shift; # Full pathname if browser is IE
302
303 # Homegrown split equivalent because File::Spec functions will assume that
304 # directory path is using / in UNIX and \ in Windows as defined in the HOST
305 # environment. And we don't know the client OS. Problem is specific to IE
306 # which sends the full original client path when you upload files. See
307 # Item2859 and Item2225 before trying again to use File::Spec functions and
308 # remember to test with IE.
309 # This should take care of any silly ../ shenanigans
310 $fileName =~ s{[\\/]+$}{}; # Get rid of trailing slash/backslash (unlikely)
311 $fileName =~ s!^.*[\\/]!!; # Get rid of leading directory components
312
313 my $origName = $fileName;
314
315 # Change spaces to underscore
316 $fileName =~ s/ /_/g;
317
318 # See Foswiki.pm filenameInvalidCharRegex definition and/or Item11185
319 #$fileName =~ s/$Foswiki::regex{filenameInvalidCharRegex}//g;
320 $fileName =~ s/$Foswiki::cfg{NameFilter}//g;
321
322 # Append .txt to some files
323 $fileName =~ s/$Foswiki::cfg{UploadFilter}/$1\.txt/g;
324
325 # Untaint
326 $fileName = untaintUnchecked($fileName);
327
328 return ( $fileName, $origName );
329}
330
331
# spent 3.85s (283ms+3.56) within Foswiki::Sandbox::_buildCommandLine which was called 120 times, avg 32.1ms/call: # 120 times (283ms+3.56s) by Foswiki::Sandbox::sysCommand at line 530, avg 32.1ms/call
sub _buildCommandLine {
332120380µs my ( $template, %params ) = @_;
33312041µs my @arguments;
334
33512030µs $template ||= '';
336
337120776µs for my $tmplarg ( split /\s+/, $template ) {
338840240µs next if $tmplarg eq ''; # ignore leading/trailing whitespace
339
340 # Split single argument into its parts. It may contain
341 # multiple substitutions.
342
3438402.44ms my @tmplarg = $tmplarg =~ m/([^%]+|%[^%]+%)/g;
344840115µs my @targs;
345840621µs for my $t (@tmplarg) {
3468402.02ms if ( $t =~ m/%(.*?)(?:\|([A-Z]))?%/ ) {
347
348 # implicit untaint of template OK
349240442µs my ( $p, $flag ) = ( $1, $2 );
350240177µs if ( !exists $params{$p} ) {
351 throw Error::Simple( 'unknown parameter name ' . $p );
352 }
353240209µs my $type = ref $params{$p};
35424041µs my @params;
3552406.31ms if ( $type eq '' ) {
356 @params = ( $params{$p} );
357 }
358 elsif ( $type eq 'ARRAY' ) {
359 @params = @{ $params{$p} };
360 }
361 else {
362 throw Error::Simple( $type . ' reference passed in ' . $p );
363 }
364
3652402.46ms for my $param (@params) {
366461606.93ms unless ($flag) {
367 push @targs, $param;
368 next;
369 }
3704616038.2ms1201.48ms if ( $flag eq 'U' ) {
# spent 1.48ms making 120 calls to Foswiki::Sandbox::untaintUnchecked, avg 12µs/call
371 push @targs, untaintUnchecked($param);
372 }
373 elsif ( $flag eq 'F' ) {
3744604056.1ms460403.56s $param = _cleanUpFilePath($param);
# spent 3.56s making 46040 calls to Foswiki::Sandbox::_cleanUpFilePath, avg 77µs/call
375
376 # Some command interpreters are too stupid to deal
377 # with filenames that start with a non-alphanumeric
3784604031.2ms $param = "./$param" if $param =~ m/^[^\w\/\\]/;
3794604034.3ms push @targs, $param;
380 }
381 elsif ( $flag eq 'N' ) {
382
383 # Generalized number.
384 if ( $param =~ m/^([0-9A-Fa-f.x+\-]{0,30})$/ ) {
385 push @targs, $1;
386 }
387 else {
388 throw Error::Simple(
389 "invalid number argument '$param' $t");
390 }
391 }
392 elsif ( $flag eq 'S' ) {
393
394 # "Harmless" string. Aggressively filter-in on unsafe
395 # platforms.
396 if ( $SAFE || $param =~ m/^[-0-9A-Za-z.+_]+$/ ) {
397 push @targs, untaintUnchecked($param);
398 }
399 else {
400 throw Error::Simple(
401 "invalid string argument '$param' $t");
402 }
403 }
404 elsif ( $flag eq 'D' ) {
405
406 # RCS date.
407 if (
408 $param =~ m|^(\d\d\d\d/\d\d/\d\d \d\d:\d\d:\d\d)$| )
409 {
410 push @targs, $1;
411 }
412 else {
413 throw Error::Simple(
414 "invalid date argument '$param' $t");
415 }
416 }
417 else {
418 throw Error::Simple( 'illegal flag in ' . $t );
419 }
420 }
421 }
422 else {
423600520µs push @targs, $t;
424 }
425 }
426
427 # Recombine the argument if the template argument contained
428 # multiple parts.
429
4308407.84ms if ( @tmplarg == 1 ) {
431 push @arguments, @targs;
432 }
433 else {
434 map { ASSERT( defined($_) ) } @targs if (DEBUG);
435 push @arguments, join( '', @targs );
436 }
437 }
438
4391206.46ms return @arguments;
440}
441
442# Catch and redirect error reports from programs and argument processing,
443# to avert the risk of exposing server paths to a hacker.
444sub _safeDie {
445 print STDERR $_[0];
446 die
447'Foswiki experienced a fatal error. Please check your webserver error logs for details.';
448}
449
450=begin TML
451
452---++ StaticMethod sysCommand( $class, $template, %params ) -> ( $data, $exit, $stderr )
453
454Invokes the program described by =$template=
455and =%params=, and returns the output of the program and an exit code.
456STDOUT is returned. STDERR is returned *if possible* (or is undef if not).
457$class is ignored, and is only present for compatibility.
458
459The caller has to ensure that the invoked program does not react in a
460harmful way to the passed arguments. =sysCommand= merely
461ensures that the shell does not interpret any of the passed arguments.
462
463$template is a template command-line for the program, which contains
464typed tokens that are replaced with parameter values passed in the
465=sysCommand= call. For example,
466<verbatim>
467 my ( $output, $exit ) = Foswiki::Sandbox->sysCommand(
468 $command,
469 FILENAME => $filename );
470</verbatim>
471where =$command= is a template for the command - for example,
472<verbatim>
473/usr/bin/rcs -i -t-none -kb %FILENAME|F%
474</verbatim>
475=$template= is split at whitespace, and '%VAR%' strings contained in it
476are replaced with =$params{VAR}=. =%params= values may consist of scalars and
477array references. Array references are dereferenced and the
478array elements are inserted. '%VAR%' can optionally take the form '%VAR|T%',
479where FLAG is a single character type flag. Permitted type flags are
480 * =U= untaint without further checks -- dangerous,
481 * =F= normalize as file name,
482 * =N= generalized number,
483 * =S= simple, short string,
484 * =D= RCS format date
485
486=cut
487
488# TODO: get emulated pipes or even backticks working on ActivePerl...
489
490
# spent 44.4s (40.5+3.90) within Foswiki::Sandbox::sysCommand which was called 120 times, avg 370ms/call: # 120 times (40.5s+3.90s) by Foswiki::Store::SearchAlgorithms::Forking::_search at line 144 of /var/www/foswikidev/core/lib/Foswiki/Store/SearchAlgorithms/Forking.pm, avg 370ms/call
sub sysCommand {
491 ASSERT( scalar(@_) % 2 == 0 ) if DEBUG;
492120724µs my ( $ignore, $template, %params ) = @_;
493
494 #local $SIG{__DIE__} = &_safeDie;
495
49612075µs my $data = ''; # Output
49712030µs my $handle; # Holds filehandle to read from process
49812047µs my $exit = 0; # Exit status of child process
499
50012041µs return '' unless $template;
501
502 # Implicit untaint OK; $template is safe
503120982µs $template =~ m/^(.*?)(?:\s+(.*))?$/;
504120578µs my $path = $1;
505120404µs my $pTmpl = $2;
50612033µs my $cmd;
507
508 # Writing to a cache file is the only way I can find of redirecting
509 # STDERR.
510
511 # Note: Use of the file handle $fh returned here would be safer than
512 # using the file name. But it is less portable, so filename wil have to do.
5131203.22ms24056.5ms my ( $fh, $stderrCache ) = File::Temp::tempfile(
# spent 55.7ms making 120 calls to File::Temp::tempfile, avg 464µs/call # spent 854µs making 120 calls to File::Spec::Unix::tmpdir, avg 7µs/call
514 "STDERR.$$.XXXXXXXXXX",
515 DIR => File::Spec->tmpdir(),
516 UNLINK => 0
517 );
5181201.12ms close $fh;
519
520 # Item5449: A random key known by both parent and child.
521 # Used to make it possible that the parent detects when
522 # child execution fails. Child can't throw exceptions
523 # cause they are separated processes, so it's up to
524 # the parent.
525120288µs my $key = int( rand(255) ) + 1;
526
52712068µs19µs _assessPipeSupport() unless defined $CMDQUOTE;
# spent 9µs making 1 call to Foswiki::Sandbox::_assessPipeSupport
528
529 # Build argument list from template
5301205.03ms1203.85s my @args = _buildCommandLine( $pTmpl, %params );
# spent 3.85s making 120 calls to Foswiki::Sandbox::_buildCommandLine, avg 32.1ms/call
531120148µs if ($REAL_SAFE_PIPE_OPEN) {
532
533 # Real safe pipes, open from process directly - works
534 # for most Unix/Linux Perl platforms and on Cygwin. Based on
535 # perlipc(1).
536
537 # Note that there doesn't seem to be any way to redirect
538 # STDERR when using safe pipes.
539
540120186ms my $pid = open( $handle, '-|' );
541
54212089µs throw Error::Simple( 'open of pipe failed: ' . $! ) unless defined $pid;
543
5441201.13ms if ($pid) {
545
546 # Parent - read data from process filehandle
5471202.32ms local $/ = undef; # set to read to EOF
54812040.2s $data = <$handle>;
54912020.3ms close $handle;
5501201.78ms $exit = ( $? >> 8 );
5511201.94ms if ( $exit == $key && $data =~ m/$key: (.*)/ ) {
552 throw Error::Simple("exec of $template failed: $1");
553 }
554 }
555 else {
556
557 # Child - run the command
558 untie(*STDERR);
559 open( STDERR, '>', $stderrCache )
560 || die "Can't redirect STDERR: '$!'";
561
562 unless ( exec( $path, @args ) ) {
563 syswrite( STDOUT, $key . ": $!\n" );
564 exit($key);
565 }
566
567 # can never get here
568 }
569
570 }
571 elsif ($EMULATED_SAFE_PIPE_OPEN) {
572
573 # Safe pipe emulation mostly on Windows platforms
574
575 # Create pipe
576 my $readHandle;
577 my $writeHandle;
578
579 pipe( $readHandle, $writeHandle )
580 || throw Error::Simple( 'could not create pipe: ' . $! );
581
582 my $pid = fork();
583 throw Error::Simple( 'fork() failed: ' . $! ) unless defined($pid);
584
585 if ($pid) {
586
587 # Parent - read data from process filehandle and remove newlines
588
589 close($writeHandle) or die;
590
591 local $/ = undef; # set to read to EOF
592 $data = <$readHandle>;
593 close($readHandle);
594 $pid = wait; # wait for child process so we can get exit status
595 $exit = ( $? >> 8 );
596 if ( $exit == $key && $data =~ m/$key: (.*)/ ) {
597 throw Error::Simple( 'exec failed: ' . $1 );
598 }
599
600 }
601 else {
602
603 # Child - run the command, stdout to pipe
604
605 # close the read side of the pipe and streams inherited from parent
606 close($readHandle) || die;
607
608 # Despite documentation apparently to the contrary, closing
609 # STDOUT first makes the subsequent open useless. So don't.
610 # When running tests -log, then STDOUT is tied to an object
611 # that tees the output. Unfortunately, what we need here is a plain
612 # file handle, so we need to make sure we untie it. untie is a
613 # NOP if STDOUT is not tied.
614 untie(*STDOUT);
615 untie(*STDERR);
616
617 open( STDOUT, ">&=", fileno($writeHandle) ) or die;
618
619 open( STDERR, '>', $stderrCache )
620 || die "Can't kill STDERR: $!";
621
622 unless ( exec( $path, @args ) ) {
623 syswrite( STDOUT, $key . ": $!\n" );
624 exit($key);
625 }
626
627 # can never get here
628 }
629
630 }
631 else {
632
633 # No safe pipes available, use the shell as last resort (with
634 # earlier filtering in unless administrator forced filtering out)
635
636 # This appears to be the only way to get ActiveStatePerl working
637 # Escape the cmd quote using \
638 if ( $CMDQUOTE eq '"' ) {
639
640 # DOS shell :-( Tried dozens of ways of trying to get the quotes
641 # right, but it just won't play nicely
642 $cmd = $path . ' "' . join( '" "', @args ) . '"';
643 }
644 else {
645 $cmd =
646 $path . ' '
647 . $CMDQUOTE
648 . join(
649 $CMDQUOTE . ' ' . $CMDQUOTE,
650 map { s/$CMDQUOTE/\\$CMDQUOTE/g; $_ } @args
651 ) . $CMDQUOTE;
652 }
653
654 if ( ( $Foswiki::cfg{DetailedOS} eq 'MSWin32' )
655 && ( length($cmd) > 8191 ) )
656 {
657
658 #heck, on pre WinXP its only 2048 - http://support.microsoft.com/kb/830473
659 print STDERR
660 "WARNING: Sandbox::sysCommand commandline probably too long ("
661 . length($cmd) . ")\n";
662 ASSERT( length($cmd) < 8191 ) if DEBUG;
663 }
664
665 open( my $oldStderr, '>&STDERR' ) || die "Can't steal STDERR: $!";
666
667 open( STDERR, '>', $stderrCache )
668 || die "Can't redirect STDERR: $!";
669
670 $data = `$cmd`;
671
672 # restore STDERR
673 close(STDERR);
674 open( STDERR, '>&', $oldStderr ) || die "Can't restore STDERR: $!";
675 close($oldStderr);
676
677 $exit = ( $? >> 8 );
678
679 # Do *not* return the error message; it contains sensitive path info.
680 print STDERR "\n$cmd failed: $exit\n" if ( TRACE && $exit );
681 }
682
683 if (TRACE) {
684 $cmd ||=
685 $path . ' '
686 . $CMDQUOTE
687 . join( $CMDQUOTE . ' ' . $CMDQUOTE, @args )
688 . $CMDQUOTE;
689 $data ||= '';
690 print STDERR $cmd, ' -> ', $data, "\n";
691 }
692
693120240µs my $stderr;
6941204.56ms if ( open( $handle, '<', $stderrCache ) ) {
695120866µs local $/;
6961204.17ms $stderr = <$handle>;
6971201.32ms close($handle);
698 }
6991206.83ms unlink($stderrCache);
700
70112038.7ms return ( $data, $exit, $stderr );
702}
703
70413µs1;
705__END__