[libyaml-perl] 01/02: Control blessing of loaded objects through an environment variable

[Christoph Biedl]

This is an automated email from the git hooks/post-receive script.

cbiedl-guest pushed a commit to branch yaml-unsafe
in repository libyaml-perl.

commit a401004cd67b079d4a942c0ada9faac68de9e406
Author: Christoph Biedl <debian.axhn at manchmal.in-ulm.de>
Date:   Fri May 19 15:25:35 2017 +0000

    Control blessing of loaded objects through an environment variable
---
 debian/patches/control-blessing.patch | 65 +++++++++++++++++++++++++++++++++++
 debian/patches/series                 |  1 +
 debian/rules                          |  2 ++
 3 files changed, 68 insertions(+)

diff --git a/debian/patches/control-blessing.patch b/debian/patches/control-blessing.patch
new file mode 100644
index 0000000..96b329d
--- /dev/null
+++ b/debian/patches/control-blessing.patch
@@ -0,0 +1,65 @@
+--- a/lib/YAML/Loader.pm
++++ b/lib/YAML/Loader.pm
+@@ -190,7 +190,7 @@
+                 undef $node;
+                 $node = \$copy;
+             }
+-            CORE::bless $node, $class;
++            CORE::bless $node, $class if $ENV{'PERL_USE_UNSAFE_YAML'};
+         }
+         else {
+             $node = $self->_parse_explicit($node, $explicit);
+@@ -270,7 +270,7 @@
+         }
+ 
+         if ( length($class) ) {
+-            CORE::bless($node, $class);
++            CORE::bless($node, $class) if ($ENV{'PERL_USE_UNSAFE_YAML'});
+         }
+ 
+         return $node;
+@@ -295,7 +295,7 @@
+             require YAML::Node;
+             return $class->yaml_load(YAML::Node->new($node, $explicit));
+         }
+-        else {
++        elsif ($ENV{'PERL_USE_UNSAFE_YAML'}) {
+             if (ref $node) {
+                 return CORE::bless $node, $class;
+             }
+@@ -303,6 +303,9 @@
+                 return CORE::bless \$node, $class;
+             }
+         }
++        else {
++            return $node;
++        }
+     }
+     elsif (ref $node) {
+         require YAML::Node;
+--- a/lib/YAML/Types.pm
++++ b/lib/YAML/Types.pm
+@@ -166,12 +166,12 @@
+             return sub {};
+         }
+         else {
+-            CORE::bless $code, $class if $class;
++            CORE::bless $code, $class if $class && $ENV{'PERL_USE_UNSAFE_YAML'};
+             return $code;
+         }
+     }
+     else {
+-        return CORE::bless sub {}, $class if $class;
++        return CORE::bless sub {}, $class if $class && $ENV{'PERL_USE_UNSAFE_YAML'};
+         return sub {};
+     }
+ }
+@@ -228,7 +228,7 @@
+     $flags =~ s/^\^//;
+     my $sub = _QR_TYPES->{$flags} || sub { qr{$_[0]} };
+     my $qr = &$sub($re);
+-    bless $qr, $class if length $class;
++    bless $qr, $class if length $class && $ENV{'PERL_USE_UNSAFE_YAML'};
+     return $qr;
+ }
+ 
diff --git a/debian/patches/series b/debian/patches/series
index c130d18..bce7195 100644
--- a/debian/patches/series
+++ b/debian/patches/series
@@ -1 +1,2 @@
 ysh-location.patch
+control-blessing.patch
diff --git a/debian/rules b/debian/rules
index 2d33f6a..63558e3 100755
--- a/debian/rules
+++ b/debian/rules
@@ -1,4 +1,6 @@
 #!/usr/bin/make -f
 
+export PERL_USE_UNSAFE_YAML=1
+
 %:
 	dh $@

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libyaml-perl.git