diff --git a/include/znc/Modules.h b/include/znc/Modules.h index 7320912d..c27bb86b 100644 --- a/include/znc/Modules.h +++ b/include/znc/Modules.h @@ -1327,7 +1327,7 @@ class CModule { * stopped supporting it. Note that it's not a strict toggle: e.g. * sometimes client will disable the cap even when it was already disabled * for that client. - * For python modules, this function accepts 3 parameters: + * For perl and python modules, this function accepts 3 parameters: * name, server callback, client callback; signatures of the callbacks are * the same as of the virtual functions you'd implement in C++. */ @@ -1414,8 +1414,9 @@ class CModule { const CString& sContext = "") const; #endif - // Default implementations of several CAP callbacks to make + // Default implementations of several callbacks to make // AddServerDependentCapability work in modpython/modperl. + // Don't worry about existence of these functions. bool InternalServerDependentCapsOnServerCap302Available( const CString& sCap, const CString& sValue); void InternalServerDependentCapsOnServerCapResult(const CString& sCap, diff --git a/modules/modperl.cpp b/modules/modperl.cpp index 05878749..1a39b5a6 100644 --- a/modules/modperl.cpp +++ b/modules/modperl.cpp @@ -374,6 +374,41 @@ CPerlSocket::~CPerlSocket() { } } +CPerlCapability::~CPerlCapability() { + SvREFCNT_dec(m_serverCb); + SvREFCNT_dec(m_clientCb); +} + +void CPerlCapability::OnServerChangedSupport(CIRCNetwork* pNetwork, bool bState) { + PSTART; + PUSH_PTR(CIRCNetwork*, pNetwork); + mXPUSHi(bState); + PUTBACK; + ret = call_sv(m_serverCb, G_EVAL | G_ARRAY); + SPAGAIN; + SP -= ret; + ax = (SP - PL_stack_base) + 1; + if (SvTRUE(ERRSV)) { + DEBUG("Perl hook OnServerChangedSupport died with: " + PString(ERRSV)); + } + PEND; +} + +void CPerlCapability::OnClientChangedSupport(CClient* pClient, bool bState) { + PSTART; + PUSH_PTR(CClient*, pClient); + mXPUSHi(bState); + PUTBACK; + ret = call_sv(m_clientCb, G_EVAL | G_ARRAY); + SPAGAIN; + SP -= ret; + ax = (SP - PL_stack_base) + 1; + if (SvTRUE(ERRSV)) { + DEBUG("Perl hook OnServerChangedSupport died with: " + PString(ERRSV)); + } + PEND; +} + template <> void TModInfo(CModInfo& Info) { Info.SetWikiPage("modperl"); diff --git a/modules/modperl/modperl.i b/modules/modperl/modperl.i index 0d7583bd..a0d6dd99 100644 --- a/modules/modperl/modperl.i +++ b/modules/modperl/modperl.i @@ -189,6 +189,10 @@ class MCString : public std::map {}; bool ExistsNV(const CString& sName) { return $self->EndNV() != $self->FindNV(sName); } + void AddServerDependentCapability(const CString& sName, SV* serverCb, + SV* clientCb) { + $self->AddServerDependentCapability(sName, std::make_unique(serverCb, clientCb)); + } } %extend CModules { diff --git a/modules/modperl/module.h b/modules/modperl/module.h index 71a6469e..2c2e5c06 100644 --- a/modules/modperl/module.h +++ b/modules/modperl/module.h @@ -216,6 +216,20 @@ inline CPerlSocket* CreatePerlSocket(CPerlModule* pModule, SV* perlObj) { return new CPerlSocket(pModule, perlObj); } +class ZNC_EXPORT_LIB_EXPORT CPerlCapability : public CCapability { + public: + CPerlCapability(SV* serverCb, SV* clientCb) + : m_serverCb(newSVsv(serverCb)), m_clientCb(newSVsv(clientCb)) {} + ~CPerlCapability(); + + void OnServerChangedSupport(CIRCNetwork* pNetwork, bool bState) override; + void OnClientChangedSupport(CClient* pClient, bool bState) override; + + private: + SV* m_serverCb; + SV* m_clientCb; +}; + inline bool HaveIPv6() { #ifdef HAVE_IPV6 return true; diff --git a/test/integration/tests/core.cpp b/test/integration/tests/core.cpp index dbf5e044..7c90e90c 100644 --- a/test/integration/tests/core.cpp +++ b/test/integration/tests/core.cpp @@ -556,7 +556,7 @@ TEST_F(ZNCTest, CAP302LSValue) { class AllLanguages : public ZNCTest, public testing::WithParamInterface {}; -INSTANTIATE_TEST_CASE_P(LanguagesTests, AllLanguages, testing::Values(1, 2)); +INSTANTIATE_TEST_CASE_P(LanguagesTests, AllLanguages, testing::Values(1, 2, 3)); TEST_P(AllLanguages, ServerDependentCapInModule) { auto znc = Run(); @@ -607,6 +607,24 @@ TEST_P(AllLanguages, ServerDependentCapInModule) { "DISABLED_ZNC_PERL_PYTHON_TEST") == "1") { return; } + znc->CanLeak(); + InstallModule("testmod.pm", R"( + package testmod; + use base 'ZNC::Module'; + sub OnLoad { + my $self = shift; + my $listen = $self->AddServerDependentCapability('testcap', sub { + my ($net, $state) = @_; + $self->PutModule('Server changed support: ' . ($state ? 'true' : 'false')); + }, sub { + my ($client, $state) = @_; + $self->PutModule('Client changed support: ' . ($state ? 'true' : 'false')); + }); + return 1; + } + 1; + )"); + client.Write("znc loadmod modperl"); break; } client.Write("znc loadmod testmod");