SelfLoader: Untaint DATA after it's reopened

[p5pRT]

Migrated from rt.perl.org#72062 (status was 'resolved')

Searchable as RT72062$

[p5pRT]

From lubo.rintel@gooddata.com

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, (c96b238 in perl git).

---

lib/SelfLoader.pm | 4 +++-
1 files changed, 3 insertions(+), 1 deletions(-)

Inline Patch

diff --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

[p5pRT]

From lubo.rintel@gooddata.com

This was moved here form
https://rt.cpan.org/Public/Bug/Display.html?id=53607

[p5pRT]

From lubo.rintel@gooddata.com

On Wed Jan 13 05​:00​:50 2010, lkundrak wrote​:

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, (c96b238 in perl git).
---
lib/SelfLoader.pm | 4 +++-
1 files changed, 3 insertions(+), 1 deletions(-)

Any chance for anyone at p5p to review this?

Thanks

[p5pRT]

lubo.rintel@gooddata.com - Status changed from 'new' to 'open'

[p5pRT]

From @rgarcia

2010/1/13 Lubomir Rintel <perlbug-followup@​perl.org>​:

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, (c96b238 in perl git).
---
 lib/SelfLoader.pm |    4 +++-
 1 files changed, 3 insertions(+), 1 deletions(-)

diff --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;

I don't like silently loading IO​::Handle in such a low-level module.
What's missing is probably a way to untaint a FH without loading
IO​::Handle. (Like a new internal subroutine Internals​::untaintfh)

[p5pRT]

From @xdg

Which META ticket should this attach to? Is it a 5.12 blocker?

[p5pRT]

From @rgarcia

2010/1/19 David Golden via RT <perlbug-followup@​perl.org>​:

Which META ticket should this attach to?  Is it a 5.12 blocker?

No. I already commented that I didn't like the patch. We'll address
that after 5.12 is out.

[p5pRT]

From @xdg

On Wed, Jan 20, 2010 at 5​:08 AM, Rafael Garcia-Suarez <rgs@​consttype.org> wrote​:

2010/1/19 David Golden via RT <perlbug-followup@​perl.org>​:

Which META ticket should this attach to?  Is it a 5.12 blocker?

No. I already commented that I didn't like the patch. We'll address
that after 5.12 is out.

Not liking the patch and not blocking are two separate things. :-)

I'll add the ticket to the "non-critical bugs" meta ticket.

David

[p5pRT]

From lubo.rintel@gooddata.com

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, (c96b238 in perl git).
Regression test included.

---

dist/SelfLoader/lib/SelfLoader.pm | 3 ++-
lib/SelfLoader.t | 20 ++++++++++++++++++++
universal.c | 19 +++++++++++++++++++
3 files changed, 41 insertions(+), 1 deletions(-)
create mode 100644 lib/SelfLoader.t

Inline Patch

diff --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

[p5pRT]

From @nwc10

On Wed, Jan 20, 2010 at 05​:10​:09PM +0100, Lubomir Rintel (GoodData) wrote​:

+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);
+}

This doesn't look right. XSRETURN() is a macro to indicate the number of
items returned, not to return that value.

The intent seems to be to

ensure that the file handle is not tainted
return 1 if the file handle was tainted on entry
return 0 if the file handle was already not tainted

The interface isn't consistent with most of the analogous XS "Internals"
routines in universal.c, which return status if given 1 argument, and set
the status if given 2.

Nicholas Clark

[p5pRT]

From lubo.rintel@gooddata.com

On Thu, 2010-01-21 at 11​:54 +0100, Lubomir Rintel (GoodData) wrote​:

+XS(XS_Internals_untaintfh)
+{
+ dVAR;
+ dXSARGS;
+ struct io *handle;

Compared to other Internals​:: subroutines in universal.c, I did not
include PERL_UNUSED_ARG(cv) -- what exactly is it used for? dXSARGS
macro expands to NOTE(ARGUNUSED(cv)), isn't that sufficient?

Thanks,
--
Lubomir Rintel (GoodData)

[p5pRT]

From lubo.rintel@gooddata.com

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, (c96b238 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

Inline Patch

diff --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

[p5pRT]

From @tonycoz

On Thu, Jan 21, 2010 at 11​:58​:04AM +0100, Lubomir Rintel wrote​:

On Thu, 2010-01-21 at 11​:54 +0100, Lubomir Rintel (GoodData) wrote​:

+XS(XS_Internals_untaintfh)
+{
+ dVAR;
+ dXSARGS;
+ struct io *handle;

Compared to other Internals​:: subroutines in universal.c, I did not
include PERL_UNUSED_ARG(cv) -- what exactly is it used for? dXSARGS
macro expands to NOTE(ARGUNUSED(cv)), isn't that sufficient?

PERL_UNUSED_ARG(cv) does whatever magic is needed to prevent the
compiler from warning about cv as an unused argument.

NOTE(ARGUNUSED(cv)) is only compiled in when passing the code through
lint or splint.

So you still need it.

Tony

[p5pRT]

From lubo.rintel@gooddata.com

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, (c96b238 in perl git).
Regression test included.

---

dist/SelfLoader/lib/SelfLoader.pm | 3 ++-
lib/SelfLoader.t | 20 ++++++++++++++++++++
universal.c | 32 ++++++++++++++++++++++++++++++++
3 files changed, 54 insertions(+), 1 deletions(-)
create mode 100644 lib/SelfLoader.t

Inline Patch

diff --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

[p5pRT]

From lubo.rintel@gooddata.com

On Thu Jan 21 05​:18​:10 2010, tonyc wrote​:

On Thu, Jan 21, 2010 at 11​:58​:04AM +0100, Lubomir Rintel wrote​:

On Thu, 2010-01-21 at 11​:54 +0100, Lubomir Rintel (GoodData) wrote​:

+XS(XS_Internals_untaintfh)
+{
+ dVAR;
+ dXSARGS;
+ struct io *handle;

Compared to other Internals​:: subroutines in universal.c, I did not
include PERL_UNUSED_ARG(cv) -- what exactly is it used for? dXSARGS
macro expands to NOTE(ARGUNUSED(cv)), isn't that sufficient?

PERL_UNUSED_ARG(cv) does whatever magic is needed to prevent the
compiler from warning about cv as an unused argument.

NOTE(ARGUNUSED(cv)) is only compiled in when passing the code through
lint or splint.

Thank you. Attaching a new patch which has it.