Filename | /var/www/foswiki11/lib/Foswiki/Sandbox.pm |
Statements | Executed 2780677 statements in 44.1s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
164 | 3 | 2 | 42.5s | 45.4s | sysCommand | Foswiki::Sandbox::
46084 | 1 | 1 | 1.51s | 2.63s | _cleanUpFilePath | Foswiki::Sandbox::
164 | 1 | 1 | 274ms | 2.91s | _buildCommandLine | Foswiki::Sandbox::
46541 | 12 | 5 | 144ms | 144ms | untaintUnchecked | Foswiki::Sandbox::
1 | 1 | 1 | 6.30ms | 12.0ms | BEGIN@37 | Foswiki::Sandbox::
185 | 7 | 4 | 1.96ms | 4.54ms | untaint | Foswiki::Sandbox::
182 | 1 | 1 | 1.14ms | 2.30ms | validateWebName | Foswiki::Sandbox::
1 | 1 | 1 | 36µs | 36µs | validateAttachmentName | Foswiki::Sandbox::
1 | 1 | 1 | 15µs | 32µs | BEGIN@31 | Foswiki::Sandbox::
2 | 1 | 1 | 12µs | 59µs | validateTopicName | Foswiki::Sandbox::
1 | 1 | 1 | 11µs | 18µs | BEGIN@32 | Foswiki::Sandbox::
1 | 1 | 1 | 9µs | 125µs | BEGIN@34 | Foswiki::Sandbox::
1 | 1 | 1 | 8µs | 28µs | BEGIN@33 | Foswiki::Sandbox::
1 | 1 | 1 | 8µs | 8µs | _assessPipeSupport | Foswiki::Sandbox::
1 | 1 | 1 | 8µs | 39µs | BEGIN@43 | Foswiki::Sandbox::
1 | 1 | 1 | 5µs | 5µs | BEGIN@36 | Foswiki::Sandbox::
1 | 1 | 1 | 4µs | 4µs | BEGIN@39 | Foswiki::Sandbox::
0 | 0 | 0 | 0s | 0s | _safeDie | Foswiki::Sandbox::
0 | 0 | 0 | 0s | 0s | normalizeFileName | Foswiki::Sandbox::
0 | 0 | 0 | 0s | 0s | sanitizeAttachmentName | Foswiki::Sandbox::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # See bottom of file for license and copyright information | ||||
2 | |||||
3 | =begin TML | ||||
4 | |||||
5 | ---+ package Foswiki::Sandbox | ||||
6 | |||||
7 | This package provides an interface to the outside world. All calls to | ||||
8 | system functions, or handling of file names, should be brokered by | ||||
9 | the =sysCommand= function in this package. | ||||
10 | |||||
11 | *Since* _date_ indicates where functions or parameters have been added since | ||||
12 | the baseline of the API (TWiki release 4.2.3). The _date_ indicates the | ||||
13 | earliest date of a Foswiki release that will support that function or | ||||
14 | parameter. | ||||
15 | |||||
16 | *Deprecated* _date_ indicates where a function or parameters has been | ||||
17 | [[http://en.wikipedia.org/wiki/Deprecation][deprecated]]. Deprecated | ||||
18 | functions will still work, though they should | ||||
19 | _not_ be called in new plugins and should be replaced in older plugins | ||||
20 | as soon as possible. Deprecated parameters are simply ignored in Foswiki | ||||
21 | releases after _date_. | ||||
22 | |||||
23 | *Until* _date_ indicates where a function or parameter has been removed. | ||||
24 | The _date_ indicates the latest date at which Foswiki releases still supported | ||||
25 | the function or parameter. | ||||
26 | |||||
27 | =cut | ||||
28 | |||||
29 | package Foswiki::Sandbox; | ||||
30 | |||||
31 | 2 | 30µs | 2 | 48µ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 # spent 32µs making 1 call to Foswiki::Sandbox::BEGIN@31
# spent 16µs making 1 call to strict::import |
32 | 2 | 26µs | 2 | 25µ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 # spent 18µs making 1 call to Foswiki::Sandbox::BEGIN@32
# spent 7µs making 1 call to warnings::import |
33 | 2 | 29µs | 2 | 47µ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 # spent 28µs making 1 call to Foswiki::Sandbox::BEGIN@33
# spent 19µs making 1 call to Assert::import |
34 | 2 | 32µs | 2 | 241µ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 # spent 125µs making 1 call to Foswiki::Sandbox::BEGIN@34
# spent 116µs making 1 call to Error::import |
35 | |||||
36 | 2 | 20µs | 1 | 5µs | # spent 5µs within Foswiki::Sandbox::BEGIN@36 which was called:
# once (5µs+0s) by Foswiki::BEGIN@631 at line 36 # spent 5µs making 1 call to Foswiki::Sandbox::BEGIN@36 |
37 | 2 | 129µs | 1 | 12.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 # spent 12.0ms making 1 call to Foswiki::Sandbox::BEGIN@37 |
38 | |||||
39 | 2 | 25µs | 1 | 4µs | # spent 4µs within Foswiki::Sandbox::BEGIN@39 which was called:
# once (4µs+0s) by Foswiki::BEGIN@631 at line 39 # 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 | ||||
43 | 2 | 2.20ms | 2 | 70µ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 # spent 39µs making 1 call to Foswiki::Sandbox::BEGIN@43
# spent 31µs making 1 call to constant::import |
44 | |||||
45 | 1 | 100ns | our $REAL_SAFE_PIPE_OPEN; | ||
46 | 1 | 100ns | our $EMULATED_SAFE_PIPE_OPEN; | ||
47 | 1 | 100ns | our $SAFE; | ||
48 | 1 | 100ns | our $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 | ||||
57 | |||||
58 | # filter the support based on what platforms are proven not to work. | ||||
59 | |||||
60 | 1 | 400ns | $REAL_SAFE_PIPE_OPEN = 1; | ||
61 | 1 | 1µs | $EMULATED_SAFE_PIPE_OPEN = 1; | ||
62 | |||||
63 | # Detect ActiveState and Strawberry perl. (Cygwin perl returns "cygwin" for $^O) | ||||
64 | 1 | 1µ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 | ||||
71 | 1 | 1µs | $SAFE = ( $REAL_SAFE_PIPE_OPEN || $EMULATED_SAFE_PIPE_OPEN ) ? 1 : 0; | ||
72 | |||||
73 | # Shell quoting - shell used only on non-safe platforms | ||||
74 | 1 | 5µs | if ( | ||
75 | $Foswiki::cfg{OS} eq 'UNIX' | ||||
76 | || ( $Foswiki::cfg{OS} eq 'WINDOWS' | ||||
77 | && $Foswiki::cfg{DetailedOS} eq 'cygwin' ) | ||||
78 | ) | ||||
79 | { | ||||
80 | 1 | 700ns | $CMDQUOTE = "'"; | ||
81 | } | ||||
82 | else { | ||||
83 | $CMDQUOTE = '"'; | ||||
84 | } | ||||
85 | } | ||||
86 | |||||
87 | =begin TML | ||||
88 | |||||
89 | ---++ StaticMethod untaintUnchecked ( $string ) -> $untainted | ||||
90 | |||||
91 | Untaints =$string= without any checks. If $string is | ||||
92 | undefined, return undef. | ||||
93 | |||||
94 | This function doesn't perform *any* checks on the data being untainted. | ||||
95 | Callers *must* ensure that =$string= does not contain any dangerous content, | ||||
96 | such as interpolation characters, if it is to be used in potentially | ||||
97 | unsafe 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 | ||||
102 | 46541 | 16.2ms | my ($string) = @_; | ||
103 | |||||
104 | 46541 | 244ms | 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 | |||||
114 | Calls &$method($datum, ...) and if it returns a non-undef result, returns | ||||
115 | that result after untainting it. Otherwise returns undef. | ||||
116 | |||||
117 | \&method can indicate a validation problem in a couple of ways. First, it | ||||
118 | can throw an exception. Second, it can return undef, which then causes | ||||
119 | the 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 | ||||
124 | 185 | 138µs | my $datum = shift; | ||
125 | 185 | 55µs | my $method = shift; | ||
126 | 185 | 222µs | 185 | 185µs | ASSERT( ref($method) ) if DEBUG; # spent 185µs making 185 calls to Assert::ASSERTS_OFF, avg 998ns/call |
127 | 185 | 48µs | return $datum unless defined $datum; | ||
128 | |||||
129 | # Untaint the datum before validating it | ||||
130 | 185 | 413µs | return undef unless $datum =~ /^(.*)$/s; | ||
131 | 185 | 786µs | 185 | 2.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 | |||||
138 | Check that the name is valid for use as a web name. Method used for | ||||
139 | validation 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 | ||||
144 | 182 | 198µs | my $web = shift; | ||
145 | 182 | 718µs | 182 | 1.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 | |||||
153 | Check that the name is valid for use as a topic name. Method used for | ||||
154 | validation 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 | ||||
159 | 2 | 2µs | my $topic = shift; | ||
160 | 2 | 8µs | 2 | 47µ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 | |||||
168 | Check that the name is valid for use as an attachment name. Method used for | ||||
169 | validation with untaint(). Returns the name, or undef if it is invalid. | ||||
170 | |||||
171 | Note that the name may contain path separators. This is to permit validation | ||||
172 | of an attachment that is stored in a subdirectory somewhere under the | ||||
173 | standard Web/Topic/attachment level e.g | ||||
174 | Web/Topic/attachmentdir/subdir/attachment.gif. While such attachments cannot | ||||
175 | be created via the UI, they *can* be created manually on the server. | ||||
176 | |||||
177 | The 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 | ||||
182 | 1 | 2µs | my $string = shift; | ||
183 | |||||
184 | 1 | 700ns | 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. | ||||
188 | 1 | 800ns | $string =~ s/^\/+//; | ||
189 | |||||
190 | 1 | 4µs | my @dirs = split( /\/+/, $string ); | ||
191 | 1 | 400ns | my @result; | ||
192 | 1 | 3µs | foreach my $component (@dirs) { | ||
193 | 1 | 1µs | return undef unless defined($component) && $component ne ''; | ||
194 | 1 | 500ns | next if $component eq '.'; | ||
195 | 1 | 2µ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 | ||||
211 | 1 | 16µs | $component =~ s/$Foswiki::cfg{NameFilter}//g; | ||
212 | 1 | 1µs | push( @result, $component ); | ||
213 | } | ||||
214 | } | ||||
215 | |||||
216 | #SMELL: there is a proper way to do this.... File::Spec | ||||
217 | 1 | 8µ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 | ||||
222 | 46084 | 13.3ms | my $string = shift; | ||
223 | 46084 | 6.23ms | return '' unless defined $string; | ||
224 | 46084 | 98.2ms | 46084 | 244ms | my ( $volume, $dirs, $file ) = File::Spec->splitpath($string); # spent 244ms making 46084 calls to File::Spec::Unix::splitpath, avg 5µs/call |
225 | 46084 | 5.56ms | my @result; | ||
226 | 46084 | 9.66ms | my $first = 1; | ||
227 | 46084 | 152ms | 46084 | 97.4ms | foreach my $component ( File::Spec->splitdir($dirs) ) { # spent 97.4ms making 46084 calls to File::Spec::Unix::splitdir, avg 2µs/call |
228 | 414673 | 84.1ms | next unless ( defined($component) && $component ne '' || $first ); | ||
229 | 322549 | 36.2ms | $first = 0; | ||
230 | 322549 | 34.3ms | $component ||= ''; | ||
231 | 322549 | 37.6ms | next if $component eq '.'; | ||
232 | 322549 | 133ms | 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 | } | ||||
241 | 322549 | 150ms | push( @result, $component ); | ||
242 | } | ||||
243 | |||||
244 | 46084 | 101ms | 46084 | 509ms | 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 | } | ||||
250 | 46084 | 91.5ms | 46084 | 126ms | $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 | ||||
253 | 46084 | 199ms | 46084 | 141ms | 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 | |||||
260 | Throws an exception if =$string= contains filtered characters, as | ||||
261 | defined by =$Foswiki::cfg{NameFilter}= | ||||
262 | |||||
263 | The returned string is not tainted, but it may contain shell | ||||
264 | metacharacters and even control characters. | ||||
265 | |||||
266 | *DEPRECATED* - provided for compatibility only. Do not use! | ||||
267 | If you want to validate an attachment, use | ||||
268 | untaint($name, \&validateAttachmentName) | ||||
269 | |||||
270 | =cut | ||||
271 | |||||
272 | sub normalizeFileName { | ||||
273 | return _cleanUpFilePath(@_); | ||||
274 | } | ||||
275 | |||||
276 | =begin TML | ||||
277 | |||||
278 | ---++ StaticMethod sanitizeAttachmentName($fname) -> ($fileName, $origName) | ||||
279 | |||||
280 | Given a file name received in a query parameter, sanitise it. Returns | ||||
281 | the sanitised name together with the basename before sanitisation. | ||||
282 | |||||
283 | Sanitation includes removal of all leading path components, | ||||
284 | filtering illegal characters and mapping client | ||||
285 | file names to a subset of legal server file names. | ||||
286 | |||||
287 | Avoid using this if you can; encoding attachment names this way is badly | ||||
288 | broken, much better to use point-of-source validation to ensure only valid | ||||
289 | attachment names are ever uploaded. | ||||
290 | |||||
291 | =cut | ||||
292 | |||||
293 | sub 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 | ||||
325 | 164 | 464µs | my ( $template, %params ) = @_; | ||
326 | 164 | 55µs | my @arguments; | ||
327 | |||||
328 | 164 | 46µs | $template ||= ''; | ||
329 | |||||
330 | 164 | 992µs | for my $tmplarg ( split /\s+/, $template ) { | ||
331 | 808 | 257µs | next if $tmplarg eq ''; # ignore leading/trailing whitespace | ||
332 | |||||
333 | # Split single argument into its parts. It may contain | ||||
334 | # multiple substitutions. | ||||
335 | |||||
336 | 808 | 2.36ms | my @tmplarg = $tmplarg =~ /([^%]+|%[^%]+%)/g; | ||
337 | 808 | 106µs | my @targs; | ||
338 | 808 | 596µs | for my $t (@tmplarg) { | ||
339 | 830 | 2.42ms | if ( $t =~ /%(.*?)(?:\|([A-Z]))?%/ ) { | ||
340 | |||||
341 | # implicit untaint of template OK | ||||
342 | 306 | 575µs | my ( $p, $flag ) = ( $1, $2 ); | ||
343 | 306 | 233µs | if ( !exists $params{$p} ) { | ||
344 | throw Error::Simple( 'unknown parameter name ' . $p ); | ||||
345 | } | ||||
346 | 306 | 283µs | my $type = ref $params{$p}; | ||
347 | 306 | 53µs | my @params; | ||
348 | 306 | 6.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 | |||||
358 | 306 | 2.44ms | for my $param (@params) { | ||
359 | 46226 | 5.62ms | unless ($flag) { | ||
360 | push @targs, $param; | ||||
361 | next; | ||||
362 | } | ||||
363 | 46226 | 36.1ms | 120 | 1.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' ) { | ||||
367 | 46084 | 54.9ms | 46084 | 2.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 | ||||
371 | 46084 | 27.5ms | $param = "./$param" if $param =~ /^[^\w\/\\]/; | ||
372 | 46084 | 29.5ms | push @targs, $param; | ||
373 | } | ||||
374 | elsif ( $flag eq 'N' ) { | ||||
375 | |||||
376 | # Generalized number. | ||||
377 | 22 | 144µ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 { | ||||
416 | 524 | 437µs | push @targs, $t; | ||
417 | } | ||||
418 | } | ||||
419 | |||||
420 | # Recombine the argument if the template argument contained | ||||
421 | # multiple parts. | ||||
422 | |||||
423 | 808 | 7.33ms | if ( @tmplarg == 1 ) { | ||
424 | push @arguments, @targs; | ||||
425 | } | ||||
426 | else { | ||||
427 | 22 | 58µs | 22 | 48µs | map { ASSERT( defined($_) ) } @targs if (DEBUG); # spent 48µs making 22 calls to Assert::ASSERTS_OFF, avg 2µs/call |
428 | 22 | 80µs | push @arguments, join( '', @targs ); | ||
429 | } | ||||
430 | } | ||||
431 | |||||
432 | 164 | 6.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. | ||||
437 | sub _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 | |||||
447 | Invokes the program described by =$template= | ||||
448 | and =%params=, and returns the output of the program and an exit code. | ||||
449 | STDOUT is returned. STDERR is returned *if possible* (or is undef if not). | ||||
450 | $class is ignored, and is only present for compatibility. | ||||
451 | |||||
452 | The caller has to ensure that the invoked program does not react in a | ||||
453 | harmful way to the passed arguments. =sysCommand= merely | ||||
454 | ensures that the shell does not interpret any of the passed arguments. | ||||
455 | |||||
456 | $template is a template command-line for the program, which contains | ||||
457 | typed 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> | ||||
464 | where =$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 | ||||
469 | are replaced with =$params{VAR}=. =%params= values may consist of scalars and | ||||
470 | array references. Array references are dereferenced and the | ||||
471 | array elements are inserted. '%VAR%' can optionally take the form '%VAR|T%', | ||||
472 | where 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 | ||||
484 | 164 | 379µs | 164 | 322µs | ASSERT( scalar(@_) % 2 == 0 ) if DEBUG; # spent 322µs making 164 calls to Assert::ASSERTS_OFF, avg 2µs/call |
485 | 164 | 888µs | my ( $ignore, $template, %params ) = @_; | ||
486 | |||||
487 | #local $SIG{__DIE__} = &_safeDie; | ||||
488 | |||||
489 | 164 | 94µs | my $data = ''; # Output | ||
490 | 164 | 42µs | my $handle; # Holds filehandle to read from process | ||
491 | 164 | 71µs | my $exit = 0; # Exit status of child process | ||
492 | |||||
493 | 164 | 45µs | return '' unless $template; | ||
494 | |||||
495 | # Implicit untaint OK; $template is safe | ||||
496 | 164 | 1.61ms | $template =~ /^(.*?)(?:\s+(.*))?$/; | ||
497 | 164 | 751µs | my $path = $1; | ||
498 | 164 | 498µs | my $pTmpl = $2; | ||
499 | 164 | 53µ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. | ||||
506 | 164 | 2.50ms | 164 | 68.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 | ); | ||||
511 | 164 | 1.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. | ||||
518 | 164 | 351µs | my $key = int( rand(255) ) + 1; | ||
519 | |||||
520 | 164 | 134µs | 1 | 8µs | _assessPipeSupport() unless defined $CMDQUOTE; # spent 8µs making 1 call to Foswiki::Sandbox::_assessPipeSupport |
521 | |||||
522 | # Build argument list from template | ||||
523 | 164 | 5.40ms | 164 | 2.91s | my @args = _buildCommandLine( $pTmpl, %params ); # spent 2.91s making 164 calls to Foswiki::Sandbox::_buildCommandLine, avg 17.7ms/call |
524 | 164 | 228µ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 | |||||
533 | 164 | 205ms | my $pid = open( $handle, '-|' ); | ||
534 | |||||
535 | 164 | 109µs | throw Error::Simple( 'open of pipe failed: ' . $! ) unless defined $pid; | ||
536 | |||||
537 | 164 | 1.47ms | if ($pid) { | ||
538 | |||||
539 | # Parent - read data from process filehandle | ||||
540 | 164 | 3.05ms | local $/ = undef; # set to read to EOF | ||
541 | 164 | 42.1s | $data = <$handle>; | ||
542 | 164 | 19.6ms | close $handle; | ||
543 | 164 | 1.86ms | $exit = ( $? >> 8 ); | ||
544 | 164 | 2.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 | |||||
686 | 164 | 320µs | my $stderr; | ||
687 | 164 | 6.39ms | if ( open( $handle, '<', $stderrCache ) ) { | ||
688 | 164 | 808µs | local $/; | ||
689 | 164 | 4.90ms | $stderr = <$handle>; | ||
690 | 164 | 1.62ms | close($handle); | ||
691 | } | ||||
692 | 164 | 13.5ms | unlink($stderrCache); | ||
693 | |||||
694 | 164 | 38.5ms | return ( $data, $exit, $stderr ); | ||
695 | } | ||||
696 | |||||
697 | 1 | 3µs | 1; | ||
698 | __END__ |