/* $OpenBSD: perl.xs,v 1.4 2009/10/27 23:59:47 deraadt Exp $ */ /*- * Copyright (c) 1992, 1993, 1994 * The Regents of the University of California. All rights reserved. * Copyright (c) 1992, 1993, 1994, 1995, 1996 * Keith Bostic. All rights reserved. * Copyright (c) 1995 * George V. Neville-Neil. All rights reserved. * Copyright (c) 1996 * Sven Verdoolaege. All rights reserved. * * See the LICENSE file for redistribution information. */ #include "config.h" #include #include #include #include #include #include #include #include #include #include #include #include #include "../common/common.h" #include #include #include #include "perl_extern.h" static void msghandler(SCR *, mtype_t, char *, size_t); extern GS *__global_list; /* XXX */ static char *errmsg = 0; /* * INITMESSAGE -- * Macros to point messages at the Perl message handler. */ #define INITMESSAGE \ scr_msg = __global_list->scr_msg; \ __global_list->scr_msg = msghandler; #define ENDMESSAGE \ __global_list->scr_msg = scr_msg; \ if (rval) croak(errmsg); static void xs_init(void); /* * perl_end -- * Clean up perl interpreter * * PUBLIC: int perl_end(GS *); */ int perl_end(gp) GS *gp; { /* * Call perl_run and perl_destuct to call END blocks and DESTROY * methods. */ if (gp->perl_interp) { /*Irestartop = 0; / * XXX */ perl_run(gp->perl_interp); perl_destruct(gp->perl_interp); #if defined(DEBUG) || defined(PURIFY) || defined(LIBRARY) perl_free(gp->perl_interp); #endif } } /* * perl_eval * Evaluate a string * We don't use mortal SVs because no one will clean up after us */ static void perl_eval(string) char *string; { #ifdef HAVE_PERL_5_003_01 SV* sv = newSVpv(string, 0); perl_eval_sv(sv, G_DISCARD | G_NOARGS); SvREFCNT_dec(sv); #else char *argv[2]; argv[0] = string; argv[1] = NULL; perl_call_argv("_eval_", G_EVAL | G_DISCARD | G_KEEPERR, argv); #endif } /* * perl_init -- * Create the perl commands used by nvi. * * PUBLIC: int perl_init(SCR *); */ int perl_init(scrp) SCR *scrp; { AV * av; GS *gp; char *bootargs[] = { "VI", NULL }; #ifndef USE_SFIO SV *svcurscr; #endif #ifndef HAVE_PERL_5_003_01 static char *args[] = { "", "-e", "sub _eval_ { eval $_[0] }" }; #else static char *args[] = { "", "-e", "" }; #endif STRLEN length; char *file = __FILE__; gp = scrp->gp; gp->perl_interp = perl_alloc(); perl_construct(gp->perl_interp); if (perl_parse(gp->perl_interp, xs_init, 3, args, 0)) { perl_destruct(gp->perl_interp); perl_free(gp->perl_interp); gp->perl_interp = NULL; return 1; } perl_call_argv("VI::bootstrap", G_DISCARD, bootargs); perl_eval("$SIG{__WARN__}='VI::Warn'"); av_unshift(av = GvAVn(PL_incgv), 1); av_store(av, 0, newSVpv(_PATH_PERLSCRIPTS, sizeof(_PATH_PERLSCRIPTS)-1)); #ifdef USE_SFIO sfdisc(PerlIO_stdout(), sfdcnewnvi(scrp)); sfdisc(PerlIO_stderr(), sfdcnewnvi(scrp)); #else svcurscr = perl_get_sv("curscr", TRUE); sv_magic((SV *)gv_fetchpv("STDOUT",TRUE, SVt_PVIO), svcurscr, 'q', Nullch, 0); sv_magic((SV *)gv_fetchpv("STDERR",TRUE, SVt_PVIO), svcurscr, 'q', Nullch, 0); #endif /* USE_SFIO */ return (0); } /* * perl_screen_end * Remove all refences to the screen to be destroyed * * PUBLIC: int perl_screen_end(SCR*); */ int perl_screen_end(scrp) SCR *scrp; { if (scrp->perl_private) { sv_setiv((SV*) scrp->perl_private, 0); } return 0; } static void my_sighandler(i) int i; { croak("Perl command interrupted by SIGINT"); } /* Create a new reference to an SV pointing to the SCR structure * The perl_private part of the SCR structure points to the SV, * so there can only be one such SV for a particular SCR structure. * When the last reference has gone (DESTROY is called), * perl_private is reset; When the screen goes away before * all references are gone, the value of the SV is reset; * any subsequent use of any of those reference will produce * a warning. (see typemap) */ static SV * newVIrv(rv, screen) SV *rv; SCR *screen; { sv_upgrade(rv, SVt_RV); if (!screen->perl_private) { screen->perl_private = newSV(0); sv_setiv(screen->perl_private, (IV) screen); } else SvREFCNT_inc(screen->perl_private); SvRV(rv) = screen->perl_private; SvROK_on(rv); return sv_bless(rv, gv_stashpv("VI", TRUE)); } /* * perl_ex_perl -- :[line [,line]] perl [command] * Run a command through the perl interpreter. * * PUBLIC: int perl_ex_perl(SCR*, CHAR_T *, size_t, recno_t, recno_t); */ int perl_ex_perl(scrp, cmdp, cmdlen, f_lno, t_lno) SCR *scrp; CHAR_T *cmdp; size_t cmdlen; recno_t f_lno, t_lno; { static SV *svcurscr = 0, *svstart, *svstop, *svid; GS *gp; STRLEN length; size_t len; char *err; Signal_t (*istat)(); /* Initialize the interpreter. */ gp = scrp->gp; if (!svcurscr) { if (gp->perl_interp == NULL && perl_init(scrp)) return (1); SvREADONLY_on(svcurscr = perl_get_sv("curscr", TRUE)); SvREADONLY_on(svstart = perl_get_sv("VI::StartLine", TRUE)); SvREADONLY_on(svstop = perl_get_sv("VI::StopLine", TRUE)); SvREADONLY_on(svid = perl_get_sv("VI::ScreenId", TRUE)); } sv_setiv(svstart, f_lno); sv_setiv(svstop, t_lno); newVIrv(svcurscr, scrp); /* Backwards compatibility. */ newVIrv(svid, scrp); istat = signal(SIGINT, my_sighandler); perl_eval(cmdp); signal(SIGINT, istat); SvREFCNT_dec(SvRV(svcurscr)); SvROK_off(svcurscr); SvREFCNT_dec(SvRV(svid)); SvROK_off(svid); err = SvPV(GvSV(errgv), length); if (!length) return (0); err[length - 1] = '\0'; msgq(scrp, M_ERR, "perl: %s", err); return (1); } /* * replace_line * replace a line with the contents of the perl variable $_ * lines are split at '\n's * if $_ is undef, the line is deleted * returns possibly adjusted linenumber */ static int replace_line(scrp, line, t_lno) SCR *scrp; recno_t line, *t_lno; { char *str, *next; size_t len; if (SvOK(GvSV(defgv))) { str = SvPV(GvSV(defgv),len); next = memchr(str, '\n', len); api_sline(scrp, line, str, next ? (next - str) : len); while (next++) { len -= next - str; next = memchr(str = next, '\n', len); api_iline(scrp, ++line, str, next ? (next - str) : len); (*t_lno)++; } } else { api_dline(scrp, line--); (*t_lno)--; } return line; } /* * perl_ex_perldo -- :[line [,line]] perl [command] * Run a set of lines through the perl interpreter. * * PUBLIC: int perl_ex_perldo(SCR*, CHAR_T *, size_t, recno_t, recno_t); */ int perl_ex_perldo(scrp, cmdp, cmdlen, f_lno, t_lno) SCR *scrp; CHAR_T *cmdp; size_t cmdlen; recno_t f_lno, t_lno; { static SV *svcurscr = 0, *svstart, *svstop, *svid; CHAR_T *p; GS *gp; STRLEN length; size_t len; recno_t i; char *str; #ifndef HAVE_PERL_5_003_01 char *argv[2]; #else SV* sv; #endif dSP; /* Initialize the interpreter. */ gp = scrp->gp; if (!svcurscr) { if (gp->perl_interp == NULL && perl_init(scrp)) return (1); SPAGAIN; SvREADONLY_on(svcurscr = perl_get_sv("curscr", TRUE)); SvREADONLY_on(svstart = perl_get_sv("VI::StartLine", TRUE)); SvREADONLY_on(svstop = perl_get_sv("VI::StopLine", TRUE)); SvREADONLY_on(svid = perl_get_sv("VI::ScreenId", TRUE)); } #ifndef HAVE_PERL_5_003_01 argv[0] = cmdp; argv[1] = NULL; #else length = strlen(cmdp); sv = newSV(length + sizeof("sub VI::perldo {")-1 + 1 /* } */); sv_setpvn(sv, "sub VI::perldo {", sizeof("sub VI::perldo {")-1); sv_catpvn(sv, cmdp, length); sv_catpvn(sv, "}", 1); perl_eval_sv(sv, G_DISCARD | G_NOARGS); SvREFCNT_dec(sv); str = SvPV(GvSV(errgv),length); if (length) goto err; #endif newVIrv(svcurscr, scrp); /* Backwards compatibility. */ newVIrv(svid, scrp); ENTER; SAVETMPS; for (i = f_lno; i <= t_lno && !api_gline(scrp, i, &str, &len); i++) { sv_setpvn(GvSV(defgv),str,len); sv_setiv(svstart, i); sv_setiv(svstop, i); #ifndef HAVE_PERL_5_003_01 perl_call_argv("_eval_", G_SCALAR | G_EVAL | G_KEEPERR, argv); #else PUSHMARK(sp); perl_call_pv("VI::perldo", G_SCALAR | G_EVAL); #endif str = SvPV(GvSV(errgv), length); if (length) break; SPAGAIN; if(SvTRUEx(POPs)) i = replace_line(scrp, i, &t_lno); PUTBACK; } FREETMPS; LEAVE; SvREFCNT_dec(SvRV(svcurscr)); SvROK_off(svcurscr); SvREFCNT_dec(SvRV(svid)); SvROK_off(svid); if (!length) return (0); err: str[length - 1] = '\0'; msgq(scrp, M_ERR, "perl: %s", str); return (1); } /* * msghandler -- * Perl message routine so that error messages are processed in * Perl, not in nvi. */ static void msghandler(sp, mtype, msg, len) SCR *sp; mtype_t mtype; char *msg; size_t len; { /* Replace the trailing with an EOS. */ /* Let's do that later instead */ if (errmsg) free (errmsg); errmsg = malloc(len + 1); memcpy(errmsg, msg, len); errmsg[len] = '\0'; } /* Register any extra external extensions */ extern void boot_DynaLoader _((CV* cv)); extern void boot_VI _((CV* cv)); static void xs_init() { char *file = __FILE__; #ifdef HAVE_PERL_5_003_01 dXSUB_SYS; #endif newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); newXS("VI::bootstrap", boot_VI, file); } typedef SCR * VI; typedef SCR * VI__OPT; typedef SCR * VI__MAP; typedef SCR * VI__MARK; typedef AV * AVREF; MODULE = VI PACKAGE = VI # msg -- # Set the message line to text. # # Perl Command: VI::Msg # Usage: VI::Msg screenId text void Msg(screen, text) VI screen char * text ALIAS: PRINT = 1 CODE: api_imessage(screen, text); # XS_VI_escreen -- # End a screen. # # Perl Command: VI::EndScreen # Usage: VI::EndScreen screenId void EndScreen(screen) VI screen PREINIT: void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; CODE: INITMESSAGE; rval = api_escreen(screen); ENDMESSAGE; # XS_VI_iscreen -- # Create a new screen. If a filename is specified then the screen # is opened with that file. # # Perl Command: VI::NewScreen # Usage: VI::NewScreen screenId [file] VI Edit(screen, ...) VI screen ALIAS: NewScreen = 1 PROTOTYPE: $;$ PREINIT: void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; char *file; SCR *nsp; CODE: file = (items == 1) ? NULL : (char *)SvPV(ST(1),na); INITMESSAGE; rval = api_edit(screen, file, &nsp, ix); ENDMESSAGE; RETVAL = ix ? nsp : screen; OUTPUT: RETVAL # XS_VI_fscreen -- # Return the screen id associated with file name. # # Perl Command: VI::FindScreen # Usage: VI::FindScreen file VI FindScreen(file) char *file PREINIT: SCR *fsp; CODE: RETVAL = api_fscreen(0, file); # XS_VI_aline -- # -- Append the string text after the line in lineNumber. # # Perl Command: VI::AppendLine # Usage: VI::AppendLine screenId lineNumber text void AppendLine(screen, linenumber, text) VI screen int linenumber char *text PREINIT: void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; STRLEN length; CODE: SvPV(ST(2), length); INITMESSAGE; rval = api_aline(screen, linenumber, text, length); ENDMESSAGE; # XS_VI_dline -- # Delete lineNum. # # Perl Command: VI::DelLine # Usage: VI::DelLine screenId lineNum void DelLine(screen, linenumber) VI screen int linenumber PREINIT: void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; CODE: INITMESSAGE; rval = api_dline(screen, (recno_t)linenumber); ENDMESSAGE; # XS_VI_gline -- # Return lineNumber. # # Perl Command: VI::GetLine # Usage: VI::GetLine screenId lineNumber char * GetLine(screen, linenumber) VI screen int linenumber PREINIT: size_t len; void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; char *line, *p; PPCODE: INITMESSAGE; rval = api_gline(screen, (recno_t)linenumber, &p, &len); ENDMESSAGE; EXTEND(sp,1); PUSHs(sv_2mortal(newSVpv(p, len))); # XS_VI_sline -- # Set lineNumber to the text supplied. # # Perl Command: VI::SetLine # Usage: VI::SetLine screenId lineNumber text void SetLine(screen, linenumber, text) VI screen int linenumber char *text PREINIT: void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; STRLEN length; CODE: SvPV(ST(2), length); INITMESSAGE; rval = api_sline(screen, linenumber, text, length); ENDMESSAGE; # XS_VI_iline -- # Insert the string text before the line in lineNumber. # # Perl Command: VI::InsertLine # Usage: VI::InsertLine screenId lineNumber text void InsertLine(screen, linenumber, text) VI screen int linenumber char *text PREINIT: void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; STRLEN length; CODE: SvPV(ST(2), length); INITMESSAGE; rval = api_iline(screen, linenumber, text, length); ENDMESSAGE; # XS_VI_lline -- # Return the last line in the screen. # # Perl Command: VI::LastLine # Usage: VI::LastLine screenId int LastLine(screen) VI screen PREINIT: recno_t last; void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; CODE: INITMESSAGE; rval = api_lline(screen, &last); ENDMESSAGE; RETVAL=last; OUTPUT: RETVAL # XS_VI_getmark -- # Return the mark's cursor position as a list with two elements. # {line, column}. # # Perl Command: VI::GetMark # Usage: VI::GetMark screenId mark void GetMark(screen, mark) VI screen char mark PREINIT: struct _mark cursor; void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; PPCODE: INITMESSAGE; rval = api_getmark(screen, (int)mark, &cursor); ENDMESSAGE; EXTEND(sp,2); PUSHs(sv_2mortal(newSViv(cursor.lno))); PUSHs(sv_2mortal(newSViv(cursor.cno))); # XS_VI_setmark -- # Set the mark to the line and column numbers supplied. # # Perl Command: VI::SetMark # Usage: VI::SetMark screenId mark line column void SetMark(screen, mark, line, column) VI screen char mark int line int column PREINIT: struct _mark cursor; void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; CODE: INITMESSAGE; cursor.lno = line; cursor.cno = column; rval = api_setmark(screen, (int)mark, &cursor); ENDMESSAGE; # XS_VI_getcursor -- # Return the current cursor position as a list with two elements. # {line, column}. # # Perl Command: VI::GetCursor # Usage: VI::GetCursor screenId void GetCursor(screen) VI screen PREINIT: struct _mark cursor; void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; PPCODE: INITMESSAGE; rval = api_getcursor(screen, &cursor); ENDMESSAGE; EXTEND(sp,2); PUSHs(sv_2mortal(newSViv(cursor.lno))); PUSHs(sv_2mortal(newSViv(cursor.cno))); # XS_VI_setcursor -- # Set the cursor to the line and column numbers supplied. # # Perl Command: VI::SetCursor # Usage: VI::SetCursor screenId line column void SetCursor(screen, line, column) VI screen int line int column PREINIT: struct _mark cursor; void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; CODE: INITMESSAGE; cursor.lno = line; cursor.cno = column; rval = api_setcursor(screen, &cursor); ENDMESSAGE; # XS_VI_swscreen -- # Change the current focus to screen. # # Perl Command: VI::SwitchScreen # Usage: VI::SwitchScreen screenId screenId void SwitchScreen(screenFrom, screenTo) VI screenFrom VI screenTo PREINIT: void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; CODE: INITMESSAGE; rval = api_swscreen(screenFrom, screenTo); ENDMESSAGE; # XS_VI_map -- # Associate a key with a perl procedure. # # Perl Command: VI::MapKey # Usage: VI::MapKey screenId key perlproc void MapKey(screen, key, perlproc) VI screen char *key SV *perlproc PREINIT: void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; int length; char *command; SV *svc; CODE: INITMESSAGE; svc = sv_2mortal(newSVpv(":perl ", 6)); sv_catsv(svc, perlproc); command = SvPV(svc, length); rval = api_map(screen, key, command, length); ENDMESSAGE; # XS_VI_unmap -- # Unmap a key. # # Perl Command: VI::UnmapKey # Usage: VI::UnmmapKey screenId key void UnmapKey(screen, key) VI screen char *key PREINIT: void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; CODE: INITMESSAGE; rval = api_unmap(screen, key); ENDMESSAGE; # XS_VI_opts_set -- # Set an option. # # Perl Command: VI::SetOpt # Usage: VI::SetOpt screenId setting void SetOpt(screen, setting) VI screen char *setting PREINIT: void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; SV *svc; CODE: INITMESSAGE; svc = sv_2mortal(newSVpv(":set ", 5)); sv_catpv(svc, setting); rval = api_run_str(screen, SvPV(svc, na)); ENDMESSAGE; # XS_VI_opts_get -- # Return the value of an option. # # Perl Command: VI::GetOpt # Usage: VI::GetOpt screenId option void GetOpt(screen, option) VI screen char *option PREINIT: void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; char *value; PPCODE: INITMESSAGE; rval = api_opts_get(screen, option, &value, NULL); ENDMESSAGE; EXTEND(SP,1); PUSHs(sv_2mortal(newSVpv(value, 0))); free(value); # XS_VI_run -- # Run the ex command cmd. # # Perl Command: VI::Run # Usage: VI::Run screenId cmd void Run(screen, command) VI screen char *command; PREINIT: void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; CODE: INITMESSAGE; rval = api_run_str(screen, command); ENDMESSAGE; void DESTROY(screen) VI screen CODE: screen->perl_private = 0; void Warn(warning) char *warning; PREINIT: int i; CODE: sv_catpv(GvSV(errgv),warning); #define TIED(package) \ sv_magic((SV *) (hv = \ (HV *)sv_2mortal((SV *)newHV())), \ sv_setref_pv(sv_newmortal(), package, \ newVIrv(newSV(0), screen)),\ 'P', Nullch, 0);\ RETVAL = newRV((SV *)hv) SV * Opt(screen) VI screen; PREINIT: HV *hv; CODE: TIED("VI::OPT"); OUTPUT: RETVAL SV * Map(screen) VI screen; PREINIT: HV *hv; CODE: TIED("VI::MAP"); OUTPUT: RETVAL SV * Mark(screen) VI screen PREINIT: HV *hv; CODE: TIED("VI::MARK"); OUTPUT: RETVAL MODULE = VI PACKAGE = VI::OPT void DESTROY(screen) VI::OPT screen CODE: # typemap did all the checking SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0)))); void FETCH(screen, key) VI::OPT screen char *key PREINIT: void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; char *value; int boolvalue; PPCODE: INITMESSAGE; rval = api_opts_get(screen, key, &value, &boolvalue); if (!rval) { EXTEND(SP,1); PUSHs(sv_2mortal((boolvalue == -1) ? newSVpv(value, 0) : newSViv(boolvalue))); free(value); } else ST(0) = &sv_undef; rval = 0; ENDMESSAGE; void STORE(screen, key, value) VI::OPT screen char *key SV *value PREINIT: void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; CODE: INITMESSAGE; rval = api_opts_set(screen, key, SvPV(value, na), SvIV(value), SvTRUEx(value)); ENDMESSAGE; MODULE = VI PACKAGE = VI::MAP void DESTROY(screen) VI::MAP screen CODE: # typemap did all the checking SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0)))); void STORE(screen, key, perlproc) VI::MAP screen char *key SV *perlproc PREINIT: void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; int length; char *command; SV *svc; CODE: INITMESSAGE; svc = sv_2mortal(newSVpv(":perl ", 6)); sv_catsv(svc, perlproc); command = SvPV(svc, length); rval = api_map(screen, key, command, length); ENDMESSAGE; void DELETE(screen, key) VI::MAP screen char *key PREINIT: void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; CODE: INITMESSAGE; rval = api_unmap(screen, key); ENDMESSAGE; MODULE = VI PACKAGE = VI::MARK void DESTROY(screen) VI::MARK screen CODE: # typemap did all the checking SvREFCNT_dec((SV*)SvIV((SV*)SvRV(ST(0)))); AV * FETCH(screen, mark) VI::MARK screen char mark PREINIT: struct _mark cursor; void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; CODE: INITMESSAGE; rval = api_getmark(screen, (int)mark, &cursor); ENDMESSAGE; RETVAL = newAV(); av_push(RETVAL, newSViv(cursor.lno)); av_push(RETVAL, newSViv(cursor.cno)); OUTPUT: RETVAL void STORE(screen, mark, pos) VI::MARK screen char mark AVREF pos PREINIT: struct _mark cursor; void (*scr_msg)(SCR *, mtype_t, char *, size_t); int rval; CODE: if (av_len(pos) < 1) croak("cursor position needs 2 elements"); INITMESSAGE; cursor.lno = SvIV(*av_fetch(pos, 0, 0)); cursor.cno = SvIV(*av_fetch(pos, 1, 0)); rval = api_setmark(screen, (int)mark, &cursor); ENDMESSAGE; void FIRSTKEY(screen, ...) VI::MARK screen ALIAS: NEXTKEY = 1 PROTOTYPE: $;$ PREINIT: struct _mark cursor; void (*scr_msg)(SCR *, mtype_t, char *, size_t); int next; char key[] = {0, 0}; PPCODE: if (items == 2) { next = 1; *key = *(char *)SvPV(ST(1),na); } else next = 0; if (api_nextmark(screen, next, key) != 1) { EXTEND(sp, 1); PUSHs(sv_2mortal(newSVpv(key, 1))); } else ST(0) = &sv_undef;