Posted to tcl by stu at Fri Jan 26 15:54:38 GMT 2018view pretty
/* * Copyright (c) 2015,2017 Stuart Cassoff <stwo@users.sourceforge.net> * * Permission to use, copy, modify, and/or distribute this software for any * purpose with or without fee is hereby granted, provided that the above * copyright notice and this permission notice appear in all copies. * * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. */ /* * tjpledge.c * * Tcl / Jim interface to pledge(3). * */ /* * Notes: * */ #ifdef __cplusplus extern "C" { #endif #include <unistd.h> #include <errno.h> #include <string.h> /* strerror */ #define COMBIEN(Z) ((int) (sizeof(Z) / sizeof(Z[0]))) #ifdef FOR_JIM #include <jim-subcmd.h> # define EZT_OK JIM_OK # define EZT_ERROR JIM_ERR # define Ezt_Alloc Jim_Alloc # define Ezt_Free Jim_Free # define Ezt_PosixError() strerror(errno) # define Ezt_WrongNumArgs Jim_WrongNumArgs # define Ezt_IncrRefCount Jim_IncrRefCount # define Ezt_DecrRefCount(O) Jim_DecrRefCount(interp,(O)) # define Ezt_SetResult(O) Jim_SetResult(interp,(O)) # define Ezt_Obj Jim_Obj # define Ezt_Interp Jim_Interp # define Ezt_NewInt(I) Ezt_NewIntObj(interp,(I)) # define Ezt_GetInt(I,P) Ezt_GetIntFromJimObj(interp,(I),(P)) # define Ezt_NewWide(I) Jim_NewWideObj(interp,(I)) # define Ezt_GetWide Jim_GetWide # define Ezt_NewString(S,L) Jim_NewStringObj(interp,(S),(L)) # define Ezt_GetString Jim_GetString # define Ezt_GetBytes Jim_GetString # define Ezt_NewList() Jim_NewListObj(interp, NULL, 0) # define Ezt_ListAppend(L,O) Jim_ListAppendElement(interp,(L),(O)) # define Ezt_NewDict() Jim_NewDictObj(interp, NULL, 0) # define Ezt_DictPut(D,KO,VO) Jim_DictAddElement(interp,(D),(KO),(VO)) # define ezt_wide jim_wide # define EZT_SUBCMD(S) int (S) (Ezt_Interp *interp, int objc, Ezt_Obj *const *objv) # define EZT_CMD(S) int (S) (Ezt_Interp *interp, int objc, Ezt_Obj *const *objv) # define ezt_subcmd_type jim_subcmd_type #else # include <tcl.h> # define EZT_OK TCL_OK # define EZT_ERROR TCL_ERROR # define Ezt_Alloc ckalloc # define Ezt_Free ckfree # define Ezt_PosixError() Tcl_PosixError(interp) # define Ezt_WrongNumArgs Tcl_WrongNumArgs # define Ezt_IncrRefCount Tcl_IncrRefCount # define Ezt_DecrRefCount(O) Tcl_DecrRefCount((O)) # define Ezt_SetResult(O) Tcl_SetObjResult(interp,(O)) # define Ezt_Obj Tcl_Obj # define Ezt_Interp Tcl_Interp # define Ezt_NewInt Tcl_NewIntObj # define Ezt_GetInt(I,P) Tcl_GetIntFromObj(interp,(I),(P)) # define Ezt_NewWide Tcl_NewWideIntObj # define Ezt_GetWide Tcl_GetWideIntFromObj # define Ezt_NewString Tcl_NewStringObj # define Ezt_GetString Tcl_GetStringFromObj # define Ezt_GetBytes Tcl_GetByteArrayFromObj # define Ezt_NewList() Tcl_NewListObj(0,NULL) # define Ezt_ListAppend(L,O) Tcl_ListObjAppendElement(interp,(L),(O)) # define Ezt_NewDict() Tcl_NewDictObj() # define Ezt_DictPut(D,KO,VO) Tcl_DictObjPut(interp,(D),(KO),(VO)) # define ezt_wide TclWideInt # define EZT_SUBCMD(S) int (S) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) # define EZT_CMD EZT_SUBCMD typedef struct { const char *name; const char *args; Tcl_ObjCmdProc *proc; short minargs; short maxargs; unsigned short flags; } ezt_subcmd_type; #endif #if 0 /* unused in this prog */ #ifdef FOR_JIM static Jim_Obj * Ezt_NewIntObj (Jim_Interp *interp, int i) { return Jim_NewWideObj(interp, (ezt_wide) i); } static int Ezt_GetIntFromJimObj (Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr) { jim_wide w; if (Jim_GetWide(interp, objPtr, &w) != JIM_OK) { return JIM_ERR; } *intPtr = (int) w; return JIM_OK; } #endif #endif static EZT_CMD(TJPledge_PledgeCmd); /***/ #ifdef FOR_TCL_WENC static EZT_CMD(TJPledge_PledgeCmd) { Tcl_DString req; int ret = EZT_OK; if (objc < 2 || objc > 3) { Ezt_WrongNumArgs(interp, 1, objv, "promises ?paths?"); return EZT_ERROR; } Tcl_DStringInit(&req); Tcl_UtfToExternalDString(NULL, Ezt_GetString(objv[1], NULL), -1, &req); if (objc == 2) { if (pledge(Tcl_DStringValue(&req), NULL) == -1) { Ezt_SetResult(Ezt_NewString(Tcl_PosixError(interp), -1)); ret = EZT_ERROR; } } else if (objc == 3) { const char **paths = NULL; Tcl_DString *dsa; int lobjc; Ezt_Obj **lobjv; int i; if (Tcl_ListObjGetElements(interp, objv[2], &lobjc, &lobjv) != EZT_OK) { ret = EZT_ERROR; goto quitting; } dsa = ckalloc(lobjc * sizeof(*dsa)); paths = ckalloc((lobjc + 1) * sizeof(*paths)); for (i = 0; i < lobjc; i++) { Tcl_DStringInit(&dsa[i]); paths[i] = Tcl_UtfToExternalDString(NULL, Tcl_GetString(lobjv[i]), -1, &dsa[i]); } paths[i] = NULL; if (pledge(Tcl_DStringValue(&req), paths) == -1) { Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp), -1)); ret = EZT_ERROR; } for (i = 0; paths[i] != NULL; i++) { Tcl_DStringFree(&dsa[i]); } ckfree(dsa); ckfree(paths); } quitting:; Tcl_DStringFree(&req); return ret; } #else /* !FOR_TCL_WENC */ static EZT_CMD(TJPledge_PledgeCmd) { const char **paths = NULL; int ret = EZT_OK; if (objc < 2 || objc > 3) { Ezt_WrongNumArgs(interp, 1, objv, "promises ?paths?"); return EZT_ERROR; } if (objc == 3) { int llen, i; Ezt_Obj *o; #ifdef FOR_JIM llen = Jim_ListLength(interp, objv[2]); #else Ezt_Obj **lobjv; if (Tcl_ListObjGetElements(interp, objv[2], &llen, &lobjv) != EZT_OK) { return EZT_ERROR; } #endif paths = (const char **) Ezt_Alloc((llen + 1) * sizeof(*paths)); for (i = 0; i < llen; i++) { #ifdef FOR_JIM o = Jim_ListGetIndex(interp, objv[2], i); #else o = lobjv[i]; #endif paths[i] = Ezt_GetString(o, NULL); } paths[i] = NULL; } if (pledge(Ezt_GetString(objv[1], NULL), paths) == -1) { Ezt_SetResult(Ezt_NewString(Ezt_PosixError(), -1)); ret = EZT_ERROR; } Ezt_Free((char *) paths); return ret; } #endif /* FOR_TCL_WENC */ /***/ #ifdef FOR_JIM int Jim_pledgeInit (Jim_Interp *interp) { if (Jim_CreateCommand(interp, "pledge", TJPledge_PledgeCmd, NULL, NULL) != JIM_OK) { return JIM_ERR; } if (Jim_PackageProvide(interp, PACKAGE_NAME, PACKAGE_VERSION, JIM_ERRMSG) != JIM_OK) { return JIM_ERR; } return JIM_OK; } #else #define MIN_TCL_VERSION "8.5" #define TJPledge_NS "::pledge" #define TJPledge_CMD "pledge" static int TJPledge_CommonInit ( Tcl_Interp *interp ) { if (Tcl_InitStubs (interp, MIN_TCL_VERSION, 0) == NULL) { return TCL_ERROR; } if (Tcl_PkgRequire (interp, "Tcl", MIN_TCL_VERSION, 0) == NULL) { return TCL_ERROR; } if (Tcl_CreateNamespace (interp, TJPledge_NS, NULL, NULL) == NULL) { return TCL_ERROR; } if (Tcl_PkgProvide (interp, PACKAGE_NAME, PACKAGE_VERSION) != TCL_OK) { return TCL_ERROR; } return TCL_OK; } EXTERN int Pledge_Init ( Tcl_Interp *interp ) { Tcl_Namespace *ns; if (TJPledge_CommonInit(interp) != TCL_OK) { return TCL_ERROR; } if ((ns = Tcl_FindNamespace(interp, TJPledge_NS, NULL, TCL_LEAVE_ERR_MSG)) == NULL) { return TCL_ERROR; } if (Tcl_CreateObjCommand(interp, TJPledge_NS "::" TJPledge_CMD, TJPledge_PledgeCmd, NULL, NULL) == NULL) { return TCL_ERROR; } if (Tcl_Export(interp, ns, TJPledge_CMD, 0) != TCL_OK) { return TCL_ERROR; } return TCL_OK; } EXTERN int Pledge_SafeInit ( Tcl_Interp *interp ) { return TJPledge_CommonInit(interp); } #endif #ifdef __cplusplus } #endif /* EOF */