SelfLoader: Untaint DATA after it's reopened #10078
Comments
From lubo.rintel@gooddata.comDATA handle is untainted on startup, but as we close and reopen it it This was probably broken by changeset 29606, (c96b238 in perl git). lib/SelfLoader.pm | 4 +++- Inline Patchdiff --git a/lib/SelfLoader.pm b/lib/SelfLoader.pm
index 047f776..20e02cc 100644
--- a/lib/SelfLoader.pm
+++ b/lib/SelfLoader.pm
@@ -1,7 +1,8 @@
package SelfLoader;
use 5.008;
use strict;
-our $VERSION = "1.17";
+use IO::Handle;
+our $VERSION = "1.18";
# The following bit of eval-magic is necessary to make this work on
# perls < 5.009005.
@@ -102,6 +103,7 @@ sub _load_stubs {
close $fh or die "close: $!"; # autocloses, but be paranoid
open $fh, '<&', $nfh or croak "reopen2: $!"; # dup() the fd "back"
close $nfh or die "close after reopen: $!"; # autocloses, but be paranoid
+ $fh->untaint;
}
$Cache{"${currpack}::<DATA"} = 1; # indicate package is cached
--
1.6.5.2 |
From lubo.rintel@gooddata.comThis was moved here form |
From lubo.rintel@gooddata.comOn Wed Jan 13 05:00:50 2010, lkundrak wrote:
Any chance for anyone at p5p to review this? Thanks |
|
lubo.rintel@gooddata.com - Status changed from 'new' to 'open' |
From @rgarcia2010/1/13 Lubomir Rintel <perlbug-followup@perl.org>:
I don't like silently loading IO::Handle in such a low-level module. |
From @xdgWhich META ticket should this attach to? Is it a 5.12 blocker? |
From @rgarcia2010/1/19 David Golden via RT <perlbug-followup@perl.org>:
No. I already commented that I didn't like the patch. We'll address |
From @xdgOn Wed, Jan 20, 2010 at 5:08 AM, Rafael Garcia-Suarez <rgs@consttype.org> wrote:
Not liking the patch and not blocking are two separate things. :-) I'll add the ticket to the "non-critical bugs" meta ticket. David |
From lubo.rintel@gooddata.comDATA handle is untainted on startup, but as we close and reopen it it This was probably broken by changeset 29606, (c96b238 in perl git). dist/SelfLoader/lib/SelfLoader.pm | 3 ++- Inline Patchdiff --git a/dist/SelfLoader/lib/SelfLoader.pm b/dist/SelfLoader/lib/SelfLoader.pm
index 047f776..759e975 100644
--- a/dist/SelfLoader/lib/SelfLoader.pm
+++ b/dist/SelfLoader/lib/SelfLoader.pm
@@ -1,7 +1,7 @@
package SelfLoader;
use 5.008;
use strict;
-our $VERSION = "1.17";
+our $VERSION = "1.18";
# The following bit of eval-magic is necessary to make this work on
# perls < 5.009005.
@@ -102,6 +102,7 @@ sub _load_stubs {
close $fh or die "close: $!"; # autocloses, but be paranoid
open $fh, '<&', $nfh or croak "reopen2: $!"; # dup() the fd "back"
close $nfh or die "close after reopen: $!"; # autocloses, but be paranoid
+ Internals::untaintfh($fh);
}
$Cache{"${currpack}::<DATA"} = 1; # indicate package is cached
diff --git a/lib/SelfLoader.t b/lib/SelfLoader.t
new file mode 100644
index 0000000..d14184a
--- /dev/null
+++ b/lib/SelfLoader.t
@@ -0,0 +1,20 @@
+#!./perl -Tw
+
+use strict;
+use Test::More tests => 4;
+
+use_ok('SelfLoader');
+is(routine (), 1, "Can call self-loaded subroutine");
+
+package pkg;
+Test::More::is(routine (), 2, "Can self-load subroutine from another package");
+
+package main;
+is(pkg::routine2 (), 3, "Can self-load other package's routine");
+
+__DATA__
+sub routine { return 1; }
+
+package pkg;
+sub routine { return 2; }
+sub routine2 { return 3; }
diff --git a/universal.c b/universal.c
index 5a2cddb..03dde5d 100644
--- a/universal.c
+++ b/universal.c
@@ -241,6 +241,7 @@ XS(XS_PerlIO_get_layers);
XS(XS_Internals_hash_seed);
XS(XS_Internals_rehash_seed);
XS(XS_Internals_HvREHASH);
+XS(XS_Internals_untaintfh);
XS(XS_re_is_regexp);
XS(XS_re_regname);
XS(XS_re_regnames);
@@ -310,6 +311,7 @@ Perl_boot_core_UNIVERSAL(pTHX)
newXSproto("Internals::hash_seed",XS_Internals_hash_seed, file, "");
newXSproto("Internals::rehash_seed",XS_Internals_rehash_seed, file, "");
newXSproto("Internals::HvREHASH", XS_Internals_HvREHASH, file, "\\%");
+ newXSproto("Internals::untaintfh", XS_Internals_untaintfh, file, "*");
newXSproto("re::is_regexp", XS_re_is_regexp, file, "$");
newXSproto("re::regname", XS_re_regname, file, ";$$");
newXSproto("re::regnames", XS_re_regnames, file, ";$");
@@ -1131,6 +1133,23 @@ XS(XS_Internals_HvREHASH) /* Subject to change */
Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
}
+XS(XS_Internals_untaintfh)
+{
+ dVAR;
+ dXSARGS;
+ struct io *handle;
+
+ if (items != 1)
+ croak_xs_usage(cv, "io handle");
+
+ handle = sv_2io(ST(0));
+ if (IoFLAGS(handle) & IOf_UNTAINT)
+ XSRETURN(0);
+
+ IoFLAGS(handle) |= IOf_UNTAINT;
+ XSRETURN(1);
+}
+
XS(XS_re_is_regexp)
{
dVAR;
--
1.6.5.2 |
From @nwc10On Wed, Jan 20, 2010 at 05:10:09PM +0100, Lubomir Rintel (GoodData) wrote:
This doesn't look right. XSRETURN() is a macro to indicate the number of The intent seems to be to ensure that the file handle is not tainted The interface isn't consistent with most of the analogous XS "Internals" Nicholas Clark |
From lubo.rintel@gooddata.comOn Thu, 2010-01-21 at 11:54 +0100, Lubomir Rintel (GoodData) wrote:
Compared to other Internals:: subroutines in universal.c, I did not Thanks, |
From lubo.rintel@gooddata.comDATA handle is untainted on startup, but as we close and reopen it it This was probably broken by changeset 29606, (c96b238 in perl git). dist/SelfLoader/lib/SelfLoader.pm | 3 ++- Inline Patchdiff --git a/dist/SelfLoader/lib/SelfLoader.pm b/dist/SelfLoader/lib/SelfLoader.pm
index 047f776..ac69a01 100644
--- a/dist/SelfLoader/lib/SelfLoader.pm
+++ b/dist/SelfLoader/lib/SelfLoader.pm
@@ -1,7 +1,7 @@
package SelfLoader;
use 5.008;
use strict;
-our $VERSION = "1.17";
+our $VERSION = "1.18";
# The following bit of eval-magic is necessary to make this work on
# perls < 5.009005.
@@ -102,6 +102,7 @@ sub _load_stubs {
close $fh or die "close: $!"; # autocloses, but be paranoid
open $fh, '<&', $nfh or croak "reopen2: $!"; # dup() the fd "back"
close $nfh or die "close after reopen: $!"; # autocloses, but be paranoid
+ #Internals::untaintfh($fh, 1);
}
$Cache{"${currpack}::<DATA"} = 1; # indicate package is cached
diff --git a/lib/SelfLoader.t b/lib/SelfLoader.t
new file mode 100644
index 0000000..d14184a
--- /dev/null
+++ b/lib/SelfLoader.t
@@ -0,0 +1,20 @@
+#!./perl -Tw
+
+use strict;
+use Test::More tests => 4;
+
+use_ok('SelfLoader');
+is(routine (), 1, "Can call self-loaded subroutine");
+
+package pkg;
+Test::More::is(routine (), 2, "Can self-load subroutine from another package");
+
+package main;
+is(pkg::routine2 (), 3, "Can self-load other package's routine");
+
+__DATA__
+sub routine { return 1; }
+
+package pkg;
+sub routine { return 2; }
+sub routine2 { return 3; }
diff --git a/universal.c b/universal.c
index 5a2cddb..9cd2da5 100644
--- a/universal.c
+++ b/universal.c
@@ -241,6 +241,7 @@ XS(XS_PerlIO_get_layers);
XS(XS_Internals_hash_seed);
XS(XS_Internals_rehash_seed);
XS(XS_Internals_HvREHASH);
+XS(XS_Internals_untaintfh);
XS(XS_re_is_regexp);
XS(XS_re_regname);
XS(XS_re_regnames);
@@ -310,6 +311,7 @@ Perl_boot_core_UNIVERSAL(pTHX)
newXSproto("Internals::hash_seed",XS_Internals_hash_seed, file, "");
newXSproto("Internals::rehash_seed",XS_Internals_rehash_seed, file, "");
newXSproto("Internals::HvREHASH", XS_Internals_HvREHASH, file, "\\%");
+ newXSproto("Internals::untaintfh", XS_Internals_untaintfh, file, "*$");
newXSproto("re::is_regexp", XS_re_is_regexp, file, "$");
newXSproto("re::regname", XS_re_regname, file, ";$$");
newXSproto("re::regnames", XS_re_regnames, file, ";$");
@@ -1131,6 +1133,35 @@ XS(XS_Internals_HvREHASH) /* Subject to change */
Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
}
+XS(XS_Internals_untaintfh)
+{
+ dVAR;
+ dXSARGS;
+ struct io *handle;
+
+ handle = sv_2io(ST(0));
+ if (items == 1) {
+ /* Query whether handle is tainted */
+ if (IoFLAGS(handle) & IOf_UNTAINT)
+ XSRETURN_YES;
+ else
+ XSRETURN_NO;
+ }
+ else if (items == 2) {
+ /* Set or unset handle's UNTAINT flag */
+ if (SvTRUE(ST(1))) {
+ IoFLAGS(handle) |= IOf_UNTAINT;
+ XSRETURN_YES;
+ }
+ else {
+ IoFLAGS(handle) &= ~IOf_UNTAINT;
+ XSRETURN_NO;
+ }
+ }
+
+ XSRETURN_UNDEF; /* Prototype prevents reaching this */
+}
+
XS(XS_re_is_regexp)
{
dVAR;
--
1.6.5.2 |
From @tonycozOn Thu, Jan 21, 2010 at 11:58:04AM +0100, Lubomir Rintel wrote:
PERL_UNUSED_ARG(cv) does whatever magic is needed to prevent the NOTE(ARGUNUSED(cv)) is only compiled in when passing the code through So you still need it. Tony |
From lubo.rintel@gooddata.comDATA handle is untainted on startup, but as we close and reopen it it This was probably broken by changeset 29606, (c96b238 in perl git). dist/SelfLoader/lib/SelfLoader.pm | 3 ++- Inline Patchdiff --git a/dist/SelfLoader/lib/SelfLoader.pm b/dist/SelfLoader/lib/SelfLoader.pm
index 047f776..ac69a01 100644
--- a/dist/SelfLoader/lib/SelfLoader.pm
+++ b/dist/SelfLoader/lib/SelfLoader.pm
@@ -1,7 +1,7 @@
package SelfLoader;
use 5.008;
use strict;
-our $VERSION = "1.17";
+our $VERSION = "1.18";
# The following bit of eval-magic is necessary to make this work on
# perls < 5.009005.
@@ -102,6 +102,7 @@ sub _load_stubs {
close $fh or die "close: $!"; # autocloses, but be paranoid
open $fh, '<&', $nfh or croak "reopen2: $!"; # dup() the fd "back"
close $nfh or die "close after reopen: $!"; # autocloses, but be paranoid
+ #Internals::untaintfh($fh, 1);
}
$Cache{"${currpack}::<DATA"} = 1; # indicate package is cached
diff --git a/lib/SelfLoader.t b/lib/SelfLoader.t
new file mode 100644
index 0000000..d14184a
--- /dev/null
+++ b/lib/SelfLoader.t
@@ -0,0 +1,20 @@
+#!./perl -Tw
+
+use strict;
+use Test::More tests => 4;
+
+use_ok('SelfLoader');
+is(routine (), 1, "Can call self-loaded subroutine");
+
+package pkg;
+Test::More::is(routine (), 2, "Can self-load subroutine from another package");
+
+package main;
+is(pkg::routine2 (), 3, "Can self-load other package's routine");
+
+__DATA__
+sub routine { return 1; }
+
+package pkg;
+sub routine { return 2; }
+sub routine2 { return 3; }
diff --git a/universal.c b/universal.c
index 5a2cddb..8e44925 100644
--- a/universal.c
+++ b/universal.c
@@ -241,6 +241,7 @@ XS(XS_PerlIO_get_layers);
XS(XS_Internals_hash_seed);
XS(XS_Internals_rehash_seed);
XS(XS_Internals_HvREHASH);
+XS(XS_Internals_untaintfh);
XS(XS_re_is_regexp);
XS(XS_re_regname);
XS(XS_re_regnames);
@@ -310,6 +311,7 @@ Perl_boot_core_UNIVERSAL(pTHX)
newXSproto("Internals::hash_seed",XS_Internals_hash_seed, file, "");
newXSproto("Internals::rehash_seed",XS_Internals_rehash_seed, file, "");
newXSproto("Internals::HvREHASH", XS_Internals_HvREHASH, file, "\\%");
+ newXSproto("Internals::untaintfh", XS_Internals_untaintfh, file, "*$");
newXSproto("re::is_regexp", XS_re_is_regexp, file, "$");
newXSproto("re::regname", XS_re_regname, file, ";$$");
newXSproto("re::regnames", XS_re_regnames, file, ";$");
@@ -1131,6 +1133,36 @@ XS(XS_Internals_HvREHASH) /* Subject to change */
Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
}
+XS(XS_Internals_untaintfh)
+{
+ dVAR;
+ dXSARGS;
+ struct io *handle;
+ PERL_UNUSED_ARG(cv);
+
+ handle = sv_2io(ST(0));
+ if (items == 1) {
+ /* Query whether handle is tainted */
+ if (IoFLAGS(handle) & IOf_UNTAINT)
+ XSRETURN_YES;
+ else
+ XSRETURN_NO;
+ }
+ else if (items == 2) {
+ /* Set or unset handle's UNTAINT flag */
+ if (SvTRUE(ST(1))) {
+ IoFLAGS(handle) |= IOf_UNTAINT;
+ XSRETURN_YES;
+ }
+ else {
+ IoFLAGS(handle) &= ~IOf_UNTAINT;
+ XSRETURN_NO;
+ }
+ }
+
+ XSRETURN_UNDEF; /* Prototype prevents reaching this */
+}
+
XS(XS_re_is_regexp)
{
dVAR;
--
1.6.5.2 |
From lubo.rintel@gooddata.comOn Thu Jan 21 05:18:10 2010, tonyc wrote:
Thank you. Attaching a new patch which has it. |
From @tonycozOn Thu, Jan 21, 2010 at 02:54:04PM +0100, Lubomir Rintel (GoodData) wrote:
Should this be commented out? Tony |
From lubo.rintel@gooddata.comDATA handle is untainted on startup, but as we close and reopen it it This was probably broken by changeset 29606, (c96b238 in perl git). dist/SelfLoader/lib/SelfLoader.pm | 3 ++- Inline Patchdiff --git a/dist/SelfLoader/lib/SelfLoader.pm b/dist/SelfLoader/lib/SelfLoader.pm
index 047f776..ac69a01 100644
--- a/dist/SelfLoader/lib/SelfLoader.pm
+++ b/dist/SelfLoader/lib/SelfLoader.pm
@@ -1,7 +1,7 @@
package SelfLoader;
use 5.008;
use strict;
-our $VERSION = "1.17";
+our $VERSION = "1.18";
# The following bit of eval-magic is necessary to make this work on
# perls < 5.009005.
@@ -102,6 +102,7 @@ sub _load_stubs {
close $fh or die "close: $!"; # autocloses, but be paranoid
open $fh, '<&', $nfh or croak "reopen2: $!"; # dup() the fd "back"
close $nfh or die "close after reopen: $!"; # autocloses, but be paranoid
+ #Internals::untaintfh($fh, 1);
}
$Cache{"${currpack}::<DATA"} = 1; # indicate package is cached
diff --git a/lib/SelfLoader.t b/lib/SelfLoader.t
new file mode 100644
index 0000000..d14184a
--- /dev/null
+++ b/lib/SelfLoader.t
@@ -0,0 +1,20 @@
+#!./perl -Tw
+
+use strict;
+use Test::More tests => 4;
+
+use_ok('SelfLoader');
+is(routine (), 1, "Can call self-loaded subroutine");
+
+package pkg;
+Test::More::is(routine (), 2, "Can self-load subroutine from another package");
+
+package main;
+is(pkg::routine2 (), 3, "Can self-load other package's routine");
+
+__DATA__
+sub routine { return 1; }
+
+package pkg;
+sub routine { return 2; }
+sub routine2 { return 3; }
diff --git a/universal.c b/universal.c
index 5a2cddb..8e44925 100644
--- a/universal.c
+++ b/universal.c
@@ -241,6 +241,7 @@ XS(XS_PerlIO_get_layers);
XS(XS_Internals_hash_seed);
XS(XS_Internals_rehash_seed);
XS(XS_Internals_HvREHASH);
+XS(XS_Internals_untaintfh);
XS(XS_re_is_regexp);
XS(XS_re_regname);
XS(XS_re_regnames);
@@ -310,6 +311,7 @@ Perl_boot_core_UNIVERSAL(pTHX)
newXSproto("Internals::hash_seed",XS_Internals_hash_seed, file, "");
newXSproto("Internals::rehash_seed",XS_Internals_rehash_seed, file, "");
newXSproto("Internals::HvREHASH", XS_Internals_HvREHASH, file, "\\%");
+ newXSproto("Internals::untaintfh", XS_Internals_untaintfh, file, "*$");
newXSproto("re::is_regexp", XS_re_is_regexp, file, "$");
newXSproto("re::regname", XS_re_regname, file, ";$$");
newXSproto("re::regnames", XS_re_regnames, file, ";$");
@@ -1131,6 +1133,36 @@ XS(XS_Internals_HvREHASH) /* Subject to change */
Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
}
+XS(XS_Internals_untaintfh)
+{
+ dVAR;
+ dXSARGS;
+ struct io *handle;
+ PERL_UNUSED_ARG(cv);
+
+ handle = sv_2io(ST(0));
+ if (items == 1) {
+ /* Query whether handle is tainted */
+ if (IoFLAGS(handle) & IOf_UNTAINT)
+ XSRETURN_YES;
+ else
+ XSRETURN_NO;
+ }
+ else if (items == 2) {
+ /* Set or unset handle's UNTAINT flag */
+ if (SvTRUE(ST(1))) {
+ IoFLAGS(handle) |= IOf_UNTAINT;
+ XSRETURN_YES;
+ }
+ else {
+ IoFLAGS(handle) &= ~IOf_UNTAINT;
+ XSRETURN_NO;
+ }
+ }
+
+ XSRETURN_UNDEF; /* Prototype prevents reaching this */
+}
+
XS(XS_re_is_regexp)
{
dVAR;
--
1.6.5.2 |
From lubo.rintel@gooddata.comDATA handle is untainted on startup, but as we close and reopen it it This was probably broken by changeset 29606, (c96b238 in perl git). dist/SelfLoader/lib/SelfLoader.pm | 3 ++- Inline Patchdiff --git a/dist/SelfLoader/lib/SelfLoader.pm b/dist/SelfLoader/lib/SelfLoader.pm
index 047f776..d6c8499 100644
--- a/dist/SelfLoader/lib/SelfLoader.pm
+++ b/dist/SelfLoader/lib/SelfLoader.pm
@@ -1,7 +1,7 @@
package SelfLoader;
use 5.008;
use strict;
-our $VERSION = "1.17";
+our $VERSION = "1.18";
# The following bit of eval-magic is necessary to make this work on
# perls < 5.009005.
@@ -102,6 +102,7 @@ sub _load_stubs {
close $fh or die "close: $!"; # autocloses, but be paranoid
open $fh, '<&', $nfh or croak "reopen2: $!"; # dup() the fd "back"
close $nfh or die "close after reopen: $!"; # autocloses, but be paranoid
+ Internals::untaintfh($fh, 1);
}
$Cache{"${currpack}::<DATA"} = 1; # indicate package is cached
diff --git a/lib/SelfLoader.t b/lib/SelfLoader.t
new file mode 100644
index 0000000..d14184a
--- /dev/null
+++ b/lib/SelfLoader.t
@@ -0,0 +1,20 @@
+#!./perl -Tw
+
+use strict;
+use Test::More tests => 4;
+
+use_ok('SelfLoader');
+is(routine (), 1, "Can call self-loaded subroutine");
+
+package pkg;
+Test::More::is(routine (), 2, "Can self-load subroutine from another package");
+
+package main;
+is(pkg::routine2 (), 3, "Can self-load other package's routine");
+
+__DATA__
+sub routine { return 1; }
+
+package pkg;
+sub routine { return 2; }
+sub routine2 { return 3; }
diff --git a/universal.c b/universal.c
index 5a2cddb..8e44925 100644
--- a/universal.c
+++ b/universal.c
@@ -241,6 +241,7 @@ XS(XS_PerlIO_get_layers);
XS(XS_Internals_hash_seed);
XS(XS_Internals_rehash_seed);
XS(XS_Internals_HvREHASH);
+XS(XS_Internals_untaintfh);
XS(XS_re_is_regexp);
XS(XS_re_regname);
XS(XS_re_regnames);
@@ -310,6 +311,7 @@ Perl_boot_core_UNIVERSAL(pTHX)
newXSproto("Internals::hash_seed",XS_Internals_hash_seed, file, "");
newXSproto("Internals::rehash_seed",XS_Internals_rehash_seed, file, "");
newXSproto("Internals::HvREHASH", XS_Internals_HvREHASH, file, "\\%");
+ newXSproto("Internals::untaintfh", XS_Internals_untaintfh, file, "*$");
newXSproto("re::is_regexp", XS_re_is_regexp, file, "$");
newXSproto("re::regname", XS_re_regname, file, ";$$");
newXSproto("re::regnames", XS_re_regnames, file, ";$");
@@ -1131,6 +1133,36 @@ XS(XS_Internals_HvREHASH) /* Subject to change */
Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
}
+XS(XS_Internals_untaintfh)
+{
+ dVAR;
+ dXSARGS;
+ struct io *handle;
+ PERL_UNUSED_ARG(cv);
+
+ handle = sv_2io(ST(0));
+ if (items == 1) {
+ /* Query whether handle is tainted */
+ if (IoFLAGS(handle) & IOf_UNTAINT)
+ XSRETURN_YES;
+ else
+ XSRETURN_NO;
+ }
+ else if (items == 2) {
+ /* Set or unset handle's UNTAINT flag */
+ if (SvTRUE(ST(1))) {
+ IoFLAGS(handle) |= IOf_UNTAINT;
+ XSRETURN_YES;
+ }
+ else {
+ IoFLAGS(handle) &= ~IOf_UNTAINT;
+ XSRETURN_NO;
+ }
+ }
+
+ XSRETURN_UNDEF; /* Prototype prevents reaching this */
+}
+
XS(XS_re_is_regexp)
{
dVAR;
--
1.6.5.2 |
From lubo.rintel@gooddata.comFrom: Lubomir Rintel (GoodData) <lubo.rintel@gooddata.com> DATA handle is untainted on startup, but as we close and reopen it it This was probably broken by changeset 29606, (c96b238 in perl git). dist/SelfLoader/lib/SelfLoader.pm | 3 ++- Inline Patchdiff --git a/dist/SelfLoader/lib/SelfLoader.pm b/dist/SelfLoader/lib/SelfLoader.pm
index 047f776..d6c8499 100644
--- a/dist/SelfLoader/lib/SelfLoader.pm
+++ b/dist/SelfLoader/lib/SelfLoader.pm
@@ -1,7 +1,7 @@
package SelfLoader;
use 5.008;
use strict;
-our $VERSION = "1.17";
+our $VERSION = "1.18";
# The following bit of eval-magic is necessary to make this work on
# perls < 5.009005.
@@ -102,6 +102,7 @@ sub _load_stubs {
close $fh or die "close: $!"; # autocloses, but be paranoid
open $fh, '<&', $nfh or croak "reopen2: $!"; # dup() the fd "back"
close $nfh or die "close after reopen: $!"; # autocloses, but be paranoid
+ Internals::untaintfh($fh, 1);
}
$Cache{"${currpack}::<DATA"} = 1; # indicate package is cached
diff --git a/lib/SelfLoader.t b/lib/SelfLoader.t
new file mode 100644
index 0000000..d14184a
--- /dev/null
+++ b/lib/SelfLoader.t
@@ -0,0 +1,20 @@
+#!./perl -Tw
+
+use strict;
+use Test::More tests => 4;
+
+use_ok('SelfLoader');
+is(routine (), 1, "Can call self-loaded subroutine");
+
+package pkg;
+Test::More::is(routine (), 2, "Can self-load subroutine from another package");
+
+package main;
+is(pkg::routine2 (), 3, "Can self-load other package's routine");
+
+__DATA__
+sub routine { return 1; }
+
+package pkg;
+sub routine { return 2; }
+sub routine2 { return 3; }
diff --git a/universal.c b/universal.c
index ce56d0b..4fa214f 100644
--- a/universal.c
+++ b/universal.c
@@ -241,6 +241,7 @@ XS(XS_PerlIO_get_layers);
XS(XS_Internals_hash_seed);
XS(XS_Internals_rehash_seed);
XS(XS_Internals_HvREHASH);
+XS(XS_Internals_untaintfh);
XS(XS_re_is_regexp);
XS(XS_re_regname);
XS(XS_re_regnames);
@@ -310,6 +311,7 @@ Perl_boot_core_UNIVERSAL(pTHX)
newXSproto("Internals::hash_seed",XS_Internals_hash_seed, file, "");
newXSproto("Internals::rehash_seed",XS_Internals_rehash_seed, file, "");
newXSproto("Internals::HvREHASH", XS_Internals_HvREHASH, file, "\\%");
+ newXSproto("Internals::untaintfh", XS_Internals_untaintfh, file, "*$");
newXSproto("re::is_regexp", XS_re_is_regexp, file, "$");
newXSproto("re::regname", XS_re_regname, file, ";$$");
newXSproto("re::regnames", XS_re_regnames, file, ";$");
@@ -1131,6 +1133,36 @@ XS(XS_Internals_HvREHASH) /* Subject to change */
Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
}
+XS(XS_Internals_untaintfh)
+{
+ dVAR;
+ dXSARGS;
+ struct io *handle;
+ PERL_UNUSED_ARG(cv);
+
+ handle = sv_2io(ST(0));
+ if (items == 1) {
+ /* Query whether handle is tainted */
+ if (IoFLAGS(handle) & IOf_UNTAINT)
+ XSRETURN_YES;
+ else
+ XSRETURN_NO;
+ }
+ else if (items == 2) {
+ /* Set or unset handle's UNTAINT flag */
+ if (SvTRUE(ST(1))) {
+ IoFLAGS(handle) |= IOf_UNTAINT;
+ XSRETURN_YES;
+ }
+ else {
+ IoFLAGS(handle) &= ~IOf_UNTAINT;
+ XSRETURN_NO;
+ }
+ }
+
+ XSRETURN_UNDEF; /* Prototype prevents reaching this */
+}
+
XS(XS_re_is_regexp)
{
dVAR;
--
1.7.0.1 |
From @avarMabye instead of adding Internals::untaintfh (which is bound to get Taint::Util probably doesn't do IOf_UNTAINT support yet, but it would |
From @rgarciaOn 22 April 2010 18:49, Ævar Arnfjörð Bjarmason <avarab@gmail.com> wrote:
Is it not possible to use IO::Handle->untaint here ? |
From @avarOn Mon, Apr 26, 2010 at 10:09, Rafael Garcia-Suarez <rgs@consttype.org> wrote:
Not for this part of the patch: IoFLAGS(handle) &= ~IOf_UNTAINT; but it should work for: IoFLAGS(handle) |= IOf_UNTAINT; |
From lubo.rintel@gooddata.comOn Mon, 2010-04-26 at 03:10 -0700, Rafael Garcia-Suarez via RT wrote:
In fact, it is. I thought you objected it? -- |
From @rgarciaOn 26 April 2010 12:44, Lubomir Rintel <lubo.rintel@gooddata.com> wrote:
Haha, looks like I can't make my mind about it. Or was it a subliminal I believe your Internals::untaintfh patch can go in. Do other porters |
From @nwc10On Mon, Apr 26, 2010 at 02:42:27PM +0200, Rafael Garcia-Suarez wrote:
Yes, roughly "Oh $deity, not more Internals::*"? Is it really unavoidable? Nicholas Clark |
From @rgarciaOn 26 April 2010 14:44, Nicholas Clark <nick@ccl4.org> wrote:
Depends where and how many side-effects we can expect by loading |
From lubo.rintel@gooddata.comOn Mon, 2010-04-26 at 15:03 +0200, Rafael Garcia-Suarez wrote:
I'm not sure which side effects are you talking about, would it be of -- |
From @ikegamiOn Tue, Apr 27, 2010 at 3:01 PM, Lubomir Rintel <lubo.rintel@gooddata.com>wrote:
Any. An example of a pre-5.12 side-effect of loading FileHandle: $ perl -e'STDOUT->foo' $ perl -MFileHandle -e'STDOUT->foo' Mind you, the side-effect in this particular case affected an aspect that $ perl -e'STDOUT->foo' $ perl -MFileHandle -e'STDOUT->foo' |
From @nwc10On Tue, Apr 27, 2010 at 04:15:47PM -0400, Eric Brine wrote:
Broke what? $ perl -MIO::File -le 'print IO::File->isa("IO::Handle")'1 Sure, the error message changes. But both FileHandle and IO::File are What breakage is there, unless code is making assumptions about the precise Nicholas Clark |
From @ikegamiOn Tue, Apr 27, 2010 at 4:30 PM, Nicholas Clark <nick@ccl4.org> wrote:
->isa can return differently 5.10.0: 5.12.0: I'm not saying that I care that it got changed. |
From lubo.rintel@gooddata.comI somehow lost track here. Was a consensus reached that there are any outstanding issues in the Thank you. |
From lubo.rintel@gooddata.comRefreshing the patch given it no longer applied. |
From lubo.rintel@gooddata.com0001-perl-72062-Untaint-DATA-after-it-s-reopened.patchFrom 1770a7f4ca824b344b0a79aa90edb02e3f29b73b Mon Sep 17 00:00:00 2001
From: Lubomir Rintel (GoodData) <lubo.rintel@gooddata.com>
Date: Mon, 11 Jan 2010 19:27:54 +0100
Subject: [PATCH] [perl #72062] Untaint DATA after it's reopened
DATA handle is untainted on startup, but as we close and reopen it it
gets the taint flag. It's safe to untaint it though, since we still hold
the file descriptor open and don't reassign it to another file.
This was probably broken by changeset 29606, (c96b2385 in perl git).
Regression test included.
---
dist/SelfLoader/lib/SelfLoader.pm | 3 ++-
lib/SelfLoader.t | 20 ++++++++++++++++++++
universal.c | 31 +++++++++++++++++++++++++++++++
3 files changed, 53 insertions(+), 1 deletions(-)
create mode 100644 lib/SelfLoader.t
diff --git a/dist/SelfLoader/lib/SelfLoader.pm b/dist/SelfLoader/lib/SelfLoader.pm
index 047f776..d6c8499 100644
--- a/dist/SelfLoader/lib/SelfLoader.pm
+++ b/dist/SelfLoader/lib/SelfLoader.pm
@@ -1,7 +1,7 @@
package SelfLoader;
use 5.008;
use strict;
-our $VERSION = "1.17";
+our $VERSION = "1.18";
# The following bit of eval-magic is necessary to make this work on
# perls < 5.009005.
@@ -102,6 +102,7 @@ sub _load_stubs {
close $fh or die "close: $!"; # autocloses, but be paranoid
open $fh, '<&', $nfh or croak "reopen2: $!"; # dup() the fd "back"
close $nfh or die "close after reopen: $!"; # autocloses, but be paranoid
+ Internals::untaintfh($fh, 1);
}
$Cache{"${currpack}::<DATA"} = 1; # indicate package is cached
diff --git a/lib/SelfLoader.t b/lib/SelfLoader.t
new file mode 100644
index 0000000..d14184a
--- /dev/null
+++ b/lib/SelfLoader.t
@@ -0,0 +1,20 @@
+#!./perl -Tw
+
+use strict;
+use Test::More tests => 4;
+
+use_ok('SelfLoader');
+is(routine (), 1, "Can call self-loaded subroutine");
+
+package pkg;
+Test::More::is(routine (), 2, "Can self-load subroutine from another package");
+
+package main;
+is(pkg::routine2 (), 3, "Can self-load other package's routine");
+
+__DATA__
+sub routine { return 1; }
+
+package pkg;
+sub routine { return 2; }
+sub routine2 { return 3; }
diff --git a/universal.c b/universal.c
index 07a0aa6..f93bad9 100644
--- a/universal.c
+++ b/universal.c
@@ -1015,6 +1015,36 @@ XS(XS_Internals_HvREHASH) /* Subject to change */
Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
}
+XS(XS_Internals_untaintfh)
+{
+ dVAR;
+ dXSARGS;
+ struct io *handle;
+ PERL_UNUSED_ARG(cv);
+
+ handle = sv_2io(ST(0));
+ if (items == 1) {
+ /* Query whether handle is tainted */
+ if (IoFLAGS(handle) & IOf_UNTAINT)
+ XSRETURN_YES;
+ else
+ XSRETURN_NO;
+ }
+ else if (items == 2) {
+ /* Set or unset handle's UNTAINT flag */
+ if (SvTRUE(ST(1))) {
+ IoFLAGS(handle) |= IOf_UNTAINT;
+ XSRETURN_YES;
+ }
+ else {
+ IoFLAGS(handle) &= ~IOf_UNTAINT;
+ XSRETURN_NO;
+ }
+ }
+
+ XSRETURN_UNDEF; /* Prototype prevents reaching this */
+}
+
XS(XS_re_is_regexp)
{
dVAR;
@@ -1517,6 +1547,7 @@ struct xsub_details details[] = {
{"Internals::hash_seed", XS_Internals_hash_seed, ""},
{"Internals::rehash_seed", XS_Internals_rehash_seed, ""},
{"Internals::HvREHASH", XS_Internals_HvREHASH, "\\%"},
+ {"Internals::untaintfh", XS_Internals_untaintfh, file, "*$"},
{"re::is_regexp", XS_re_is_regexp, "$"},
{"re::regname", XS_re_regname, ";$$"},
{"re::regnames", XS_re_regnames, ";$"},
--
1.7.1
|
From @cpansproutOn Mon Apr 26 05:44:37 2010, nicholas wrote:
Do you mind if I go ahead and apply this? I’m sure that if you are Anyway, this is the most efficient solution. I would not want to risk |
From @rgarciaOn 27 September 2010 02:14, Father Chrysostomos via RT
I have no strong objection, except that probably Internals::untaintfh Then of course we have the bikeshed issue of "no more Internals:: |
From @nwc10On Mon, Sep 27, 2010 at 12:11:15PM +0200, Rafael Garcia-Suarez wrote:
Yes, but equally well it could be an IO function. And we *do* have an IO I believe that it should go in IO. Nicholas Clark |
From lubo.rintel@gooddata.comOn Mon Sep 27 03:15:59 2010, nicholas wrote:
Would appropriate fix involving IO be any different from the first patch http://rt.perl.org/rt3/Ticket/Display.html?id=72062#txn-649184 |
From @cpansproutOn Wed Oct 13 04:36:40 2010, lkundrak wrote:
No. I have applied it as a3a44df. Thank |
|
@cpansprout - Status changed from 'open' to 'resolved' |
From @cpansproutOn Thu Oct 21 06:00:36 2010, sprout wrote:
Could you provide a test case? The one included in your most recent |
From @cpansproutOn Sun Oct 24 13:30:35 2010, sprout wrote:
I was wrong. I was piping the tests through STDIN, which was why they |
Migrated from rt.perl.org#72062 (status was 'resolved')
Searchable as RT72062$
The text was updated successfully, but these errors were encountered: