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 */