1package Opcode; 2 3use 5.006_001; 4 5use strict; 6 7our($VERSION, @ISA, @EXPORT_OK); 8 9$VERSION = "1.15"; 10 11use Carp; 12use Exporter (); 13use XSLoader (); 14 15BEGIN { 16 @ISA = qw(Exporter); 17 @EXPORT_OK = qw( 18 opset ops_to_opset 19 opset_to_ops opset_to_hex invert_opset 20 empty_opset full_opset 21 opdesc opcodes opmask define_optag 22 opmask_add verify_opset opdump 23 ); 24} 25 26sub opset (;@); 27sub opset_to_hex ($); 28sub opdump (;$); 29use subs @EXPORT_OK; 30 31XSLoader::load 'Opcode', $VERSION; 32 33_init_optags(); 34 35sub ops_to_opset { opset @_ } # alias for old name 36 37sub opset_to_hex ($) { 38 return "(invalid opset)" unless verify_opset($_[0]); 39 unpack("h*",$_[0]); 40} 41 42sub opdump (;$) { 43 my $pat = shift; 44 # handy utility: perl -MOpcode=opdump -e 'opdump File' 45 foreach(opset_to_ops(full_opset)) { 46 my $op = sprintf " %12s %s\n", $_, opdesc($_); 47 next if defined $pat and $op !~ m/$pat/i; 48 print $op; 49 } 50} 51 52 53 54sub _init_optags { 55 my(%all, %seen); 56 @all{opset_to_ops(full_opset)} = (); # keys only 57 58 local($_); 59 local($/) = "\n=cut"; # skip to optags definition section 60 <DATA>; 61 $/ = "\n="; # now read in 'pod section' chunks 62 while(<DATA>) { 63 next unless m/^item\s+(:\w+)/; 64 my $tag = $1; 65 66 # Split into lines, keep only indented lines 67 my @lines = grep { m/^\s/ } split(/\n/); 68 foreach (@lines) { s/--.*// } # delete comments 69 my @ops = map { split ' ' } @lines; # get op words 70 71 foreach(@ops) { 72 warn "$tag - $_ already tagged in $seen{$_}\n" if $seen{$_}; 73 $seen{$_} = $tag; 74 delete $all{$_}; 75 } 76 # opset will croak on invalid names 77 define_optag($tag, opset(@ops)); 78 } 79 close(DATA); 80 warn "Untagged opnames: ".join(' ',keys %all)."\n" if %all; 81} 82 83 841; 85 86__DATA__ 87 88=head1 NAME 89 90Opcode - Disable named opcodes when compiling perl code 91 92=head1 SYNOPSIS 93 94 use Opcode; 95 96 97=head1 DESCRIPTION 98 99Perl code is always compiled into an internal format before execution. 100 101Evaluating perl code (e.g. via "eval" or "do 'file'") causes 102the code to be compiled into an internal format and then, 103provided there was no error in the compilation, executed. 104The internal format is based on many distinct I<opcodes>. 105 106By default no opmask is in effect and any code can be compiled. 107 108The Opcode module allow you to define an I<operator mask> to be in 109effect when perl I<next> compiles any code. Attempting to compile code 110which contains a masked opcode will cause the compilation to fail 111with an error. The code will not be executed. 112 113=head1 NOTE 114 115The Opcode module is not usually used directly. See the ops pragma and 116Safe modules for more typical uses. 117 118=head1 WARNING 119 120The authors make B<no warranty>, implied or otherwise, about the 121suitability of this software for safety or security purposes. 122 123The authors shall not in any case be liable for special, incidental, 124consequential, indirect or other similar damages arising from the use 125of this software. 126 127Your mileage will vary. If in any doubt B<do not use it>. 128 129 130=head1 Operator Names and Operator Lists 131 132The canonical list of operator names is the contents of the array 133PL_op_name defined and initialised in file F<opcode.h> of the Perl 134source distribution (and installed into the perl library). 135 136Each operator has both a terse name (its opname) and a more verbose or 137recognisable descriptive name. The opdesc function can be used to 138return a list of descriptions for a list of operators. 139 140Many of the functions and methods listed below take a list of 141operators as parameters. Most operator lists can be made up of several 142types of element. Each element can be one of 143 144=over 8 145 146=item an operator name (opname) 147 148Operator names are typically small lowercase words like enterloop, 149leaveloop, last, next, redo etc. Sometimes they are rather cryptic 150like gv2cv, i_ncmp and ftsvtx. 151 152=item an operator tag name (optag) 153 154Operator tags can be used to refer to groups (or sets) of operators. 155Tag names always begin with a colon. The Opcode module defines several 156optags and the user can define others using the define_optag function. 157 158=item a negated opname or optag 159 160An opname or optag can be prefixed with an exclamation mark, e.g., !mkdir. 161Negating an opname or optag means remove the corresponding ops from the 162accumulated set of ops at that point. 163 164=item an operator set (opset) 165 166An I<opset> as a binary string of approximately 44 bytes which holds a 167set or zero or more operators. 168 169The opset and opset_to_ops functions can be used to convert from 170a list of operators to an opset and I<vice versa>. 171 172Wherever a list of operators can be given you can use one or more opsets. 173See also Manipulating Opsets below. 174 175=back 176 177 178=head1 Opcode Functions 179 180The Opcode package contains functions for manipulating operator names 181tags and sets. All are available for export by the package. 182 183=over 8 184 185=item opcodes 186 187In a scalar context opcodes returns the number of opcodes in this 188version of perl (around 350 for perl-5.7.0). 189 190In a list context it returns a list of all the operator names. 191(Not yet implemented, use @names = opset_to_ops(full_opset).) 192 193=item opset (OP, ...) 194 195Returns an opset containing the listed operators. 196 197=item opset_to_ops (OPSET) 198 199Returns a list of operator names corresponding to those operators in 200the set. 201 202=item opset_to_hex (OPSET) 203 204Returns a string representation of an opset. Can be handy for debugging. 205 206=item full_opset 207 208Returns an opset which includes all operators. 209 210=item empty_opset 211 212Returns an opset which contains no operators. 213 214=item invert_opset (OPSET) 215 216Returns an opset which is the inverse set of the one supplied. 217 218=item verify_opset (OPSET, ...) 219 220Returns true if the supplied opset looks like a valid opset (is the 221right length etc) otherwise it returns false. If an optional second 222parameter is true then verify_opset will croak on an invalid opset 223instead of returning false. 224 225Most of the other Opcode functions call verify_opset automatically 226and will croak if given an invalid opset. 227 228=item define_optag (OPTAG, OPSET) 229 230Define OPTAG as a symbolic name for OPSET. Optag names always start 231with a colon C<:>. 232 233The optag name used must not be defined already (define_optag will 234croak if it is already defined). Optag names are global to the perl 235process and optag definitions cannot be altered or deleted once 236defined. 237 238It is strongly recommended that applications using Opcode should use a 239leading capital letter on their tag names since lowercase names are 240reserved for use by the Opcode module. If using Opcode within a module 241you should prefix your tags names with the name of your module to 242ensure uniqueness and thus avoid clashes with other modules. 243 244=item opmask_add (OPSET) 245 246Adds the supplied opset to the current opmask. Note that there is 247currently I<no> mechanism for unmasking ops once they have been masked. 248This is intentional. 249 250=item opmask 251 252Returns an opset corresponding to the current opmask. 253 254=item opdesc (OP, ...) 255 256This takes a list of operator names and returns the corresponding list 257of operator descriptions. 258 259=item opdump (PAT) 260 261Dumps to STDOUT a two column list of op names and op descriptions. 262If an optional pattern is given then only lines which match the 263(case insensitive) pattern will be output. 264 265It's designed to be used as a handy command line utility: 266 267 perl -MOpcode=opdump -e opdump 268 perl -MOpcode=opdump -e 'opdump Eval' 269 270=back 271 272=head1 Manipulating Opsets 273 274Opsets may be manipulated using the perl bit vector operators & (and), | (or), 275^ (xor) and ~ (negate/invert). 276 277However you should never rely on the numerical position of any opcode 278within the opset. In other words both sides of a bit vector operator 279should be opsets returned from Opcode functions. 280 281Also, since the number of opcodes in your current version of perl might 282not be an exact multiple of eight, there may be unused bits in the last 283byte of an upset. This should not cause any problems (Opcode functions 284ignore those extra bits) but it does mean that using the ~ operator 285will typically not produce the same 'physical' opset 'string' as the 286invert_opset function. 287 288 289=head1 TO DO (maybe) 290 291 $bool = opset_eq($opset1, $opset2) true if opsets are logically eqiv 292 293 $yes = opset_can($opset, @ops) true if $opset has all @ops set 294 295 @diff = opset_diff($opset1, $opset2) => ('foo', '!bar', ...) 296 297=cut 298 299# the =cut above is used by _init_optags() to get here quickly 300 301=head1 Predefined Opcode Tags 302 303=over 5 304 305=item :base_core 306 307 null stub scalar pushmark wantarray const defined undef 308 309 rv2sv sassign 310 311 rv2av aassign aelem aelemfast aslice av2arylen 312 313 rv2hv helem hslice each values keys exists delete aeach akeys avalues 314 boolkeys 315 316 preinc i_preinc predec i_predec postinc i_postinc postdec i_postdec 317 int hex oct abs pow multiply i_multiply divide i_divide 318 modulo i_modulo add i_add subtract i_subtract 319 320 left_shift right_shift bit_and bit_xor bit_or negate i_negate 321 not complement 322 323 lt i_lt gt i_gt le i_le ge i_ge eq i_eq ne i_ne ncmp i_ncmp 324 slt sgt sle sge seq sne scmp 325 326 substr vec stringify study pos length index rindex ord chr 327 328 ucfirst lcfirst uc lc quotemeta trans chop schop chomp schomp 329 330 match split qr 331 332 list lslice splice push pop shift unshift reverse 333 334 cond_expr flip flop andassign orassign dorassign and or dor xor 335 336 warn die lineseq nextstate scope enter leave 337 338 rv2cv anoncode prototype 339 340 entersub leavesub leavesublv return method method_named -- XXX loops via recursion? 341 342 leaveeval -- needed for Safe to operate, is safe without entereval 343 344=item :base_mem 345 346These memory related ops are not included in :base_core because they 347can easily be used to implement a resource attack (e.g., consume all 348available memory). 349 350 concat repeat join range 351 352 anonlist anonhash 353 354Note that despite the existence of this optag a memory resource attack 355may still be possible using only :base_core ops. 356 357Disabling these ops is a I<very> heavy handed way to attempt to prevent 358a memory resource attack. It's probable that a specific memory limit 359mechanism will be added to perl in the near future. 360 361=item :base_loop 362 363These loop ops are not included in :base_core because they can easily be 364used to implement a resource attack (e.g., consume all available CPU time). 365 366 grepstart grepwhile 367 mapstart mapwhile 368 enteriter iter 369 enterloop leaveloop unstack 370 last next redo 371 goto 372 373=item :base_io 374 375These ops enable I<filehandle> (rather than filename) based input and 376output. These are safe on the assumption that only pre-existing 377filehandles are available for use. Usually, to create new filehandles 378other ops such as open would need to be enabled, if you don't take into 379account the magical open of ARGV. 380 381 readline rcatline getc read 382 383 formline enterwrite leavewrite 384 385 print say sysread syswrite send recv 386 387 eof tell seek sysseek 388 389 readdir telldir seekdir rewinddir 390 391=item :base_orig 392 393These are a hotchpotch of opcodes still waiting to be considered 394 395 gvsv gv gelem 396 397 padsv padav padhv padany 398 399 once 400 401 rv2gv refgen srefgen ref 402 403 bless -- could be used to change ownership of objects (reblessing) 404 405 pushre regcmaybe regcreset regcomp subst substcont 406 407 sprintf prtf -- can core dump 408 409 crypt 410 411 tie untie 412 413 dbmopen dbmclose 414 sselect select 415 pipe_op sockpair 416 417 getppid getpgrp setpgrp getpriority setpriority localtime gmtime 418 419 entertry leavetry -- can be used to 'hide' fatal errors 420 421 entergiven leavegiven 422 enterwhen leavewhen 423 break continue 424 smartmatch 425 426 custom -- where should this go 427 428=item :base_math 429 430These ops are not included in :base_core because of the risk of them being 431used to generate floating point exceptions (which would have to be caught 432using a $SIG{FPE} handler). 433 434 atan2 sin cos exp log sqrt 435 436These ops are not included in :base_core because they have an effect 437beyond the scope of the compartment. 438 439 rand srand 440 441=item :base_thread 442 443These ops are related to multi-threading. 444 445 lock 446 447=item :default 448 449A handy tag name for a I<reasonable> default set of ops. (The current ops 450allowed are unstable while development continues. It will change.) 451 452 :base_core :base_mem :base_loop :base_orig :base_thread 453 454This list used to contain :base_io prior to Opcode 1.07. 455 456If safety matters to you (and why else would you be using the Opcode module?) 457then you should not rely on the definition of this, or indeed any other, optag! 458 459=item :filesys_read 460 461 stat lstat readlink 462 463 ftatime ftblk ftchr ftctime ftdir fteexec fteowned fteread 464 ftewrite ftfile ftis ftlink ftmtime ftpipe ftrexec ftrowned 465 ftrread ftsgid ftsize ftsock ftsuid fttty ftzero ftrwrite ftsvtx 466 467 fttext ftbinary 468 469 fileno 470 471=item :sys_db 472 473 ghbyname ghbyaddr ghostent shostent ehostent -- hosts 474 gnbyname gnbyaddr gnetent snetent enetent -- networks 475 gpbyname gpbynumber gprotoent sprotoent eprotoent -- protocols 476 gsbyname gsbyport gservent sservent eservent -- services 477 478 gpwnam gpwuid gpwent spwent epwent getlogin -- users 479 ggrnam ggrgid ggrent sgrent egrent -- groups 480 481=item :browse 482 483A handy tag name for a I<reasonable> default set of ops beyond the 484:default optag. Like :default (and indeed all the other optags) its 485current definition is unstable while development continues. It will change. 486 487The :browse tag represents the next step beyond :default. It it a 488superset of the :default ops and adds :filesys_read the :sys_db. 489The intent being that scripts can access more (possibly sensitive) 490information about your system but not be able to change it. 491 492 :default :filesys_read :sys_db 493 494=item :filesys_open 495 496 sysopen open close 497 umask binmode 498 499 open_dir closedir -- other dir ops are in :base_io 500 501=item :filesys_write 502 503 link unlink rename symlink truncate 504 505 mkdir rmdir 506 507 utime chmod chown 508 509 fcntl -- not strictly filesys related, but possibly as dangerous? 510 511=item :subprocess 512 513 backtick system 514 515 fork 516 517 wait waitpid 518 519 glob -- access to Cshell via <`rm *`> 520 521=item :ownprocess 522 523 exec exit kill 524 525 time tms -- could be used for timing attacks (paranoid?) 526 527=item :others 528 529This tag holds groups of assorted specialist opcodes that don't warrant 530having optags defined for them. 531 532SystemV Interprocess Communications: 533 534 msgctl msgget msgrcv msgsnd 535 536 semctl semget semop 537 538 shmctl shmget shmread shmwrite 539 540=item :load 541 542This tag holds opcodes related to loading modules and getting information 543about calling environment and args. 544 545 require dofile 546 caller 547 548=item :still_to_be_decided 549 550 chdir 551 flock ioctl 552 553 socket getpeername ssockopt 554 bind connect listen accept shutdown gsockopt getsockname 555 556 sleep alarm -- changes global timer state and signal handling 557 sort -- assorted problems including core dumps 558 tied -- can be used to access object implementing a tie 559 pack unpack -- can be used to create/use memory pointers 560 561 hintseval -- constant op holding eval hints 562 563 entereval -- can be used to hide code from initial compile 564 565 reset 566 567 dbstate -- perl -d version of nextstate(ment) opcode 568 569=item :dangerous 570 571This tag is simply a bucket for opcodes that are unlikely to be used via 572a tag name but need to be tagged for completeness and documentation. 573 574 syscall dump chroot 575 576=back 577 578=head1 SEE ALSO 579 580L<ops> -- perl pragma interface to Opcode module. 581 582L<Safe> -- Opcode and namespace limited execution compartments 583 584=head1 AUTHORS 585 586Originally designed and implemented by Malcolm Beattie, 587mbeattie@sable.ox.ac.uk as part of Safe version 1. 588 589Split out from Safe module version 1, named opcode tags and other 590changes added by Tim Bunce. 591 592=cut 593 594