Bug Summary

File:perl/perl-core.c
Location:line 246, column 3
Description:Value stored to 'ret' is never read

Annotated Source Code

1/*
2 perl-core.c : irssi
3
4 Copyright (C) 1999-2001 Timo Sirainen
5
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License along
17 with this program; if not, write to the Free Software Foundation, Inc.,
18 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19*/
20
21#define NEED_PERL_H
22#include "module.h"
23#include "modules.h"
24#include "core.h"
25#include "signals.h"
26#include "misc.h"
27#include "settings.h"
28
29#include "perl-core.h"
30#include "perl-common.h"
31#include "perl-signals.h"
32#include "perl-sources.h"
33
34#include "XSUB.h"
35#include "irssi-core.pl.h"
36
37GSList *perl_scripts;
38PerlInterpreter *my_perl;
39
40static int print_script_errors;
41static char *perl_args[] = {"", "-e", "0"};
42
43#define IS_PERL_SCRIPT(file)(strlen(file) > 3 && strcmp(file+strlen(file)-3, ".pl"
) == 0) \
44 (strlen(file) > 3 && strcmp(file+strlen(file)-3, ".pl") == 0)
45
46static void perl_script_destroy_package(PERL_SCRIPT_REC *script)
47{
48 dSPSV **sp = PL_stack_sp;
49
50 ENTERPerl_push_scope();
51 SAVETMPSPerl_save_int((int*)&PL_tmps_floor), PL_tmps_floor = PL_tmps_ix;
52
53 PUSHMARK(SP)(void)( { if (++PL_markstack_ptr == PL_markstack_max) Perl_markstack_grow
(); *PL_markstack_ptr = (I32)((sp) - PL_stack_base); } );
54 XPUSHs(sv_2mortal(new_pv(script->package)))(void)( { (void)( { if (PL_stack_max - sp < (int)(1)) { sp
= Perl_stack_grow(sp,sp, (int) (1)); } } ); (*++sp = (Perl_sv_2mortal
((Perl_newSVpv((script->package) == ((void *)0) ? "" : (script
->package), (script->package) == ((void *)0) ? 0 : strlen
(script->package)))))); } );
55 PUTBACKPL_stack_sp = sp;
56
57 perl_call_pv("Irssi::Core::destroy", G_VOID|G_EVAL|G_DISCARD)Perl_call_pv("Irssi::Core::destroy",128|4|2);
58
59 SPAGAINsp = PL_stack_sp;
60
61 PUTBACKPL_stack_sp = sp;
62 FREETMPSif (PL_tmps_ix > PL_tmps_floor) Perl_free_tmps();
63 LEAVEPerl_pop_scope();
64}
65
66static void perl_script_destroy(PERL_SCRIPT_REC *script)
67{
68 perl_scripts = g_slist_remove(perl_scripts, script);
69
70 signal_emit("script destroyed", 1, script);
71
72 perl_signal_remove_script(script);
73 perl_source_remove_script(script);
74
75 g_free(script->name);
76 g_free(script->package);
77 g_free_not_null(script->path)g_free(script->path);
78 g_free_not_null(script->data)g_free(script->data);
79 g_free(script);
80}
81
82extern void boot_DynaLoader(pTHX_ CV* cv);
83
84#if PERL_STATIC_LIBS0 == 1
85extern void boot_Irssi(CV *cv);
86
87XS(boot_Irssi_Core)void boot_Irssi_Core( CV* cv __attribute__((unused)))
88{
89 dXSARGSSV **sp = PL_stack_sp; I32 ax = (*PL_markstack_ptr--); register
SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark
);
90
91 irssi_callXS(boot_Irssi, cv, mark);
92 irssi_boot(Irc){ extern void boot_Irssi__Irc( CV *cv); irssi_callXS(boot_Irssi__Irc
, cv, mark); };
93 irssi_boot(UI){ extern void boot_Irssi__UI( CV *cv); irssi_callXS(boot_Irssi__UI
, cv, mark); };
94 irssi_boot(TextUI){ extern void boot_Irssi__TextUI( CV *cv); irssi_callXS(boot_Irssi__TextUI
, cv, mark); };
95 XSRETURN_YES(void)( { (PL_stack_base[ax + (0)] = &PL_sv_yes ); (void)
( { const IV tmpXSoff = (1); PL_stack_sp = PL_stack_base + ax
+ (tmpXSoff - 1); return; } ); } );
96}
97#endif
98
99static void xs_init(pTHXvoid)
100{
101 dXSUB_SYS;
102
103#if PERL_STATIC_LIBS0 == 1
104 newXSPerl_newXS("Irssi::Core::boot_Irssi_Core", boot_Irssi_Core, __FILE__"perl-core.c");
105#endif
106
107 /* boot the dynaloader too, if we want to use some
108 other dynamic modules.. */
109 newXSPerl_newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, __FILE__"perl-core.c");
110}
111
112/* Initialize perl interpreter */
113void perl_scripts_init(void)
114{
115 char *code, *use_code;
116
117 perl_scripts = NULL((void *)0);
118 perl_sources_start();
119 perl_signals_start();
120
121 my_perl = perl_alloc();
122 perl_construct(my_perl);
123
124 perl_parse(my_perl, xs_init, G_N_ELEMENTS(perl_args)(sizeof (perl_args) / sizeof ((perl_args)[0])), perl_args, NULL((void *)0));
125#if PERL_STATIC_LIBS0 == 1
126 perl_eval_pv("Irssi::Core::boot_Irssi_Core();", TRUE)Perl_eval_pv("Irssi::Core::boot_Irssi_Core();",(1));
127#endif
128
129 perl_common_start();
130
131 use_code = perl_get_use_list();
132 code = g_strdup_printf(irssi_core_code, PERL_STATIC_LIBS0, use_code);
133 perl_eval_pv(code, TRUE)Perl_eval_pv(code,(1));
134
135 g_free(code);
136 g_free(use_code);
137}
138
139/* Destroy all perl scripts and deinitialize perl interpreter */
140void perl_scripts_deinit(void)
141{
142 if (my_perl == NULL((void *)0))
143 return;
144
145 /* unload all scripts */
146 while (perl_scripts != NULL((void *)0))
147 perl_script_unload(perl_scripts->data);
148
149 signal_emit("perl scripts deinit", 0);
150
151 perl_signals_stop();
152 perl_sources_stop();
153 perl_common_stop();
154
155 /* Unload all perl libraries loaded with dynaloader */
156 perl_eval_pv("foreach my $lib (@DynaLoader::dl_modules) { if ($lib =~ /^Irssi\\b/) { $lib .= '::deinit();'; eval $lib; } }", TRUE)Perl_eval_pv("foreach my $lib (@DynaLoader::dl_modules) { if ($lib =~ /^Irssi\\b/) { $lib .= '::deinit();'; eval $lib; } }"
,(1));
157
158 /* We could unload all libraries .. but this crashes with some
159 libraries, probably because we don't call some deinit function..
160 Anyway, this would free some memory with /SCRIPT RESET, but it
161 leaks memory anyway. */
162 /*perl_eval_pv("eval { foreach my $lib (@DynaLoader::dl_librefs) { DynaLoader::dl_unload_file($lib); } }", TRUE);*/
163
164 /* perl interpreter */
165 PL_perl_destruct_level = 1;
166 perl_destruct(my_perl);
167 perl_free(my_perl);
168 my_perl = NULL((void *)0);
169}
170
171/* Modify the script name so that all non-alphanumeric characters are
172 translated to '_' */
173void script_fix_name(char *name)
174{
175 char *p;
176
177 p = strrchr(name, '.');
178 if (p != NULL((void *)0)) *p = '\0';
179
180 while (*name != '\0') {
181 if (*name != '_' && !i_isalnum(*name)__sbistype(((int) (unsigned char) (*name)), 0x00000100L|0x00000400L
))
182 *name = '_';
183 name++;
184 }
185}
186
187static char *script_file_get_name(const char *path)
188{
189 char *name;
190
191 name = g_strdup(g_basename(path));
192 script_fix_name(name);
193 return name;
194}
195
196static char *script_data_get_name(void)
197{
198 GString *name;
199 char *ret;
200 int n;
201
202 name = g_string_new(NULL((void *)0));
203 n = 1;
204 do {
205 g_string_printf(name, "data%d", n);
206 n++;
207 } while (perl_script_find(name->str) != NULL((void *)0));
208
209 ret = name->str;
210 g_string_free(name, FALSE(0));
211 return ret;
212}
213
214static int perl_script_eval(PERL_SCRIPT_REC *script)
215{
216 dSPSV **sp = PL_stack_sp;
217 char *error;
218 int retcount;
219 SV *ret;
220
221 ENTERPerl_push_scope();
222 SAVETMPSPerl_save_int((int*)&PL_tmps_floor), PL_tmps_floor = PL_tmps_ix;
223
224 PUSHMARK(SP)(void)( { if (++PL_markstack_ptr == PL_markstack_max) Perl_markstack_grow
(); *PL_markstack_ptr = (I32)((sp) - PL_stack_base); } );
225 XPUSHs(sv_2mortal(new_pv(script->path != NULL ? script->path :(void)( { (void)( { if (PL_stack_max - sp < (int)(1)) { sp
= Perl_stack_grow(sp,sp, (int) (1)); } } ); (*++sp = (Perl_sv_2mortal
((Perl_newSVpv((script->path != ((void *)0) ? script->path
: script->data) == ((void *)0) ? "" : (script->path !=
((void *)0) ? script->path : script->data), (script->
path != ((void *)0) ? script->path : script->data) == (
(void *)0) ? 0 : strlen(script->path != ((void *)0) ? script
->path : script->data)))))); } )
226 script->data)))(void)( { (void)( { if (PL_stack_max - sp < (int)(1)) { sp
= Perl_stack_grow(sp,sp, (int) (1)); } } ); (*++sp = (Perl_sv_2mortal
((Perl_newSVpv((script->path != ((void *)0) ? script->path
: script->data) == ((void *)0) ? "" : (script->path !=
((void *)0) ? script->path : script->data), (script->
path != ((void *)0) ? script->path : script->data) == (
(void *)0) ? 0 : strlen(script->path != ((void *)0) ? script
->path : script->data)))))); } );
227 XPUSHs(sv_2mortal(new_pv(script->name)))(void)( { (void)( { if (PL_stack_max - sp < (int)(1)) { sp
= Perl_stack_grow(sp,sp, (int) (1)); } } ); (*++sp = (Perl_sv_2mortal
((Perl_newSVpv((script->name) == ((void *)0) ? "" : (script
->name), (script->name) == ((void *)0) ? 0 : strlen(script
->name)))))); } );
228 PUTBACKPL_stack_sp = sp;
229
230 retcount = perl_call_pv(script->path != NULL ?Perl_call_pv(script->path != ((void *)0) ? "Irssi::Core::eval_file"
: "Irssi::Core::eval_data",4|0)
231 "Irssi::Core::eval_file" :Perl_call_pv(script->path != ((void *)0) ? "Irssi::Core::eval_file"
: "Irssi::Core::eval_data",4|0)
232 "Irssi::Core::eval_data",Perl_call_pv(script->path != ((void *)0) ? "Irssi::Core::eval_file"
: "Irssi::Core::eval_data",4|0)
233 G_EVAL|G_SCALAR)Perl_call_pv(script->path != ((void *)0) ? "Irssi::Core::eval_file"
: "Irssi::Core::eval_data",4|0);
234 SPAGAINsp = PL_stack_sp;
235
236 error = NULL((void *)0);
237 if (SvTRUE(ERRSV)( !((((XPVGV*)(PL_errgv)->sv_any)->xgv_gp)->gp_sv) ?
0 : ((((((XPVGV*)(PL_errgv)->sv_any)->xgv_gp)->gp_sv
))->sv_flags & 0x00040000) ? (({XPV *nxpv = (XPV*)((((
(XPVGV*)(PL_errgv)->sv_any)->xgv_gp)->gp_sv))->sv_any
; nxpv && (nxpv->xpv_cur > 1 || (nxpv->xpv_cur
&& *nxpv->xpv_pv != '0')); }) ? 1 : 0) : ((((((XPVGV
*)(PL_errgv)->sv_any)->xgv_gp)->gp_sv))->sv_flags
& 0x00010000) ? ((XPVIV*) (((((XPVGV*)(PL_errgv)->sv_any
)->xgv_gp)->gp_sv))->sv_any)->xiv_iv != 0 : (((((
(XPVGV*)(PL_errgv)->sv_any)->xgv_gp)->gp_sv))->sv_flags
& 0x00020000) ? ((XPVNV*)(((((XPVGV*)(PL_errgv)->sv_any
)->xgv_gp)->gp_sv))->sv_any)->xnv_nv != 0.0 : Perl_sv_2bool
(((((XPVGV*)(PL_errgv)->sv_any)->xgv_gp)->gp_sv)) )) {
238 error = SvPV(ERRSV, PL_na)(((((((XPVGV*)(PL_errgv)->sv_any)->xgv_gp)->gp_sv))->
sv_flags & (0x00040000)) == 0x00040000 ? ((PL_na = ((XPV*
) (((((XPVGV*)(PL_errgv)->sv_any)->xgv_gp)->gp_sv))->
sv_any)->xpv_cur), ((XPV*) (((((XPVGV*)(PL_errgv)->sv_any
)->xgv_gp)->gp_sv))->sv_any)->xpv_pv) : Perl_sv_2pv_flags
(((((XPVGV*)(PL_errgv)->sv_any)->xgv_gp)->gp_sv), &
PL_na, 2));
239
240 if (error != NULL((void *)0)) {
241 error = g_strdup(error);
242 signal_emit("script error", 2, script, error);
243 g_free(error);
244 }
245 } else if (retcount > 0) {
246 ret = POPs(*sp--);
Value stored to 'ret' is never read
247 }
248
249 PUTBACKPL_stack_sp = sp;
250 FREETMPSif (PL_tmps_ix > PL_tmps_floor) Perl_free_tmps();
251 LEAVEPerl_pop_scope();
252
253 return error == NULL((void *)0);
254}
255
256/* NOTE: name must not be free'd */
257static PERL_SCRIPT_REC *script_load(char *name, const char *path,
258 const char *data)
259{
260 PERL_SCRIPT_REC *script;
261
262 /* if there's a script with a same name, destroy it */
263 script = perl_script_find(name);
264 if (script != NULL((void *)0))
265 perl_script_unload(script);
266
267 script = g_new0(PERL_SCRIPT_REC, 1)((PERL_SCRIPT_REC *) g_malloc0 (((gsize) sizeof (PERL_SCRIPT_REC
)) * ((gsize) (1))));
268 script->name = name;
269 script->package = g_strdup_printf("Irssi::Script::%s", name);
270 script->path = g_strdup(path);
271 script->data = g_strdup(data);
272
273 perl_scripts = g_slist_append(perl_scripts, script);
274 signal_emit("script created", 1, script);
275
276 if (!perl_script_eval(script))
277 script = NULL((void *)0); /* the script is destroyed in "script error" signal */
278 return script;
279}
280
281/* Load a perl script, path must be a full path. */
282PERL_SCRIPT_REC *perl_script_load_file(const char *path)
283{
284 char *name;
285
286 g_return_val_if_fail(path != NULL, NULL)do{ if (path != ((void *)0)) { } else { g_return_if_fail_warning
(((gchar*) 0), __PRETTY_FUNCTION__, "path != NULL"); return (
((void *)0)); }; }while (0);
287
288 name = script_file_get_name(path);
289 return script_load(name, path, NULL((void *)0));
290}
291
292/* Load a perl script from given data */
293PERL_SCRIPT_REC *perl_script_load_data(const char *data)
294{
295 char *name;
296
297 g_return_val_if_fail(data != NULL, NULL)do{ if (data != ((void *)0)) { } else { g_return_if_fail_warning
(((gchar*) 0), __PRETTY_FUNCTION__, "data != NULL"); return (
((void *)0)); }; }while (0);
298
299 name = script_data_get_name();
300 return script_load(name, NULL((void *)0), data);
301}
302
303/* Unload perl script */
304void perl_script_unload(PERL_SCRIPT_REC *script)
305{
306 g_return_if_fail(script != NULL)do{ if (script != ((void *)0)) { } else { g_return_if_fail_warning
(((gchar*) 0), __PRETTY_FUNCTION__, "script != NULL"); return
; }; }while (0);
307
308 perl_script_destroy_package(script);
309 perl_script_destroy(script);
310}
311
312/* Find loaded script by name */
313PERL_SCRIPT_REC *perl_script_find(const char *name)
314{
315 GSList *tmp;
316
317 g_return_val_if_fail(name != NULL, NULL)do{ if (name != ((void *)0)) { } else { g_return_if_fail_warning
(((gchar*) 0), __PRETTY_FUNCTION__, "name != NULL"); return (
((void *)0)); }; }while (0);
318
319 for (tmp = perl_scripts; tmp != NULL((void *)0); tmp = tmp->next) {
320 PERL_SCRIPT_REC *rec = tmp->data;
321
322 if (strcmp(rec->name, name) == 0)
323 return rec;
324 }
325
326 return NULL((void *)0);
327}
328
329/* Find loaded script by package */
330PERL_SCRIPT_REC *perl_script_find_package(const char *package)
331{
332 GSList *tmp;
333
334 g_return_val_if_fail(package != NULL, NULL)do{ if (package != ((void *)0)) { } else { g_return_if_fail_warning
(((gchar*) 0), __PRETTY_FUNCTION__, "package != NULL"); return
(((void *)0)); }; }while (0);
335
336 for (tmp = perl_scripts; tmp != NULL((void *)0); tmp = tmp->next) {
337 PERL_SCRIPT_REC *rec = tmp->data;
338
339 if (strcmp(rec->package, package) == 0)
340 return rec;
341 }
342
343 return NULL((void *)0);
344}
345
346/* Returns full path for the script */
347char *perl_script_get_path(const char *name)
348{
349 struct stat statbuf;
350 char *file, *path;
351
352 if (g_path_is_absolute(name) || (name[0] == '~' && name[1] == '/')) {
353 /* full path specified */
354 return convert_home(name);
355 }
356
357 /* add .pl suffix if it's missing */
358 file = IS_PERL_SCRIPT(name)(strlen(name) > 3 && strcmp(name+strlen(name)-3, ".pl"
) == 0) ? g_strdup(name) :
359 g_strdup_printf("%s.pl", name);
360
361 /* check from ~/.irssi/scripts/ */
362 path = g_strdup_printf("%s/scripts/%s", get_irssi_dir(), file);
363 if (stat(path, &statbuf) != 0) {
364 /* check from SCRIPTDIR */
365 g_free(path);
366 path = g_strdup_printf(SCRIPTDIR"/home/jilles/irssi/share/irssi/scripts""/%s", file);
367 if (stat(path, &statbuf) != 0) {
368 g_free(path);
369 path = NULL((void *)0);
370 }
371 }
372 g_free(file);
373 return path;
374}
375
376/* If core should handle printing script errors */
377void perl_core_print_script_error(int print)
378{
379 print_script_errors = print;
380}
381
382/* Returns the perl module's API version. */
383int perl_get_api_version(void)
384{
385 return IRSSI_PERL_API_VERSION20011214;
386}
387
388static void perl_scripts_autorun(void)
389{
390 DIR *dirp;
391 struct dirent *dp;
392 struct stat statbuf;
393 char *path, *fname;
394
395 /* run *.pl scripts from ~/.irssi/scripts/autorun/ */
396 path = g_strdup_printf("%s/scripts/autorun", get_irssi_dir());
397 dirp = opendir(path);
398 if (dirp == NULL((void *)0)) {
399 g_free(path);
400 return;
401 }
402
403 while ((dp = readdir(dirp)) != NULL((void *)0)) {
404 if (!IS_PERL_SCRIPT(dp->d_name)(strlen(dp->d_name) > 3 && strcmp(dp->d_name
+strlen(dp->d_name)-3, ".pl") == 0))
405 continue;
406
407 fname = g_strdup_printf("%s/%s", path, dp->d_name);
408 if (stat(fname, &statbuf) == 0 && !S_ISDIR(statbuf.st_mode)(((statbuf.st_mode) & 0170000) == 0040000))
409 perl_script_load_file(fname);
410 g_free(fname);
411 }
412 closedir(dirp);
413 g_free(path);
414}
415
416static void sig_script_error(PERL_SCRIPT_REC *script, const char *error)
417{
418 char *str;
419
420 if (print_script_errors) {
421 str = g_strdup_printf("Script '%s' error:",
422 script == NULL((void *)0) ? "??" : script->name);
423 signal_emit("gui dialog", 2, "error", str);
424 signal_emit("gui dialog", 2, "error", error);
425 g_free(str);
426 }
427
428 if (script != NULL((void *)0)) {
429 perl_script_unload(script);
430 signal_stop();
431 }
432}
433
434static void sig_autorun(void)
435{
436 signal_remove("irssi init finished", (SIGNAL_FUNC) sig_autorun)signal_remove_full(("irssi init finished"), (SIGNAL_FUNC) ((SIGNAL_FUNC
) sig_autorun), ((void *)0));
437
438 perl_scripts_autorun();
439}
440
441void perl_core_init(void)
442{
443 int argc = G_N_ELEMENTS(perl_args)(sizeof (perl_args) / sizeof ((perl_args)[0]));
444 char **argv = perl_args;
445
446 PERL_SYS_INIT3(&argc, &argv, &environ)Perl_sys_init3(&argc, &argv, &environ);
447 print_script_errors = 1;
448 settings_add_str("perl", "perl_use_lib", PERL_USE_LIB)settings_add_str_module("perl/core", "perl", "perl_use_lib", "/home/jilles/irssi/lib/perl5/5.8.9/mach"
);
449
450 /*PL_perl_destruct_level = 1; - this crashes with some people.. */
451 perl_signals_init();
452 signal_add_last("script error", (SIGNAL_FUNC) sig_script_error)signal_add_full("perl/core", 100, ("script error"), (SIGNAL_FUNC
) ((SIGNAL_FUNC) sig_script_error), ((void *)0));
453
454 perl_scripts_init();
455
456 if (irssi_init_finished)
457 perl_scripts_autorun();
458 else {
459 signal_add("irssi init finished", (SIGNAL_FUNC) sig_autorun)signal_add_full("perl/core", 0, ("irssi init finished"), (SIGNAL_FUNC
) ((SIGNAL_FUNC) sig_autorun), ((void *)0));
460 settings_check()settings_check_module("perl/core");
461 }
462
463 module_register("perl", "core")module_register_full("perl", "core", "perl/core");
464}
465
466void perl_core_deinit(void)
467{
468 perl_scripts_deinit();
469 perl_signals_deinit();
470
471 signal_remove("script error", (SIGNAL_FUNC) sig_script_error)signal_remove_full(("script error"), (SIGNAL_FUNC) ((SIGNAL_FUNC
) sig_script_error), ((void *)0));
472 PERL_SYS_TERM()Perl_sys_term();
473}