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.)
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
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";'
| [reply] [Watch: Dir/Any] [d/l] |
|
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
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
|
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 | [reply] [Watch: Dir/Any] [d/l] [select] |
|
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
#!/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 :-(
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
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();
| [reply] [Watch: Dir/Any] [d/l] |
|
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;
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
|
|
|
| [reply] [Watch: Dir/Any] [d/l] |
|
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);.
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
> 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.
| [reply] [Watch: Dir/Any] [d/l] [select] |
Re: How to redefine a modules private function?
by Your Mother (Archbishop) on Mar 08, 2022 at 05:39 UTC
|
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.
| [reply] [Watch: Dir/Any] [d/l] |
|
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. | [reply] [Watch: Dir/Any] [d/l] [select] |
|
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";
| [reply] [Watch: Dir/Any] [d/l] |
|
|
|
| [reply] [Watch: Dir/Any] |
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.
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
| [reply] [Watch: Dir/Any] |
|
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.
| [reply] [Watch: Dir/Any] |
|
If you're gonna be messing with @INC, maybe just create a subclass and redefine DOMAIN_PORT via @ISA or parent.
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
| [reply] [Watch: Dir/Any] [d/l] |
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";
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
plus begging the author to fix that.
| [reply] [Watch: Dir/Any] |
|
| [reply] [Watch: Dir/Any] [d/l] |
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.
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
> 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
update
°) not sure what is going wrong here, maybe it's a timimg issue | [reply] [Watch: Dir/Any] [d/l] [select] |
|
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 :/
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
|
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. | [reply] [Watch: Dir/Any] [d/l] |