Bug #37045 for Net-SSH2: better patch with 5.6 support

This patch is compatible with 5.6, 5.8, 5.10 and blead. Fixed the tied interface for 5.6. In 5.6 you apparently have to set sv_magic on the gv not the io, but in later versions it has to be set on the io. I couldn't get an #if to work in the typemap so I'm just setting magic on both the gv and the io, and that seems to work fine. Rewrote all the malloc/memcpy/realloc stuff to use the XS memory APIs. My 5.6.2 couldn't even load the module before because it couldn't find Perl_mfree and such symbols, now it works. Please sanity check... Also a very minor change, added $ENV{HOME} to the check for libssh2 in Makefile.PL -- Rafael

diff -ruN Net-SSH2-0.18-kiubRr/Makefile.PL /home/rkitover/src/Net-SSH2-0.18/Makefile.PL --- Net-SSH2-0.18-kiubRr/Makefile.PL 2007-11-10 16:29:00.000000000 -0800 +++ /home/rkitover/src/Net-SSH2-0.18/Makefile.PL 2008-06-23 23:21:58.000000000 -0700 @@ -16,7 +16,7 @@ # try to find libSSH2 if we're not given a location unless($lib and $inc) { for my $prefix($Config{siteprefixexp},$Config{prefixexp}, - '/usr','/usr/local','/opt') { + '/usr','/usr/local','/opt',$ENV{HOME}) { $lib ||= "$prefix/lib" if -f "$prefix/lib/libssh2$Config{_a}" or -f "$prefix/lib/libssh2.$Config{so}"; diff -ruN Net-SSH2-0.18-kiubRr/SSH2.xs /home/rkitover/src/Net-SSH2-0.18/SSH2.xs --- Net-SSH2-0.18-kiubRr/SSH2.xs 2007-11-10 17:53:25.000000000 -0800 +++ /home/rkitover/src/Net-SSH2-0.18/SSH2.xs 2008-06-23 20:44:38.000000000 -0700 @@ -173,13 +173,15 @@ /* libssh2 allocator thunks */ LIBSSH2_ALLOC_FUNC(local_alloc) { - return Perl_malloc(count); + void *buf; + New(0, buf, count, char); + return buf; } LIBSSH2_REALLOC_FUNC(local_realloc) { - return Perl_realloc(ptr, count); + return Renew(ptr, count, char); } LIBSSH2_FREE_FUNC(local_free) { - Perl_mfree(ptr); + Safefree(ptr); } /* set Net:SSH2-specific error message */ @@ -349,8 +351,8 @@ /* single prompt, no echo: assume it's a password request */ pv_password = SvPV(ss->sv_tmp, len_password); - responses[0].text = Perl_malloc(len_password); - memcpy(responses[0].text, pv_password, len_password); + New(0, responses[0].text, len_password, char); + Copy(pv_password, responses[0].text, len_password, char); responses[0].length = len_password; } @@ -383,8 +385,8 @@ for (i = 0; i < count; ++i) { STRLEN len_response; const char* pv_response = SvPV(ST(i), len_response); - responses[i].text = Perl_malloc(len_response); - memcpy(responses[i].text, pv_response, len_response); + New(0, responses[i].text, len_response, char); + Copy(pv_response, responses[i].text, len_response, char); responses[i].length = len_response; } @@ -409,8 +411,8 @@ if (count > 0) { STRLEN len_password; const char* pv_password = SvPV(ST(0), len_password); - *newpw = Perl_malloc(len_password); - memcpy(*newpw, pv_password, len_password); + New(0, *newpw, len_password, char); + Copy(pv_password, *newpw, len_password, char); *newpw_len = len_password; } @@ -759,7 +761,7 @@ count = split_comma(sp, auth); else PUSHs(sv_2mortal(newSVpv(auth, 0))); - Perl_mfree(auth); + Safefree(auth); XSRETURN(count); void @@ -786,7 +788,7 @@ if (!password || !SvPOK(password)) { char* auth = libssh2_userauth_list(ss->session, pv_username, len_username); - Perl_mfree(auth); + Safefree(auth); XSRETURN_IV(!auth && libssh2_userauth_authenticated(ss->session)); } @@ -986,7 +988,10 @@ debug("%s::poll: timeout = %d, array[%d]\n", class, timeout, count); if (!count) // some architectures return null for malloc(0) XSRETURN_IV(0); - if (!(pollfd = Perl_malloc(sizeof(LIBSSH2_POLLFD) * count))) { + + New(0, pollfd, count, LIBSSH2_POLLFD); + + if (!pollfd) { set_error(ss, 0, "out of memory allocating pollfd structures"); XSRETURN_EMPTY; } @@ -1006,7 +1011,7 @@ debug("- [%d] = channel\n", i); pollfd[i].type = LIBSSH2_POLLFD_CHANNEL; pollfd[i].fd.channel = - ((SSH2_CHANNEL*)SvIVX(SvRV(*handle)))->channel; + ((SSH2_CHANNEL*)SvIVX(GvSV((GV*)SvRV(*handle))))->channel; } else if(strEQ(package, "Net::SSH2::Listener")) { debug("- [%d] = listener\n", i); pollfd[i].type = LIBSSH2_POLLFD_LISTENER; @@ -1046,7 +1051,7 @@ debug("- [%d] revents %d\n", i, pollfd[i].revents); } - Perl_mfree(pollfd); + Safefree(pollfd); if (changed < 0) XSRETURN_EMPTY; XSRETURN_IV(changed); @@ -1707,7 +1712,8 @@ pv_blob = SvPV(blob, len_blob); num_attrs = items - 4; - if (!(attrs = Perl_malloc(sizeof(*attrs) * num_attrs))) { + New(0, attrs, num_attrs, libssh2_publickey_attribute); + if (!attrs) { set_error(pk->ss, 0, "out of memory allocating attribute structures"); XSRETURN_EMPTY; } @@ -1740,7 +1746,7 @@ success = !libssh2_publickey_add_ex(pk->pkey, pv_name, len_name, pv_blob, len_blob, overwrite, num_attrs, attrs); - Perl_mfree(attrs); + Safefree(attrs); XSRETURN_IV(!success); void diff -ruN Net-SSH2-0.18-kiubRr/typemap /home/rkitover/src/Net-SSH2-0.18/typemap --- Net-SSH2-0.18-kiubRr/typemap 2007-02-24 07:15:23.000000000 -0800 +++ /home/rkitover/src/Net-SSH2-0.18/typemap 2008-06-23 23:17:25.000000000 -0700 @@ -29,10 +29,11 @@ const char* name = form("_GEN_%ld", (long)net_ch_gensym++); SvUPGRADE((SV*)gv, SVt_PVGV); SvUPGRADE((SV*)io, SVt_PVIO); - SvIVX(gv) = PTR2IV($var); gv_init(gv, gv_stashpv("Net::SSH2::Channel", 0/*create*/), name, strlen(name), 0/*multi*/); + GvSV(gv) = newSViv(PTR2IV($var)); GvIOp(gv) = io; + sv_magic((SV*)gv, newRV((SV*)gv), PERL_MAGIC_tiedscalar, Nullch, 0); sv_magic((SV*)io, newRV((SV*)gv), PERL_MAGIC_tiedscalar, Nullch, 0); } @@ -49,10 +50,11 @@ const char* name = form("_GEN_%ld", (long)net_fi_gensym++); SvUPGRADE((SV*)gv, SVt_PVGV); SvUPGRADE((SV*)io, SVt_PVIO); - SvIVX(gv) = PTR2IV($var); gv_init(gv, gv_stashpv("Net::SSH2::File", 0/*create*/), name, strlen(name), 0/*multi*/); + GvSV(gv) = newSViv(PTR2IV($var)); GvIOp(gv) = io; + sv_magic((SV*)gv, newRV((SV*)gv), PERL_MAGIC_tiedscalar, Nullch, 0); sv_magic((SV*)io, newRV((SV*)gv), PERL_MAGIC_tiedscalar, Nullch, 0); } @@ -80,7 +82,7 @@ O_CHANNEL if(sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVGV)) - $var = ($type)SvIVX((SV*)SvRV($arg)); + $var = ($type)SvIVX(GvSV((GV*)SvRV($arg))); else croak(\"${Package}::$func_name() - invalid channel object\"); @@ -98,7 +100,7 @@ O_FILE if(sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVGV)) - $var = ($type)SvIVX((SV*)SvRV($arg)); + $var = ($type)SvIVX(GvSV((GV*)SvRV($arg))); else croak(\"${Package}::$func_name() - invalid SFTP file object\");