path: root/main/perl-digest-sha1/perl-digest-sha1-check-object.patch
blob: 110ef42d7e3b9f4261bfc621075b9a6e787a7736 (plain) (tree)


The get_sha_info() function in SHA1.xs does not check that its argument
is an actual object.  This means that segfaults can be generated by
commands such as:

$ perl -Mblib -e "use Digest::SHA1; print Digest::SHA1->add(q(a))->hexdigest"
Segmentation fault

diff -Naur Digest-SHA1-2.13/SHA1.xs Digest-SHA1-2.13.patched/SHA1.xs
--- Digest-SHA1-2.13/SHA1.xs	2010-07-02 23:51:12.000000000 -0700
+++ Digest-SHA1-2.13.patched/SHA1.xs	2014-03-25 12:43:53.233272555 -0700
@@ -372,7 +372,7 @@
 static SHA_INFO* get_sha_info(pTHX_ SV* sv)
-    if (sv_derived_from(sv, "Digest::SHA1"))
+    if (sv_isobject(sv) && sv_derived_from(sv, "Digest::SHA1"))
 	return INT2PTR(SHA_INFO*, SvIV(SvRV(sv)));
     croak("Not a reference to a Digest::SHA1 object");
     return (SHA_INFO*)0; /* some compilers insist on a return value */