source: libabac/abac_pl_yap.c @ d0efdec

/* copied from abac_graph.c 
   implementation of the low level using
   yap prolog
*/

#include <err.h>
#include <stdio.h>
#include <assert.h>
#include <stdlib.h>
#include <string.h>
#include <Yap/YapInterface.h>

#include "abac_defines.h"
#include "abac_util.h"
#include "abac_stack.h"
#include "abac_context.h"
#include "abac_list.h"
#include "abac_pl_gen.h"
#include "abac_pl_yy.h"
#include "abac_aspect.h"
#include "abac_m64.h"

#include "uthash.h"

static int debug=0;

/* track constraint's external clause's -unique name id */

static int constraint_label_count=0;
static char *constraint_label="isABAC_constraint";

/*
x    can pLadybug buy_rockets from pAcme ? (_arg_for_fact)
x    can pLadybug What from pAcme ? (_arg_for_what)
x    Who can buy_rockets from pAcme ? (_arg_for_who)
x    can pLadybug buy_rockets from Whom ? (_arg_for_whom)
x    can pLadybug What from Whom ? (_arg_for_what_whom)
the type ordering also dictates the order of partial proof query
sequence
*/
enum _query_type_t {
   e_PL_FACT=0,
   e_PL_WHAT=1,
   e_PL_WHAT_DFLT=2,
   e_PL_WHO=3,   
   e_PL_WHOM=4,
   e_PL_WHAT_WHOM=5,
   e_PL_NOMORE=6
};

static const char *const _queryname[] =
{
  "fact",
  "what",
  "what_default",
  "who",
  "whom",
  "what_whom",
  "nomore"
};
static int _queryname_cnt=6;

/* this is the prolog query structure */

struct _abac_pl_t {
    abac_context_t *ctxt;
   /* a_term <- prin */
    char *whom;
    char *who;
    char *aspect;
    char *what;
    char *whatwith;
    int pcnt; /* pcnt=number of params in whatwith */

    int query_made; /* 1+ yes, 0 no, rc is valid only if a query is made */
    int query_rc; /* rc of query call */
    int next_rc; /* rc of next-last query */
      /* proof count = abac_list_size(proof_list) */
    int is_partial;
    int want_partial;
    int query_type;
    abac_list_t *proof_list; /* list of list of cred_list */ 
    long safe_t; /* holding the YAP's saved goal */
};

/* the arg term for extracting ruleset is the 4th */
#define RULES_ARG_OF_TERM  4

/***********************************************************/
/* default to Yap2 */
static int isYAP3()
{
#ifdef  YAP_VERSION 
    if(strncmp(YAP_VERSION,"6.3.",4)==0)
        return 1;
#endif
    return 0;
}   
/***********************************************************/
static int _get_next_constraint_label_idx()
{
    constraint_label_count++;
    return constraint_label_count;
}

static int _get_constraint_label_idx()
{
    return constraint_label_count;
}

/***********************************************************/
/* retract( (clause) ) */
static int _remove_clause(char *str)
{
    int rc=0;
    char *tmp=NULL;
    YAP_Term eterm;
    asprintf(&tmp,"retract( (%s) ).", str);
    YAP_Term goalArgs=YAP_ReadBuffer(tmp, &eterm);
    int res=YAP_RunGoal(goalArgs);
    if (!res) { 
        printf("error: result of removing clause (%s)\n", tmp);
        rc=1;
        } else {
            DEBUG_PRINTF("okay: result of removing clause (%s)\n", tmp);
    }
    free(tmp);
    return rc;
}

static int _insert_clause(char *str)
{
    YAP_Term eterm;
    YAP_Term goalArgs=YAP_ReadBuffer(str, &eterm);
    char *tmp=YAP_CompileClause(goalArgs);
    if (tmp!=NULL) { /* something is wrong */
        printf("error: result of compile clause (%s)\n", tmp);
        printf("error: str used (%s)\n", str);
        return 1;
    }
    return 0;
}

/* assert( (clause) ) */
static int _assert_clause(char *str)
{
    int rc=0;
    YAP_Term eterm;
    char *tmp=NULL;
    asprintf(&tmp,"assert( (%s) )", str);
    YAP_Term goalArgs=YAP_ReadBuffer(tmp, &eterm);
    int res=YAP_RunGoal(goalArgs);
    if (!res) { /* something is wrong */
        printf("error: result of assert clause (%d)(%s)\n", res, tmp);
        rc=1;
        } else {
            DEBUG_PRINTF("okay: result of assert clause (%d)(%s)\n", res, tmp);
    }
    free(tmp);
    return rc;
}


static int _insert_cred_clause(char *cstr)
{
    int ret=ABAC_CERT_SUCCESS;
    int rc=_assert_clause(cstr);
    if (rc)
        return ABAC_CERT_BAD_YAP;
    return ABAC_CERT_SUCCESS;
}

void show_yap_db(const char *msg)
{
    char lstr[]="listing.";
    YAP_Term eterm; /* error term */

    printf("\n\n/* ========= yap db (%s) */\n",msg);
    int rc=YAP_RunGoalOnce(YAP_ReadBuffer(lstr,&eterm));
    if (rc) {
        printf("/* listing ok.. */\n");
    } else {
        printf("/* listing's rc is bad.. */ \n");
        YAP_Exit(1);
    }
    printf("/* ========= */\n\n");
}

/**
 * Include some utility routines
 */
abac_pl_t *abac_pl_utility(void)
{
/*
append([],L,L).
append([X|L1],L2,[X|L3]):-append(L1,L2,L3).

appendL([],[]).
appendL([H|T], L) :-
   appendL(T,L2), append(H,L2,L).
*/
    if(_insert_clause("append([],L,L)"))
        YAP_Exit(1);
    if(_insert_clause("append([X|L1],L2,[X|L3]):-append(L1,L2,L3)"))
        YAP_Exit(1);
    if(_insert_clause("appendL([],[])"))
        YAP_Exit(1);
    if(_insert_clause("appendL([H|T], L) :- appendL(T,L2), append(H,L2,L)"))
        YAP_Exit(1);
}

abac_pl_t *abac_pl_init()
{
    YAP_Term eterm;

    if (YAP_FastInit(NULL) == YAP_BOOT_ERROR)
        YAP_Exit(1);

    int rc=YAP_RunGoalOnce(YAP_ReadBuffer("source",&eterm));
    if(rc) {
        DEBUG_PRINTF( "calling source..\n");
        } else {
            DEBUG_PRINTF("PANIC: calling source failed..\n");
            YAP_Exit(1);
    }
    abac_pl_utility();
}

/* nothing in deinit right now */
void abac_pl_deinit()
{
}
  
/**
 * Create a new yap query structure.
 */
abac_pl_t *abac_pl_new(abac_context_t *ctxt)
{
    abac_pl_t *pl = abac_xmalloc(sizeof(abac_pl_t));

    pl->ctxt=ctxt;
    pl->who=NULL;
    pl->whom = NULL;
    pl->what = NULL;
    pl->whatwith = NULL;
    pl->aspect = NULL;
    pl->pcnt=0;
    pl->query_made=0;
    pl->query_rc=0;
    pl->is_partial=0;
    pl->want_partial=1;
    pl->query_type=e_PL_FACT;
    pl->next_rc=0;
    pl->proof_list=NULL;
    pl->safe_t=0;
    return pl;
}

int abac_pl_returning_partial(abac_pl_t *pl)
{
    return pl->is_partial;
}

/* returns the number of solution so far */
int abac_pl_proof_cnt(abac_pl_t *pl)
{
    if(pl->proof_list)
        return abac_list_size(pl->proof_list);
    return 0;
}

int abac_pl_is_partial(abac_pl_t *pl)
{
    return pl->is_partial;
}

/* is this the conclusion of the query ? */
/* 1 is yes, 0 N/A */
int abac_pl_done_yet(abac_pl_t *pl)
{
    if(pl->query_made) {
        if(pl->query_rc) {
            if(!pl->next_rc) return 1;
            return 0;
        } else return 1; /* even init query failed */
    }
    return 0;
}

void abac_pl_set_no_partial(abac_pl_t *pl)
{
   pl->want_partial=0;
}

void abac_pl_set_want_partial(abac_pl_t *pl)
{
   pl->want_partial=1;
}

static void _free_p_list(abac_list_t *p)
{
    if( p != NULL ) {
        if(abac_list_size(p) != 0) {
            abac_credential_t *cur=NULL;
            abac_list_foreach(p, cur,
                abac_credential_free(cur);
            );
        }
        abac_list_free(p);
    }
}

static void _free_pf_list(abac_list_t *p)
{
    
    if(p != NULL) {
        if(abac_list_size(p) != 0) {
            abac_list_t *cur=NULL;
            abac_list_foreach(p, cur,
                _free_p_list(cur);
            );
        }
        abac_list_free(p);
    }
}

void abac_pl_free(abac_pl_t *pl) {
    if(pl->who) free(pl->who);
    if(pl->whom) free(pl->whom);
    if(pl->what) free(pl->what);
    if(pl->whatwith) free(pl->whatwith);
    if(pl->aspect) free(pl->aspect);
    _free_pf_list(pl->proof_list);
    free(pl);
}

/* this is done whenever a new query starts in */
static void _reset_pl(abac_pl_t *pl, char *who,
char *what, char *whom, char *aspect, char *whatwith, int pcnt)
{
    if(pl->safe_t != 0) {
        if(!isYAP3()) {
            YAP_RecoverSlots(1); 
            YAP_Reset();  
            } else { /* 6.3.2 seems to have YAP_Reset problem */
                YAP_RecoverSlots(1); 
        }
    }

    /* free the old ones */
    if(pl->who) free(pl->who);
    if(pl->whom) free(pl->whom);
    if(pl->what) free(pl->what);
    if(pl->whatwith) free(pl->whatwith);
    if(pl->aspect) free(pl->aspect);

    pl->who = (who !=NULL)?abac_xstrdup(who):NULL;
    pl->whom = (whom !=NULL)?abac_xstrdup(whom):NULL;
    pl->what = (what!=NULL)?abac_xstrdup(what):NULL;
    pl->whatwith = (whatwith!=NULL)?abac_xstrdup(whatwith):NULL;
    pl->aspect = (aspect!=NULL)?abac_xstrdup(aspect):NULL;

    pl->pcnt=pcnt;

    pl->query_made=0;
    pl->query_rc=0;
    pl->next_rc=0;
    pl->is_partial=0;
    pl->query_type=e_PL_FACT;
    _free_pf_list(pl->proof_list);
    pl->proof_list=abac_list_new();
    pl->safe_t=0;
}

/**
 * Add a credential to the db, not duplicating a copy and so
 * don't try to free it after this call.
 */
int abac_pl_add_credential(abac_list_t *clauses)
{
    int rc=0;
    if (clauses != NULL) {
        char *cur;
        abac_list_foreach(clauses, cur,
            if(cur) {
                if(debug) fprintf(stderr,"inserting =>%s\n",cur);
                rc=_insert_cred_clause(cur);
            }
        );
    }
    return rc;
}

/**
 * Delete a list of credentials from db,
 */
int abac_pl_remove_credential(abac_list_t *clauses)
{
    int rc=0;
    if (clauses != NULL) {
        char *cur;
        abac_list_foreach(clauses, cur,
            if(cur) {
                if(debug) fprintf(stderr,"deleting =>%s\n",cur);
                rc=_remove_clause(cur);
            }
        );
    }
    return rc;
}



int abac_pl_add_type_credential(char *clause)
{
    if (clause != NULL) {
        int rc=_insert_cred_clause(clause);
        return rc;
    }
    return 0;
}

/*  string1(S):- S="abc";S="efg";S="ijk" */
char *abac_pl_add_range_constraint_clause(char *var, char *tmplist)
{
    int i=_get_next_constraint_label_idx();
    char *tmp=NULL;
    asprintf(&tmp,"%s_%d(%s) :- %s", constraint_label, i, var, tmplist); 
    int rc=_insert_cred_clause(tmp);
    free(tmp);
    if(rc) 
        panic("abac_pl_add_range_constraint_clause, failed to insert");
    asprintf(&tmp,"%s_%d(%s)", constraint_label, i, var);
    return tmp;
}

/* chop a 'string' or bare-string out of istring */
static char* _chop(char **istring)
{
   char *ret=NULL;
   char *cptr=*istring;
   char *nptr=cptr; /* next */
   int yesQ=0;

   if(strlen(*istring)==0) return ret;
   if(cptr[0]==']') return ret;
   if(cptr[0]=='\'') { /* take a step */
      yesQ=1;
      cptr++; 
      nptr=cptr;
   }
   while(1) {
       if(yesQ) { /* look for ',' or ', or '] */
           nptr=strstr(cptr,"',");
           if(nptr!=NULL) { 
              *istring=nptr+2;
              break;
           }
           nptr=strstr(cptr,"']");
           if(nptr!=NULL) { 
              *istring=nptr+2;
              break;
           }
           } else { /* yesQ=no */
              nptr=strstr(cptr,",");
              if(nptr!=NULL) { 
                  *istring=nptr+1;
                  break;
              }
              nptr=strstr(cptr,"]");
              if(nptr!=NULL) { 
                  *istring=nptr+1;
                  break;
              }
       }
   }
   if(nptr==NULL) {
       fprintf(stderr,"BAD,  format not as expected!!\n");
       } else {
          int len=(nptr-cptr);
          ret=strndup(cptr,len);
   }
   return ret;
}

/* cases, for YAP 6.2.x 
     ['str']
     ['str1','str2']
     [str1,'str2']
     ['str1',str2]
     ([] is not possible, and don't care)
*/
static void _credentials_from_string_2(abac_context_t *ctxt,abac_list_t *credentials,char *slist) 
{
    char *cptr=slist; /* current ptr */
    char *string;
    abac_credential_t *cred=NULL;
    int cnt=0;
    char *ptr=NULL;

/* it looks like the first one could be [abc,'def'] */
    /* find first [' or [ */  
    ptr=strstr(cptr,"[");
    if(ptr==NULL) { 
        return;
    }

/* it looks like the last one could be  'abc',efg] in addition to 'abac','efg'] */
/* it looks like the first one could be [abc,'def'] */
    cptr++;
    string=_chop(&cptr); /* first one */
    while (string!=NULL) {
        cred=abac_context_credential_lookup(ctxt,string);
        if(cred) {
             int i=abac_list_unique_add(credentials, cred);
             if(i) cnt++;
             } else {
                 printf("BAD -did not find(%s)(%s)\n", abac_decode_string(string),string); 
        }
        free(string); 
        string=_chop(&cptr);
    }
    DEBUG_PRINTF("DEBUG:total %d credentials\n", cnt);
}

/*  XXX just for yap 6.3.2
     [str]
     [str1,str2]
     ([] is not possible, and don't care)
*/
static void _credentials_from_string_3(abac_context_t *ctxt,abac_list_t *credentials,char *slist)
{
    char *cptr=slist; /* current ptr */
    char *sptr; /* string ptr */
    char *ptr;
    int len=0;
    char *string;
    abac_credential_t *cred=NULL;
    int cnt=0;

    /* find first [ */  
    ptr=strstr(cptr,"[");
    if(ptr == NULL) 
         return;
    cptr=ptr+1;
    sptr=cptr;
    while (1) {
        /* find next "," or "]" */
        DEBUG_PRINTF("START with %d\n", strlen(cptr));
        ptr=strstr(cptr,",");
        if(ptr!=NULL) {
             cptr=ptr+1;
             len=(ptr-sptr);
             string=strndup(sptr,len);
             cred=abac_context_credential_lookup(ctxt,string);
             free(string); 
             if(cred) {
                 int i=abac_list_unique_add(credentials, cred);
                 if(i) cnt++;
                 } else {
                   printf("BAD 2 -did not find(%s)\n", abac_decode_string(string)); 
             }
             sptr=cptr;
             } else {
             ptr=strstr(cptr,"]");
             if(ptr!=NULL) {
                 len=(ptr-sptr);
                 string=strndup(sptr,len);
                 cred=abac_context_credential_lookup(ctxt,string);
                 free(string);
                 if(cred) {
                     int i=abac_list_unique_add(credentials, cred);
                     if(i) cnt++;
                     } else {
                         printf("BAD BAD 2 -did not find(%s)\n", abac_decode_string(string)); 
                 }
                 break;
             }
        }
    }
    DEBUG_PRINTF("DEBUG:total %d credentials\n", cnt);
}

static void _credentials_from_string(abac_context_t *ctxt,abac_list_t *credentials,char *slist) {
    if(isYAP3()) {
         _credentials_from_string_3(ctxt,credentials,slist);
    } else {
         _credentials_from_string_2(ctxt,credentials,slist);
    }
}

/* MAX 1024x1024, double as it goes */
static int try_again(int sz, char **tptr)
{
   int blk=1024*2; /* 2048 */
   int max=1024*1024;
   int size;
   char *tmp = NULL;

   if(sz==0) {
       size = (sizeof(char) * (blk+1));
       } else {
           DEBUG_PRINTF("calling try_again needing extra space!!\n");
           if (sz>=max) {
               size=0;
               *tptr=tmp;
               return 0;
           }
           size=sz*2+1;
           if(size > max) size=max;
   }

   tmp = (char *) YAP_AllocSpaceFromYap(size);
   if(tmp==NULL) {
       fprintf(stderr,"ERROR: malloc failed !!!\n");
       YAP_Exit(1);
   }
   *tptr=tmp;
   return size;
}

static int _check_buffer(char *tmp)
{
    if(tmp==NULL) return 0;
    int len=strlen(tmp); /* just for reference :-( */
    if (len < 3) return 0;
    if (tmp[0] != '[') return 0;
    if (tmp[len-1] == ']') return 1;
    int i=0; 
    for(i=3; i<=len; i++) {
        if(tmp[i]==']') {
           if(i==len) fprintf(stderr," _check_buffer, match up..\n");
             else {
                 fprintf(stderr," _check_buffer, did not match up ..\n");
                 tmp[i+1]='\0';
           }
           return 1;
        }
    }
    DEBUG_PRINTF(" _check_buffer, did not find the closing square bracket ..\n");
    return 0;
}

abac_list_t *run_goal(abac_pl_t *pl, YAP_Term *arg)
{
    abac_list_t *cred_list=abac_list_new();
    YAP_Atom f = YAP_LookupAtom("isMember");
    YAP_Functor func = YAP_MkFunctor(f, 4);
    YAP_Term goal=YAP_MkApplTerm(func, 4, arg);

    pl->safe_t = YAP_InitSlot(goal);
DEBUG_PRINTF(" run_goal, safe_t is %ld\n", pl->safe_t);
    pl->query_rc =YAP_RunGoal(goal);
    goal=YAP_GetFromSlot(pl->safe_t);
    pl->query_made=1;
    pl->next_rc=pl->query_rc;
    if (pl->query_rc) {
        if(pl->is_partial) 
            printf("A partial proof(type:%s)\n",_queryname[pl->query_type]);
            else printf("YAP query succeed\n");
        char *tmp=NULL;
        int tmp_sz=0; 
        if(!isYAP3())
            tmp_sz=try_again(0, &tmp);
        YAP_Term argterm=YAP_ArgOfTerm(RULES_ARG_OF_TERM,goal);
        while(1) {
            int rc=YAP_WriteBuffer(argterm, tmp, tmp_sz,YAP_WRITE_HANDLE_VARS);
            if(YAP_VERSION == "6.2.2" || YAP_VERSION == "6.2.3") 
               rc=1; /* XXX rc does not seems to be right for 6.2.x */
/** it seems that 6.3 might give me some garbage at the back.. */
            if(rc==1 && _check_buffer(tmp)) {
                break;
            } else {
                tmp_sz=try_again(tmp_sz,&tmp);
                if(tmp_sz==0) {
                    fprintf(stderr," PANIC, run out of heap space..\n");
                    YAP_Exit(1);
                }
            }
        }
        /* this is returned as ['string1','string2'] */
        DEBUG_PRINTF("    query answer : %s(%d)\n", tmp, strlen(tmp));
        _credentials_from_string(pl->ctxt,cred_list,tmp); 
        if(abac_list_size(cred_list)==0) {
            fprintf(stderr,"CAN NOT retrieve result properly from YAP(1)!!!\n");
            YAP_Exit(1);
        }
        abac_list_add(pl->proof_list, cred_list);
        YAP_FreeSpaceFromYap(tmp);
    } else {
        /* don't print anything if it is running a partial proof goal */
        if(!pl->is_partial) 
            printf("YAP query failed\n");
  
    }
    return cred_list;
}

/*************************************************************************/
YAP_Term _make_term(char *term) {
    YAP_Term eterm;
    YAP_Term ret;
    if(term[0]=='\'' || term[0]=='"') {
        ret =YAP_ReadBuffer(term,&eterm);
        } else {
            ret = YAP_MkAtomTerm(YAP_LookupAtom(term));
    }
}

// isMember(namespace, who,aspect(whom,what,whatwith)) 
/* aspect(whom, what, whatwith) */
YAP_Term _aspect_base(char *whom,char *aspect, char *what, char *whatwith)
{
    YAP_Term eterm;
    YAP_Term ret;

    char *estring=NULL;
    if(whatwith)
       asprintf(&estring, "%s(%s,%s,%s)",aspect,whom,what,whatwith);
       else asprintf(&estring, "%s(%s,%s)",aspect,whom,what);
    DEBUG_PRINTF("_aspect_base, doing %s\n",estring);
    ret=YAP_ReadBuffer(estring,&eterm);
    free(estring);
    return ret;
}

/* generate a string of whatwith that are of ?variable */
char *_make_whatwith_var(char *whatwith, int pcnt)
{
/* this is a dumb count since it is in porting directory */
   if(whatwith==NULL || pcnt==0) return NULL;  
   char *tmp=NULL;
   char *ptr=NULL;
   int i;
   for(i=0;i<pcnt;i++) {
       ptr=tmp;
       tmp=NULL;
       if(i == 0)
           asprintf(&tmp,"Whatwith%d",i);
           else asprintf(&tmp,"%s,Whatwith%d",ptr,i);
   }
   return tmp;
}

/* aspect(X, Y, Whatwith) */
YAP_Term _aspect_what_whom(char *whom,char *aspect, char *what, char *whatwith)
{
    YAP_Term ret=_aspect_base("Whom",aspect,"What",whatwith);
    return ret;
}

/* aspect(whom,Y,Whatwith) */
/* call with char *tmp=_make_whatwith_var(whatwith); */
YAP_Term _aspect_what(char *whom,char *aspect, char *what, char *whatwith)
{
    YAP_Term ret=_aspect_base(whom,aspect,"What",whatwith);
    return ret;
}

/* aspect(X,what,whatwith) */
YAP_Term _aspect_whom(char *whom,char *aspect, char *what, char *whatwith)
{
    YAP_Term ret=_aspect_base("Whom",aspect,what,whatwith);
    return ret;
}

/* aspect(whom,what,whatwith) */
YAP_Term _aspect_fact(char *whom,char *aspect, char *what, char* whatwith)
{
    YAP_Term ret=_aspect_base(whom,aspect,what,whatwith);
    return ret;
}

// Whom.What <- ladybug
// isMember(namespace,ladybug, role(W1, W2), R)
static void _arg_for_what_whom(YAP_Term *arg,char *namespace, char *who, char *whom,
char *aspect, char*what, char *whatwith, int pcnt)
{
    arg[0] = _make_term(namespace);
    arg[1] = _make_term(who);
    char *tmp=_make_whatwith_var(whatwith,pcnt); 
    arg[2] = _aspect_what_whom(who,aspect,what,tmp);
    if(tmp) free(tmp);
    arg[3] = YAP_MkVarTerm();
}

// pAcme.What <- ladybug
// isMember(namespace, ladybug, role(pAcme, W), R)
static void _arg_for_what(YAP_Term *arg,char *namespace,char *who, char* whom, 
char *aspect, char*what, char*whatwith, int pcnt)
{
    arg[0] = _make_term(namespace);
    arg[1] = _make_term(who);
    char *tmp=_make_whatwith_var(whatwith,pcnt); 
    arg[2] = _aspect_what(whom,aspect,what,tmp);
    if(tmp) free(tmp);
    arg[3] = YAP_MkVarTerm();
}

// W.rocket <- ladybug
// isMember(namespace, ladybug, role(W, buy_rockets), R)
static void _arg_for_whom(YAP_Term *arg, char *namespace,char *who, char*whom,
char *aspect, char *what, char*whatwith)
{
    arg[0] = _make_term(namespace);
    arg[1] = _make_term(who);
    arg[2] = _aspect_whom(whom,aspect,what,whatwith);
    arg[3] = YAP_MkVarTerm();
}

// Acme.rocket <- V
// isMember(namespace, V, role(pAcme, buy_rockets), R)
static int _arg_for_who(YAP_Term *arg, char* namespace, char *who,char *whom, 
char *aspect, char* what, char*whatwith)
{
    arg[0] = _make_term(namespace);
    arg[1] = YAP_MkVarTerm();
    arg[2] = _aspect_fact(whom, aspect, what, whatwith);
    arg[3] = YAP_MkVarTerm();
}

// Acme.rocket <- x 
// isMember(namespace,x, role(pAcme, buy_rockets), R)
static void _arg_for_fact(YAP_Term *arg, char* namespace, char *who,char *whom, 
char* aspect, char *what, char*whatwith)
{
    arg[0] = _make_term(namespace);
    arg[1] = _make_term(who);
    arg[2] = _aspect_fact(whom, aspect, what, whatwith);
    arg[3] = YAP_MkVarTerm();
}


static abac_list_t *_make_partial_query(abac_pl_t *pl)
{
    abac_list_t *ret=abac_list_new();
    pl->is_partial=1;
    char *namespace=abac_context_namespace(pl->ctxt);
    char *who=pl->who;
    char *whom=pl->whom;
    char *aspect=pl->aspect;
    char *what=pl->what;
    char *whatwith=pl->whatwith;
    int pcnt=pl->pcnt;
    DEBUG_PRINTF("making make_partial_query..\n");

    switch (pl->query_type) { 
        case e_PL_FACT: /* try what */
            {
            YAP_Term arg[4];
            DEBUG_PRINTF("... 1st partial attempt\n");
            pl->query_type = e_PL_WHAT;
            _arg_for_what(arg,namespace,who,whom, aspect, what, whatwith, pcnt);
            ret=run_goal(pl,arg);
            if(pcnt==0) pl->query_type= e_PL_WHAT_DFLT;
            if(pl->query_rc) return ret;
            break;
            }
        case e_PL_WHAT: /* try what with no params if need to */
            {
            YAP_Term arg[4];
            DEBUG_PRINTF("... 2nd partial attempt\n");
            pl->query_type = e_PL_WHAT_DFLT;
            _arg_for_what(arg,namespace,who,whom, aspect, what, whatwith, 0);
            ret=run_goal(pl,arg);
            if(pl->query_rc) return ret;
            break;
            }
        case e_PL_WHAT_DFLT: /* try who */
            {
            YAP_Term arg[4];
            DEBUG_PRINTF("... 2nd half partial attempt\n");
            pl->query_type = e_PL_WHO;
            _arg_for_who(arg,namespace,who,whom, aspect, what, whatwith);
            ret=run_goal(pl,arg);
            if(pl->query_rc) return ret;
            break;
            }
        case e_PL_WHO: /* try whom */
            {
            YAP_Term arg[4];
            DEBUG_PRINTF("... 3rd partial attempt\n");
            pl->query_type = e_PL_WHOM;
            _arg_for_whom(arg,namespace,who,whom, aspect, what, whatwith);
            ret=run_goal(pl,arg);
            if(pl->query_rc) return ret;
            break;
            }
        case e_PL_WHOM: /* try what-whom */
            {
            YAP_Term arg[4];
            DEBUG_PRINTF("... 4th partial attempt\n");
            pl->query_type = e_PL_WHAT_WHOM;
            _arg_for_what_whom(arg,namespace,who,whom, aspect, what, whatwith,pcnt);
            ret=run_goal(pl,arg);
            if(pl->query_rc) return ret;
            break;
            }
        default :
            {
            DEBUG_PRINTF("... no more partial query to try\n");
            pl->query_type = e_PL_NOMORE;
            }
    }
    return ret;
}

/* make a query and extract just first set of result,
   simple = rt0
   aspect => role/oset
   aspect_string => rest of params
   prin => principal
   issuer => issuer
   estring =>  aspect(issuer, aspect_type_string) 
*/
static abac_list_t *_make_yap_query(abac_pl_t *pl, char *who,
char *whom, char *aspect, char *what, char *whatwith, int pcnt)
{
    DEBUG_PRINTF("_make_yap_query: \n who(%s)\n whom(%s)\n role/oset(%s)\n aspect what(%s)\n pcnt(%d)\n",
                 who, whom, aspect, what, pcnt);
    if(whatwith) { DEBUG_PRINTF(" aspect what(%s)\n", whatwith); }

/* run query on fact goal */
    YAP_Term arg[4];
    char* namespace=abac_context_namespace(pl->ctxt);
    _arg_for_fact(arg, namespace,who,whom, aspect, what, whatwith);
    abac_list_t *ret=run_goal(pl,arg);

/* fact query failed and so run partial query */
    if(!pl->query_rc && pl->want_partial) {
        while(pl->query_type != e_PL_NOMORE) {
            abac_list_free(ret);
            ret=_make_partial_query(pl);
            if( pl->query_rc ) break;
        }
    }
    return ret;
}

/* make a query for next possible solution proof */
static abac_list_t *_query_again(abac_pl_t *pl)
{
    abac_list_t *cred_list=abac_list_new();

    DEBUG_PRINTF("making query_again call..\n");
    pl->next_rc=YAP_RestartGoal();
    pl->query_made++;
    YAP_Term goal=YAP_GetFromSlot(pl->safe_t);

    char *tmp=NULL;
    int tmp_sz=try_again(0, &tmp);
    YAP_Term argterm=YAP_ArgOfTerm(RULES_ARG_OF_TERM,goal);
    if(pl->next_rc) {
        DEBUG_PRINTF("query_again: another success\n");
        if(pl->is_partial)
            printf("A partial proof(type:%s)\n",_queryname[pl->query_type]);
        while(1) {
            int rc=YAP_WriteBuffer(argterm, tmp, tmp_sz,YAP_WRITE_HANDLE_VARS);
            if(YAP_VERSION == "6.2.2" || YAP_VERSION == "6.2.3") 
               rc=1; /* XXX rc does not seems to be right for 6.2.x */
            if(rc==1 && _check_buffer(tmp)) 
                break;
            tmp_sz=try_again(tmp_sz,&tmp);
            if(tmp_sz==0) {
                fprintf(stderr," PANIC, run out of heap space..\n");
                YAP_Exit(1);
            }
        }
        /* this is returned as ['string1','string2'] */
        DEBUG_PRINTF("    query answer : %s(%d)\n", tmp, strlen(tmp));
        _credentials_from_string(pl->ctxt,cred_list,tmp); 
        if(abac_list_size(cred_list)==0) {
            fprintf(stderr,"CAN NOT retrieve result properly from YAP(2)!!!\n");
            YAP_Exit(1);
        }
        abac_list_add(pl->proof_list, cred_list);
        YAP_FreeSpaceFromYap(tmp);
        } else {
            DEBUG_PRINTF("query_again: fail finding next\n");
            if(pl->is_partial) { /* if there is more partial query to make */
                while(pl->query_type != e_PL_NOMORE) {
                    abac_list_free(cred_list);
                    cred_list=_make_partial_query(pl);
                    if( pl->query_rc ) break;
                }
            }
    }
    return cred_list;
}

/* print a list of abac_credential_t */
void _print_cred_list(abac_list_t *p)
{
    DEBUG_PRINTF("_print_cred_list(%d)items:\n",abac_list_size(p));
    if(abac_list_size(p) != 0) {
        abac_credential_t *cur=NULL;
        abac_list_foreach(p, cur,
            DEBUG_PRINTF("printing (%d),\n",(int)cur);
            abac_print_cred_info(cur, NULL);
        );
    }
}


abac_stack_t *_make_cred_stack(abac_list_t *p)
{
    abac_stack_t *ret=abac_stack_new();
    if(abac_list_size(p) != 0) {
        abac_credential_t *cur=NULL;
        abac_list_foreach(p, cur,
            void *vptr=(void *)abac_credential_dup(cur);
            abac_stack_push(ret, vptr);
        );
    }
    return ret;
}

/* force a  backtrack to get next solution proof */
abac_stack_t *abac_pl_query_again(abac_pl_t *pl)
{
    abac_list_t *rlist=_query_again(pl);
    abac_stack_t *ret=_make_cred_stack(rlist);
    return ret;
}

/* 2 types 
      acme.buys_rocket <- coyote (coyote=prin, acme.buys_rocket=role)
        ==> isMember(namespace, coyote,role(acme,buys_rocket), L)
      acme.buys_rocket <- acme.preferred_customer  -- NOT valid 
*/
static abac_stack_t *_query_with_aspect(abac_pl_t *pl, abac_aspect_t* head, abac_aspect_t* tail)
{
    abac_stack_t *ret=NULL;
    char *tmp=NULL;

    if(0)
        show_yap_db("DEBUG:calling within _query_with_aspect");

    char *whom=NULL;
    PROLOG(whom=abac_aspect_principal_name(head););

    /* could be obj or principal */
    char *who=NULL;
    if(abac_aspect_is_object(tail)) {
        who=abac_aspect_object_name(tail);
        } else {
            PROLOG(who=abac_aspect_principal_name(tail););
    }

    if(abac_aspect_aspect_name(tail)!=NULL) {
        printf("fail, a.o <- b.o and a.r <- a.r query is not implemented yet !!!\n");
        YAP_Exit(1);
    }

    if (who == NULL || whom == NULL) {
        printf("fail, query's call got bad aspect names .. \n");
        YAP_Exit(1);
    }

    DEBUG_PRINTF("printing up the yap query ..\n");

    char *pstring;
    PROLOG(pstring=abac_aspect_aspect_param_string(head););

    char *aspect=abac_aspect_type_string(head);
    int pcnt=abac_aspect_aspect_param_cnt(head);
    char *what=abac_aspect_aspect_name(head);

    _reset_pl(pl, who, what, whom, aspect, pstring, pcnt);

    abac_list_t *rlist=NULL;
    if(pcnt)
        rlist=_make_yap_query(pl,who,whom,aspect,abac_aspect_aspect_name(head),pstring,pcnt);
        else
            rlist=_make_yap_query(pl,who,whom,aspect,abac_aspect_aspect_name(head),NULL,0);

    /* generate the resulting stack from a list */
    ret=_make_cred_stack(rlist);
    if(tmp) free(tmp);
    if(pstring) free(pstring);
    return ret;
}

/**
 * Make a query into prolog db
--role acme.preferred_customer --principal coyote
         acme.preferred_customer <-?- coyote
--role acme.preferred_customer.buy_rockets --principlal coyote
         acme.preferred_customer.buy_rockets <-?- coyote
--oset acme.rockets -- object mrx_21 
         acme.rockets <-?- mrx_21
--oset acme.villans -- principal coyote
         acme.villans <-?- coyote
 */
abac_stack_t *abac_pl_query(abac_pl_t *pl, char *roleoset, char *prinobj)
{
    abac_stack_t *ret=NULL;
    int len=strlen(roleoset)+strlen(prinobj)+5;
    char* attr_string=(char *) abac_xmalloc(sizeof(char)*len);
    /* compose the query statement string */
    sprintf(attr_string,"%s<-%s", roleoset, prinobj);

    DEBUG_PRINTF("abac_pl_query, query string is (%s)\n",attr_string);

    /* call into yacc parser */
    abac_aspect_t *head_aspect = NULL;
    abac_aspect_t *tail_aspect = NULL;
    int using_this=0;
    int rc=abac_yy_parse(pl->ctxt, attr_string, &head_aspect, &tail_aspect, &using_this);
    if(rc) { /* ABAC_CERT_INVALID; */
        return NULL;
    }

    ret=_query_with_aspect(pl,head_aspect,tail_aspect);

    return ret;
}

abac_stack_t *abac_pl_query_with_structure(abac_pl_t *pl,
abac_aspect_t *head_aspect, abac_aspect_t *tail_aspect)
{
    abac_stack_t *ret=NULL;
    ret=_query_with_aspect(pl,head_aspect,tail_aspect);

    return ret;
}