__export_function struct k_prng_t* k_prng_init
(enum prng_e prng)
{
enum k_error_e err = K_ESUCCESS;
struct k_prng_t* c = 0;
c = k_calloc(1, sizeof(struct k_prng_t));
if (!c) {
err = K_ENOMEM;
goto k_prng_init_err;
}
c->fd_urandom = -1;
c->fd_random = -1;
if (prng == PRNG_NOOP)
return c;
c->prng = prng_get_by_id(prng);
if (!c->prng) {
err = K_ENOCIPHER;
goto k_prng_init_err;
}
if (!c->prng->context_size) {
err = K_ECTXZERO;
goto k_prng_init_err;
}
c->ctx = k_locked_calloc(1, c->prng->context_size,
&c->alloced_ctxsize);
if (!c->ctx) {
err = K_ENOMEM;
goto k_prng_init_err;
}
#ifndef __WINNT__
if (c->prng->setfds) {
c->fd_urandom = open("/dev/urandom", O_RDONLY);
if (c->fd_urandom == -1) {
err = K_ENORNDDEV;
goto k_prng_init_err;
}
c->fd_random = open("/dev/random", O_RDONLY);
if (c->fd_random == -1) {
err = K_ENORNDDEV;
goto k_prng_init_err;
}
c->prng->setfds(c->ctx, c->fd_random, c->fd_urandom);
}
#endif
return c;
k_prng_init_err:
k_prng_finish(c);
k_error(err);
return NULL;
}
Private void k_descr_error(
short int msg_no,
DESCRIPTOR * descr)
{
char * var;
char message[80+1];
char * p;
strcpy(message, sysmsg(msg_no));
p = strchr(message, '|');
if ((var = k_var_name(descr)) != NULL)
{
*p = ' ';
k_error(message, var);
}
else
{
*p = '\0';
k_error(message);
}
}
Private void itype()
{
/* Stack:
|=============================|=============================|
| BEFORE | AFTER |
|=============================|=============================|
top | ADDR to object code | Result |
|=============================|=============================|
*/
DESCRIPTOR * descr;
STRING_CHUNK * str;
char * p;
short int i;
int n;
u_char type;
unsigned short int header_flags;
OBJECT_HEADER * obj;
/* Find I-type code. An I-type must be referenced via an ADDR as we are
going to pop the pointer and use the actual string. Anything else would
require that we dereference the string on leaving the I-type program.
This implies that an I-type must be a variable or an array reference, not
a field extraction, etc. */
descr = e_stack - 1;
if (descr->type != ADDR) k_error(sysmsg(1470));
do {descr = descr->data.d_addr;} while(descr->type == ADDR);
k_get_string(descr);
descr->data.str.saddr = s_make_contiguous(descr->data.str.saddr, NULL);
str = descr->data.str.saddr;
if (str == NULL) goto inva_i_type;
p = str->data;
type = UpperCase(*p);
if ((type == 'I') || (type == 'C') || (type == 'A') || (type == 'S'))
{
/* It's a complete dictionary record */
for(i = 15; i--;) /* Skip 15 field marks */
{
p = strchr(p, FIELD_MARK);
if (p == NULL) goto inva_i_type;
p++;
}
}
if (*p != HDR_MAGIC)
{
if (*p == HDR_MAGIC_INVERSE) convert_object_header((OBJECT_HEADER *)p);
if (*p != HDR_MAGIC) goto inva_i_type;
}
k_pop(1);
if (((long int)p) & 0x00000003)
{
/* Not word aligned - must make a copy. To ensure that this gets
released at an abort, we push a string descriptor onto the stack */
n = str->bytes - (p - str->data);
k_put_string(p, n, e_stack);
obj = (OBJECT_HEADER *)((e_stack++)->data.str.saddr->data);
header_flags = obj->flags;
k_recurse((u_char *)obj, 0);
if (header_flags & HDR_CTYPE) /* 0560 */
{
k_release(e_stack - 1);
}
else
{
k_release(e_stack - 2);
*(e_stack - 2) = *(e_stack - 1);
}
e_stack--;
}
else
{
header_flags = ((OBJECT_HEADER *)p)->flags;
k_recurse((u_char *)p, 0);
}
/* If this is a C-type, load @ANS on to the stack */
if (header_flags & HDR_CTYPE)
{
*e_stack = *(Element(process.syscom, SYSCOM_AT_ANS));
if (e_stack->type >= COMPLEX_DESCR) k_incr_refct(e_stack);
e_stack++;
}
return;
inva_i_type:
k_recurse(pcode_itype, 1);
if (process.status == ER_INVA_ITYPE) k_error(sysmsg(1471));
}
void op_fileinfo()
{
/* Stack:
|================================|=============================|
| BEFORE | AFTER |
|================================|=============================|
top | Key | Information |
|--------------------------------|-----------------------------|
| ADDR to file variable | |
|================================|=============================|
Key values: Action Returns
0 FL_OPEN Test if is open file variable True/False
1 FL_VOCNAME Get VOC name of file VOC name
2 FL_PATH Get file pathname Pathname
3 FL_TYPE Check file type DH: FL_TYPE_DH (3)
Directory: FL_TYPE_DIR (4)
Sequential: FL_TYPE_SEQ (5)
5 FL_MODULUS File modulus Modulus value
6 FL_MINMOD Minimum modulus Minimum modulus value
7 FL_GRPSIZE Group size Group size
8 FL_LARGEREC Large record size Large record size
9 FL_MERGE Merge load percentage Merge load
10 FL_SPLIT Split load percentage Split load
11 FL_LOAD Current load percentage Current load
13 FL_AK File has AK indices? Boolean
14 FL_LINE Number of next line Line number
1000 FL_LOADBYTES Current load in bytes Current load bytes
1001 FL_READONLY Read only file? Boolean
1002 FL_TRIGGER Get trigger function name Call name
1003 FL_PHYSBYTES Physical file size Size in bytes, excl indices
1004 FL_VERSION File version
1005 FL_STATS_QUERY Query file stats status Boolean
1006 FL_SEQPOS File position File offset
1007 FL_TRG_MODES Get trigger modes Mode mask
1008 FL_NOCASE File uses case insensitive ids? Boolean
1009 FL_FILENO Return internal file number File number
1010 FL_JNL_FNO Return journalling file no File no, zero if not journalling
1011 FL_AKPATH Returns AK subfile location Pathname of directory
1012 FL_ID Id of last record read Id
1013 FL_STATUS As STATUS statement Dynamic array
1014 FL_MARK_MAPPING Is mark mapping enabled? Boolean
1015 FL_RECORD_COUNT Approximate record count
1016 FL_PRI_BYTES Primary subfile size in bytes
1017 FL_OVF_BYTES Overflow subfile size in bytes
1018 FL_NO_RESIZE Resizing inhibited?
1019 FL_UPDATE Update counter
1020 FL_ENCRYPTED File uses encryption? Boolean
10000 FL_EXCLUSIVE Set exclusive access Successful?
10001 FL_FLAGS Fetch file flags File flags
10002 FL_STATS_ON Turn on file statistics
10003 FL_STATS_OFF Turn off file statistics
10004 FL_STATS Return file statistics
10005 FL_SETRDONLY Set file as read only
*/
short int key;
DESCRIPTOR * descr;
FILE_VAR * fvar;
DH_FILE * dh_file;
char * p = NULL;
long int n = 0;
FILE_ENTRY * fptr;
OSFILE fu;
bool dynamic;
bool internal;
long int * q;
STRING_CHUNK * str;
short int i;
double floatnum;
u_char ftype;
int64 n64;
/* Get action key */
descr = e_stack - 1;
GetInt(descr);
key = (short int)(descr->data.value);
k_pop(1);
/* Get file variable */
descr = e_stack - 1;
while(descr->type == ADDR) {descr = descr->data.d_addr;}
if (key == FL_OPEN) /* Test if file is open */
{
n = (descr->type == FILE_REF);
}
else
{
if (descr->type != FILE_REF) k_error(sysmsg(1200));
fvar = descr->data.fvar;
ftype = fvar->type;
if (ftype == NET_FILE) /* Network file */
{
str = net_fileinfo(fvar, key);
k_dismiss();
InitDescr(e_stack, STRING);
(e_stack++)->data.str.saddr = str;
return;
}
fptr = FPtr(fvar->file_id);
dynamic = (ftype == DYNAMIC_FILE);
if (dynamic) dh_file = fvar->access.dh.dh_file;
internal = ((process.program.flags & HDR_INTERNAL) != 0);
switch(key)
{
case FL_VOCNAME: /* 1 VOC name of file */
if (fvar->voc_name != NULL) p = fvar->voc_name;
else p = "";
goto set_string;
case FL_PATH: /* 2 File pathname */
p = (char *)(fptr->pathname);
goto set_string;
case FL_TYPE: /* 3 File type */
/* !!FVAR_TYPES!! */
switch(ftype)
{
case DYNAMIC_FILE:
n = FL_TYPE_DH;
break;
case DIRECTORY_FILE:
n = FL_TYPE_DIR;
break;
case SEQ_FILE:
n = FL_TYPE_SEQ;
break;
}
break;
case FL_MODULUS: /* 5 Modulus of file */
if (dynamic) n = fptr->params.modulus;
break;
case FL_MINMOD: /* 6 Minimum modulus of file */
if (dynamic) n = fptr->params.min_modulus;
break;
case FL_GRPSIZE: /* 7 Group size of file */
if (dynamic) n = dh_file->group_size / DH_GROUP_MULTIPLIER;
break;
case FL_LARGEREC: /* 8 Large record size */
if (dynamic) n = fptr->params.big_rec_size;
break;
case FL_MERGE: /* 9 Merge load percentage */
if (dynamic) n = fptr->params.merge_load;
break;
case FL_SPLIT: /* 10 Split load percentage */
if (dynamic) n = fptr->params.split_load;
break;
case FL_LOAD: /* 11 Load percentage */
if (dynamic)
{
n = DHLoad(fptr->params.load_bytes, dh_file->group_size, fptr->params.modulus);
}
break;
case FL_AK: /* 13 File has AKs? */
if (dynamic) n = (dh_file->ak_map != 0);
break;
case FL_LINE: /* 14 Sequential file line position */
if (ftype == SEQ_FILE)
{
n64 = fvar->access.seq.sq_file->line;
if (n64 > LONG_MAX)
{
floatnum = (double)n64;
goto set_float;
}
n = (long)n64;
}
break;
case FL_LOADBYTES: /* 1000 Load bytes */
if (dynamic)
{
floatnum = (double)(fptr->params.load_bytes);
goto set_float;
}
break;
case FL_READONLY: /* 1001 Read-only? */
n = ((fvar->flags & FV_RDONLY) != 0);
break;
case FL_TRIGGER: /* 1002 Trigger function name */
if (dynamic)
{
p = dh_file->trigger_name;
goto set_string;
}
break;
case FL_PHYSBYTES: /* 1003 Physical file size */
switch(ftype)
{
case DIRECTORY_FILE:
floatnum = (double)dir_filesize(fvar);
break;
case DYNAMIC_FILE:
floatnum = (double)dh_filesize(dh_file, PRIMARY_SUBFILE) + dh_filesize(dh_file, OVERFLOW_SUBFILE);
break;
case SEQ_FILE:
fu = fvar->access.seq.sq_file->fu;
floatnum = (double)(ValidFileHandle(fu)?filelength64(fu):-1);
break;
}
goto set_float;
case FL_VERSION: /* 1004 File version */
if (dynamic) n = dh_file->file_version;
break;
case FL_STATS_QUERY: /* 1005 File statistics enabled? */
if (dynamic) n = (fptr->stats.reset != 0);
break;
case FL_SEQPOS: /* 1006 Sequential file offset */
if (ftype == SEQ_FILE)
{
n64 = fvar->access.seq.sq_file->posn;
if (n64 > LONG_MAX)
{
floatnum = (double)n64;
goto set_float;
}
n = (long)n64;
}
break;
case FL_TRG_MODES: /* 1007 Trigger modes */
if (dynamic) n = dh_file->trigger_modes;
break;
case FL_NOCASE: /* 1008 Case insensitive ids? */
switch(ftype)
{
case DIRECTORY_FILE:
case DYNAMIC_FILE:
n = (fptr->flags & DHF_NOCASE) != 0;
break;
}
break;
case FL_FILENO: /* 1009 Internal file number */
n = fvar->file_id;
break;
case FL_JNL_FNO: /* 1010 Journalling file number */
break;
case FL_AKPATH: /* 1011 AK subfile pathname */
if (dynamic)
{
p = dh_file->akpath;
goto set_string;
}
break;
case FL_ID: /* 1012 Id of last record read */
k_dismiss();
k_put_string(fvar->id, fvar->id_len, e_stack);
e_stack++;
return;
case FL_STATUS: /* 1013 STATUS array */
str = get_file_status(fvar);
k_dismiss();
InitDescr(e_stack, STRING);
(e_stack++)->data.str.saddr = str;
return;
case FL_MARK_MAPPING: /* 1014 Mark mapping enabled? */
if (ftype == DIRECTORY_FILE) n = fvar->access.dir.mark_mapping;
break;
case FL_RECORD_COUNT: /* 1015 Approximate record count */
if (dynamic)
{
floatnum = (double)(fptr->record_count);
goto set_float;
}
else n = -1;
case FL_PRI_BYTES: /* 1016 Physical size of primary subfile */
if (dynamic)
{
floatnum = (double)dh_filesize(dh_file, PRIMARY_SUBFILE);
goto set_float;
}
break;
case FL_OVF_BYTES: /* 1017 Physical size of overflow subfile */
if (dynamic)
{
floatnum = (double)dh_filesize(dh_file, OVERFLOW_SUBFILE);
goto set_float;
}
break;
case FL_NO_RESIZE: /* 1018 Resizing inhibited? */
if (dynamic) n = ((fptr->flags & DHF_NO_RESIZE) != 0);
break;
case FL_UPDATE: /* 1019 File update counter */
n = (long)(fptr->upd_ct);
break;
case FL_ENCRYPTED: /* 1020 File uses encryption? */
/* Recognised but returns default zero */
break;
case FL_EXCLUSIVE: /* 10000 Set exclusive access mode */
if (internal)
{
/* To gain exclusive access to a file it must be open only to this
process (fptr->ref_ct = 1) and must not be open more than once
in this process. The latter condition only affects dynamic files
as other types produce multiply referenced file table entries.
We need to ensure a dynamic file is only open once so that when
we close the file we really are going to kill off the DH_FILE
structure. This is essential, for example, in AK creation where
the DH_FILE structure has to change its size. */
flush_dh_cache(); /* Ensure we are not stopped by a cached
reference from our own process. */
n = FALSE;
for (i = 0; i < 6; i++)
{
StartExclusive(FILE_TABLE_LOCK, 37);
if ((fptr->ref_ct == 1)
&& ((ftype != DYNAMIC_FILE) || (dh_file->open_count == 1)))
{
fptr->ref_ct = -1;
fptr->fvar_index = fvar->index;
n = TRUE;
}
EndExclusive(FILE_TABLE_LOCK);
if (n) break;
if (i == 0) /* First attempt */
{
/* Cannot gain exclusive access. Maybe some other process has
the file in its DH cache. Fire an EVT_FLUSH_CACHE event to
all processes to see if this clears the problem. We then
continue trying for a short time until either we get the
required access or we reach our retry count. */
raise_event(EVT_FLUSH_CACHE, -1);
}
Sleep(500); /* Pause for something to happen */
}
}
break;
case FL_FLAGS: /* 10001 File flags */
if (dynamic && internal) n = (long int)(dh_file->flags);
break;
case FL_STATS_ON: /* 10002 Enable file statistics */
if (dynamic && internal)
{
memset((char *)&(fptr->stats), 0, sizeof(struct FILESTATS));
fptr->stats.reset = qmtime();
}
break;
case FL_STATS_OFF: /* 10003 Disable file statistics */
if (dynamic && internal) fptr->stats.reset = 0;
break;
case FL_STATS: /* 10004 Return file statistics data */
if (dynamic && internal)
{
str = NULL;
ts_init(&str, 5 * FILESTATS_COUNTERS);
for (i = 0, q = (long int *)&(fptr->stats.reset); i < FILESTATS_COUNTERS; i++, q++)
{
ts_printf("%ld\xfe", *q);
}
(void)ts_terminate();
k_dismiss(); /* 0363 */
InitDescr(e_stack, STRING);
(e_stack++)->data.str.saddr = str;
return;
}
break;
case FL_SETRDONLY: /* 10005 Set read-only */
if (internal)
{
fvar->flags |= FV_RDONLY;
if (dynamic) dh_file->flags |= DHF_RDONLY;
}
break;
default:
k_error(sysmsg(1010));
}
}
/* Set integer return value on stack */
set_integer:
k_dismiss();
InitDescr(e_stack, INTEGER);
(e_stack++)->data.value = n;
return;
/* Set string return value on stack */
set_string:
k_dismiss();
k_put_c_string(p, e_stack);
e_stack++;
return;
set_float:
if (floatnum <= (double)LONG_MAX)
{
n = (long)floatnum;
goto set_integer;
}
k_dismiss();
InitDescr(e_stack, FLOATNUM);
(e_stack++)->data.float_value = floatnum;
return;
}
void op_ospath()
{
/* Stack:
|================================|=============================|
| BEFORE | AFTER |
|================================|=============================|
top | Key | Information |
|--------------------------------|-----------------------------|
| Pathname string | |
|================================|=============================|
Key values: Action Returns
0 OS_PATHNAME Test if valid pathname True/False
1 OS_FILENAME Test if valid filename True/False
or directory file record name
2 OS_EXISTS Test if file exists True/False
3 OS_UNIQUE Make a unique file name Name
4 OS_FULLPATH Return full pathname Name
5 OS_DELETE Delete file Success/Failure
6 OS_CWD Get current working directory Pathname
7 OS_DTM Return date/time modified DTM value
8 OS_FLUSH_CACHE Flush DH file cache -
9 OS_CD Change working directory Success/Failure
10 OS_MAPPED_NAME Map a directory file name Mapped name
11 OS_OPEN Check if path is an open file True/False
12 OS_DIR Return content of directory Filenames
13 OS_MKDIR Make a directory True/False
14 OS_MKPATH Make a directory path True/False
Pathnames with lengths outside the range 1 to MAX_PATHNAME_LEN return
0 regardless of the action key.
*/
long int status = 0;
short int key;
DESCRIPTOR * descr;
char path[MAX_PATHNAME_LEN+1];
short int path_len;
char name[MAX_PATHNAME_LEN+1];
char * p;
char * q;
STRING_CHUNK * head;
int file_id;
FILE_ENTRY * fptr;
struct stat stat_buff;
DIR * dfu;
struct dirent * dp;
long int n;
/* Get action key */
descr = e_stack - 1;
GetInt(descr);
key = (short int)(descr->data.value);
k_pop(1);
/* Get pathname */
descr = e_stack - 1;
path_len = k_get_c_string(descr, path, MAX_PATHNAME_LEN);
k_dismiss();
if (path_len < 0) goto set_status;
#ifdef CASE_INSENSITIVE_FILE_SYSTEM
UpperCaseString(path);
#endif
switch(key)
{
case OS_PATHNAME: /* Test if valid pathname */
p = path;
if (*p == '/') p++;
do {
q = strchr(p, '/');
if (q != NULL) *q = '\0';
if (!valid_name(p)) goto set_status;
p = q + 1;
} while(q != NULL);
status = 1;
break;
case OS_FILENAME: /* Test if valid pathname */
status = (long int)valid_name(path);
break;
case OS_EXISTS: /* Test if file exists */
status = !access(path, 0);
break;
case OS_UNIQUE: /* Make unique file name. Path variable holds directory name */
n = (time(NULL) * 10) & 0xFFFFFFFL;
do {
sprintf(name, "%s\\D%07lX", path, n);
n--;
} while(!access(name, 0));
sprintf(name, "D%07lX", n);
k_put_c_string(name, e_stack);
e_stack++;
goto exit_op_pathinfo;
case OS_FULLPATH: /* Expand path to full OS pathname */
fullpath(name, path);
k_put_c_string(name, e_stack);
e_stack++;
goto exit_op_pathinfo;
case OS_DELETE:
flush_dh_cache();
status = (long int)delete_path(path);
break;
case OS_CWD:
(void)getcwd(name, MAX_PATHNAME_LEN);
#ifdef CASE_INSENSITIVE_FILE_SYSTEM
UpperCaseString(name);
#endif
k_put_c_string(name, e_stack);
e_stack++;
goto exit_op_pathinfo;
case OS_DTM:
if (stat(path, &stat_buff) == 0) status = stat_buff.st_mtime;
break;
case OS_FLUSH_CACHE:
flush_dh_cache();
break;
case OS_CD:
status = attach(path);
break;
case OS_MAPPED_NAME: /* Map a directory file record name */
(void)map_t1_id(path, strlen(path), name);
k_put_c_string(name, e_stack);
e_stack++;
goto exit_op_pathinfo;
case OS_OPEN:
fullpath(name, path);
for(file_id = 1; file_id <= sysseg->used_files; file_id++)
{
fptr = FPtr(file_id);
if ((fptr->ref_ct != 0)
&& (strcmp((char *)(fptr->pathname), name) == 0))
{
status = TRUE;
break;
}
}
break;
case OS_DIR:
head = NULL;
ts_init(&head, 1024);
if ((dfu = opendir(path)) != NULL)
{
if (path[path_len-1] == DS) path[path_len-1] = '\0';
while((dp = readdir(dfu)) != NULL)
{
if (strcmp(dp->d_name, ".") == 0) continue;
if (strcmp(dp->d_name, "..") == 0) continue;
sprintf(name, "%s%c%s", path, DS, dp->d_name);
if (stat(name, &stat_buff)) continue;
strcpy(name+1, dp->d_name);
#ifdef CASE_INSENSITIVE_FILE_SYSTEM
UpperCaseString(name+1);
#endif
if (stat_buff.st_mode & S_IFDIR)
{
name[0] = 'D';
if (head != NULL) ts_copy_byte(FIELD_MARK);
ts_copy_c_string(name);
}
else if (stat_buff.st_mode & S_IFREG)
{
name[0] = 'F';
if (head != NULL) ts_copy_byte(FIELD_MARK);
ts_copy_c_string(name);
}
}
closedir(dfu);
}
ts_terminate();
InitDescr(e_stack, STRING);
(e_stack++)->data.str.saddr = head;
goto exit_op_pathinfo;
case OS_MKDIR:
status = !MakeDirectory(path);
break;
case OS_MKPATH:
status = make_path(path);
break;
default:
k_error(sysmsg(1010));
}
set_status:
/* Set status value on stack */
InitDescr(e_stack, INTEGER);
(e_stack++)->data.value = status;
exit_op_pathinfo:
return;
}
void op_illegal()
{
k_error("Illegal opcode x%02X", (unsigned int)(*(pc-1)));
}
void k_illegal_call_name() {k_error(sysmsg(1130));}
void k_txn_error() {k_error(sysmsg(1119));}
void k_select_range_error() {k_error(sysmsg(1118));}
void k_nary_length_error() {k_error(sysmsg(1117));}
void k_inva_task_lock_error() {k_error(sysmsg(1116));}
void k_err_pu() {k_error(sysmsg(1115));}
void k_deadlock() {k_error(sysmsg(1114));}
