|
DataMuseum.dkPresents historical artifacts from the history of: DANOSI |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DANOSI Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 18655 (0x48df)
Types: TextFile
Names: »DIS.ENV«
└─⟦5bf9983c6⟧ Bits:30010496 DANOSI SW50070 Disk 2/2 MegaSwitch Development Toolset Rel. 1.1 PN: 798-66-79 DVBS1.SW50070.rel.1.1.2/2
└─⟦this⟧ »PAXENV\DIS.ENV«
disenv;
(*-----------------------------------------------------------------*)
(* *)
(* directory management environment *)
(* *)
(* description: *)
(* the disenv defines the most common used constants, types and *)
(* routines used by modules containing directory management *)
(* *)
(* ver. date init changes *)
(* -------------------------------------------------------------- *)
(* - - 891020 oer initial version *)
(* - - 900312 phk minor adjustments *)
(* - - 900320 phk body declarations extracted to disbodyenv *)
(* - - 930820 bb swith for RTP3502 or not *)
(*-----------------------------------------------------------------*)
(*-------------------------------------*)
(* Version of disenv *)
(*-------------------------------------*)
type
dis_version_type = record
version : byte;
release : byte;
end;
const
env_version = dis_version_type(: 1, 0 :);
\f
(*--------------------------------------*)
(* Options in the use of dis-routines *)
(*--------------------------------------*)
type
dis_options_type =
packed record
dis_optional : boolean; -- true if module may run without dis
soft_init : boolean; -- no hard_wait in dis_initialize
user_req : boolean; -- all requests are given to user
abort_return : boolean; -- user want dis_abort to return
mess_req_bufs : 0..7; -- number of request message headers
end;
const
user_id_digs = 18;
owner_id_digs = 18;
user_id_lgt = ( user_id_digs + 1) div 2;
owner_id_lgt = ( owner_id_digs + 1) div 2;
type
user_id_type = packed3502 array(1..user_id_digs) of hex_digit; -- like sap_adr_t
owner_id_type = packed3502 array(1..owner_id_digs) of hex_digit; -- like sap_adr_t
const
nil_user_id = user_id_type(: user_id_digs *** 0:);
nil_owner_id = owner_id_type(: owner_id_digs *** 0:);
dis_options =
dis_options_type(:
false, -- dis_optional
false, -- soft init
false, -- oper_types
true, -- abort_return
1 -- headers at scc
:);
const
dis_break_excep = pax_break_code + 1;
\f
(*-------------------------------------*)
(* dis zone type *)
(*-------------------------------------*)
type
dis_a_type = -- the assignable part of zone
record
env_version : dis_version_type; -- the version of the dis zone
lib_version : dis_version_type; -- the version of the procedures
options : dis_options_type; -- the options assigned to the zone
dis_name : alfa; -- the incarnation name of server
dis_user_ix : integer; -- the dis user index of the zone
dis_default_owner : owner_id_type; -- the owner id of the zone
no_of_requests : integer; -- no of requests generated
no_of_answers : integer; -- no of answers received
dis_inf4 : integer; -- ( for future use)
dis_inf5 : integer;
dis_ia_stream : byte; -- the stream number for input answers
dis_oa_stream : byte; -- the stream number for output answers
end;
dis_b_type = -- buffer management part of zone
record
dis : sempointer; -- main mailbox for the dis
main : sempointer; -- main mailbox for the module
$if language = rtp3502
private_sem : semaphore; -- answer mailbox for hard waits
request_pool : pool 0;
header_pool : pool 0;
$else
private_sem : mailbox; -- answer mailbox for hard waits
request_pool : pool;
header_pool : pool;
$endif
help1_ref : reference;
help2_ref : reference; -- request header, hard use
end;
dis_zone_type =
record
a : dis_a_type;
b : dis_b_type;
end;
\f
(*--------------------------------------------------------*)
(* dis operations *)
(*--------------------------------------------------------*)
const
dis_update = 1;
dis_update_a = 2;
dis_delete = 3;
dis_delete_a = 4;
dis_query = 5;
dis_query_a = 6;
dis_subscr = 7;
dis_subscr_a = 8;
dis_delete_user = 9;
dis_delete_user_a = 10;
dis_exclude = 11;
dis_exclude_a = 12;
\f
(*---------------------------------------------------*)
(* dis object constants *)
(*---------------------------------------------------*)
const
dis_obj_dir = 0;
dis_obj_ssap = 128;
dis_obj_dnic = 129;
dis_obj_cug = 130;
dis_obj_icn = 131;
dis_obj_nui = 132;
dis_obj_x32 = 133;
dis_obj_ixi_xxx = 140;
dis_obj_connect = 141;
dis_obj_test = 160;
\f
(*--------------------------------------------------------*)
(* dis parameter types *)
(*--------------------------------------------------------*)
const
dis_parm_space =
3 -- internal header
+ logic_id_lgt + 1 + 8 -- logic id with up to 8 levels
+ typesize( access_ctr_t) + 2 -- access control parameters
+ owner_id_lgt + 2 -- owner id
+ 8 -- timestamp
+ 3; -- data header
min_dt_f_dis = min_dt_f_sl + 16 + dis_parm_space;
dis_max_data_lgt = 300;
dis_ombuf_lgt = min_dt_f_dis + dis_max_data_lgt;
type
title_id_type = record
lgt : byte;
val : logic_id_arr;
end;
const
obj_val_max = 82;
type
obj_val_type = array(1..obj_val_max) of byte;
obj_body_type = record
lgt : byte;
val : obj_val_type;
end;
obj_gen_type = record
typ : byte;
body : obj_body_type;
end;
const
nil_obj_body = obj_body_type(: 0, obj_val_type(: obj_val_max *** 0 :):);
type
dis_incl_t = record
cs_prms : cs_incl_t;
user_id : user_id_type;
end;
dis_search_key_t = record
title : title_id_type;
object_type : byte;
end;
dis_update_key_t = record
owner : owner_id_type;
search : dis_search_key_t;
end;
dis_om_t = record
req_prms : cs_om_t;
acc_prms : access_ctr_t;
update_key : dis_update_key_t;
dummy : array( typesize( cs_om_t)
+ typesize( access_ctr_t)
+ typesize( dis_update_key_t)
.. min_dt_f_dis-1) of byte;
end;
dis_rsp_ia_t = record
i_prms : cs_ia_t;
sev : severity_t;
reason : integer;
buf : array( 16 .. dis_max_data_lgt + min_dt_f_sl) of byte;
end;
dis_oper_ref_type = record
csuix : byte;
ucid : integer;
cscid : integer;
end;
\f
(*----------------------------------------------*)
(* Inclusion and Exclusion of Directory Service *)
(*----------------------------------------------*)
type
dis_init_result = (
(* 0 *) dis_init_ok,
(* 1 *) dis_init_no_dis,
(* 2 *) dis_init_no_buf,
(* 3 *) dis_init_no_incl,
(* 4 *) dis_init_few_headers);
function dis_initialize(
var dis_zone : dis_zone_type; -- the dis zone to be intiated
dis_server_inc : integer; -- the incarnation number of server
dis_user_id : user_id_type; -- identification of the user
dis_owner_id : owner_id_type; -- identification of the owner
dis_answ_sem : sempointer; -- the answer mailbox of the buffers
dis_ia_stream : byte; -- the u4 val of the input answers
dis_oa_stream : byte; -- the u4 val of the output answers
dis_options : dis_options_type; -- options for configuration
dis_version : dis_version_type) -- taken from this environment
: dis_init_result; -- result
external;
(*----------------------------------------------------------*)
(* The DIS_INITIALIZE procedure prepares the dis_zone for *)
(* use by initializing the zone variable and by making *)
(* the corresponding module a user of the Directory Service *)
(* *)
(* The recommended options for configurating the dis_zone is*)
(* given in this environment in DIS_OPTIONS. *)
(* Other options should only be used in special cases. *)
(* *)
(* The function shall be called before the process is able *)
(* to use the Directory system, and it may be *)
(* called in the initialization part of the module. *)
(* *)
(* The following results may be given : *)
(* *)
(* 0 :- dis_init_ok *)
(* 1 :- dis_init_no_dis *)
(* 2 :- dis_init_no_buf *)
(* 3 :- dis_init_no_incl *)
(* 4 :- dis_init_few_headers *)
(* *)
(*----------------------------------------------------------*)
procedure dis_terminate(
var dis_zone : dis_zone_type;
cause : integer );
external;
(*----------------------------------------------------------------*)
(* The DIS_TERMINATE procedure executes an orderly termination of *)
(* the dis activities in the module,ie the procedure excludes the *)
(* module from using the Directory Service and closes *)
(* the dis zone. *)
(*----------------------------------------------------------------*)
\f
(*----------------------------------------*)
(* Receiving Requests and sending Answers *)
(*----------------------------------------*)
procedure dis_request(
var dis_zone : dis_zone_type; -- the dis zone
var i_buf : reference; -- buffer for the request
dis_operation : byte; -- update, query , reset
dis_user_ref : integer; -- users ref to activity
dis_acc_prms : access_ctr_t; -- access parameter
dis_update_key : dis_update_key_t;-- key to dis_operation
dis_object_body : obj_body_type); -- length of object body
external;
(*-------------------------------------------------------*)
(* The DIS_REQUEST procedure forms a request *)
(* message and sends this to the Directory Service *)
(*-------------------------------------------------------*)
\f
procedure dis_query_request(
var dis_zone : dis_zone_type; -- the dis zone
var i_buf : reference; -- buffer for the query
dis_user_ref : integer; -- users ref to activity
dis_acc_prms : access_ctr_t; -- access parameter
dis_query_key : dis_search_key_t);-- search key to find
external;
(*-------------------------------------------------------*)
(* The DIS_QUERY_REQUEST procedure forms a query *)
(* message and sends this to the Directory Service *)
(*-------------------------------------------------------*)
procedure dis_subscribe(
var dis_zone : dis_zone_type; -- the dis zone
var dis_ref : reference; -- a buffer to contain the request
dis_user_ref : integer; -- users ref to operation
dis_subscribtion : title_id_type); -- sap, dnic, nui, ...
external;
(*-------------------------------------------------------*)
(* The DIS_SUBSCRIBE procedure forms a request *)
(* message and sends this to the Directory Service *)
(*-------------------------------------------------------*)
\f
const
dis_st_no_free_res = 128; -- no free resources available
dis_st_out_of_range = 32; -- out of range
dis_st_illegal_state = 16; -- illegal state
dis_st_data_error = 8; -- error found in supervisor data
dis_st_obj_unknown = 4; -- object type unknown
dis_st_ill_dis_oper = 2; -- illegal dis_oper
dis_st_successed = 0; -- the operation was executed sucessfully
type
dis_answer_type =
(
dis_oper, -- the module must take care of the dis operation
dis_error, -- error in answer from dis, see dis_result and dis_reason
dis_format_error, -- format error in the message
dis_no_message, -- no message received
dis_buf_rejected, -- the buffer has been rejected by dis
dis_u2_error, -- u2 <> ok in the answer from dis
dis_initialized, -- (soft-init only) the dis_zone is ready
dis_terminated); -- the dis_zone cannot be made ready
\f
function dis_receive_answer(
var dis_zone : dis_zone_type;
var msg : reference; -- the message received from the dis
var dis_operation : byte; -- the dis operation
var dis_user_ref : integer ; -- the user ref to operation
var dis_obj_type : byte; -- the object type in the answer
var dis_obj_body : obj_body_type; -- the object body received
var dis_obj_count : byte; -- number of objects in answer
var dis_result : severity_t; -- the result of the dis operation
var dis_reason : integer) -- the reason to the specified result
: dis_answer_type;
external;
(*-------------------------------------------------------------*)
(* The DIS_RECEIVE_ANSWER handles the receivement of answers *)
(* from the Directory System. *)
(* *)
(* The message is unpacked and if result <> dis_lcp_oper then *)
(* msg reference is nil, and the dis_receive_answer has *)
(* taken care of all the actions concerning buffer management. *)
(* The value of dis_status is set to dis_st_successed if the *)
(* message reference is not nil. *)
(* *)
(* The following results/actions may occur: *)
(* *)
(* dis_lcp_oper : the module must take care of the oper *)
(* dis_answered : should be ignored *)
(* dis_changed : should be ignored *)
(* dis_format_error : should be ignored *)
(* dis_break : the module must call the exception *)
(* procedure or the dis_terminate *)
(* dis_initialized : (soft-init only) the dis_zone is ready *)
(* dis_terminated : the module may stop execution *)
(* *)
(*-------------------------------------------------------------*)
\f
function dis_answer(
var dis_zone : dis_zone_type;
var msg : reference; -- the message received from the dis
var dis_operation : byte; -- the dis operation
var dis_user_ref : integer ; -- the user ref to operation
var dis_obj_type : byte; -- the object type in the answer
var dis_obj_count : byte; -- number of objects in answer
var dis_obj_size : byte; -- size of object body
var dis_result : severity_t; -- the result of the dis operation
var dis_reason : integer) -- the reason to the specified result
: dis_answer_type;
external;
(*-------------------------------------------------------------*)
(* The DIS_ANSWER function handles the receivement of answers *)
(* from the Directory System. In case of query operations the *)
(* object bodies are identified by first, last and the *)
(* parameters dis_obj_count and dis_obj_size *)
(* *)
(* The message is unpacked and if result <> dis_lcp_oper then *)
(* msg reference is nil, and the dis_answer has taken case of *)
(* all the actions concerning buffer management. *)
(* The value of dis_status is set to dis_st_successed if the *)
(* message reference is not nil. *)
(* *)
(* The following results/actions may occur: *)
(* *)
(* dis_lcp_oper : the module must take care of the oper *)
(* dis_answered : should be ignored *)
(* dis_changed : should be ignored *)
(* dis_format_error : should be ignored *)
(* dis_break : the module must call the exception *)
(* procedure or the dis_terminate *)
(* dis_initialized : (soft-init only) the dis_zone is ready *)
(* dis_terminated : the module may stop execution *)
(* *)
(*-------------------------------------------------------------*)
\f
function dis_query_receive(
var dis_zone : dis_zone_type; -- the dis zone
var dis_ref : reference; -- a buffer containing query
var dis_operation: byte; -- the dis operation
var dis_oper_ref : dis_oper_ref_type; -- users ref to operation
var dis_access : access_ctr_t; -- access parameter
var dis_query_key: dis_search_key_t): -- the query key
dis_answer_type;
external;
\f
procedure dis_query_answer(
var dis_zone : dis_zone_type; -- the dis zone
var dis_ref : reference; -- a buffer to contain the request
var dis_oper_ref : dis_oper_ref_type; -- ref to operation
var dis_obj_type : byte; -- the object type in the answer
var dis_obj_body : obj_body_type); -- the object body received
external;
(*-------------------------------------------------------*)
(* The DIS_QUERY_ANSWER procedure forms a query answer *)
(* message and sends this to the Directory Service *)
(*-------------------------------------------------------*)
(*------------------------------------------------------------*)
(* *)
(* end of directory management environment *)
(* *)
(*------------------------------------------------------------*)
.