diff --git a/modules/modperl.cpp b/modules/modperl.cpp index e1a66fc3..d41e1ae2 100644 --- a/modules/modperl.cpp +++ b/modules/modperl.cpp @@ -76,14 +76,13 @@ public: virtual EModRet OnModuleLoading(const CString& sModName, const CString& sArgs, CModInfo::EModuleType eType, bool& bSuccess, CString& sRetMsg) { - if (!GetUser() || eType != CModInfo::UserModule) { - return CONTINUE; - } EModRet result = HALT; PSTART; PUSH_STR(sModName); PUSH_STR(sArgs); + mXPUSHi(eType); PUSH_PTR(CUser*, GetUser()); + PUSH_PTR(CIRCNetwork*, GetNetwork()); PCALL("ZNC::Core::LoadModule"); if (SvTRUE(ERRSV)) { @@ -115,7 +114,7 @@ public: if (pMod) { CString sModName = pMod->GetModName(); PSTART; - PUSH_PTR(CPerlModule*, pMod); + XPUSHs(pMod->GetPerlObj()); PCALL("ZNC::Core::UnloadModule"); if (SvTRUE(ERRSV)) { bSuccess = false; @@ -135,6 +134,7 @@ public: bool& bSuccess, CString& sRetMsg) { PSTART; PUSH_STR(sModule); + PUSH_PTR(CModInfo*, &ModInfo); PCALL("ZNC::Core::GetModInfo"); EModRet result = CONTINUE; if (SvTRUE(ERRSV)) { @@ -147,13 +147,7 @@ public: break; case Perl_Loaded: result = HALT; - if (4 == ret) { - ModInfo.SetDefaultType(CModInfo::UserModule); - ModInfo.AddType(CModInfo::UserModule); - ModInfo.SetDescription(PString(ST(2))); - ModInfo.SetName(sModule); - ModInfo.SetPath(PString(ST(1))); - ModInfo.SetWikiPage(PString(ST(3))); + if (1 == ret) { bSuccess = true; } else { bSuccess = false; @@ -175,14 +169,10 @@ public: sRetMsg = "Something weird happened"; } PEND; - DEBUG(__PRETTY_FUNCTION__ << " " << sRetMsg); return result; } virtual void OnGetAvailableMods(set& ssMods, CModInfo::EModuleType eType) { - if (eType != CModInfo::UserModule) { - return; - } unsigned int a = 0; CDir Dir; @@ -202,13 +192,9 @@ public: PSTART; PUSH_STR(sPath); PUSH_STR(sName); + PUSH_PTR(CModInfo*, &ModInfo); PCALL("ZNC::Core::ModInfoByPath"); if (!SvTRUE(ERRSV) && ret == 2) { - ModInfo.AddType(CModInfo::UserModule); - ModInfo.SetDescription(PString(ST(0))); - ModInfo.SetName(sName); - ModInfo.SetPath(sPath); - ModInfo.SetWikiPage(PString(ST(1))); ssMods.insert(ModInfo); } PEND; @@ -243,8 +229,7 @@ void CPerlTimer::RunJob() { CPerlModule* pMod = AsPerlModule(GetModule()); if (pMod) { PSTART; - PUSH_STR(pMod->GetPerlID()); - PUSH_STR(GetPerlID()); + XPUSHs(GetPerlObj()); PCALL("ZNC::Core::CallTimer"); PEND; } @@ -254,14 +239,13 @@ CPerlTimer::~CPerlTimer() { CPerlModule* pMod = AsPerlModule(GetModule()); if (pMod) { PSTART; - PUSH_STR(pMod->GetPerlID()); - PUSH_STR(GetPerlID()); + XPUSHs(sv_2mortal(m_perlObj)); PCALL("ZNC::Core::RemoveTimer"); PEND; } } -#define SOCKSTART PSTART; PUSH_STR(pMod->GetPerlID()); PUSH_STR(GetPerlID()) +#define SOCKSTART PSTART; XPUSHs(GetPerlObj()) #define SOCKCBCHECK(OnSuccess) PCALL("ZNC::Core::CallSocket"); if (SvTRUE(ERRSV)) { Close(); DEBUG("Perl socket hook died with: " + PString(ERRSV)); } else { OnSuccess; } PEND #define CBSOCK(Func) void CPerlSocket::Func() {\ CPerlModule* pMod = AsPerlModule(GetModule());\ @@ -313,7 +297,8 @@ Csock* CPerlSocket::GetSockObj(const CString& sHost, unsigned short uPort) { CPerlSocket::~CPerlSocket() { CPerlModule* pMod = AsPerlModule(GetModule()); if (pMod) { - SOCKSTART; + PSTART; + XPUSHs(sv_2mortal(m_perlObj)); PCALL("ZNC::Core::RemoveSocket"); PEND; } diff --git a/modules/modperl/codegen.pl b/modules/modperl/codegen.pl index 0e4bf138..d27e46a0 100755 --- a/modules/modperl/codegen.pl +++ b/modules/modperl/codegen.pl @@ -64,7 +64,7 @@ namespace { #define PUSH_STR(s) XPUSHs(PString(s).GetSV()) #define PUSH_PTR(type, p) XPUSHs(SWIG_NewInstanceObj(const_cast(p), SWIG_TypeQuery(#type), SWIG_SHADOW)) */ -#define PSTART_IDF(Func) PSTART; PUSH_STR(GetPerlID()); PUSH_STR(#Func) +#define PSTART_IDF(Func) PSTART; XPUSHs(GetPerlObj()); PUSH_STR(#Func) #define PCALLMOD(Error, Success) PCALL("ZNC::Core::CallModFunc"); if (SvTRUE(ERRSV)) { DEBUG("Perl hook died with: " + PString(ERRSV)); Error; } else { Success; } PEND EOF diff --git a/modules/modperl/modperl.i b/modules/modperl/modperl.i index b7394e21..c62cd334 100644 --- a/modules/modperl/modperl.i +++ b/modules/modperl/modperl.i @@ -24,6 +24,7 @@ #include "../include/znc/Nick.h" #include "../include/znc/Chan.h" #include "../include/znc/User.h" +#include "../include/znc/IRCNetwork.h" #include "../include/znc/Client.h" #include "../include/znc/IRCSock.h" #include "../include/znc/Listener.h" @@ -87,6 +88,7 @@ namespace std { %include "../include/znc/Nick.h" %include "../include/znc/Chan.h" %include "../include/znc/User.h" +%include "../include/znc/IRCNetwork.h" %include "../include/znc/Client.h" %include "../include/znc/IRCSock.h" %include "../include/znc/Listener.h" diff --git a/modules/modperl/module.h b/modules/modperl/module.h index 22c0ec37..a88efd5d 100644 --- a/modules/modperl/module.h +++ b/modules/modperl/module.h @@ -8,21 +8,27 @@ #pragma once +#include +#include +#include + #include #if HAVE_VISIBILITY #pragma GCC visibility push(default) #endif class CPerlModule : public CModule { - CString m_sPerlID; + SV* m_perlObj; VWebSubPages* _GetSubPages(); public: CPerlModule(CUser* pUser, CIRCNetwork* pNetwork, const CString& sModName, const CString& sDataPath, - const CString& sPerlID) + SV* perlObj) : CModule(NULL, pUser, pNetwork, sModName, sDataPath) { - m_sPerlID = sPerlID; + m_perlObj = newSVsv(perlObj); + } + SV* GetPerlObj() { + return sv_2mortal(newSVsv(m_perlObj)); } - CString GetPerlID() { return m_sPerlID; } virtual bool OnBoot(); virtual bool WebRequiresLogin(); @@ -99,27 +105,31 @@ enum ELoadPerlMod { }; class CPerlTimer : public CTimer { - CString m_sPerlID; + SV* m_perlObj; public: - CPerlTimer(CPerlModule* pModule, unsigned int uInterval, unsigned int uCycles, const CString& sLabel, const CString& sDescription, const CString& sPerlID) - : CTimer (pModule, uInterval, uCycles, sLabel, sDescription), m_sPerlID(sPerlID) { + CPerlTimer(CPerlModule* pModule, unsigned int uInterval, unsigned int uCycles, const CString& sLabel, const CString& sDescription, SV* perlObj) + : CTimer (pModule, uInterval, uCycles, sLabel, sDescription), m_perlObj(newSVsv(perlObj)) { pModule->AddTimer(this); } virtual void RunJob(); - CString GetPerlID() { return m_sPerlID; } + SV* GetPerlObj() { + return sv_2mortal(newSVsv(m_perlObj)); + } ~CPerlTimer(); }; inline CPerlTimer* CreatePerlTimer(CPerlModule* pModule, unsigned int uInterval, unsigned int uCycles, - const CString& sLabel, const CString& sDescription, const CString& sPerlID) { - return new CPerlTimer(pModule, uInterval, uCycles, sLabel, sDescription, sPerlID); + const CString& sLabel, const CString& sDescription, SV* perlObj) { + return new CPerlTimer(pModule, uInterval, uCycles, sLabel, sDescription, perlObj); } class CPerlSocket : public CSocket { - CString m_sPerlID; + SV* m_perlObj; public: - CPerlSocket(CPerlModule* pModule, const CString& sPerlID) : CSocket(pModule), m_sPerlID(sPerlID) {} - CString GetPerlID() { return m_sPerlID; } + CPerlSocket(CPerlModule* pModule, SV* perlObj) : CSocket(pModule), m_perlObj(newSVsv(perlObj)) {} + SV* GetPerlObj() { + return sv_2mortal(newSVsv(m_perlObj)); + } ~CPerlSocket(); virtual void Connected(); virtual void Disconnected(); @@ -130,8 +140,8 @@ public: virtual Csock* GetSockObj(const CString& sHost, unsigned short uPort); }; -inline CPerlSocket* CreatePerlSocket(CPerlModule* pModule, const CString& sPerlID) { - return new CPerlSocket(pModule, sPerlID); +inline CPerlSocket* CreatePerlSocket(CPerlModule* pModule, SV* perlObj) { + return new CPerlSocket(pModule, perlObj); } inline bool HaveIPv6() { diff --git a/modules/modperl/startup.pl b/modules/modperl/startup.pl index 0e8cee5d..22e098e9 100644 --- a/modules/modperl/startup.pl +++ b/modules/modperl/startup.pl @@ -15,69 +15,40 @@ use feature 'switch', 'say'; package ZNC::Core; -my $uuidtype; -my $uuidgen; -our %pmods; my %modrefcount; +my @allmods; -sub Init { - if (eval { require Data::UUID }) { - $uuidtype = 'Data::UUID'; - $uuidgen = new Data::UUID; - } elsif (eval { require UUID }) { - $uuidtype = 'UUID'; - } else { - $uuidtype = 'int'; - $uuidgen = 0; - } -} - -sub CreateUUID { - my $res; - given ($uuidtype) { - when ('Data::UUID') { - $res = $uuidgen->create_str; +sub UnloadModule { + my ($pmod) = @_; + $pmod->OnShutdown; + @allmods = grep {$pmod != $_} @allmods; + my $cmod = $pmod->{_cmod}; + my $modpath = $cmod->GetModPath; + my $modname = $cmod->GetModName; + given ($cmod->GetType()) { + when ($ZNC::CModInfo::NetworkModule) { + $cmod->GetNetwork->GetModules->removeModule($cmod); } - when ('UUID') { - my ($uuid, $str); - UUID::generate($uuid); - UUID::unparse($uuid, $res); + when ($ZNC::CModInfo::UserModule) { + $cmod->GetUser->GetModules->removeModule($cmod); } - when ('int') { - $uuidgen++; - $res = "$uuidgen"; + when ($ZNC::CModInfo::GlobalModule) { + ZNC::CZNC::Get()->GetModules->removeModule($cmod); } } - say "Created new UUID for modperl with '$uuidtype': $res"; - return $res; -} - -sub unloadByIDUser { - my ($id, $user) = @_; - my $modpath = $pmods{$id}{_cmod}->GetModPath; - my $modname = $pmods{$id}{_cmod}->GetModName; - $pmods{$id}->OnShutdown; - $user->GetModules->removeModule($pmods{$id}{_cmod}); - delete $pmods{$id}{_cmod};# Just for the case - delete $pmods{$id}{_nv}; - delete $pmods{$id}{_ptimers}; - delete $pmods{$id}{_sockets}; - delete $pmods{$id}; + delete $pmod->{_cmod}; + delete $pmod->{_nv}; unless (--$modrefcount{$modname}) { say "Unloading $modpath from perl"; ZNC::_CleanupStash($modname); delete $INC{$modpath}; } -} - -sub UnloadModule { - my ($cmod) = @_; - unloadByIDUser($cmod->GetPerlID, $cmod->GetUser); + # here $cmod is deleted by perl (using DESTROY) } sub UnloadAll { - while (my ($id, $pmod) = each %pmods) { - unloadByIDUser($id, $pmod->{_cmod}->GetUser); + while (@allmods) { + UnloadModule($allmods[0]); } } @@ -89,39 +60,55 @@ sub IsModule { } sub LoadModule { - my ($modname, $args, $user) = @_; + my ($modname, $args, $type, $user, $network) = @_; $modname =~ /^\w+$/ or return ($ZNC::Perl_LoadError, "Module names can only contain letters, numbers and underscores, [$modname] is invalid."); - return ($ZNC::Perl_LoadError, "Module [$modname] already loaded.") if defined $user->GetModules->FindModule($modname); + my $container; + given ($type) { + when ($ZNC::CModInfo::NetworkModule) { + $container = $network; + } + when ($ZNC::CModInfo::UserModule) { + $container = $user; + } + when ($ZNC::CModInfo::GlobalModule) { + $container = ZNC::CZNC::Get(); + } + } + return ($ZNC::Perl_LoadError, "Uhm? No container for the module? Wtf?") unless $container; + $container = $container->GetModules; + return ($ZNC::Perl_LoadError, "Module [$modname] already loaded.") if defined $container->FindModule($modname); my $modpath = ZNC::String->new; my $datapath = ZNC::String->new; ZNC::CModules::FindModPath("$modname.pm", $modpath, $datapath) or return ($ZNC::Perl_NotFound); $modpath = $modpath->GetPerlStr; return ($ZNC::Perl_LoadError, "Incorrect perl module [$modpath]") unless IsModule $modpath, $modname; - eval { + my $pmod; + my @types = eval { require $modpath; + $pmod = bless {}, $modname; + $pmod->module_types(); }; if ($@) { - # modrefcount was 0 before this, otherwise it couldn't die. + # modrefcount was 0 before this, otherwise it couldn't die in the previous time. # so can safely remove module from %INC delete $INC{$modpath}; die $@; } + return ($ZNC::Perl_LoadError, "Module [$modname] doesn't support the specified type.") unless $type ~~ @types; $modrefcount{$modname}++; - my $id = CreateUUID; $datapath = $datapath->GetPerlStr; $datapath =~ s/\.pm$//; - my $cmod = ZNC::CPerlModule->new($user, $modname, $datapath, $id); + my $cmod = ZNC::CPerlModule->new($user, $network, $modname, $datapath, $pmod); my %nv; tie %nv, 'ZNC::ModuleNV', $cmod; - my $pmod = bless { - _cmod=>$cmod, - _nv=>\%nv - }, $modname; + $pmod->{_cmod} = $cmod; + $pmod->{_nv} = \%nv; $cmod->SetDescription($pmod->description); $cmod->SetArgs($args); $cmod->SetModPath($modpath); - $pmods{$id} = $pmod; - $user->GetModules->push_back($cmod); + $cmod->SetType($type); + push @allmods, $pmod; + $container->push_back($cmod); my $x = ''; my $loaded = 0; eval { @@ -132,7 +119,7 @@ sub LoadModule { $x .= $@; } if (!$loaded) { - unloadByIDUser($id, $user); + UnloadModule $pmod; if ($x) { return ($ZNC::Perl_LoadError, "Module [$modname] aborted: $x"); } @@ -145,7 +132,7 @@ sub LoadModule { } sub GetModInfo { - my ($modname) = @_; + my ($modname, $modinfo) = @_; $modname =~ /^\w+$/ or return ($ZNC::Perl_LoadError, "Module names can only contain letters, numbers and underscores, [$modname] is invalid."); my $modpath = ZNC::String->new; my $datapath = ZNC::String->new; @@ -154,23 +141,36 @@ sub GetModInfo { return ($ZNC::Perl_LoadError, "Incorrect perl module.") unless IsModule $modpath, $modname; require $modpath; my $pmod = bless {}, $modname; - return ($ZNC::Perl_Loaded, $modpath, $pmod->description, $pmod->wiki_page) + my @types = $pmod->module_types; + $modinfo->SetDefaultType($types[0]); + $modinfo->SetDescription($pmod->description); + $modinfo->SetWikiPage($pmod->wiki_page); + $modinfo->SetName($modname); + $modinfo->SetPath($modpath); + $modinfo->AddType($_) for @types; + return ($ZNC::Perl_Loaded) } sub ModInfoByPath { - my ($modpath, $modname) = @_; + my ($modpath, $modname, $modinfo) = @_; die "Incorrect perl module." unless IsModule $modpath, $modname; require $modpath; my $pmod = bless {}, $modname; - return ($pmod->description, $pmod->wiki_page) + my @types = $pmod->module_types; + $modinfo->SetDefaultType($types[0]); + $modinfo->SetDescription($pmod->description); + $modinfo->SetWikiPage($pmod->wiki_page); + $modinfo->SetName($modname); + $modinfo->SetPath($modpath); + $modinfo->AddType($_) for @types; } sub CallModFunc { - my $id = shift; + my $pmod = shift; my $func = shift; my $default = shift; my @arg = @_; - my $res = $pmods{$id}->$func(@arg); + my $res = $pmod->$func(@arg); # print "Returned from $func(@_): $res, (@arg)\n"; unless (defined $res) { $res = $default if defined $default; @@ -179,26 +179,25 @@ sub CallModFunc { } sub CallTimer { - my $modid = shift; - my $timerid = shift; - $pmods{$modid}->_CallTimer($timerid) + my $timer = shift; + $timer->RunJob; } sub CallSocket { - my $modid = shift; - $pmods{$modid}->_CallSocket(@_) + my $socket = shift; + my $func = shift; + say "Calling socket $func"; + $socket->$func(@_) } sub RemoveTimer { - my $modid = shift; - my $timerid = shift; - $pmods{$modid}->_RemoveTimer($timerid) + my $timer = shift; + $timer->OnShutdown; } sub RemoveSocket { - my $modid = shift; - my $sockid = shift; - $pmods{$modid}->_RemoveSocket($sockid) + my $socket = shift; + $socket->OnShutdown; } package ZNC::ModuleNV; @@ -283,6 +282,10 @@ sub wiki_page { '' } +sub module_types { + $ZNC::CModInfo::NetworkModule +} + # Default implementations for module hooks. They can be overriden in derived modules. sub OnLoad {1} sub OnBoot {} @@ -386,20 +389,16 @@ sub NV { sub CreateTimer { my $self = shift; - my $id = ZNC::Core::CreateUUID; my %a = @_; + my $ptimer = {}; my $ctimer = ZNC::CreatePerlTimer( $self->{_cmod}, $a{interval}//10, $a{cycles}//1, - "perl-timer-$id", + "perl-timer", $a{description}//'Just Another Perl Timer', - $id); - my $ptimer = { - _ctimer=>$ctimer, - _modid=>$self->GetPerlID - }; - $self->{_ptimers}{$id} = $ptimer; + $ptimer); + $ptimer->{_ctimer} = $ctimer; if (ref($a{task}) eq 'CODE') { bless $ptimer, 'ZNC::Timer'; $ptimer->{job} = $a{task}; @@ -410,55 +409,21 @@ sub CreateTimer { $ptimer; } -sub _CallTimer { - my $self = shift; - my $id = shift; - my $t = $self->{_ptimers}{$id}; - $t->RunJob; -} - -sub _RemoveTimer { - my $self = shift; - my $id = shift; - say "Removing perl timer $id"; - $self->{_ptimers}{$id}->OnShutdown; - delete $self->{_ptimers}{$id} -} - sub CreateSocket { my $self = shift; my $class = shift; - my $id = ZNC::Core::CreateUUID; - my $csock = ZNC::CreatePerlSocket($self->{_cmod}, $id); - my $psock = bless { - _csock=>$csock, - _modid=>$self->GetPerlID - }, $class; - $self->{_sockets}{$id} = $psock; + my $psock = bless {}, $class; + my $csock = ZNC::CreatePerlSocket($self->{_cmod}, $psock); + $psock->{_csock} = $csock; $psock->Init(@_); $psock; } -sub _CallSocket { - my $self = shift; - my $id = shift; - my $func = shift; - $self->{_sockets}{$id}->$func(@_) -} - -sub _RemoveSocket { - my $self = shift; - my $id = shift; - say "Removing perl socket $id"; - $self->{_sockets}{$id}->OnShutdown; - delete $self->{_sockets}{$id} -} - package ZNC::Timer; sub GetModule { my $self = shift; - $ZNC::Core::pmods{$self->{_modid}}; + ZNC::AsPerlModule($self->{_ctimer}->GetModule)->GetPerlObj() } sub RunJob { @@ -492,7 +457,7 @@ package ZNC::Socket; sub GetModule { my $self = shift; - $ZNC::Core::pmods{$self->{_modid}}; + ZNC::AsPerlModule($self->{_csock}->GetModule)->GetPerlObj() } sub Init {} @@ -537,7 +502,7 @@ sub Connect { $self->GetModule->GetManager->Connect( $host, $port, - "perl-socket-".$self->GetPerlID, + "perl-socket", $arg{timeout}//60, $arg{ssl}//0, $arg{bindhost}//'', @@ -560,7 +525,7 @@ sub Listen { if (defined $arg{port}) { return $arg{port} if $self->GetModule->GetManager->ListenHost( $arg{port}, - "perl-socket-".$self->GetPerlID, + "perl-socket", $arg{bindhost}//'', $arg{ssl}//0, $arg{maxconns}//ZNC::_GetSOMAXCONN, @@ -571,7 +536,7 @@ sub Listen { return 0; } $self->GetModule->GetManager->ListenRand( - "perl-socket-".$self->GetPerlID, + "perl-socket", $arg{bindhost}//'', $arg{ssl}//0, $arg{maxconns}//ZNC::_GetSOMAXCONN,