in reply to Moving an OP and replacing it

I really hope that this is for nothing more serious than an ACME::* module since I would hate for anyone to rely on code that tries to do something like this. It sounds extremely fragile.

How are you going to recognize pointers to the thing that you're adjusting? Are you just going to do a substitution and pray that anything whose bytes are the address of that location really is a pointer to that location? Sure it is only 1 in 4 billion odds of being wrong, for each place you start a set of 4 bytes. Which means that if you did this on a process that was at 40 MB, you'd have 1% odds of randomly going wrong. And when you did go wrong, good luck debugging it!

Replies are listed 'Best First'.
Re: Re: Moving an OP and replacing it
by diotalevi (Canon) on Jun 01, 2004 at 13:28 UTC

    Oh that'd be silly - to just substr the process memory and just look for strings that were identical to the packed pointer. Here's I've half-copied, half-sketched the code that I'm running in http://lik.grenekatz.org/downloads/perl/Devel/UncheckedOps.pm.

    use vars qw( %ALLOPS %OPMAP @QUEUE_OPCODES_TO_FIX ); CHECK { walkallops_filtered( sub { foo( $op ) ... }, \ &queue_opcode ); fix_opcode( $_ ) for @QUEUE_OPCODES_TO_FIX; } sub queue_opcode { my $op = shift; push @QUEUE_OPCODES_TO_FIX, $op; } sub foo { my $op = shift; my $addr = $$op; $ALLOPS{ $addr } = $op; for my $m ( qw( next sibling ppaddr first last other pmreplroot pm +replstart pmnext ) ) { my $to = eval { ${ $op->$m } }; next unless $to; push @{$OPMAP{ $addr }}, "$to $m"; } } x_opcode { my $op = shift; my $addr = $$op; # Construct the new program fragment in reverse order so parent no +des # can point to child nodes. See the tree immedia # null # or # $OP # die # pushmark # null2 # gvsv my $gvsv = B::SVOP->new( gvsv => 2, '$!' ); my $null2 = B::OP->new( null => 6 ); $null2->private( 1 ); my $pushmark = B::OP->new( pushmark => 2 ); my $die = B::LISTOP->new( die => 5, $pushmark, $null2 ); $die->targ( 1 ); $die->private( 1 ); $pushmark->sibling( $null2 ); my $or = B::LOGOP->new( or => 2, $op, $die ); $or->private( 1 ); my $null = B::OP->new( null => 5 ); $null->private( 1 ); # Tree order my $orig_sibling = $op->sibling; $op->sibling( $die ); # Now thread the execution order. my $orig_next = $op->next; # EXT -> $op # -> OR # -> $orig_next || $pushmark # ( null2 -> gvsv ) # -> gvsv # -> die $op->next( $or ); $or->next( $orig_next ); $or->other( $pushmark ); $null->next( $orig_next ); $pushmark->next( $gvsv ); $null2->next( $gvsv ); # Also but this is skipped anyway. $gvsv->next( $die ); $die->next( $orig_next ); # Now change everything that currently points to $op so that it po +ints to my @referrents = @{ $OPMAP{ $addr } }; # use YAML 'Dump'; # print Dump( $addr, \%OPMAP ) or die $!;exit; foreach my $referrent ( @referrents ) { my ( $referrent_addr, $referrent_attr ) = split ' ', $referrent; print "$$op $referrent_addr $referrent_attr\n" or die $!; # my $co = B::class( $op ); # my $cn = $op->oldname; # my $c = B::class( $referrent_obj ); # my $n = $referrent_obj->oldname; # $referrent_obj->$referrent_attr( $op ); # print STDERR "$referrent_obj->$referrent_attr( $op )\n" or die $! +; } }