Cleanup Perl runtime leaks

FossilOrigin-Name: 5081c19df88f2dfca0ef18710c47f906de3104a1411275c7826965faf6479317
This commit is contained in:
nekobit 2022-08-24 23:57:18 +00:00
parent bebc9eb58b
commit 9efd9f9a9f
13 changed files with 48 additions and 40 deletions

View file

@ -3,7 +3,7 @@ GIT ?= git
MASTODONT_DIR = mastodont-c/
MASTODONT = $(MASTODONT_DIR)libmastodont.a
CFLAGS += -Wall -I $(MASTODONT_DIR)include/ -Wno-unused-variable -Wno-ignored-qualifiers -I/usr/include/ -I $(MASTODONT_DIR)/libs $(shell pkg-config --cflags libcurl libpcre2-8) `perl -MExtUtils::Embed -e ccopts`
LDFLAGS = -L$(MASTODONT_DIR) -lmastodont $(shell pkg-config --libs libcurl libpcre2-8) -lfcgi -lpthread `perl -MExtUtils::Embed -e ldopts`
LDFLAGS += -L$(MASTODONT_DIR) -lmastodont $(shell pkg-config --libs libcurl libpcre2-8) -lfcgi -lpthread `perl -MExtUtils::Embed -e ldopts`
SRC = $(wildcard src/*.c)
OBJ = $(patsubst %.c,%.o,$(SRC))
HEADERS = $(wildcard src/*.h) config.h
@ -45,7 +45,7 @@ $(TARGET): $(HEADERS) $(OBJ)
$(CC) -o $(TARGET) $(OBJ) $(PAGES_C_OBJ) $(LDFLAGS)
filec: src/file-to-c/main.o
$(CC) -o filec $<
$(CC) $(LDFLAGS) -o filec $<
emojitoc: scripts/emoji-to.o
$(CC) -o emojitoc $< $(LDFLAGS)

View file

@ -58,14 +58,14 @@ static char* accounts_page(HV* session_hv,
XPUSHs(newRV_noinc((SV*)session_hv));
XPUSHs(newRV_noinc((SV*)template_files));
if (acct)
XPUSHs(newRV_noinc((SV*)perlify_account(acct)));
mXPUSHs(newRV_noinc((SV*)perlify_account(acct)));
else ARG_UNDEFINED();
if (rel)
XPUSHs(newRV_noinc((SV*)perlify_relationship(rel)));
mXPUSHs(newRV_noinc((SV*)perlify_relationship(rel)));
else ARG_UNDEFINED();
if (accts && accts_len)
XPUSHs(newRV_noinc((SV*)perlify_accounts(accts, accts_len)));
mXPUSHs(newRV_noinc((SV*)perlify_accounts(accts, accts_len)));
else ARG_UNDEFINED();
// perlapi doesn't specify if a string length of 0 calls strlen so calling just to be safe...
@ -158,13 +158,13 @@ static char* account_statuses_cb(HV* session_hv,
PERL_STACK_INIT;
XPUSHs(newRV_noinc((SV*)session_hv));
XPUSHs(newRV_noinc((SV*)template_files));
XPUSHs(newRV_noinc((SV*)perlify_account(acct)));
mXPUSHs(newRV_noinc((SV*)perlify_account(acct)));
if (rel)
XPUSHs(newRV_noinc((SV*)perlify_relationship(rel)));
mXPUSHs(newRV_noinc((SV*)perlify_relationship(rel)));
else ARG_UNDEFINED();
if (statuses && statuses_len)
XPUSHs(newRV_noinc((SV*)perlify_statuses(statuses, statuses_len)));
mXPUSHs(newRV_noinc((SV*)perlify_statuses(statuses, statuses_len)));
else ARG_UNDEFINED();
PERL_STACK_SCALAR_CALL("account::content_statuses");
@ -203,13 +203,13 @@ static char* account_scrobbles_cb(HV* session_hv,
PERL_STACK_INIT;
XPUSHs(newRV_noinc((SV*)session_hv));
XPUSHs(newRV_noinc((SV*)template_files));
XPUSHs(newRV_noinc((SV*)perlify_account(acct)));
mXPUSHs(newRV_noinc((SV*)perlify_account(acct)));
if (rel)
XPUSHs(newRV_noinc((SV*)perlify_relationship(rel)));
mXPUSHs(newRV_noinc((SV*)perlify_relationship(rel)));
else ARG_UNDEFINED();
if (scrobbles && scrobbles_len)
XPUSHs(newRV_noinc((SV*)perlify_scrobbles(scrobbles, scrobbles_len)));
mXPUSHs(newRV_noinc((SV*)perlify_scrobbles(scrobbles, scrobbles_len)));
else ARG_UNDEFINED();
PERL_STACK_SCALAR_CALL("account::content_scrobbles");

View file

@ -74,14 +74,13 @@ void render_base_page(struct base_page* page, FCGX_Request* req, struct session*
else
mXPUSHs(newRV_noinc((SV*)perlify_session(ssn)));
XPUSHs(newRV_noinc((SV*)template_files));
XPUSHs(sv_2mortal(newSVpv(page->content, 0)));
mXPUSHs(newSVpv(page->content, 0));
if (notifs && notifs_len)
{
AV* notifs_av = perlify_notifications(notifs, notifs_len);
mXPUSHs(newRV_inc((SV*)notifs_av));
mXPUSHs(newRV_noinc((SV*)perlify_notifications(notifs, notifs_len)));
}
else XPUSHs(&PL_sv_undef);
else ARG_UNDEFINED();
// Run function
PERL_STACK_SCALAR_CALL("base_page");
@ -89,7 +88,6 @@ void render_base_page(struct base_page* page, FCGX_Request* req, struct session*
send_result(req, NULL, "text/html", dup, 0);
mstdnt_cleanup_notifications(notifs, notifs_len);
mastodont_storage_cleanup(&storage);
Safefree(dup);

View file

@ -50,7 +50,7 @@ void content_chats(PATH_ARGS)
XPUSHs(newRV_noinc((SV*)session_hv));
XPUSHs(newRV_noinc((SV*)template_files));
if (chats)
XPUSHs(newRV_noinc((SV*)perlify_chats(chats, chats_len)));
mXPUSHs(newRV_noinc((SV*)perlify_chats(chats, chats_len)));
else ARG_UNDEFINED();
PERL_STACK_SCALAR_CALL("chat::content_chats");

View file

@ -112,7 +112,7 @@ char* construct_emoji_picker(char* status_id, size_t* size)
{
av_store(av, i, newSVpv(emojis[i], 0));
}
XPUSHs(newRV_noinc((SV*)av));
mXPUSHs(newRV_noinc((SV*)av));
PERL_STACK_SCALAR_CALL("emojis::emoji_picker");
char* dup = PERL_GET_STACK_EXIT;

View file

@ -26,7 +26,7 @@
#define hvstores_str(hv, key, val) hv_stores((hv), key, ((val) ? newSVpv((val), 0) : &PL_sv_undef))
#define hvstores_int(hv, key, val) hv_stores((hv), key, newSViv((val)))
#define hvstores_ref(hv, key, val) hv_stores((hv), key, \
((val) ? newRV_inc((SV* const)(val)) : &PL_sv_undef))
((val) ? newRV_noinc((SV* const)(val)) : &PL_sv_undef))
/* Seeing all this shit littered in Treebird's code made me decide to write some macros */
#define PERL_STACK_INIT perl_lock(); \
@ -59,7 +59,7 @@ extern pthread_mutex_t perllock_mutex;
#define perl_unlock() ;;
#endif
#define ARG_UNDEFINED() do { XPUSHs(&PL_sv_undef); } while (0)
#define ARG_UNDEFINED() do { mXPUSHs(&PL_sv_undef); } while (0)
void init_template_files(pTHX);
void cleanup_template_files();

View file

@ -56,7 +56,7 @@ void content_lists(PATH_ARGS)
XPUSHs(newRV_noinc((SV*)session_hv));
XPUSHs(newRV_noinc((SV*)template_files));
if (lists)
XPUSHs(newRV_noinc((SV*)perlify_lists(lists, lists_len)));
mXPUSHs(newRV_noinc((SV*)perlify_lists(lists, lists_len)));
PERL_STACK_SCALAR_CALL("lists::content_lists");

View file

@ -209,7 +209,7 @@ void content_login(PATH_ARGS)
XPUSHs(newRV_noinc((SV*)session_hv));
XPUSHs(newRV_noinc((SV*)template_files));
if (storage.error || oauth_store.error)
XPUSHs(newSVpv(storage.error ? storage.error : oauth_store.error, 0));
mXPUSHs(newSVpv(storage.error ? storage.error : oauth_store.error, 0));
PERL_STACK_SCALAR_CALL("login::content_login");

View file

@ -51,14 +51,14 @@
// Allow dynamic loading for Perl
static void xs_init (pTHX);
EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
void boot_DynaLoader (pTHX_ CV* cv);
#ifdef DEBUG
static int quit = 0;
static void exit_treebird(PATH_ARGS)
{
quit = 1;
exit(1);
}
#endif
@ -221,17 +221,22 @@ void cgi_start(mastodont_t* api)
}
#endif
EXTERN_C void xs_init(pTHX)
void xs_init(pTHX)
{
char *file = __FILE__;
newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
static const char file[] = __FILE__;
dXSUB_SYS;
PERL_UNUSED_CONTEXT;
newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
}
int main(int argc, char **argv, char **env)
{
// Global init
mastodont_global_curl_init();
#ifndef SINGLE_THREADED
FCGX_Init();
#endif
// Initialize Perl
PERL_SYS_INIT3(&argc, &argv, &env);
@ -242,6 +247,7 @@ int main(int argc, char **argv, char **env)
perl_parse(my_perl, xs_init, (sizeof(perl_argv) / sizeof(perl_argv[0])) - 1, perl_argv, (char**)NULL);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
PL_perl_destruct_level = 2;
perl_run(my_perl);
init_template_files(aTHX);

View file

@ -61,7 +61,7 @@ void content_notifications(PATH_ARGS)
XPUSHs(newRV_noinc((SV*)session_hv));
XPUSHs(newRV_noinc((SV*)template_files));
if (notifs)
XPUSHs(newRV_noinc((SV*)perlify_notifications(notifs, notifs_len)));
mXPUSHs(newRV_noinc((SV*)perlify_notifications(notifs, notifs_len)));
// ARGS
PERL_STACK_SCALAR_CALL("notifications::content_notifications");

View file

@ -70,6 +70,7 @@ void content_search_all(PATH_ARGS)
redirect(req, REDIRECT_303, url);
break;
}
free(url);
curl_free(query);
return;
}
@ -80,7 +81,7 @@ void content_search_all(PATH_ARGS)
HV* session_hv = perlify_session(ssn);
XPUSHs(newRV_noinc((SV*)session_hv));
XPUSHs(newRV_noinc((SV*)template_files));
XPUSHs(newRV_noinc((SV*)perlify_search_results(&results)));
mXPUSHs(newRV_noinc((SV*)perlify_search_results(&results)));
PERL_STACK_SCALAR_CALL("search::content_search");
@ -95,7 +96,7 @@ void content_search_all(PATH_ARGS)
};
render_base_page(&b, req, ssn, api);
mstdnt_cleanup_search_results(&results);
mastodont_storage_cleanup(&storage);
Safefree(dup);
@ -127,7 +128,8 @@ void content_search_statuses(PATH_ARGS)
HV* session_hv = perlify_session(ssn);
XPUSHs(newRV_noinc((SV*)session_hv));
XPUSHs(newRV_noinc((SV*)template_files));
XPUSHs(newRV_noinc((SV*)perlify_search_results(&results)));
mXPUSHs(newRV_noinc((SV*)perlify_search_results(&results)));
PERL_STACK_SCALAR_CALL("search::content_search_statuses");
// Duplicate so we can free the TMPs
@ -172,7 +174,7 @@ void content_search_accounts(PATH_ARGS)
HV* session_hv = perlify_session(ssn);
XPUSHs(newRV_noinc((SV*)session_hv));
XPUSHs(newRV_noinc((SV*)template_files));
XPUSHs(newRV_noinc((SV*)perlify_search_results(&results)));
mXPUSHs(newRV_noinc((SV*)perlify_search_results(&results)));
PERL_STACK_SCALAR_CALL("search::content_search_accounts");
@ -190,6 +192,7 @@ void content_search_accounts(PATH_ARGS)
mstdnt_cleanup_search_results(&results);
mastodont_storage_cleanup(&storage);
Safefree(dup);
}
void content_search_hashtags(PATH_ARGS)
@ -217,6 +220,7 @@ void content_search_hashtags(PATH_ARGS)
mstdnt_cleanup_search_results(&results);
mastodont_storage_cleanup(&storage);
// Safefree(dup);
}
HV* perlify_search_results(struct mstdnt_search_results* results)

View file

@ -318,9 +318,9 @@ void content_status_interactions(FCGX_Request* req,
XPUSHs(newRV_noinc((SV*)session_hv));
XPUSHs(newRV_noinc((SV*)template_files));
if (accts)
XPUSHs(newRV_noinc((SV*)perlify_accounts(accts, accts_len)));
mXPUSHs(newRV_noinc((SV*)perlify_accounts(accts, accts_len)));
else ARG_UNDEFINED();
XPUSHs(newSVpv(label, 0));
mXPUSHs(newSVpv(label, 0));
PERL_STACK_SCALAR_CALL("account::status_interactions");
@ -367,20 +367,20 @@ void content_status(PATH_ARGS, uint8_t flags)
HV* session_hv = perlify_session(ssn);
XPUSHs(newRV_noinc((SV*)session_hv));
XPUSHs(newRV_noinc((SV*)template_files));
XPUSHs(newRV_noinc((SV*)perlify_status(&status)));
mXPUSHs(newRV_noinc((SV*)perlify_status(&status)));
if (statuses_before)
XPUSHs(newRV_noinc((SV*)perlify_statuses(statuses_before, stat_before_len)));
mXPUSHs(newRV_noinc((SV*)perlify_statuses(statuses_before, stat_before_len)));
else
ARG_UNDEFINED();
if (statuses_after)
XPUSHs(newRV_noinc((SV*)perlify_statuses(statuses_after, stat_after_len)));
mXPUSHs(newRV_noinc((SV*)perlify_statuses(statuses_after, stat_after_len)));
else
ARG_UNDEFINED();
if (picker)
{
XPUSHs(newSVpv(picker, picker_len));
mXPUSHs(newSVpv(picker, picker_len));
} else ARG_UNDEFINED();
PERL_STACK_SCALAR_CALL("status::content_status");

View file

@ -47,11 +47,11 @@ void content_timeline(REQUEST_T req,
XPUSHs(newRV_noinc((SV*)template_files));
if (statuses)
XPUSHs(newRV_noinc((SV*)perlify_statuses(statuses, statuses_len)));
mXPUSHs(newRV_noinc((SV*)perlify_statuses(statuses, statuses_len)));
else ARG_UNDEFINED();
if (header_text)
XPUSHs(newSVpv(header_text, 0));
mXPUSHs(newSVpv(header_text, 0));
else ARG_UNDEFINED();
mXPUSHi(show_post_box);