This commit is contained in:
joonicks
2018-04-02 18:33:49 +02:00
parent d9fac6178c
commit f50111b895
14 changed files with 433 additions and 255 deletions

View File

@@ -31,6 +31,8 @@ WARNFLAG = @W_FLAGS@
OPTIMIZE = @O_FLAGS@
PYINCLUDE = @PYINCLUDE@
TCLINCLUDE = @TCLINCLUDE@
I_PERL = @I_PERL@
L_PERL = @L_PERL@
CFLAGS = $(PIPEFLAG) $(GDBFLAG) $(WARNFLAG) $(OPTIMIZE)
LFLAGS = $(PIPEFLAG) $(GDBFLAG)
@@ -58,6 +60,8 @@ SRCFILES = alias.c auth.c bounce.c chanban.c channel.c core.c \
spy.c stats.c tcl.c telnet.c toybox.c trivia.c uptime.c urlcap.c \
user.c vars.c web.c
.PHONY: all clean mega-install mega mega-static test commands
all: $(INSTALLNAME)
#
@@ -78,16 +82,16 @@ install: $(INSTALLNAME)
$(CHMOD) $(INSTALLMODE) $(INSTALLNAME)
$(MV) $(INSTALLNAME) $(INSTALLDIR)
clean: FORCE
clean:
$(RM) $(INSTALLNAME) gencmd mcmd.h usercombo.h core $(TESTFILES) $(OFILES)
$(INSTALLNAME): $(OFILES)
$(CROSS_COMPILE)$(CC) $(LFLAGS) -o $(INSTALLNAME) $(OFILES) $(LPROF) $(LIBS) $(LDSCRIPT)
$(CROSS_COMPILE)$(CC) $(LFLAGS) -o $(INSTALLNAME) $(OFILES) $(LPROF) $(LIBS) $(LDSCRIPT) $(L_PERL)
@oc@ $(CROSS_COMPILE)objcopy -R .note -R .comment $(INSTALLNAME)
@sz@ size $(INSTALLNAME)
$(INSTALLNAME)-static: $(OFILES)
$(CROSS_COMPILE)$(CC) $(LFLAGS) -o $(INSTALLNAME) $(OFILES) $(LPROF) $(LIBS) $(LDSCRIPT) -static
$(CROSS_COMPILE)$(CC) $(LFLAGS) -o $(INSTALLNAME) $(OFILES) $(LPROF) $(LIBS) $(LDSCRIPT) $(L_PERL) -static
@oc@ $(CROSS_COMPILE)objcopy -R .note -R .comment $(INSTALLNAME)
@sz@ size $(INSTALLNAME)
@@ -103,12 +107,12 @@ mega-install: mega $(SRCFILES) $(INCS) usage.h
$(MV) $(INSTALLNAME) $(INSTALLDIR)
mega: $(SRCFILES) $(INCS) usage.h
$(CROSS_COMPILE)$(CC) $(CFLAGS) -o $(INSTALLNAME) mega.c $(LPROF) $(LIBS) $(LDSCRIPT) $(PYINCLUDE) $(TCLINCLUDE)
$(CROSS_COMPILE)$(CC) $(CFLAGS) -o $(INSTALLNAME) mega.c $(LPROF) $(LIBS) $(LDSCRIPT) $(PYINCLUDE) $(TCLINCLUDE) $(I_PERL) $(L_PERL)
@oc@ $(CROSS_COMPILE)objcopy -R .note -R .comment $(INSTALLNAME)
@sz@ size $(INSTALLNAME)
mega-static: $(SRCFILES) $(INCS) usage.h
$(CROSS_COMPILE)$(CC) $(CFLAGS) -o $(INSTALLNAME) mega.c $(LPROF) $(LIBS) $(LDSCRIPT) $(PYINCLUDE) $(TCLINCLUDE) -static
$(CROSS_COMPILE)$(CC) $(CFLAGS) -o $(INSTALLNAME) mega.c $(LPROF) $(LIBS) $(LDSCRIPT) $(PYINCLUDE) $(TCLINCLUDE) $(I_PERL) $(L_PERL) -static
@oc@ $(CROSS_COMPILE)objcopy -R .note -R .comment $(INSTALLNAME)
@sz@ size $(INSTALLNAME)
@@ -203,7 +207,7 @@ parse.o: parse.c $(INCS)
$(CROSS_COMPILE)$(CC) $(CFLAGS) -c $< $(CPROF)
perl.o: perl.c $(INCS)
$(CROSS_COMPILE)$(CC) $(CFLAGS) -c $< $(CPROF)
$(CROSS_COMPILE)$(CC) $(CFLAGS) $(I_PERL) -c $< $(CPROF)
prot.o: prot.c $(INCS)
$(CROSS_COMPILE)$(CC) $(CFLAGS) -c $< $(CPROF)
@@ -265,4 +269,3 @@ md5/md5.o: md5/md5.c $(INCS)
sha/sha1.o: sha/sha1.c $(INCS)
$(CROSS_COMPILE)$(CC) $(CFLAGS) -c $< -o $@ -Isha1 $(CPROF)
FORCE:

View File

@@ -1238,7 +1238,7 @@ void debug_rawdns(void)
#endif /* RAWDNS */
#if defined(TCL) || defined(PYTHON)
#if defined(TCL) || defined(PYTHON) || defined(PERL)
#if 0
typedef struct

View File

@@ -179,7 +179,7 @@ struct
* Level 70 == JOINLEVEL
*/
{ 0, "CYCLE", "do_cycle", 70 | CCPW | CAXS | ACCHAN },
{ 0, "FORGET", "do_forget", 70 | CCPW | CARGS },
{ 0, "FORGET", "do_forget", 70 | CCPW | CAXS | CARGS },
{ 0, "JOIN", "do_join", 70 | CCPW | CARGS },
{ 0, "KS", "do_kicksay", 70 | CCPW | REDIR | LBUF },
{ 0, "PART", "do_part", 70 | CCPW | CAXS | ACCHAN },
@@ -251,6 +251,12 @@ struct
{ 0, "DEBUG", "do_debug", 100 | CCPW | GAXS },
{ 0, "CRASH", "do_crash", 100 | CCPW | GAXS },
#endif /* DEBUG */
#ifdef PERL
#ifdef PLEASE_HACK_MY_SHELL
{ 0, "PERL", "do_perl", 100 | CCPW | GAXS | CARGS },
#endif /* PLEASE_HACK_MY_SHELL */
{ 0, "PERLSCRIPT", "do_perlscript", 100 | CCPW | GAXS | CARGS },
#endif /* PERL */
#ifdef PYTHON
#ifdef PLEASE_HACK_MY_SHELL
{ 0, "PYTHON", "do_python", 100 | CCPW | GAXS | CARGS },

View File

@@ -190,6 +190,10 @@ LS void netchanSuppress(BotNet *, char *) __page(CORE_SEG);
/* ons.c */
/* parse.c */
/* perl.c */
LS void do_perl(COMMAND_ARGS) __page(CMD1_SEG);
LS void do_perlscript(COMMAND_ARGS) __page(CMD1_SEG);
/* prot.c */
/* python.c */
/* redirect.c */

View File

@@ -402,8 +402,8 @@ void sig_segv(int crap, siginfo_t *si, void *uap)
debug("(sigsegv) trying to access "mx_pfmt"\n",(mx_ptr)si->si_addr);
#ifdef __x86_64__
mctx = &((ucontext_t *)uap)->uc_mcontext;
rsp = &mctx->gregs[15]; // RSP, 64-bit stack pointer
rip = &mctx->gregs[16]; // RIP, 64-bit instruction pointer
rsp = &mctx->gregs[15]; // RSP, 64-bit stack pointer
rip = &mctx->gregs[16]; // RIP, 64-bit instruction pointer
debug("(sigsegv) Stack pointer: "mx_pfmt", Instruction pointer: "mx_pfmt"\n",(mx_ptr)*rsp,(mx_ptr)*rip);
debug("(sigsegv) sig_segv() = "mx_pfmt"\n",(mx_ptr)sig_segv);
@@ -948,6 +948,9 @@ execve( ./energymech, argv = { ./energymech <NULL> <NULL> <NULL> <NULL> }, envp
else
to_file(1,"error: Missing argument for -p <string>\n");
_exit(0);
case 't':
startup = 666;
break;
case 'X':
debug_on_exit = TRUE;
break;
@@ -1120,6 +1123,8 @@ execve( ./energymech, argv = { ./energymech <NULL> <NULL> <NULL> <NULL> }, envp
#endif /* DEBUG */
}
if (startup == 666)
exit(0);
startup = FALSE;
doit();
}

View File

@@ -1,8 +1,8 @@
/*
EnergyMech, IRC bot software
Copyright (c) 2001-2009 proton
Copyright (c) 2001 MadCamel
Copyright (c) 2001-2018 proton
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@@ -19,11 +19,17 @@
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
#define PERL_C
#include "config.h"
#ifdef PERL
#ifdef __x86_64__
typedef __off64_t off64_t;
#define __off64_t_defined
#endif /* __x86_64__ */
#include "defines.h"
#include "structs.h"
#include "global.h"
@@ -31,12 +37,12 @@
#include "text.h"
#include "mcmd.h"
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "EXTERN.h"
#include "XSUB.h"
#include "perl.h"
PerlInterpreter *energymech_perl = NULL;
#define my_perl energymech_perl
/*
* parse_jump() translates from C to perl
@@ -55,8 +61,8 @@ int perl_parse_jump(char *from, char *rest, Hook *hook)
args[1] = rest;
args[2] = NULL;
/* Call_argv returns the # of args returned from perl */
if (call_argv(Hook->self, G_EVAL|G_SCALAR, args) < 1)
/* call_argv returns the # of args returned from perl */
if (call_argv(hook->self, G_EVAL|G_SCALAR, args) < 1)
return(0);
SPAGAIN; /* Rehash stack, it's probably been clobbered */
@@ -76,8 +82,8 @@ int perl_parse_jump(char *from, char *rest, Hook *hook)
XS(XS_perl_parse_hook)
{
Hook *hook;
char *name, *sub;
int c;
char *name, *sub;
int c;
dXSARGS; items = 0;
/*
@@ -86,29 +92,23 @@ XS(XS_perl_parse_hook)
* but I don't know if it's safe to point directly in to perl
* space like that.
*/
if ((name = strdup(SvPV(ST(0), i)))) == NULL)
if ((name = SvPV_nolen(ST(0))) == NULL)
XSRETURN_EMPTY;
if ((sub = strdup(SvPV(ST(0), i)))) == NULL)
{
free(name);
if ((sub = SvPV_nolen(ST(0))) == NULL)
XSRETURN_EMPTY;
}
/*
* make a Hook struct and link it into the parse hook list
*/
set_mallocdoer(perl_parse_hook);
set_mallocdoer(XS_perl_parse_hook);
hook = (Hook*)Calloc(sizeof(Hook) + Strlen2(name,sub)); // sub is never NULL
hook->func = perl_parse_jump;
hook->next = hooklist;
hooklist = hook;
hook->command = Strcpy(hook->self,sub) + 1;
Strcpy(hook->command,name);
free(name);
free(sub);
hook->type.command = Strcpy(hook->self,sub) + 1;
Strcpy(hook->type.command,name);
/*
* return successful status to script
@@ -126,7 +126,7 @@ void init_perl(void)
/*
* make parse_hook() callable from scripts
*/
newXS("mech::parse_hook", XS_perl_parse_hook, "mech");
newXS("mech::hook", XS_perl_parse_hook, "mech");
}
void do_perl(COMMAND_ARGS)
@@ -134,6 +134,8 @@ void do_perl(COMMAND_ARGS)
/*
* call init_perl() if the perl interpreter isnt initialized yet
*/
if (energymech_perl == NULL)
init_perl();
/*
* call the perl interpreter with the content of *rest
@@ -152,6 +154,8 @@ void do_perlscript(COMMAND_ARGS)
/*
* call init_perl() if the perl interpreter isnt initialized yet
*/
if (energymech_perl == NULL)
init_perl();
/*
* chop(&rest) for name of script filename and load it into the perl interpreter
@@ -160,10 +164,10 @@ void do_perlscript(COMMAND_ARGS)
args[1] = chop(&rest);
/* FIXME: Trap parse errors */
perl_parse(energymech_perl, NULL, 1, argv, (char **)NULL);
perl_parse(energymech_perl, NULL, 1, args, (char **)NULL);
/* Call sub named Init, what should contain
* mech::perl_parse_hook("PRIVMSG", "yoink_privmsg");
* mech::hook("PRIVMSG", "yoink_privmsg");
* Note to self: Wouldn't it be better to pass subs by
* Reference(perl ver of pointer) instead of name?
* How the fsck do i do that?!
@@ -173,7 +177,7 @@ void do_perlscript(COMMAND_ARGS)
{
STRLEN n_a;
to_user(from, "perl script %s failed to init: %s",
argv[1], SvPV(ERRSV, n_a));
args[1], SvPV(ERRSV, n_a));
}
/*
* be verbose about success or fail to the user

View File

@@ -325,7 +325,7 @@ void trivia_no_answer(void)
char *random_question(char *triv_rand)
{
char *p;
char *p,tmpname[120];
off_t sz;
int fd,ifd;
int n;
@@ -336,10 +336,22 @@ char *random_question(char *triv_rand)
} entry;
if ((fd = open(triv_qfile,O_RDONLY)) < 0)
if (STRCHR(triv_qfile,'/') || strlen(triv_qfile) > 100) // really bad filenames...
return(NULL);
Strcpy(triv_rand,triv_qfile);
Strcat(Strcpy(tmpname,"trivia/"),triv_qfile);
if ((fd = open(tmpname,O_RDONLY)) < 0)
#ifdef DEBUG
{
debug("(random_question) %s: %s\n",tmpname,strerror(errno));
return(NULL);
}
#else
return(NULL);
#endif /* DEBUG */
Strcpy(triv_rand,tmpname);
if ((p = STRCHR(triv_rand,'.')) == NULL)
p = STREND(triv_rand);
Strcpy(p,".index");