Filename | /var/www/foswikidev/core/lib/Foswiki/Sandbox.pm |
Statements | Executed 3053070 statements in 42.5s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
120 | 1 | 1 | 40.5s | 44.4s | sysCommand | Foswiki::Sandbox::
46040 | 1 | 1 | 2.00s | 3.56s | _cleanUpFilePath | Foswiki::Sandbox::
120 | 1 | 1 | 283ms | 3.85s | _buildCommandLine | Foswiki::Sandbox::
47084 | 17 | 10 | 182ms | 182ms | untaintUnchecked | Foswiki::Sandbox::
1 | 1 | 1 | 5.86ms | 9.59ms | BEGIN@37 | Foswiki::Sandbox::
112 | 8 | 4 | 782µs | 2.41ms | untaint | Foswiki::Sandbox::
106 | 1 | 1 | 546µs | 1.50ms | validateWebName | Foswiki::Sandbox::
5 | 1 | 1 | 28µs | 96µs | validateTopicName | Foswiki::Sandbox::
1 | 1 | 1 | 23µs | 23µs | validateAttachmentName | Foswiki::Sandbox::
1 | 1 | 1 | 14µs | 28µs | BEGIN@31 | Foswiki::Sandbox::
1 | 1 | 1 | 9µs | 34µs | BEGIN@33 | Foswiki::Sandbox::
1 | 1 | 1 | 9µs | 9µs | _assessPipeSupport | Foswiki::Sandbox::
1 | 1 | 1 | 9µs | 13µs | BEGIN@32 | Foswiki::Sandbox::
1 | 1 | 1 | 8µs | 107µs | BEGIN@34 | Foswiki::Sandbox::
1 | 1 | 1 | 7µs | 36µs | BEGIN@50 | Foswiki::Sandbox::
1 | 1 | 1 | 4µs | 4µs | BEGIN@36 | Foswiki::Sandbox::
1 | 1 | 1 | 4µs | 4µs | BEGIN@39 | Foswiki::Sandbox::
1 | 1 | 1 | 4µs | 4µs | BEGIN@41 | Foswiki::Sandbox::
0 | 0 | 0 | 0s | 0s | _safeDie | Foswiki::Sandbox::
0 | 0 | 0 | 0s | 0s | normalizeFileName | Foswiki::Sandbox::
0 | 0 | 0 | 0s | 0s | sanitizeAttachmentName | Foswiki::Sandbox::
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 | 28µs | 2 | 43µ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 # spent 28µs making 1 call to Foswiki::Sandbox::BEGIN@31
# spent 14µs making 1 call to strict::import |
32 | 2 | 23µs | 2 | 18µ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 # spent 13µs making 1 call to Foswiki::Sandbox::BEGIN@32
# spent 4µs making 1 call to warnings::import |
33 | 2 | 28µs | 2 | 59µ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 # spent 34µs making 1 call to Foswiki::Sandbox::BEGIN@33
# spent 25µs making 1 call to Exporter::import |
34 | 2 | 29µs | 2 | 205µ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 # spent 107µs making 1 call to Foswiki::Sandbox::BEGIN@34
# spent 98µs making 1 call to Error::import |
35 | |||||
36 | 2 | 19µs | 1 | 4µs | # spent 4µs within Foswiki::Sandbox::BEGIN@36 which was called:
# once (4µs+0s) by Foswiki::BEGIN@643 at line 36 # spent 4µs making 1 call to Foswiki::Sandbox::BEGIN@36 |
37 | 2 | 116µs | 1 | 9.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 # spent 9.59ms making 1 call to Foswiki::Sandbox::BEGIN@37 |
38 | |||||
39 | 2 | 41µs | 1 | 4µs | # spent 4µs within Foswiki::Sandbox::BEGIN@39 which was called:
# once (4µs+0s) by Foswiki::BEGIN@643 at line 39 # 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 | ||||
42 | 1 | 4µs | if ( $Foswiki::cfg{UseLocale} ) { | ||
43 | require locale; | ||||
44 | import locale(); | ||||
45 | } | ||||
46 | 1 | 20µs | 1 | 4µ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 | ||||
50 | 2 | 2.07ms | 2 | 65µ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 # spent 36µs making 1 call to Foswiki::Sandbox::BEGIN@50
# spent 29µs making 1 call to constant::import |
51 | |||||
52 | 1 | 100ns | our $REAL_SAFE_PIPE_OPEN; | ||
53 | 1 | 100ns | our $EMULATED_SAFE_PIPE_OPEN; | ||
54 | 1 | 100ns | our $SAFE; | ||
55 | 1 | 100ns | our $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 | ||||
64 | |||||
65 | # filter the support based on what platforms are proven not to work. | ||||
66 | |||||
67 | 1 | 700ns | $REAL_SAFE_PIPE_OPEN = 1; | ||
68 | 1 | 400ns | $EMULATED_SAFE_PIPE_OPEN = 1; | ||
69 | |||||
70 | # Detect ActiveState and Strawberry perl. (Cygwin perl returns "cygwin" for $^O) | ||||
71 | 1 | 1µ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 | ||||
78 | 1 | 1µs | $SAFE = ( $REAL_SAFE_PIPE_OPEN || $EMULATED_SAFE_PIPE_OPEN ) ? 1 : 0; | ||
79 | |||||
80 | # Shell quoting - shell used only on non-safe platforms | ||||
81 | 1 | 7µs | if ( | ||
82 | $Foswiki::cfg{OS} eq 'UNIX' | ||||
83 | || ( $Foswiki::cfg{OS} eq 'WINDOWS' | ||||
84 | && $Foswiki::cfg{DetailedOS} eq 'cygwin' ) | ||||
85 | ) | ||||
86 | { | ||||
87 | 1 | 700ns | $CMDQUOTE = "'"; | ||
88 | } | ||||
89 | else { | ||||
90 | $CMDQUOTE = '"'; | ||||
91 | } | ||||
92 | } | ||||
93 | |||||
94 | =begin TML | ||||
95 | |||||
96 | ---++ StaticMethod untaintUnchecked ( $string ) -> $untainted | ||||
97 | |||||
98 | Untaints =$string= without any checks. If $string is | ||||
99 | undefined, return undef. | ||||
100 | |||||
101 | This function doesn't perform *any* checks on the data being untainted. | ||||
102 | Callers *must* ensure that =$string= does not contain any dangerous content, | ||||
103 | such as interpolation characters, if it is to be used in potentially | ||||
104 | unsafe 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 | ||||
109 | 47084 | 16.9ms | my ($string) = @_; | ||
110 | |||||
111 | 47084 | 284ms | 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 | |||||
121 | Calls &$method($datum, ...) and if it returns a non-undef result, returns | ||||
122 | that result after untainting it. Otherwise returns undef. | ||||
123 | |||||
124 | \&method can indicate a validation problem in a couple of ways. First, it | ||||
125 | can throw an exception. Second, it can return undef, which then causes | ||||
126 | the 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 | ||||
131 | 112 | 46µs | my $datum = shift; | ||
132 | 112 | 29µs | my $method = shift; | ||
133 | ASSERT( ref($method) ) if DEBUG; | ||||
134 | 112 | 23µs | return $datum unless defined $datum; | ||
135 | |||||
136 | # Untaint the datum before validating it | ||||
137 | 112 | 274µs | return undef unless $datum =~ m/^(.*)$/s; | ||
138 | 112 | 428µs | 112 | 1.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 | |||||
145 | Check that the name is valid for use as a web name. Method used for | ||||
146 | validation 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 | ||||
151 | 106 | 94µs | my $web = shift; | ||
152 | 106 | 385µs | 106 | 958µ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 | |||||
160 | Check that the name is valid for use as a topic name. Method used for | ||||
161 | validation 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 | ||||
166 | 5 | 4µs | my $topic = shift; | ||
167 | 5 | 17µs | 5 | 68µ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 | |||||
175 | Check that the name is valid for use as an attachment name. Method used for | ||||
176 | validation with untaint(). Returns the name, or undef if it is invalid. | ||||
177 | |||||
178 | Note that the name may contain path separators. This is to permit validation | ||||
179 | of an attachment that is stored in a subdirectory somewhere under the | ||||
180 | standard Web/Topic/attachment level e.g | ||||
181 | Web/Topic/attachmentdir/subdir/attachment.gif. While such attachments cannot | ||||
182 | be created via the UI, they *can* be created manually on the server. | ||||
183 | |||||
184 | The 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 | ||||
189 | 1 | 1µs | my $string = shift; | ||
190 | |||||
191 | 1 | 400ns | 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. | ||||
195 | 1 | 700ns | $string =~ s/^\/+//; | ||
196 | |||||
197 | 1 | 2µs | my @dirs = split( /\/+/, $string ); | ||
198 | 1 | 200ns | my @result; | ||
199 | 1 | 2µs | foreach my $component (@dirs) { | ||
200 | 1 | 600ns | return undef unless defined($component) && $component ne ''; | ||
201 | 1 | 300ns | next if $component eq '.'; | ||
202 | 1 | 1µ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 | ||||
218 | 1 | 11µs | $component =~ s/$Foswiki::cfg{NameFilter}//g; | ||
219 | 1 | 900ns | push( @result, $component ); | ||
220 | } | ||||
221 | } | ||||
222 | |||||
223 | #SMELL: there is a proper way to do this.... File::Spec | ||||
224 | 1 | 6µ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 | ||||
229 | 46040 | 13.8ms | my $string = shift; | ||
230 | 46040 | 7.20ms | return '' unless defined $string; | ||
231 | 46040 | 110ms | 46040 | 292ms | my ( $volume, $dirs, $file ) = File::Spec->splitpath($string); # spent 292ms making 46040 calls to File::Spec::Unix::splitpath, avg 6µs/call |
232 | 46040 | 6.00ms | my @result; | ||
233 | 46040 | 9.32ms | my $first = 1; | ||
234 | 46040 | 167ms | 46040 | 257ms | foreach my $component ( File::Spec->splitdir($dirs) ) { # spent 257ms making 46040 calls to File::Spec::Unix::splitdir, avg 6µs/call |
235 | 460400 | 102ms | next unless ( defined($component) && $component ne '' || $first ); | ||
236 | 368320 | 42.0ms | $first = 0; | ||
237 | 368320 | 40.1ms | $component ||= ''; | ||
238 | 368320 | 55.2ms | next if $component eq '.'; | ||
239 | 368320 | 297ms | 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 | } | ||||
248 | 368320 | 214ms | push( @result, $component ); | ||
249 | } | ||||
250 | |||||
251 | 46040 | 111ms | 46040 | 644ms | 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 | } | ||||
257 | 46040 | 100ms | 46040 | 189ms | $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 | ||||
260 | 46040 | 211ms | 46040 | 178ms | 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 | |||||
267 | Throws an exception if =$string= contains filtered characters, as | ||||
268 | defined by =$Foswiki::cfg{NameFilter}= | ||||
269 | |||||
270 | The returned string is not tainted, but it may contain shell | ||||
271 | metacharacters and even control characters. | ||||
272 | |||||
273 | *DEPRECATED* - provided for compatibility only. Do not use! | ||||
274 | If you want to validate an attachment, use | ||||
275 | untaint($name, \&validateAttachmentName) | ||||
276 | |||||
277 | =cut | ||||
278 | |||||
279 | sub normalizeFileName { | ||||
280 | return _cleanUpFilePath(@_); | ||||
281 | } | ||||
282 | |||||
283 | =begin TML | ||||
284 | |||||
285 | ---++ StaticMethod sanitizeAttachmentName($fname) -> ($fileName, $origName) | ||||
286 | |||||
287 | Given a file name received in a query parameter, sanitise it. Returns | ||||
288 | the sanitised name together with the basename before sanitisation. | ||||
289 | |||||
290 | Sanitation includes removal of all leading path components, | ||||
291 | filtering illegal characters and mapping client | ||||
292 | file names to a subset of legal server file names. | ||||
293 | |||||
294 | Avoid using this if you can; encoding attachment names this way is badly | ||||
295 | broken, much better to use point-of-source validation to ensure only valid | ||||
296 | attachment names are ever uploaded. | ||||
297 | |||||
298 | =cut | ||||
299 | |||||
300 | sub 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 | ||||
332 | 120 | 380µs | my ( $template, %params ) = @_; | ||
333 | 120 | 41µs | my @arguments; | ||
334 | |||||
335 | 120 | 30µs | $template ||= ''; | ||
336 | |||||
337 | 120 | 776µs | for my $tmplarg ( split /\s+/, $template ) { | ||
338 | 840 | 240µs | next if $tmplarg eq ''; # ignore leading/trailing whitespace | ||
339 | |||||
340 | # Split single argument into its parts. It may contain | ||||
341 | # multiple substitutions. | ||||
342 | |||||
343 | 840 | 2.44ms | my @tmplarg = $tmplarg =~ m/([^%]+|%[^%]+%)/g; | ||
344 | 840 | 115µs | my @targs; | ||
345 | 840 | 621µs | for my $t (@tmplarg) { | ||
346 | 840 | 2.02ms | if ( $t =~ m/%(.*?)(?:\|([A-Z]))?%/ ) { | ||
347 | |||||
348 | # implicit untaint of template OK | ||||
349 | 240 | 442µs | my ( $p, $flag ) = ( $1, $2 ); | ||
350 | 240 | 177µs | if ( !exists $params{$p} ) { | ||
351 | throw Error::Simple( 'unknown parameter name ' . $p ); | ||||
352 | } | ||||
353 | 240 | 209µs | my $type = ref $params{$p}; | ||
354 | 240 | 41µs | my @params; | ||
355 | 240 | 6.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 | |||||
365 | 240 | 2.46ms | for my $param (@params) { | ||
366 | 46160 | 6.93ms | unless ($flag) { | ||
367 | push @targs, $param; | ||||
368 | next; | ||||
369 | } | ||||
370 | 46160 | 38.2ms | 120 | 1.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' ) { | ||||
374 | 46040 | 56.1ms | 46040 | 3.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 | ||||
378 | 46040 | 31.2ms | $param = "./$param" if $param =~ m/^[^\w\/\\]/; | ||
379 | 46040 | 34.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 { | ||||
423 | 600 | 520µs | push @targs, $t; | ||
424 | } | ||||
425 | } | ||||
426 | |||||
427 | # Recombine the argument if the template argument contained | ||||
428 | # multiple parts. | ||||
429 | |||||
430 | 840 | 7.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 | |||||
439 | 120 | 6.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. | ||||
444 | sub _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 | |||||
454 | Invokes the program described by =$template= | ||||
455 | and =%params=, and returns the output of the program and an exit code. | ||||
456 | STDOUT is returned. STDERR is returned *if possible* (or is undef if not). | ||||
457 | $class is ignored, and is only present for compatibility. | ||||
458 | |||||
459 | The caller has to ensure that the invoked program does not react in a | ||||
460 | harmful way to the passed arguments. =sysCommand= merely | ||||
461 | ensures that the shell does not interpret any of the passed arguments. | ||||
462 | |||||
463 | $template is a template command-line for the program, which contains | ||||
464 | typed 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> | ||||
471 | where =$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 | ||||
476 | are replaced with =$params{VAR}=. =%params= values may consist of scalars and | ||||
477 | array references. Array references are dereferenced and the | ||||
478 | array elements are inserted. '%VAR%' can optionally take the form '%VAR|T%', | ||||
479 | where 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 | ||||
491 | ASSERT( scalar(@_) % 2 == 0 ) if DEBUG; | ||||
492 | 120 | 724µs | my ( $ignore, $template, %params ) = @_; | ||
493 | |||||
494 | #local $SIG{__DIE__} = &_safeDie; | ||||
495 | |||||
496 | 120 | 75µs | my $data = ''; # Output | ||
497 | 120 | 30µs | my $handle; # Holds filehandle to read from process | ||
498 | 120 | 47µs | my $exit = 0; # Exit status of child process | ||
499 | |||||
500 | 120 | 41µs | return '' unless $template; | ||
501 | |||||
502 | # Implicit untaint OK; $template is safe | ||||
503 | 120 | 982µs | $template =~ m/^(.*?)(?:\s+(.*))?$/; | ||
504 | 120 | 578µs | my $path = $1; | ||
505 | 120 | 404µs | my $pTmpl = $2; | ||
506 | 120 | 33µ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. | ||||
513 | 120 | 3.22ms | 240 | 56.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 | ); | ||||
518 | 120 | 1.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. | ||||
525 | 120 | 288µs | my $key = int( rand(255) ) + 1; | ||
526 | |||||
527 | 120 | 68µs | 1 | 9µs | _assessPipeSupport() unless defined $CMDQUOTE; # spent 9µs making 1 call to Foswiki::Sandbox::_assessPipeSupport |
528 | |||||
529 | # Build argument list from template | ||||
530 | 120 | 5.03ms | 120 | 3.85s | my @args = _buildCommandLine( $pTmpl, %params ); # spent 3.85s making 120 calls to Foswiki::Sandbox::_buildCommandLine, avg 32.1ms/call |
531 | 120 | 148µ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 | |||||
540 | 120 | 186ms | my $pid = open( $handle, '-|' ); | ||
541 | |||||
542 | 120 | 89µs | throw Error::Simple( 'open of pipe failed: ' . $! ) unless defined $pid; | ||
543 | |||||
544 | 120 | 1.13ms | if ($pid) { | ||
545 | |||||
546 | # Parent - read data from process filehandle | ||||
547 | 120 | 2.32ms | local $/ = undef; # set to read to EOF | ||
548 | 120 | 40.2s | $data = <$handle>; | ||
549 | 120 | 20.3ms | close $handle; | ||
550 | 120 | 1.78ms | $exit = ( $? >> 8 ); | ||
551 | 120 | 1.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 | |||||
693 | 120 | 240µs | my $stderr; | ||
694 | 120 | 4.56ms | if ( open( $handle, '<', $stderrCache ) ) { | ||
695 | 120 | 866µs | local $/; | ||
696 | 120 | 4.17ms | $stderr = <$handle>; | ||
697 | 120 | 1.32ms | close($handle); | ||
698 | } | ||||
699 | 120 | 6.83ms | unlink($stderrCache); | ||
700 | |||||
701 | 120 | 38.7ms | return ( $data, $exit, $stderr ); | ||
702 | } | ||||
703 | |||||
704 | 1 | 3µs | 1; | ||
705 | __END__ |