| 1 | package Safe; |
| 2 | |
| 3 | use 5.003_11; |
| 4 | use strict; |
| 5 | |
| 6 | $Safe::VERSION = "2.12"; |
| 7 | |
| 8 | # *** Don't declare any lexicals above this point *** |
| 9 | # |
| 10 | # This function should return a closure which contains an eval that can't |
| 11 | # see any lexicals in scope (apart from __ExPr__ which is unavoidable) |
| 12 | |
| 13 | sub lexless_anon_sub { |
| 14 | # $_[0] is package; |
| 15 | # $_[1] is strict flag; |
| 16 | my $__ExPr__ = $_[2]; # must be a lexical to create the closure that |
| 17 | # can be used to pass the value into the safe |
| 18 | # world |
| 19 | |
| 20 | # Create anon sub ref in root of compartment. |
| 21 | # Uses a closure (on $__ExPr__) to pass in the code to be executed. |
| 22 | # (eval on one line to keep line numbers as expected by caller) |
| 23 | eval sprintf |
| 24 | 'package %s; %s strict; sub { @_=(); eval q[my $__ExPr__;] . $__ExPr__; }', |
| 25 | $_[0], $_[1] ? 'use' : 'no'; |
| 26 | } |
| 27 | |
| 28 | use Carp; |
| 29 | use Carp::Heavy; |
| 30 | |
| 31 | use Opcode 1.01, qw( |
| 32 | opset opset_to_ops opmask_add |
| 33 | empty_opset full_opset invert_opset verify_opset |
| 34 | opdesc opcodes opmask define_optag opset_to_hex |
| 35 | ); |
| 36 | |
| 37 | *ops_to_opset = \&opset; # Temporary alias for old Penguins |
| 38 | |
| 39 | |
| 40 | my $default_root = 0; |
| 41 | my $default_share = ['*_']; #, '*main::']; |
| 42 | |
| 43 | sub new { |
| 44 | my($class, $root, $mask) = @_; |
| 45 | my $obj = {}; |
| 46 | bless $obj, $class; |
| 47 | |
| 48 | if (defined($root)) { |
| 49 | croak "Can't use \"$root\" as root name" |
| 50 | if $root =~ /^main\b/ or $root !~ /^\w[:\w]*$/; |
| 51 | $obj->{Root} = $root; |
| 52 | $obj->{Erase} = 0; |
| 53 | } |
| 54 | else { |
| 55 | $obj->{Root} = "Safe::Root".$default_root++; |
| 56 | $obj->{Erase} = 1; |
| 57 | } |
| 58 | |
| 59 | # use permit/deny methods instead till interface issues resolved |
| 60 | # XXX perhaps new Safe 'Root', mask => $mask, foo => bar, ...; |
| 61 | croak "Mask parameter to new no longer supported" if defined $mask; |
| 62 | $obj->permit_only(':default'); |
| 63 | |
| 64 | # We must share $_ and @_ with the compartment or else ops such |
| 65 | # as split, length and so on won't default to $_ properly, nor |
| 66 | # will passing argument to subroutines work (via @_). In fact, |
| 67 | # for reasons I don't completely understand, we need to share |
| 68 | # the whole glob *_ rather than $_ and @_ separately, otherwise |
| 69 | # @_ in non default packages within the compartment don't work. |
| 70 | $obj->share_from('main', $default_share); |
| 71 | Opcode::_safe_pkg_prep($obj->{Root}) if($Opcode::VERSION > 1.04); |
| 72 | return $obj; |
| 73 | } |
| 74 | |
| 75 | sub DESTROY { |
| 76 | my $obj = shift; |
| 77 | $obj->erase('DESTROY') if $obj->{Erase}; |
| 78 | } |
| 79 | |
| 80 | sub erase { |
| 81 | my ($obj, $action) = @_; |
| 82 | my $pkg = $obj->root(); |
| 83 | my ($stem, $leaf); |
| 84 | |
| 85 | no strict 'refs'; |
| 86 | $pkg = "main::$pkg\::"; # expand to full symbol table name |
| 87 | ($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/; |
| 88 | |
| 89 | # The 'my $foo' is needed! Without it you get an |
| 90 | # 'Attempt to free unreferenced scalar' warning! |
| 91 | my $stem_symtab = *{$stem}{HASH}; |
| 92 | |
| 93 | #warn "erase($pkg) stem=$stem, leaf=$leaf"; |
| 94 | #warn " stem_symtab hash ".scalar(%$stem_symtab)."\n"; |
| 95 | # ", join(', ', %$stem_symtab),"\n"; |
| 96 | |
| 97 | # delete $stem_symtab->{$leaf}; |
| 98 | |
| 99 | my $leaf_glob = $stem_symtab->{$leaf}; |
| 100 | my $leaf_symtab = *{$leaf_glob}{HASH}; |
| 101 | # warn " leaf_symtab ", join(', ', %$leaf_symtab),"\n"; |
| 102 | %$leaf_symtab = (); |
| 103 | #delete $leaf_symtab->{'__ANON__'}; |
| 104 | #delete $leaf_symtab->{'foo'}; |
| 105 | #delete $leaf_symtab->{'main::'}; |
| 106 | # my $foo = undef ${"$stem\::"}{"$leaf\::"}; |
| 107 | |
| 108 | if ($action and $action eq 'DESTROY') { |
| 109 | delete $stem_symtab->{$leaf}; |
| 110 | } else { |
| 111 | $obj->share_from('main', $default_share); |
| 112 | } |
| 113 | 1; |
| 114 | } |
| 115 | |
| 116 | |
| 117 | sub reinit { |
| 118 | my $obj= shift; |
| 119 | $obj->erase; |
| 120 | $obj->share_redo; |
| 121 | } |
| 122 | |
| 123 | sub root { |
| 124 | my $obj = shift; |
| 125 | croak("Safe root method now read-only") if @_; |
| 126 | return $obj->{Root}; |
| 127 | } |
| 128 | |
| 129 | |
| 130 | sub mask { |
| 131 | my $obj = shift; |
| 132 | return $obj->{Mask} unless @_; |
| 133 | $obj->deny_only(@_); |
| 134 | } |
| 135 | |
| 136 | # v1 compatibility methods |
| 137 | sub trap { shift->deny(@_) } |
| 138 | sub untrap { shift->permit(@_) } |
| 139 | |
| 140 | sub deny { |
| 141 | my $obj = shift; |
| 142 | $obj->{Mask} |= opset(@_); |
| 143 | } |
| 144 | sub deny_only { |
| 145 | my $obj = shift; |
| 146 | $obj->{Mask} = opset(@_); |
| 147 | } |
| 148 | |
| 149 | sub permit { |
| 150 | my $obj = shift; |
| 151 | # XXX needs testing |
| 152 | $obj->{Mask} &= invert_opset opset(@_); |
| 153 | } |
| 154 | sub permit_only { |
| 155 | my $obj = shift; |
| 156 | $obj->{Mask} = invert_opset opset(@_); |
| 157 | } |
| 158 | |
| 159 | |
| 160 | sub dump_mask { |
| 161 | my $obj = shift; |
| 162 | print opset_to_hex($obj->{Mask}),"\n"; |
| 163 | } |
| 164 | |
| 165 | |
| 166 | |
| 167 | sub share { |
| 168 | my($obj, @vars) = @_; |
| 169 | $obj->share_from(scalar(caller), \@vars); |
| 170 | } |
| 171 | |
| 172 | sub share_from { |
| 173 | my $obj = shift; |
| 174 | my $pkg = shift; |
| 175 | my $vars = shift; |
| 176 | my $no_record = shift || 0; |
| 177 | my $root = $obj->root(); |
| 178 | croak("vars not an array ref") unless ref $vars eq 'ARRAY'; |
| 179 | no strict 'refs'; |
| 180 | # Check that 'from' package actually exists |
| 181 | croak("Package \"$pkg\" does not exist") |
| 182 | unless keys %{"$pkg\::"}; |
| 183 | my $arg; |
| 184 | foreach $arg (@$vars) { |
| 185 | # catch some $safe->share($var) errors: |
| 186 | croak("'$arg' not a valid symbol table name") |
| 187 | unless $arg =~ /^[\$\@%*&]?\w[\w:]*$/ |
| 188 | or $arg =~ /^\$\W$/; |
| 189 | my ($var, $type); |
| 190 | $type = $1 if ($var = $arg) =~ s/^(\W)//; |
| 191 | # warn "share_from $pkg $type $var"; |
| 192 | *{$root."::$var"} = (!$type) ? \&{$pkg."::$var"} |
| 193 | : ($type eq '&') ? \&{$pkg."::$var"} |
| 194 | : ($type eq '$') ? \${$pkg."::$var"} |
| 195 | : ($type eq '@') ? \@{$pkg."::$var"} |
| 196 | : ($type eq '%') ? \%{$pkg."::$var"} |
| 197 | : ($type eq '*') ? *{$pkg."::$var"} |
| 198 | : croak(qq(Can't share "$type$var" of unknown type)); |
| 199 | } |
| 200 | $obj->share_record($pkg, $vars) unless $no_record or !$vars; |
| 201 | } |
| 202 | |
| 203 | sub share_record { |
| 204 | my $obj = shift; |
| 205 | my $pkg = shift; |
| 206 | my $vars = shift; |
| 207 | my $shares = \%{$obj->{Shares} ||= {}}; |
| 208 | # Record shares using keys of $obj->{Shares}. See reinit. |
| 209 | @{$shares}{@$vars} = ($pkg) x @$vars if @$vars; |
| 210 | } |
| 211 | sub share_redo { |
| 212 | my $obj = shift; |
| 213 | my $shares = \%{$obj->{Shares} ||= {}}; |
| 214 | my($var, $pkg); |
| 215 | while(($var, $pkg) = each %$shares) { |
| 216 | # warn "share_redo $pkg\:: $var"; |
| 217 | $obj->share_from($pkg, [ $var ], 1); |
| 218 | } |
| 219 | } |
| 220 | sub share_forget { |
| 221 | delete shift->{Shares}; |
| 222 | } |
| 223 | |
| 224 | sub varglob { |
| 225 | my ($obj, $var) = @_; |
| 226 | no strict 'refs'; |
| 227 | return *{$obj->root()."::$var"}; |
| 228 | } |
| 229 | |
| 230 | |
| 231 | sub reval { |
| 232 | my ($obj, $expr, $strict) = @_; |
| 233 | my $root = $obj->{Root}; |
| 234 | |
| 235 | my $evalsub = lexless_anon_sub($root,$strict, $expr); |
| 236 | return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub); |
| 237 | } |
| 238 | |
| 239 | sub rdo { |
| 240 | my ($obj, $file) = @_; |
| 241 | my $root = $obj->{Root}; |
| 242 | |
| 243 | my $evalsub = eval |
| 244 | sprintf('package %s; sub { @_ = (); do $file }', $root); |
| 245 | return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub); |
| 246 | } |
| 247 | |
| 248 | |
| 249 | 1; |
| 250 | |
| 251 | __END__ |
| 252 | |
| 253 | =head1 NAME |
| 254 | |
| 255 | Safe - Compile and execute code in restricted compartments |
| 256 | |
| 257 | =head1 SYNOPSIS |
| 258 | |
| 259 | use Safe; |
| 260 | |
| 261 | $compartment = new Safe; |
| 262 | |
| 263 | $compartment->permit(qw(time sort :browse)); |
| 264 | |
| 265 | $result = $compartment->reval($unsafe_code); |
| 266 | |
| 267 | =head1 DESCRIPTION |
| 268 | |
| 269 | The Safe extension module allows the creation of compartments |
| 270 | in which perl code can be evaluated. Each compartment has |
| 271 | |
| 272 | =over 8 |
| 273 | |
| 274 | =item a new namespace |
| 275 | |
| 276 | The "root" of the namespace (i.e. "main::") is changed to a |
| 277 | different package and code evaluated in the compartment cannot |
| 278 | refer to variables outside this namespace, even with run-time |
| 279 | glob lookups and other tricks. |
| 280 | |
| 281 | Code which is compiled outside the compartment can choose to place |
| 282 | variables into (or I<share> variables with) the compartment's namespace |
| 283 | and only that data will be visible to code evaluated in the |
| 284 | compartment. |
| 285 | |
| 286 | By default, the only variables shared with compartments are the |
| 287 | "underscore" variables $_ and @_ (and, technically, the less frequently |
| 288 | used %_, the _ filehandle and so on). This is because otherwise perl |
| 289 | operators which default to $_ will not work and neither will the |
| 290 | assignment of arguments to @_ on subroutine entry. |
| 291 | |
| 292 | =item an operator mask |
| 293 | |
| 294 | Each compartment has an associated "operator mask". Recall that |
| 295 | perl code is compiled into an internal format before execution. |
| 296 | Evaluating perl code (e.g. via "eval" or "do 'file'") causes |
| 297 | the code to be compiled into an internal format and then, |
| 298 | provided there was no error in the compilation, executed. |
| 299 | Code evaluated in a compartment compiles subject to the |
| 300 | compartment's operator mask. Attempting to evaluate code in a |
| 301 | compartment which contains a masked operator will cause the |
| 302 | compilation to fail with an error. The code will not be executed. |
| 303 | |
| 304 | The default operator mask for a newly created compartment is |
| 305 | the ':default' optag. |
| 306 | |
| 307 | It is important that you read the Opcode(3) module documentation |
| 308 | for more information, especially for detailed definitions of opnames, |
| 309 | optags and opsets. |
| 310 | |
| 311 | Since it is only at the compilation stage that the operator mask |
| 312 | applies, controlled access to potentially unsafe operations can |
| 313 | be achieved by having a handle to a wrapper subroutine (written |
| 314 | outside the compartment) placed into the compartment. For example, |
| 315 | |
| 316 | $cpt = new Safe; |
| 317 | sub wrapper { |
| 318 | # vet arguments and perform potentially unsafe operations |
| 319 | } |
| 320 | $cpt->share('&wrapper'); |
| 321 | |
| 322 | =back |
| 323 | |
| 324 | |
| 325 | =head1 WARNING |
| 326 | |
| 327 | The authors make B<no warranty>, implied or otherwise, about the |
| 328 | suitability of this software for safety or security purposes. |
| 329 | |
| 330 | The authors shall not in any case be liable for special, incidental, |
| 331 | consequential, indirect or other similar damages arising from the use |
| 332 | of this software. |
| 333 | |
| 334 | Your mileage will vary. If in any doubt B<do not use it>. |
| 335 | |
| 336 | |
| 337 | =head2 RECENT CHANGES |
| 338 | |
| 339 | The interface to the Safe module has changed quite dramatically since |
| 340 | version 1 (as supplied with Perl5.002). Study these pages carefully if |
| 341 | you have code written to use Safe version 1 because you will need to |
| 342 | makes changes. |
| 343 | |
| 344 | |
| 345 | =head2 Methods in class Safe |
| 346 | |
| 347 | To create a new compartment, use |
| 348 | |
| 349 | $cpt = new Safe; |
| 350 | |
| 351 | Optional argument is (NAMESPACE), where NAMESPACE is the root namespace |
| 352 | to use for the compartment (defaults to "Safe::Root0", incremented for |
| 353 | each new compartment). |
| 354 | |
| 355 | Note that version 1.00 of the Safe module supported a second optional |
| 356 | parameter, MASK. That functionality has been withdrawn pending deeper |
| 357 | consideration. Use the permit and deny methods described below. |
| 358 | |
| 359 | The following methods can then be used on the compartment |
| 360 | object returned by the above constructor. The object argument |
| 361 | is implicit in each case. |
| 362 | |
| 363 | |
| 364 | =over 8 |
| 365 | |
| 366 | =item permit (OP, ...) |
| 367 | |
| 368 | Permit the listed operators to be used when compiling code in the |
| 369 | compartment (in I<addition> to any operators already permitted). |
| 370 | |
| 371 | You can list opcodes by names, or use a tag name; see |
| 372 | L<Opcode/"Predefined Opcode Tags">. |
| 373 | |
| 374 | =item permit_only (OP, ...) |
| 375 | |
| 376 | Permit I<only> the listed operators to be used when compiling code in |
| 377 | the compartment (I<no> other operators are permitted). |
| 378 | |
| 379 | =item deny (OP, ...) |
| 380 | |
| 381 | Deny the listed operators from being used when compiling code in the |
| 382 | compartment (other operators may still be permitted). |
| 383 | |
| 384 | =item deny_only (OP, ...) |
| 385 | |
| 386 | Deny I<only> the listed operators from being used when compiling code |
| 387 | in the compartment (I<all> other operators will be permitted). |
| 388 | |
| 389 | =item trap (OP, ...) |
| 390 | |
| 391 | =item untrap (OP, ...) |
| 392 | |
| 393 | The trap and untrap methods are synonyms for deny and permit |
| 394 | respectfully. |
| 395 | |
| 396 | =item share (NAME, ...) |
| 397 | |
| 398 | This shares the variable(s) in the argument list with the compartment. |
| 399 | This is almost identical to exporting variables using the L<Exporter> |
| 400 | module. |
| 401 | |
| 402 | Each NAME must be the B<name> of a non-lexical variable, typically |
| 403 | with the leading type identifier included. A bareword is treated as a |
| 404 | function name. |
| 405 | |
| 406 | Examples of legal names are '$foo' for a scalar, '@foo' for an |
| 407 | array, '%foo' for a hash, '&foo' or 'foo' for a subroutine and '*foo' |
| 408 | for a glob (i.e. all symbol table entries associated with "foo", |
| 409 | including scalar, array, hash, sub and filehandle). |
| 410 | |
| 411 | Each NAME is assumed to be in the calling package. See share_from |
| 412 | for an alternative method (which share uses). |
| 413 | |
| 414 | =item share_from (PACKAGE, ARRAYREF) |
| 415 | |
| 416 | This method is similar to share() but allows you to explicitly name the |
| 417 | package that symbols should be shared from. The symbol names (including |
| 418 | type characters) are supplied as an array reference. |
| 419 | |
| 420 | $safe->share_from('main', [ '$foo', '%bar', 'func' ]); |
| 421 | |
| 422 | |
| 423 | =item varglob (VARNAME) |
| 424 | |
| 425 | This returns a glob reference for the symbol table entry of VARNAME in |
| 426 | the package of the compartment. VARNAME must be the B<name> of a |
| 427 | variable without any leading type marker. For example, |
| 428 | |
| 429 | $cpt = new Safe 'Root'; |
| 430 | $Root::foo = "Hello world"; |
| 431 | # Equivalent version which doesn't need to know $cpt's package name: |
| 432 | ${$cpt->varglob('foo')} = "Hello world"; |
| 433 | |
| 434 | |
| 435 | =item reval (STRING) |
| 436 | |
| 437 | This evaluates STRING as perl code inside the compartment. |
| 438 | |
| 439 | The code can only see the compartment's namespace (as returned by the |
| 440 | B<root> method). The compartment's root package appears to be the |
| 441 | C<main::> package to the code inside the compartment. |
| 442 | |
| 443 | Any attempt by the code in STRING to use an operator which is not permitted |
| 444 | by the compartment will cause an error (at run-time of the main program |
| 445 | but at compile-time for the code in STRING). The error is of the form |
| 446 | "'%s' trapped by operation mask...". |
| 447 | |
| 448 | If an operation is trapped in this way, then the code in STRING will |
| 449 | not be executed. If such a trapped operation occurs or any other |
| 450 | compile-time or return error, then $@ is set to the error message, just |
| 451 | as with an eval(). |
| 452 | |
| 453 | If there is no error, then the method returns the value of the last |
| 454 | expression evaluated, or a return statement may be used, just as with |
| 455 | subroutines and B<eval()>. The context (list or scalar) is determined |
| 456 | by the caller as usual. |
| 457 | |
| 458 | This behaviour differs from the beta distribution of the Safe extension |
| 459 | where earlier versions of perl made it hard to mimic the return |
| 460 | behaviour of the eval() command and the context was always scalar. |
| 461 | |
| 462 | Some points to note: |
| 463 | |
| 464 | If the entereval op is permitted then the code can use eval "..." to |
| 465 | 'hide' code which might use denied ops. This is not a major problem |
| 466 | since when the code tries to execute the eval it will fail because the |
| 467 | opmask is still in effect. However this technique would allow clever, |
| 468 | and possibly harmful, code to 'probe' the boundaries of what is |
| 469 | possible. |
| 470 | |
| 471 | Any string eval which is executed by code executing in a compartment, |
| 472 | or by code called from code executing in a compartment, will be eval'd |
| 473 | in the namespace of the compartment. This is potentially a serious |
| 474 | problem. |
| 475 | |
| 476 | Consider a function foo() in package pkg compiled outside a compartment |
| 477 | but shared with it. Assume the compartment has a root package called |
| 478 | 'Root'. If foo() contains an eval statement like eval '$foo = 1' then, |
| 479 | normally, $pkg::foo will be set to 1. If foo() is called from the |
| 480 | compartment (by whatever means) then instead of setting $pkg::foo, the |
| 481 | eval will actually set $Root::pkg::foo. |
| 482 | |
| 483 | This can easily be demonstrated by using a module, such as the Socket |
| 484 | module, which uses eval "..." as part of an AUTOLOAD function. You can |
| 485 | 'use' the module outside the compartment and share an (autoloaded) |
| 486 | function with the compartment. If an autoload is triggered by code in |
| 487 | the compartment, or by any code anywhere that is called by any means |
| 488 | from the compartment, then the eval in the Socket module's AUTOLOAD |
| 489 | function happens in the namespace of the compartment. Any variables |
| 490 | created or used by the eval'd code are now under the control of |
| 491 | the code in the compartment. |
| 492 | |
| 493 | A similar effect applies to I<all> runtime symbol lookups in code |
| 494 | called from a compartment but not compiled within it. |
| 495 | |
| 496 | |
| 497 | |
| 498 | =item rdo (FILENAME) |
| 499 | |
| 500 | This evaluates the contents of file FILENAME inside the compartment. |
| 501 | See above documentation on the B<reval> method for further details. |
| 502 | |
| 503 | =item root (NAMESPACE) |
| 504 | |
| 505 | This method returns the name of the package that is the root of the |
| 506 | compartment's namespace. |
| 507 | |
| 508 | Note that this behaviour differs from version 1.00 of the Safe module |
| 509 | where the root module could be used to change the namespace. That |
| 510 | functionality has been withdrawn pending deeper consideration. |
| 511 | |
| 512 | =item mask (MASK) |
| 513 | |
| 514 | This is a get-or-set method for the compartment's operator mask. |
| 515 | |
| 516 | With no MASK argument present, it returns the current operator mask of |
| 517 | the compartment. |
| 518 | |
| 519 | With the MASK argument present, it sets the operator mask for the |
| 520 | compartment (equivalent to calling the deny_only method). |
| 521 | |
| 522 | =back |
| 523 | |
| 524 | |
| 525 | =head2 Some Safety Issues |
| 526 | |
| 527 | This section is currently just an outline of some of the things code in |
| 528 | a compartment might do (intentionally or unintentionally) which can |
| 529 | have an effect outside the compartment. |
| 530 | |
| 531 | =over 8 |
| 532 | |
| 533 | =item Memory |
| 534 | |
| 535 | Consuming all (or nearly all) available memory. |
| 536 | |
| 537 | =item CPU |
| 538 | |
| 539 | Causing infinite loops etc. |
| 540 | |
| 541 | =item Snooping |
| 542 | |
| 543 | Copying private information out of your system. Even something as |
| 544 | simple as your user name is of value to others. Much useful information |
| 545 | could be gleaned from your environment variables for example. |
| 546 | |
| 547 | =item Signals |
| 548 | |
| 549 | Causing signals (especially SIGFPE and SIGALARM) to affect your process. |
| 550 | |
| 551 | Setting up a signal handler will need to be carefully considered |
| 552 | and controlled. What mask is in effect when a signal handler |
| 553 | gets called? If a user can get an imported function to get an |
| 554 | exception and call the user's signal handler, does that user's |
| 555 | restricted mask get re-instated before the handler is called? |
| 556 | Does an imported handler get called with its original mask or |
| 557 | the user's one? |
| 558 | |
| 559 | =item State Changes |
| 560 | |
| 561 | Ops such as chdir obviously effect the process as a whole and not just |
| 562 | the code in the compartment. Ops such as rand and srand have a similar |
| 563 | but more subtle effect. |
| 564 | |
| 565 | =back |
| 566 | |
| 567 | =head2 AUTHOR |
| 568 | |
| 569 | Originally designed and implemented by Malcolm Beattie, |
| 570 | mbeattie@sable.ox.ac.uk. |
| 571 | |
| 572 | Reworked to use the Opcode module and other changes added by Tim Bunce |
| 573 | E<lt>F<Tim.Bunce@ig.co.uk>E<gt>. |
| 574 | |
| 575 | =cut |
| 576 | |