//////////////////
// return functor
//
kstring Term::get_funct() const
{
if (type(f_ATOM))
return kstring(ivalue());
if (type(f_STRUCT))
return (*m_structs[ivalue()])->funct;
if (type(f_LIST))
return kstring(KSTRING_LIST);
return kstring(MSR_NULL);
}
BOOL KScriptManager::UpdateStatInfo(DWORD dwScriptID, const char cszFuncName[], uint64_t uCostTime)
{
BOOL bResult = false;
KStatInfoNode* pNode = NULL;
char szKey[128];
KFUNC_STAT_TABLE::iterator it;
snprintf(szKey, sizeof(szKey), "%u:%s", dwScriptID, cszFuncName);
szKey[sizeof(szKey) - 1] = '\0';
it = m_StatTable.find(szKey);
if (it == m_StatTable.end())
{
std::pair<KFUNC_STAT_TABLE::iterator, BOOL> InsRet = m_StatTable.insert(
std::make_pair(kstring(szKey), KStatInfoNode())
);
KGLOG_PROCESS_ERROR(InsRet.second);
it = InsRet.first;
it->second.dwScriptID = dwScriptID;
it->second.sFunction = cszFuncName;
}
pNode = &it->second;
pNode->dwCount++;
pNode->uTime += uCostTime;
bResult = true;
Exit0:
return true;
}
BOOL KStatDataManager::LoadDataName(const char szName[], int nID)
{
BOOL bResult = false;
KDATA_NAME_TABLE::iterator it;
std::pair<KDATA_NAME_TABLE::iterator, BOOL> InsRet;
assert(szName);
KGLOG_PROCESS_ERROR(nID > 0 && nID <= MAX_STAT_DATA_COUNT);
it = m_DataNameTable.find(szName);
KGLOG_PROCESS_ERROR(it == m_DataNameTable.end());
InsRet = m_DataNameTable.insert(std::make_pair(kstring(szName), nID));
KGLOG_PROCESS_ERROR(InsRet.second);
bResult = true;
Exit0:
return bResult;
}
/////////////////////////
// initialize environment
//
EngineHandlers::EngineHandlers(ostream *msgStream)
{
// global string table
kstring::initMem();
// local operator table
OpTbl = new OperTable;
AddStdOpers(OpTbl);
// initialize streams
IntlogIOStreams::setuser(kstring("user"), MSR_NULL);
// global messages table
MsgTbl = new MsgTable(msgStream);
AddStdMsg(MsgTbl);
// shared parser
ParseG = new IntlogParser(OpTbl);
// install system wide builtins
DbIntlog::_pGlobalBuiltins = new DbIntlog;
BuiltIn::Initialize(DbIntlog::_pGlobalBuiltins, get_msgtbl());
}
//------------------------------------------------------------------------
// install standard operators
// for convenction on constant mapping of kstring/functors_operators
// the call order MUST follow that of Operator::tag as declared
// in operator.h
//
void AddStdOpers(OperTable *tbl)
{
tbl->Add(kstring(":-"), 255, Operator::XFX, Operator::RULE);
tbl->Add(kstring("?-"), 255, Operator::FX, Operator::QUERY);
tbl->Add(kstring(";"), 254, Operator::XFY, Operator::OR);
tbl->Add(kstring(","), 253, Operator::XFY, Operator::AND);
tbl->Add(kstring("spy"), 240, Operator::FX, Operator::SPY);
tbl->Add(kstring("nospy"), 240, Operator::FX, Operator::NOSPY);
tbl->Add(kstring("not"), 60, Operator::FX, Operator::NOT);
tbl->Add(kstring("is"), 40, Operator::XFX, Operator::IS);
tbl->Add(kstring(":="), 40, Operator::XFX, Operator::ASS);
tbl->Add(kstring("=.."), 40, Operator::XFX, Operator::UNIV);
tbl->Add(kstring("="), 40, Operator::XFX, Operator::EQ);
tbl->Add(kstring("\\="), 40, Operator::XFX, Operator::NE);
tbl->Add(kstring("<"), 40, Operator::XFX, Operator::LT);
tbl->Add(kstring("=<"), 40, Operator::XFX, Operator::LE);
tbl->Add(kstring(">="), 40, Operator::XFX, Operator::GE);
tbl->Add(kstring(">"), 40, Operator::XFX, Operator::GT);
tbl->Add(kstring("=="), 40, Operator::XFX, Operator::STRICTEQ);
tbl->Add(kstring("\\=="), 40, Operator::XFX, Operator::STRICTNE);
tbl->Add(kstring("-"), 31, Operator::YFX, Operator::SUB);
tbl->Add(kstring("+"), 31, Operator::YFX, Operator::ADD);
tbl->Add(kstring("/"), 21, Operator::YFX, Operator::DIV);
tbl->Add(kstring("*"), 21, Operator::YFX, Operator::MUL);
tbl->Add(kstring("mod"), 11, Operator::XFX, Operator::MOD);
tbl->Add(kstring("^"), 10, Operator::XFY, Operator::POT);
tbl->Add(kstring("\\"), 50, Operator::XFY, Operator::PATHNAME);
tbl->Add(kstring(":-", 1), 255, Operator::FX, Operator::RULEUNARY);
tbl->Add(kstring("-", 1), 31, Operator::FX, Operator::SUBUNARY);
tbl->Add(kstring("+", 1), 31, Operator::FX, Operator::ADDUNARY);
tbl->Add(kstring(":{", 1), 31, Operator::XF, Operator::I_BEGIN);
tbl->Add(kstring(":}", 1), 31, Operator::XF, Operator::I_END);
tbl->Add(kstring(":<", 1), 31, Operator::FX, Operator::I_INHERIT);
tbl->Add(kstring(":/", 1), 31, Operator::FX, Operator::I_IMPORT);
tbl->Add(kstring(":\\", 1), 31, Operator::FX, Operator::I_EXPORT);
tbl->Add(kstring(":+", 1), 31, Operator::FX, Operator::I_DYNAMIC);
tbl->Add(kstring(":$", 1), 31, Operator::FX, Operator::I_HANDLER);
tbl->Add(kstring(":@", 1), 31, Operator::XFX, Operator::I_CREATE);
tbl->Add(kstring(":", 1), 241, Operator::XFX, Operator::I_CALL);
tbl->Add(kstring(":*", 1), 241, Operator::XFX, Operator::I_GCALL);
tbl->Add(kstring(":~", 1), 31, Operator::FX, Operator::I_DESTROY);
tbl->Add(kstring(":^", 1), 31, Operator::XFX, Operator::I_PROPLIST);
tbl->Add(kstring(":&", 1), 31, Operator::XFX, Operator::I_ISA);
kstring kl("."), kc("!");
}
// class Font
Font::Font(){
File *file = fs->fopen(kstring((char *)"/hankaku.bin"));
fonts = new char[4096];
file->read(0,4096,fonts);
}
/* Given krb5 service name in KSSL_CTX *kssl_ctx (typically "kssl"),
** and krb5 AP_REQ message & message length,
** Return Kerberos session key and client principle
** to SSL Server in KSSL_CTX *kssl_ctx.
**
** 19990702 VRS Started.
*/
krb5_error_code
kssl_sget_tkt(
/* UPDATE */ KSSL_CTX *kssl_ctx,
/* IN */ krb5_data *indata,
/* OUT */ krb5_ticket_times *ttimes,
/* OUT */ KSSL_ERR *kssl_err )
{
krb5_error_code krb5rc = KRB5KRB_ERR_GENERIC;
static krb5_context krb5context = NULL;
static krb5_auth_context krb5auth_context = NULL;
krb5_ticket *krb5ticket = NULL;
KRB5_TKTBODY *asn1ticket = NULL;
const unsigned char *p;
krb5_keytab krb5keytab = NULL;
krb5_keytab_entry kt_entry;
krb5_principal krb5server;
krb5_rcache rcache = NULL;
kssl_err_set(kssl_err, 0, "");
if (!kssl_ctx) {
kssl_err_set(kssl_err, SSL_R_KRB5_S_INIT,
"No kssl_ctx defined.\n");
goto err;
}
#ifdef KSSL_DEBUG
printf("in kssl_sget_tkt(%s)\n", kstring(kssl_ctx->service_name));
#endif /* KSSL_DEBUG */
if (!krb5context && (krb5rc = krb5_init_context(&krb5context))) {
kssl_err_set(kssl_err, SSL_R_KRB5_S_INIT,
"krb5_init_context() fails.\n");
goto err;
}
if (krb5auth_context &&
(krb5rc = krb5_auth_con_free(krb5context, krb5auth_context))) {
kssl_err_set(kssl_err, SSL_R_KRB5_S_INIT,
"krb5_auth_con_free() fails.\n");
goto err;
} else
krb5auth_context = NULL;
if (!krb5auth_context &&
(krb5rc = krb5_auth_con_init(krb5context, &krb5auth_context))) {
kssl_err_set(kssl_err, SSL_R_KRB5_S_INIT,
"krb5_auth_con_init() fails.\n");
goto err;
}
if ((krb5rc = krb5_auth_con_getrcache(krb5context, krb5auth_context,
&rcache))) {
kssl_err_set(kssl_err, SSL_R_KRB5_S_INIT,
"krb5_auth_con_getrcache() fails.\n");
goto err;
}
if ((krb5rc = krb5_sname_to_principal(krb5context, NULL,
(kssl_ctx->service_name) ? kssl_ctx->service_name : KRB5SVC,
KRB5_NT_SRV_HST, &krb5server)) != 0) {
kssl_err_set(kssl_err, SSL_R_KRB5_S_INIT,
"krb5_sname_to_principal() fails.\n");
goto err;
}
if (rcache == NULL) {
if ((krb5rc = krb5_get_server_rcache(krb5context,
krb5_princ_component(krb5context, krb5server, 0),
&rcache))) {
kssl_err_set(kssl_err, SSL_R_KRB5_S_INIT,
"krb5_get_server_rcache() fails.\n");
goto err;
}
}
if ((krb5rc = krb5_auth_con_setrcache(krb5context, krb5auth_context,
rcache))) {
kssl_err_set(kssl_err, SSL_R_KRB5_S_INIT,
"krb5_auth_con_setrcache() fails.\n");
goto err;
}
/* kssl_ctx->keytab_file == NULL ==> use Kerberos default
*/
if (kssl_ctx->keytab_file) {
krb5rc = krb5_kt_resolve(krb5context, kssl_ctx->keytab_file,
&krb5keytab);
if (krb5rc) {
kssl_err_set(kssl_err, SSL_R_KRB5_S_INIT,
"krb5_kt_resolve() fails.\n");
goto err;
}
} else {
krb5rc = krb5_kt_default(krb5context, &krb5keytab);
if (krb5rc) {
kssl_err_set(kssl_err, SSL_R_KRB5_S_INIT,
"krb5_kt_default() fails.\n");
goto err;
}
}
/* Actual Kerberos5 krb5_recvauth() has initial conversation here
** o check KRB5_SENDAUTH_BADAUTHVERS
** unless KRB5_RECVAUTH_SKIP_VERSION
** o check KRB5_SENDAUTH_BADAPPLVERS
** o send "0" msg if all OK
*/
/* 20010411 was using AP_REQ instead of true KerberosWrapper
**
** if ((krb5rc = krb5_rd_req(krb5context, &krb5auth_context,
** &krb5in_data, krb5server, krb5keytab,
** &ap_option, &krb5ticket)) != 0) { Error }
*/
p = (unsigned char *)indata->data;
if ((asn1ticket = (KRB5_TKTBODY *) d2i_KRB5_TICKET(NULL, &p,
(long)indata->length)) == NULL) {
(void) snprintf(kssl_err->text, KSSL_ERR_MAX,
"d2i_KRB5_TICKET() ASN.1 decode failure.\n");
kssl_err->reason = SSL_R_KRB5_S_RD_REQ;
goto err;
}
/* Was: krb5rc = krb5_decode_ticket(krb5in_data,&krb5ticket)) != 0) */
if ((krb5rc = kssl_TKT2tkt(krb5context, asn1ticket, &krb5ticket,
kssl_err)) != 0) {
(void) snprintf(kssl_err->text, KSSL_ERR_MAX,
"Error converting ASN.1 ticket to krb5_ticket.\n");
kssl_err->reason = SSL_R_KRB5_S_RD_REQ;
goto err;
}
if (!krb5_principal_compare(krb5context, krb5server,
krb5ticket->server)) {
krb5rc = KRB5_PRINC_NOMATCH;
(void) snprintf(kssl_err->text, KSSL_ERR_MAX,
"server principal != ticket principal\n");
kssl_err->reason = SSL_R_KRB5_S_RD_REQ;
goto err;
}
if ((krb5rc = krb5_kt_get_entry(krb5context, krb5keytab,
krb5ticket->server, krb5ticket->enc_part.kvno,
krb5ticket->enc_part.enctype, &kt_entry)) != 0) {
(void) snprintf(kssl_err->text, KSSL_ERR_MAX,
"krb5_kt_get_entry() fails with %x.\n", krb5rc);
kssl_err->reason = SSL_R_KRB5_S_RD_REQ;
goto err;
}
if ((krb5rc = krb5_decrypt_tkt_part(krb5context, &kt_entry.key,
krb5ticket)) != 0) {
(void) snprintf(kssl_err->text, KSSL_ERR_MAX,
"krb5_decrypt_tkt_part() failed.\n");
kssl_err->reason = SSL_R_KRB5_S_RD_REQ;
goto err;
} else {
krb5_kt_free_entry(krb5context, &kt_entry);
#ifdef KSSL_DEBUG
{
int i;
krb5_address **paddr = krb5ticket->enc_part2->caddrs;
printf("Decrypted ticket fields:\n");
printf("\tflags: %X, transit-type: %X",
krb5ticket->enc_part2->flags,
krb5ticket->enc_part2->transited.tr_type);
print_krb5_data("\ttransit-data: ",
&(krb5ticket->enc_part2->transited.tr_contents));
printf("\tcaddrs: %p, authdata: %p\n",
krb5ticket->enc_part2->caddrs,
krb5ticket->enc_part2->authorization_data);
if (paddr) {
printf("\tcaddrs:\n");
for (i = 0; paddr[i] != NULL; i++) {
krb5_data d;
d.length = paddr[i]->length;
d.data = paddr[i]->contents;
print_krb5_data("\t\tIP: ", &d);
}
}
printf("\tstart/auth/end times: %d / %d / %d\n",
krb5ticket->enc_part2->times.starttime,
krb5ticket->enc_part2->times.authtime,
krb5ticket->enc_part2->times.endtime);
}
#endif /* KSSL_DEBUG */
}
krb5rc = KRB5_NO_TKT_SUPPLIED;
if (!krb5ticket || !krb5ticket->enc_part2 ||
!krb5ticket->enc_part2->client ||
!krb5ticket->enc_part2->client->data ||
!krb5ticket->enc_part2->session) {
kssl_err_set(kssl_err, SSL_R_KRB5_S_BAD_TICKET,
"bad ticket from krb5_rd_req.\n");
} else if (kssl_ctx_setprinc(kssl_ctx, KSSL_CLIENT,
&krb5ticket->enc_part2->client->realm,
krb5ticket->enc_part2->client->data,
krb5ticket->enc_part2->client->length)) {
kssl_err_set(kssl_err, SSL_R_KRB5_S_BAD_TICKET,
"kssl_ctx_setprinc() fails.\n");
} else if (kssl_ctx_setkey(kssl_ctx, krb5ticket->enc_part2->session)) {
kssl_err_set(kssl_err, SSL_R_KRB5_S_BAD_TICKET,
"kssl_ctx_setkey() fails.\n");
} else if (krb5ticket->enc_part2->flags & TKT_FLG_INVALID) {
krb5rc = KRB5KRB_AP_ERR_TKT_INVALID;
kssl_err_set(kssl_err, SSL_R_KRB5_S_BAD_TICKET,
"invalid ticket from krb5_rd_req.\n");
} else
krb5rc = 0;
kssl_ctx->enctype = krb5ticket->enc_part.enctype;
ttimes->authtime = krb5ticket->enc_part2->times.authtime;
ttimes->starttime = krb5ticket->enc_part2->times.starttime;
ttimes->endtime = krb5ticket->enc_part2->times.endtime;
ttimes->renew_till = krb5ticket->enc_part2->times.renew_till;
err:
#ifdef KSSL_DEBUG
kssl_ctx_show(kssl_ctx);
#endif /* KSSL_DEBUG */
if (asn1ticket)
KRB5_TICKET_free((KRB5_TICKET *) asn1ticket);
if (krb5keytab)
krb5_kt_close(krb5context, krb5keytab);
if (krb5ticket)
krb5_free_ticket(krb5context, krb5ticket);
if (krb5server)
krb5_free_principal(krb5context, krb5server);
return (krb5rc);
}
DbIntlog::DbIntlog(DbIntlog *father) : hashtable(DIMBASE)
{
m_name = kstring(MSR_NULL);
m_father = father;
}
/////////////////////////////////////////////
// i_proplist(NameInt,Property,List) (+,+,?)
// retrieve property name/arity list
// for required interface e property
//
BtFImpl(i_proplist, t, p)
{
Term NameInt = p->eval_term(t.getarg(0)),
Prop = p->eval_term(t.getarg(1)),
ListProp(ListNULL);
DbIntlog *db;
if ( !NameInt.type(f_ATOM) ||
!Prop.type(f_ATOM) ||
(db = findint(p->get_db(), NameInt.kstr())) == 0)
{ err:
p->BtErr(BTERR_INVALID_ARG_TYPE);
return 0;
}
// search for property
DbEntry::scopemode prop;
BuiltIn* bt = p->get_db()->is_builtin(Prop, 1);
if (!bt)
goto err;
if (bt->eval == i_export) prop = DbEntry::exported;
else
if (bt->eval == i_import) prop = DbEntry::import;
else
if (bt->eval == i_dynamic) prop = DbEntry::dynamic;
else
if (bt->eval == i_begin) prop = DbEntry::local;
else goto err;
slist lprop;
db->EntriesWithProperty(prop, lprop);
// transform the slist in Prolog List
if (lprop.numel() > 0) {
Term tail(f_NOTERM);
slist_iter it(lprop);
DbIntlog::EntryWithProp *pEntry;
while ((pEntry = (DbIntlog::EntryWithProp *)it.next()) != 0) {
// build the name/arity structure
Term sProp = Term(kstring(Operator::DIV), 2);
sProp.setarg(0, Term(kstring(pEntry->id)));
sProp.setarg(1, Term(Int(pEntry->arity)));
Term elem = Term(sProp, Term(ListNULL));
if (tail.type(f_NOTERM))
tail = ListProp = elem;
else {
tail.setarg(1, elem);
tail = elem;
}
}
ListProp = p->save(ListProp);
}
return p->unify(t.getarg(2), ListProp);
}
inline kstring Term::kstr() const
{
ASSERT(type(f_ATOM));
return kstring(ivalue());
}
/*
inline Term::operator kstring() const
{
ASSERT(type(f_ATOM));
return kstring(ivalue());
}
*/
inline Term::operator CCP() const
{
ASSERT(type(f_ATOM));
return kstring(ivalue());
}
