Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

How to redefine a modules private function?

by sectokia (Pilgrim)
on Mar 08, 2022 at 03:01 UTC ( [id://11141900]=perlquestion: print w/replies, xml ) Need Help??

sectokia has asked for the wisdom of the Perl Monks concerning the following question:

In AnyEvent::DNS code there is this line that sets the port for the DNS server (and there seems to be no way to specify another port):

sub DOMAIN_PORT() { 53 } # if this changes drop me a note

I want to use another port. I thought I could simply re-define it like so:

*AnyEvent::DNS::DOMAIN_PORT = sub () { 8053 }; print AnyEvent::DNS::DOMAIN_PORT(); # Prints 53..

However it doesn't work. What am I doing wrong?

Replies are listed 'Best First'.
Re: How to redefine a modules private function?
by haukex (Archbishop) on Mar 08, 2022 at 09:13 UTC
    However it doesn't work. What am I doing wrong?

    AnyEvent::DNS::DOMAIN_PORT is a constant function, which means it gets inlined, and within AnyEvent::DNS, the instances of DOMAIN_PORT are replaced by 53 by the compiler by the time the module is loaded and before control returns to your code. (See e.g. perl -MO=Deparse "`perldoc -l AnyEvent::DNS`")

    At the moment, I don't see a way to modify the value of DOMAIN_PORT within AnyEvent::DNS itself from the outside, meaning you may have to resort to modifying the module's code. Constant Functions explains several ways to prevent inlining.

    (There may be some Devel::* modules or some other trickery that could prevent inlining from the outside, but I'm currently unaware of any such modules, though I would be interested to learn about such things.)

      I tried using source filters (Filter::Simple), but couldn't make it work, either. I usually don't use these, so i might have done it wrong.

      Frankly, i would consider the use of a constant function (or other type of constant) for a port number a major bug in AnyEvent::DNS. There are very few use cases that make sense to declare a number a constant in programming code. Pi might qualify, but in my opinion even physics constants shouldn't (because, hey, i might want to run a simulation to see what would happen if i change the planck constant.

      As for port numbers, if you want to run a network service as non-root (which is highly recommended, and pretty much a must while debugging software), the easiest way would be to change the port and set a fowarding rule on local the firewall. This is pretty much the default answer on most Linux forums. So coding a port number as constant in a library is a big no-no. Especially if it's a reserved port (lower than 1024).

      I haven't reported this as a bug to the AnyEvent maintainers, since i don't use AnyEvent. This should be done by sectokia, since they can provide more information to the maintainers.

      perl -e 'use Crypt::Digest::SHA256 qw[sha256_hex]; print substr(sha256_hex("the Answer To Life, The Universe And Everything"), 6, 2), "\n";'
        Frankly, i would consider the use of a constant function (or other type of constant) for a port number a major bug in AnyEvent::DNS. There are very few use cases that make sense to declare a number a constant in programming code.

        I assume you're not advocating for magic numbers - I might have said that a constant that isn't modifiable from outside the module is a problem.

        I tried using source filters (Filter::Simple), but couldn't make it work

        This was a fun project. I didn't exactly use source filters, but I did use PPI to munge the module before loading it, basically like a filtered use. Obviously this still has all the limitations of source filters and PPI!

        Deconstifier.pm

        package Deconstifier; use warnings; use strict; use parent 'PPI::Transform'; =head1 DESCRIPTION L<PPI::Transform> implementation that modifies a subset of L<constant functions|perlsub/"Constant Functions"> such that they are +no longer inlined. The subset of C<sub> definitions that are currently supported + is: sub FOO () { 42; } sub BAR () { "string"; } sub QUZ () { undef; } where the final semicolon is optional. =cut sub document { ( my $self = shift )->isa(__PACKAGE__) or return undef; ( my $doc = shift )->isa('PPI::Document') or return undef; my $subs = $doc->find(sub { if ( $_[1]->isa('PPI::Statement::Sub') && defined($_[1]->proto +type) && $_[1]->prototype eq "" ) { my $bl = $_[1]->block; if ( $bl && $bl->schildren==1 && $bl->schild(0)->isa('PPI: +:Statement') ) { my $st = $bl->schild(0); if ( $st->schildren==1 || $st->schildren==2 && $st->sc +hild(1)->isa('PPI::Token::Structure') && $st->schild(1)->content eq ' +;' ) { my $ch = $st->schild(0); if ( $ch->isa('PPI::Token::Number') || $ch->isa('P +PI::Token::Quote') || $ch->isa('PPI::Token::Word') && $ch->literal eq + 'undef' ) { return 1; } } } } return 0; }); return undef unless defined $subs; return 0 unless $subs; for my $s (@$subs) { #use PPI::Dumper; PPI::Dumper->new($s, whitespace=>0, comments +=>0)->print; # This first one only seems to work on Perl 5.8+, the second d +own to 5.6 and maybe/likely earlier (untested). # NOTE: This isn't really the right way to use PPI::Token::Wor +d, but since it's the only modification we're making it works fine. #$s->block->schild(0)->schild(0)->insert_before(PPI::Token::Wo +rd->new('return ')); $s->block->schild(0)->schild(0)->insert_after(PPI::Token::Word +->new(' if $]')); } return 0+@$subs; } 1;

        deconstify.t

        use warnings; use strict; use Test::More tests=>4; BEGIN { use_ok 'Deconstifier' } my $code = <<'END'; sub MAX_PKT() { 4096.0 } sub DOMAIN_PORT() { 53; } sub resolver (); sub _enc_qd() { (_enc_name $_->[0]) . pack "nn", ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}), ($_->[3] > 0 ? $_->[2] : $class_id{$_->[2] || "in"}) } sub _enc_rr() { die "encoding of resource records is not supported"; } sub HELLO { "world" } sub WORLD () { "foo" } sub FOO () { $bar } sub BAR () { return 123 } sub BLAH () { undef; } END my $exp = <<'END'; sub MAX_PKT() { 4096.0 if $] } sub DOMAIN_PORT() { 53 if $]; } sub resolver (); sub _enc_qd() { (_enc_name $_->[0]) . pack "nn", ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}), ($_->[3] > 0 ? $_->[2] : $class_id{$_->[2] || "in"}) } sub _enc_rr() { die "encoding of resource records is not supported"; } sub HELLO { "world" } sub WORLD () { "foo" if $] } sub FOO () { $bar } sub BAR () { return 123 } sub BLAH () { undef if $]; } END my $trans = new_ok 'Deconstifier'; ok $trans->apply(\$code), 'apply'; is $code, $exp, 'output is as expected';

        FilterLoad.pm

        package FilterLoad; use warnings; use strict; use List::Util qw/ pairs pairkeys /; use PPI; use Module::Load::Conditional qw/ check_install /; use Module::Runtime qw/ use_module module_notional_filename /; =head1 DESCRIPTION Loads modules after passing them through the L<PPI::Transform> filter( +s) given in the C<use> statement. For example: use FilterLoad 'AnyEvent::DNS' => 'Deconstifier', SomeModule => 'Deconstifier'; =cut sub import { my ($class, @defs) = @_; my (%mods, %filts); for ( pairs @defs ) { my ($mod, $filt) = @$_; $filts{$filt}++; my $modfn = module_notional_filename($mod); $mods{$modfn}{name} = $mod; push @{ $mods{$modfn}{filts} }, $filt; } use_module($_) for keys %filts; our $_in_inc_hook; unshift @INC, sub { my ($self, $modfn) = @_; return if $_in_inc_hook; return unless exists $mods{$modfn}; local $_in_inc_hook = 1; # check_install calls @INC hooks! my $info = check_install(module=>$mods{$modfn}{name}) or die "could not find $modfn"; my $doc = PPI::Document->new($info->{file}); $_->new->apply($doc) for @{ $mods{$modfn}{filts} }; return \$doc->serialize; }; use_module($_) for pairkeys @defs; } 1;

        test.pl

        use warnings; use strict; use FilterLoad Foo => 'Deconstifier', 'AnyEvent::DNS' => 'Deconstifier'; sub Foo::ONE () { 444 } sub Foo::TWO { 555 } sub Foo::THREE () { 666 } Foo::go(); print "One=", Foo::ONE, ", Two=", Foo::TWO, ", Three=", Foo::THREE, "\ +n"; # I've manually edited the module to include a function # sub foobar { print "DOMAIN_PORT=", DOMAIN_PORT, "\n" } AnyEvent::DNS::foobar(); sub AnyEvent::DNS::DOMAIN_PORT () { 4242 } AnyEvent::DNS::foobar();

        Using Foo.pm from my node here, and modifying AnyEvent::DNS as noted in the code above, the output is:

        Subroutine Foo::ONE redefined at test.pl line 9. Subroutine Foo::TWO redefined at test.pl line 10. Subroutine Foo::THREE redefined at test.pl line 11. Subroutine AnyEvent::DNS::DOMAIN_PORT redefined at test.pl line 19. One=444, Two=555, Three=666 One=444, Two=555, Three=666 DOMAIN_PORT=4242 DOMAIN_PORT=4242
      AnyEvent::DNS::DOMAIN_PORT is a constant function, which means it gets inlined, and within AnyEvent::DNS, the instances of DOMAIN_PORT are replaced by 53...

      I didn't know about this, and I don't want to hijack this thread, but I do have a tangential question.
      I'm wondering if there is essentially no difference between doing:
      sub DOMAIN_PORT() { 53 }
      and
      use constant DOMAIN_PORT => 53;
      Is there any difference at all ?

      Cheers,
      Rob
        I'm wondering if there is essentially no difference between doing: sub DOMAIN_PORT() { 53 } and use constant DOMAIN_PORT => 53; Is there any difference at all ?

        AFAIK not really, other than that constant does some checks on the constant names and that it keeps track of declared constants in %constant::declared - but they should both produce a constant function. (Even today you can still find the line *$full_name = sub () { $scalar }; in constant.pm.)

      There may be some Devel::* modules or some other trickery that could prevent inlining from the outside, but I'm currently unaware of any such modules, though I would be interested to learn about such things.

      A relatively simple solution would be to tie AnyEvent::DNS stash, so that the definition of DOMAIN_PORT could be replaced by a custom one:

      #!/usr/bin/perl use strict; use warnings; use feature 'say'; use Data::Dumper; use Tie::Hash; package Tie::Hash::Mine { BEGIN { our @ISA = qw(Tie::StdHash) }; sub STORE { warn "Setting AnyEvent::DNS::$_[1]"; $_[0]->SUPER::STORE($_[1], ($_[1] eq 'DOMAIN_PORT') ? sub () { 1053 } + : $_[2]) } }; BEGIN { tie %AnyEvent::DNS::, 'Tie::Hash::Mine'; } #use AnyEvent::DNS; <-- uncommenting this results in a segmentation fa +ult! BEGIN { package AnyEvent::DNS { sub ONE () { 1 } sub DOMAIN_PORT () { 53 } } } say Dumper \%AnyEvent::DNS::; say Dumper tied(%AnyEvent::DNS::);

      ... unfortunately, it seems that tieing a stash doesn't work at all :-(

        A very interesting hack attempt :-) I did briefly peek into the Perl source because I was curious if there was an obvious way to turn off the inlining (e.g. cv_const_sv), but I didn't see anything yet.

      Well, and now, something that actually works:
      #!/usr/bin/perl use strict; use warnings; use feature 'say'; use Path::Tiny; use File::Temp qw(tempfile); sub hotpatch { if ($_[1] eq 'AnyEvent/DNS.pm') { for my $inc (@INC) { next if ref $inc; my $fn = path($inc)->child($_[1]); if (open my $in, '<', $fn) { my ($out) = tempfile(UNLINK => 1); while (<$in>) { s/sub\s+DOMAIN_PORT\b/sub DOMAIN_PORT () { 1053 } +sub FORMER_DOMAIN_PORT/; print {$out} $_; } seek($out, 0, 0); return $out; } } warn "couldn't patch AnyEvent::DNS"; } return undef; } BEGIN { unshift @INC, \&hotpatch } use AnyEvent::DNS; BEGIN { @INC = grep not(ref and $_ eq \&hotpatch), @INC } say AnyEvent::DNS::DOMAIN_PORT(); say AnyEvent::DNS::FORMER_DOMAIN_PORT();

        You can avoid hitting the disk (even though that's great for debugging) by using an in-memory file in your @INC hook:

        open my $out, \my $buffer or die "Couldn't patch AnyEvent::DNS; your Perl do +es not support in-memory filehandles"; while (<$in>) { s/sub\s+DOMAIN_PORT\b/sub DOMAIN_PORT () { 1053 } +sub FORMER_DOMAIN_PORT/; $buffer .= $_; } return $out;

      Constant Functions says:

      Calls made using & are never inlined.

      I can't understand to what cases it applies to though.

      bw, bliako

        Calls made using & are never inlined. ... I can't understand to what cases it applies to though.

        In this case, this would require one to edit AnyEvent::DNS and change lines such as my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server); to my $sa = AnyEvent::Socket::pack_sockaddr (&DOMAIN_PORT(), $server);.

        > I can't understand to what cases it applies to though.

        &foo is disabling any prototype checks on foo calls at compile time. But constant folding requires an empty prototype () to rule out any side effects at run-time.

        (Though I never tried playing around with other side effects like returning a closure var)

        Like HaukeX said, this doesn't help here, because you'd need to patch the source.

        Cheers Rolf
        (addicted to the Perl Programming Language :)
        Wikisyntax for the Monastery

Re: How to redefine a modules private function?
by Your Mother (Archbishop) on Mar 08, 2022 at 05:39 UTC

    Can just use the fully qualified name to overwrite the sub.

    use 5.10.0; use AnyEvent::DNS; { no warnings "redefine"; sub AnyEvent::DNS::DOMAIN_PORT { 8053 }; } say AnyEvent::DNS::DOMAIN_PORT();

    Probably a couple other ways to do it.

      Can just use the fully qualified name to overwrite the sub.

      Unfortunately not - the change is visible within your script, but not within the module.

      Foo.pm

      package Foo; use warnings; use strict; sub ONE () { 111 } sub TWO { 222 } my $three = 333; sub THREE () { $three } sub go { print "One=", ONE, ", Two=", TWO, ", Three=", THREE, "\n"; } 1;

      test.pl

      use warnings; use strict; use lib '.'; use Foo; #BEGIN { #*Foo::ONE = sub () { 444 }; #*Foo::TWO = sub { 555 }; #*Foo::THREE = sub () { 666 }; sub Foo::ONE () { 444 } sub Foo::TWO { 555 } sub Foo::THREE () { 666 } #} Foo::go; print "One=", Foo::ONE, ", Two=", Foo::TWO, ", Three=", Foo::THREE, "\ +n";

      See also perl -MO=Deparse Foo.pm.

        Update: sorry, this is rubbish - see Re^5: How to redefine a modules private function?

        Can't get AnyEvent installed ATM, but your little demo does work, if you don't "re"define it, but define it before you load the module:

        Foo.pm as in your example

        test2.pl
        use warnings; use strict; use lib '.'; BEGIN { sub Foo::ONE () { 444 } sub Foo::TWO { 555 } sub Foo::THREE () { 666 } } use Foo; # _after_ your "re"definitions Foo::go; print "One=", Foo::ONE, ", Two=", Foo::TWO, ", Three=", Foo::THREE, "\ +n";

        Nice. And other post with more about it.

Re: How to redefine a modules private function?
by davido (Cardinal) on Mar 09, 2022 at 16:17 UTC

    Not ready for production. :) With Perl, we can insert code into @INC so that we get ahead of the constant definition:

    First, MyBase.pm. This module defines a constant, FOO of 42. But we live in a universe where FOO needs to be 44. Here's the example base:

    package MyBase; use strict; use warnings; use Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(bar); sub FOO() {42} sub bar { return FOO(); } 1;

    If someone were to use this module and call bar(), its return value would be 42.

    Now I need a module that depends on MyBase.pm. We'll call it MySub.pm. Here's where I can get in front of loading MyBase. To do that I'll insert code into @INC so that use and require get a little modified behavior:

    package MySub; use strict; use warnings; sub _filter { my $module = $_[1]; if ($module =~ m/^MyBase/) { foreach my $dir (@INC[1..$#INC]) { if (-e "$dir/MyBase.pm" && -f _) { open FH, '<', "$Bin/lib/MyBase.pm" or die $!; last; } } die "Couldn't find MyBase.pm in @INC\n" unless defined *FH; return \'', \*FH, sub { if (length $_) { $_ =~ s/(sub FOO\(\)\s*\{)(\d+)(\})/${1}44${3}/; return 1; } else { return 0; } }; } return (); } BEGIN {unshift @INC, \&_filter} use MyBase; use Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(baz); sub baz { return bar(); } 1;

    Here I have a subroutine named baz which calls MyBase::bar(), which returns the constant stored in MyBase::FOO, which would normally be 42. However, I've inserted a subroutine into @INC named _filter() that looks for the loading of MyBase.pm and replaces the FOO definition with a new one, with a value of 44.

    Finally, a small sample app using this:

    #!/usr/bin/env perl use strict; use warnings; use FindBin qw($Bin); use lib "$Bin/lib"; use MySub; print baz(), "\n";

    If we didn't override FOO in MyBase, this code would print 42. But the approach is successful, and the output is now 44.

    Obviously this isn't necessarily robust. A better approach would be to submit a patch to the maintainers of AnyEvent::DNS that makes the hard-coded value configurable. Just by removing the prototype it would become possible to subclass and override, or monkeypatch, for example. But in a pinch, a lot of things are possible. Look at the documentation in require for an explanation of how my approach works.


    Dave

        Oh... you got me. I had worked on this yesterday and posted it today without noticing someone had produced an @INC solution. Oh well. The approach has some subtle differences; I'm using the filehandle iterator approach instead of the buffer approach, but the result is the same. Thanks for bringing it to my attention.


        Dave

      If you're gonna be messing with @INC, maybe just create a subclass and redefine DOMAIN_PORT via @ISA or parent.
        If you're gonna be messing with @INC, maybe just create a subclass and redefine DOMAIN_PORT via @ISA or parent.

        No, overloading only works on methods, which the subs in question are not.

Re: How to redefine a modules private function?
by salva (Canon) on Mar 10, 2022 at 08:37 UTC
    Well, after seen all the solutions proposed, the truth is that I would go for the simplest one:

    Just copy AnyEvent/DNS.pm from the AnyEvent distribution somewhere under your source tree (for instance, under a directory called patched_modules), make the required modifications there and then ensure it is in the module search path before the original:

    BEGIN { unshift @INC, './patched_modules' } use AnyEvent; use AnyEvent::DNS;

    I would also add a version check into my modified version of AnyEvent::DNS:

    AnyEvent::VERSION eq "7.17" or warn "New version of AnyEvent ($AnyEvent::VERSION) detected, please +upgrade ".__FILE__." accordingly";
Re: How to redefine a modules private function?
by LanX (Saint) on Mar 08, 2022 at 19:16 UTC
    HaukeX already explained that constant folding is happening.

    This means the value is inlined at compile time, and you'd need to intercept the compilation between sub declaration and first call.

    The default answer is that you need to a hard patch of the code (no monkey patch, copy it into another namespace)

    I can't remember a clean possibility to register a callback to be called right after the sub declaration.

    • salva already tried to tie the STASH, but this would surprise me.
    • maybe it's possible to hack the attribute mechanism such that an invisible attribute is activated sub DOMAIN_PORT :magic_attribute but I'm not optimistic.
    • Another approach would be to use the debugger with a watch expression which redefines the sub after the breakpoint. But this would require to deactivate the debugger afterwards. I seem to remember that it's possible to dynamically (de)activate the debugger via a special CPAN module. something like "enbugger"
    • IMHO the most likely approach is to trigger error handling. In case you define your own sub prior to loading the module, Perl should throw a "redefined" warning and you can intercept that via $SIG{__WARN__} -handler. I would try that.

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery

      > IMHO the most likely approach is to trigger error handling. In case you define your own sub prior to loading the module, Perl should throw a "redefined" warning and you can intercept that via $SIG{__WARN__} -handler. I would try that.

      I tried my best.

      I was capable to intercept the warning, but it doesn't seem like it's even possible to redefine a constant. (or to be more precise: the once stored constant can't be changed)°

      Other may have more success:

      use strict; use warnings; use Data::Dump qw/pp dd/; $|=1; BEGIN { $\="\n"; my $old = $SIG{__WARN__}; $SIG{__WARN__} = sub { my ( $msg ) = @_ ; if ($msg =~ /Constant subroutine DOMAIN_PORT redefined/ ) { $SIG{__WARN__} = $old; print "REDEFINED", pp caller; package ALIEN; no warnings "redefine"; sub DOMAIN_PORT() { 666 } } } } sub ALIEN::DOMAIN_PORT() { "DUMMY" } package ALIEN; sub DOMAIN_PORT() { 53 } BEGIN { print "pre compile"; } sub test { print "Inside test: ", DOMAIN_PORT; } BEGIN { test(); print DOMAIN_PORT; }

      REDEFINED("main", "d:/tmp/pm/patch_constant.pl", 42) pre compile Inside test: 53 53

      Cheers Rolf
      (addicted to the Perl Programming Language :)
      Wikisyntax for the Monastery

      update

      °) not sure what is going wrong here, maybe it's a timimg issue

        OK I'm seeing clearer now.

        1. my code was wrong in that part

        package ALIEN; no warnings "redefine"; sub DOMAIN_PORT() { 666 }

        it's better written as

        no warnings "redefine"; *ALIEN::DOMAIN_PORT = sub() { 666 };

        2. But this creates a weird error

        Attempt to free unreferenced scalar: SV 0x6917d8, Perl interpreter: 0x767b98 at d:/tmp/pm/patch_constant.pl line 41.

        Which is most likely explained by %SIG

        __DIE__/__WARN__ handlers are very special in one respect: they may be called to report (probable) errors found by the parser. In such a case the parser may be in inconsistent state, so any attempt to evaluate Perl code from such a handler will probably result in a segfault. This means that warnings or errors that result from parsing Perl should be used with extreme caution, like this:

        bottom line

        nice idea, but no luck :/

        Cheers Rolf
        (addicted to the Perl Programming Language :)
        Wikisyntax for the Monastery

Re: How to redefine a modules private function?
by perlfan (Vicar) on Mar 10, 2022 at 06:36 UTC
    # if this changes drop me a note
    Have you tried this? MLEHMANN's activity indicates he's been active on CPAN within the last month.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://11141900]
Approved by Discipulus
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (7)
As of 2024-03-29 09:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found