Posted to tcl by stu at Fri Jan 26 15:54:38 GMT 2018view raw
- /*
- * 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 */