cv_rcp_attributes_.pl1 11/11/89 1110.3rew 11/11/89 0806.7 157374 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ format: off */ cv_rcp_attributes_: proc; return; /* This subroutine changes RCP attribute specifications into printable RCP attribute descriptions and vice versa. Multiple entrypoints allow these operations, as well as several perversions on the same theme. */ /* Written 04/02/78 by C. D. Tavares */ /* Last modified 02/27/80 by CDT to add make_rel entry. */ /****^ HISTORY COMMENTS: 1) change(87-07-15,Rauschelbach), approve(87-08-07,MCR7748), audit(87-11-11,Farley), install(87-11-30,MR12.2-1004): Set RTDT_area_len. END HISTORY COMMENTS */ %include rtdt; /* automatic */ dcl temp_spec bit (72) aligned, temp_relatts (4) bit (72), temp_atts (2) bit (72), temp_att_string char (256) varying; /* static */ dcl sysdir char (168) initial (">system_control_1") static; dcl sys_info$max_seg_size fixed bin (35) ext static; /* entries */ dcl hcs_$initiate ext entry (char (*), char (*), char (*), fixed bin, fixed bin, pointer, fixed bin (35)), hcs_$terminate_noname ext entry (pointer, fixed bin (35)); dcl sub_err_ ext entry options (variable); /* external variables */ dcl (error_table_$rcp_bad_attributes, error_table_$unimplemented_version, error_table_$resource_type_inappropriate, error_table_$resource_unknown) ext fixed bin (35) static; /* builtins */ dcl (pointer, substr, index, max, null, copy, length, rtrim, string, size) builtin; dcl cleanup condition; to_string: entry (resource_type, attributes, attribute_string, code); dcl (resource_type char (*), attributes (2) bit (72), attribute_string char (*) varying, code fixed bin (35)) parameter; rtdtp = null; RTDT_area_len = 0; /* With the area size 0, then rtdt is only as big as the header info. */ RTDT_area_len = sys_info$max_seg_size - size (rtdt); on cleanup call term_rtdt (0); call find_rtde (resource_type, code); if code ^= 0 then return; call make_string (attributes, attribute_string, code); call term_rtdt (code); return; to_string_rel: entry (resource_type, rel_attributes, attribute_string, code); dcl rel_attributes (4) bit (72) parameter; rtdtp = null; on cleanup call term_rtdt (0); call find_rtde (resource_type, code); if code ^= 0 then return; call make_string_rel (rel_attributes, attribute_string, code); if code ^= 0 then call term_rtdt (0); else call term_rtdt (code); return; to_string_given_rtde: entry (xrtdep, attributes, attribute_string, code); /* This entry is for the use of display_rtdt only. */ dcl xrtdep pointer parameter; rtdep = xrtdep; call make_string (attributes, attribute_string, code); return; from_string: entry (resource_type, attributes, attribute_string, code); rtdtp = null; on cleanup call term_rtdt (0); call find_rtde (resource_type, code); if code ^= 0 then return; call interpret_string (attribute_string, temp_relatts, code); if code ^= 0 then do; call term_rtdt (0); return; end; attributes (1) = temp_relatts (1); attributes (2) = temp_relatts (2); call term_rtdt (code); return; from_string_rel: entry (resource_type, rel_attributes, attribute_string, code); rtdtp = null; on cleanup call term_rtdt (0); call find_rtde (resource_type, code); if code ^= 0 then return; call interpret_string (attribute_string, rel_attributes, code); if code ^= 0 then call term_rtdt (0); else call term_rtdt (code); return; modify: entry (resource_type, attributes, attribute_string, new_attributes, code); dcl new_attributes (2) bit (72) parameter; rtdtp = null; on cleanup call term_rtdt (0); call find_rtde (resource_type, code); if code ^= 0 then return; call interpret_string (attribute_string, temp_relatts, code); if code ^= 0 then do; call term_rtdt (0); return; end; new_attributes (1) = (attributes (1) | rel_attributes (1)) & ^rel_attributes (3); new_attributes (2) = (attributes (2) | rel_attributes (2)) & ^rel_attributes (4); call term_rtdt (code); return; make_rel: entry (resource_type, attributes, rel_attributes, code); /* This entry takes a full or relative attribute string in absolute attribute format and makes a full relative attribute string in relative attribute format (filling in the "turn off" bit portions). It does this via the quick and dirty method of converting back and forth to a char string. */ rtdtp = null; on cleanup call term_rtdt (0); call find_rtde (resource_type, code); if code ^= 0 then return; call check_validity (attributes, validity_level, code); if code ^= 0 then do; term_and_return: call term_rtdt (0); return; end; call make_string (attributes, temp_att_string, code); if code ^= 0 then goto term_and_return; call interpret_string (temp_att_string, rel_attributes, code); if code ^= 0 then goto term_and_return; call term_rtdt (code); return; modify_rel: entry (attributes, rel_attributes, new_attributes); new_attributes (1) = (attributes (1) | rel_attributes (1)) & ^rel_attributes (3); new_attributes (2) = (attributes (2) | rel_attributes (2)) & ^rel_attributes (4); return; test_valid: entry (resource_type, attributes, validity_level, code); dcl validity_level fixed bin parameter; dcl (Absolute initial (0), Relative initial (1), Multiple initial (2), Invalid initial (3)) fixed bin static options (constant); rtdtp = null; on cleanup call term_rtdt (0); call find_rtde (resource_type, code); if code ^= 0 then return; call check_validity (attributes, validity_level, code); if code ^= 0 then do; call term_rtdt (0); return; end; call term_rtdt (code); return; protected_change: entry (attributes, rel_attributes) returns (bit (1) aligned); if (rel_attributes (2) & attributes (2)) ^= rel_attributes (2) then return ("1"b); /* making a currently unprotected attribute protected */ if (rel_attributes (4) & ^attributes (2)) ^= rel_attributes (4) then return ("1"b); /* making a currently protected attribute unprotected */ if (rel_attributes (3) & attributes (2)) ^= "0"b then return ("1"b); /* turning off a currently protected attribute */ return ("0"b); /* this will cause no change to protected attributes */ reduce_implications: entry (vol_type, vol_attributes, dev_type, dev_attributes, code); dcl ((vol_type, dev_type) char (*), (vol_attributes, dev_attributes) dimension (2) bit (72)) parameter; rtdtp = null; on cleanup call term_rtdt (0); call find_rtde (vol_type, code); if code ^= 0 then return; if ^rtde.is_volume then do; code = error_table_$resource_type_inappropriate; call term_rtdt (0); return; end; if rtde.n_mates ^= 1 then do; code = error_table_$resource_unknown; call term_rtdt (0); return; end; dev_type = rtde.mates (1); temp_atts (1) = vol_attributes (1) & string (rtde.attributes_to_match); temp_atts (2) = ""b; call make_string (temp_atts, temp_att_string, code); call term_rtdt (0); if code ^= 0 /* from make_string */ then return; call find_rtde (dev_type, code); if code ^= 0 then return; call interpret_string (temp_att_string, temp_relatts, code); call term_rtdt (0); if code ^= 0 /* from interpret_string */ then return; dev_attributes (1) = temp_relatts (1); dev_attributes (2) = temp_relatts (2); return; find_rtde: proc (resource_type_arg, code); dcl (resource_type_arg char (*), code fixed bin (35)) parameter; dcl resource_type char (32), i fixed bin, found bit (1) aligned, error_table_$improper_data_format ext fixed bin (35) static; call hcs_$initiate (sysdir, "rtdt", "", 0, 0, rtdtp, code); if rtdtp = null then do; call sub_err_ (code, "cv_rcp_attributes_", "c", null, 0, "Cannot initiate ^a>rtdt", sysdir); return; end; code = 0; if (rtdt.version ^= RTDT_version_2) & (rtdt.version ^= RTDT_version_3) then do; code = error_table_$unimplemented_version; call hcs_$terminate_noname (rtdtp, 0); return; end; resource_type = resource_type_arg; do i = 1 to 2; /* give 2 chances to chase down syn */ found = ""b; do rtdep = pointer (rtdt.first_resource, rtdt.rtdt_area) repeat (pointer (rtde.next_resource, rtdt.rtdt_area)) while (rtdep ^= null); if rtde.valid then if rtde.name = resource_type then if ^rtde.is_synonym then return; else do; resource_type = rtde.syn_to; found = "1"b; end; end; if ^found then do; code = error_table_$resource_unknown; call hcs_$terminate_noname (rtdtp, 0); return; end; end; code = error_table_$improper_data_format; call hcs_$terminate_noname (rtdtp, 0); return; end find_rtde; term_rtdt: proc (code); dcl code fixed bin (35) parameter; if rtdtp ^= null then call hcs_$terminate_noname (rtdtp, code); return; end term_rtdt; make_string: proc (abs_attributes, attribute_string, code); dcl (abs_attributes (2) bit (72), attribute_string char (*) varying, code fixed bin (35)) parameter; dcl (i, j) fixed bin, auto_attributes (4) bit (72); string (auto_attributes) = string (abs_attributes); goto make_string_common; make_string_rel: entry (rel_attributes, attribute_string, code); dcl rel_attributes (4) bit (72); string (auto_attributes) = string (rel_attributes); goto make_string_common; make_string_common: attribute_string = ""; do i = index (auto_attributes (1), "1"b) repeat (i) while (i > 0); if i > rtde.n_defined_attributes then do; code = error_table_$rcp_bad_attributes; return; end; if substr (rtde.attributes_valid, i, 1) = "1"b then do; attribute_string = attribute_string || rtrim (rtde.attribute_names (i), " "); if substr (auto_attributes (2), i, 1) then attribute_string = attribute_string || "*,"; else attribute_string = attribute_string || ","; end; if substr (auto_attributes (1), i+1) = ""b then i = -1; else i = i + index (substr (auto_attributes (1), i+1), "1"b); end; do i = index (auto_attributes (3), "1"b) repeat (i) while (i > 0); if i > rtde.n_defined_attributes then do; code = error_table_$rcp_bad_attributes; return; end; if substr (rtde.attributes_valid, i, 1) = "0"b then do; code = error_table_$rcp_bad_attributes; return; end; /* this may be on because "key=val" is ON in the first string, so all other values of "key=" must be turned OFF. This is simple to check for, because "key=" values never appear in the third element otherwise (you can't say "^key=val"!) */ do j = 1 to rtde.n_exclusion_specs while (substr (rtde.exclusion_specs (j), i, 1) = "0"b); end; if j > rtde.n_exclusion_specs then do; attribute_string = attribute_string || "^"; attribute_string = attribute_string || rtrim (rtde.attribute_names (i), " "); attribute_string = attribute_string || ","; end; if substr (auto_attributes (3), i+1) = ""b then i = -1; else i = i + index (substr (auto_attributes (3), i+1), "1"b); end; do i = index (auto_attributes (4), "1"b) repeat (i) while (i > 0); if i > rtde.n_defined_attributes then do; code = error_table_$rcp_bad_attributes; return; end; if substr (rtde.attributes_valid, i, 1) = "0"b then do; code = error_table_$rcp_bad_attributes; return; end; if substr (rel_attributes (3), i, 1) = "0"b then /* already printed if so */ if substr (rel_attributes (1), i, 1) = "0"b then do; /* ditto */ attribute_string = attribute_string || rtrim (rtde.attribute_names (i), " "); attribute_string = attribute_string || ","; end; if substr (auto_attributes (4), i+1) = ""b then i = -1; else i = i + index (substr (auto_attributes (4), i+1), "1"b); end; if length (attribute_string) > 0 then attribute_string = substr (attribute_string, 1, length (attribute_string) - 1); code = 0; return; end make_string; check_validity: proc (attributes, validity_level, code); dcl (attributes (2) bit (72), validity_level fixed bin parameter, code fixed bin (35)) parameter; dcl (i, j) fixed bin; validity_level = Absolute; /* for now, anyway */ /* All bits should be within limits */ if substr (attributes (1), rtde.n_defined_attributes+1) ^= ""b then do; badatt: code = error_table_$rcp_bad_attributes; validity_level = Invalid; return; end; /* Protected attributes must be subset of current attributes */ if (attributes (1) & attributes (2)) ^= attributes (2) then goto badatt; /* Enabled attributes must be subset of potential attributes */ if (attributes (1) & string (rtde.attributes_valid)) ^= attributes (1) then goto badatt; /* Now check to see that one and only one of each "key=val" attributes is on. */ do i = 1 to rtde.n_exclusion_specs; temp_spec = exclusion_specs (i) & attributes (1); j = index (temp_spec, "1"b); if j = 0 then validity_level = max (validity_level, Relative); else if j < length (temp_spec) then if substr (temp_spec, j+1) ^= ""b then validity_level = max (validity_level, Multiple); end; code = 0; /* congratulations, you passed */ return; end check_validity; interpret_string: proc (attribute_string, relatts, code); dcl (attribute_string char (*) varying, relatts (4) bit (72), code fixed bin (35)) parameter; dcl single_attr char (12) varying, (i, j, k) fixed bin, (protected, not) bit (1) aligned, temp_spec bit (72) aligned; /* A relative attribute string consists of four bit (72) quantities. The first represents the attributes that were specified to be ON. The second represents the attributes that were specified as PROTECTED. The third represents the attributes that must be turned OFF, either as the result of the user specifying "^attr", or having "key=val" specified such that all other possible "key=valN" must be forced off. The fourth represents the attributes that must be NONPROTECTED, either as the result of the user specifying "attr", or having "key=val" or "key=val*" specified such that all other possible "key=valN must be DEPROTECTED. */ /* An absolute attribute string consists of the first two of these quantities which are always a consistent combination of attributes. */ i = 1; relatts (*) = ""b; do while (i <= length (attribute_string)); j = index (substr (attribute_string, i), ",") - 1; if j = -1 then j = length (substr (attribute_string, i)); single_attr = substr (attribute_string, i, j); single_attr = rtrim (single_attr, " "); /* PL/I won't do this correctly in one stmt right now. */ if substr (single_attr, 1, 1) = "^" then do; if index (single_attr, "=") > 0 then do; /* "^key=val" makes no sense-- you turn one of those off by turning another on. */ code = error_table_$rcp_bad_attributes; return; end; single_attr = copy (substr (single_attr, 2), 1); not = "1"b; end; else not = ""b; if substr (single_attr, length (single_attr), 1) = "*" then do; if not then do; /* "^mumble*" ?? */ code = error_table_$rcp_bad_attributes; return; end; single_attr = substr (single_attr, 1, length (single_attr) - 1); protected = "1"b; end; else protected = ""b; do k = 1 to rtde.n_defined_attributes while ((rtde.attribute_names (k) ^= single_attr) | (substr (rtde.attributes_valid, k, 1) = "0"b)); end; if k > rtde.n_defined_attributes then do; code = error_table_$rcp_bad_attributes; return; end; if not then substr (relatts (3), k, 1) = "1"b; else substr (relatts (1), k, 1) = "1"b; if protected then substr (relatts (2), k, 1) = "1"b; else substr (relatts (4), k, 1) = "1"b; i = i + j + 1; end; /* Perform exclusions to turn off all other values of "key=a" */ do i = 1 to rtde.n_exclusion_specs; if (rtde.exclusion_specs (i) & relatts (1)) ^= ""b then do; /* One of these exclusive attributes has been mentioned */ temp_spec = rtde.exclusion_specs (i) & ^relatts (1) & rtde.attributes_valid; /* last operand necc. due to bug in early vers. of up_rtdt_ */ relatts (3) = relatts (3) | temp_spec; /* turn OFF matching keys */ relatts (4) = relatts (4) | temp_spec; /* and their protected counterparts */ end; end; return; end interpret_string; test: entry (newsysdir); dcl newsysdir char (*); if newsysdir = "" then sysdir = ">system_control_1"; else sysdir = newsysdir; return; end cv_rcp_attributes_;  rcp_access_kernel_.pl1 11/11/89 1110.3r w 11/11/89 0804.3 77274 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_access_kernel_: procedure (a_operation, a_requestor_info_ptr, a_resource_info_ptr, a_effmode, a_code); /* This program implements an access kernel for RCP * Created 841024 by Maria M. Pozzo * * The operation argument is used to determine the access rules * to apply when calculating effective access of the user to * the RCP resource. */ /****^ HISTORY COMMENTS: 1) change(85-07-08,Pozzo), approve(86-02-21,MCR7346), audit(86-07-29,Farley), install(86-08-01,MR12.0-1108): Modified to return the correct error code from rcp_compute_bracket_mode. 2) change(85-07-10,Pozzo), approve(86-02-21,MCR7346), audit(86-07-29,Farley), install(86-08-01,MR12.0-1108): Modified to audit attempt to access a multi-class volume from outside ring 1 or without the rcp privilege turned on. 3) change(86-08-07,Farley), approve(86-08-07,MCR7469), audit(86-10-19,Beattie), install(86-10-28,MR12.0-1200): Added validation level check for MCA attachments. END HISTORY COMMENTS */ /* ARGUMENT DATA */ dcl a_operation bit (36) aligned; /* (I) RCP operation found in rcp_operations.incl.pl1 */ dcl a_requestor_info_ptr ptr; /* (I) Contains information about the user requesting the RCP operation */ dcl a_resource_info_ptr ptr; /* (I) Contains information about the resource being requested */ dcl a_effmode bit (3); /* (O) Effective access mode of the requesting user to the RCP resource */ dcl a_code fixed bin (35); /* (O) Error code */ /* AUTOMATIC */ dcl rcp_priv bit (1) aligned; /* ON => rcp system_privilege is enabled */ dcl rm_on bit (1) aligned; /* Set if Resource Management is enabled */ dcl (aim_mode, bracket_mode, effmode, raw_mode, temp_effmode) bit (3); /* access modes */ dcl operation bit (36) aligned; dcl base_operation bit (36) aligned; dcl acs_path char (168); /* ACS pathname */ dcl owner char (32); /* If RM is enabled this is the resource owner found in the registry */ dcl who_am_i char (32); /* Identifies this program. */ dcl operation_ptr ptr; /* RCP operation */ dcl error_code fixed bin (35); /* Internal error code */ dcl input_code fixed bin (35); /* Passed in error_code */ dcl rbs (2) fixed bin (3); /* Ring brackets of the ACS if it exists. */ dcl 1 en_access_op like encoded_access_op aligned based (operation_ptr); dcl addr builtin; /* CONSTANTS */ dcl RING_1 fixed bin (3) static internal options (constant) init (1); /* EXTERNAL */ dcl error_table_$bad_ring_brackets fixed bin (35) external; dcl error_table_$unsupported_multi_class_volume fixed bin (35) external; /* EXTERNAL ENTRIES */ dcl rcp_audit entry (char (*), bit (36) aligned, ptr, ptr, char (*), bit (3), bit (3), (2) fixed bin (3), bit (1), fixed bin (35)); dcl rcp_merge_modes entry (bit (3), bit (3), fixed bin (35)) returns (bit (3)); dcl rcp_access_kernel_setup entry (bit (36) aligned, ptr, ptr, bit (1) aligned, char (168), bit (1) aligned, char (32), bit (3), fixed bin (35)); dcl rcp_compute_aim_mode entry (ptr, ptr, bit (3), fixed bin (35)); dcl rcp_compute_bracket_mode entry (char (168), ptr, ptr, bit (3), (2) fixed bin (3), fixed bin (35)); dcl rcp_compute_raw_mode entry (bit (1) aligned, ptr, ptr, char (168), char (32), bit (3), fixed bin (35)); dcl rcp_operation_access entry (bit (36) aligned, char (32), bit (1) aligned, bit (3), fixed bin (35)); dcl access_operations_$rcp_acquire bit (36) aligned external; dcl access_operations_$rcp_register bit (36) aligned external; dcl access_operations_$rcp_register_acquire bit (36) aligned external; %page; /* Copy input arguments */ operation = a_operation; base_operation = operation; input_code = a_code; addr (base_operation) -> encoded_access_op.detailed_operation = 0; operation_ptr = addr (operation); requestor_info_ptr = a_requestor_info_ptr; resource_info_ptr = a_resource_info_ptr; /* Initializer local variables */ who_am_i = "rcp_access_kernel_"; rcp_priv, rm_on = "0"b; aim_mode, bracket_mode, effmode, raw_mode = ""b; temp_effmode = REW_ACCESS; owner = ""; ops_ptr = addr (en_access_op.detailed_operation); error_code = 0; rbs = 0; rbs (1) = -1; /* In case they don't exist. */ /* Get setup - determine if this is a privileged user */ call rcp_access_kernel_setup (operation, requestor_info_ptr, resource_info_ptr, rm_on, acs_path, rcp_priv, owner, effmode, error_code); if error_code ^= 0 then if error_code = error_table_$unsupported_multi_class_volume then goto AUDIT; else goto MAIN_RETURN; if base_operation = access_operations_$rcp_register | base_operation = access_operations_$rcp_register_acquire | base_operation = access_operations_$rcp_acquire then goto MAIN_RETURN; /* These ops have default access and are audited later. */ if effmode ^= ""b then /* Some operations have default access but get audited now. */ goto AUDIT; /* If the resource is an MCA, verify that the requestor's validation level is correct. */ if resource_info.resource_type = DEVICE_TYPE (MCA_DTYPEX) then if requestor_info.validation_level > RING_1 then do; error_code = error_table_$bad_ring_brackets; goto AUDIT; end; else ; else ; /* If this is a privileged gate call (rcp_sys_, rcp_admin_) bypass all discretionary access checks */ if ^detailed_operation.priv_gate_call then do; /* Calculate the discretionary access mode of the subject to the object */ call rcp_compute_raw_mode (rm_on, requestor_info_ptr, resource_info_ptr, acs_path, owner, raw_mode, error_code); /* Calculate the ring bracket mode - if the acs path is null then this check is bypassed */ if acs_path ^= "" then do; call rcp_compute_bracket_mode (acs_path, requestor_info_ptr, resource_info_ptr, bracket_mode, rbs, error_code); /* Determine the temporary effective mode without AIM factored in */ temp_effmode = rcp_merge_modes (raw_mode, bracket_mode, error_code); end; else temp_effmode = raw_mode; end; /* If RM is enabled and RCP system privilege is off, must factor in the AIM access mode */ if (rm_on & ^rcp_priv) then do; call rcp_compute_aim_mode (requestor_info_ptr, resource_info_ptr, aim_mode, error_code); effmode = rcp_merge_modes (temp_effmode, aim_mode, error_code); end; else effmode = temp_effmode; /* Now we know the access, see if we have enough to perform the requested operation */ call rcp_operation_access (operation, resource_info.resource_type, rm_on, effmode, error_code); a_code = error_code; /* Now let's audit the attempted operation. rcp_audit determines if auditing */ /* is enabled. */ AUDIT: /**** If the error code passed in is not zero, then the operation failed due to reasons other than access (such as resource locked) and this call to the access kernel is to determine how much information to return. We want to be sure to audit this as a denial of the operation even though the user may have access. */ if input_code ^= 0 then call rcp_audit (who_am_i, operation, requestor_info_ptr, resource_info_ptr, owner, ("000"b), raw_mode, rbs, (rm_on), (error_code)); else call rcp_audit (who_am_i, operation, requestor_info_ptr, resource_info_ptr, owner, (effmode), raw_mode, rbs, (rm_on), (error_code)); MAIN_RETURN: a_operation = operation; a_effmode = effmode; a_code = error_code; return; %page; %include access_audit_encoded_op; %page; %include access_mode_values; %page; %include rcp_ops; %page; %include rcp_resource_info; %page; %include rcp_resource_types; %page; %include rcp_requestor_info; end rcp_access_kernel_;  rcp_access_kernel_setup.pl1 11/11/89 1110.3rew 11/11/89 0804.6 98685 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_access_kernel_setup: procedure (a_operation, a_requestor_info_ptr, a_resource_info_ptr, a_rm_on, a_acs_path, a_rcp_priv, a_owner, a_effmode, a_error_code); /* This program implements the set up procedures for the RCP * access kernel. * Created 841108 by Maria M. Pozzo * Modified 850401 by E. Swenson to protect pointer reference by * rm_on flag. * * This routine determines if a valid operation was requested, * if Resource Management (RM) is enabled, the registry directory if * there is one, if the rcp privilege is enabled, if the Initializer * has made the call (Initializer gets REW), the resource owner * if there is one and some general setup. */ /****^ HISTORY COMMENTS: 1) change(87-07-14,Rauschelbach), approve(87-08-07,MCR7748), audit(87-11-11,Farley), install(87-11-30,MR12.2-1004): Removed signal to vfile_error condition as it was erroneously left in from debugging. END HISTORY COMMENTS */ /* ARGUMENT DATA */ dcl a_operation bit (36) aligned; /* (I) RCP operation */ dcl a_requestor_info_ptr ptr; /* (I) Requestor information */ dcl a_resource_info_ptr ptr; /* (I) Resource information */ dcl a_rm_on bit (1) aligned; /* (O) ON-> Resource Management enabled */ dcl a_acs_path char (168); /* (O) Pathnameof the ACS segment */ dcl a_rcp_priv bit (1) aligned; /* (O) ON->the rcp system priviege is enabled */ dcl a_owner char (32); /* (O) Resouce owner if one exists */ dcl a_effmode bit (3); /* (O) Some operations have a default effmode */ dcl a_error_code fixed bin (35); /* (O) Error code */ /* AUTOMATIC DATA */ dcl based_bits bit (bl * 9) aligned based (bp); dcl device_found bit (1) aligned; /* Locates the device in rcp_data */ dcl device_off bit (18) aligned; /* Offset to device entry in rcp_data */ dcl is_volume bit (1); /* True if resource is a volume. */ dcl rcp_priv bit (1) aligned; /* rcp privilege on */ dcl rm_on bit (1) aligned; /* Resource_management enabled */ dcl effmode bit (3); dcl object_access_class (2) bit (72) aligned; dcl operation bit (36) aligned; dcl base_operation bit (36) aligned; dcl acs_path char (168); /* Pathname of the ACS segment */ dcl based_charstring char (bl) aligned based (bp); dcl owner char (32); /* Owner name if one exists */ dcl temp_user_id char (32); dcl prim_resource_type char (32); /* Hold the primary resource type */ dcl bl fixed bin (21); dcl error_code fixed bin (35); /* Local error code */ dcl (i, loc) fixed bin; /* Working variable */ dcl bp ptr; dcl operation_ptr ptr; dcl 1 en_access_op like encoded_access_op aligned based (operation_ptr) aligned; /* EXTERNAL ENTRIES */ dcl aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl rcp_pointers_$data entry () returns (ptr); dcl resource_info_$get_primary_type entry (char (*), char (*), fixed bin (35)); dcl resource_info_$get_type entry (char (*), bit (1), fixed bin (35)); dcl access_operations_$rcp_register bit (36) aligned external; dcl access_operations_$rcp_register_acquire bit (36) aligned external; dcl access_operations_$rcp_acquire bit (36) aligned external; dcl access_operations_$rcp_cancel bit (36) aligned external; /* ERROR ENTRIES */ dcl error_table_$unsupported_multi_class_volume fixed bin (35) external; dcl error_table_$resource_unknown fixed bin (35) external; dcl error_table_$action_not_performed fixed bin (35) external; dcl (addr, hbound, length, null, ptr, rtrim, substr, unspec) builtin; /* CONSTANTS */ dcl DEFAULT_REGISTRY_DIR char (64) internal static options (constant) init (">sc1>rcp"); %page; /* Copy arguments */ operation = a_operation; base_operation = operation; addr (base_operation) -> encoded_access_op.detailed_operation = 0; operation_ptr = addr (operation); requestor_info_ptr = a_requestor_info_ptr; resource_info_ptr = a_resource_info_ptr; record_ptr = resource_info.registry_record_ptr; /* Initialize local variables */ device_found, rm_on, rcp_priv = "0"b; device_off = (18)"0"b; prim_resource_type, owner = ""; acs_path = ""; i, loc, bl = 0; error_code = 0; bp = null (); effmode = ""b; ops_ptr = addr (en_access_op.detailed_operation); /* Determine if Resource Management enabled */ rcpd_ptr = rcp_pointers_$data (); if rcpd.modes.resource_mgmt_enabled then rm_on = "1"b; else rm_on = "0"b; /* Set Registry and rcp priv flag */ if rm_on then if (resource_info.registry_dir = "") then resource_info.registry_dir = DEFAULT_REGISTRY_DIR; if addr (requestor_info.current_authorization) -> aim_template.privileges.rcp then rcp_priv = "1"b; else rcp_priv = "0"b; /* If it's a Register operation then there is no owner or registry */ /* yet so no need to continue just give REW access. */ /* if it's an acquire operation, as long as it is a free resource */ /* which is checked outside the kernel, then it can be acquired. */ /* If it's a cancel operation, as long as this is the user who */ /* made the reservation, or it was a privileged user (which are both */ /* checked outside the kernel) then it can be cancelled. */ if base_operation = access_operations_$rcp_register | base_operation = access_operations_$rcp_register_acquire | base_operation = access_operations_$rcp_acquire | base_operation = access_operations_$rcp_cancel then do; effmode = REW_ACCESS; owner = "free"; goto MAIN_RETURN; end; /* If the resource is not free and it is a volume, see if it is */ /* a multi-class volume. We can not handle multi-class volumes unless */ /* we are executing in ring 1 OR the user has the rcp privilege enabled. */ /* Otherwise, no one has access to multi-class volumes not even the */ /* Initializer. */ call resource_info_$get_primary_type (resource_info.resource_type, prim_resource_type, error_code); if error_code ^= 0 then goto MAIN_RETURN; call resource_info_$get_type (prim_resource_type, is_volume, error_code); if error_code ^= 0 then goto MAIN_RETURN; if rm_on then if (is_volume & ^registry_record.free & requestor_info.validation_level ^= 1 & ^rcp_priv) then do; call chase (registry_record.aim_range_desc, bp, bl, error_code); if error_code ^= 0 then goto MAIN_RETURN; if bl > 0 then addr (object_access_class) -> based_bits = based_bits; else unspec (object_access_class) = ""b;/* no range, set to lowest possible */ if ^aim_check_$equal (object_access_class (1), object_access_class (2)) then do; error_code = error_table_$unsupported_multi_class_volume; goto MAIN_RETURN; end; end; /* If it is the Initializer, just give REW access. */ if requestor_info.user_id = "Initializer.SysDaemon.z" then do; effmode = REW_ACCESS; goto MAIN_RETURN; end; /* Let's get the owner if it exists */ /* Set the owner bit in the operation if this user is the owner. */ if rm_on then do; call chase (registry_record.owner_desc, bp, bl, error_code); if error_code ^= 0 then goto MAIN_RETURN; owner = based_charstring; temp_user_id = substr (requestor_info.user_id, 1, length (rtrim (requestor_info.user_id)) - 2); detailed_operation.owner = (owner = temp_user_id); end; /* Let's get the ACS segment pathname if it exists */ if rm_on then do; if registry_record.acs_path_desc ^= 0 then do; call chase (registry_record.acs_path_desc, bp, bl, error_code); if error_code ^= 0 then goto MAIN_RETURN; acs_path = based_charstring; end; end; else do; if ^is_volume then do i = 1 to hbound (DEVICE_TYPE, 1); if prim_resource_type = DEVICE_TYPE (i) then do; device_found = "0"b; do device_off = rcpd.dtype (i).first_off repeat device.next_off while ((device_off ^= (18)"0"b) & ^device_found); device_ptr = ptr (rcpd_ptr, device_off); if device.device_name = resource_info.resource_name then device_found = "1"b; end; if ^device_found then error_code = error_table_$resource_unknown; else if rm_on then acs_path = pathname_ ((resource_info.registry_dir), (device.acs_name)); else acs_path = pathname_ (DEFAULT_REGISTRY_DIR, (device.acs_name)); goto MAIN_RETURN; end; end; end; /* If this is a priv_gate call then DAC access check is by_passed, and */ /* if the rcp privilege is enabled then AIM access check is by_passed; */ /* so if both are true just give REW. */ if (detailed_operation.priv_gate_call & rcp_priv) then effmode = REW_ACCESS; MAIN_RETURN: a_operation = operation; a_rm_on = rm_on; a_acs_path = acs_path; a_owner = owner; a_rcp_priv = rcp_priv; a_effmode = effmode; a_error_code = error_code; %page; chase: proc (descriptor, bp, bl, a_error_code); dcl ( descriptor fixed bin (35), a_error_code fixed bin (35), bp pointer, bl fixed bin (21) ) parameter; dcl 1 rs like rs_info aligned automatic; dcl local_code fixed bin (35); a_error_code = 0; if descriptor = 0 then do; bp = addr (bp); /* gotta point somewhere */ bl = 0; return; end; unspec (rs) = ""b; rs.version = rs_info_version_2; rs.locate_sw = "1"b; rs.descriptor = descriptor; local_code = 0; call iox_$control (resource_info.registry_switch_ptr, "record_status", addr (rs), local_code); if local_code ^= 0 then do; a_error_code = error_table_$action_not_performed; return; end; bl = rs.record_length; bp = rs.record_ptr; return; end chase; %page; %include access_audit_encoded_op; %page; %include access_mode_values; %page; %include aim_template; %page; %include iox_dcls; %page; %include rcp_com_seg; %page; %include rcp_data; %page; %include rcp_ops; %page; %include rcp_registry; %page; %include rcp_requestor_info; %page; %include rcp_resource_types; %page; %include rcp_resource_info; %page; %include rs_info; end rcp_access_kernel_setup;  rcp_assign_device_.pl1 11/11/89 1110.3r 11/11/89 0805.9 55098 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_assign_device_: procedure (arg_device_type, arg_device_info_ptr, arg_event_id, arg_comment, arg_rcp_id, arg_ecode); /* This program implements the rcp_$assign_device entry point. * Created on 11/20/74 by Bill Silver. * * This program is called to assign one device class resource. We will allocate one * RCS entry of this assignment request. We will fill in this entry with all * of the data needed to make this assignment. If there are no errors we will call * rcp_control_ * to perform the actual device assignment. The results of this call will not * be tested until a call is made to rcp_$check_assign. */ /* Modified 841005 to interface to rcp_control_ instead of * rcp_initializer...M.M.Pozzo * Modified 850131 as part of the B2 effort...M. M. Pozzo * Modified 850304 to copy device_info correctly...Chris Jones */ /* ARGUMENT DATA */ dcl arg_device_type char (*); /* (I) Type of device being assigned. */ dcl arg_comment char (*); /* (I) Caller's comment. */ dcl arg_device_info_ptr ptr; /* (I) Pointer to device info structure. */ dcl arg_ecode fixed bin (35); /* (O) error_table_ code. */ dcl arg_event_id fixed bin (71); /* (I) Caller's event channel ID. */ dcl arg_rcp_id bit (36) aligned; /* (O) ID for this assignment request. */ /* AUTOMATIC DATA */ dcl device_info_buffer (RCP_MAX_DEVICE_INFO_SIZE) bit (36) aligned; dcl device_offset bit (18) aligned init ("0"b); /* Offset to device entry passed to rcp_control_. */ dcl process_id bit (36) aligned init ("0"b); /* Process id of process making the request */ dcl rcp_id bit (36) aligned; /* ID that identifies RCS entry. */ dcl rcse_off bit (18); /* Offset to RCS entry. */ dcl volume_offset bit (18) aligned init ("0"b); /* Offset to volume entry passed to rcp_control_. */ dcl device_name char (32) init (""); /* Device name */ dcl device_type char (32); /* Device type name. */ dcl operation bit (36) aligned; /* Type of operation being requested by RCP */ dcl prev_level fixed bin; /* Caller's validation level. */ dcl ecode fixed bin (35); /* error_table_ code. */ dcl error_count fixed bin (17) init (0); /* Input to rcp_control_ for attachment errors */ dcl 1 rcse_buffer like rcse aligned; /* Template RCSE. */ /* EXTERNAL ENTRIES CALLED */ dcl cleanup condition; /* Used to set up cleanup handler. */ dcl (addr, rel) builtin; dcl error_table_$resource_assigned fixed bin (35) external; dcl access_operations_$rcp_assign_write bit (36) ext static; dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl get_ring_ entry returns (fixed bin); dcl rcp_control_ entry (bit (36) aligned, bit (18) aligned, bit (18) aligned, char (*), fixed bin (17), bit (36) aligned, fixed bin (35)); dcl rcp_device_info_$copy entry (char (*), ptr, ptr, fixed bin (35)); dcl rcp_device_info_$get entry (char (*), ptr, ptr, fixed bin, fixed bin (35)); dcl rcp_find_$device entry (char (*) aligned, bit (18)); dcl rcp_rcse_$get entry (ptr, fixed bin (35)); call cu_$level_get (prev_level); /* Save caller's validation level. */ on cleanup begin; /* If trouble cleanup. */ call cu_$level_set (prev_level); end; call cu_$level_set (get_ring_ ()); /* Set validation level to RCP level. */ rcse_off, /* No RCS entry or rcp_id yet. */ rcp_id = "0"b; device_type = arg_device_type; /* Get type of device being assigned. */ device_info_ptr = arg_device_info_ptr; /* copy the caller's device_info structure */ call rcp_device_info_$copy (device_type, device_info_ptr, addr (device_info_buffer), ecode); if ecode ^= 0 then goto RETURN; device_info_ptr = addr (device_info_buffer); rcse_ptr = addr (rcse_buffer); /* Use template RCSE. */ call rcp_device_info_$get (device_type, device_info_ptr, rcse_ptr, prev_level, ecode); if ecode ^= 0 then goto RETURN; /* Fill in the rest of the RCSE. */ rcse.kind = 2; /* This is an assignment RCSE. */ rcse.disposition = "1"b; /* Explicit assignment => retain. */ rcse.event_id = arg_event_id; /* Save argument data. */ rcse.caller_comment = arg_comment; if rcse.flags.device /* Are we assigning a specific device? */ then do; /* Yes, see if already assigned to this process. */ call rcp_find_$device (rcse.device_name, rcse_off); if rcse_off ^= "0"b /* Is it already assigned? */ then do; /* Yes. */ ecode = error_table_$resource_assigned; goto RETURN; end; end; call rcp_rcse_$get (rcse_ptr, ecode); /* Now get a real assignment RCSE. */ if ecode ^= 0 then goto RETURN; rcse_off = rel (rcse_ptr); /* Save offset of RCSE. */ rcp_id = rcse.rcp_id; /* Get real RCP ID. */ /* Now call rcp_control_ to assign a device. */ operation = access_operations_$rcp_assign_write; volume_offset = "0"b; device_offset = rcse_off; device_name = rcse.device_name; call rcp_control_ (operation, volume_offset, device_offset, device_name, error_count, process_id, ecode); RETURN: arg_rcp_id = rcp_id; /* Set return arguments. */ arg_ecode = ecode; call cu_$level_set (prev_level); /* Reset validation level to caller level. */ %include rcp_com_seg; %page; %include rcp_device_info_structs; end rcp_assign_device_;  rcp_attach_.pl1 11/11/89 1110.3rew 11/11/89 0804.3 94698 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_attach_: procedure; /* This program is called to attach a device controlled by RCP. * * This program has the following entry points: * 1. priv_attach - Attach a device with privilege. * 2. attach - Attach a device. */ /* * Created on 11/21/74 by Bill Silver. * Modified 841009 to interface with rcp_control_ instead of * rcp_initializer_... - M. M. Pozzo */ /****^ HISTORY COMMENTS: 1) change(85-06-27,Pozzo), approve(86-02-21,MCR7346), audit(86-07-29,Farley), install(86-08-01,MR12.0-1108): Modified to return a good error code when a garbage error code was input. 2) change(85-07-18,CLJones), approve(86-02-21,MCR7346), audit(86-07-29,Farley), install(86-08-01,MR12.0-1108): Modified to not return rcp_id when an error is encountered. 3) change(85-07-21,ABall), approve(86-02-21,MCR7346), audit(86-07-29,Farley), install(86-08-01,MR12.0-1108): Modified to check for null rcse_ptr and arcse_ptr before referencing rcse_off. 4) change(85-09-11,Fawcett), approve(85-09-11,MCR6979), audit(85-12-02,CLJones), install(86-03-21,MR12.0-1033): Add MCA and FIPS support END HISTORY COMMENTS */ /* ARGUMENT DATA */ dcl arg_comment char (*); /* (I) Caller's comment. */ dcl arg_device_info_ptr ptr; /* (I) Pointer to device info structure. */ dcl arg_device_type char (*); /* (I) Device type name. */ dcl arg_ecode fixed bin (35); /* (O) error_table_ code. */ dcl arg_event_id fixed bin (71); /* (I) Caller's event channel ID. */ dcl arg_rcp_id bit (36) aligned; /* (O) ID for this attachment request. */ /* AUTOMATIC DATA */ dcl arcse_off bit (18); /* Offset of assignment RCS entry. */ dcl device_off bit (18) aligned; /* Offset of RCS entry specifying device. */ dcl priv_flag bit (1); /* ON => privileged attach. */ dcl process_id bit (36) aligned; /* Needed by rcp_control_ */ dcl rcse_off bit (18); /* Offset of RCS entry. */ dcl volume_off bit (18) aligned; /* Offset of RCS entry specifying volume. */ dcl got_arcse bit (1) aligned; /* whether we acquired an arcse */ dcl got_rcse bit (1) aligned; /* whether we acquired an rcse */ dcl device_type char (32); /* Device type name. */ dcl device_name char (32); /* Needed by rcp_control_. */ dcl operation bit (36) aligned; /* Operation being requested of rcp_control_. */ dcl caller_level fixed bin; /* Caller's validation level. */ dcl ecode fixed bin (35); /* error_table_ code. */ dcl error_count fixed bin (17); /* Error count for device attachments */ dcl arcse_ptr ptr; /* Pointer to assignment RCS entry. */ dcl callers_device_info_ptr ptr; dcl device_info_buffer (RCP_MAX_DEVICE_INFO_SIZE) bit (36) aligned; dcl 1 rcse_buffer like rcse aligned; /* Template RCSE. */ /* BASED DATA */ dcl 1 arcse based (arcse_ptr) like rcse aligned; /* Used to reference assignment RCS entry. */ /* EXTERNAL ENTRIES CALLED */ dcl cleanup condition; /* Used to establish cleanup handler. */ dcl (addr, null, ptr, rel) builtin; dcl ( error_table_$bad_volid, error_table_$no_operation, error_table_$resource_attached ) fixed bin (35) external; dcl access_operations_$rcp_assign_write bit (36) aligned ext static; dcl access_operations_$rcp_assign_read bit (36) aligned ext static; dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl get_ring_ entry returns (fixed bin); dcl rcp_find_$attached entry (ptr, bit (18)); dcl rcp_find_$unattached entry (ptr, bit (18)); dcl rcp_control_ entry (bit (36) aligned, bit (18) aligned, bit (18) aligned, char (*), fixed bin (17), bit (36) aligned, fixed bin (35)); dcl rcp_device_info_$copy entry (char (*), ptr, ptr, fixed bin (35)); dcl rcp_device_info_$get entry (char (*), ptr, ptr, fixed bin, fixed bin (35)); dcl rcp_device_info_$set entry (pointer, pointer, fixed bin (35)); dcl rcp_rcse_$free entry (ptr, fixed bin (35)); dcl rcp_rcse_$get entry (ptr, fixed bin (35)); priv_attach: entry (arg_device_type, arg_device_info_ptr, arg_event_id, arg_comment, arg_rcp_id, arg_ecode); priv_flag = "1"b; goto COMMON; attach: entry (arg_device_type, arg_device_info_ptr, arg_event_id, arg_comment, arg_rcp_id, arg_ecode); priv_flag = "0"b; COMMON: device_off = ""b; process_id = ""b; volume_off = ""b; device_name = ""; error_count = 0; rcse_ptr, arcse_ptr = null (); got_arcse, got_rcse = "0"b; call cu_$level_get (caller_level); /* Save caller's validation level. */ on cleanup call CLEANUP (error_table_$no_operation); call cu_$level_set (get_ring_ ()); /* Set validation level to RCP level. */ device_type = arg_device_type; /* Get device type name. */ callers_device_info_ptr = arg_device_info_ptr; device_info_ptr = addr (device_info_buffer); call rcp_device_info_$copy (device_type, callers_device_info_ptr, device_info_ptr, ecode); if ecode ^= 0 then goto RETURN; rcse_ptr = addr (rcse_buffer); /* Use temporary RCSE. */ call rcp_device_info_$get (device_type, device_info_ptr, rcse_ptr, caller_level, ecode); if ecode ^= 0 then goto RETURN; /* Fill in the rest of the RCSE. */ rcse.kind = 1; /* This is an attachment RCSE. */ rcse.flags.priv = priv_flag; /* Remember if privileged attachment. */ rcse.event_id = arg_event_id; /* Save argument data. */ rcse.caller_comment = arg_comment; goto DEVICE_TYPE (rcse.dtypex); /* Special tests based upon device type. */ DEVICE_TYPE (1): /* TAPE */ DEVICE_TYPE (2): /* DISK */ if ^rcse.flags.volume /* Was a volume specified? */ then do; /* No, but it is required. */ ecode = error_table_$bad_volid; goto RETURN; end; if (rcse.flags.t_and_d) & /* Is attachment for a T&D volume? */ (^priv_flag) /* Then is this a privileged attachment? */ then do; /* No, T&D must use privileged entry. */ ecode = error_table_$no_operation; goto RETURN; end; DEVICE_TYPE (3): /* CONSOLE */ DEVICE_TYPE (4): /* PRINTER */ DEVICE_TYPE (5): /* PUNCH */ DEVICE_TYPE (6): /* READER */ DEVICE_TYPE (7): /* SPECIAL */ DEVICE_TYPE (8): /* MCA */ /**** If we are attaching a specific device or if we are attaching a volume * then we must check to see if that device or volume is already attached * to this process. ****/ if (rcse.flags.device) | /* Attaching a specific device? */ (rcse.flags.volume) /* Or attaching a volume. */ then do; /* Yes. */ call rcp_find_$attached (rcse_ptr, arcse_off); if arcse_off ^= "0"b /* Already attached? */ then do; /* Yes. */ ecode = error_table_$resource_attached; goto RETURN; end; end; /* Now get a real attachment RCSE. All the data in our temporary RCSE will * be copied into the real RCSE. */ call rcp_rcse_$get (rcse_ptr, ecode); if ecode ^= 0 then goto RETURN; got_rcse = "1"b; rcse_off = rel (rcse_ptr); /* Now we must see if an appropriate (and unattached) device is already * assigned to this process. If so we will use that device. Otherwise * we will have to have rcp_control_ assign a device. */ call rcp_find_$unattached (rcse_ptr, arcse_off); if arcse_off ^= "0"b /* Did we find an assigned unattached device? */ then do; /* Yes, use it. */ device_off = "0"b; /* We don't need to assign a device. */ arcse_ptr = ptr (rcse_ptr, arcse_off); end; else do; /* No, must assign a device. */ arcse_ptr = addr (rcse_buffer); /* Use attachment RCSE as template. */ arcse.kind = 2; /* Show that this is an assignment RCSE. */ call rcp_rcse_$get (arcse_ptr, ecode); if ecode ^= 0 then /* Any error getting assignment RCS entry? */ goto RETURN; /* Yes, free attachment RCSE. */ got_arcse = "1"b; arcse_off = rel (arcse_ptr); /* Now we have an assignment RCS entry. */ device_off = arcse_off; /* Assign device through assignment RCS entry. */ end; arcse.rcse_off = rcse_off; /* Link the attach and assign RCSEs. */ rcse.rcse_off = arcse_off; if rcse.flags.volume /* Is there a volume? */ then volume_off = rcse_off; /* Yes, assign it using attachment RCSE. */ else do; /* No volume to assign. */ volume_off = "0"b; rcse.state = 2; /* State => any volume assignment has been done. */ end; if (device_off ^= "0"b) | /* Do we have to assign a device? */ (volume_off ^= "0"b) /* Or a volume? */ then do; /* Yes, something to assign. */ if volume_off ^= "0"b & ^rcse.flags.writing then operation = access_operations_$rcp_assign_read; else operation = access_operations_$rcp_assign_write; call rcp_control_ (operation, volume_off, device_off, device_name, error_count, process_id, ecode); if ecode = 0 then call rcp_device_info_$set (callers_device_info_ptr, rcse_ptr, (0)); /*** in case the name has changed (from "scratch") ***/ /*** we ignore the code since it's the caller's problem, and the attachment has been made in any case. ***/ end; RETURN: call CLEANUP (ecode); if ecode = 0 then arg_rcp_id = rcse.rcp_id; arg_ecode = ecode; return; CLEANUP: proc (code); dcl code fixed bin (35); if code ^= 0 then do; if rcse_ptr ^= null () then rcse.rcse_off = ""b; if arcse_ptr ^= null () then arcse.rcse_off = ""b; if got_arcse then call rcp_rcse_$free (arcse_ptr, (0)); if got_rcse then call rcp_rcse_$free (rcse_ptr, (0)); end; call cu_$level_set (caller_level); end CLEANUP; %include rcp_com_seg; %page; %include rcp_device_info_structs; end rcp_attach_;  rcp_attach_lv_.pl1 11/11/89 1110.3rew 11/11/89 0805.2 56556 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-07-10,EJSharpe), approve(86-02-20,MCR7304), audit(86-03-27,CLJones), install(86-04-23,MR12.0-1044): added security auditing END HISTORY COMMENTS */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_attach_lv_: procedure (arg_volume_info_ptr, arg_event_id, arg_rcp_id, arg_ecode); /* This program implements the rcp_$attach_lv entry point. * Created on 06/08/76 by Bill Silver. * Moddfied 09/13/76 by Bernard Greenberg for lv_request_. * Modified 84-09-04 by EJ Sharpe - rename hdx refs to volume_registration_mgr_ * Modified 84-10-30 by EJ Sharpe - new volume_registration_mgr_$get_access uses bit(36) instead of fixed(5) * Modified 12/84 by Chris Jones for B2 security cleanup. */ /* * This program is called to attach one logical volume. * The volume must be registered and this process must have RW access to it. * The program rcp_lv_ will be call to add this lv to a list of lvs * that are attached for this process. The lv will be attached by rcp_attach_lv_. Calls to rcp$check_attach_lv interrogate the global table. */ /* ARGUMENT DATA */ dcl arg_volume_info_ptr ptr; /* (I) Pointer to logical volume info structure. */ dcl arg_event_id fixed bin (71); /* (I) Caller's event channel ID. */ dcl arg_rcp_id bit (36) aligned; /* (0) ID for this logical volume attachment. */ dcl arg_ecode fixed bin (35); /* (O) error_table_ code. */ /* AUTOMATIC DATA */ dcl access bit (36) aligned; /* Access mode to logical volume. */ dcl 1 auto_event_flags aligned like audit_event_flags; dcl 1 auto_lv_info aligned like lv_info; /* local copy of lv info */ dcl caller_level fixed bin; /* Caller's validation level. */ dcl ecode fixed bin (35); /* error_table_ code. */ dcl event_id fixed bin (71); /* Caller's event channel ID */ dcl lvid bit (36) aligned; /* ID that identifies logical volume. */ dcl lv_access_range (2) bit (72) aligned; /* access range of volume */ dcl pub_bit bit (1) aligned; /* from volume_registration_mgr_$get_access - we ignore it */ dcl rcp_id bit (36) aligned; /* ID for this attach request. */ /* EXTERNAL ENTRIES CALLED */ dcl access_operations_$attach_lv bit (36) aligned external; dcl error_table_$resource_assigned fixed bin (35) external; dcl error_table_$resource_bad_access fixed bin (35) external; dcl error_table_$unimplemented_version fixed bin (35) external; dcl access_audit_r1_$log_obj_class_range entry options (variable); dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl get_ring_ entry () returns (fixed bin (3)); dcl volume_registration_mgr_$find_lvid entry (char (*), bit (36) aligned, fixed bin (35)); dcl volume_registration_mgr_$get_access_for_attach entry (char (*), fixed bin, bit (36) aligned, bit (1) aligned, (2) bit (72) aligned, fixed bin (35)); dcl rcp_lv_$add_lv entry (char (*) aligned, bit (36) aligned, fixed bin (71), bit (36) aligned, fixed bin (35)); /* Builtins and conditions */ dcl addr builtin; dcl null builtin; dcl string builtin; dcl cleanup condition; /* Begin rcp_attach_lv_ */ call cu_$level_get (caller_level); /* Save caller's validation level. */ on cleanup call cu_$level_set (caller_level); call cu_$level_set (get_ring_ ()); /* Set validation level to RCP level. */ rcp_id = "0"b; /* Initialize RCP ID (rcp_id). */ event_id = arg_event_id; /* Copy caller's event channel */ lv_info_ptr = addr (auto_lv_info); lv_info = arg_volume_info_ptr -> lv_info; /* copy lv_info structure */ if lv_info.version_num ^= rlvi_version_1 then do; /* Wrong version of lv info structure. */ ecode = error_table_$unimplemented_version; goto RETURN; end; call volume_registration_mgr_$find_lvid ((lv_info.volume_name), lvid, ecode); if ecode ^= 0 then goto RETURN; /* Volume is not registered. */ /*** here's the decision whether to proceed with the attach. This code really should be in an "lv_access_kernel_" */ string (auto_event_flags) = ""b; call volume_registration_mgr_$get_access_for_attach ((lv_info.volume_name), caller_level, access, pub_bit, lv_access_range, ecode); if ecode ^= 0 then do; call audit_it; goto RETURN; /* Error getting access to volume. */ end; if (access & RW_ACCESS) ^= RW_ACCESS then do; /* Caller does not have RW access to volume. */ ecode = error_table_$resource_bad_access; call audit_it; goto RETURN; end; else do; auto_event_flags.grant = "1"b; call audit_it; end; call rcp_lv_$add_lv (lv_info.volume_name, lvid, event_id, rcp_id, ecode); if ecode ^= 0 /* Error adding lv to per-process list? */ then if ecode = error_table_$resource_assigned then ecode = 0; /* Ok if already attached. */ RETURN: arg_rcp_id = rcp_id; /* Set return arguments. */ arg_ecode = ecode; call cu_$level_set (caller_level); /* Reset validation level to caller level. */ return; audit_it: procedure (); dcl volname_str char (64); volname_str = "logical volume " || lv_info.volume_name; call access_audit_r1_$log_obj_class_range ("rcp_attach_lv_", caller_level, string (auto_event_flags), access_operations_$attach_lv, lv_access_range, volname_str, ecode, null (), (0)); return; end audit_it; %include access_mode_values; %page; %include rcp_lv_info; %page; %include access_audit_eventflags; end rcp_attach_lv_;  rcp_audit.pl1 11/11/89 1110.3rew 11/11/89 0806.7 109719 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_audit: procedure (a_caller, a_operation, a_req_info_ptr, a_res_info_ptr, a_owner, a_effmode, a_raw_mode, a_rbs, a_rm_on, a_error_code); /* This internal subroutine determines if auditing is * required for an RCP event. * Created 841112 by Maria M. Pozzo * */ /****^ HISTORY COMMENTS: 1) change(87-07-14,Rauschelbach), approve(87-08-07,MCR7748), audit(87-11-11,Farley), install(87-11-30,MR12.2-1004): Removed signal to vfile_error condition as it was erroneously left from debugging. END HISTORY COMMENTS */ /* ARGUMENTS */ dcl a_caller char (*); /* (I) Identifies the program that made the call. */ dcl a_operation bit (36) aligned; /* (I) The RCP operation as defined in rcp_operations.incl.pl1 */ dcl a_req_info_ptr ptr; /* (I) Pointer to requestor information. */ dcl a_res_info_ptr ptr; /* (I) Pointer to object information. */ dcl a_owner char (*); /* (I) Resource Owner. */ dcl a_effmode bit (3); /* (I) "0"b3 if access was denied */ dcl a_raw_mode bit (3); /* (I) Raw mode used in auditing. */ dcl a_rbs (2) fixed bin (3); /* (I) Ring brackets of the ACS segment if there was one. */ dcl a_rm_on bit (1); /* (I) True = resource management enabled */ dcl a_error_code fixed bin (35); /* (I) Error code */ /* AUTOMATIC */ dcl audit bit (1); /* Is audit needed. */ dcl 1 auto_rcp_obj_info like rcp_obj_info; dcl based_bits bit (bl * 9) aligned based (bp); dcl rm_on bit (1); dcl effmode bit (3); dcl raw_mode bit (3); dcl rbs (2) fixed bin (3); dcl object_access_class (2) bit (72) aligned; dcl event_flags bit (36) aligned; dcl operation bit (36) aligned; /* Local operation */ dcl base_op bit (36) aligned; /* oper_code for audit. */ dcl caller char (32); /* Local caller */ dcl msg_str char (256); /* Format string for audit message. */ dcl object_name char (177); /* Object name is "Registry " plus the pathname of the registry, at it's largest. */ dcl owner char (32); /* Current resource owner. */ dcl registry_dir char (168); /* directory registry is contained in */ dcl registry_name char (32); /* name of registry (for registry operations) */ dcl bl fixed bin (21); dcl error_code fixed bin (35); dcl local_code fixed bin (35); dcl bp ptr; dcl operation_ptr ptr; dcl 1 en_access_op like encoded_access_op aligned based (operation_ptr); dcl addr builtin; dcl bin builtin; dcl null builtin; dcl rtrim builtin; dcl size builtin; dcl unspec builtin; /* EXTERNAL */ dcl access_audit_r1_$check_obj_class_range entry (bit (36) aligned, bit (36) aligned, (2) bit (72) aligned) returns (bit (1)); dcl access_audit_r1_$log_obj_class_range entry options (variable); dcl hcs_$get_access_class entry (char (*), char (*), bit (72) aligned, fixed bin (35)); dcl ioa_$rsnnl entry () options (variable); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl rcp_setup_event entry (bit (36) aligned, bit (3), bit (36) aligned, fixed bin (35)); dcl resource_info_$get_type entry (char (*), bit (1), fixed bin (35)); dcl suffixed_name_$make entry (char (*), char (*), char (32), fixed bin (35)); dcl access_operations_$rcp_set bit (36) aligned ext static; dcl access_operations_$rcp_set_access bit (36) aligned ext static; dcl access_operations_$rcp_delete_registry bit (36) aligned external; dcl access_operations_$rcp_copy_registry bit (36) aligned external; dcl access_operations_$rcp_update_registry_header bit (36) aligned external; dcl access_operations_$rcp_reconstruct_registry bit (36) aligned external; /* CONSTANTS */ dcl COMPONENT_0_NAME char (1) static options (constant) init ("0"); dcl REGISTRY_SUFFIX char (4) static options (constant) init ("rcpr"); dcl REGISTRY_OLD_SUFFIX char (3) static options (constant) init ("old"); /* Copy argument data */ caller = a_caller; operation = a_operation; base_op = operation; addr (base_op) -> en_access_op.detailed_operation = 0; ops_ptr = addr (addr (operation) -> en_access_op.detailed_operation); requestor_info_ptr = a_req_info_ptr; resource_info_ptr = a_res_info_ptr; owner = a_owner; effmode = a_effmode; raw_mode = a_raw_mode; rbs = a_rbs; rm_on = a_rm_on; error_code = a_error_code; /* Initialize local variables. */ audit = "0"b; event_flags = "0"b; object_name = ""; local_code = 0; bp = null (); bl = 0; /* If resource management is not enabled then don't audit. If this is */ /* a search operation then we don't audit either. */ /* If it's a reconstruct operation we are in the Initializer process and */ /* rm is not turned on, since reconstructs are done in "stan". */ if (^rm_on & (base_op ^= access_operations_$rcp_reconstruct_registry)) | detailed_operation.search then goto MAIN_RETURN; /* Set up the RCP event. We already have the oper_code in base_op. */ call rcp_setup_event (operation, effmode, event_flags, local_code); if local_code ^= 0 then goto MAIN_RETURN; /* Get the access class range of the object. */ registry_dir = resource_info.registry_dir; if registry_operation (base_op) then do; /* the registry itself is the object */ if base_op = access_operations_$rcp_delete_registry then call suffixed_name_$make (resource_info.resource_type, REGISTRY_OLD_SUFFIX, registry_name, local_code) ; else call suffixed_name_$make (resource_info.resource_type, REGISTRY_SUFFIX, registry_name, local_code); if local_code ^= 0 then goto MAIN_RETURN; /**** Low end of access class range is access class of the directory (registry), high end is that of component 0. ****/ call hcs_$get_access_class (registry_dir, registry_name, object_access_class (1), local_code); if local_code ^= 0 then goto MAIN_RETURN; call hcs_$get_access_class (pathname_ (registry_dir, registry_name), COMPONENT_0_NAME, object_access_class (2), local_code); if local_code ^= 0 then goto MAIN_RETURN; end; else do; /* we can use the registry to find out the access class range */ record_ptr = resource_info.registry_record_ptr; if registry_record.free then call chase (registry_record.potential_aim_range_desc, bp, bl, local_code); else call chase (registry_record.aim_range_desc, bp, bl, local_code); if local_code ^= 0 then goto MAIN_RETURN; if bl > 0 then addr (object_access_class) -> based_bits = based_bits; else unspec (object_access_class) = ""b; /* no range, set to lowest possible */ end; /* Determine if access is needed. */ audit = access_audit_r1_$check_obj_class_range (event_flags, base_op, object_access_class); /* If auditing is required then do it. */ if audit then do; call get_obj_name (); audit_rcp_obj_ptr = addr (auto_rcp_obj_info); call fill_audit_record (local_code); if local_code ^= 0 then goto MAIN_RETURN; call get_msg_str (); call access_audit_r1_$log_obj_class_range (caller, (requestor_info.validation_level), event_flags, base_op, object_access_class, rtrim (object_name), error_code, addr (rcp_obj_info), (size (rcp_obj_info)), msg_str); end; MAIN_RETURN: return; %page; chase: proc (descriptor, bp, bl, a_error_code); dcl ( descriptor fixed bin (35), a_error_code fixed bin (35), bp pointer, bl fixed bin (21) ) parameter; dcl 1 rs like rs_info aligned automatic; dcl local_code fixed bin (35); dcl error_table_$action_not_performed ext static fixed bin (35); a_error_code = 0; if descriptor = 0 then do; bp = addr (bp); /* gotta point somewhere */ bl = 0; return; end; unspec (rs) = ""b; rs.version = rs_info_version_2; rs.locate_sw = "1"b; rs.descriptor = descriptor; local_code = 0; call iox_$control (resource_info.registry_switch_ptr, "record_status", addr (rs), local_code); if local_code ^= 0 then do; a_error_code = error_table_$action_not_performed; return; end; bl = rs.record_length; bp = rs.record_ptr; return; %include rs_info; %include iox_dcls; end chase; get_obj_name: proc (); if registry_operation (base_op) then object_name = "Registry " || pathname_ (registry_dir, resource_info.resource_type); else object_name = (rtrim (resource_info.resource_type)) || " " || resource_info.resource_name; return; end get_obj_name; registry_operation: proc (op) returns (bit (1) aligned); dcl op bit (36) aligned; return (op = access_operations_$rcp_copy_registry | op = access_operations_$rcp_delete_registry | op = access_operations_$rcp_reconstruct_registry | op = access_operations_$rcp_update_registry_header); end registry_operation; fill_audit_record: proc (a_code); dcl a_code fixed bin (35); dcl is_vol bit (1); dcl fill_code fixed bin (35); fill_code = 0; is_vol = "0"b; unspec (rcp_obj_info) = ""b; rcp_obj_info.info_type = AAB_rcp_object; rcp_obj_info.version = AUDIT_RCP_OBJ_INFO_VERSION_1; rcp_obj_info.pad = "0"b; rcp_obj_info.resource_type = resource_info.resource_type; rcp_obj_info.resource_name = resource_info.resource_name; rcp_obj_info.owner_id = owner; rcp_obj_info.access_class = object_access_class; rcp_obj_info.raw_mode = raw_mode; rcp_obj_info.rcp_ring_brackets = rbs; if registry_operation (base_op) then rcp_obj_info.registry = "1"b; else do; call resource_info_$get_type (resource_info.resource_type, is_vol, fill_code); if fill_code ^= 0 then goto FILL_RETURN; rcp_obj_info.device = ^is_vol; rcp_obj_info.volume = is_vol; rcp_obj_info.usage_locked = registry_record.usage_lock; rcp_obj_info.release_locked = registry_record.release_lock; rcp_obj_info.awaiting_clear = registry_record.awaiting_clear; rcp_obj_info.has_acs_path = (registry_record.acs_path_desc ^= 0); rcp_obj_info.flags.pad = "0"b; rcp_obj_info.attributes = registry_record.attributes; end; FILL_RETURN: a_code = fill_code; return; end fill_audit_record; get_msg_str: proc (); call ioa_$rsnnl ( "^[raw_mode=^a ^;^s^]^[rcp_ring_brackets=^d,^d ^;^2s^]^[^[potential_attributes ^]^[desired_attributes ^]^[potential_aim_range ^]^[aim_range ^]^[owner ^]^[acs_path ^]^[location ^]^[comment ^]^[charge_type ^]^[usage_lock ^]^[release_lock ^]^[user_alloc^]^]", msg_str, (0), (raw_mode ^= ""b), SEG_ACCESS_MODE_NAMES (bin (rcp_obj_info.raw_mode)), (rbs (1) ^= -1), rcp_obj_info.rcp_ring_brackets, (base_op = access_operations_$rcp_set | base_op = access_operations_$rcp_set_access), detailed_operation.given.potential_attributes, detailed_operation.given.desired_attributes, detailed_operation.given.potential_aim_range, detailed_operation.given.aim_range, detailed_operation.given.owner, detailed_operation.given.acs_path, detailed_operation.given.location, detailed_operation.given.comment, detailed_operation.given.charge_type, detailed_operation.given.usage_lock, detailed_operation.given.release_lock, detailed_operation.given.user_alloc); end get_msg_str; %include access_audit_binary_def; %page; %include access_audit_encoded_op; %page; %include access_audit_rcp_info; %page; %include access_mode_values; %page; %include rcp_ops; %page; %include rcp_requestor_info; %page; %include rcp_resource_info; %page; %include rcp_registry; end rcp_audit;  rcp_authenticate_device_.pl1 11/11/89 1110.3rew 11/11/89 0806.7 59517 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-01-15,Fawcett), approve(86-04-11,MCR7383), audit(86-05-14,Farley), install(86-07-17,MR12.0-1097): Add support for subvolumes by setting a priority for authentication. END HISTORY COMMENTS */ rcp_authenticate_device_: proc (a_device_name, a_oper_auth_code, a_code); /* This program takes a device name and an authentication code. For tape drives it gets the user specified volume name, converts it with authenticate_ and checks it against the operator specified authentication code ("***", if permitted, matches any code). For disk drives it checks the authentication code against the disk label type flags in the rcse. */ /* Written by R.J.C. Kissel in September 1977. Modified by R.J.C. Kissel 1/79 to handle disk authentication. Modified 05/79 by C. D. Tavares to handle new authentication levels. Modified 6/79 by Michael R. Jordan for MR7.0R. */ dcl a_device_name char (*); dcl a_oper_auth_code char (*); dcl a_code fixed bin (35); dcl UPPER char (26) static internal options (constant) init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"); dcl LOWER char (26) static internal options (constant) init ("abcdefghijklmnopqrstuvwxyz"); dcl device_name char (32); dcl oper_auth_code char (3); dcl code fixed bin (35); dcl user_label char (32); dcl caller_level fixed bin; dcl found bit (1); dcl i fixed bin; dcl authenticate_ entry (char (*)) returns (char (3) aligned); /* In upper case. */ dcl rcp_pointers_$com_seg entry () returns (ptr); dcl rcp_pointers_$data entry () returns (ptr); dcl hcs_$wakeup entry (bit (36), fixed bin (71), fixed bin (71), fixed bin (35)); dcl get_ring_ entry () returns (fixed bin); dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl rcp_lock_$lock entry (ptr, fixed bin (35)); dcl rcp_lock_$unlock entry (ptr); dcl (error_table_$auth_incorrect, error_table_$auth_unknown, error_table_$dev_nt_assnd, error_table_$action_not_performed, error_table_$improper_data_format) external fixed bin (35); dcl cleanup condition; dcl (translate, addr, substr, null) builtin; code = 0; lock_info_ptr = null (); call cu_$level_get (caller_level); on cleanup call CLEANUP; call cu_$level_set (get_ring_ ()); device_name = a_device_name; oper_auth_code = a_oper_auth_code; rcpd_ptr = rcp_pointers_$data (); rcs_ptr = rcp_pointers_$com_seg (); lock_info_ptr = addr (rcs.lock_info); call rcp_lock_$lock (lock_info_ptr, code); if code ^= 0 then do; call CLEANUP; return; end; found = "0"b; do i = 1 to rcs.num_entries by 1 while (^found); rcse_ptr = addr (rcs.entry (i)); if rcse.device_name = device_name /* Right device. */ & rcse.kind = 1 /* The attach entry. */ & rcse.state ^= 0 /* Not free, i.e. probably attaching. */ then found = "1"b; end; if ^found then do; code = error_table_$dev_nt_assnd; call CLEANUP; return; end; if ^rcse.flags.need_auth | (substr (device_name, 1, 3) ^= "tap" & substr (device_name, 1, 3) ^= "dsk") then do; code = error_table_$action_not_performed; call CLEANUP; return; end; if substr (device_name, 1, 3) = "tap" then do; /* Handle tape authentication. */ if rcpd.modes.authentication_level = No_authentication then goto auth_ok; if rcpd.modes.authentication_level = Nominal_authentication then if oper_auth_code = "***" then goto auth_ok; /* full auto or manual authentication */ if oper_auth_code = "***" then do; /* don't allow this */ code = error_table_$improper_data_format; call CLEANUP; return; end; user_label = rcse.volume_name; if (translate (oper_auth_code, UPPER, LOWER) = authenticate_ (user_label)) then auth_ok: do; rcse.have_auth = "1"b; rcse.auth_set = "1"b; rcse.need_auth = "0"b; end; else do; rcse.have_auth = "0"b; rcse.auth_set = "1"b; rcse.need_auth = "0"b; end; call hcs_$wakeup ((rcse.process_id), rcse.event_id, 0, code); call CLEANUP; return; end; /* Handle tape authentication. */ else do; /* Handle disk authentication. */ if oper_auth_code = "no" then do; /* Operator has denied authentication. */ rcse.have_auth = "0"b; rcse.auth_set = "1"b; rcse.need_auth = "0"b; end; /* Operator has denied authentication. */ else if (oper_auth_code = "ss") | (oper_auth_code = "io") | (oper_auth_code = "urd") | (oper_auth_code = "urg") then do; if (rcse.flags.disk_ss_pack | rcse.flags.disk_copy_of_ss_pack) & ^(oper_auth_code = "ss") then goto wrong_auth_code; else if (rcse.flags.disk_io_pack & ^(oper_auth_code = "io")) then goto wrong_auth_code; else if (rcse.flags.disk_unreadable & ^(oper_auth_code = "urd")) then goto wrong_auth_code; else if (rcse.flags.disk_unregistered & ^(oper_auth_code = "urg")) then goto wrong_auth_code; /* Operator has authenticated the pack. */ rcse.have_auth = "1"b; rcse.auth_set = "1"b; rcse.need_auth = "0"b; end; /* Operator has authenticated the pack. */ else do; /* Unknown authentication code. */ code = error_table_$auth_unknown; call CLEANUP; return; end; call hcs_$wakeup ((rcse.process_id), rcse.event_id, 0, code); /* Inform user the operator is done. */ call CLEANUP; return; end; /* Handle disk authentication. */ wrong_auth_code: code = error_table_$auth_incorrect; call CLEANUP; return; /* */ CLEANUP: proc; if lock_info_ptr ^= null then call rcp_lock_$unlock (lock_info_ptr); call cu_$level_set (caller_level); a_code = code; end CLEANUP; %include rcp_data; %include rcp_com_seg; end rcp_authenticate_device_;  rcp_auto_register_.pl1 11/11/89 1110.3r 11/11/89 0806.9 31437 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ rcp_auto_register_: proc (rsct, resource_name, group_id, code); /* This procedure will register the specified resource for the specified user. It is called when a volume must be automatically registered for a user. Initially coded 3/79 by Michael R. Jordan for MR7.0R */ /* PARAMETERS */ dcl code fixed bin (35); /* Error code. */ dcl group_id char (*); /* Nmae of the user. */ dcl resource_name char (*); /* Name of the resource to be registered. */ dcl rsct char (*); /* Type of resource to register. */ /* ENTRIES CALLED */ dcl admin_gate_$syserr entry options (variable); dcl rcp_pointers_$com_seg entry () returns (ptr); dcl rcprm_find_resource_$auto_register entry (ptr, char (*), fixed bin (35)); dcl resource_info_$defaults entry (char (*), char (*), ptr, fixed bin, fixed bin (35)); /* ERROR CODES */ dcl error_table_$action_not_performed fixed bin (35) ext; dcl error_table_$rcp_no_auto_reg fixed bin (35) ext; /* BUILTIN FUNCTIONS */ dcl addr builtin; dcl size builtin; dcl string builtin; %include rcp_com_seg; %include resource_control_desc; code = 0; /* No error, yet. */ Resource_count = 1 ; /* Just one resource to register. */ begin; dcl garbage (size (resource_descriptions)) bit (36); string (garbage) = "0"b; resource_desc_ptr = addr (garbage); resource_descriptions.version_no = resource_desc_version_1; resource_descriptions.n_items = 1; call resource_info_$defaults (rsct, "", resource_desc_ptr, 0, code); if code ^= 0 then return; if ^resource_descriptions.item (1).given.potential_attributes | ^resource_descriptions.item (1).given.potential_aim_range | ^resource_descriptions.item (1).given.charge_type then do; code = error_table_$rcp_no_auto_reg; return; end; resource_descriptions.item (1).name = resource_name; resource_descriptions.item (1).given.name = "1"b; resource_descriptions.item (1).owner = group_id; resource_descriptions.item (1).given.owner = "1"b; call rcprm_find_resource_$auto_register (resource_desc_ptr, (rcp_pointers_$com_seg () -> rcs.acs_directory), code); if code = error_table_$action_not_performed then code = resource_descriptions.item (1).status_code; end; if code = 0 then call admin_gate_$syserr (0, "RCP: ^a ^a registered and acquired to ^a.", rsct, resource_name, group_id); return; /* BEGIN MESSAGE DOCUMENTATION Message: RCP: RESOURCE_TYPE RESOURCE_NAME registered and acquired to USER. S: $info T: $run M: The resource RESOURCE_NAME has been automatically registered and acquired to USER. It is a resource of the type RESCOURCE_TYPE. A: $ignore END MESSAGE DOCUMENTATION */ end rcp_auto_register_;  rcp_cancel_id_.pl1 11/11/89 1110.3rew 11/11/89 0805.2 97497 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(87-06-25,Rauschelbach), approve(87-06-29,MCR7736), audit(87-07-21,Farley), install(87-08-06,MR12.1-1063): System error message documentation was added. END HISTORY COMMENTS */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_cancel_id_: proc (a_reservation_id, a_group_id, a_code); /* * This subroutine will implement the privileged reservation cancelling * function needed by the operator and initializer process. It uses * the reservation_id to cancel the reservations of all the resources * associated with that id. The group_id is used to help guarantee * that the reservation_id was correctly entered, it must match the * reserved_for field of the reservation. * This subroutine will be used by the absentee manager when * terminating a process for which a reservation was made; and also * by the operator, if some terrible calamity befalls the initializer * process, to clean up leftover reservations. */ /* Written by R.J.C. Kissel 5/78. Modified by R.J.C. Kissel 1/79 to handle rcp_ gate calls and ambiguous request ids. Modified by Chris Jones 1/85 to stop using magic numbers. */ /* Arguments */ dcl a_reservation_id fixed bin (71); dcl a_group_id char (*); dcl a_code fixed bin (35); /* Local Variables */ dcl string bit (1); dcl system bit (1); dcl rstr_id char (19); dcl prc_id bit (36); dcl res_id fixed bin (71); dcl log_res_id char (19); dcl grp_id char (32) aligned; dcl code fixed bin (35); dcl i fixed bin; /* Index in rcpd. */ dcl any_found bit (1); dcl caller_level fixed bin; /* Local Constants */ /* Local Overlays */ /* External Entries */ dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl get_ring_ entry returns (fixed bin); dcl rcp_cancel_resource_ entry (char (*), char (*), fixed bin (35)); dcl rcp_pointers_$data entry returns (ptr); dcl rcp_pointers_$com_seg entry returns (ptr); dcl rcp_lock_$lock entry (ptr, fixed bin (35)); dcl rcp_lock_$unlock entry (ptr); dcl rcp_match_user_name_ entry (char (32) aligned, char (32) aligned) returns (bit (1)); dcl request_id_ entry (fixed bin (71)) returns (char (19)); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl admin_gate_$syserr entry options (variable); dcl get_process_id_ entry () returns (bit (36)); dcl match_request_id_ entry (fixed bin (71), char (*)) returns (bit (1) aligned); /* External Constants */ dcl error_table_$noentry fixed bin (35) external; dcl error_table_$badcall fixed bin (35) external; dcl error_table_$request_id_ambiguous fixed bin (35) external; dcl error_table_$invalid_resource_state fixed bin (35) external; /* Builtin Functions and Conditions */ dcl (addr, clock, rel, unspec) builtin; dcl (cleanup) condition; string = "0"b; system = "0"b; goto START; string: entry (a_res_id, a_code); dcl a_res_id char (*); string = "1"b; system = "0"b; goto START; sys: entry (a_reservation_id, a_group_id, a_code); string = "0"b; system = "1"b; goto START; sys_string: entry (a_res_id, a_group_id, a_code); string = "1"b; system = "1"b; goto START; START: if string then rstr_id = a_res_id; else res_id = a_reservation_id; if system then grp_id = a_group_id; else prc_id = get_process_id_ (); call cu_$level_get (caller_level); on cleanup call cleanup_handler; call cu_$level_set (get_ring_ ()); rcpd_ptr = rcp_pointers_$data (); rcs_ptr = rcp_pointers_$com_seg (); call rcp_lock_$lock (addr (rcpd.lock_info), code); if code ^= 0 then goto BAD_ERROR; /* * Loop through the rcp data base looking for the reservation * id. Then cancel the reservation. */ any_found = "0"b; if string then do; /* Check for ambiguous res id, and state not reserved. */ res_id = 0b; do i = 1 to rcpd.tot_devices; if match_request_id_ (rcpd.device (i).reservation_id, rstr_id) then do; /* Only check ones that match. */ any_found = "1"b; if rcpd.device (i).state ^= RESERVED /* Not reserved. */ then code = error_table_$invalid_resource_state; if res_id = 0b then res_id = rcpd.device (i).reservation_id; else if res_id ^= rcpd.device (i).reservation_id then goto BAD_RID; else ; end; /* Only check ones that match. */ end; do i = 1 to rcpd.last_volume; if match_request_id_ (rcpd.volume (i).reservation_id, rstr_id) then do; /* Only check ones that match. */ any_found = "1"b; if rcpd.volume (i).state ^= RESERVED /* Not reserved. */ then code = error_table_$invalid_resource_state; if res_id = 0b then res_id = rcpd.volume (i).reservation_id; else if res_id ^= rcpd.volume (i).reservation_id then goto BAD_RID; else ; end; /* Only check ones that match. */ end; if ^any_found then goto NONE_FOUND; if code ^= 0 then goto ALREADY_ASSND; any_found = "0"b; end; /* Check for ambiguous res id, and state not reserved. */ log_res_id = request_id_ (res_id); do i = 1 to rcpd.tot_devices; if rcpd.device (i).reservation_id = res_id then do; if system then do; if ^rcp_match_user_name_ (rcpd.device (i).group_id, grp_id) then goto BAD_GROUP; end; else do; if rcpd.device (i).process_id ^= prc_id then goto BAD_PRC; end; any_found = "1"b; device_ptr = addr (rcpd.device (i)); call rcp_cancel_resource_ (DEVICE_TYPE (device.dtypex), (device.device_name), code); if code ^= 0 then goto BAD_ERROR; call admin_gate_$syserr (JUST_LOG, "RCP: Cancelled device ^a for ^a (id=^a)", device.device_name, device.group_id, log_res_id); call ACCOUNT_WAKEUP (device_ptr, RCP_ACCTMSG_unassign); if device.volume_name = "" then device.group_id = ""; /* Only if not preloaded. */ device.reservation_id = 0; device.reserved_by = ""; device.process_id = "0"b; device.state_time = clock (); device.state = FREE; /* Free. */ end; end; do i = 1 to rcpd.last_volume; if rcpd.volume (i).reservation_id = res_id then do; if system then do; if ^rcp_match_user_name_ (rcpd.volume (i).group_id, grp_id) then goto BAD_GROUP; end; else do; if rcpd.volume (i).process_id ^= prc_id then goto BAD_PRC; end; any_found = "1"b; volume_ptr = addr (rcpd.volume (i)); call admin_gate_$syserr (JUST_LOG, "RCP: Cancelled volume ^a for ^a (id=^a)", volume.volume_name, volume.group_id, log_res_id); call rcp_cancel_resource_ (VOLUME_TYPE (volume.vtypex), (volume.volume_name), code); /* Ignore the code. */ volume.group_id = ""; volume.reservation_id = 0; volume.reserved_by = ""; volume.process_id = "0"b; volume.state_time = clock (); volume.state = FREE; /* Free. */ end; end; if ^any_found then goto NONE_FOUND; a_code = 0b; call rcp_lock_$unlock (addr (rcpd.lock_info)); call cu_$level_set (caller_level); return; remove_schedule: entry (a_resource_desc_ptr, resource_no, registry_dir, reserver_info_ptr, reserver_chain, a_code); /* This entry is called by rcprm_find_resource_$cancel to finish the cancellation of a resource once it has made sure that the cancellation may be requested by the caller (access control function.) */ /* Right now it is a no-op-- in fact, I would be surprised if anyone ever called rcprm_find_resource_$cancel. */ dcl ( a_resource_desc_ptr pointer, resource_no fixed bin, registry_dir char (*), reserver_info_ptr pointer, reserver_chain bit (18) unaligned ) parameter; a_code = 0; /* I'm OK, you're OK */ return; BAD_ERROR: call cleanup_handler; a_code = code; return; BAD_GROUP: call cleanup_handler; a_code = error_table_$badcall; return; BAD_PRC: call cleanup_handler; a_code = error_table_$badcall; return; BAD_RID: call cleanup_handler; a_code = error_table_$request_id_ambiguous; return; NONE_FOUND: call cleanup_handler; a_code = error_table_$noentry; return; ALREADY_ASSND: call cleanup_handler (); a_code = code; return; ACCOUNT_WAKEUP: procedure (a_devptr, a_action); /* This procedure is called to format an accounting message, and send it to the * accounting process. If the accounting event channel has not been set up, no message is sent. */ dcl a_devptr ptr; /* Pointer to rcp_data entry */ dcl a_action fixed bin; /* Accounting action */ dcl wakeup_buf fixed bin (71); dcl 1 auto_rcpamsg like rcp_account_msg aligned; unspec (auto_rcpamsg) = "0"b; auto_rcpamsg.device_user_procid = a_devptr -> device.process_id; auto_rcpamsg.rcp_data_relp = rel (a_devptr); auto_rcpamsg.devtype = a_devptr -> device.dtypex; auto_rcpamsg.action = a_action; unspec (wakeup_buf) = unspec (auto_rcpamsg); if rcpd.accounting_chan ^= 0 then call hcs_$wakeup (rcpd.accounting_pid, rcpd.accounting_chan, wakeup_buf, (0)); end ACCOUNT_WAKEUP; cleanup_handler: proc; call rcp_lock_$unlock (addr (rcpd.lock_info)); call cu_$level_set (caller_level); end cleanup_handler; /* Include Files */ %include rcp_data; %page; %include rcp_com_seg; %page; %include rcp_account_msg; %page; %include rcp_resource_types; %page; %include rcp_resource_states; %page; %include syserr_constants; %page; /* BEGIN MESSAGE DOCUMENTATION Message: RCP: Cancelled device devX_MM for GRP_ID (id=RES_ID) S: $log T: $run M: A device reservation has been cancelled by the operator, the absentee manager or the Initializer. A: $ignore Message: RCP: Cancelled volume volume_name for GRP_ID (id=RES_ID) S: $log T: $run M: A volume reservation has been cancelled by the operator, the absentee manager or the Initializer. A: $ignore END MESSAGE DOCUMENTATION */ end rcp_cancel_id_;  rcp_cancel_resource_.pl1 11/11/89 1110.3r 11/11/89 0806.9 24534 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ rcp_cancel_resource_: proc (rsc_type, rsc_name, code); /* This procedure will tell Resource Management when RCP is finished with a resource. It will only do so if Resource Management is enabled. Initially coded 3/79 by Michael R. Jordan for MR7.0R. */ /* PARAMETERS */ dcl code fixed bin (35); /* Error code. */ dcl rsc_name char (*); /* Name of the resource. */ dcl rsc_type char (*); /* Type of resource. */ /* ERROR CODES */ dcl error_table_$action_not_performed fixed bin (35) ext; /* ENTRIES CALLED */ dcl rcp_pointers_$com_seg entry () returns (ptr); dcl rcp_pointers_$data entry () returns (ptr); dcl rcprm_find_resource_$cancel entry (ptr, char (*), ptr, fixed bin (35)); /* BUILTIN FUNCTIONS */ dcl addr builtin; dcl null builtin; dcl size builtin; dcl string builtin; %include rcp_data; %include rcp_com_seg; %include resource_control_desc; /* Get everything set and check to see if Resource Management is enabled. */ code = 0; /* No error. */ rcpd_ptr = rcp_pointers_$data (); rcs_ptr = rcp_pointers_$com_seg (); if ^rcpd.modes.resource_mgmt_enabled /* No Resource Management, no work. */ then return; /* Now that we know Resource Management is enabled, we can tell him that we are finished with this resource. */ Resource_count = 1; /* Only one resource. */ begin; dcl garbage (size (resource_descriptions)) bit (36); string (garbage) = ""b; resource_desc_ptr = addr (garbage); resource_descriptions.version_no = resource_desc_version_1; resource_descriptions.n_items = 1; resource_descriptions.item (1).type = rsc_type; resource_descriptions.item (1).name = rsc_name; resource_descriptions.item (1).given.name = "1"b; call rcprm_find_resource_$cancel (resource_desc_ptr, (rcs.acs_directory), null (), code); if code = error_table_$action_not_performed then code = resource_descriptions.item (1).status_code; end; return; end rcp_cancel_resource_;  rcp_check_assign_.pl1 11/11/89 1110.3r 11/11/89 0805.9 44892 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_check_assign_: procedure (arg_rcp_id, arg_device_info_ptr, arg_comment, arg_statex, arg_ecode); /* This program implements the rcp_$check_assign entry point. * Created on 12/04/74 by Bill Silver. * * The rcp_id is used to generate a pointer to the RCS entry that is associated * with this assignment request. We will look in this RCS entry to obtain * the information that describes the results of the assignment operation. * In the current implementation the assignment is actually performed by the * assign call. If everything in the RCS entry is OK we will declare the * assignment to be completed and will return the device information to * the caller. */ /* ARGUMENT DATA */ dcl arg_comment char (*); /* (O) RCP comment. */ dcl arg_device_info_ptr ptr; /* (I) Pointer to device info structure. */ dcl arg_ecode fixed bin (35); /* (O) Return error_table_ code. */ dcl arg_rcp_id bit (36) aligned; /* (I) RCP ID. */ dcl arg_statex fixed bin; /* (O) State of assignment check. */ /* AUTOMATIC DATA */ dcl caller_level fixed bin; /* Caller's validation level. */ dcl dcode fixed bin (35); /* Dummy error code. */ dcl ecode fixed bin (35); /* error_table_ code. */ dcl rcp_id bit (36) aligned; /* Used to copy rcp_id argument. */ dcl save_ecode fixed bin (35); /* Dummy error code. */ /* EXTERNAL ENTRIES CALLED */ dcl cleanup condition; /* Used to set up a cleanup handler. */ dcl ( error_table_$bad_arg, error_table_$invalid_state, error_table_$out_of_sequence ) fixed bin (35) external; dcl clock_ entry returns (fixed bin (71)); dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl get_ring_ entry returns (fixed bin); dcl rcp_comment_ entry (ptr); dcl rcp_device_info_$set entry (ptr, ptr, fixed bin (35)); dcl rcp_unassign_$unassign entry (bit (36) aligned, bit (*), char (*), fixed bin (35)); dcl rcp_validate_ entry (bit (36) aligned, fixed bin, ptr, fixed bin (35)); call cu_$level_get (caller_level); /* Save caller's validation level. */ on cleanup begin; /* If trouble cleanup. */ call cu_$level_set (caller_level); /* Reset validation level. */ end; call cu_$level_set (get_ring_ ()); /* Set validation level to RCP level. */ rcp_id = arg_rcp_id; /* Copy arguments. */ device_info_ptr = arg_device_info_ptr; call rcp_validate_ (rcp_id, caller_level, rcse_ptr, ecode); if ecode ^= 0 /* Is RCP ID OK? */ then goto ERROR; /* No, rcse_ptr is not valid. */ if rcse.kind ^= 2 /* Is this a device assignment RCS entry? */ then do; /* No, leave attachment alone. */ ecode = error_table_$bad_arg; goto ERROR; end; ecode = rcse.ecode; /* Get code generated by rcp_initializer_. */ if ecode ^= 0 /* Was there an error assigning the device? */ then goto ERROR; if rcse.state ^= 2 /* We should be in the ASSIGNED state. */ then do; /* But we are not. */ ecode = error_table_$invalid_state; goto ERROR; end; /* Return the information about the assigned device in the info structure. */ /**** Passing a copy of device_info_ptr is OK since the pointer is used to base a write-only structure, so nothing the caller is doing can throw us. ****/ call rcp_device_info_$set (device_info_ptr, rcse_ptr, ecode); if ecode ^= 0 /* Is device info structure valid? */ then goto ERROR; /* Abort assignment. */ call rcp_comment_ (rcse_ptr); /* Type caller's comment. */ rcse.state = 5; /* Assignment now complete. */ rcse.state_time = clock_ (); arg_comment = ""; /* No comments returned by this version of RCP. */ arg_statex, /* Tell caller that assignment completed OK. */ arg_ecode = 0; call cu_$level_set (caller_level); /* Reset caller's validation level. */ return; ERROR: /* Abort assignment. */ call rcp_unassign_$unassign (rcp_id, "0"b, "", dcode); arg_statex = 3; /* Tell caller there was an error. */ arg_ecode = ecode; /* Return error code. */ call cu_$level_set (caller_level); /* Reset validation level. */ %include rcp_com_seg; %page; %include rcp_device_info_structs; end rcp_check_assign_;  rcp_check_attach_.pl1 11/11/89 1110.3rew 11/11/89 0805.2 138744 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_check_attach_: procedure (arg_rcp_id, arg_device_info_ptr, arg_comment, arg_ioi_index, arg_workspace_max, arg_timeout_max, arg_statex, arg_ecode); /* This program implements the rcp_$check_attach entry point. * Created on 12/04/74 by Bill Silver. * Accounting by B. Greenberg, 8/2/77. * Modified on 09/19/77 by R.J.C. Kissel to check workspace.acs for big workspace access. * Modified on 04/28/78 by Michael R. Jordan to allow preloaded volumes. * Modified on 02/08/79 by Michael R. Jordan for MSS0500 support. * Modified on 05/03/82 by E. N. Kittlitz to set ioi_timeout if UR device. * Modified on 01/24/83 by J. A. Bush to copy the label type and density into the asignment rcse * Modified 830818 to replace take_console call with console_free call... -E. A. Ranzenbach * Modified 841009 to interface with rcp_control_ instead of rcp_initializer_... - M. M. Pozzo * Modified 850131 general cleanup...M. M. Pozzo */ /****^ HISTORY COMMENTS: 1) change(85-07-21,ABall), approve(86-02-21,MCR7346), audit(86-07-29,Farley), install(86-08-01,MR12.0-1108): Modified to check for null rcse_ptr before referencing through during error handling. 2) change(85-09-11,Fawcett), approve(85-09-11,MCR6979), audit(85-12-02,CLJones), install(86-03-21,MR12.0-1033): Add MCA and FIPS support END HISTORY COMMENTS */ /****^ The rcp_id is used to generate a pointer to the RCS entry that is associated with this attachment request. We will look in this RCS entry to obtain the information that describes the results of the attachment operation. In the current implementation any assignment needed is performed by the attach call. The attachment itself involves setting up communication with IOI. For some devices there is the additional problem of mounting volumes. The caller may be told to go blocked and call us back when he wakes up. When the attachment is finally completed we will call IOI to set the limits for this device and to promote the device to the caller's validation level. Then we will return the information that he needs in order to perform I/O on this device. */ /* ARGUMENT DATA */ dcl arg_comment char (*); /* (O) RCP comment. */ dcl arg_device_info_ptr ptr; /* (I) Pointer to device info structure. */ dcl arg_ecode fixed bin (35); /* (O) Return error_table_ code. */ dcl arg_ioi_index fixed bin; /* (O) Index used to communicate with IOI. */ dcl arg_rcp_id bit (36) aligned; /* (I) RCP ID. */ dcl arg_statex fixed bin; /* (O) Caller's attachment state index. */ dcl arg_timeout_max fixed bin (71); /* (O) Max time-out value in microseconds. */ dcl arg_workspace_max fixed bin (19); /* (O) max size of IOI workspace in words. */ /* AUTOMATIC DATA */ dcl console_is_free bit (1); /* ON => OK to attach console... */ dcl volume_offset bit (18) aligned; /* Offset to volume entry for rcp_control_ */ dcl device_offset bit (18) aligned; /* Offset to device entry for rcp_control_ . */ dcl process_id bit (36) aligned; /* Process id makin the request to RCP. */ dcl rcp_id bit (36) aligned; /* Used to copy rcp_id argument. */ dcl device_name char (32); /* Device name for rcp_control_ */ dcl operation bit (36) aligned; /* Type of operation being requested of rcp_control_ */ dcl caller_level fixed bin; /* Caller's validation level. */ dcl dcode fixed bin (35); /* Dummy error code. */ dcl dtypex fixed bin; /* Device type index. */ dcl ecode fixed bin (35); /* error_table_ code. */ dcl error_count fixed bin (17); /* Error count for attachments needed by rcp_control_. */ dcl ioi_index fixed bin; /* IOI internal device index. */ dcl statex fixed bin; /* Caller's attachment state index. */ dcl timeout_max fixed bin (71); /* Max time-out interval in microseconds. */ dcl workspace_max fixed bin (19); /* Max IOI workspace size in words. */ dcl arcse_ptr ptr; /* Pointer to assignment RCS entry. */ dcl device_info_ptr ptr; /* Pointer to device info */ dcl device_pointer ptr; dcl device_vol_ptr ptr; dcl rcp_data_pointer ptr; /* BASED DATA */ dcl 1 arcse based (arcse_ptr) like rcse aligned; /* Used to reference assignment RCS entry. */ /* INTERNAL STATIC DATA */ /* EXTERNAL ENTRIES CALLED */ dcl cleanup condition; /* Used to set up a cleanup handler. */ dcl (null, ptr, substr) builtin; dcl ( error_table_$bad_arg, error_table_$invalid_state ) fixed bin (35) external; dcl access_operations_$rcp_account bit (36) aligned ext static; dcl rcp_pointers_$data entry () returns (ptr); dcl admin_gate_$console_free entry (char (4), bit (1)); dcl admin_gate_$ioi_promote entry (fixed bin, fixed bin, fixed bin (35)); dcl admin_gate_$ioi_set_to_max entry (fixed bin, fixed bin (71), fixed bin (35)); dcl admin_gate_$ioi_set_ws_max entry (fixed bin, fixed bin (19), fixed bin (35)); dcl clock_ entry returns (fixed bin (71)); dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl get_ring_ entry returns (fixed bin); dcl ioi_$timeout entry (fixed bin, fixed bin (71), fixed bin (35)); dcl rcp_detach_$detach entry (bit (36) aligned, bit (*), fixed bin, char (*), fixed bin (35)); dcl rcp_device_info_$set entry (ptr, ptr, fixed bin (35)); dcl rcp_disk_ entry (ptr, fixed bin (35)); dcl rcp_control_ entry (bit (36) aligned, bit (18) aligned, bit (18) aligned, char (*), fixed bin (17), bit (36) aligned, fixed bin (35)); dcl rcp_ioi_attach_ entry (ptr, fixed bin (35)); dcl rcp_tape_ entry (ptr, fixed bin (35)); dcl rcp_validate_ entry (bit (36) aligned, fixed bin, ptr, fixed bin (35)); /* */ %include rcp_com_seg; %include rcp_data; volume_offset = ""b; device_offset = ""b; process_id = ""b; device_name = ""; error_count = 0; ecode = 0; call cu_$level_get (caller_level); /* Save caller's validation level. */ on cleanup begin; /* If trouble cleanup. */ call cu_$level_set (caller_level); /* Reset validation level. */ end; call cu_$level_set (get_ring_ ()); /* Set validation level to RCP level. */ rcp_id = arg_rcp_id; /* Copy arguments. */ device_info_ptr = arg_device_info_ptr; call rcp_validate_ (rcp_id, caller_level, rcse_ptr, ecode); if ecode ^= 0 /* Is RCP ID OK? */ then goto ERROR; /* No. */ if rcse.kind ^= 1 /* Is this a device attachment RCS entry? */ then do; /* No, can't go on. */ ecode = error_table_$bad_arg; goto ERROR; end; ecode = rcse.ecode; /* Get code generated by rcp_control_. */ if ecode ^= 0 /* Was there any error. */ then goto ERROR; arcse_ptr = ptr (rcse_ptr, rcse.rcse_off); /* Get pointer to assignment RCSE. */ goto ATTACHMENT_STATE (rcse.state); /* Check current state of attachment. */ ATTACHMENT_STATE (0): /* FREE */ ATTACHMENT_STATE (1): /* ASSIGNING */ ATTACHMENT_STATE (4): /* ATTACHED */ ATTACHMENT_STATE (5): /* COMPLETED */ ecode = error_table_$invalid_state; goto ERROR; ATTACHMENT_STATE (2): /* ASSIGNED */ if arcse.state ^= 5 /* Has assignment been completed? */ then do; /* No. */ ecode = arcse.ecode; /* Get assignment error code. */ if ecode ^= 0 /* Any error in assignment? */ then goto ERROR; /* Yes, abort attachment. */ arcse.state = 5; /* Indicate that assignment has been checked. */ arcse.state_time = clock_ (); end; rcse.state = 3; /* Now attaching. */ rcse.device_name = arcse.device_name; /* Get name of assigned device. */ rcse.device_off = arcse.device_off; /* Copy rcp_data offset of assigned device. */ rcse.flags.fips = arcse.flags.fips; /* Copy fips flag */ rcse.flags.no_protect = arcse.flags.no_protect; /* Copy no_protect flag */ rcse.flags.opr_int_available = arcse.flags.opr_int_available; /* Copy opr_int_available flag */ ATTACHMENT_STATE (3): /* ATTACHING */ dtypex = rcse.dtypex; /* Get device type. */ call ATTACH; /* Perform the actual attachment. */ if ecode ^= 0 then goto ERROR; if rcse.state = 3 /* Are we still attaching? */ then do; /* Yes. */ statex = 1; /* Caller should block and then call back. */ goto RETURN; end; ioi_index = rcse.ioi_index; /* No, we can now complete the attachment. *. */ rcs_ptr = ptr (rcse_ptr, "0"b); if (rcse.flags.volume) & /* Did we assign a volume? */ (rcse.volume_name ^= "scratch") /* That was not a scratch volume? */ then do; /* Yes, remember volume in assignment RCS entry. */ arcse.flags.volume = "1"b; arcse.volume_name = rcse.volume_name; arcse.label_type = rcse.label_type; arcse.volume_density_index = rcse.volume_density_index; arcse.need_auth = rcse.need_auth; end; /* Now complete the attachment by calling IOI to set the workspace and * time-out limits and to promote the device. */ if rcse.flags.priv /* If privileged attachment, */ | rcse.flags.system /* Or system user. */ then workspace_max = rcs.ws_pmaxs (dtypex); /* Then give user large IOI workspace max. */ else do; /* A normal user. */ if USER_ON_WS_ACS ("01010"b) then workspace_max = rcs.ws_pmaxs (dtypex); /* Then give user large IOI workspace max. */ else workspace_max = rcs.ws_maxs (dtypex); /* Else give user normal IOI workspace max. */ end; rcse.workspace_max = workspace_max; call admin_gate_$ioi_set_ws_max (ioi_index, workspace_max, ecode); if ecode ^= 0 then goto ERROR; rcse.timeout_max, /* Get and set max IOI time-out interval. */ timeout_max = rcs.to_maxs (dtypex); call admin_gate_$ioi_set_to_max (ioi_index, timeout_max, ecode); if ecode ^= 0 then goto ERROR; if dtypex = 4 | /* PRINTER */ dtypex = 5 | /* PUNCH */ dtypex = 6 /* READER */ then do; call ioi_$timeout (ioi_index, timeout_max, ecode); if ecode ^= 0 then go to ERROR; end; call admin_gate_$ioi_promote (ioi_index, rcse.caller_level, ecode); if ecode ^= 0 then goto ERROR; /* Return info about assigned device. Passing a copy of arg_device_info_ptr is OK since rcp_device_info_ uses it to base a write-only structure. */ call rcp_device_info_$set (device_info_ptr, ptr (rcse_ptr, rcse.rcse_off), ecode); if ecode ^= 0 then goto ERROR; rcse.state = 5; /* Attachment is now completed. */ statex = 0; /* Tell caller that it is complete. */ arg_ioi_index = ioi_index; /* Now we can return all the other info. */ arg_workspace_max = workspace_max; arg_timeout_max = timeout_max; /* Prepare for calling rcp_control_ */ operation = access_operations_$rcp_account; volume_offset = rcse.volume_off; device_offset = rcse.device_off; call rcp_control_ (operation, volume_offset, device_offset, device_name, error_count, process_id, ecode); goto RETURN; ERROR: /* Abort this attachment. */ if rcse_ptr ^= null () then call rcp_detach_$detach (rcse.rcp_id, "0"b, 0, "", dcode); statex = 3; /* Return error state. */ RETURN: /* Return command args, reset validation level. */ arg_comment = " "; arg_statex = statex; arg_ecode = ecode; call cu_$level_set (caller_level); return; /* */ ATTACH: procedure; /* This procedure is called to perform the actual attachment via IOI. * The processing to be done depends upon the device type. */ goto DEVICE_TYPE (dtypex); /* Process depending upon device type. */ DEVICE_TYPE (1): /* TAPE */ rcse.model = arcse.model; /* Need model for tape attachment/mounting. */ if rcse.flags.volume /* Determine if preloading is allowed for this attachement. */ & arcse.flags.volume & rcse.volume_name = arcse.volume_name then rcse.flags.preloaded = arcse.preload_allowed; call rcp_tape_ (rcse_ptr, ecode); /* Perform tape attachment and mounting. */ rcp_data_pointer = rcp_pointers_$data (); device_pointer = ptr (rcp_data_pointer, rcse.device_off); device_pointer -> device.flags.attached = "1"b; if rcse.flags.volume then device_vol_ptr = ptr (rcp_data_pointer, rcse.volume_off); return; DEVICE_TYPE (2): /* DISK */ rcse.model = arcse.model; /* Need model for tape attachment/mounting. */ if rcse.flags.volume /* Determine if preloading is allowed for this attachement. */ & arcse.flags.volume & rcse.volume_name = arcse.volume_name then rcse.flags.preloaded = arcse.preload_allowed; rcse.flags.not_removable_media = arcse.flags.not_removable_media; call rcp_disk_ (rcse_ptr, ecode); /* Perform disk attachment and mounting. */ rcp_data_pointer = rcp_pointers_$data (); device_pointer = ptr (rcp_data_pointer, rcse.device_off); device_pointer -> device.flags.attached = "1"b; if rcse.flags.volume then device_vol_ptr = ptr (rcp_data_pointer, rcse.volume_off); return; DEVICE_TYPE (3): /* CONSOLE */ call admin_gate_$console_free (substr (rcse.device_name, 1, 4), console_is_free); if ^console_is_free then do; ecode = error_table_$invalid_state; return; end; DEVICE_TYPE (4): /* PRINTER */ DEVICE_TYPE (5): /* PUNCH */ DEVICE_TYPE (6): /* READER */ DEVICE_TYPE (7): /* SPECIAL */ DEVICE_TYPE (8): /* MCA */ call rcp_ioi_attach_ (rcse_ptr, ecode); /* Attach the device in ring 0 via IOI. */ rcse.state = 4; /* Actual attachment has been performed. */ end ATTACH; /* */ USER_ON_WS_ACS: proc (test_access) returns (bit (1)); dcl test_access bit (5); /* access we are testing for, normally "rw" */ dcl actual_access fixed bin (5); /* access returned by hcs_$get_user_effmode. */ dcl hcs_$get_user_effmode entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin, fixed bin (5), fixed bin (35)); /* Note above that the "aligned" attributes are there only to get around the fact */ /* that the acs_directory and group_id are declared aligned in an include file. */ dcl bit builtin; call hcs_$get_user_effmode (rcs.acs_directory, "workspace.acs", rcse.group_id, rcse.caller_level, actual_access, ecode); if ecode ^= 0 then do; ecode = 0; /* This isn't really an error */ return ("0"b); /* Report failure */ end; if (bit (actual_access, 5) & test_access) = test_access then return ("1"b); /* This process has at least "rw" access */ else return ("0"b); /* This process does not have "rw" access */ end USER_ON_WS_ACS; end rcp_check_attach_;  rcp_check_attach_lv_.pl1 11/11/89 1110.3rew 11/11/89 0806.7 14229 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ rcp_check_attach_lv_: procedure (arg_rcp_id, arg_volume_info_ptr, arg_statex, arg_ecode); /* This procedure implements the rcp_$check_attach_lv entry. * Created on 04/08/76 by Bill Silver. * Modified 09/13/76 by Greenberg for lv_request_. * * This procedure is basically a NOP. */ dcl arg_rcp_id bit(36) aligned; /* (I) RCP ID of logical volume attachment. */ dcl arg_volume_info_ptr ptr; /* (I) Not really used. */ dcl arg_statex fixed bin; /* (O) 0 => OK, 3 => error. */ dcl arg_ecode fixed bin(35); dcl ecode fixed bin(35); dcl lvid bit(36) aligned; dcl rcp_id bit(36) aligned; dcl statex fixed bin; dcl rcp_lv_$check entry (bit (36) aligned, bit (36) aligned, fixed bin, fixed bin(35)); rcp_id = arg_rcp_id; call rcp_lv_$check (rcp_id, lvid, statex, ecode); if ecode ^= 0 then arg_statex = 3; else arg_statex = statex; arg_ecode = ecode; end rcp_check_attach_lv_;  rcp_comment_.pl1 11/11/89 1110.3rew 11/11/89 0804.3 30483 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: off */ rcp_comment_: procedure (arg_rcse_ptr); /* This program is an internal interface of RCP. * Created on 10/15/74 by Bill Silver. */ /****^ HISTORY COMMENTS: 1) change(87-02-10,Farley), approve(87-04-14,MCR7652), audit(87-04-15,Lippard), install(87-04-28,MR12.1-1028): Removed the resetting of rcse.caller_comment so that it can be multiply displayed if required along with the check mount message. END HISTORY COMMENTS */ /* This program is called to display a comment on the operator's console. * We will call a special ring 1 interface to syserr using syserr code 0. * The comment that is displayed is taken from the specified RCS entry. * The format of the comment message seen by the operator is: * * "RCP: Note (device_name) - comment" * * The following rules are used to control the printing of the comment. * 1. If the comment is blank it will not be displayed. * 2. If the comment contains any bad characters they will be * converted to blanks. The bad characters that we check * for are all ASCII characters from (000) to (037) octal. * 3. Once the comment is displayed it will be set to all * blanks so it will not be displayed again. */ dcl arg_rcse_ptr ptr; /* (I) Pointer to specified RCS entry. */ dcl converted_comment char(64); /* Used to convert bad characters. */ dcl x fixed bin; /* Search variable. */ dcl ( collate, search, substr, translate ) builtin; dcl admin_gate_$syserr entry options(variable); %page; %include rcp_com_seg; %page; /* Begin rcp_comment_. */ rcse_ptr = arg_rcse_ptr; /* Get pointer to RCS entry. */ if rcse.caller_comment = " " /* Is comment blank? */ then return; /* Yes, don't display comment. */ /* Look for bad characters. (000 - 037 octal) */ x = search (rcse.caller_comment, substr(collate,1,31)); if x ^= 0 /* Are there any bad characters in comment? */ then do; /* Yes, convert them to blanks. */ converted_comment = translate(rcse.caller_comment, " ", substr(collate,1,31)); rcse.caller_comment = converted_comment; if rcse.caller_comment = " " /* Is comment blank now? */ then return; /* Yes, then don't display it. */ end; call admin_gate_$syserr (0, "RCP: Note (^a) - ^a", rcse.device_name, rcse.caller_comment); %page; /* BEGIN MESSAGE DOCUMENTATION Message: RCP: Note (DEVICE) - COMMENT S: $info T: $run M: The user requesting the mounting of a tape or disk pack on device specified a comment string. A: Read the comment. It may describe special operator action, such as where to find or send the volume. END MESSAGE DOCUMENTATION */ end rcp_comment_;  rcp_compute_aim_mode.pl1 11/11/89 1110.3rew 11/11/89 0805.5 69885 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(87-07-06,Rauschelbach), approve(87-08-07,MCR7748), audit(87-11-11,Farley), install(87-11-30,MR12.2-1004): Changed to return error_table_$ai_restricted when access is denied for all cases, not just one. Removed signal to vfile_error condition as it was erroneously left from debugging. END HISTORY COMMENTS */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_compute_aim_mode: procedure (a_req_info_ptr, a_res_info_ptr, a_aim_mode, a_error_code); /* This internal subroutine implements mandatory access * control (AIM) for RCP. * Created 841112 by Maria M. Pozzo * */ /* ARGUMENT DATA */ dcl a_req_info_ptr ptr; /* (I) Points to requestor info */ dcl a_res_info_ptr ptr; /* (I) Points to resoruce info */ dcl a_aim_mode bit (3); /* (O) Raw AIM mode */ dcl a_error_code fixed bin (35); /* (O) Error code */ /* AUTOMATIC DATA */ dcl aim_mode bit (3); /* Local AIM mode */ dcl temp_range (2) bit (72) aligned; dcl based_bits bit (bl * 9) aligned based (bp); dcl bl fixed bin (21); dcl error_code fixed bin (35); /* Local error code */ dcl bp ptr; dcl (addr, null, unspec) builtin; /* EXTERNAL ENTRIES */ dcl aim_check_$range_in_range entry ((2) bit (72) aligned, (2) bit (72) aligned) returns (bit (1) aligned); dcl aim_check_$greater_or_equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl hcs_$get_authorization entry (bit (72) aligned, bit (72) aligned); dcl read_allowed_ entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl write_allowed_ entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl error_table_$ai_invalid_range ext fixed bin (35) static; dcl error_table_$ai_out_range ext fixed bin (35) static; dcl error_table_$ai_restricted ext fixed bin (35) static; dcl error_table_$action_not_performed ext fixed bin (35) static; %page; /* Copy arguments */ requestor_info_ptr = a_req_info_ptr; resource_info_ptr = a_res_info_ptr; record_ptr = resource_info.registry_record_ptr; user_auth = requestor_info.current_authorization; /* Initialize local variables */ aim_mode = REW_ACCESS; /* Assume REW initially */ error_code, bl = 0; bp = null (); /* If the resource is free, get the potential aim range found in the */ /* registry record; otherwise get the real aim range found in the */ /* registry record. */ if registry_record.free then call chase (registry_record.potential_aim_range_desc, bp, bl, error_code); else call chase (registry_record.aim_range_desc, bp, bl, error_code); if error_code ^= 0 then goto MAIN_RETURN; if bl > 0 then addr (temp_range) -> based_bits = based_bits; else unspec (temp_range) = ""b; /* no range, set to lowest possible */ /* If the low end of the AIM range is higher than us, then R access (and */ /* thus all access) is denied since we can't read up */ if ^read_allowed_ (user_auth, temp_range (1)) then do; aim_mode = N_ACCESS; error_code = error_table_$ai_restricted; goto MAIN_RETURN; end; /* If the current authorization is not at the low end of the AIM range */ /* then E access is denied since allowing it anywhere else in the range */ /* could be a potential covert channel. E access allows writing of */ /* protected attributes. */ if ^aim_check_$equal (user_auth, temp_range (1)) then aim_mode = aim_mode & RW_ACCESS; /* If the high end of the AIM range is lower or disjoint then W access */ /* is denied since we can't write down. We can still have R access and */ /* that is preserved, however, we must also deny E access since that */ /* allows writing of protected attributes and we have just been denied */ /* write access. */ if ^write_allowed_ (user_auth, temp_range (2)) then aim_mode = aim_mode & R_ACCESS; MAIN_RETURN: if error_code ^= 0 then aim_mode = N_ACCESS; a_aim_mode = aim_mode; a_error_code = error_code; return; %page; /* --------------------------------------------- */ permissible_aim: entry (max_range, aim_range, code); /* This entry takes a pair of AIM access classes and determines whether the user should be allowed to place these AIM range on some RCP resource. */ dcl (aim_range, max_range) (2) bit (72) aligned parameter; dcl user_auth bit (72) aligned; dcl code fixed bin (35); dcl rcp_priv bit (1) aligned; call hcs_$get_authorization (user_auth, (""b)); rcp_priv = addr (user_auth) -> aim_template.privileges.rcp; /* First and simplest check-- the high bounds must be >= the low bounds. */ if ^aim_check_$greater_or_equal (max_range (2), max_range (1)) then do; code = error_table_$ai_invalid_range; goto permissible_aim_return; end; if ^aim_check_$greater_or_equal (aim_range (2), aim_range (1)) then do; code = error_table_$ai_invalid_range; goto permissible_aim_return; end; /* Now check that the desired range "fits within" the max bounds. */ if (^aim_check_$range_in_range (aim_range, max_range)) then do; code = error_table_$ai_out_range; goto permissible_aim_return; end; /* Now we know that the ranges are self-consistent. */ code = 0; /* Now check to see whether this user has the ability to set these ranges. */ if rcp_priv then goto permissible_aim_return; /* Make sure a user at a high authorization is not making a resource "suddenly appear" to someone at a lower authorization. */ if ^write_allowed_ (user_auth, aim_range (1)) then do; code = error_table_$ai_restricted; goto permissible_aim_return; end; /* We don't check upper bound. Like creating directories, you can register a resource with an upper bound higher than you-- just don't expect to do anything else with it afterwards! */ permissible_aim_return: return; %page; /* ------------------------ */ chase: proc (descriptor, bp, bl, a_error_code); dcl ( descriptor fixed bin (35), a_error_code fixed bin (35), bp pointer, bl fixed bin (21) ) parameter; dcl 1 rs like rs_info aligned automatic; dcl local_code fixed bin (35); a_error_code = 0; if descriptor = 0 then do; bp = addr (bp); /* gotta point somewhere */ bl = 0; return; end; unspec (rs) = ""b; rs.version = rs_info_version_2; rs.locate_sw = "1"b; rs.descriptor = descriptor; local_code = 0; call iox_$control (resource_info.registry_switch_ptr, "record_status", addr (rs), local_code); if local_code ^= 0 then do; a_error_code = error_table_$action_not_performed; return; end; bl = rs.record_length; bp = rs.record_ptr; return; end chase; /* ------------------------------- */ %page; %include access_mode_values; %page; %include aim_template; %page; %include iox_dcls; %page; %include rcp_requestor_info; %page; %include rcp_resource_info; %page; %include rcp_registry; %page; %include rs_info; end rcp_compute_aim_mode;  rcp_compute_bracket_mode.pl1 11/11/89 1110.3rew 11/11/89 0807.0 37044 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-07-12,Pozzo), approve(86-08-13,MCR7510), audit(86-08-13,EJSharpe), install(86-08-19,MR12.0-1120): Modified to initialize the variable local_bracket_mode. Change name and date are guesses. END HISTORY COMMENTS */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_compute_bracket_mode: procedure (a_acs_path, a_requestor_info_ptr, a_resource_info_ptr, a_bracket_mode, a_rbs, a_error_code); /* This internal subroutine implements intraprocess access * computations (ring brackets) for RCP. * Created 841030 by Maria M. Pozzo * * If the ACS segment exists as found in a_acs_path, then get * the ring brackets from the ACS segment and set access as follows: * user validation in 0-r1 ---- REW * user validation in 0-r2 ---- R * If the ACS segment does not exist, then this check is bypassed. */ /* ARGUMENT DATA */ dcl a_requestor_info_ptr ptr; /* (I) Pointer to information about the real requestor of the RCP operation - not Initializer. */ dcl a_resource_info_ptr ptr; /* (I) Pointer to information about the resource being requested */ dcl a_acs_path char (168); /* (I) Pathname of the associated ACS segment */ dcl a_bracket_mode bit (3); /* (O) Resulting discretionary access mode of requestor to resource */ dcl a_rbs (2) fixed bin (3); /* (O) The ring brackets of the ACS segment if they exist. */ dcl a_error_code fixed bin (35); /* (O) Error code */ /* AUTOMATIC */ dcl local_bracket_mode bit (3); /* Internal bracket mode */ dcl acs_path char (168); /* ACS pathname */ dcl registry_dir char (64); /* Registry directory */ dcl error_code fixed bin (35); /* Error code */ dcl user_level fixed bin (3); /* Validation level of caller */ dcl resource_ring_brackets (3) fixed bin (3); /* Ring brackets of resource */ /* ENTRIES CALLED */ dcl hcs_$get_ring_brackets entry (char (*), char (*), (3) fixed bin (3), fixed bin (35)); /* ERROR ENTRIES */ dcl error_table_$resource_bad_access fixed bin (35) ext static; %page; /* Copy input arguments */ acs_path = a_acs_path; requestor_info_ptr = a_requestor_info_ptr; resource_info_ptr = a_resource_info_ptr; /* Initialize local variables and get set up */ error_code = 0; local_bracket_mode = "000"b; user_level = requestor_info.validation_level; registry_dir = resource_info.registry_dir; /* Find out the ACS segment ring brackets. */ call hcs_$get_ring_brackets (a_acs_path, "", resource_ring_brackets, error_code); if error_code ^= 0 then goto MAIN_RETURN; a_rbs (1) = resource_ring_brackets (1); a_rbs (2) = resource_ring_brackets (2); /* See if we are in the read (R) bracket 0-r2 */ if user_level <= resource_ring_brackets (2) then local_bracket_mode = R_ACCESS; /* See if we are in the executive/write bracket (EW) which also implies R bracket. */ if user_level <= resource_ring_brackets (1) then local_bracket_mode = local_bracket_mode | REW_ACCESS; MAIN_RETURN: if local_bracket_mode = N_ACCESS then error_code = error_table_$resource_bad_access; a_bracket_mode = local_bracket_mode; a_error_code = error_code; return; %page; %include access_mode_values; %page; %include rcp_requestor_info; %page; %include rcp_resource_info; end rcp_compute_bracket_mode;  rcp_compute_raw_mode.pl1 11/11/89 1110.3rew 11/11/89 0804.6 49770 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_compute_raw_mode: procedure (a_rm_on, a_requestor_info_ptr, a_resource_info_ptr, a_acs_path, a_owner, a_raw_mode, a_error_code); /****^ This internal subroutine implements discretionary access computations for RCP. Created 841025 by Maria M. Pozzo */ /****^ HISTORY COMMENTS: 1) change(85-07-12,Pozzo), approve(86-02-21,MCR7346), audit(86-07-29,Farley), install(86-08-01,MR12.0-1108): Modified to allow owners to retain REW access if the ACS specified in the registry does not exist. END HISTORY COMMENTS */ /****^ If Resource Management is DISABLED, simply get the ACL from the ACS segment located in >sc1>rcp. If Resource Management is ENABLED, and there is an ACS segment set the access from the ACL of the ACS segment. If there is no ACS, get the resource owner from the registry and set as follows: owner = user_id REW owner NULL world owner = free NULL world owner = system NULL world */ /* ARGUMENT DATA */ dcl a_rm_on bit (1) aligned; /* (I) "1"b means Resource Management is Enabled. */ dcl a_requestor_info_ptr ptr; /* (I) Pointer to information about the real requestor of the RCP operation - not Initializer. */ dcl a_resource_info_ptr ptr; /* (I) Pointer to information about the resource being requested */ dcl a_acs_path char (168); /* (I) Pathname of the associated ACS segment */ dcl a_owner char (32); /* (I/O) Owner of the resource */ dcl a_raw_mode bit (3); /* (O) Resulting discretionary access mode of requestor to resource */ dcl a_error_code fixed bin (35); /* (O) Error code */ /* AUTOMATIC */ dcl local_raw_mode bit (3); /* Local raw mode */ dcl rm_on bit (1) aligned; /* ON=> Resource Management enabled */ dcl temp_mode bit (36) aligned; /* Conversion of modes */ dcl is_volume bit (1); /* ON=> resource type is volume */ dcl acs_path char (168); /* ACS path name */ dcl owner char (32) varying; /* Resource owner */ dcl registry_dir char (64); /* Registry directory */ dcl user char (32); /* User id */ dcl error_code fixed bin (35); /* EXTERNAL STATIC */ dcl error_table_$resource_bad_access fixed bin (35) ext static; dcl error_table_$resource_unknown fixed bin (35) ext static; /* BUILTINS */ dcl (length, rtrim, substr) builtin; /* ENTRIES CALLED */ dcl hcs_$get_user_raw_mode entry (char (*), char (*), char (*), bit (36) aligned, fixed bin (35)); dcl resource_info_$get_type entry (char (*), bit (1), fixed bin (35)); %page; /* Copy input arguments */ rm_on = a_rm_on; requestor_info_ptr = a_requestor_info_ptr; resource_info_ptr = a_resource_info_ptr; acs_path = a_acs_path; owner = a_owner; /* Initialize local variables and get set up */ local_raw_mode = N_ACCESS; temp_mode = (36)"0"b; error_code = 0; /* The user is in the form of *.*.* and the owner is in */ /* the form *.* in the registry so must strip user of tag. */ user = substr (requestor_info.user_id, 1, length (rtrim (requestor_info.user_id)) - 2); registry_dir = resource_info.registry_dir; /* Is Resource Management Enabled */ if (rm_on & acs_path = "") then do; if owner = user then /* Owner gets REW */ local_raw_mode = REW_ACCESS; else local_raw_mode = N_ACCESS; /* NULL access to world */ end; else if (acs_path ^= "") then do; /* We have an ACS path */ call hcs_$get_user_raw_mode (acs_path, "", (requestor_info.user_id), temp_mode, error_code); /* If the access on the acs_path cannont be determined (i.e. it */ /* doesn't exist or something) the owner should retain REW. */ if error_code ^= 0 then if user = owner then do; local_raw_mode = REW_ACCESS; error_code = 0; end; else goto MAIN_RETURN; else local_raw_mode = substr (temp_mode, 1, 3); end; else do; /* We know there's no ACS and RM is disabled */ call resource_info_$get_type (resource_info.resource_type, is_volume, error_code); if error_code ^= 0 then goto MAIN_RETURN; if is_volume then local_raw_mode = RW_ACCESS; /* Everyone has RW to volumes */ /* At this point it is not a volume and there is no */ /* ACS for it so it is not a known resource. */ else error_code = error_table_$resource_unknown; end; MAIN_RETURN: if local_raw_mode = N_ACCESS then error_code = error_table_$resource_bad_access; a_raw_mode = local_raw_mode; a_error_code = error_code; return; %page; %include access_mode_values; %page; %include rcp_requestor_info; %page; %include rcp_resource_info; %page; %include rcp_registry; end rcp_compute_raw_mode;  rcp_control_.pl1 11/11/89 1110.3rew 11/11/89 0806.7 491463 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-09-11,Fawcett), approve(85-09-11,MCR6979), audit(85-12-02,CLJones), install(86-03-21,MR12.0-1033): Add support for FIPS and IMU 2) change(86-08-07,Farley), approve(86-08-07,MCR7448), audit(86-10-20,Beattie), install(86-10-28,MR12.0-1200): Changed DELETE_DEVICE to unload the device BEFORE deleting it. Changed TEST_DEVICE to set priv_gate_call to OFF, even when called through rcp_priv_. Changed ASSIGN to properly unassign the volume when the device assignment fails. 3) change(87-01-27,Farley), approve(87-04-06,MCR7650), audit(87-04-15,Dickson), install(87-04-28,MR12.1-1028): Changed to reset device.flags.attached before unloading the volume from the device. This is required when the device is still assigned. 4) change(87-06-25,Rauschelbach), approve(87-06-29,MCR7736), audit(87-07-21,Farley), install(87-08-06,MR12.1-1063): The error error_table_$resource_unknown was replaced with a new error code error_table_$no_appropriate_device for the instance of mismatched device and volume attributes. END HISTORY COMMENTS */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_control_: procedure (a_operation, a_volume_offset, a_device_offset, a_device_name, a_error_count, a_process_id, a_ecode); /* This program is an internal interface of RCP. * Created on 11/27/74 by Bill Silver * * This routine performs the following functions: * 1. Assign a device and/or volume. * 2. Update the error count for the specified device. * 3. Unassign a device and/or volume. * 4. Forcedly unassign a device. * 5. Unassign all resources of specified process. * 6. Delete a device. * 7. Add a device. */ /* Tape survey when adding drive by C. Hornig, September 1982. * Modified 12/8/83 by B. Braun to correct all device requests being denined (phx12105). * Modified 1/84 by Chris Jones to tell IOI what we've done about adding or deleting a device. * Modified 840521 for console addition / deletion... -E. A. Ranzenbach * Modified 841004 to change the name to rcp_control, to allow the * routine to accept arguments instead of a 72-bit message, and * perform some general cleanup...- M. M. Pozzo * Modified 850131 to interface with the new rcp_access_kernel_ for the * B2 effort...-M. M. Pozzo * Modified 1985-03-08, BIM: check console state. * Modified 1985-03-14, BIM: cleanup journals, translate "record not found" into "no such resource". * Modified 03/18/85 by Chris Jones to not delete devices until after their volumes are unloaded. * Modified 1985-04-3 by Paul Farley & Fawcett to add FIPS support and * add no_protect and opr_int_available code * Modified 1985-04-11, BIM&MMP: Don't zero error code before testing it in TEST_DEVICE. * Also audit mounts of volumes. * Modified 1985-04-12, BIM: ioi delete device at unassign time * that was added at assign time due to use of rcp_priv_ to assign * a deleted device. */ %page; /* ARGUMENT DATA */ dcl a_operation bit (36) aligned; /* Specifies the type of operation being requested */ dcl a_volume_offset bit (18) aligned; /* Offset to volume information */ dcl a_device_offset bit (18) aligned; /* Offset to device information */ dcl a_device_name char (*); /* Drive name */ dcl a_error_count fixed bin (17); /* Error count for device attachments */ dcl a_process_id bit (36) aligned; /* Process id for which this operation is being performed */ dcl a_ecode fixed bin (35); /* Error code */ dcl a_add_sw bit (1) aligned; /* For $ss_io_interchange, "1"b = add to RCP */ dcl a_del_sw bit (1) aligned; /* For $ss_io_interchange, "1"b to 'add' in deleted state */ /* AUTOMATIC DATA */ dcl access bit (3) aligned; /* User's access to resource. */ dcl effmode bit (3); dcl accessible_flag bit (1) aligned; /* ON => process has access to a segment. */ dcl add_sw bit (1) aligned; /* For $ss_io_interchange, "1"b => add to RCP. */ dcl available_flag bit (1) aligned; /* ON => device is available. */ dcl console_free bit (1) aligned; /* flag indicating that the ocdcm_ willlet us have the console. */ dcl del_sw bit (1) aligned; /* For $ss_io_interchange, "1"b to 'add' in deleted state */ dcl full bit (1) aligned; /* "1"b if available_list array is full */ dcl match_flag bit (1) aligned; /* ON => device matches. */ dcl system_flag bit (1) aligned; /* ON => process is a system process. */ dcl volume_flag bit (1) aligned; /* ON => we have assigned a volume. */ dcl temp_mode bit (3); dcl dev_rcse_off bit (18) aligned; /* Offset of RCS device entry. */ dcl device_off bit (18) aligned; /* Offset of RCPD device entry. */ dcl vol_rcse_off bit (18) aligned; /* Offset of RCS volume entry. */ dcl volume_off bit (18) aligned; /* Offset of RCPD volume entry. */ dcl process_id bit (36) aligned; /* Process ID. */ dcl operation bit (36) aligned; /* Operation. */ dcl base_op bit (36) aligned; /* the basic operation */ dcl device_name char (32); /* Device name. */ dcl volume_name char (32); /* Volume name. */ dcl who_am_i char (32); /* Identifies this program. */ dcl dtypex fixed bin; /* Device type index. */ dcl ecode fixed bin (35); /* error_table_ code. */ dcl error_count fixed bin (17); /* error count for device attachments */ dcl num_assigned fixed bin; /* Number of devices assigned to a process. */ dcl num_avail_nres fixed bin; /* Number of non reservable devices available. */ dcl num_available fixed bin; /* Number of devices available for assignment. */ dcl num_free_res fixed bin; /* Number of reservable devices currently free. */ dcl num_reserved fixed bin; /* Number of devices reserved to system processes. */ dcl num_resvd fixed bin; /* Number of device reserved for this process. */ dcl one_was_accessible bit (1) aligned; /* at least one was accessible */ dcl one_was_appropriate bit (1) aligned; /* at least one was appropriate (but perhaps inaccessible or unavailable) */ /**** there is no one_was_available, since available is conditional on the other two PLUS resource limits. */ dcl time_assigned fixed bin (71); /* Used to compute metering data. */ dcl record_ptr ptr; /* Pointer to the registry resource record. */ dcl reg_iocb_ptr ptr; /* IOCB for the registry. */ dcl save_device_ptr ptr; /* Used to save pointer to assigned device. */ dcl trans_iocb_ptr ptr; /* IOCB for the transaction control file. */ dcl available_list (MAX_AVAILABLE) ptr; /* List of appropriate, accessible, and available devices. */ dcl 1 req_info like requestor_info automatic; /* Requestor information for determining RCP access */ dcl 1 res_info like resource_info automatic; /* Resource information for determining RCP access */ /* CONSTANTS */ dcl MAX_AVAILABLE fixed bin (17) static internal options (constant) init (128); dcl DEFAULT_REGISTRY_DIR char (64) static internal options (constant) init (">sc1>rcp"); /* CONDITIONS */ dcl cleanup condition; /* Used to establish a cleanup handler. */ /* BUILTIN FUNCTIONS */ dcl (addr, clock, divide, hbound, length, null, ptr, rel, string, substr, unspec) builtin; /* ERROR CODES */ dcl error_table_$no_key fixed bin (35) ext static; dcl error_table_$resource_unassigned fixed bin (35) ext; dcl error_table_$device_deletion_deferred fixed bin (35) ext; dcl error_table_$device_limit_exceeded fixed bin (35) ext; dcl error_table_$invalid_state fixed bin (35) ext; dcl error_table_$io_still_assnd fixed bin (35) ext; dcl error_table_$notalloc fixed bin (35) ext; dcl error_table_$resource_bad_access fixed bin (35) ext; dcl error_table_$resource_unavailable fixed bin (35) ext; dcl error_table_$resource_unknown fixed bin (35) ext; dcl error_table_$no_appropriate_device fixed bin (35) ext; dcl error_table_$unsupported_operation fixed bin (35) ext; dcl access_operations_$rcp_assign_read bit (36) aligned ext static; dcl access_operations_$rcp_assign_write bit (36) aligned ext static; dcl access_operations_$rcp_add_device bit (36) aligned ext static; dcl access_operations_$rcp_delete_device bit (36) aligned ext static; dcl access_operations_$rcp_error_count bit (36) aligned ext static; dcl access_operations_$rcp_account bit (36) aligned ext static; dcl access_operations_$rcp_unassign bit (36) aligned ext static; /* EXTERNAL ENTRIES CALLED */ dcl admin_gate_$console_free entry (char (4) aligned, bit (1) aligned); dcl admin_gate_$ocdcm_reconfigure entry (char (4) aligned, fixed bin, fixed bin (35)); dcl admin_gate_$ioi_add_device entry (char (*), fixed bin (35)); dcl admin_gate_$ioi_delete_device entry (char (*), fixed bin (35)); dcl admin_gate_$syserr entry options (variable); dcl get_group_id_ entry () returns (char (32)); dcl get_process_id_ entry returns (bit (36)); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl rcp_access_kernel_ entry (bit (36) aligned, ptr, ptr, bit (3), fixed bin (35)); dcl rcp_lock_$lock entry (ptr, fixed bin (35)); dcl rcp_lock_$unlock entry (ptr); dcl rcp_match_$match entry (ptr, ptr) returns (bit (1)); dcl rcp_match_$select entry (ptr, fixed bin, char (*) aligned, ptr); dcl rcp_match_user_name_ entry (char (32) aligned, char (32) aligned) returns (bit (1)); dcl rcp_pointers_$com_seg entry returns (ptr); dcl rcp_pointers_$data entry returns (ptr); dcl rcp_tape_survey_ entry (char (*), fixed bin, bit (1) aligned, bit (1) aligned, (4) fixed bin (35), fixed bin (35)); dcl rcp_unload_$unload_device entry (ptr, bit (1)); dcl get_authorization_ entry () returns (bit (72) aligned); dcl hcs_$get_authorization entry (bit (72) aligned, bit (72) aligned); dcl rcp_get_scratch_volume_ entry (ptr, char (*), bit (3) aligned, fixed bin (35)); dcl rcp_cancel_resource_ entry (char (*), char (*), fixed bin (35)); %page; /* This routine has two entry points. rcp_control_$ss_io_interchange is called by mdx.pl1. The main entry point will determine what functions to perform from the operation argument. RCPD will be locked while it is being manipulated. */ /**** NOTES device.unassign_state, device.delete, device.priv: These three variables overlap. device.unassign_state should always be the correct value for device.state after the completion of unassign. However, if device.delete is on, then the device must be marked DELETED at unassign. However, unassign_state is not changed when a deletion is requested for an assigned or reserved device, so that if the device is added back before it is unassigned things will work correctly. If device.priv is on, then unassign_state = DELETED implies that the device was deleted to begin with and assigned with rcp_priv_, rather than deleted by the operator during the assignment. The only implication of this is that unloads are not attempted at unassignment. */ operation = a_operation; /* Copy args */ base_op = basic_operation (operation); ops_ptr = addr (addr (operation) -> encoded_access_op.detailed_operation); error_count = a_error_count; who_am_i = "rcp_control_"; rcpd_ptr = rcp_pointers_$data (); /* Set up pointers. */ rcs_ptr = rcp_pointers_$com_seg (); reg_iocb_ptr, trans_iocb_ptr = null (); ecode = 0; on cleanup begin; call cleanup_kernel_call ((0)); call UNLOCK; /* If trouble unlock rcp_data. */ end; call rcp_lock_$lock (addr (rcpd.lock_info), ecode); if ecode ^= 0 then do; a_ecode = ecode; return; end; if (base_op = access_operations_$rcp_assign_read) | (base_op = access_operations_$rcp_assign_write) then call ASSIGN; else if base_op = access_operations_$rcp_error_count then call ERROR_COUNT; else if base_op = access_operations_$rcp_unassign then call UNASSIGN; else if base_op = access_operations_$rcp_delete_device then call DELETE_DEVICE; else if base_op = access_operations_$rcp_add_device then call ADD_DEVICE; else if base_op = access_operations_$rcp_account then call ACCOUNT_ATTACH; else ecode = error_table_$unsupported_operation; call UNLOCK; a_ecode = ecode; return; %page; UNLOCK: procedure; /* Unlock RCPD. */ call rcp_lock_$unlock (addr (rcpd.lock_info)); end UNLOCK; %page; ASSIGN: procedure; /* This procedure is called to perform an assignment of a device and/or volume. The offsets provided as input determine what is to be assigned. These offsets reference RCS entries. We will communicate the results of the assignment(s) by filling in these entries. */ vol_rcse_off = a_volume_offset; /* Copy args */ dev_rcse_off = a_device_offset; volume_flag = "0"b; /* Assume no volume assigned. */ if vol_rcse_off ^= "0"b /* Do we have to assign a volume? */ then do; /* Yes. */ call ASSIGN_VOLUME; /* Assign one volume to this process. */ rcse.ecode = ecode; /* Tell results of volume assignment. */ if ecode ^= 0 /* Any problems with volume? */ then return; /* Yes, abort all assignments. */ end; if dev_rcse_off ^= "0"b /* Do we have a device to assign? */ then do; /* Yes. */ base_op = access_operations_$rcp_assign_write; /* Always assign a device for writing. */ call ASSIGN_DEVICE; /* Assign an appropriate device. */ rcse.ecode = ecode; /* Tell results of device assignment. */ end; if ^volume_flag /* Device assignment done. Was there a volume? */ then return; /* No, nothing else to do. */ if ecode ^= 0 /* Was there an error assigning device? */ then do; /* Yes. */ call UNASSIGN_VOLUME (); return; end; if dev_rcse_off = "0"b /* Was a device just assigned? */ then do; /* No, put volume on previously assigned device. */ rcse_ptr = ptr (rcs_ptr, vol_rcse_off); /* Attachment RCS entry. */ rcse_ptr = ptr (rcs_ptr, rcse.rcse_off); /* Assignment RCS entry. */ device_ptr = ptr (rcpd_ptr, rcse.device_off); dtypex = device.dtypex; /* Get device type of this device. */ dtype_ptr = addr (rcpd.dtype (dtypex)); end; if device.volume_name = volume_name /* Is volume already on this device? */ then do; /* Yes, nothing more to do. */ rcse.volume_name = volume_name; /* ASSIGNment RCSE */ return; end; if volume_name = "scratch" /* Is this a scratch volume. */ then do; /* Yes, special case. */ device.volume_name = " "; /* Scratch volumes not remembered. */ return; end; /* The assigned volume is being put on a new device. We must search through * all of the devices of this type to see if it is currently on any other * device. If it is we will remove it from that device. */ save_device_ptr = device_ptr; /* Save pointer to assigned device. */ device_off = dtype.first_off; /* Get first device of this type. */ do while (device_off ^= "0"b); /* Test all devices of this type. */ device_ptr = ptr (rcpd_ptr, device_off); if device.volume_name = volume_name then do; /* We found the volume on another device. */ device.flags.attached = "0"b; /* Mark it as _n_o_t attached. */ call rcp_unload_$unload_device (device_ptr, "0"b); /* unload the volume */ device.volume_name = ""; /* Forget this occurance. */ goto REMEMBER_DEVICE; /* No need to test any more devices. */ end; device_off = device.next_off; /* Test next device. */ end; REMEMBER_DEVICE: /* Put volume on assigned device. */ save_device_ptr -> device.volume_name = volume_name; end ASSIGN; %page; /* This procedure is called to assign a volume. The assignment of a volume * is independent of the assignment of a device. A list of the currently * assigned volumes is kept in RCPD. */ ASSIGN_VOLUME: procedure; dcl i fixed bin; dcl ignored_code fixed bin (35); rcse_ptr = ptr (rcs_ptr, vol_rcse_off); /* Get pointer to RCS entry that => volume. */ access = "000"b; if rcse.volume_name ^= "scratch" then volume_name = rcse.volume_name; else do; call rcp_get_scratch_volume_ (rcse_ptr, volume_name, access, ecode); if ecode ^= 0 then return; rcse.volume_name = volume_name; end; volume_off = "0"b; /* Initialize volume offset. */ do i = 1 to rcpd.last_volume; /* Search through list of volumes. */ volume_ptr = addr (rcpd.volume (i)); /* Get pointer to volume entry. */ if volume.volume_name = volume_name then do; if (volume.state = FREE) | ((volume.state = RESERVED) & (volume.process_id = rcse.process_id)) then volume_off = rel (volume_ptr); else if volume_name ^= "" then do; ecode = error_table_$resource_unavailable; return; end; end; else if (volume.state = FREE) & (volume.volume_name = "") then /* If this is a free entry in the table ... */ if volume_off = "0"b then /* ... and we don't have a slot to use yet ... */ volume_off = rel (volume_ptr); /* ... then remember this one for later. */ end; if volume_off = "0"b /* Volume not found, room for another? */ then if rcpd.last_volume >= rcpd.tot_volumes then do; /* No room. */ ecode = error_table_$notalloc; return; end; else do; /* Get a new entry. */ rcpd.last_volume = rcpd.last_volume + 1; volume_off = rel (addr (rcpd.volume (rcpd.last_volume))); end; /* Now we must make sure we have access to the volume requested. */ if access = "000"b then do; /* Don't know yet. */ call setup_kernel_call ((VOLUME_TYPE (rcse.dtypex)), rcse.volume_name, ecode); if ecode ^= 0 then return; call rcp_access_kernel_ (operation, addr (req_info), addr (res_info), effmode, ecode); if ecode ^= 0 then if (ecode = error_table_$resource_unknown) & (rcpd.modes.auto_registration) then do; rcse.flags.must_auto_register = "1"b; access = REW_ACCESS; ecode = 0; call cleanup_kernel_call (ignored_code); end; else do; call cleanup_kernel_call (ignored_code); return; end; else do; access = effmode; call cleanup_kernel_call (ignored_code); end; end; /* Assign volume by filling in the free volume entry that we have found. */ volume_ptr = ptr (rcpd_ptr, volume_off); /* Get pointer to assigned volume entry. */ volume.process_id = rcse.process_id; /* Assign volume entry to process. */ volume.vtypex = rcse.dtypex; volume.unassign_state = volume.state; volume.state = ASSIGNED; /* Make it assigned. */ volume.state_time = clock (); volume.volume_name = volume_name; volume.group_id = rcse.group_id; if volume.unassign_state = FREE then do; /* if this was free ... */ volume.reserved_by = ""; /* no reservation */ volume.reservation_id = 0; end; volume.current_authorization = get_authorization_ (); /* Save this guy's authorization. */ volume_name = rcse.volume_name; /* Leave the real volume name here. */ volume_flag = "1"b; /* ON => a volume has been assigned. */ rcse.state = 2; /* State => volume now assigned. */ rcse.volume_off = volume_off; /* Save offset of volume entry. */ end ASSIGN_VOLUME; %page; ASSIGN_DEVICE: procedure; dcl ignored_code fixed bin (35); dcl (i, j) fixed bin; /* This procedure is called to assign a device. The following tests * are made before assigning a device: * 1. There must be an appropriate device. * 2. The requesting process must have access to the device. * 3. There must be an appropriate and accessible device that is available. * 4. The device limits must not be exceeded. * 5. If the assignment is based on a volume then we will try to * find a device that has the specified volume already mounted. * 6. Otherwise we take the device that has been unassigned the longest. */ rcse_ptr = ptr (rcs_ptr, dev_rcse_off); /* Get pointer to RCS entry for device. */ dtypex = rcse.dtypex; /* Get device type index. */ dtype_ptr = addr (rcpd.dtype (dtypex)); /* Get pointer to device type entry. */ system_flag = rcse.flags.system; /* Get system flag. */ if rcse.group_id = "Initializer.SysDaemon.z" & rcse.caller_level = 1 then system_flag = "1"b; num_assigned, /* Initialize counters. */ num_free_res, num_reserved, num_resvd = 0; one_was_accessible, one_was_appropriate = "0"b; num_available = 0; device_off = dtype.first_off; /* Start with first type of device. */ full = "0"b; /* available_list array is empty. */ do while ((device_off ^= "0"b) & (^full)); /* Test all devices of this type until the available_list array is full. */ device_ptr = ptr (rcpd_ptr, device_off); /* Get pointer to RCPD device entry. */ call TEST_DEVICE; /* Test device to see if it can be assigned. */ device_off = device.next_off; /* Get offset of next device of this type. */ end; if num_available = 0 /* none to return */ then do; /* select the error code */ if ^one_was_appropriate then ecode = error_table_$no_appropriate_device; else if ^one_was_accessible then ecode = error_table_$resource_bad_access; else ecode = error_table_$resource_unavailable; /* there was one that we would have access too, but we couldn't have it */ return; end; call CHECK_LIMITS; /* Check device limits. */ if ecode ^= 0 then return; /* Find the best device that matched. */ if num_resvd > 0 then do; j = 0; do i = 1 to num_available; if available_list (i) -> device.state = RESERVED then do; j = j + 1; if i ^= j then available_list (j) = available_list (i); end; end; num_available = j; end; call rcp_match_$select (addr (available_list), num_available, rcse.volume_name, device_ptr); device_off = rel (device_ptr); /* Save offset of device entry. */ /* When searching for any device, auditing is done after selection. */ /* Call the kernel to perform the auditing since it has all the */ /* information needed to do it. */ if (^rcse.flags.device & rcpd.modes.resource_mgmt_enabled) then do; detailed_operation.search = "0"b; call setup_kernel_call ((DEVICE_TYPE (device.dtypex)), device.device_name, ecode); temp_mode = ""b; call rcp_access_kernel_ (operation, addr (req_info), addr (res_info), temp_mode, ecode); call cleanup_kernel_call (ecode); /* the above call was just to provoke an audit, so we can discard the error code. */ end; rcse.flags.volume = "0"b; if device.volume_name ^= "" then do; /* then let him know it. */ if rcpd.modes.resource_mgmt_enabled then do; call setup_kernel_call ((VOLUME_TYPE (device.dtypex)), device.volume_name, ecode); if ecode = 0 then do; detailed_operation.search = "1"b; /* Don't audit this since a denial is unimportant. */ call rcp_access_kernel_ (operation, addr (req_info), addr (res_info), effmode, ecode); detailed_operation.search = "0"b; if ecode = 0 then do; rcse.flags.volume = "1"b; rcse.volume_name = device.volume_name; end; else ecode = 0; end; else ecode = 0; /* no such volume? ignore the problem, and just hand over the requested device. ycch. */ call cleanup_kernel_call (ecode); end; else if rcp_match_user_name_ (rcse.group_id, device.group_id) then do; rcse.flags.volume = "1"b; rcse.volume_name = device.volume_name; end; end; if ^rcse.flags.volume then rcse.volume_name = ""; rcse.flags.preload_allowed = ^rcpd.modes.unload_on_detach; rcse.flags.not_removable_media = device.flags.not_removable_media; device.process_id = rcse.process_id; /* Save info about assignment. */ device.group_id = rcse.group_id; if device.flags.reservable /* Can device be reserved? */ then device.flags.reserved = system_flag; else device.flags.reserved = "0"b; if device.state = DELETED /* Are we assigning a deleted device? */ then do; /* Yes. */ call admin_gate_$ioi_add_device ((device.device_name), ignored_code); device.flags.delete, /* Remember to delete when unassigned. */ device.flags.priv = "1"b; /* Special assignment for privileged attachment. */ end; device.state_time = clock (); /* Note when assigned. */ device.unassign_state = device.state; /* redundant for DELETED, since flags.delete forces unassignment to delete */ /* the curious result of this is that if the operator */ /* during the .priv attachment it will fail. */ device.current_authorization = get_authorization_ (); /* Save this guy's authorization. */ device.state = ASSIGNED; /* Device is now assigned. */ if device.unassign_state ^= RESERVED then /* Accounting for reserved devices is done at reservation time. */ call ACCOUNT_WAKEUP (device_ptr, RCP_ACCTMSG_assign); rcse.state = 2; /* Tell requesting process assignment complete. */ rcse.device_off = device_off; /* Save offset of rcp_data entry. */ rcse.device_name = device.device_name; /* Return info about assigned device. */ rcse.model = device.model; do i = 1 to device.num_qualifiers; rcse.qualifiers (i) = device.qualifiers (i); end; rcse.flags.system = system_flag; /* Note whether assigned as a system process. */ rcse.flags.fips = device.flags.fips; /* pass along fips flag */ rcse.flags.no_protect = device.flags.no_protect; /* pass along no_protect flag */ rcse.flags.opr_int_available = device.flags.opr_int_available; /* pass along opr_int_available flag */ /* Note this assignment in the syserr log. */ call admin_gate_$syserr (LOG, "RCP: Assigned ^a to ^a", device.device_name, device.group_id); end ASSIGN_DEVICE; %page; TEST_DEVICE: procedure; /* This procedure is called to test a device. We will see if it is * appropriate, accessible, and available. If it is all three we * will add it to a list of such devices. */ /* Test free devices and deleted devices */ if (device.state = FREE) | (device.state = DELETED & rcse.flags.priv) then do; if device.dtypex = CONSOLE_DTYPEX then call admin_gate_$console_free (substr (device.device_name, 1, 4), console_free); /**** The following test is obscure. Note the following: if a console is RCP-DELETED, then it is in ocdcm_ unavailable. However, ocdcm_ does nothing different for an UNAVAILABLE device from an INOP or an I/O device. Therefore, checking the console_free flag suffices for consoles. */ if (device.dtypex = CONSOLE_DTYPEX & console_free) | (device.dtypex ^= CONSOLE_DTYPEX) then do; if device.flags.reservable then /* Can this device be reserved? */ num_free_res = num_free_res + 1; /* Yes, count free reservable devices. */ else ; available_flag = "1"b; /* Device is available. */ end; end; /* Test assigned devices */ else if (device.state = ASSIGNED) then do; if device.process_id = rcse.process_id then /* Assigned to requesting process? */ num_assigned = num_assigned + 1; /* Yes, count number assigned to this process. */ if device.flags.reserved then /* Is device reserved to a system process? */ num_reserved = num_reserved + 1; /* Yes, count these too. */ available_flag = "0"b; /* This device is not available. */ end; /* Test reserved devices */ else if (device.state = RESERVED) then if device.process_id = rcse.process_id then available_flag = "1"b; else available_flag = "0"b; /* Must be a storage system device - forget it */ else return; /* Make appropriate, accessible, available test */ match_flag = rcp_match_$match (rcse_ptr, device_ptr); if match_flag then /* Did it match, i.e., is it appropriate? */ one_was_appropriate = "1"b; else return; /* No this device is not appropriate. */ operation = access_operations_$rcp_assign_write; if ^rcse.flags.device then detailed_operation.search = "1"b; call setup_kernel_call ((DEVICE_TYPE (device.dtypex)), device.device_name, ecode); detailed_operation.priv_gate_call = ""b; /* Device assignment is not a privileged */ /* gate call, even through rcp_priv_ */ if ecode = 0 then call rcp_access_kernel_ (operation, addr (req_info), addr (res_info), effmode, ecode); if ecode = 0 then accessible_flag = "1"b; else do; accessible_flag = "0"b; ecode = 0; end; call cleanup_kernel_call (ecode); /* don't zero code until it has been tested */ if ^accessible_flag then return; one_was_accessible = "1"b; if ^available_flag then return; num_available = num_available + 1; if num_available = MAX_AVAILABLE then full = "1"b; /* available list is now full */ available_list (num_available) = device_ptr; /* Put this device in the available list. */ if device.state = RESERVED then /* a reserved device */ num_resvd = num_resvd + 1; return; /* test passes here */ end TEST_DEVICE; %page; CHECK_LIMITS: procedure; dcl i fixed bin; /* This procedure is called to check the limits imposed upon non * system processes. These limits are: * 1. Only a certain number of devices of any one type may be assigned * to a process at at one time. * 2. A certain number of reservable devices of this type * must be free or in use by system processes. */ if system_flag /* Is this a system process? */ then return; /* Yes, no need to test limits. */ if num_resvd ^= 0 then return; /* can always use reserved device */ if num_assigned >= dtype.max_concurrent /* Maximum already assigned to this process? */ then do; /* Yes. */ ecode = error_table_$device_limit_exceeded; return; end; if num_reserved >= dtype.num_reserved /* Already using the quota of system drives? */ then return; /* Yes, don't bother the user */ if num_free_res > (dtype.num_reserved - num_reserved) then return; /* There are enough free reservable devices. */ num_avail_nres = 0; /* Count number that will be available. *. */ do i = 1 to num_available; /* Remove reservable devices from selection list. */ device_ptr = available_list (i); if ^device.flags.reservable /* If non reservable keep in list. */ then do; available_list (num_avail_nres) = device_ptr; num_avail_nres = num_avail_nres + 1; end; end; num_available = num_avail_nres; /* Now only non reservable devices are available. */ if num_available = 0 /* Are there any available devices left? */ then do; /* No, only reservable devices were available. */ ecode = error_table_$resource_unavailable; return; end; end CHECK_LIMITS; %page; ERROR_COUNT: procedure; /* This procedure is called to update the error count for a device. */ dev_rcse_off = a_device_offset; device_ptr = ptr (rcpd_ptr, dev_rcse_off); if device.state ^= ASSIGNED then /* Is device assigned? */ ecode = error_table_$resource_unassigned; /* No, ignore this call. */ if device.process_id ^= get_process_id_ () then ecode = error_table_$resource_unassigned; /* Not assigned to this process. */ if ecode = 0 then do; device.error_count = device.error_count + error_count; a_error_count = device.error_count; end; return; end ERROR_COUNT; %page; UNASSIGN: procedure; /* This procedure is called to unassign a device and/or volume. * The volume and device offsets reference RCPD volume and * and device entries. The resources associated with these * entries will be unassigned. Before unassigning any * resource we will verify that it is actually assigned to the * requesting process. We will note this unassignment in the syserr log. */ if detailed_operation.force then do; call FORCE_UNASSIGN; return; end; if detailed_operation.process then do; call PROC_UNASSIGN; return; end; volume_off = a_volume_offset; device_off = a_device_offset; process_id = get_process_id_ (); /* Get process ID of calling process. */ if volume_off ^= "0"b /* Is there a volume to unassign? */ then do; /* Yes. */ volume_ptr = ptr (rcpd_ptr, volume_off); if volume.process_id = process_id then /* Volume is assigned to this process. */ call UNASSIGN_VOLUME (); end; if device_off ^= "0"b then do; /* Is there a device to unassign? */ device_ptr = ptr (rcpd_ptr, device_off); /* Yes, get a pointer to its device entry. */ if device.process_id = process_id then do; /* Is it actually assigned to this process? */ device.error_count = device.error_count + error_count; call UNASSIGN_DEVICE; call admin_gate_$syserr (LOG, "RCP: Unassigned ^a from ^a", device.device_name, device.group_id); a_error_count = error_count; end; end; end UNASSIGN; %page; FORCE_UNASSIGN: procedure; dcl i fixed bin; /* This procedure is called to force the unassignment of a device. * The device does not have to be assigned by the requesting process. * If there is a volume mounted on this device we will unassign it. */ device_name = a_device_name; call FIND_DEVICE; /* Search through all devices for this one. */ if device_off = "0"b then do; /* Find it? */ ecode = error_table_$resource_unknown; /* No */ return; end; if device.state = ASSIGNED then do; /* Is device assigned? */ call UNASSIGN_DEVICE; /* Just forcedly unassign it. */ call admin_gate_$syserr (ANNOUNCE, "RCP: Force Unassigned ^a from ^a", device_name, device.group_id); end; if device.volume_name = " " /* Is there a volume on this device? */ then return; /* No, we are all done. */ do i = 1 to rcpd.last_volume; /* Yes, find this volume. */ volume_ptr = addr (rcpd.volume (i)); /* Get pointer to next volume entry. */ if volume.volume_name = device.volume_name then do; /* We found this volume. */ call UNASSIGN_VOLUME (); return; end; end; end FORCE_UNASSIGN; %page; PROC_UNASSIGN: procedure; dcl i fixed bin; /* This procedure is called to forcedly unassign all devices and volumes * currently assigned to the process whose process ID has been provided * by the caller of this routine. */ process_id = a_process_id; do i = 1 to rcpd.last_volume; /* Look at all volume entries. */ volume_ptr = addr (rcpd.volume (i)); /* Get pointer to volume entry. */ if volume.process_id = process_id /* Does volume belong to this process? */ then do; /* Yes, unassign it. */ volume.unassign_state = FREE; call UNASSIGN_VOLUME (); end; end; do i = 1 to rcpd.tot_devices; /* Look at all devices. */ device_ptr = addr (rcpd.device (i)); if device.process_id = process_id /* Does device belong to this process? */ then do; /* Yes, forcedly unassign. */ device.unassign_state = FREE; call UNASSIGN_DEVICE; call admin_gate_$syserr (LOG, "RCP: Force Unassigned ^a from ^a", device.device_name, device.group_id) ; end; end; end PROC_UNASSIGN; %page; DELETE_DEVICE: procedure; dcl local_code fixed bin (35); dcl local_effmode bit (3); /* This procedure is called to put a device in the deleted state. * This means that the device cannot be assigned to any process. * If the device is currently assigned will will not delete it now. * We will remember to delete it when it is unassigned. */ device_name = a_device_name; /* Get name of device to delete. */ call FIND_DEVICE; /* Find the device with this name. */ if device_off = "0"b then do; /* Did we find it? */ ecode = error_table_$resource_unknown; goto DELETE_RETURN; end; if device.state = STORAGE_SYSTEM then goto DELETE_RETURN; /* Should not be here, but check for ss drives */ if device.state = ASSIGNED | device.state = RESERVED /* Is device still assigned? */ then do; /* Yes, we won't delete it now. */ device.flags.delete = "1"b; /* Remember to delete it when unassigned. */ ecode = error_table_$device_deletion_deferred; goto DELETE_RETURN; end; if device.volume_name ^= "" & device.dtypex = 1 then call rcp_unload_$unload_device (device_ptr, "1"b); /* unload volume and forget it was here */ call admin_gate_$ioi_delete_device (device_name, ecode); if ecode ^= 0 then goto DELETE_RETURN; device.volume_name = " "; /* Forget any volume on the deleted device. */ device.process_id = "0"b; /* Make sure it doesn't belong to any process. */ device.state = DELETED; /* Just change its state. */ device.state_time = clock (); /* And remember when. */ if device.dtypex = CONSOLE_DTYPEX then /* must inform console DIM of deletion... */ call admin_gate_$ocdcm_reconfigure (substr (device_name, 1, 4), MAKE_UNAVAILABLE, ecode); call admin_gate_$syserr (ANNOUNCE, "RCP: Deleted device ^a", device_name); DELETE_RETURN: /* Let's perform auditing. Call setup_kernel_call to set up */ /* the resource_info and requestor_info structures although we */ /* really don't call the kernel for this operation, it has all the */ /* information so let it do the auditing for us. */ local_code = 0; call setup_kernel_call ((DEVICE_TYPE (device.dtypex)), device.device_name, local_code); if local_code = 0 then do; /* if we didn't find the resource at all ... */ detailed_operation.priv_gate_call = "1"b; call rcp_access_kernel_ (operation, addr (req_info), addr (res_info), local_effmode, (ecode)); end; call cleanup_kernel_call (local_code); if ecode = 0 then ecode = local_code; return; end DELETE_DEVICE; ADD_DEVICE: procedure; /* This procedure is called to take a device out of the deleted state. * This will only be done if the device is already in the deleted state. */ dcl local_code fixed bin (35); dcl local_effmode bit (3); dcl operational bit (1) aligned; dcl 1 tape_name unaligned, 2 subsystem char (4), 2 bar char (1), 2 drive pic "99"; device_name = a_device_name; /* Get name of device to add. */ call FIND_DEVICE; /* Find the device with this name. */ if device_off = "0"b /* Did we find it? */ then goto ADD_RETURN; device.flags.delete = "0"b; /* Make sure no delete is pending. */ if device.state ^= DELETED /* Is device in the deleted state? */ then goto ADD_RETURN; /* No, leave it alone. */ if (device.dtypex = TAPE_DRIVE_DTYPEX) & (device.qualifiers (1) = 0) then do; /* this is a tape drive deleted during initialization */ string (tape_name) = substr (device_name, 1, length (string (tape_name))); call rcp_tape_survey_ (tape_name.subsystem, (tape_name.drive), (device.flags.fips), operational, device.qualifiers, ecode); if ^operational then do; if ecode = 0 then call admin_gate_$syserr (ANNOUNCE, "RCP: ^a is not operational and will not be added.", device_name); goto ADD_RETURN; end; end; call admin_gate_$ioi_add_device (device_name, ecode); if ecode ^= 0 then goto ADD_RETURN; device.state = FREE; /* Put it into the free state. */ device.unassign_state = FREE; /* And keep it there. */ device.state_time = clock (); /* Save time device added. */ if device.dtypex = CONSOLE_DTYPEX then /* must inform console DIM of deletion... */ call admin_gate_$ocdcm_reconfigure (substr (device_name, 1, 4), MAKE_IO_DEVICE, ecode); call admin_gate_$syserr (ANNOUNCE, "RCP: Added device ^a", device_name); ADD_RETURN: /* Let's perform auditing. Call setup_kernel_call to set up */ /* the resource_info and requestor_info structures although we */ /* really don't call the kernel for this operation, it has all */ /* information to do the auditing so let it do it. */ local_code = 0; call setup_kernel_call ((DEVICE_TYPE (device.dtypex)), device.device_name, local_code); if local_code = 0 then do; /* if we didn't find the resource at all ... */ detailed_operation.priv_gate_call = "1"b; call rcp_access_kernel_ (operation, addr (req_info), addr (res_info), local_effmode, (ecode)); end; call cleanup_kernel_call (local_code); if ecode = 0 then ecode = local_code; return; end ADD_DEVICE; %page; ACCOUNT_ATTACH: procedure; /* This procedure is called when an attachment is completed. The rcp_control_ * wakes the accounting process with a datum about the attachment. */ device_off = a_device_offset; device_ptr = ptr (rcpd_ptr, device_off); call ACCOUNT_WAKEUP (device_ptr, RCP_ACCTMSG_attach); return; end ACCOUNT_ATTACH; %page; UNASSIGN_DEVICE: procedure; dcl ignored_code fixed bin (35); /* Ignored error code. */ dcl i fixed bin; dcl old_state fixed bin; /* This procedure is called to put a device in the state it was in * at assignment time. * It will also compute the metering statistics kept for each device. * If the device was supposed to be deleted but was not because it was still * assigned we will delete it now. */ time_assigned = device.state_time; /* Save time assigned. */ old_state = device.state; if device.flags.delete /* Are we waiting to delete this device? */ & (device.unassign_state = FREE | device.unassign_state = DELETED) /* and it won't still be reserved after this unassignment */ then do; /* Yes, delete it now. */ if ^device.flags.priv & device.volume_name ^= "" & device.dtypex <= 2 then do; /* Must unload this loaded device. */ device.state = FREE; /* do this now to permit unload */ call rcp_unload_$unload_device (device_ptr, "1"b); /* unload volume and forget it was here */ end; call admin_gate_$ioi_delete_device ((device.device_name), ignored_code); device.state = DELETED; /* Now it is deleted. */ device.volume_name = ""; if ^device.flags.priv /* If not assigned while deleted say it is deleted now. */ then call admin_gate_$syserr (ANNOUNCE, "RCP: Deleted device ^a", device.device_name); device.flags.delete, /* Turn off these flags. */ device.flags.priv = "0"b; end; else device.state = device.unassign_state; /* No, unassign the device. */ device.unassign_state = FREE; if device.state ^= RESERVED then do; /* Accounting for reserved devices is done at cancel time. */ /* the only other possibilities are DELETED and FREE */ call ACCOUNT_WAKEUP (device_ptr, RCP_ACCTMSG_unassign); /* go send wakeup before clearing process_id */ device.process_id = "0"b; /* No longer assigned to this process. */ device.reservation_id = 0; device.reserved_by = ""; end; device.state_time = clock (); /* Time device made free. */ device.num_assigns = device.num_assigns + 1; device.flags.mounting = "0"b; /* Turn off mount timer for this device. */ device.flags.attached = "0"b; time_assigned = device.state_time - time_assigned; device.tot_assign_time = device.tot_assign_time + time_assigned; time_assigned = divide (time_assigned, 1000000, 71, 0); dtype_ptr = addr (rcpd.dtype (device.dtypex)); do i = 1 to hbound (dtype.histo_times, 1); /* Find histogram slot. */ if time_assigned < dtype.histo_times (i) then do; /* We found the right slot. */ device.histogram (i) = device.histogram (i) + 1; return; end; end; /* Falling through loop => use last slot. */ device.histogram (hbound (device.histogram, 1)) = device.histogram (hbound (device.histogram, 1)) + 1; end UNASSIGN_DEVICE; %page; UNASSIGN_VOLUME: proc (); dcl ignored_code fixed bin (35); /* Ignored error code. */ dcl old_state fixed bin (35); /* This procedure is called to put a volume in the free or reserved state. The choice is made based on the volume's state at the time of the last assignment. */ volume.state_time = clock (); /* record the time */ old_state = volume.state; volume.state = volume.unassign_state; /* and return the volume to the proper state */ volume.unassign_state = FREE; /* reset the unassign state */ if volume.state = FREE then do; /* if we are freeing it ... */ volume.process_id = "0"b; /* no process owns it now */ volume.reserved_by = ""; volume.reservation_id = 0; if old_state = RESERVED then call rcp_cancel_resource_ (VOLUME_TYPE (volume.vtypex), (volume.volume_name), ignored_code); /* Tell Resource Management that this volume has been turned loose. */ if rcpd.unload_on_detach then do; /* all done */ volume.volume_name = ""; /* no need to remember the volume_name */ volume.group_id = ""; end; end; return; end UNASSIGN_VOLUME; %page; FIND_DEVICE: procedure; dcl i fixed bin; /* This procedure is called to find the device entry of the device with * the specified name. We will search by device type since tapes and * disks are the most active types. */ do i = 1 to rcpd.tot_dtypes; /* Look at each device type. */ dtype_ptr = addr (rcpd.dtype (i)); /* Get pointer to device type entry. */ device_off = dtype.first_off; /* Start with first device type. */ do while (device_off ^= "0"b); /* Look at each device of this type. */ device_ptr = ptr (rcpd_ptr, device_off); if device.device_name = device_name then return; /* This is the device. Look no further. */ device_off = device.next_off; end; end; device_off = "0"b; /* Let caller know we didn't find device. */ end FIND_DEVICE; %page; ACCOUNT_WAKEUP: procedure (a_devptr, a_action); /* This procedure is called to format an accounting message, and send it to the * accounting process. If the accounting event channel has not been set up, no message is sent. */ dcl a_devptr ptr; /* Pointer to rcp_data entry */ dcl a_action fixed bin; /* Accounting action */ dcl wakeup_buf fixed bin (71); dcl 1 auto_rcpamsg like rcp_account_msg aligned; unspec (auto_rcpamsg) = "0"b; auto_rcpamsg.device_user_procid = a_devptr -> device.process_id; auto_rcpamsg.rcp_data_relp = rel (a_devptr); auto_rcpamsg.devtype = a_devptr -> device.dtypex; auto_rcpamsg.action = a_action; unspec (wakeup_buf) = unspec (auto_rcpamsg); if rcpd.accounting_chan ^= 0 then call hcs_$wakeup (rcpd.accounting_pid, rcpd.accounting_chan, wakeup_buf, (0)); end ACCOUNT_WAKEUP; %page; ss_io_interchange: entry (a_device_name, a_add_sw, a_del_sw, a_ecode); /* Entry to add and delete disk drives on demand, called from mdx in * the initializer's process, in ring 1. a_add_sw is "1"b if drive is * being given back to RCP. */ device_name = a_device_name; add_sw = a_add_sw; del_sw = a_del_sw; ecode = 0; rcpd_ptr = rcp_pointers_$data (); rcs_ptr = rcp_pointers_$com_seg (); on cleanup begin; call cleanup_kernel_call ((0)); call UNLOCK; /* If trouble unlock rcp_data. */ end; call rcp_lock_$lock (addr (rcpd.lock_info), ecode); if ecode ^= 0 then do; a_ecode = ecode; return; end; call FIND_DEVICE; /* Attempt to find the device */ if device_off = "000000"b3 then ecode = error_table_$resource_unknown; else if dtype.device_type ^= DEVICE_TYPE (DISK_DRIVE_DTYPEX) then ecode = error_table_$invalid_state; if ecode = 0 then if add_sw then if device.state = STORAGE_SYSTEM then if del_sw then device.state = DELETED; /* deleted */ else device.state = FREE; /* free */ else ecode = error_table_$invalid_state; else if device.state = ASSIGNED then ecode = error_table_$io_still_assnd; else device.state = STORAGE_SYSTEM; if ecode = 0 then do; device.state_time = clock (); device.volume_name = " "; device.process_id = "000000000000"b3; call admin_gate_$syserr (ANNOUNCE, "RCP: ^[Acquired ^a from^;Consigned ^a to^] storage system.", add_sw, device_name); end; a_ecode = ecode; call UNLOCK; return; %page; setup_kernel_call: proc (a_resource_type, a_resource_name, a_code); dcl (a_resource_type, a_resource_name) char (*) aligned; dcl a_code fixed bin (35); dcl local_code fixed bin (35); dcl rcprm_registry_util_$grab_transaction_control_file entry (ptr, char (*) aligned, fixed bin (35)); dcl rcprm_registry_util_$grab_registry entry (ptr, char (*) aligned, char (*) aligned, fixed bin (35)); dcl rcprm_registry_util_$find_resource_record entry (ptr, char (*) aligned, ptr, fixed bin (35)); local_code = 0; if rcpd.modes.resource_mgmt_enabled then do; res_info.registry_dir = DEFAULT_REGISTRY_DIR; call rcprm_registry_util_$grab_transaction_control_file (trans_iocb_ptr, res_info.registry_dir, local_code) ; if local_code ^= 0 then goto SETUP_RETURN; call rcprm_registry_util_$grab_registry (reg_iocb_ptr, res_info.registry_dir, a_resource_type, local_code); if local_code ^= 0 then goto SETUP_RETURN; call rcprm_registry_util_$find_resource_record (reg_iocb_ptr, a_resource_name, record_ptr, local_code); if local_code ^= 0 then do; if local_code = error_table_$no_key then local_code = error_table_$resource_unknown; /* well defined reason for this. */ call cleanup_kernel_call ((0)); /* undo the above */ goto SETUP_RETURN; end; res_info.registry_switch_ptr = reg_iocb_ptr; res_info.registry_record_ptr = record_ptr; end; else do; res_info.registry_dir = ""; res_info.registry_switch_ptr, res_info.registry_record_ptr = null (); end; if (basic_operation (operation) = access_operations_$rcp_unassign & (detailed_operation.force | detailed_operation.process)) | (base_op = access_operations_$rcp_delete_device) | (base_op = access_operations_$rcp_add_device) then detailed_operation.priv_gate_call = "1"b; else detailed_operation.priv_gate_call = "0"b; res_info.resource_type = a_resource_type; res_info.resource_name = a_resource_name; if base_op = access_operations_$rcp_add_device | base_op = access_operations_$rcp_delete_device then do; req_info.user_id = get_group_id_ (); req_info.validation_level = 1; end; else do; req_info.user_id = rcse.group_id; req_info.validation_level = rcse.caller_level; end; call hcs_$get_authorization (req_info.current_authorization, ""b); SETUP_RETURN: a_code = local_code; end setup_kernel_call; %page; cleanup_kernel_call: proc (a_code); dcl a_code fixed bin (35); dcl local_code fixed bin (35); dcl rcprm_registry_util_$release_transaction_control_file entry (ptr, fixed bin (35)); dcl rcprm_registry_util_$release_registry entry (ptr, fixed bin (35)); local_code = 0; if reg_iocb_ptr ^= null () then call rcprm_registry_util_$release_registry (reg_iocb_ptr, local_code); if trans_iocb_ptr ^= null () then call rcprm_registry_util_$release_transaction_control_file (trans_iocb_ptr, local_code); a_code = local_code; end cleanup_kernel_call; basic_operation: proc (oper) returns (bit (36) aligned); dcl oper bit (36) aligned; dcl return_arg bit (36) aligned; return_arg = oper; addr (return_arg) -> encoded_access_op.detailed_operation = 0; return (return_arg); end basic_operation; %page; %include access_mode_values; %page; %include rcp_data; %page; %include rcp_com_seg; %page; %include rcp_account_msg; %page; %include rcp_resource_states; %page; %include rcp_requestor_info; %page; %include rcp_resource_info; %page; %include rcp_resource_types; %page; %include access_audit_encoded_op; %include rcp_ops; %page; %include opc_reconfig_options; %page; %include syserr_constants; /* BEGIN MESSAGE DOCUMENTATION Message: RCP: Acquired DEVICE from storage system. S: $info T: $response M: The operator has used the set_drive_usage command to make DRIVE an IO drive. A: $ignore Message: RCP: Added device DEVICE S: $info T: $response M: The operator has added a user I/O disk drive with adddev. A: $ignore Message: RCP: Assigned DEVICE to PERSON.PROJ.T S: $log T: $run M: DEVICE has been assigned to a user process. A: $ignore Message: RCP: Consigned DEVICE to storage system. S: $info T: $response M: The operator has used the set_drive_usage command to make DRIVE a storage system drive. A: $ignore Message: RCP: Deleted device DEVICE S: $info T: $response M: The operator has deleted user I/O disk DRIVE with deldev. A: $ignore Message: RCP: Force Unassigned DEVICE from PERSON.PROJ.T S: $info T: $run M: The user process PERSON.PROJ.T has terminated, and its resources have been freed. Or, the operator may have forced the unassignment of DRIVE. A: $ignore Message: RCP: Unassigned DEVICE from PERSON.PROJ.T S: $log T: $run M: PERSON.PROJ.T has released DRIVE normally. A: $ignore Message: RCP: DEVICE is not operational and has not been added. S: $info T: $response M: An attempt was made to add a non-operational device with adddev. A: Ready the device and add it again. Message: rcp_control_: Error surveying DEVICE. MESSAGE S: $info T: $response M: An error occurred while surveying the device. A: $notify END MESSAGE DOCUMENTATION */ end rcp_control_;  rcp_copy_.pl1 11/11/89 1110.3r 11/11/89 0807.0 155808 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_copy_: procedure; /* This program implements the RCP copy entries. * Created on 12/26/74 by Bill Silver. * Modified on 04/24/78 by Michael R. Jordan to add the attached and loaded bits. * Modified on 12/09/78 by Michael R. Jordan to add support for listing reservations for both the * system and user entries. * Modified 1/85 by Chris Jones to stop using magic numbers. * Modified 3/85 by Maria Pozzo to add auditing for B2. * * This program is called to copy RCP data out of ring 1. * It has the following entry points: * 1. data - rcp_sys_$copy_data - Copys privileged info. * 2. meters - rcp_priv_$copy_meters - Copy meters. * 3. list - rcp_$copy_list - Copy per user info. */ dcl arg_copy_size fixed bin (19); /* (I) Size of caller's copy buffer. */ dcl arg_ecode fixed bin (35); /* (O) error_table_ code. */ dcl arg_to_ptr ptr; /* (I) Pointer to caller's work segment. */ dcl attach_off bit (18); /* Offset of an RLI attachment entry. */ dcl dassign_off bit (18); /* Offset of an RLI assignment entry. */ dcl caller_level fixed bin; /* Caller's validation level. */ dcl copy_size fixed bin (19); /* Size of caller's copy buffer. */ dcl device_off bit (18); /* Device entry offset in RCPD. */ dcl devicex fixed bin; /* Device entry index in RDI. */ dcl ecode fixed bin (35); /* error_table_ code. */ dcl (i, j, k) fixed bin; dcl max_size fixed bin (19); /* Max seg size of caller's work segment. */ dcl meter_time fixed bin (71); /* Time used to base meters on. */ dcl num_attach fixed bin; /* Number of attachment entries. */ dcl num_dassign fixed bin; /* Number of assignment entries. */ dcl num_lv fixed bin; /* Number of lv entries. */ dcl operation bit (36) aligned; /* RCP operation */ dcl operation_ptr ptr; dcl rcse_off bit (18); /* Offset of an RCS entry. */ dcl this_process bit (36); /* Process id for the calling process. */ dcl to_ptr ptr; /* Pointer to caller's work segment. */ dcl total_size fixed bin; /* Total size of an info structure. */ dcl who_am_i char (32); /* Identifies the caller. */ dcl 1 en_access_op like encoded_access_op aligned based (operation_ptr); dcl (addr, fixed, hbound, ptr, rel, size) builtin; dcl cleanup condition; dcl ( error_table_$bad_arg, error_table_$item_too_big, error_table_$unimplemented_version ) fixed bin (35) external; dcl access_operations_$rcp_copy_info bit (36) aligned external; dcl access_audit_r1_$log_obj_ptr entry options (variable); dcl clock_ entry returns (fixed bin (71)); dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl get_process_id_ entry () returns (bit (36)); dcl get_ring_ entry returns (fixed bin (3)); dcl get_group_id_ entry () returns (char (32)); dcl get_process_authorization_ entry () returns (bit (72) aligned); dcl hcs_$get_max_length_seg entry (ptr, fixed bin (19), fixed bin (35)); dcl rcp_rcse_$info entry (bit (18), fixed bin, bit (18), fixed bin); dcl rcp_pointers_$data entry returns (ptr); dcl rcp_pointers_$com_seg entry returns (ptr); dcl rcp_lv_$copy entry (ptr); dcl rcp_lv_$number entry (fixed bin); dcl DEFAULT_REGISTRY_DIR char (64) static internal options (constant) init (">sc1>rcp"); data: entry (arg_to_ptr, arg_copy_size, arg_ecode); /* This entry is called to copy privileged information from rcp_data. * It is used by privileged commands that want to list data about all * of the devices controlled by RCP. */ who_am_i = "rcp_copy_$data"; call SETUP; /* Set up and validate arguments. */ on cleanup call CLEANUP; rcpd_ptr = rcp_pointers_$data (); rdi_ptr = to_ptr; /* Return info in RDI structure. */ if ecode ^= 0 then goto DATA_RETURN; if rdi.head.version_num ^= rdi_version_3 /* Are we using the same version as the caller. */ then do; /* No. */ ecode = error_table_$unimplemented_version; goto DATA_RETURN; end; if size (rdi_header) > copy_size /* Is there room for at least the header? */ then do; /* No, no room for even this. */ ecode = error_table_$item_too_big; goto DATA_RETURN; end; rdi.head.tot_ddtypes = rcpd.tot_dtypes; /* Fill in header info. */ rdi.head.tot_ddevices = rcpd.tot_devices; rdi.head.tot_dvolumes = rcpd.last_volume; total_size = fixed (rel (addr (rdi.end)), 19) - fixed (rel (rdi_ptr), 19); if total_size > copy_size /* Is there room for the whole structure? */ then do; /* No. */ ecode = error_table_$item_too_big; goto DATA_RETURN; end; devicex = 1; /* Initialize device index. */ do i = 1 to rcpd.tot_dtypes; /* Process each device type. */ dtype_ptr = addr (rcpd.dtype (i)); ddtype_ptr = addr (rdi.ddtypes (i)); ddtype.device_type = dtype.device_type; ddtype.max_concurrent = dtype.max_concurrent; ddtype.num_reserved = dtype.num_reserved; ddtype.num_devices = dtype.num_devices; devicex = devicex; ddtype.first_devicex = devicex; /* Save index of first device of this type. */ device_off = dtype.first_off; /* Get RCPD offset of 1st device of type. */ do while (device_off ^= "0"b); /* Process each device of this type. */ device_ptr = ptr (rcpd_ptr, device_off); ddevice_ptr = addr (rdi.ddevices (devicex)); ddevice.device_name = device.device_name; ddevice.volume_name = device.volume_name; ddevice.dtypex = device.dtypex; ddevice.model = device.model; ddevice.num_qualifiers = device.num_qualifiers; do j = 1 to hbound (ddevice.qualifiers, 1); ddevice.qualifiers (j) = device.qualifiers (j); end; ddevice.state_time = device.state_time; ddevice.state = device.state; ddevice.iom_num = device.iom_num; ddevice.chan_num = device.chan_num; ddevice.num_channels = device.num_channels; ddevice.flags.reservable = device.flags.reservable; ddevice.flags.reserved = device.flags.reserved; ddevice.flags.mounting = device.flags.mounting; ddevice.flags.writing = device.flags.writing; ddevice.flags.attached = device.flags.attached; ddevice.flags.loaded = (device.volume_name ^= "") & (^rcpd.modes.unload_on_detach); ddevice.group_id = device.group_id; ddevice.reservation_id = device.reservation_id; ddevice.reserved_by = device.reserved_by; device_off = device.next_off; /* Get offset of next device of this type. */ devicex = devicex + 1; /* Increment RDI device index. */ end; end; do i = 1 to rcpd.last_volume; volume_ptr = addr (rcpd.volume (i)); dvolume_ptr = addr (rdi.dvolumes (i)); dvolume = volume; end; DATA_RETURN: call audit (ecode); call CLEANUP; arg_ecode = ecode; return; meters: entry (arg_to_ptr, arg_copy_size, arg_ecode); /* This entry is called to copy all meter data from RCS and RCPD. * We will copy only the lock meters from RCS. Then from RCPD * we will copy all of the lock data, the complete entry for each * device type, and all non security data from each device entry. * With this information the caller can calculate meter data but * cannot determine the state of any device. */ who_am_i = "rcp_copy_$meters"; call SETUP; /* Set up arguments. */ rcpd_ptr = rcp_pointers_$data (); rcs_ptr = rcp_pointers_$com_seg (); on cleanup call CLEANUP; if ecode ^= 0 then goto METERS_RETURN; rmi_ptr = to_ptr; /* Return info in RMI strcuture. */ if rmi.head.version_num ^= 1 /* Are we using same version as caller? */ then do; /* No. */ ecode = error_table_$unimplemented_version; goto METERS_RETURN; end; if size (rmi_header) > copy_size /* Is there room for RMI header? */ then do; /* No, no room for even that. */ ecode = error_table_$item_too_big; goto METERS_RETURN; end; meter_time = clock_ (); /* Use same time for all devices. */ rmi.head.tot_mdtypes = rcpd.tot_dtypes; /* Get totals from RCPD. */ rmi.head.tot_mdevices = rcpd.tot_devices; total_size = fixed (rel (addr (rmi.end)), 19) - fixed (rel (rmi_ptr), 19); if total_size > copy_size /* Is there room for all of RMI? */ then do; /* No. */ ecode = error_table_$item_too_big; goto METERS_RETURN; end; rmi.rcs_lock_info = rcs.lock_info; /* Copy lock data. */ rmi.rcpd_lock_info = rcpd.lock_info; do i = 1 to rcpd.tot_dtypes; /* Copy info for each device type. */ dtype_ptr = addr (rcpd.dtype (i)); mdtype_ptr = addr (rmi.mdtypes (i)); mdtype.device_type = dtype.device_type; mdtype.num_devices = dtype.num_devices; do j = 1 to hbound (mdtype.histo_times, 1); mdtype.histo_times (j) = dtype.histo_times (j); end; end; do i = 1 to rcpd.tot_devices; /* Copy info for each device. */ device_ptr = addr (rcpd.device (i)); mdevice_ptr = addr (rmi.mdevices (i)); mdevice.device_name = device.device_name; mdevice.dtypex = device.dtypex; mdevice.error_count = device.error_count; mdevice.num_assigns = device.num_assigns; mdevice.tot_assign_time = device.tot_assign_time; do j = 1 to hbound (mdevice.histogram, 1); mdevice.histogram (j) = device.histogram (j); end; if device.state = ASSIGNED /* If device now assigned tell how long. */ then mdevice.time_assigned = meter_time - device.state_time; else mdevice.time_assigned = 0; end; METERS_RETURN: call audit (ecode); call CLEANUP; arg_ecode = ecode; return; list: entry (arg_to_ptr, arg_copy_size, arg_ecode); /* This entry is called to return RCS information about all attachments * and assignments of the calling process. */ who_am_i = "rcp_copy_$list"; call SETUP; /* Set up arguments. */ rcpd_ptr = rcp_pointers_$data (); rcs_ptr = rcp_pointers_$com_seg (); on cleanup call CLEANUP; if ecode ^= 0 then goto LIST_RETURN; rli_ptr = to_ptr; this_process = get_process_id_ (); if (rli.head.version_num ^= rli_version_4) /* Are we and caller using the same RLI structure? */ then do; /* No. */ ecode = error_table_$unimplemented_version; goto LIST_RETURN; end; if size (rli_header) > copy_size /* Is there room for RLI header? */ then do; /* No, no room for even that. */ ecode = error_table_$item_too_big; goto LIST_RETURN; end; /* Get per process RCS information. */ call rcp_rcse_$info (attach_off, num_attach, dassign_off, num_dassign); call rcp_lv_$number (num_lv); /* get number of lvs. */ rli.head.num_dassign = num_dassign; /* Fill in RLI header info. */ rli.head.num_attach = num_attach; rli.head.num_lv = num_lv; rli.head.num_device_resv = 0; do i = 1 to rcpd.tot_devices; /* loop through all devices */ device_ptr = addr (rcpd.device (i)); if (device.reservation_id ^= 0) & (device.process_id = this_process) then rli.head.num_device_resv = rli.head.num_device_resv + 1; end; rli.head.num_vol_resv = 0; do i = 1 to rcpd.last_volume; /* and then loop through all volumes */ volume_ptr = addr (rcpd.volume (i)); if (volume.reservation_id ^= 0) & (volume.process_id = this_process) then rli.head.num_vol_resv = rli.head.num_vol_resv + 1; end; total_size = fixed (rel (addr (rli.end)), 19) - fixed (rel (rli_ptr), 19); if total_size > copy_size /* Is there room for all info? */ then do; /* No. */ ecode = error_table_$item_too_big; goto LIST_RETURN; end; rcse_off = dassign_off; /* Process all assignment RCS entries. */ num_dassign = 0; do while (rcse_off ^= "0"b); /* We will go through process assignment list. */ num_dassign = num_dassign + 1; /* Index of current assignment entry. */ dassign_ptr = addr (rli.dassigns (num_dassign)); rcse_ptr = ptr (rcs_ptr, rcse_off); /* Pointer fo RCS entry we get info from. */ rcse_off = rcse.user_off; /* Offset of next RCS entry in this list. */ dassign.device_name = rcse.device_name; /* Copy all fields needed for assignment entry. */ dassign.dtypex = rcse.dtypex; dassign.model = rcse.model; do i = 1 to rcse.num_qualifiers; dassign.qualifiers (i) = rcse.qualifiers (i); end; dassign.state_time = rcse.state_time; dassign.state = rcse.state; dassign.level = rcse.caller_level; dassign.disposition = rcse.disposition; if rcse.rcse_off = "0"b then dassign.flags.attached = "0"b; else dassign.flags.attached = "1"b; dassign.rcp_id = rcse.rcp_id; dassign.usage_time, dassign.wait_time = 0; end; rcse_off = attach_off; /* Process all attachment entries. */ num_attach = 0; do while (rcse_off ^= "0"b); /* Go through process attachment list. */ num_attach = num_attach + 1; /* Index of current attachment entry. */ attach_ptr = addr (rli.attaches (num_attach)); rcse_ptr = ptr (rcs_ptr, rcse_off); /* Pointer to RCS entry we get info from. */ rcse_off = rcse.user_off; /* Offset of next RCS entry in this list. */ attach.device_name = rcse.device_name; /* Copy all fields needed for attachment entry. */ attach.volume_name = rcse.volume_name; attach.dtypex = rcse.dtypex; attach.state_time = rcse.state_time; attach.state = rcse.state; attach.level = rcse.caller_level; attach.flags.priv = rcse.flags.priv; attach.flags.writing = rcse.flags.writing; attach.rcp_id = rcse.rcp_id; attach.workspace_max = rcse.workspace_max; attach.timeout_max = rcse.timeout_max; attach.ioi_index = rcse.ioi_index; attach.usage_time, attach.wait_time = 0; end; if num_lv ^= 0 /* Are there any lvs to list? */ then call rcp_lv_$copy (rli_ptr); /* Yes, copy list of lv info. */ k = 0; do i = 1 to rcpd.tot_devices; /* loop through all devices */ device_ptr = addr (rcpd.device (i)); if (device.reservation_id ^= 0) & (device.process_id = this_process) then do; k = k + 1; device_resv_ptr = addr (rli.device_resvs (k)); device_resv.reservation_id = device.reservation_id; device_resv.reserved_by = device.reserved_by; device_resv.device_name = device.device_name; end; end; k = 0; do i = 1 to rcpd.last_volume; /* and then loop through all volumes */ volume_ptr = addr (rcpd.volume (i)); if (volume.reservation_id ^= 0) & (volume.process_id = this_process) then do; k = k + 1; vol_resv_ptr = addr (rli.vol_resvs (k)); vol_resv.reservation_id = volume.reservation_id; vol_resv.reserved_by = volume.reserved_by; vol_resv.volume_name = volume.volume_name; end; end; LIST_RETURN: call CLEANUP; /* We don't bother to audit 'cause this is non-privileged */ arg_ecode = ecode; return; SETUP: procedure; /* This procedure is called to set up and validate the caller's * segment pointer. We must be sure that we don't copy past the * end of his segment. */ call cu_$level_get (caller_level); /* Save caller's validation level. */ call cu_$level_set (get_ring_ ()); /* Set validation level to RCP level. */ to_ptr = arg_to_ptr; /* Copy arguments. */ copy_size = arg_copy_size; operation = access_operations_$rcp_copy_info; operation_ptr = addr (operation); en_access_op.detailed_operation = 0; ops_ptr = addr (en_access_op.detailed_operation); /**** the one non-priv entry (list) isn't audited, so always set this flag ****/ detailed_operation.priv_gate_call = "1"b; call hcs_$get_max_length_seg (to_ptr, max_size, ecode); if ecode ^= 0 then return; if (fixed (rel (to_ptr), 19) + copy_size) > max_size then ecode = error_table_$bad_arg; end SETUP; audit: proc (code); dcl code fixed bin (35) parameter; dcl 1 auto_event_flags like audit_event_flags aligned; unspec (auto_event_flags) = ""b; auto_event_flags.grant = (code = 0); auto_event_flags.priv_op = "1"b; call access_audit_r1_$log_obj_ptr (who_am_i, caller_level, unspec (auto_event_flags), operation, rcpd_ptr, code, null (), 0); end audit; CLEANUP: proc; call cu_$level_set (caller_level); end CLEANUP; %include access_mode_values; %page; %include access_audit_eventflags; %page; %include access_audit_encoded_op; %page; %include rcp_data; %page; %include rcp_com_seg; %page; %include rcp_data_info; %page; %include rcp_meter_info; %page; %include rcp_list_info; %page; %include rcp_ops; %page; %include rcp_requestor_info; %page; %include rcp_resource_info; %page; %include rcp_resource_states; %page; %include rcp_resource_types; end rcp_copy_;  rcp_detach_.pl1 11/11/89 1110.3rew 11/11/89 0805.9 115614 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1983 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-09-11,Fawcett), approve(85-09-11,MCR6979), audit(85-12-02,CLJones), install(86-03-21,MR12.0-1033): Add MCA support END HISTORY COMMENTS */ rcp_detach_: procedure; /* This program implements the rcp_$detach entry point. * It is also an internal interface of RCP. * Created on 12/11/74 by Bill Silver. * Modified 1/79 by R.J.C. Kissel to fix the mount timer bug. * Modified 830818 to delete admin_gate_$give_console... -E. A. Ranzenbach * Modified 841005 to interface to rcp_control_ instead of rcp_initializer_ ... -M. M. Pozzo * Modified 1985-04-03 by Paul Farley & RAF to add support for MCA as device_type (8). * * This program contains the following entry points: * 1. detach - Detach and possible unassign a device. * 2. force_detach - Detach a device that is being forcedly unassigned. */ /* ARGUMENT DATA */ dcl arg_comment char (*); /* (I) Caller's comment. */ dcl arg_disposition bit (*); /* (I) ON => retain, OFF => default. */ dcl arg_ecode fixed bin (35); /* (O) error_table_ code. */ dcl arg_error_count fixed bin; /* (I) User ring error count for attachment. */ dcl arg_rcp_id bit (36) aligned; /* (I) ID used to identify RCS entry. */ dcl arg_rcse_ptr ptr; /* (I) Pointer to attachment RCSE. */ /* AUTOMATIC DATA */ dcl disposition bit (1); /* Assignment disposition. */ dcl device_off bit (18) aligned; /* Offset of RCSE device entry. */ dcl force_detach_entry bit (1); /* set if force_detach entry */ dcl volume_off bit (18) aligned; /* Offset of RCSE volume entry. */ dcl rcp_id bit (36) aligned; /* Used to copy rcp_id argument. */ dcl process_id bit (36) aligned; /* Process id requesting operation by RCP */ dcl device_name char (32); /* Device name for rcp_control_ */ dcl operation bit (36) aligned; /* Operation being requested of rcp_control_ */ dcl arcse_ptr ptr; /* Pointer to assignment RCS entry. */ dcl caller_level fixed bin; /* Caller's validation level. */ dcl dcode fixed bin (35); /* A dummy error_table code. */ dcl ecode fixed bin (35); /* error_table_ code. */ dcl error_count fixed bin (17); /* Number of errors during attachment. */ dcl ioi_index fixed bin; /* Used in final call to IOI. */ /* BASED DATA */ dcl 1 arcse based (arcse_ptr) like rcse aligned; /* Used to reference assignment RCS entry. */ /* EXTERNAL ENTRIES CALLED */ dcl cleanup condition; /* Used to set up cleanup handler. */ dcl (addr, ptr) builtin; dcl error_table_$bad_arg fixed bin (35) external; dcl error_table_$force_unassign fixed bin (35) external; dcl access_operations_$rcp_error_count bit (36) aligned ext static; dcl access_operations_$rcp_unassign bit (36) aligned ext static; dcl admin_gate_$ioi_detach entry (fixed bin, fixed bin (35)); dcl admin_gate_$syserr entry options (variable); dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl get_ring_ entry returns (fixed bin); dcl mca_attach_$finish_detach entry (fixed bin, bit (1), fixed bin (35)); dcl rcp_comment_ entry (ptr); dcl rcp_control_ entry (bit (36) aligned, bit (18) aligned, bit (18) aligned, char (*), fixed bin (17), bit (36) aligned, fixed bin (35)); dcl rcp_rcse_$free entry (ptr, fixed bin (35)); dcl rcp_validate_ entry (bit (36) aligned, fixed bin, ptr, fixed bin (35)); dcl rcp_pointers_$data entry () returns (ptr); dcl rcp_mount_timer_$reset entry (bit (18) aligned, fixed bin (35)); /* */ %include rcp_data; %include rcp_com_seg; detach: entry (arg_rcp_id, arg_disposition, arg_error_count, arg_comment, arg_ecode); /* This entry implements the rcp_$detach entry point. It is also called by * RCP programs. This entry point will detach the device associated with the * specified RCSE entry. Depending upon the disposition specified in the * call and the disposition specified in the associated assignment RCSE we * will also unassign the device. In all cases where there is a volume * attached on this drive we will unassign the volume. */ call SETUP; force_detach_entry = "0"b; call cu_$level_get (caller_level); /* Get caller's validation level. */ on cleanup begin; /* Cleanup if any trouble. */ call cu_$level_set (caller_level); /* Reset validation level to caller level. */ end; call cu_$level_set (get_ring_ ()); /* Set validation level to RCP level. */ rcp_id = arg_rcp_id; /* Copy arguments. */ disposition = arg_disposition; error_count = arg_error_count; call rcp_validate_ (rcp_id, caller_level, rcse_ptr, ecode); if ecode ^= 0 /* Is rcp_id OK? */ then if ecode = error_table_$force_unassign then ; else goto RETURN; /* No. */ if rcse.kind ^= 1 /* Is this an attachment entry? */ then do; /* No. */ ecode = error_table_$bad_arg; goto RETURN; end; if rcse.ioi_index ^= 0 /* Is device attached to IOI? */ then do; /* Yes, detach it. */ call DETACH; /* Detach and tell operator. */ call admin_gate_$syserr (0, "RCP: Detached ^a from ^a", rcse.device_name, rcse.group_id); call rcp_mount_timer_$reset (rcse.device_off, dcode); /* Make sure and stop all check mount messages, ignore dcode. */ if error_count > 0 /* Report any errors. */ then if rcse.volume_name = "" then call admin_gate_$syserr (0, "RCP: Errors (^a) = ^d", rcse.device_name, error_count); else call admin_gate_$syserr (0, "RCP: Errors (^a, volume ^a) = ^d", rcse.device_name, rcse.volume_name, error_count); end; rcse.caller_comment = arg_comment; /* Get comment argument. */ call rcp_comment_ (rcse_ptr); /* Type caller's comment. */ arcse_ptr = ptr (rcse_ptr, rcse.rcse_off); /* Get pointer to assignment RCS entry. */ if ^disposition /* Should we use default disposition? */ then disposition = arcse.disposition; /* Yes, get it from assignment entry. */ device_off, /* No device or volume specified yet. */ volume_off = "0"b; if error_count > 0 /* Are there any errors to report? */ then do; /* Yes, for now just update error count. */ operation = access_operations_$rcp_error_count; device_off = arcse.device_off; end; if ^disposition /* Should we unassign the device? */ then do; /* Yes, rcp_initializer_ will do it. */ operation = access_operations_$rcp_unassign; device_off = arcse.device_off; /* Get RCPD offset of device. */ call rcp_rcse_$free (arcse_ptr, dcode); if ecode = 0 /* If no previous error use this error code. */ then ecode = dcode; end; else do; arcse.rcse_off = "0"b; /* No, just show that device no longer attached. */ device_off = "0"b; /* Don't unassign this device! */ end; if rcse.flags.volume /* Is there a volume to unassign? */ then do; /* Yes, rcp_initializer_ will do it. */ operation = access_operations_$rcp_unassign; volume_off = rcse.volume_off; /* Get RCPD offset of volume. */ end; call rcp_rcse_$free (rcse_ptr, dcode); /* Always free attachment entry. */ if ecode = 0 then ecode = dcode; if operation ^= ""b /* Is there any reason to call rcp_control_? */ then do; /* Yes, something for it to do. */ call rcp_control_ (operation, volume_off, device_off, device_name, error_count, process_id, ecode); end; RETURN: arg_ecode = ecode; call cu_$level_set (caller_level); return; /* */ force_detach: entry (arg_rcse_ptr); /* This entry point is an internal interface of RCP. It is called to * detach a device that is being forcedly unassigned. Freeing the * attachment RCSE and the unassignment of the device and any volume * mounted on it must be done by the caller. */ call SETUP; force_detach_entry = "1"b; rcse_ptr = arg_rcse_ptr; /* Get pointer to attachment RCSE. */ if rcse.ioi_index = 0 /* Is device actually attached via IOI? */ then return; /* No, we don't have to do anything. */ call DETACH; /* Now go and detach the device. */ /* Tell operator about force detachment. */ call admin_gate_$syserr (0, "RCP: Force Detached ^a from ^a", rcse.device_name, rcse.group_id); return; SETUP: procedure; device_off = ""b; volume_off = ""b; process_id = ""b; device_name = ""; operation = ""b; error_count = 0; end SETUP; DETACH: procedure; /* This procedure is called to perform the actual device detachment. * What we have to do depends upon the device type. */ ioi_index = rcse.ioi_index; /* Save IOI index. */ rcse.ioi_index = 0; /* Make sure IOI never called again by RCP. */ goto DTYPE (rcse.dtypex); /* Process according to device type. */ DTYPE (1): /* TAPE */ call admin_gate_$ioi_detach (ioi_index, ecode); if rcp_pointers_$data () -> rcpd.modes.unload_on_detach then call UNLOAD_DEVICE (); return; DTYPE (2): /* DISK */ call admin_gate_$ioi_detach (ioi_index, ecode); call UNLOAD_DEVICE (); return; DTYPE (8): /* MCA */ call mca_attach_$finish_detach (ioi_index, force_detach_entry, ecode); DTYPE (3): /* CONSOLE */ DTYPE (4): /* PRINTER */ DTYPE (5): /* PUNCH */ DTYPE (6): /* READER */ DTYPE (7): /* SPECIAL */ call admin_gate_$ioi_detach (ioi_index, ecode); end DETACH; /* This internal procedure gets the device_ptr for the device being detached and unloades that device by calling rcp_unload_. This entry is normally called with rcp_data locked, but, in this case, the data base does not need to be locked. This is due to the fact that no one can be using this device entry except this user until rcp_initializer_ resets its state. */ UNLOAD_DEVICE: proc (); dcl rcp_pointers_$data entry () returns (ptr); dcl rcp_unload_$unload_device entry (ptr, bit (1)); if rcse.rcse_off = "0"b then return; /* Cannot get to needed rcse. */ arcse_ptr = ptr (rcse_ptr, rcse.rcse_off); /* Get ptr to device rcse. */ if arcse.device_off = "0"b then return; /* Cannot get to device entry. */ device_ptr = ptr (rcp_pointers_$data (), rcse.device_off); device.flags.attached = "0"b; /* Mark it as _n_o_t attached. */ call rcp_unload_$unload_device (device_ptr, "0"b);/* Unload the device. */ return; end UNLOAD_DEVICE; /* BEGIN MESSAGE DOCUMENTATION Message: RCP: Detached DEVICE from PERSON.PROJ.T S: $info T: $run M: The user of DEVICE has detached it. A: If DEVICE is a disk drive, demount the volume on it and store it in the library. Message: RCP: Force Detached DEVICE from PERSON.PROJ.T S: $info T: $run M: The user PERSON.PROJ.T has terminated abnormally. This may be due to an automatic logout or a process termination. A: If DEVICE is a disk drive, demount the volume on it and store it in the library. Message: RCP: Errors (DEVICE) = NN S: $info T: $run M: When DEVICE was detached, its error counter was nonzero. This may be due to a problem with DEVICE or with the user program. A: $ignore Message: RCP: Errors (DEVICE, volume VOL) = NN S: $info T: $run M: When DEVICE was detached, its error counter was nonzero. The errors may be due to a problem with DEVICE, with the volume VOLUME, or with the user program. A: $ignore Message: RCP: Unloading volume VOLUME from device DEVICE S: $info T: $run M: The specified VOLUME is being demounted by RCP. A: Return the specified VOLUME to the library. Message: RCP: Manually unload volume VOLUME from device DEVICE S: $beep T: $run M: RCP could not unload the specified volume from the device on which it was loaded. A: Manually unload the volume from the device and return the volume to the library for storage. END MESSAGE DOCUMENTATION */ end rcp_detach_;  rcp_detach_lv_.pl1 11/11/89 1110.3rew 11/11/89 0806.7 43812 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-07-10,EJSharpe), approve(86-02-20,MCR7304), audit(86-03-27,CLJones), install(86-04-23,MR12.0-1044): added security auditing END HISTORY COMMENTS */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_detach_lv_: procedure (arg_rcp_id, arg_ecode); /* This procedure implements the rcp_$detach_lv entry point. * Created on 04/08/76 by Bill Silver. * Modified for lv_request_ 09/16/76 by B. Greenberg. * Modified for B2 security cleanup, December 1984 by Chris Jones. */ /* * This program is called to detach one logical volume. * We will check to see if this lv is already attached for this process. * If so, we will detach it. Then we will remove it from the * per-process list of attached logical volumes. */ dcl arg_rcp_id bit (36) aligned; /* (I) ID of this attachment. */ dcl arg_ecode fixed bin (35); /* (O) error_table_ code. */ dcl 1 auto_event_flags aligned like audit_event_flags; dcl caller_level fixed bin; /* Validation level of caller. */ dcl ecode fixed bin (35); /* error_table_code. */ dcl ignore_mode bit (36) aligned; dcl ignore_pubbit bit (1) aligned; dcl lv_access_range (2) bit (72) aligned; /* range of access to LV */ dcl lvid bit (36) aligned; /* ID of logical volume. */ dcl rcp_id bit (36) aligned; /* RCP ID of this attach. */ dcl volume_name_str char (64); /* passed to access_audit_ */ dcl access_audit_r1_$log_obj_class_range entry options (variable); dcl admin_gate_$detach_lv entry (bit (36) aligned, fixed bin (35)); dcl cu_$level_get entry entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl get_ring_ entry () returns (fixed bin (3)); dcl rcp_lv_$check entry (bit (36) aligned, bit (36) aligned, fixed bin, fixed bin (35)); dcl rcp_lv_$del_lv entry (bit (36) aligned, fixed bin (35)); dcl volume_registration_mgr_$get_access_for_attach entry (char (*), fixed bin (3), bit (36) aligned, bit (1) aligned, (2) bit (72) aligned, fixed bin (35)); dcl volume_registration_mgr_$find_lvname entry (bit (36), char (*), fixed bin (35)); dcl access_operations_$detach_lv bit (36) aligned external; dcl error_table_$logical_volume_not_connected fixed bin (35) external; dcl sys_info$access_class_ceiling bit (72) aligned external; dcl cleanup condition; dcl null builtin; dcl string builtin; /* Begin rcp_detach_lv_. */ call cu_$level_get (caller_level); /* Save caller's validation level. */ on cleanup call cu_$level_set (caller_level); call cu_$level_set (get_ring_ ()); /* Set validation level to RCP level. */ rcp_id = arg_rcp_id; /* Copy argument. */ call rcp_lv_$check (rcp_id, lvid, (0), ecode); if ecode ^= 0 then goto RETURN; /* LV not attached for this process. */ call admin_gate_$detach_lv (lvid, ecode); if ecode ^= 0 then if ecode = error_table_$logical_volume_not_connected then ecode = 0; else go to RETURN; /* Unable to detach in ring 0. */ /*** get information so we can audit the detachment. This should all be moved to a "lv_access_kernel_" module */ call volume_registration_mgr_$find_lvname ((lvid), volume_name_str, ecode); if ecode ^= 0 then do; volume_name_str = "logical volume UNKNOWN"; lv_access_range = sys_info$access_class_ceiling; end; else do; call volume_registration_mgr_$get_access_for_attach (volume_name_str, (caller_level), ignore_mode, ignore_pubbit, lv_access_range, (0)); volume_name_str = "logical volume " || volume_name_str; end; string (auto_event_flags) = ""b; auto_event_flags.grant = "1"b; call access_audit_r1_$log_obj_class_range ("rcp_detach_lv_", caller_level, string (auto_event_flags), access_operations_$detach_lv, lv_access_range, volume_name_str, (0), null (), (0)); /*** and finally detach it */ call rcp_lv_$del_lv (rcp_id, ecode); /* Delete lv from process list. */ RETURN: arg_ecode = ecode; call cu_$level_set (caller_level); /* Reset validation level. */ %page; %include access_audit_eventflags; end rcp_detach_lv_;  rcp_device_info_.pl1 11/11/89 1110.3rew 11/11/89 0807.0 146880 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-09-11,Fawcett), approve(85-09-11,MCR6979), audit(85-12-11,CLJones), install(86-03-21,MR12.0-1033): Add MCA support END HISTORY COMMENTS */ /* format: style4 */ rcp_device_info_: procedure; /* This program is an internal interface of RCP. * Created by Bill Silver on 12/12/74. * Modified by D. Vinograd 6/76 to map model number 450 to 451 * Modified by Noel I. Morris on 01/20/77 for multiple tape controllers. * Modified by D. Vinograd 2/77 to force access for Initializer process in ring 1. * Modified by Michael R. Jordan on 11/17/78 to add version 2 tape_info structures and 6250 bpi. * Modified by C. D. Tavares 04/27/79 for canonicalization. * Modified by Michael R. Jordan 6/79 for MR7.0R. * Modified by J. A. Bush 09/30/82 to return more tape info * Modified by J. A. Bush 09/19/83 to fix a bug when using tape_info_version_3 * Modified by Chris Jones 03/05/85 to add copy entrypoint. * Modified by Paul Farley & RAF 04/03/85 to add device_type (8) "MCA". * * This program deals with the various RCP device info structures. * It has the following entry points: * 1. get - Get data from a device info structure and put it into * an RCSE. Initialize the RCSE. * 2. put - Get data from an RCSE and put it into a device info structure. * 3. copy - Copy data from one device info structure to another. */ /* ARGUMENT DATA */ dcl arg_caller_level fixed bin; /* (I) Caller's validation level. */ dcl arg_device_info_ptr ptr; /* (I) pointer to device info structure. */ dcl arg_device_type char (*); /* (I) Device type name. */ dcl arg_ecode fixed bin (35); /* (O) error_table_ code. */ dcl arg_rcse_ptr ptr; /* (I) Pointer to specified RCS entry. */ /* AUTOMATIC DATA */ dcl access fixed bin (5); /* Access to RCP system gate. */ dcl am_initializer bit (1) initial ("0"b); /* On if user is the Initializer */ dcl caller_level fixed bin; /* User's validation level. */ dcl device_name char (32) aligned; /* Device name. */ dcl device_type char (32); /* Device type name. */ dcl dtypex fixed bin; /* Index that => device type. */ dcl ecode fixed bin (35); /* error_table_ code. */ dcl i fixed bin; dcl tracks fixed bin; /* Tape tracks type qualifier. */ dcl 1 local_tape_info like tape_info; /* A copy for handling version 1 structures. */ /* BASED DATA */ dcl based_rcse (size (rcse)) bit (36) based (rcse_ptr); dcl 1 version_1_tape_info based (device_info_ptr) aligned, /* O_L_D_ RCP device info structure for tapes. */ 2 version_num fixed bin, /* Version number of this structure. */ 2 usage_time fixed bin, /* Number of minutes drive will/may be used. */ 2 wait_time fixed bin, /* Number of minutes user will/must wait. */ 2 system_flag bit (1), /* ON => user wants to be a system process. */ 2 device_name char (8), /* Tape drive name. */ 2 model fixed bin, /* Tape drive model number. */ 2 tracks fixed bin, /* Tracks type. */ 2 density bit (36), /* Recording density: 200, 556, 800, 1600, 6250. */ 2 volume_name char (32), /* Tape reel name. */ 2 write_flag bit (1), /* ON => writing on tape reel. */ 2 position_index fixed bin (35); /* Counter used to determine tape reel position. */ /* EXTERNAL ENTRIES CALLED */ dcl (addr, bit, null, size, string, substr) builtin; dcl (error_table_$bad_arg, error_table_$resource_unknown, error_table_$unimplemented_version) fixed bin (35) external; dcl get_group_id_ entry returns (char (32) aligned); dcl get_process_id_ entry returns (bit (36) aligned); dcl hcs_$get_user_effmode entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin, fixed bin (5), fixed bin (35)); dcl rcp_pointers_$com_seg entry returns (ptr); dcl resource_info_$get_dtypex entry (char (*), char (*), fixed bin, fixed bin (35)); /* * * This entry is called to get information out of a device info structure. * We will interpret this information and put it into the specified RCS * entry. We will validate as much information in the structure as possible. * */ get: entry (arg_device_type, arg_device_info_ptr, arg_rcse_ptr, arg_caller_level, arg_ecode); device_type = arg_device_type; /* Get arguments. */ device_info_ptr = arg_device_info_ptr; rcse_ptr = arg_rcse_ptr; caller_level = arg_caller_level; call resource_info_$get_dtypex (device_type, device_type, dtypex, ecode); if ecode ^= 0 then goto RETURN_ERR; string (based_rcse) = "0"b; /* Zero entire RCSE. */ device_name, /* Get name of device to assign. */ rcse.device_name = device_info.device_name; rcse.volume_name = " "; /* Assume no volume. */ rcse.dtypex = dtypex; /* Remember device type. */ rcse.model = device_info.model; /* Every device type has a model number. */ rcse.num_qualifiers = NUM_QUALIFIERS (dtypex); do i = 1 to rcse.num_qualifiers; /* Fill in all qualifiers that device has. */ rcse.qualifiers (i) = device_info.qualifiers (i); end; rcse.caller_level = caller_level; /* Fill in other data common to all device types. */ rcse.process_id = get_process_id_ (); rcse.group_id = get_group_id_ (); rcse.version_num = device_info.version_num; rcse.workspace_ptr = null (); if device_name ^= " " /* Not blank => looking for a specific device. */ then rcse.flags.device = "1"b; rcse.flags.system = GET_SYSTEM_FLAG (); goto GET_DTYPE (dtypex); /* Process according to device type. */ GET_DTYPE (1): /* TAPE */ if tape_info.version_num = 1 then do; /* Convert old structures. */ local_tape_info.usage_time = version_1_tape_info.usage_time; local_tape_info.wait_time = version_1_tape_info.wait_time; local_tape_info.system_flag = version_1_tape_info.system_flag; local_tape_info.device_name = version_1_tape_info.device_name; local_tape_info.model = version_1_tape_info.model; local_tape_info.tracks = version_1_tape_info.tracks; local_tape_info.density = version_1_tape_info.density; local_tape_info.speed = "0"b; local_tape_info.pad = "0"b; local_tape_info.volume_name = version_1_tape_info.volume_name; local_tape_info.write_flag = version_1_tape_info.write_flag; local_tape_info.position_index = version_1_tape_info.position_index; device_info_ptr = addr (local_tape_info); /* Switch to the temporary version 2 copy. */ rcse.qualifiers (3) = 0; /* No speed in RCSE either. */ end; else if tape_info.version_num ^= tape_info_version_3 & tape_info.version_num ^= tape_info_version_2 then goto BAD_VERSION; call canon_name (DEVICE_TYPE (dtypex), device_name, rcse.device_name); if rcse.flags.device then do; /* Specific device => no qualifier tests. */ if substr (device_name, 1, 3) ^= "tap" then goto BAD_DEVICE; end; else do; /* Any tape, check qualifiers. */ tracks = tape_info.tracks; /* Get tracks type. */ if tracks ^= 0 /* If track qualifier specified validate it. */ then if (tracks ^= 9) & (tracks ^= 7) then goto BAD_QUALIFIER; if substr (tape_info.density, 6) ^= ""b /* Extraneous bits set? */ then goto BAD_QUALIFIER; if (tracks = 7) & /* Did caller specify 7 track? */ (substr (tape_info.density, 4, 2) ^= ""b) /* Then he can't specify possible 1600 or 6250 density. */ then goto BAD_QUALIFIER; if substr (tape_info.speed, 4) ^= ""b /* Extraneous bits set? */ then goto BAD_QUALIFIER; if tape_info.pad ^= "0"b /* This must be "0"b. */ then goto BAD_QUALIFIER; end; rcse.flags.writing = tape_info.write_flag; if tape_info.volume_name ^= " " /* Is there a volume name? */ then do; /* Yes. */ rcse.volume_name = tape_info.volume_name; rcse.flags.volume = "1"b; if rcse.volume_name = "T&D_Volume" then do; rcse.flags.t_and_d = "1"b; rcse.volume_name = "scratch"; end; else call canon_name (VOLUME_TYPE (dtypex), rcse.volume_name, tape_info.volume_name); end; goto RETURN_OK; GET_DTYPE (2): /* DISK */ if disk_info.version_num ^= 1 then goto BAD_VERSION; call canon_name (DEVICE_TYPE (dtypex), device_name, rcse.device_name); if rcse.flags.device then if substr (device_name, 1, 3) ^= "dsk" then goto BAD_DEVICE; rcse.flags.writing = disk_info.write_flag; if disk_info.volume_name ^= " " /* Is there a volume name? */ then do; /* Yes. */ rcse.volume_name = disk_info.volume_name; rcse.flags.volume = "1"b; if rcse.volume_name = "T&D_Volume" then do; rcse.flags.t_and_d = "1"b; rcse.volume_name = "scratch"; end; else call canon_name (VOLUME_TYPE (dtypex), rcse.volume_name, disk_info.volume_name); end; if rcse.model = 191 /* Model number 191 replaced by 400. */ then rcse.model = 400; if rcse.model = 450 /* then name been changed */ then rcse.model = 451; goto RETURN_OK; GET_DTYPE (3): /* CONSOLE */ if device_info.version_num ^= 1 then goto BAD_VERSION; call canon_name (DEVICE_TYPE (dtypex), device_name, rcse.device_name); if rcse.flags.device /* Does caller want a specific device? */ then if substr (device_name, 1, 3) ^= "opc" /* Then it must be this name: "opc". */ then goto BAD_DEVICE; rcse.model = 0; /* Model number not used. */ goto RETURN_OK; GET_DTYPE (4): /* PRINTER */ if device_info.version_num ^= 1 then goto BAD_VERSION; call canon_name (DEVICE_TYPE (dtypex), device_name, rcse.device_name); if rcse.flags.device then if substr (device_name, 1, 3) ^= "prt" then goto BAD_DEVICE; goto RETURN_OK; GET_DTYPE (5): /* PUNCH */ if device_info.version_num ^= 1 then goto BAD_VERSION; call canon_name (DEVICE_TYPE (dtypex), device_name, rcse.device_name); if rcse.flags.device then if substr (device_name, 1, 3) ^= "pun" then goto BAD_DEVICE; goto RETURN_OK; GET_DTYPE (6): /* READER */ if device_info.version_num ^= 1 then goto BAD_VERSION; call canon_name (DEVICE_TYPE (dtypex), device_name, rcse.device_name); if rcse.flags.device then if substr (device_name, 1, 3) ^= "rdr" then goto BAD_DEVICE; goto RETURN_OK; GET_DTYPE (7): /* SPECIAL */ GET_DTYPE (8): /* MCA */ if device_info.version_num ^= 1 then goto BAD_VERSION; /* Anything goes for name. */ goto RETURN_OK; RETURN_OK: arg_ecode = 0; device_info.device_name = rcse.device_name; /* in case it was changed (canonicalized) */ return; RETURN_ERR: arg_ecode = ecode; return; BAD_DEVICE: arg_ecode = error_table_$resource_unknown; return; BAD_QUALIFIER: arg_ecode = error_table_$bad_arg; return; BAD_VERSION: arg_ecode = error_table_$unimplemented_version; return; canon_name: proc (resource_type, resource_name, copy_resource_name); dcl resource_type char (*); dcl (resource_name, copy_resource_name) char (*) aligned parameter, resource_info_$canonicalize_name ext entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (35)); if am_initializer then copy_resource_name = resource_name; /* don't take chance RTDT nonexistent during reload */ else do; call resource_info_$canonicalize_name ((resource_type), resource_name, copy_resource_name, ecode); if ecode ^= 0 then goto RETURN_ERR; end; resource_name = copy_resource_name; return; end canon_name; /* * * This entry is called to return information in a device info structure. * The information about this device is take from the specified RCS entry. * */ set: entry (arg_device_info_ptr, arg_rcse_ptr, arg_ecode); device_info_ptr = arg_device_info_ptr; /* Copy arguments. */ rcse_ptr = arg_rcse_ptr; if device_info.version_num ^= rcse.version_num then /* verson number ^= */ if rcse.dtypex ^= TAPE_DRIVE_DTYPEX then /* and not tapes */ go to BAD_VERSION; else if device_info.version_num ^= tape_info_version_3 & device_info.version_num ^= tape_info_version_2 then go to BAD_VERSION; device_info.usage_time, /* Return common info. */ device_info.wait_time = 0; device_info.system_flag = rcse.flags.system; device_info.device_name = rcse.device_name; device_info.model = rcse.model; do i = 1 to rcse.num_qualifiers; device_info.qualifiers (i) = rcse.qualifiers (i); end; goto SET_DTYPE (rcse.dtypex); /* Process according to device type. */ SET_DTYPE (1): /* TAPE */ if device_info.version_num = 1 then do; /* Old version version 1 structure. */ version_1_tape_info.volume_name = rcse.volume_name; version_1_tape_info.write_flag = rcse.flags.writing; version_1_tape_info.position_index = 1; /* Feature not yet implemented. */ end; else do; /* Version 2 or > structure */ tape_info.volume_name = rcse.volume_name; tape_info.write_flag = rcse.flags.writing; tape_info.position_index = 1; /* Feature not yet implemented. */ if tape_info.version_num = tape_info_version_3 then do; /* version 3 */ tape_info.volume_density = rcse.volume_density_index; tape_info.volume_type = rcse.label_type; tape_info.opr_auth = rcse.need_auth; end; end; arg_ecode = 0; return; SET_DTYPE (2): /* DISK */ disk_info.volume_name = rcse.volume_name; disk_info.write_flag = rcse.flags.writing; arg_ecode = 0; return; SET_DTYPE (3): /* CONSOLE */ SET_DTYPE (4): /* PRINTER */ SET_DTYPE (5): /* PUNCH */ SET_DTYPE (6): /* READER */ SET_DTYPE (7): /* SPECIAL */ SET_DTYPE (8): /* MCA */ arg_ecode = 0; /* No extra info to return. */ return; copy: entry (arg_device_type, arg_source_ptr, arg_dest_ptr, arg_ecode); dcl arg_source_ptr ptr parameter; dcl arg_dest_ptr ptr parameter; dcl source_ptr ptr; dcl dest_ptr ptr; dcl wordcount fixed bin; dcl based_bits (wordcount) bit (36) aligned based; device_type = arg_device_type; call resource_info_$get_dtypex (device_type, device_type, dtypex, ecode); if ecode ^= 0 then goto RETURN_ERR; source_ptr = arg_source_ptr; dest_ptr = arg_dest_ptr; wordcount = device_info_size (dtypex); dest_ptr -> based_bits = source_ptr -> based_bits; arg_ecode = 0; return; /* * * This procedure is called to determine whether or not the calling is to be * considered a system process. If it is a value of "1"b will be returned. * Otherwise a value of "0"b will be returned. In order to be considered * a system process the following criteria must be satisified: * 1. The caller must want to be a system process. * 2. The caller must have access to the system RCP gate. * * If the caller is the Initializer process in ring 1 then all is ok. * */ GET_SYSTEM_FLAG: procedure returns (bit (1)); if rcse.group_id = "Initializer.SysDaemon.z" then do; am_initializer = "1"b; return ("1"b); end; if ^device_info.system_flag /* Does caller want to be a system process? */ then return ("0"b); /* No. */ rcs_ptr = rcp_pointers_$com_seg (); /* Yes, see if caller has the necessary access. */ call hcs_$get_user_effmode (rcs.sys_directory, rcs.sys_acs, rcse.group_id, caller_level, access, ecode); if ecode ^= 0 /* Any error => no access. */ then return ("0"b); if (bit (access, 5) & "00100"b) ^= "00100"b then return ("0"b); /* Caller does not have "E" access. */ return ("1"b); end GET_SYSTEM_FLAG; %include rcp_com_seg; %page; %include rcp_resource_types; %page; %include rcp_device_info_structs; end rcp_device_info_;  rcp_disk_.pl1 11/11/89 1110.3r w 11/11/89 0804.3 283284 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-09-09,Farley), approve(85-09-09,MCR6979), audit(85-12-17,CLJones), install(86-03-21,MR12.0-1033): Add code for no PROTECT and OPR INT switches. 2) change(86-01-15,Fawcett), approve(86-04-11,MCR7383), audit(86-06-17,Farley), install(86-07-17,MR12.0-1097): Add support for subvolumes and 512_WORD_IO. 3) change(86-09-26,Farley), approve(86-10-24,MCR7557), audit(86-10-27,Fawcett), install(86-10-28,MR12.0-1200): Added call to admin_gate_$ioi_set_ws_max, before calling ioi_$workspace. This will allow proper workspace size setting when the workspace may be currently smaller than required. END HISTORY COMMENTS */ rcp_disk_: procedure (arg_rcse_ptr, arg_ecode); /* This program is an internal interface of RCP. * Created on 05/13/75 by Bill Silver. * Changed on 04/02/76 by Bill Silver for NSS. * Changed on 11/01/76 by Bill Silver to set mount timer. * Changed on 12/02/76 by Bernard Greenberg for label countervalidator. * Changed on 1/79 by R.J.C. Kissel to add disk label authentication. * Changed 3/79 by Michael R. Jordan for MR7.0R. * Changed 2/85 by Paul Farley to add code for no PROTECT and OPR INT switches. * * This program is called to perform special disk attachment processing. */ /* ARGUMENT DATA */ dcl arg_ecode fixed bin (35); /* (O) Return error_table_ code. */ dcl arg_rcse_ptr ptr; /* (I) Pointer to attachment RCS entry. */ /* AUTOMATIC DATA */ dcl command bit (6); dcl device_off bit (18) aligned; /* RCPD device entry offset. */ dcl drive_num fixed bin; /* Disk drive number. */ dcl (ecode, scode) fixed bin (35); /* error_table_ code. */ dcl ioi_index fixed bin; /* IOI internal device index. */ dcl label_address fixed bin; dcl special_flag bit (1) aligned; /* ON => special interrupt. */ dcl special_status_word bit (36) aligned; /* One word of special status. */ dcl workspace_ptr ptr; /* Pointer to our workspace. */ dcl real_story char (160); dcl label_story char (160); dcl what_user_asked_for bit (1); dcl write_flag bit (1) aligned; dcl valid_reg bit (1); /* Pack has valid registration */ dcl ss_pack bit (1); /* Pack is Storage System */ dcl valid_copy bit (1); /* Pack is provably copy of mounted vol */ dcl (i, sector, record_factor, record_offset, cylinder, devadd, usable_sect_per_cyl, unused_sect_per_cyl) fixed bin (24); /* variables used to calculate label sector addresses */ /* BASED DATA */ dcl 1 wspace based (workspace_ptr) aligned, /* Overlay of IOI workspace. */ 2 idcw bit (36), /* Disk IDCW. */ 2 seek_dcw bit (36), /* Used in label checking seek-read operation. */ 2 read_idcw bit (36), 2 read_dcw bit (36), 2 seek_addr bit (36), /* Specifies record to seek. */ 2 state fixed bin, /* Index that => current state of attachment. */ 2 mount_state fixed bin, /* Save state used to wait for mounts. */ 2 retry_count fixed bin, /* Number of REREADYs we have issued. */ 2 protect_comment char (8), /* Used in disk mount messages. */ 2 flags, ( 3 waiting_for_operator_interrupt bit (1), /* ON => interrupt must come from MPC button. */ 3 pad1 bit (35) ) unaligned, 2 pad_ptr ptr, /* Pad so status queue starts at even offset. */ 2 istatq like istat, /* Our status queue - only 1 entry. */ 2 fs_type_idx fixed bin, /* index into fs_devtype arrays for this device */ 2 n_label fixed bin, /* number of labels */ 2 cur_label fixed bin, /* what label currently checking */ 2 sv (3), /* info on labels */ 3 pvname char (32), /* pv_name found in label */ 3 story char (32), /* Need this in wspace since it is used in different states. */ 2 label_buffer (1024) bit (36); /* Area where we read pack label. */ /* INTERNAL STATIC DATA */ dcl max_num_retries fixed bin /* Number of times we will ready a disk drive. */ internal static init (5); dcl template_idcw bit (36) internal static init ("000000700201"b3); /* Template of the IDCW we will use. */ dcl set_standby_command bit (6) internal static init ("72"b3); dcl request_status_command bit (6) internal static init ("00"b3); dcl read_command bit (6) internal static init ("25"b3); dcl reset_status_command bit (6) internal static init ("40"b3); dcl LABEL_ADDRESS fixed bin (24) internal static init (0); /* EXTERNAL ENTRIES CALLED */ dcl (addr, bin, bit, divide, hbound, null, mod, rel, rtrim, size, substr) builtin; dcl (error_table_$bad_label, error_table_$device_attention, error_table_$invalid_state, error_table_$unable_to_do_io) fixed bin (35) external; dcl admin_gate_$ioi_set_ws_max entry (fixed bin, fixed bin (19), fixed bin (35)); dcl admin_gate_$syserr entry options (variable); dcl countervalidate_label_ entry (ptr, bit (1), bit (1), bit (1)); dcl cv_dec_ entry (char (*), fixed bin); dcl ioa_$rsnnl entry () options (variable); dcl ioi_$connect entry (fixed bin, fixed bin, fixed bin (35)); dcl ioi_$get_special_status entry (fixed bin, bit (1) aligned, bit (36) aligned, fixed bin (35)); dcl ioi_$set_status entry (fixed bin, fixed bin (18), fixed bin, fixed bin (35)); dcl ioi_$workspace entry (fixed bin, ptr, fixed bin (19), fixed bin (35)); dcl rcp_auto_register_ entry (char (*), char (*), char (*), fixed bin (35)); dcl rcp_ioi_attach_ entry (ptr, fixed bin (35)); dcl rcp_mount_timer_$reset entry (bit (18) aligned, fixed bin (35)); dcl rcp_mount_timer_$set entry (bit (18) aligned, bit (1) aligned, fixed bin (35)); /* */ %include rcp_com_seg; %include rcp_resource_types; /* */ %include fs_dev_types; %include fs_vol_label; /* */ %include iom_pcw; %include iom_dcw; /* */ %include ioi_stat; /* */ %include iom_stat; /* */ /* Begin special disk attachment processing. */ rcse_ptr = arg_rcse_ptr; /* Copy argument. */ workspace_ptr = rcse.workspace_ptr; /* Get pointer to current workspace. */ ecode = 0; if workspace_ptr ^= null () /* Have we set up a workspace yet? */ then do; /* Yes. */ ioi_index = rcse.ioi_index; /* Needed to call IOI. */ isp = addr (wspace.istatq); /* Almost every state needs this pointer. */ goto DISK_STATE (wspace.state); /* Go do next step in disk attachment. */ end; /* No workspace implies that this is the first call to rcp_$check_attach. * We must attach the disk drive in ring 0 via IOI. */ call rcp_ioi_attach_ (rcse_ptr, ecode); if ecode ^= 0 /* Any error at all? */ then do; /* Yes, abort attachment. */ arg_ecode = ecode; return; end; ioi_index = rcse.ioi_index; /* Get IOI index for this attachment. */ /* We have just attached the disk drive to IOI. We must get an IOI workspace. * Then we will issue a set standby command in order to power down this drive. * For T&D attachments we don't want to do any of this special processing. */ if rcse.flags.t_and_d /* Is this a special T&D attachment? */ then do; /* Yes, nothing to do. */ rcse.state = 4; /* Tell caller that disk is ready for use. */ arg_ecode = 0; return; end; call admin_gate_$ioi_set_ws_max (ioi_index, size (wspace), ecode); if ecode ^= 0 then do; arg_ecode = ecode; return; end; call ioi_$workspace (ioi_index, workspace_ptr, size (wspace), ecode); if ecode ^= 0 then do; arg_ecode = ecode; return; end; rcse.workspace_ptr = workspace_ptr; /* Save workspace pointer for this attachment. */ wspace.idcw = template_idcw; /* Set up template IDCW. */ call cv_dec_ (substr (rcse.device_name, 6, 2), drive_num); addr (wspace.idcw) -> idcw.device = bit (bin (drive_num, 6)); wspace.state, /* Initialize the state variable that controls all. */ wspace.mount_state, wspace.retry_count = 0; /* Initialize retry count. */ if rcse.flags.writing /* Set up mount comment. */ then wspace.protect_comment = "without"; else wspace.protect_comment = "with"; isp = addr (wspace.istatq); /* Call IOI to set up our status queue. */ call ioi_$set_status (ioi_index, bin (rel (isp), 18), 1, ecode); if ecode ^= 0 then do; /* Can't go on without a status queue. */ arg_ecode = ecode; return; end; if rcse.flags.preloaded | rcse.flags.not_removable_media then do; /* In these cases we do not want to unload the disk */ command = reset_status_command; wspace.state = 3; wspace.mount_state = 2; end; else do; /* UNLOAD the disk */ command = set_standby_command; wspace.state = 1; end; /* find the device index from model number */ do wspace.fs_type_idx = 1 to hbound (MODELN, 1) while (rcse.model ^= MODELN (wspace.fs_type_idx)); end; wspace.n_label = number_of_sv (wspace.fs_type_idx); if wspace.n_label = 0 then wspace.n_label = 1; wspace.cur_label = 0; istat.completion.st = "0"b; /* Try to put this disk drive in standby or reset status. */ addr (wspace.idcw) -> idcw.command = command; call ioi_$connect (ioi_index, 0, ecode); arg_ecode = ecode; return; /* Somehow or other we are trying to use the workspace out of sequence. */ DISK_STATE (0): /* INVALID STATE */ arg_ecode = error_table_$invalid_state; return; /* The connect issued to perform the set standby has terminated. * We don't really care whether or not the set standby operation worked. * We will tell the operator to mount the disk volume being attached. * Then we will wait for any special interrupts generated by a set standby * or the mounting. */ DISK_STATE (1): /* SET STANDBY TERMINATION */ if ^istat.completion.st /* There should at least be some status. */ then return; /* None, so ignore. */ /* REQUEST DISK MOUNT */ call admin_gate_$syserr (3, "RCP: Mount Pack ^a^[^s^; ^a protect^] on ^a for ^a", rcse.volume_name, rcse.flags.no_protect, wspace.protect_comment, rcse.device_name, rcse.group_id); wspace.state = 2; /* Wait for special for mount. */ wspace.mount_state = 2; /* Remember state used to wait for mount. */ wspace.flags.waiting_for_operator_interrupt = "0"b; /* Turn ON mount timer. */ device_off = rcse.device_off; /* Need RCPD device entry offset. */ write_flag = rcse.flags.writing; /* Pass on write flag. */ call rcp_mount_timer_$set (device_off, write_flag, ecode); arg_ecode = ecode; return; /* We should come here because we have received a special interrupt. * We will check to see if it was generated by the disk mount. * If so bit # 36 should be ON. If not we will wait for another special. */ DISK_STATE (2): /* SPECIAL from MOUNT. */ call ioi_$get_special_status (ioi_index, special_flag, special_status_word, ecode); /* Check for: an error return, not a special, the wrong special, or not a special from the MPC. */ arg_ecode = ecode; if ecode ^= 0 | ^special_flag then return; /* Not a special. */ else do; /* A good special. */ if wspace.flags.waiting_for_operator_interrupt then do; /* Make sure it is from MPC butoon. */ if substr (special_status_word, 20, 1) ^= "1"b | substr (special_status_word, 13, 6) ^= "00"b3 then return; end; /* Make sure it is from MPC button. */ else do; /* Make sure it is from a device. */ if substr (special_status_word, 34, 3) ^= "001"b then return; end; /* Make sure it is from a device. */ end; /* A good special. */ istat.completion.st = "0"b; /* DISK READY - check its current state. */ addr (wspace.idcw) -> idcw.command = request_status_command; call ioi_$connect (ioi_index, 0, ecode); wspace.state = 3; /* Wait for request status to terminate. */ device_off = rcse.device_off; /* Turn OFF mount timer. */ call rcp_mount_timer_$reset (device_off, scode); if ecode = 0 then ecode = scode; rcse.flags.disk_ss_pack = "0"b; rcse.flags.disk_copy_of_ss_pack = "0"b; rcse.flags.disk_io_pack = "0"b; rcse.flags.disk_unregistered = "0"b; rcse.flags.disk_unreadable = "0"b; arg_ecode = ecode; return; /* Check the status from the request (or reset) status operation. We must check that * write protect is set correctly. If everything is OK we will indicate that * the attachment has been completed. */ DISK_STATE (3): /* REQUEST (or RESET) STATUS TERMINATION. */ if ^istat.completion.st /* Is there any status. */ then do; /* No, ignore. */ arg_ecode = 0; return; end; if istat.level ^= 3 /* Is this a terminiate? */ then do; /* No, something wrong. */ call REREADY_DISK ("0"b, "0"b); arg_ecode = ecode; return; end; statp = addr (istat.iom_stat); /* Get pointer to IOM status. */ if istat.completion.er /* Test for error that is not an Attention with Protect. */ then if (status.major ^= "0010"b) | (status.sub ^= "000001"b) then do; /* That is what we have. */ call REREADY_DISK ("0"b, "0"b); arg_ecode = ecode; return; end; /* Now check that the write protect is set correctly. If the user * wants to write then protect should be OFF and the major status should * be Ready and thus there should be no error. If the user does not want * to write then protect should be ON and the status should be Device * Attention with Protect and there should be an error. */ if rcse.flags.writing = istat.completion.er & ^rcse.flags.no_protect /* device has protect sw. */ then do; /* Protect is not set correctly. */ call REREADY_DISK ("0"b, "1"b); arg_ecode = ecode; return; end; /* Set up channel program to read label of pack. We want to verify that this * pack is not a storage system pack. Only users acting as system processes * may mount a storage system pack for user I/O. */ idcwp = addr (wspace.idcw); /* Set up a seek for the label record. */ idcw.command = seek_command (wspace.fs_type_idx); /* Get correct seek type for this dev */ idcw.control = "10"b; /* Continue to next IDCW. */ idcw.count = "0"b; wspace.seek_dcw = "0"b; /* Set up seek DCW. */ dcwp = addr (wspace.seek_dcw); dcw.address = rel (addr (wspace.seek_addr)); dcw.tally = bit (bin (1, 12)); wspace.read_idcw = "0"b; /* Set up to read on record. */ idcwp = addr (wspace.read_idcw); idcw.command = read_command; idcw.device = addr (wspace.idcw) -> idcw.device; idcw.code = "111"b; wspace.read_dcw = "0"b; /* Set up read DCW. */ dcwp = addr (wspace.read_dcw); dcw.address = rel (addr (wspace.label_buffer)); dcw.tally = bit (bin (size (label), 12), 12); LABEL_LOOP: wspace.cur_label = wspace.cur_label + 1; label_address = LABEL_ADDRESS; if wspace.cur_label > 1 then do; record_factor = (wspace.cur_label - 1) * rec_per_cyl (wspace.fs_type_idx); record_offset = mod (label_address, rec_per_cyl (wspace.fs_type_idx)); devadd = ((label_address - record_offset) * wspace.n_label) + record_factor + record_offset; sector = devadd * sect_per_rec (wspace.fs_type_idx); /* raw sector. */ usable_sect_per_cyl = divide (sect_per_cyl (wspace.fs_type_idx), sect_per_rec (wspace.fs_type_idx), 24, 0) * sect_per_rec (wspace.fs_type_idx); unused_sect_per_cyl = sect_per_cyl (wspace.fs_type_idx) - usable_sect_per_cyl; cylinder = divide (sector, usable_sect_per_cyl, 12, 0); sector = sector + cylinder * unused_sect_per_cyl; end; else sector = label_address; wspace.seek_addr = bit (bin (sect_per_rec (wspace.fs_type_idx), 12), 12) || bit (bin (sector, 24), 24); istat.completion.st = "0"b; /* Reset before connect. */ call ioi_$connect (ioi_index, 0, ecode); if ecode ^= 0 then do; /* Bad error from IOI. */ arg_ecode = ecode; return; end; wspace.state = 4; return; /* Check the status from the seek and read request. */ DISK_STATE (4): /* SEEK and READ TERMINATION */ if ^istat.completion.st /* Did we get a real interrupt? */ then do; /* No, ignore. */ arg_ecode = 0; return; end; if istat.level ^= 3 /* Is it a termination? */ then do; /* No, must be an unwanted special. */ call REREADY_DISK ("0"b, "0"b); arg_ecode = ecode; return; end; /* Initialize for label checking. */ wspace.n_label = number_of_sv (wspace.fs_type_idx); if wspace.n_label = 0 then wspace.n_label = 1; labelp = addr (wspace.label_buffer); /* Always need this whether the read was successful or not. */ statp = addr (istat.iom_stat); /* Check termination status. */ if istat.completion.er /* Did we get an error? */ then do; /* An error reading the label. */ if rcse.flags.system then do; /* System processes get a chance to authenticate. */ label.pv_name = ""; /* Blank this for authentication message. */ sv (wspace.cur_label).pvname = label.pv_name; wspace.sv (wspace.cur_label).story = "UnReaDable"; rcse.flags.disk_unreadable = "1"b; end; else do; /* Normal people don't. */ arg_ecode = error_table_$unable_to_do_io; return; end; end; /* An error reading the label. */ else do; /* Check the label. */ sv (wspace.cur_label).pvname = label.pv_name; call countervalidate_label_ (labelp, valid_reg, valid_copy, ss_pack); if ss_pack then do; /* Some sort of known pack. */ if valid_copy then do; wspace.sv (wspace.cur_label).story = "copy of Storage System"; rcse.flags.disk_copy_of_ss_pack = "1"b; end; else if valid_reg then do; wspace.sv (wspace.cur_label).story = "Storage System"; rcse.flags.disk_ss_pack = "1"b; end; else do; wspace.sv (wspace.cur_label).story = "UnReGistered"; rcse.flags.disk_unregistered = "1"b; end; if ^rcse.flags.system then do; /* Normal people can't use these. */ call admin_gate_$syserr (0, "RCP: Rejected mount of ^a volume ^a for ^a.", wspace.sv (wspace.cur_label).story, wspace.sv (wspace.cur_label).pvname, rcse.group_id); arg_ecode = error_table_$bad_label; return; end; /* Normal people can't use these. */ end; /* Some sort of known pack. */ else do; /* An unknown pack. */ label.pv_name = ""; /* Blank this for authentication message. */ wspace.sv (wspace.cur_label).pvname = label.pv_name; wspace.sv (wspace.cur_label).story = "IO"; rcse.flags.disk_io_pack = "1"b; end; /* An unknown pack. */ end; /* Check the label. */ /* Initialize for the authentication state. */ rcse.flags.have_auth = "0"b; rcse.flags.need_auth = "0"b; rcse.flags.auth_set = "0"b; /* Everybody (except the Initializer) must get authenticated at this point. User processes only get here if the label was readable and not a registered or unregistered storage system pack. System processes always get here with an appropriate story. */ if rcse.group_id = "Initializer.SysDaemon.z" then do; /* Set flags so Initializer does'nt need authentication. */ rcse.flags.have_auth = "1"b; rcse.flags.auth_set = "1"b; rcse.flags.need_auth = "0"b; end; /* check for all labels read */ if wspace.cur_label < n_label then do; wspace.state = 3; goto LABEL_LOOP; end; DISK_STATE (5): /* The authentication state. */ wspace.state = 5; labelp = addr (wspace.label_buffer); /* Always need this for messages. */ if rcse.flags.auth_set /* Note that this will be false the first time. */ then do; /* Check whether authenticated or not. */ if rcse.flags.have_auth then do; /* Everything is done. */ device_off = rcse.device_off; call rcp_mount_timer_$reset (device_off, scode); /* Turn OFF mount timer. */ do i = 1 to wspace.n_label; call admin_gate_$syserr (0, "RCP: Mounted ^a volume ^a on ^a^[^a^] for user I/O.", wspace.sv (i).story, wspace.sv (i).pvname, rcse.device_name, (n_label > 1), substr (valid_sv_string, i, 1)); end; call ioi_$set_status (ioi_index, 0, 0, ecode); if ecode ^= 0 then do; /* Bad error. */ arg_ecode = ecode; return; end; /* Bad error. */ if rcse.flags.must_auto_register then do; /* Register this disk_vol to this user. */ call rcp_auto_register_ (VOLUME_TYPE (DISK_VOL_VTYPEX), (rcse.volume_name), (rcse.group_id), ecode); if ecode ^= 0 /* ERROR */ then do; arg_ecode = ecode; return; end; end; rcse.state = 4; wspace.state = 0; arg_ecode = scode; /* Not a fatal error. */ return; end; /* Everything is done. */ else do; /* Bad authentication. */ device_off = rcse.device_off; call rcp_mount_timer_$reset (device_off, scode); /* Turn OFF mount timer. */ call admin_gate_$syserr (3, "RCP: Authentication denied for ^a.", rcse.device_name); if rcse.flags.not_removable_media then do; /* Nothing we can do about this. */ arg_ecode = error_table_$bad_label; return; end; else do; /* Give the operator another chance. */ istat.completion.st = "0"b; addr (wspace.idcw) -> idcw.command = set_standby_command; call ioi_$connect (ioi_index, 0, ecode); /* Ignore the code. */ wspace.retry_count = 0; /* Start over. */ call REREADY_DISK ("1"b, "0"b); /* Authentication denied. */ arg_ecode = ecode; return; end; /* Give the operator another chance. */ end; /* Denied authentication. */ end; /* Check whether authenticated or not. */ else do; /* Tell operator to authenticate, type of pack is already set. */ if ^rcse.flags.need_auth then do; /* Authentication is needed. */ rcse.flags.need_auth = "1"b; rcse.flags.auth_set = "0"b; rcse.flags.have_auth = "0"b; if wspace.n_label > 1 then do; real_story = ""; what_user_asked_for = "0"b; if rcse.flags.disk_ss_pack then do; real_story = "a Storage System"; rcse.flags.disk_copy_of_ss_pack = "0"b; rcse.flags.disk_io_pack = "0"b; rcse.flags.disk_unregistered = "0"b; rcse.flags.disk_unreadable = "0"b; end; else if rcse.flags.disk_copy_of_ss_pack then do; real_story = "a copy of Storage System"; rcse.flags.disk_io_pack = "0"b; rcse.flags.disk_unregistered = "0"b; rcse.flags.disk_unreadable = "0"b; end; else if rcse.flags.disk_unregistered then do; real_story = "an UnReGistered"; rcse.flags.disk_io_pack = "0"b; rcse.flags.disk_unreadable = "0"b; end; else if rcse.flags.disk_io_pack then do; real_story = "an IO"; rcse.flags.disk_unreadable = "0"b; end; else if rcse.flags.disk_unreadable then do; real_story = "an UnReaDable label."; call ioa_$rsnnl ("All ^d subvolume labels are unreadable.", label_story, (0), wspace.n_label); goto TELL_STORY; end; call ioa_$rsnnl ("^a label.", real_story, (0), rtrim (real_story)); label_story = ""; do i = 1 to wspace.n_label; call ioa_$rsnnl ("^a^x^[no label for^s^;^a on^] subvol ^a^[.^;,^]", label_story, (0), rtrim (label_story), (wspace.sv (i).pvname = ""), wspace.sv (i).pvname, valid_sv_array (i - 1), (i = wspace.n_label)); if wspace.sv (i).pvname = rcse.volume_name then what_user_asked_for = "1"b; end; TELL_STORY: call admin_gate_$syserr (3, "RCP: Authenticate ^a for ^a.^/^8xRCP: It has ^a^/^8xRCP:^a^[^s^;^/^8xRCP: User requested volume ^a.^]^[ RCP: WARNING!! IF YOU AUTHENTICATE THIS REQUEST ^a WILL OWN VOLUME ^a!^]", rcse.device_name, rcse.group_id, real_story, label_story, what_user_asked_for, rcse.volume_name, rcse.flags.must_auto_register, rcse.group_id, rcse.volume_name); end; else do; call admin_gate_$syserr (3, "RCP: Authenticate ^a for ^a.^/^8xRCP: It has ^a label ^a.^[^s^;^/^8xRCP: User requested volume ^a.^]^[ RCP: WARNING!! IF YOU AUTHENTICATE THIS REQUEST ^a WILL OWN VOLUME ^a!^]", rcse.device_name, rcse.group_id, wspace.sv (1).story, wspace.sv (1).pvname, wspace.sv (1).pvname = rcse.volume_name, rcse.volume_name, rcse.flags.must_auto_register, rcse.group_id, wspace.sv (1).pvname); end; device_off = rcse.device_off; write_flag = rcse.flags.writing; call rcp_mount_timer_$set (device_off, write_flag, scode); /* Turn ON mount timer. */ arg_ecode = 0; /* Ignore code from timer setting. */ return; end; /* Authentication is needed. */ else do; /* Ignore some spurious wakeups. */ arg_ecode = 0; return; end; end; /* Tell operator to authenticate. */ /* */ REREADY_DISK: procedure (remount_flag, protect_flag); /* This procedure is called to tell the operator to ready the disk again. * We will have to wait for the special again. */ dcl remount_flag bit (1); /* ON => remount, OFF => reready. */ dcl protect_flag bit (1); /* ON => protect wrong, OFF => protect ok. */ if wspace.retry_count = max_num_retries /* Have we retried too many times. */ then do; /* Yes, abort attachment. */ ecode = error_table_$device_attention; return; end; wspace.retry_count = wspace.retry_count + 1; device_off = rcse.device_off; /* Turn ON mount timer. */ write_flag = rcse.flags.writing; /* Pass on write flag. */ call rcp_mount_timer_$set (device_off, write_flag, ecode); if ecode ^= 0 then return; if protect_flag & rcse.flags.opr_int_available then do; /* Must change protect switch on drive. */ call admin_gate_$syserr (3, "RCP: Turn protect switch ^[OFF^;ON^] on drive ^a and then push Operator Interrupt on MPC.", rcse.flags.writing, rcse.device_name); wspace.state = wspace.mount_state; wspace.flags.waiting_for_operator_interrupt = "1"b; end; /* Must change protect switch on drive. */ else do; if remount_flag /* Remount or ready? */ then call admin_gate_$syserr (3, "RCP: Wrong pack (^a) mounted on ^a. Mount pack ^a^[^s^; ^a protect^] on ^a", label.pv_name, rcse.device_name, rcse.volume_name, rcse.flags.no_protect, wspace.protect_comment, rcse.device_name); else call admin_gate_$syserr (3, "RCP: Reready ^a^[^s^; ^a protect^]", rcse.device_name, rcse.flags.no_protect, wspace.protect_comment); wspace.state = wspace.mount_state; /* Wait for special from mount again. */ wspace.flags.waiting_for_operator_interrupt = "0"b; end; end REREADY_DISK; /* BEGIN MESSAGE DOCUMENTATION Message: RCP: Mount Pack PACK with(out) protect on DRIVE for PERSON.PROJ.T S: $beep T: $run M: The user PERSON.PROJ.T has requested the mounting of the user I/O pack named PACK on disk drive DRIVE. A: Mount the pack and make it ready. Set the PROTECT status as specified in the message. Message: RCP: Mount Pack PACK on DRIVE for PERSON.PROJ.T S: $beep T: $run M: The user PERSON.PROJ.T has requested the mounting of the user I/O pack named PACK on disk drive DRIVE. A: Mount the pack and make it ready. Message: RCP: Turn protect switch ON/OFF on drive DRIVE and then push Operator Interrupt on MPC S: $beep T: $run M: The PROTECT status was wrong for DRIVE. M: Correct the PROTECT status and push the Operator Interrupt button on the MPC. Message: RCP: Reready DRIVE with(out) protect S: $beep T: $run M: DRIVE is not ready. A: Make the drive ready. Message: RCP: Reready DRIVE S: $beep T: $run M: DRIVE is not ready. A: Make the drive ready. Message: RCP: Rejected mount of LABEL_TYPE volume NAME for PERSON.PROJ.T S: $info T: $run M: A user has attempted to mount a storage-system format or unreadable (LABEL_TYPE) disk pack for user I/O, without specifying the -sys parameter. Because this might interfere with later storage system use of the pack or compromise system security, this action is not permitted. The user's request is rejected. This error could arise if an operator inadvertently mounted the wrong pack. A: $ignore Message: RCP: Mounted LABEL_TYPE volume NAME on DRIVE for user I/O. S: $info T: $run M: A user has mounted LABEL_TYPE volume NAME as a user I/O disk on DRIVE. The operator has authenticated the mount. A: $ignore Message: RCP: Authenticate DRIVE for PERSON.PROJ.T. .brf RCP: It has LABEL_TYPE label NAME. .brf;.unl 1 (RCP: All N subvolume labels are unreadable.) .brf;.unl 1 (RCP: VOL_NAME on subvol a, VOL_NAME on subvol b, VOL_NAME on subvol c.) .brf;.unl 1 (RCP: User requested volume DIFFERENT_NAME.) S: $beep T: $run M: The operator must verify that the correct pack is mounted on DRIVE. If the DIFFERENT_NAME message indicates that the label on the pack (NAME) is different from the user's request then special instructions from the system administrator must be followed. A: If the pack is correct then use the "x auth" function to input the DRIVE and the authentication code which matches LABEL_TYPE: "ss" for "Storage System" or "copy of Storage System"; "io" for "IO"; "urd" for "UnReaDable"; or "urg" for "UnReGistered". If the wrong pack is mounted then use the authentication code "no". Message: RCP: Authentication denied for DRIVE S: $beep T: $run M: The operator has denied authentication for DRIVE. A: $ignore Message: RCP: Wrong pack (NAME) mounted on DRIVE. Mount pack PACK with(out) protect on DRIVE. S: $beep T: $run M: The operator has denied authentication for a removable disk pack (NAME) on drive DRIVE. The disk drive is put in standby. A: Mount the correct pack PACK with protect as specified and ready drive. Message: RCP: Wrong pack (NAME) mounted on DRIVE. Mount pack PACK on DRIVE. S: $beep T: $run M: The operator has denied authentication for a removable disk pack (NAME) on drive DRIVE. The disk drive is put in standby. A: Mount the correct pack PACK with protect as specified and ready drive. Message: RCP: WARNING!! IF YOU AUTHENTICATE THIS REQUEST WILL OWN VOLUME ! S: $beep T: $run M: This is a warning to the operator. He should be very careful to check the physical label of the volume before authenticating this request. As the message states, if the request is autheticated, will be registered and acquired to . A: Check the physical label of the disk pack. If it is the property of , authenticate the request. If it is not the property of deny the request by typing "x auth no". END MESSAGE DOCUMENTATION */ end rcp_disk_;  rcp_find_.pl1 11/11/89 1110.3r 11/11/89 0805.9 70560 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ rcp_find_: procedure; /* This program is an internal interface of RCP. * Created on 12/04/74 by Bill Silver. * Modified 6/79 by Michael R. Jordan for MR7.0R. * * This program is called to find a device that is already assigned * or attached to the calling process. If successful we will return * the offset of the RCS entry that corresponds to this device. * This program has the following entry points: * 1. attached - Find a device or volume that is attached. * 2. device - Find a device that is assigned given its name. * 3. unattached - Find a device that is assigned and not attached. */ /* ARGUMENT DATA */ dcl arg_device_name char (*); /* (I) name of device to find. */ dcl arg_rcse_ptr ptr; /* (I) Pointer to RCS entry to match. */ dcl arg_trcse_off bit (18); /* (O) Offset of RCS entry that matched. */ /* AUTOMATIC DATA */ dcl match_list (16) ptr; /* List of devices that match. */ dcl assign_off bit (18); /* Offset of first assignment RCS entry. */ dcl attach_off bit (18); /* Offset of first attachment RCS entry. */ dcl device_name char (32); /* Name of device we are looking for. */ dcl match_flag bit (1); /* ON => matching attach RCS entries. */ dcl num_assign fixed bin; /* Number of devices assigned to process. */ dcl num_attach fixed bin; /* Number of devices attached to process. */ dcl num_match fixed bin; /* Number of devices that match. */ dcl trcse_off bit (18); /* Offset of a test RCS entry. */ dcl trcse_ptr ptr; /* Pointer to a test RCS entry. */ /* BASED DATA */ dcl 1 trcse based (trcse_ptr) like rcse aligned; /* Used to reference a test RCS entry. */ /* EXTERNAL ENTRIES CALLED */ dcl (addr, ptr, rel) builtin; dcl rcp_match_$match entry (ptr, ptr) returns (bit (1)); dcl rcp_match_$select entry (ptr, fixed bin, char (*) aligned, ptr); dcl rcp_pointers_$com_seg entry returns (ptr); dcl rcp_rcse_$info entry (bit (18), fixed bin, bit (18), fixed bin); %include rcp_com_seg; attached: entry (arg_rcse_ptr, arg_trcse_off); /* This entry point will look for an attachment RCS entry that matches * the specified RCS entry. If we are looking for a volume or a * specific device and we find either of them then we will have * found a matching entry. */ rcse_ptr = arg_rcse_ptr; /* Get pointer to RCS entry to match. */ rcs_ptr = rcp_pointers_$com_seg (); /* Get list of devices attached to process. */ call rcp_rcse_$info (attach_off, num_attach, assign_off, num_assign); match_flag = "0"b; /* Assume no matching attach entry. */ trcse_off = attach_off; /* Start with first attachment RCS entry. */ do while (trcse_off ^= "0"b); /* Test all attachment RCS entries. */ trcse_ptr = ptr (rcs_ptr, trcse_off); call MATCH_ATTACH; /* See if this RCS entry matches. */ if match_flag /* Did it match? */ then do; /* Yes, return offset of entry that matched. */ arg_trcse_off = trcse_off; return; end; trcse_off = trcse.user_off; /* Get next attachment RCS entry. */ end; arg_trcse_off = "0"b; /* No matching attachment. */ return; device: entry (arg_device_name, arg_trcse_off); /* This entry is called to find a device that is assigned. We are * looking for a specific device name and will not bother matching any * other device characteristics. We do not care if the device is also * attached. */ device_name = arg_device_name; /* Initialize. */ rcs_ptr = rcp_pointers_$com_seg (); /* Get list of devices assigned to process. */ call rcp_rcse_$info (attach_off, num_attach, assign_off, num_assign); trcse_off = assign_off; /* Start with first device in the list. */ do while (trcse_off ^= "0"b); /* Test each device in assignment list. */ trcse_ptr = ptr (rcs_ptr, trcse_off); /* Get pointer to device to test. */ if device_name = trcse.device_name /* Is this the device we are looking for? */ then do; /* Yes, return its RCS entry. */ arg_trcse_off = trcse_off; return; end; trcse_off = trcse.user_off; /* Get next device in assignment list. */ end; arg_trcse_off = "0"b; /* We did not find the specified device. */ return; unattached: entry (arg_rcse_ptr, arg_trcse_off); /* This entry is called to find a device that is assigned to the calling * process but is not attached. The input RCS entry is used to specify * the characteristics of the device that we are looking for. We will * generate a list of all assigned but unattached devices that match * these characteristics. From that list we will choose the best device. */ rcse_ptr = arg_rcse_ptr; /* Initialize. */ rcs_ptr = rcp_pointers_$com_seg (); /* Get list of devices assigned to process. */ call rcp_rcse_$info (attach_off, num_attach, assign_off, num_assign); num_match = 0; /* No devices match yet. */ trcse_off = assign_off; /* Start with first device on the list. */ do while (trcse_off ^= "0"b); /* Test all devices in assignment list. */ trcse_ptr = ptr (rcs_ptr, trcse_off); call MATCH_ASSIGN; /* See if this device matches. */ trcse_off = trcse.user_off; /* Get next device in the assignment list. */ end; if num_match = 0 /* Did any devices match? */ then do; /* No. */ arg_trcse_off = "0"b; return; end; /* Yes, select the best one. */ call rcp_match_$select (addr (match_list), num_match, rcse.volume_name, trcse_ptr); arg_trcse_off = rel (trcse_ptr); /* Return offset of selected device. */ return; MATCH_ATTACH: procedure; /* This procedure is called to see if the current attached device matches * the device name or volume name of the device that is being attached. */ if (rcse.flags.device) & /* Are we looking for a specific device? */ (rcse.device_name = trcse.device_name) then do; /* Yes, and this is it. */ match_flag = "1"b; /* Tell caller that we found a match. */ return; end; if rcse.flags.volume /* Are we looking for a volume? */ then if (rcse.volume_name ^= "scratch") & (rcse.volume_name = trcse.volume_name) then match_flag = "1"b; /* Yes, a non scratch volume that matches. */ end MATCH_ATTACH; MATCH_ASSIGN: procedure; /* This procedure is called to see if the current assigned device matches * the requirements of the specified device. Only devices that are not * attached can match. */ if rcse.dtypex ^= trcse.dtypex /* No match if not same device type. */ then return; if trcse.state ^= 5 /* Is assignment complete? */ then return; /* No, then no match. */ if trcse.rcse_off ^= "0"b /* Is device attached? */ then return; /* Yes, no match. */ /* See if device characteristics match. */ match_flag = rcp_match_$match (rcse_ptr, trcse_ptr); if match_flag /* Do they match? */ then do; /* Yes. */ num_match = num_match + 1; /* Up count of devices that have matched. */ match_list (num_match) = trcse_ptr; /* Save pointer to this device in our list. */ end; end MATCH_ASSIGN; end rcp_find_;  rcp_force_unassign_.pl1 11/11/89 1110.3r 11/11/89 0805.9 80064 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ rcp_force_unassign_: procedure; /* This program implements the rcp_sys_$unassign_device * and rcp_sys_$unassign_process entries. * Created on 12/09/74 by Bill Silver. * Modified 841009 to interface to rcp_control_ instead of * rcp_initializer_... -M. M. Pozzo * * This program contains the following entry points: * 1. unassign_device - Unassign a device regardless of process. * 2. unassign_process - Unassign all resources assigned to a process. */ /* ARGUMENT DATA */ dcl arg_device_name char (*); /* (I) Device name. */ dcl arg_ecode fixed bin (35); /* (O) error_table_ code. */ dcl arg_process_id bit (36) aligned; /* (I) Process ID. */ /* AUTOMATIC DATA */ dcl device_offset bit (18) aligned; dcl lock_flag bit (1) aligned; /* ON => RCS locked. */ dcl process_flag bit (1) aligned; /* ON => using process ID. */ dcl process_id bit (36) aligned; /* Process ID. */ dcl volume_offset bit (18) aligned; dcl operation bit (36) aligned; /* Operation being requested of rcp_control_. */ dcl device_name char (32); /* Device name. */ dcl caller_level fixed bin; /* Caller's validation level. */ dcl bump_message fixed bin (71); /* Cell for device preempt message */ dcl ecode fixed bin (35); /* error_table_ code. */ dcl error_count fixed bin (17); /* error count for device attachments. */ dcl i fixed bin; /* CONSTANT DATA */ dcl BUMP_MESSAGE char (8) static options (constant) init ("RCP_BUMP"); /* EXTERNAL ENTRIES CALLED */ dcl cleanup condition; /* Used to set up cleanup handler. */ dcl (addr, rel, unspec) builtin; dcl error_table_$invalid_state fixed bin (35) external; dcl error_table_$force_unassign fixed bin (35) external; dcl error_table_$resource_unknown fixed bin (35) external; dcl access_operations_$rcp_unassign bit (36) aligned ext static; dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl get_ring_ entry returns (fixed bin); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl rcp_control_ entry (bit (36) aligned, bit (18) aligned, bit (18) aligned, char (*), fixed bin (17), bit (36) aligned, fixed bin (35)); dcl rcp_detach_$force_detach entry (ptr); dcl rcp_lock_$lock entry (ptr, fixed bin (35)); dcl rcp_lock_$unlock entry (ptr); dcl rcp_pointers_$com_seg entry returns (ptr); unassign_device: entry (arg_device_name, arg_ecode); /* This entry point implements the rcp_sys_$unassign_device entry point. * We will call rcp_control_ to unassign the specified device. * If the device is attached we will detach it. We will free any RCS * entries used by this device. */ call SETUP; /* Perform initialization. */ on cleanup begin; /* Cleanup if any trouble. */ call CLEANUP; /* Unlock lock and reset validation level. */ end; call cu_$level_set (get_ring_ ()); /* Set validation level to RCP level. */ device_name = arg_device_name; /* Copy device name argument. */ call FREE_ENTRIES; /* Clean up everything in RCS for device. */ if ecode ^= 0 then goto DEVICE_RETURN; detailed_operation.force = "1"b; call rcp_control_ (operation, volume_offset, device_offset, device_name, error_count, process_id, ecode); DEVICE_RETURN: call cu_$level_set (caller_level); arg_ecode = ecode; return; /* */ unassign_process: entry (arg_process_id, arg_ecode); /* This entry point implements the rcp_sys_$unassign_process entry point. * This entry point will call rcp_initializer_ to unassign everything that * is assigned to the specified process. We will detach any attached * devices and free all RCS entries. */ call SETUP; on cleanup begin; call CLEANUP; end; call cu_$level_set (get_ring_ ()); process_id = arg_process_id; /* Copy argument. */ process_flag = "1"b; /* Using process ID not device name. */ call FREE_ENTRIES; /* Clean up everything in RCS for process. */ if ecode ^= 0 then goto PROCESS_RETURN; detailed_operation.process = "1"b; call rcp_control_ (operation, volume_offset, device_offset, device_name, error_count, process_id, ecode); PROCESS_RETURN: call cu_$level_set (caller_level); arg_ecode = ecode; return; /* */ FREE_ENTRIES: procedure; /* This procedure will test all of the RCS entries. It will * look for entries that it should make free. */ lock_flag = "1"b; /* RCS now locked. */ call rcp_lock_$lock (lock_info_ptr, ecode); if ecode ^= 0 /* Any trouble locking RCS? */ then return; /* Yes. */ do i = 1 to rcs.num_entries; /* Look at all existing RCS entries. */ rcse_ptr = addr (rcs.entry (i)); /* Get pointer to rcs entry. */ call FREE_ENTRY; /* See if we should free this entry. */ end; call rcp_lock_$unlock (lock_info_ptr); lock_flag = "0"b; /* RCS no longer locked. */ end FREE_ENTRIES; /* */ FREE_ENTRY: procedure; /* This procedure is called to see if we should free the specified RCS entry. * We will not free it if it is already free or if it does not match the * specified device name or process ID. If this entry is an attachment entry * that has actually been attached then we will detach it. */ if rcse.free_off ^= "0"b /* Is entry free? */ then return; /* Yes, nothing to do. */ if process_flag /* Are we looking for process IDs? */ then if rcse.process_id ^= process_id then return; /* Yes, but we didn't find one that matched. */ else ; /* Yes, and this one matches. */ else if rcse.device_name ^= device_name then return; /* No, device name, but no match. */ rcse.state = 0; /* Put the device in an invalid state. */ if process_flag then rcse.ecode = error_table_$invalid_state; /* Note the invalid state. */ else rcse.ecode = error_table_$force_unassign; if rcse.kind = 1 /* If attachment we must detach. */ then call rcp_detach_$force_detach (rcse_ptr); /* We have found an entry that we want to make free. We cannot just call * rcp_rcse_$free because we already have RCS locked and because we are * probably not running in the process that had assigned this entry. * If we are deleting all entries of a process we will add this entry to * the free list since we can assume that process' own entry lists are * gone or are at least no longer valid. However, if we are just deleting * an entry for some device it is possible that this entry is still on a * process list. Changing the state of the entry is all that we should do. */ if process_flag /* Using a process ID? */ then do; /* Yes, free entry ourselves. */ rcse.free_off = rcs.first_free_off; rcse.process_id = "0"b; rcse.state = 0; rcs.first_free_off = rel (rcse_ptr); end; else do; /* Send wakeup to cause process attach to fail. */ unspec (bump_message) = unspec (BUMP_MESSAGE); call hcs_$wakeup (rcse.process_id, rcse.event_id, bump_message, ecode); end; end FREE_ENTRY; /* */ SETUP: procedure; /* This procedure is called to set up the data we will need in * the cleanup handler. */ device_offset = ""b; process_flag = ""b; process_id = ""b; volume_offset = ""b; device_name = ""; operation = access_operations_$rcp_unassign; ops_ptr = addr (addr (operation) -> encoded_access_op.detailed_operation); error_count = 0; rcs_ptr = rcp_pointers_$com_seg (); lock_info_ptr = addr (rcs.lock_info); /* Needed to lock and unlock RCS. */ lock_flag = "0"b; /* Lock not locked yet. */ call cu_$level_get (caller_level); /* Get caller's validation level. */ end SETUP; CLEANUP: procedure; /* This procedure is called from the cleanup handlers. * We must reset the validation level to the caller's level. * If we now have RCS locked we must unlock it. */ if lock_flag /* Is RCS locked? */ then call rcp_lock_$unlock (lock_info_ptr); call cu_$level_set (caller_level); end CLEANUP; %include rcp_com_seg; %page; %include access_audit_encoded_op; %page; %include rcp_ops; end rcp_force_unassign_;  rcp_get_scratch_volume_.pl1 11/11/89 1110.3rew 11/11/89 0807.0 44379 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-09-11,Farley), approve(85-09-11,MCR6979), audit(85-12-17,CLJones), install(86-03-21,MR12.0-1033): Add MCA support END HISTORY COMMENTS */ rcp_get_scratch_volume_: proc (a_rcse_ptr, rsc_name, access, code); /* Modified Jan 1985 by Paul Farley to add device_type (8) "MCA". */ /* This procedure is called by RCP to get the name of a scratch volume from Resource Management. If Resource Management is not enabled, we will just return the old " " name and RW access. */ /* PARAMETERS */ dcl a_rcse_ptr ptr; /* Pointer to the RSCE of the volume in question. */ dcl access bit (3) aligned; /* User's access to the reosurce. */ dcl code fixed bin (35); /* Error code. */ dcl rsc_name char (*); /* Name of the resource. */ /* CONSTANTS */ dcl DEN_NAME (5) char (12) varying static internal options (constant) init ( ",den=200", ",den=556", ",den=800", ",den=1600", ",den=6250"); dcl RW bit (3) static internal options (constant) init ("101"b); /* AUTOMATIC STORAGE */ dcl attrs char (256) varying; dcl i fixed bin; dcl model_pic pic "zzz9"; /* BUILTIN FUNTIONS */ dcl addr builtin; dcl null builtin; dcl size builtin; dcl string builtin; /* ERROR CODES */ dcl error_table_$action_not_performed fixed bin (35) ext; /* ENTRIES CALLED */ dcl cv_rcp_attributes_$from_string_rel entry (char (*), (4) bit (72) aligned, char (*) varying, fixed bin (35)); dcl rcp_pointers_$com_seg entry () returns (ptr); dcl rcp_pointers_$data entry () returns (ptr); dcl rcprm_find_resource_$reserve entry (ptr, char (*), ptr, fixed bin (35)); %include rcp_data; %include rcp_com_seg; %include resource_control_desc; %include rcp_resource_types; /* First, get things set up and ready to go. */ rcse_ptr = a_rcse_ptr; rsc_name = ""; /* Good enough for now. */ access = RW; /* " */ code = 0; /* No error. */ rcpd_ptr = rcp_pointers_$data (); rcs_ptr = rcp_pointers_$com_seg (); /* Now, if Resource Management is not enabled, we will simply return. */ if ^rcpd.modes.resource_mgmt_enabled then return; /* Resource Management must be queried. Ask him for a system resource of the type specified. */ Resource_count = 1; begin; dcl garbage (size (resource_descriptions)) bit (36); string (garbage) = "0"b; resource_desc_ptr = addr (garbage); resource_descriptions.version_no = resource_desc_version_1; resource_descriptions.n_items = 1; resource_descriptions.item (1).type = VOLUME_TYPE (rcse.dtypex); goto MAKE_ATTRS (rcse.dtypex); MAKE_ATTRS (1): /* TAPE VOL */ if rcse.qualifiers (1) = 9 then attrs = "track=9"; else attrs = "track=7"; do i = 1 to hbound (DEN_NAME, 1); if substr (unspec (rcse.qualifiers (2)), i, 1) then attrs = attrs || DEN_NAME (i); end; goto MADE_ATTRS; MAKE_ATTRS (2): /* DISK VOL */ model_pic = rcse.model; attrs = "model=" || ltrim (model_pic) || ",use=io"; goto MADE_ATTRS; MAKE_ATTRS (3): /* NOT USED */ MAKE_ATTRS (4): /* NOT USED */ MAKE_ATTRS (5): /* NOT USED */ MAKE_ATTRS (6): /* NOT USED */ MAKE_ATTRS (7): /* NOT USED */ MAKE_ATTRS (8): /* NOT USED */ attrs = ""; MADE_ATTRS: if attrs = "" then resource_descriptions.item (1).desired_attributes (*) = "0"b; else do; call cv_rcp_attributes_$from_string_rel ((VOLUME_TYPE (rcse.dtypex)), resource_descriptions.item (1).desired_attributes (*), attrs, code); if code ^= 0 then return; resource_descriptions.item (1).given.desired_attributes = "1"b; end; call rcprm_find_resource_$reserve (resource_desc_ptr, (rcs.acs_directory), null (), code); if code = error_table_$action_not_performed then code = resource_descriptions.item (1).status_code; if code ^= 0 then return; rsc_name = resource_descriptions.item (1).name; access = resource_descriptions.item (1).rew; end; return; end rcp_get_scratch_volume_;  rcp_ioi_attach_.pl1 11/11/89 1110.3r 11/11/89 0805.5 19476 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ rcp_ioi_attach_: procedure (arg_rcse_ptr, arg_ecode); /* This program is an internal RCP interface. * Created on 07/14/75 by Bill Silver. * * This program will call IOI to attach the device specified in the RCSE. * If the attachment is successful an attachment message will be output * to the operator. If the caller has specified a comment, a note message * will also be output to the operator. */ dcl arg_ecode fixed bin(35); /* (O) Return error_table_ code. */ dcl arg_rcse_ptr ptr; /* (I) Pointer to the RCSE that specifies the device. */ dcl ecode fixed bin(35); /* error_table_ code. */ dcl admin_gate_$ioi_attach entry (fixed bin, char(*) aligned, fixed bin(71), bit(1) aligned, fixed bin(35)); dcl admin_gate_$syserr entry options(variable); dcl rcp_comment_ entry (ptr); /* */ %include rcp_com_seg; /* */ rcse_ptr = arg_rcse_ptr; /* Copy argument. */ call admin_gate_$ioi_attach (rcse.ioi_index, rcse.device_name, rcse.event_id, (rcse.flags.priv), ecode); arg_ecode = ecode; if ecode ^= 0 /* If attachment failed don't output messages. */ then return; call admin_gate_$syserr (0, "RCP: Attached ^a for ^a", rcse.device_name, rcse.group_id); call rcp_comment_ (rcse_ptr); /* Type out any user comment. */ /* BEGIN MESSAGE DOCUMENTATION Message: RCP: Attached DEVICE for PERSON.PROJ.T S: $info T: $run M: The device DEVICE has been attached by the user process. A: $ignore END MESSAGE DOCUMENTATION */ end rcp_ioi_attach_;  rcp_lock_.pl1 11/11/89 1110.3r 11/11/89 0807.0 31338 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ rcp_lock_: procedure; /* This program is an internal RCP interface. * Created on 12/07/74 by Bill Silver. * * This program manages the locks that control RCPD and RCS. * It contains the following two entry points: * 1. lock - Lock the segment. * 2. unlock - Unlock the segment. */ /* ARGUMENT DATA */ dcl arg_ecode fixed bin(35); /* (O) error_table_ code. */ dcl arg_lock_info_ptr ptr; /* (I) Pointer to lock info structure. */ /* AUTOMATIC DATA */ dcl ecode fixed bin(35); /* error_table_ code. */ dcl time_locked fixed bin(71); /* Length of time lock was locked. */ dcl time_waiting fixed bin(71); /* Length of time waiting for lock. */ /* EXTERNAL ENTRIES CALLED */ dcl error_table_$invalid_lock_reset fixed bin(35) external; dcl admin_gate_$guaranteed_eligibility_off entry options(variable); dcl admin_gate_$guaranteed_eligibility_on entry options(variable); dcl rcp_set_lock_$meter_lock entry (bit(36) aligned,fixed bin,fixed bin(71),fixed bin(71),fixed bin(35)); dcl rcp_set_lock_$meter_unlock entry (bit(36) aligned,fixed bin(71),fixed bin(71),fixed bin(35)); /* */ %include rcp_com_seg; /* */ /* This entry point is called to lock the specified lock. Before locking we * must make sure that we will not lose eligibility while the lock is locked. * We will meter any time that we have to wait for the lock. We will wait for * up to 2 minutes for the lock. We will remember when the lock was locked * so we can calculate other meters at unlock time. */ lock: entry (arg_lock_info_ptr,arg_ecode); lock_info_ptr = arg_lock_info_ptr; /* Get pointer to lock info structure. */ call admin_gate_$guaranteed_eligibility_on(); call rcp_set_lock_$meter_lock (lock_info.lock,120,lock_info.time_of_lock,time_waiting,ecode); if (ecode ^= 0) & /* Any trouble locking? */ (ecode ^= error_table_$invalid_lock_reset) then do; /* Yes, lock not locked. */ arg_ecode = ecode; /* Abort lock. */ call admin_gate_$guaranteed_eligibility_off(); return; end; lock_info.num_locks = lock_info.num_locks + 1; if time_waiting ^= 0 then lock_info.num_lock_waits = lock_info.num_lock_waits + 1; lock_info.tot_wait_time = lock_info.tot_wait_time + time_waiting; arg_ecode = 0; return; /* */ /* This entry is called to unlock the specified lock. * After it is unlocked we must turn OFF the guaranteed eligibility. * We will compute the length of time the lock was locked. */ unlock: entry (arg_lock_info_ptr); lock_info_ptr = arg_lock_info_ptr; /* Get pointer to lock info structure. */ call rcp_set_lock_$meter_unlock (lock_info.lock,lock_info.time_of_lock,time_locked,ecode); call admin_gate_$guaranteed_eligibility_off(); lock_info.tot_lock_time = lock_info.tot_lock_time + time_locked; end rcp_lock_;  rcp_lv_.pl1 11/11/89 1110.3rew 11/11/89 0805.5 87984 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ rcp_lv_: procedure; /* This program is an internal interface of RCP. * Created on 04/08/76 by Bill Silver. * Massively reworked on 09/13/76 by Bernard Greenberg for lv_request_. * * This program is call to manage a per-process list of attached logical volumes. * It has the following entry points: * 1. add_lv - Adds a logical volume to the list. * 2. del_lv - Deletes a logical volume from the list. * 3. check - Returns lvid of attached lv. * 4. number - Returns the number of attached lvs. * 5. copy - Copies lv info. */ /* ARGUMENTS */ dcl arg_ecode fixed bin (35); /* (O) error_table_ code. */ dcl arg_event_id fixed bin (71); /* (I) User-supplied event ID */ dcl arg_lvid bit (36) aligned; /* (I/O) Logical volume ID. */ dcl arg_lv_name char (*); /* (I) Logical volume name. */ dcl arg_num_lvs fixed bin; /* (O) Number of attached lvs. */ dcl arg_rcp_id bit (36) aligned; /* (I/O) RCP ID of this LV attachment. */ dcl arg_rli_ptr ptr; /* (I) Pointer to RLI structure. */ dcl arg_statex fixed bin; /* (O) State index. */ /* AUTOMATIC DATA */ dcl ecode fixed bin (35); /* error_table_ code. */ dcl event_id fixed bin (71); /* User's event ID. */ dcl lvid bit (36) aligned; /* LV ID. */ dcl lv_name char (32); /* Name of lv. */ dcl i fixed bin; dcl listx fixed bin; /* LV array index. */ dcl num_lvs fixed bin; /* Number of attached lvs. */ dcl rcp_id bit (36) aligned; /* RCP ID for this LV attachment. */ dcl statex fixed bin; dcl freex fixed bin; /* Free index in lv_list search */ /* BASED DATA */ dcl 1 based_rcp_id based aligned, /* Overlay of RCP ID. */ (2 id_count fixed bin (17), /* Count make ID unique. */ 2 index fixed bin (17)) unal; /* LV list index. */ /* STATIC DATA */ dcl rcp_id_count fixed bin internal static init (0); dcl 1 lv_list (16) aligned internal static, /* Per-process list of attached lvs. */ 2 volume_name char (32), /* LV name. */ 2 lvatep ptr, /* Identifier for lv_request_communicator_ */ 2 r0_accepted bit (1), /* Called attach_lv. */ 2 lvid bit (36), /* UID of lv. */ 2 rcp_id bit (36), /* RCP ID for this LV attachment. */ 2 state_time fixed bin (71); /* Time lv attached for process. */ /* EXTERNAL ENTRIES CALLED */ dcl (addr, hbound) builtin; dcl error_table_$bad_index fixed bin (35) external; dcl error_table_$noalloc fixed bin (35) external; dcl error_table_$resource_assigned fixed bin (35) external; dcl error_table_$resource_unassigned fixed bin (35) external; dcl admin_gate_$attach_lv entry (bit (36) aligned, fixed bin (35)); dcl admin_gate_$detach_lv entry (bit (36) aligned, fixed bin (35)); dcl clock_ entry returns (fixed bin (71)); dcl lv_request_communicator_$alloc_lvate entry (fixed bin (35)) returns (ptr); dcl lv_request_communicator_$abandon entry (ptr); dcl lv_request_communicator_$check entry (ptr, fixed bin, fixed bin (35)); dcl lv_request_communicator_$intent_to_mount entry (ptr, char (*), fixed bin (71), fixed bin (35)); dcl lv_request_communicator_$intent_to_detach entry (ptr, fixed bin (35)); /* */ %include rcp_list_info; /* */ add_lv: entry (arg_lv_name, arg_lvid, arg_event_id, arg_rcp_id, arg_ecode); /* This entry will add the specified logical volume to the list of * attached lvs. The name and ID of this lv will be saved. * An RCP ID will be generated that references this LV attachment. * If valid, the lv_request_mechanism will be informed of the attachment. */ lv_name = arg_lv_name; /* Copy arguments. */ lvid = arg_lvid; event_id = arg_event_id; rcp_id = "0"b; ecode = 0; freex = 0; /* Initialize search through list. */ do i = 1 to hbound (lv_list, 1); /* Look at all possible entries. */ rcp_id = lv_list (i).rcp_id; /* Make sure each entry is valid as it is considered. */ call CHECK_RCP_ID; /* Get latest info. */ if lv_list (i).rcp_id = "0"b /* Is this a free entry? */ then if freex = 0 /* Yes, is it the first free entry? */ then freex = i; /* Yes, remember this entry. */ else; /* No, we already have an entry. */ else if lv_list (i).volume_name = lv_name then do; /* Entry taken, and by this lv. */ ecode = error_table_$resource_assigned; rcp_id = lv_list (i).rcp_id; /* Return so check call can go. */ goto ADD_LV_RETURN; end; end; if freex = 0 /* Did we find a free entry? */ then do; /* No, all taken. */ ecode = error_table_$noalloc; goto ADD_LV_RETURN; end; listx = freex; /* First free is new one. */ rcp_id_count = rcp_id_count + 1; /* Found entry. Gen new RCP ID. */ addr (rcp_id) -> based_rcp_id.id_count = rcp_id_count; addr (rcp_id) -> based_rcp_id.index = listx; lv_list (listx).lvatep = lv_request_communicator_$alloc_lvate (ecode); if ecode ^= 0 then go to ADD_LV_RETURN; call lv_request_communicator_$intent_to_mount (lv_list (listx).lvatep, lv_name, event_id, ecode); /* Fill in entry, send message */ if ecode ^= 0 then go to ADD_LV_RETURN; lv_list (listx).volume_name = lv_name; /* Fill entry with lv info. */ lv_list (listx).r0_accepted = "0"b; /* Haven't checked into ring 0 yet. */ lv_list (listx).lvid = lvid; lv_list (listx).state_time = clock_ (); lv_list (listx).rcp_id = rcp_id; /* This marks entry as being used. */ ADD_LV_RETURN: arg_rcp_id = rcp_id; arg_ecode = ecode; return; /* */ del_lv: entry (arg_rcp_id, arg_ecode); /* This entry is called to remove an lv from the list of attached lvs. */ rcp_id = arg_rcp_id; /* Copy RCP ID argument. */ call CHECK_RCP_ID; /* Check that this RCP ID is valid. */ if ecode = 0 then do; call lv_request_communicator_$intent_to_detach (lv_list (listx).lvatep, ecode); lv_list (listx).rcp_id = "0"b; /* free local entry */ ecode = 0; /* Dont care */ end; arg_ecode = ecode; return; check: entry (arg_rcp_id, arg_lvid, arg_statex, arg_ecode); /* This entry is called to check that the specified (by RCP ID) lv * is really still attached. If it is the ID of the lv will be returned. */ rcp_id = arg_rcp_id; call CHECK_RCP_ID; /* Check that this RCP ID is valid. */ if ecode = 0 then arg_lvid = lv_list (listx).lvid; /* Get lv ID. */ else arg_lvid = "0"b; if ecode = 0 & statex = 0 then if ^lv_list (listx).r0_accepted then do; call admin_gate_$attach_lv (lv_list (listx).lvid, ecode); if ecode = 0 then lv_list (listx).r0_accepted = "1"b; end; arg_ecode = ecode; arg_statex = statex; return; /* */ number: entry (arg_num_lvs); /* This entry returns the current number of attached lvs. */ num_lvs = 0; /* Init. */ do i = 1 to hbound (lv_list, 1); /* Test all possible entries. */ rcp_id = lv_list (i).rcp_id; call CHECK_RCP_ID; /* Get latest info on validity. */ if lv_list (i).rcp_id ^= "0"b /* Is this entry being used? */ then num_lvs = num_lvs + 1; /* Yes, there is an attached lv here. */ end; arg_num_lvs = num_lvs; return; copy: entry (arg_rli_ptr); /* This entry is called to fill in info about all attached lvs. */ rli_ptr = arg_rli_ptr; /* Get pointer to RLI structure. */ rli.head.num_lv = hbound (lv_list, 1); /* Set max number for now. */ num_lvs = 0; /* Init to count attached lvs. */ do i = 1 to hbound (lv_list, 1); /* Test all possible entries. */ rcp_id = lv_list (i).rcp_id; call CHECK_RCP_ID; /* Get latest info on validity. */ if lv_list (i).rcp_id ^= "0"b /* Is this entry being used? */ then do; /* Yes, copy info. */ num_lvs = num_lvs + 1; /* Up count. */ lv_ptr = addr (rli.lvs (num_lvs)); lv.volume_name = lv_list (i).volume_name; lv.state_time = lv_list (i).state_time; lv.rcp_id = lv_list (i).rcp_id; end; end; rli.head.num_lv = num_lvs; /* Set real count. */ return; /* */ CHECK_RCP_ID: procedure; /* This internal procedure is called to validate the RCP ID argument. * If it is valid it will return the index to the lv_list entry that * corresponds to the RCP ID. */ listx = addr (rcp_id) -> based_rcp_id.index; /* Get array index. */ if (listx = 0) | /* Is index part of RCP ID valid? */ (listx > hbound (lv_list, 1)) then do; /* No. */ ecode = error_table_$bad_index; return; end; if lv_list (listx).rcp_id = rcp_id /* Is this RCP ID valid? */ then ecode = 0; /* Yes. */ else do; /* Bad, bad */ ecode = error_table_$resource_unassigned; return; end; call lv_request_communicator_$check (lv_list (listx).lvatep, statex, ecode); if ecode ^= 0 then do; /* Invalidate lv_list slot, abandon entry */ if lv_list (listx).r0_accepted then call admin_gate_$detach_lv (lv_list (listx).lvid, (0)); /* Get it out of ring 0. */ call lv_request_communicator_$abandon (lv_list (listx).lvatep); lv_list (listx).rcp_id = "0"b; end; end CHECK_RCP_ID; end rcp_lv_;  rcp_match_.pl1 11/11/89 1110.3rew 11/11/89 0807.0 61479 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-09-11,Farley), approve(85-09-11,MCR6979), audit(85-12-02,CLJones), install(86-03-21,MR12.0-1033): Add MCA support END HISTORY COMMENTS */ rcp_match_: procedure; /* This program is an internal interface of RCP. * Created on 01/29/75 by Bill Silver. * Modified Jan 1985 by Paul Farley to add device_type (8) "MCA". * * This program is called to choose a device that is appropriate for assignment. * It has the following entry points: * 1. match - Given device characteristics that we want to match, see if * a specified test device does match these characteristics. * 2. select - Given a list of devices that match the specified character- * istics, select the best device to assign. */ /* ARGUMENT DATA */ dcl arg_match_list_ptr ptr; /* (I) Pointer to a list of devices that match. */ dcl arg_match_ptr ptr; /* (I/O) I => match, O => select. */ dcl arg_num_match fixed bin; /* (I) Number of devices in match list. */ dcl arg_test_ptr ptr; /* (I) Pointer to a device to test. */ dcl arg_volume_name char (*); /* (I) Volume to be used with assigned device. */ /* AUTOMATIC DATA */ dcl i fixed bin; dcl low_time fixed bin (71); /* Current earliest time. */ dcl match_density bit (4) aligned; /* Density that we must match. */ dcl match_info_ptr ptr; /* Pointer to info that we must match. */ dcl match_list_ptr ptr; /* Pointer to a list of devices that match. */ dcl match_speed bit (3) aligned; /* Speed that we must match. */ dcl num_match fixed bin; /* Number of devices in match list. */ dcl test_density bit (4) aligned; /* Density of device we are testing. */ dcl test_info_ptr ptr; /* Pointer to info about device we are testing. */ dcl test_speed bit (3) aligned; /* Speed of device we are testing. */ dcl volume_name char (32); /* Volume to be used with assigned device. */ /* BASED DATA */ dcl 1 match_info based (match_info_ptr) like rcse aligned; dcl 1 test_info based (test_info_ptr) like rcse aligned; dcl match_list (num_match) ptr based (match_list_ptr); dcl based_density bit (4) aligned based; dcl based_speed bit (3) aligned based; /* EXTERNAL ENTRIES CALLED */ dcl addr builtin; dcl clock builtin; %include rcp_com_seg; /* */ match: entry (arg_match_ptr, arg_test_ptr) returns (bit (1)); /* This entry is called to test if a device matches the specified characteristics. * If it does then we will return a value of "1"b. If it does not match then * we will return "0"b. If a device characteristic is not specified then it is not * used in determining whether or not the device matches. */ match_info_ptr = arg_match_ptr; /* Copy arguments. */ test_info_ptr = arg_test_ptr; if match_info.device_name ^= " " /* Not blank => looking for specific device. */ then if match_info.device_name = test_info.device_name then return ("1"b); /* This is it. */ else return ("0"b); /* No other testing necessary. */ if match_info.model ^= 0 /* If model specified then test. */ then if match_info.model ^= test_info.model then return ("0"b); /* Device model numbers don't match. */ goto DTYPE (match_info.dtypex); /* Match other characteristics based on device type. */ DTYPE (1): /* TAPE */ if match_info.qualifiers (1) ^= 0 /* If tracks specified then test. */ then if match_info.qualifiers (1) ^= test_info.qualifiers (1) then return ("0"b); /* Track types do not match. */ match_density = addr (match_info.qualifiers (2)) -> based_density; test_density = addr (test_info.qualifiers (2)) -> based_density; if (match_density & test_density) ^= match_density then return ("0"b); /* Tape density does not match. */ match_speed = addr (match_info.qualifiers (3)) -> based_speed; test_speed = addr (test_info.qualifiers (3)) -> based_speed; if (match_speed & test_speed) ^= match_speed then return ("0"b); /* Tape speed does not match. */ return ("1"b); /* Everything that had to match did. */ DTYPE (4): /* PRINTER */ do i = 1 to match_info.num_qualifiers; /* Test each qualifying characteristic. */ if match_info.qualifiers (i) ^= 0 /* If characteristic specified then test. */ then if match_info.qualifiers (i) ^= test_info.qualifiers (i) then return ("0"b); /* No match. */ end; return ("1"b); /* Everything that had to match did. */ DTYPE (2): /* DISK */ DTYPE (3): /* CONSOLE */ DTYPE (5): /* PUNCH */ DTYPE (6): /* READER */ DTYPE (7): /* SPECIAL */ DTYPE (8): /* MCA */ return ("1"b); /* No characteristics => match. */ /* */ select: entry (arg_match_list_ptr, arg_num_match, arg_volume_name, arg_match_ptr); /* This entry is called to select the best device to assign from among * a list of devices that match the assignment requirements. If the * assignment is to be made based upon a volume then if one of devices * has that volume mounted we will choose that device. Otherwise, * we will choose the device that has been in its current state the * longest. */ match_list_ptr = arg_match_list_ptr; /* Copy arguments. */ num_match = arg_num_match; volume_name = arg_volume_name; low_time = clock () + 1; /* Start with latest possible time. */ do i = 1 to num_match; /* Test each device that matched. */ match_info_ptr = match_list (i); /* Pointer to device info. */ if (volume_name ^= " ") & /* Are we looking for a volume? */ (volume_name = match_info.volume_name) then do; /* Yes, and we found it. Select this device. */ arg_match_ptr = match_info_ptr; return; end; if match_info.state_time < low_time /* Has device been in this state longer? */ then do; /* Yes, for now select this device. */ test_info_ptr = match_info_ptr; low_time = match_info.state_time; end; end; arg_match_ptr = test_info_ptr; /* No volume found. */ end rcp_match_;  rcp_match_user_name_.pl1 11/11/89 1110.3rew 11/11/89 0807.0 31401 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ rcp_match_user_name_: proc (user_name, match_name) returns (bit (1)); /* This procedure is called by RCP to see if a group_id matches a match string which is a group_id with star components. For example User.Proj.a would match User.*.* or User but not User.Proj.m Written 06/01/78 by Michael R. Jordan */ dcl addr builtin; dcl index builtin; dcl length builtin; dcl match_name char (32) aligned; /* Name in the RCPD. */ dcl substr builtin; dcl user_name char (32) aligned; /* Name of the user. */ dcl 1 user aligned, 2 person char (32), /* Person_id */ 2 project char (32), /* Project_id */ 2 tag char (32); /* Instance tag */ dcl 1 match like user; /* If the strings match, the test succeeds. */ if user_name = match_name then return ("1"b); /* Well, we have to do some work. First parse the two strings and then see if they match. If so the test succeeds. */ call PARSE (user_name, addr (user)); call PARSE (match_name, addr (match)); /* Now test the structures returned. */ if user.person ^= match.person then /* Not the same person. */ if match.person ^= "*" then return ("0"b); /* Nope! */ if user.project ^= match.project then /* Not the same project. */ if match.project ^= "*" then return ("0"b); if user.tag ^= match.tag then /* Not the right tag. */ if match.tag ^= "*" then return ("0"b); /* All matched in some way - succeed! */ return ("1"b); PARSE: proc (s, st_ptr); dcl s char (*) aligned; /* The string to parse. */ dcl st_ptr ptr; /* Ptr to the following structure... */ dcl i fixed bin; /* start of substring */ dcl l fixed bin ; /* length of substring */ dcl 1 st like user based (st_ptr); /* start out with default values for the structure. */ st.person, st.project, st.tag = "*"; /* Now get the Person_id. */ l = index (s, ".")-1; /* length of substring */ if l < 0 then do; /* this is the last substring */ st.person = s; return; end; if l > 0 then /* the substring is not null */ st.person = substr (s, 1, l); /* so use it */ i = l+2; /* update start of next substring */ if i > length (s) then return; /* if there's no more, quit */ l = index (substr (s, i), ".")-1; /* length of substring */ if l < 0 then do; /* this is the last substring */ st.project = substr (s, i); return; end; if l > 0 then /* the substring is not null */ st.project = substr (s, i, l); /* so use it */ i = i+l+1; /* update start of next substring */ if i > length (s) then return; /* no more data */ st.tag = substr (s, i); /* last substring */ return; end PARSE; end rcp_match_user_name_;  rcp_merge_modes.pl1 11/11/89 1110.3r w 11/11/89 0804.6 13878 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_merge_modes: procedure (a_mode1, a_mode2, a_code) returns (bit (3)); /* This program is an internal interface of RCP. * Created 841025 by Maria M. Pozzo * * This program implements the RCP internal subroutine that * will merge two raw modes together to determine an effective * mode. */ /* ARGUMENT DATA */ dcl a_mode1 bit (3); /* (I) Raw mode */ dcl a_mode2 bit (3); /* (I) Raw mode */ dcl a_code fixed bin (35); /* (O) Error code */ /* INTERNAL STATIC DATA */ dcl result_mode bit (3); /* (O) Resulting mode */ /* EXTERNAL STATIC DATA */ dcl error_table_$resource_bad_access fixed bin (35) ext static; result_mode = a_mode1 & a_mode2; if result_mode = N_ACCESS then a_code = error_table_$resource_bad_access; return (result_mode); %page; %include access_mode_values; end rcp_merge_modes;  rcp_message_.pl1 11/11/89 1110.3rew 11/11/89 0805.9 52839 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387), audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056): Correct error message documentation. END HISTORY COMMENTS */ rcp_message_: procedure; /* This program implements the RCP message entry points. * Created on 04/25/75 by Bill Silver. * * This program has the following entry points: * 1. priv - Allows privileged users to send messages to the operator * that involve an attached device. * 2. tape - Generates a tape mount message. */ dcl arg_comment char(*); /* (I) Privileged comment. */ dcl arg_ecode fixed bin(35); /* (O) error_table_ code. */ dcl arg_rcp_id bit(36) aligned; /* (I) RCP ID. */ dcl arg_volume_name char(*); /* (I) Name of reel to be mounted. */ dcl arg_ring_flag bit(1); /* (I) ON => mount with write ring. */ dcl caller_level fixed bin; /* Caller's validation level. */ dcl ecode fixed bin(35); /* error_table_ code. */ dcl rcp_id bit(36) aligned; /* RCP ID. */ dcl volume_name char(32) aligned; /* Tape reel to be mounted. */ dcl ring_comment char(8); /* "with" or "without" ring. */ dcl cleanup condition; /* Used to set up cleanup handler. */ dcl ( error_table_$invalid_state, error_table_$no_operation ) fixed bin(35) external; dcl admin_gate_$syserr entry options(variable); dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl get_ring_ entry returns(fixed bin); dcl rcp_comment_ entry (ptr); dcl rcp_validate_ entry (bit(36) aligned, fixed bin, ptr, fixed bin(35)); /* */ %include rcp_com_seg; /* */ priv: entry (arg_rcp_id, arg_comment, arg_ecode); /* This entry point is called by privileged users in order to display a * comment to the operator. The comment should deal with an attached device. */ call cu_$level_get (caller_level); /* Get caller's validation level. */ on cleanup begin; /* Cleanup if any trouble. */ call cu_$level_set (caller_level); /* Reset validation level. */ end; call cu_$level_set (get_ring_()); /* Set validation level to RCP level. */ rcp_id = arg_rcp_id; /* Get RCP ID. */ call rcp_validate_ (rcp_id, caller_level, rcse_ptr, ecode); if ecode ^= 0 /* Is RCP ID valid? */ then goto PRIV_RETURN; /* No. */ if (rcse.kind ^= 1) | /* Is this an attachment? */ (^rcse.flags.priv) /* and was device attached with privilege? */ then do; /* No, don't display the comment. */ ecode = error_table_$no_operation; goto PRIV_RETURN; end; rcse.caller_comment = arg_comment; /* Copy caller's comment. */ call rcp_comment_ (rcse_ptr); /* Now go display this comment. */ PRIV_RETURN: call cu_$level_set (caller_level); /* Reset caller's validation level. */ arg_ecode = ecode; return; /* */ tape: entry (arg_rcp_id, arg_volume_name, arg_ring_flag, arg_ecode); /* This entry point is called to display a tape mount message to the * operator. This is a temporary feature of RCP that will be deleted * when all callers of tdcm_ stop calling tdcm_$tdcm_message more * than once. */ call cu_$level_get (caller_level); /* Get caller's validation level. */ on cleanup begin; /* Cleanup if any trouble. */ call cu_$level_set (caller_level); /* Reset validation level. */ end; call cu_$level_set (get_ring_()); /* Set validation level to RCP level. */ rcp_id = arg_rcp_id; /* Copy arguments. */ volume_name = arg_volume_name; if arg_ring_flag /* Are we mounting with or without a write ring? */ then ring_comment = "with"; else ring_comment = "without"; call rcp_validate_ (rcp_id, caller_level, rcse_ptr, ecode); if ecode ^= 0 /* Does caller have a right to this device? */ then goto TAPE_RETURN; /* No, something wrong. */ if rcse.dtypex ^= 1 /* Is this a tape device? */ then do; /* No. */ ecode = error_table_$no_operation; goto TAPE_RETURN; end; if (rcse.kind ^= 1) | /* Is tape attached? */ (rcse.state ^= 5) /* And is attachment completed? */ then do; /* No. */ ecode = error_table_$invalid_state; goto TAPE_RETURN; end; rcse.volume_name = volume_name; /* Save this volume name. */ call admin_gate_$syserr (3, "RCP: Mount Reel ^a ^a ring on ^a for ^a (switching volumes).", volume_name, ring_comment, rcse.device_name, rcse.group_id); TAPE_RETURN: call cu_$level_set (caller_level); /* Reset to caller's validation level. */ arg_ecode = ecode; /* BEGIN MESSAGE DOCUMENTATION Message: RCP: Mount Reel REELID with(out) ring on DRIVE for PERSON.PROJ.T (switching volumes). S: $beep T: $run M: A user process has requested the mounting of tape reel REELID on drive DRIVE. A: Locate the requested reel. Check to make sure that the user PERSON.PROJ is allowed to use the reel. Insert or remove a write ring as specified. Mount the reel on the specified drive. If the reel cannot be mounted, either because it cannot be located, access is incorrect, or the drive is down, use the "x deny" function to reject the mount request. END MESSAGE DOCUMENTATION */ end rcp_message_;  rcp_mount_timer_.pl1 11/11/89 1110.3rew 11/11/89 0807.0 89811 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: off */ rcp_mount_timer_: procedure; /* This program implements the RCP mount timer mechanism. * Created on 11/02/76 by Bill Silver. * $account_init by B. Greenberg 8/2/77 */ /****^ HISTORY COMMENTS: 1) change(87-02-10,Farley), approve(87-04-14,MCR7652), audit(87-04-15,Lippard), install(87-04-28,MR12.1-1028): Changed to attempt to locate the attachment RCSE for the device and if found call rcp_comment_ to possibly display the user comment that was displayed with the first mount message. END HISTORY COMMENTS */ /* This program has the following entry points: * 1. init - called by a system process through the rcp_sys_ gate. * It initializes the mount timer mechanism. * 2. check - called by the system process that initialized the mount timer. * It is called through the rcp_sys_ gate. It checks to see * if a mount is pending for the specified drive. If a mount is * pending the operator is told to check on this mount. * 3. set - an internal interface called by rcp_tape_ and rcp_disk_. * It turns ON the mount pending flag for a specified drive * and signals the system process that will check on this mount. * 4. reset - an internal interface called by rcp_tape_ and rcp_disk_. * It turns OFF the mount pending flag for a specified drive. 5. account_init - like $init. Called through rcp_sys_ to set up accounting channel/PID. Here for convenience. */ /* ARGUMENTS */ dcl arg_device_off bit (18) aligned; /* (I) RCPD device entry offset. */ dcl arg_ecode fixed bin (35); /* (O) error_table_ code. */ dcl arg_ev_chan fixed bin (71); /* (I) Mount timer IPC event channel. */ dcl arg_recheck_flag bit (1) aligned; /* (O) ON => check this mount again. */ dcl arg_write_flag bit (1) aligned; /* (I) ON => mounting for writing. */ /* AUTOMATIC DATA */ dcl caller_level fixed bin; /* Caller's validation level. */ dcl device_off bit (18) aligned; /* RCPD device entry offset. */ dcl ecode fixed bin (35); dcl message_buffer fixed bin (71); /* Holds message send to system process. */ dcl message_ptr ptr; /* Pointer for based message structure. */ dcl recheck_flag bit (1); dcl rcsx fixed bin; /* RCS index */ /* BASED DATA */ dcl 1 message based (message_ptr) aligned, /* Mount timer message. */ 2 key char (4), /* Must be "rcmt". */ (2 device_off bit (18), /* RCPD device entry offset. */ 2 mbz bit (18)) unal; /* INTERNAL STATIC DATA */ dcl save_pid bit (36) aligned internal static init ("0"b); /* EXTERNAL DATA */ dcl (addr, fixed, mod, ptr, rel, size) builtin; dcl error_table_$bad_index fixed bin (35) external; dcl error_table_$bad_processid fixed bin (35) external; dcl admin_gate_$syserr entry options (variable); dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl get_process_id_ entry returns (bit (36) aligned); dcl get_ring_ entry returns (fixed bin); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl rcp_comment_ entry (ptr); dcl rcp_pointers_$com_seg entry returns (ptr); dcl rcp_pointers_$data entry returns (ptr); %page;%include rcp_data; %page;%include rcp_com_seg; %page; init: entry (arg_ev_chan, arg_ecode); /* This entry point is called by the system process that will handle * the mount timer wakeups. This entry just has to save the process * ID of this process and the IPC event channel used for the mount timer * wakeups. */ call cu_$level_get (caller_level); /* Save caller's validation level. */ call cu_$level_set (get_ring_ ()); /* Set RCP's validation level. */ rcpd_ptr = rcp_pointers_$data (); /* Get a pointer to RCP_DATA. */ rcpd.mtimer_chan = arg_ev_chan; /* Save event channel and PID. */ rcpd.mtimer_pid = get_process_id_ (); save_pid = rcpd.mtimer_pid; /* Save process ID. */ arg_ecode = 0; call cu_$level_set (caller_level); /* Reset caller's validation level. */ return; %page; account_init: entry (arg_ev_chan, arg_ecode); /* This entry point is called by the system process that will handle * the accounting wakeups. This entry just has to save the process ID * of this process and the IPC event channel used for the accounting wakeups. * It is in this program simply because of its similarity to the $init * entry above: a convenience. */ call cu_$level_get (caller_level); /* Save/restor validation levels */ call cu_$level_set (get_ring_ ()); rcpd_ptr = rcp_pointers_$data (); /* Get a pointer to RCP_DATA. */ rcpd.accounting_chan = arg_ev_chan; /* Copy params. */ rcpd.accounting_pid = get_process_id_ (); arg_ecode = 0; call cu_$level_set (caller_level); return; %page; check: entry (arg_device_off, arg_recheck_flag, arg_ecode); /* This entry point is called by the system process that is handling * mount timer wakeups. It passes in the RCPD device entry offset of * the drive that it wants to check. This entry will check to see if * a mount is now pending for this drive. If so, a message will be sent * to the system operator asking that this mount be checked. The system * process will be told to check on this mount again. */ call cu_$level_get (caller_level); /* Save callers validation level. */ call cu_$level_set (get_ring_ ()); /* Set RCP validation level. */ rcpd_ptr = rcp_pointers_$data (); /* Get pointer to RCPD. */ device_off = arg_device_off; /* Copy argument. */ ecode = 0; /* Initialize variables. */ recheck_flag = "1"b; if rcpd.mtimer_pid = "0"b /* Have we been initialized yet? */ then goto CHECK_RETURN; /* No, just return. */ if rcpd.mtimer_pid ^= save_pid /* Caller must be process that initialized. */ then do; /* But it isn't. */ ecode = error_table_$bad_processid; goto CHECK_RETURN; end; /* Validate device entry offset. */ if (device_off < rel (addr (rcpd.device))) | (device_off >= rel (addr (rcpd.volume))) | (mod ((fixed (device_off, 18) - fixed (rel (addr (rcpd.device)), 18)), size (device)) ^= 0) then do; /* Offset not for a real entry. */ ecode = error_table_$bad_index; goto CHECK_RETURN; end; device_ptr = ptr (rcpd_ptr, device_off); /* Ok now to get ptr to device entry. */ if device.dtypex > 2 /* Device must be a tape or disk drive. */ then do; /* No, it is some other type of device. */ ecode = error_table_$bad_index; goto CHECK_RETURN;; end; recheck_flag = device.flags.mounting; /* ON => a mount is pending. */ if recheck_flag then do; /* Is there a mount pending? */ call admin_gate_$syserr (3, "RCP: Check Mount of ^[scratch^s^;^a^]^[ for writing^] on ^a for ^a", (device.volume_name = ""), device.volume_name, device.flags.writing, device.device_name, device.group_id); rcs_ptr = rcp_pointers_$com_seg (); do rcsx = 1 to rcs.num_entries; rcse_ptr = addr (rcs.entry (rcsx)); if rcse.state ^= 0 then /* not free */ if rcse.kind = 1 then /* attach entry */ if rcse.device_name = device.device_name then do; /* correct device */ call rcp_comment_ (rcse_ptr); /* Type caller's comment. */ goto CHECK_RETURN; end; end; end; CHECK_RETURN: arg_recheck_flag = recheck_flag; /* Return arguments. */ arg_ecode = ecode; call cu_$level_set (caller_level); /* Reset validation level. */ return; %page; set: entry (arg_device_off, arg_write_flag, arg_ecode); /* This entry point is called by RCP within the mounting process. * The mount pending flag is turned ON for the specified device. * A wakeup is sent to the mount timer process. */ rcpd_ptr = rcp_pointers_$data (); /* Get pointer to RCPD. */ device_off = arg_device_off; /* Get RCPD device entry offset. */ device_ptr = ptr (rcpd_ptr, device_off); /* Now get pointer to device entry. */ if rcpd.mtimer_chan = 0 /* Is mount timer process there? */ then do; /* No, nothing to do. */ arg_ecode = 0; return; end; device.flags.writing = arg_write_flag; /* Remember if mounting for writing. */ device.flags.mounting = "1"b; /* Turn ON mount pending flag. */ message_ptr = addr (message_buffer); /* Set up mount timer message. */ message.key = "rcmt"; /* Name of message. */ message.device_off = device_off; /* RCPD devce entry offset. */ message.mbz = "0"b; call hcs_$wakeup (rcpd.mtimer_pid, rcpd.mtimer_chan, message_buffer, ecode); arg_ecode = ecode; return; %page; reset: entry (arg_device_off, arg_ecode); /* This entry is called by RCP within the mounting process to turn OFF * the mount pending flag. */ rcpd_ptr = rcp_pointers_$data (); /* Get pointer to RCPD. */ device_ptr = ptr (rcpd_ptr, arg_device_off); device.flags.mounting = "0"b; /* Mount no longer pending. */ arg_ecode = 0; return; %page; /* BEGIN MESSAGE DOCUMENTATION Message: RCP: Check Mount of REELID {for writing} on DRIVE for PERSON.PROJ.T S: $beep T: $run M: The request to mount tape reel REELID has been unsatisfied for over 4 minutes. A: Mount the reel or use "x deny" to inform the user that the reel cannot be mounted. END MESSAGE DOCUMENTATION */ end rcp_mount_timer_;  rcp_operation_access.pl1 11/11/89 1110.3rew 11/11/89 0807.0 76437 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(87-06-08,Rauschelbach), approve(87-06-26,MCR7713), audit(87-07-08,Farley), install(87-07-15,MR12.1-1041): A check for access when changing potential attributes was added. A fix to make the clear_resource command work was added. END HISTORY COMMENTS */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_operation_access: procedure (a_operation, a_resource_type, a_rm_on, a_effmode, a_error_code); /* This program determines if the subject has enough access to * the object to perform the requested RCP operation. * Created 841109 by Maria M. Pozzo * */ /* ARGUMENT DATA */ dcl a_operation bit (36) aligned; /* (I) Requested RCP operation */ dcl a_resource_type char (32); /* (I) Resource type for requested operation */ dcl a_rm_on bit (1); /* (I) Resource Management enabled */ dcl a_effmode bit (3); /* (I/O) Current effective mode of the subject to the object(I) - resultant mode (O) */ dcl a_error_code fixed bin (35); /* (O) Error code */ /* AUTOMATIC DATA */ dcl is_volume bit (1); dcl rm_on bit (1); /* Resource management enabled */ dcl effmode bit (3); /* Subjects access to object depending on operation */ dcl operation bit (36) aligned; dcl base_op bit (36) aligned; dcl resource_type char (32); /* Resource type */ dcl error_code fixed bin (35); /* Internal error code */ dcl operation_ptr ptr; dcl 1 en_access_op like encoded_access_op based (operation_ptr) aligned; dcl addr builtin; /* EXTERNAL ENTRIES */ dcl error_table_$insufficient_access fixed bin (35) external; dcl error_table_$unsupported_operation fixed bin (35) external; dcl access_operations_$rcp_deregister bit (36) aligned external; dcl access_operations_$rcp_release bit (36) aligned external; dcl access_operations_$rcp_reserve bit (36) aligned external; dcl access_operations_$rcp_preload bit (36) aligned external; dcl access_operations_$rcp_assign_read bit (36) aligned external; dcl access_operations_$rcp_assign_write bit (36) aligned external; dcl access_operations_$rcp_status bit (36) aligned external; dcl access_operations_$rcp_set bit (36) aligned external; dcl access_operations_$rcp_set_access bit (36) aligned external; dcl access_operations_$rcp_clear bit (36) aligned external; dcl access_operations_$rcp_delete_device bit (36) aligned external; dcl access_operations_$rcp_add_device bit (36) aligned external; dcl resource_info_$get_type entry (char (*), bit (1), fixed bin (35)); /* Copy input arguments */ operation = a_operation; base_op = basic_operation (operation); addr (base_op) -> encoded_access_op.detailed_operation = 0; operation_ptr = addr (operation); resource_type = a_resource_type; rm_on = a_rm_on; effmode = a_effmode; /* Initialize local variables */ error_code = 0; call resource_info_$get_type (resource_type, is_volume, error_code); ops_ptr = addr (en_access_op.detailed_operation); /* Is it a volume - most operations require R or RW to volumes */ if is_volume then do; /* Need at least R to reserve a volume. */ /* Need R to assign a volume for reading, need R to preload a volume. */ if base_op = access_operations_$rcp_reserve | base_op = access_operations_$rcp_assign_read | base_op = access_operations_$rcp_preload then do; call require_access (R_ACCESS); goto MAIN_RETURN; end; /* Need at least RW to assign a volume for writing */ else if base_op = access_operations_$rcp_assign_write then do; call require_access (RW_ACCESS); goto MAIN_RETURN; end; end; else do; /* Need at least RW to reserve a device */ /* Need at least RW to assign a device */ /* Need at least RW to preload a device */ /* Need R to add or delete a device, this is a privileged operation. */ if base_op = access_operations_$rcp_reserve | base_op = access_operations_$rcp_assign_write | base_op = access_operations_$rcp_preload then do; call require_access (RW_ACCESS); goto MAIN_RETURN; end; else if base_op = access_operations_$rcp_delete_device | base_op = access_operations_$rcp_add_device then do; call require_access (R_ACCESS); goto MAIN_RETURN; end; end; /* The following operations are not resource-type specific. */ /* SET_ACCESS */ /* There are two kinds of set_access operations. */ /* The first type is the setting of access_class_range or */ /* the potential access_class_range. The call must have been */ /* made through a privileged gate and have REW access. The second */ /* type is setting the acs_path. The caller either 1) must be the */ /* resource owner and have REW access, or 2) have made the call through */ /* a privileged gate and have REW access. */ if base_op = access_operations_$rcp_set_access then do; if detailed_operation.potential_aim_range | detailed_operation.aim_range then if detailed_operation.priv_gate_call then call require_access (REW_ACCESS); else error_code = error_table_$insufficient_access; else if detailed_operation.acs_path then if detailed_operation.owner | detailed_operation.priv_gate_call then call require_access (REW_ACCESS); else error_code = error_table_$insufficient_access; end; /* SET */ /* There are several other types of Set operations. */ /* Setting of the comment requires E and therefore REW access */ /* Setting of release_lock, lock, location, or charge_type all */ /* require the call be made through a privileged gate and the */ /* user have E and therefore REW access. All other sets require */ /* RW access. */ else if base_op = access_operations_$rcp_set then do; if detailed_operation.comment then call require_access (REW_ACCESS); else if detailed_operation.release_lock | detailed_operation.usage_lock | detailed_operation.location | detailed_operation.charge_type | detailed_operation.potential_attributes then if detailed_operation.priv_gate_call then call require_access (REW_ACCESS); else error_code = error_table_$insufficient_access; else call require_access (RW_ACCESS); end; /* RELEASE */ /* This operation requires 1) the user be the resource owner */ /* and have REW access OR 2) the call be made through a privileged gate */ /* and the user have REW. */ else if base_op = access_operations_$rcp_release then do; if detailed_operation.owner | detailed_operation.priv_gate_call then call require_access (REW_ACCESS); else error_code = error_table_$insufficient_access; end; /* DEREGISTER */ /* Must have REW to deregister or clear a resource. These are privileged operations. */ else if base_op = access_operations_$rcp_deregister | base_op = access_operations_$rcp_clear then call require_access (REW_ACCESS); /* STATUS */ /* Only need R access to status a resource. */ else if base_op = access_operations_$rcp_status then call require_access (R_ACCESS); else error_code = error_table_$unsupported_operation; MAIN_RETURN: if error_code ^= 0 then a_effmode = "000"b; a_error_code = error_code; return; %page; require_access: proc (mode); dcl mode bit (3); if (effmode & mode) = mode then return; else error_code = error_table_$insufficient_access; return; end require_access; %page; basic_operation: proc (oper) returns (bit (36) aligned); dcl oper bit (36) aligned; dcl return_arg bit (36) aligned; return_arg = oper; addr (return_arg) -> encoded_access_op.detailed_operation = 0; return (return_arg); end basic_operation; %page; %include access_audit_encoded_op; %page; %include access_mode_values; %page; %include rcp_ops; %page; %include rcp_resource_types; end rcp_operation_access;  rcp_pointers_.pl1 11/11/89 1110.3rew 11/11/89 0807.0 17892 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ rcp_pointers_: procedure; /* This program is an internal interface of RCP. * Created on 07/31/75 by Bill Silver. * * This program returns pointers to rcp_data or rcp_com_seg. * This program has the following entries: * 1. data - Returns a pointer to rcp_data. * 2. com_seg - Returns a pointer to rcp_com_seg. */ dcl ecode fixed bin(35); dcl com_seg_init_flag bit(1) /* ON => com_seg_ptr initialized. */ internal static init ("0"b); dcl data_init_flag bit(1) /* ON => data_ptr initialized. */ internal static init ("0"b); dcl com_seg_ptr ptr internal static; dcl data_ptr ptr internal static; dcl hcs_$initiate entry (char(*), char(*), char(*), fixed bin(1), fixed bin(2), ptr, fixed bin(35)); /* */ data: entry returns (ptr); if ^data_init_flag /* Have we initiated pointer to rcp_data? */ then do; /* No. */ call hcs_$initiate (">system_library_1", "rcp_data", "", 0, 0, data_ptr, ecode); data_init_flag = "1"b; end; return (data_ptr); com_seg: entry returns (ptr); if ^com_seg_init_flag /* Have we initiated pointer to rcp_com_seg? */ then do; /* No. */ call hcs_$initiate (">system_library_1", "rcp_com_seg", "", 0, 0, com_seg_ptr, ecode); com_seg_init_flag = "1"b; end; return (com_seg_ptr); end rcp_pointers_;  rcp_pre_claim_.pl1 11/11/89 1110.3rew 11/11/89 0806.7 60228 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(87-06-25,Rauschelbach), approve(87-06-29,MCR7736), audit(87-07-21,Farley), install(87-08-06,MR12.1-1063): System error message documentation was added. END HISTORY COMMENTS */ rcp_pre_claim_: proc (a_reservation_id, a_group_id, a_process_id, a_code); /* * This subroutine will implement the privileged pre-claiming of reservations. * This function will only be used by the absentee manager in the * initializer process. * It is needed because when the absentee manager originally makes * the reservation it does not know the process_id of the process * it will create. Because of this it is possible for a different * job with the same group_id to claim the reservation. This problem * is avoided by having the absentee manager call res_pre_claim * Which will fill in the process_id of the job for which the * reservation was really made. */ /* Written by R.J.C. Kissel 5/78. Modfied by R.J.C. Kissel on 1/79 to do proper reservation accounting and log res id. */ /* Arguments */ dcl a_reservation_id fixed bin (71); dcl a_group_id char (*); dcl a_process_id bit (36); dcl a_code fixed bin (35); /* Local Variables */ dcl res_id fixed bin (71); dcl log_res_id char (19); dcl grp_id char (32) aligned; dcl prc_id bit (36); dcl code fixed bin (35); dcl i fixed bin; /* Index in rcpd. */ dcl any_found bit (1); dcl caller_level fixed bin; /* Local Constants */ /* Local Overlays */ /* Include Files */ %include rcp_data; %include rcp_com_seg; %include rcp_account_msg; %include syserr_constants; /* External Entries */ dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl request_id_ entry (fixed bin (71)) returns (char (19)); dcl get_ring_ entry returns (fixed bin); dcl rcp_pointers_$data entry returns (ptr); dcl rcp_pointers_$com_seg entry returns (ptr); dcl rcp_lock_$lock entry (ptr, fixed bin (35)); dcl rcp_lock_$unlock entry (ptr); dcl rcp_match_user_name_ entry (char (32) aligned, char (32) aligned) returns (bit (1)); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl admin_gate_$syserr entry options (variable); /* External Constants */ dcl error_table_$noentry fixed bin (35) external; dcl error_table_$badcall fixed bin (35) external; /* Builtin Functions and Conditions */ dcl (addr, rel, unspec) builtin; dcl (cleanup) condition; res_id = a_reservation_id; grp_id = a_group_id; prc_id = a_process_id; call cu_$level_get (caller_level); on cleanup call cleanup_handler; call cu_$level_set (get_ring_ ()); rcpd_ptr = rcp_pointers_$data (); rcs_ptr = rcp_pointers_$com_seg (); log_res_id = request_id_ (res_id); /* Set this for later use. */ call rcp_lock_$lock (addr (rcpd.lock_info), code); if code ^= 0 then goto BAD_ERROR; /* * Loop through the rcp data base looking for the reservation * id. Then change the entry by adding the process_id and * leaving everything else the same. */ any_found = "0"b; do i = 1 to rcpd.tot_devices; if rcpd.device (i).reservation_id = res_id then do; if ^rcp_match_user_name_ (rcpd.device (i).group_id, grp_id) then goto BAD_GROUP; any_found = "1"b; rcpd.device (i).process_id = prc_id; call ACCOUNT_WAKEUP (addr (rcpd.device (i)), RCP_ACCTMSG_assign); /* Take care of accting when done by the Initializer. */ call admin_gate_$syserr (JUST_LOG, "RCP: Pre-claimed device ^a for ^a (prc_id=^o res_id=^a)", rcpd.device (i).device_name, grp_id, prc_id, log_res_id); end; end; do i = 1 to rcpd.last_volume; if rcpd.volume (i).reservation_id = res_id then do; if ^rcp_match_user_name_ (rcpd.volume (i).group_id, grp_id) then goto BAD_GROUP; any_found = "1"b; rcpd.volume (i).process_id = prc_id; call admin_gate_$syserr (JUST_LOG, "RCP: Pre-claimed volume ^a for ^a (prc_id=^o res_id=^a)", rcpd.volume (i).volume_name, grp_id, prc_id, log_res_id); end; end; if ^any_found then a_code = error_table_$noentry; else a_code = 0; call rcp_lock_$unlock (addr (rcpd.lock_info)); call cu_$level_set (caller_level); return; BAD_ERROR: call cleanup_handler; a_code = code; return; BAD_GROUP: call cleanup_handler; a_code = error_table_$badcall; return; ACCOUNT_WAKEUP: procedure (a_devptr, a_action); /* This procedure is called to format an accounting message, and send it to the * accounting process. If the accounting event channel has not been set up, no message is sent. */ dcl a_devptr ptr; /* Pointer to rcp_data entry */ dcl a_action fixed bin; /* Accounting action */ dcl wakeup_buf fixed bin (71); dcl 1 auto_rcpamsg like rcp_account_msg aligned; unspec (auto_rcpamsg) = "0"b; auto_rcpamsg.device_user_procid = a_devptr -> device.process_id; auto_rcpamsg.rcp_data_relp = rel (a_devptr); auto_rcpamsg.devtype = a_devptr -> device.dtypex; auto_rcpamsg.action = a_action; unspec (wakeup_buf) = unspec (auto_rcpamsg); if rcpd.accounting_chan ^= 0 then call hcs_$wakeup (rcpd.accounting_pid, rcpd.accounting_chan, wakeup_buf, (0)); end ACCOUNT_WAKEUP; cleanup_handler: proc; call rcp_lock_$unlock (addr (rcpd.lock_info)); call cu_$level_set (caller_level); end cleanup_handler; %page; /* BEGIN MESSAGE DOCUMENTATION Message: RCP: Pre-claimed device devX_MM for GRP_ID (prc_id= PRC_ID res_id= RES_ID) S: $log T: $run M: An announcement that the absentee manager has preclaimed a device for its use. A: $ignore Message: RCP: Pre-claimed volume VOL_NAME for GRP_ID (prc_id= PRC_ID res_id= RES_ID) S: $log T: $run M: An announcement that the absentee manager has preclaimed a volume for its use. A: $ignore END MESSAGE DOCUMENTATION */ end rcp_pre_claim_;  rcp_preload_.pl1 11/11/89 1110.3r 11/11/89 0805.5 103491 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_preload_: proc (arg_device_name, arg_volume_name, arg_group_id, arg_ecode); /* This program implements the preload operator command support in ring one. Created on 04/20/78 by Michael R. Jordan Modified on 08/17/78 by Michael R. Jordan Modified 6/79 by Michael R. Jordan to fix misc bugs. Modified 021585 by M. M. Pozzo to interface with rcp_access_kernel_ and general cleanup for B2 effort. */ dcl addr builtin; dcl admin_gate_$syserr options (variable); dcl arg_device_name char (32); /* name of the device */ dcl arg_ecode fixed bin (35); /* status code returned */ dcl arg_group_id char (32); /* name of the user */ dcl arg_volume_name char (32); /* name of the volume */ dcl caller_level fixed bin; /* callers validation level */ dcl cleanup condition; dcl clock builtin; dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl device_name char (8); /* local copy of device name */ dcl device_off bit (18); /* offset of rcpd.device entry */ dcl dtypex fixed bin; /* device type table index */ dcl ecode fixed bin (35); /* local status code */ dcl effmode bit (3); dcl error_table_$device_busy fixed bin (35) ext; dcl error_table_$incorrect_device_type fixed bin (35) ext; dcl error_table_$incomplete_access_name fixed bin (35) ext; dcl error_table_$noarg fixed bin (35) ext; dcl error_table_$resource_unknown fixed bin (35) ext; dcl error_table_$volume_busy fixed bin (35) ext; dcl access_operations_$rcp_preload bit (36) aligned ext static; dcl get_authorization_ entry () returns (bit (72) aligned); dcl get_ring_ entry () returns (fixed bin); dcl group_id char (32); /* local copy of user name */ dcl i fixed bin; dcl null builtin; dcl operation bit (36) aligned; dcl ptr builtin; dcl rel builtin; dcl reg_iocb_ptr ptr; dcl 1 res_info aligned automatic like resource_info; dcl 1 req_info aligned automatic like requestor_info; dcl rcp_access_kernel_ entry (bit (36) aligned, ptr, ptr, bit (3), fixed bin (35)); dcl rcp_lock_$lock entry (ptr, fixed bin (35)); dcl rcp_lock_$unlock entry (ptr); dcl rcp_match_user_name_ entry (char (32), char (32)) returns (bit (1)); dcl rcp_pointers_$data entry () returns (ptr); dcl rcp_unload_$unload_device entry (ptr, bit (1)); dcl record_ptr ptr; dcl this_device_off bit (18); /* device_off for the device being preloaded */ dcl trans_iocb_ptr ptr; dcl volume_off bit (18); dcl volume_name char (32); /* local copy of volume name */ /* CONSTANTS */ dcl DEFAULT_REGISTRY_DIR char (64) internal static options (constant) init (">sc1>rcp"); /* Get the callers validation level and get him set to go. */ call cu_$level_get (caller_level); on cleanup begin; call cu_$level_set (caller_level); end; call cu_$level_set (get_ring_ ()); reg_iocb_ptr, trans_iocb_ptr = null (); ecode = 0; /* Now copy all input arguments. */ device_name = arg_device_name; volume_name = arg_volume_name; group_id = arg_group_id; rcpd_ptr = rcp_pointers_$data (); if ^rcpd.modes.resource_mgmt_enabled then if group_id = "" then do; arg_ecode = error_table_$noarg; return; end; if group_id ^= "" then if incomplete_name (group_id) then do; arg_ecode = error_table_$incomplete_access_name; return; end; /* See if the volume is available */ volume_off = "0"b; do i = 1 to rcpd.last_volume while (volume_off = "0"b); volume_ptr = addr (rcpd.volume (i)); if volume.volume_name = volume_name then volume_off = rel (volume_ptr); end; if volume_off ^= "0"b then do; if volume.state = 2 | volume.state = 3 then do; ecode = error_table_$volume_busy; goto UNLOCK_AND_RETURN; end; if volume.state = 1 | volume.state = 4 then do; if ((group_id ^= "") & (^rcp_match_user_name_ ((volume.group_id), group_id))) | (group_id = "") then do; ecode = error_table_$volume_busy; goto UNLOCK_AND_RETURN; end; end; end; /* Make sure this device type is known before we go any farther. */ do dtypex = 1 to rcpd.tot_dtypes; do device_off = rcpd.dtype (dtypex).first_off repeat device.next_off while (device_off ^= "0"b); device_ptr = ptr (rcpd_ptr, device_off); if device_name = device.device_name then goto FOUND_DEVICE; end; end; ecode = error_table_$resource_unknown; goto RETURN; /* Got the device, now is the volume in use? */ FOUND_DEVICE: if dtypex ^= TAPE_DRIVE_DTYPEX & dtypex ^= DISK_DRIVE_DTYPEX then do; /* Not tape or disk. */ ecode = error_table_$incorrect_device_type; goto RETURN; end; call rcp_lock_$lock (addr (rcpd.lock_info), ecode); if ecode ^= 0 then goto RETURN; if device.flags.attached then do; /* Someone has this one attached! */ ecode = error_table_$device_busy; goto UNLOCK_AND_RETURN; end; goto STATE (device.state); /* Cross-check the device state */ STATE (2): /* DELETED - cannot allow this */ STATE (3): /* STORAGE SYSTEM - this should never happen */ ecode = error_table_$device_busy; goto UNLOCK_AND_RETURN; STATE (1): /* ASSIGNED - make sure this is the right user */ STATE (4): /* RESERVED - ditto */ /* If its not assigned or reserved to this user then it can't be preloaded and if the group_id is "" then we can't tell so deny preload */ if ((group_id ^= "") & (^rcp_match_user_name_ ((device.group_id), group_id))) | (group_id = "") then do; ecode = error_table_$device_busy; goto UNLOCK_AND_RETURN; end; STATE (0): /* FREE - no sweat */ this_device_off = device_off; /* If the volume is free or not in rcp_data yet, see if we have access to it - if we don't, then don't preload it since we can't get it. If the device is free, check it's access as well for the same reason. */ if volume_off = "0"b | volume.state = 0 then do; call setup_kernel_call ((VOLUME_TYPE (device.dtypex)), (volume_name), ecode); if ecode ^= 0 then goto UNLOCK_AND_RETURN; call rcp_access_kernel_ (operation, addr (req_info), addr (res_info), effmode, ecode); if ecode ^= 0 then do; ecode = error_table_$volume_busy; goto UNLOCK_AND_RETURN; end; call cleanup_kernel_call (ecode); end; if device.state = 0 then do; call setup_kernel_call ((DEVICE_TYPE (device.dtypex)), (device_name), ecode); if ecode ^= 0 then goto UNLOCK_AND_RETURN; call rcp_access_kernel_ (operation, addr (req_info), addr (res_info), effmode, ecode); if ecode ^= 0 then do; ecode = error_table_$device_busy; goto UNLOCK_AND_RETURN; end; call cleanup_kernel_call (ecode); end; /* We have all we need. Make the note of this volume on this device. */ device_ptr = ptr (rcpd_ptr, this_device_off); if device.volume_name ^= "" then if device.volume_name ^= volume_name then call rcp_unload_$unload_device (device_ptr, "1"b); device.volume_name = volume_name; if device.state = 0 then do; /* only set if device is free */ device.group_id = group_id; device.state_time = clock (); end; call admin_gate_$syserr (0, "RCP: Preload volume ^a on device ^a^[ for ^a^;^s^].", volume_name, device_name, (group_id ^= ""), group_id); /* Now return to the caller in a proper manner. */ UNLOCK_AND_RETURN: call cleanup_kernel_call (ecode); call rcp_lock_$unlock (addr (rcpd.lock_info)); RETURN: arg_ecode = ecode; call cu_$level_set (caller_level); return; %page; setup_kernel_call: proc (a_resource_type, a_resource_name, a_code); dcl (a_resource_type, a_resource_name) char (*) aligned; dcl a_code fixed bin (35); dcl local_code fixed bin (35); dcl rcprm_registry_util_$grab_transaction_control_file entry (ptr, char (*) aligned, fixed bin (35)); dcl rcprm_registry_util_$grab_registry entry (ptr, char (*) aligned, char (*) aligned, fixed bin (35)); dcl rcprm_registry_util_$find_resource_record entry (ptr, char (*) aligned, ptr, fixed bin (35)); local_code = 0; req_info.user_id = group_id; req_info.current_authorization = get_authorization_ (); req_info.validation_level = caller_level; operation = access_operations_$rcp_preload; if rcpd.modes.resource_mgmt_enabled then do; res_info.registry_dir = DEFAULT_REGISTRY_DIR; call rcprm_registry_util_$grab_transaction_control_file (trans_iocb_ptr, res_info.registry_dir, local_code) ; if local_code ^= 0 then goto SETUP_RETURN; call rcprm_registry_util_$grab_registry (reg_iocb_ptr, res_info.registry_dir, a_resource_type, local_code); if local_code ^= 0 then goto SETUP_RETURN; call rcprm_registry_util_$find_resource_record (reg_iocb_ptr, a_resource_name, record_ptr, local_code); if local_code ^= 0 then goto SETUP_RETURN; res_info.registry_switch_ptr = reg_iocb_ptr; res_info.registry_record_ptr = record_ptr; end; else do; res_info.registry_dir = ""; res_info.registry_switch_ptr, res_info.registry_record_ptr = null (); end; res_info.resource_type = a_resource_type; res_info.resource_name = a_resource_name; SETUP_RETURN: a_code = local_code; end setup_kernel_call; %page; cleanup_kernel_call: proc (a_code); dcl a_code fixed bin (35); dcl local_code fixed bin (35); dcl rcprm_registry_util_$release_transaction_control_file entry (ptr, fixed bin (35)); dcl rcprm_registry_util_$release_registry entry (ptr, fixed bin (35)); local_code = 0; if reg_iocb_ptr ^= null () then call rcprm_registry_util_$release_registry (reg_iocb_ptr, local_code); if trans_iocb_ptr ^= null () then call rcprm_registry_util_$release_transaction_control_file (trans_iocb_ptr, local_code); if local_code ^= 0 then a_code = local_code; end cleanup_kernel_call; %page; incomplete_name: proc (a_group_id) returns (bit (1)); dcl a_group_id char (*); dcl after builtin; if after ((after (a_group_id, ".")), ".") = "" then return ("1"b); else return ("0"b); end incomplete_name; %page; %include rcp_resource_info; %page; %include rcp_requestor_info; %page; %include rcp_com_seg; %page; %include rcp_data; %page; %include rcp_resource_types; %page; /* BEGIN MESSAGE DOCUMENTATION Message: RCP: Preload volume VOLUME on device DEVICE S: $info T: $run M: The operator request to preload has been accepted by RCP. A: Preload the volume in question on the specified device. END MESSAGE DOCUMENTATION */ end rcp_preload_;  rcp_promote_.pl1 11/11/89 1110.3r 11/11/89 0807.0 36027 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ rcp_promote_: procedure (arg_rcp_id, arg_new_level, arg_ecode); /* This program implements the rcp_$promote entry. * Created on 11/14/74 by Bill Silver. * * This procedure is called to change (promote or demote) the caller's * validation level for the specified RCS entry. This validation * level defines the highest ring from which calls can be made to RCP * (and also IOI) that involve this RCS entry. If there is another * RCS entry associated with this one then it will also be promoted. * If an attachment kind of RCS entry is found then IOI will be called * to promote the associated device if the attachment has completed. */ dcl arg_ecode fixed bin(35); /* (O) error_table_ code. */ dcl arg_new_level fixed bin; /* (I) New validation level. */ dcl arg_rcp_id bit(36) aligned; /* (I) RCP ID. */ dcl caller_level fixed bin; /* Caller's validation level. */ dcl ecode fixed bin(35); /* error_table_ code. */ dcl new_level fixed bin; /* New validation level. */ dcl rcp_id bit(36) aligned; /* RCP ID. */ dcl rcse_off bit(18); /* Offset of RCS entry. */ dcl cleanup condition; /* Used to set up cleanup handler. */ dcl ( ptr ) builtin; dcl admin_gate_$ioi_promote entry (fixed bin, fixed bin, fixed bin(35)); dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl get_ring_ entry returns(fixed bin); dcl rcp_validate_ entry (bit(36) aligned, fixed bin, ptr, fixed bin(35)); /* */ %include rcp_com_seg; /* */ rcp_id = arg_rcp_id; /* Copy arguments. */ new_level = arg_new_level; call cu_$level_get (caller_level); /* Save caller's validation level. */ on cleanup begin; /* If trouble reset level. */ call cu_$level_set (caller_level); end; call cu_$level_set (get_ring_()); /* Set validation level to RCP level. */ call rcp_validate_ (rcp_id, caller_level, rcse_ptr, ecode); if ecode ^= 0 /* Can't change level if call is invalid. */ then goto PROMOTE_RETURN; call PROMOTE; /* Promote this RCS entry. */ if ecode ^= 0 then goto PROMOTE_RETURN; if rcse.rcse_off ^= "0"b /* Is there an associated entry? */ then do; /* Yes, promote it too. */ rcse_ptr = ptr(rcse_ptr, rcse.rcse_off); call PROMOTE; end; PROMOTE_RETURN: call cu_$level_set (caller_level); /* Reset validation level. */ arg_ecode = ecode; /* Return whatever code we have. */ return; /* */ PROMOTE: procedure; /* This procedure is called to actually promote an RCS entry. * This involves just setting the caller_level in the entry. * However, if this is a completed attachment entry (thus already * promoted in IOI) then we must call IOI to promote this device * to the new level. An incomplete attachment will not yet be promoted * by IOI in ring 0. We must leave the ring 0 validation level at the * RCP level so the higher ring will not interfere with any RCP I/O. */ rcse.caller_level = new_level; /* Promote RCS entry. */ if rcse.kind ^= 1 /* Is it an attachment kind of entry? */ then return; /* No. */ if rcse.state ^= 5 /* Is device attachment completed? */ then return; /* No, not yet promoted by IOI in ring 0. */ /* OK to promote in ring 0 since promoted once already. */ call admin_gate_$ioi_promote (rcse.ioi_index, new_level, ecode); end PROMOTE; end rcp_promote_;  rcp_rcse_.pl1 11/11/89 1110.3r 11/11/89 0807.0 88389 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ rcp_rcse_: procedure; /* This program is an internal interface of RCP. * Created on 11/20/74 by Bill Silver. * * This program manages the entries in RCS. It also keeps a list of * the RCS entries used by this process. There is a separate list for * attachments and assignments. This program has the following entries: * 1. get - Gets a free entry and assigns it to the calling process. * 2. free - Frees an entry and puts it back onto the free list. * 3. info - Returns the offset of the first entry and the total * number of entries in the attach and assign lists. */ /* ARGUMENT DATA */ dcl arg_assign_off bit(18); /* (O) Offset of first entry in assign list. */ dcl arg_attach_off bit(18); /* (O) Offset of first entry in attach list. */ dcl arg_ecode fixed bin(35); /* (O) error_table_ code. */ dcl arg_num_assign fixed bin; /* (O) Number of assignment RCS entries. */ dcl arg_num_attach fixed bin; /* (O) Number of attachment RCS entries. */ dcl arg_rcse_ptr ptr; /* (I/O) Pointer to the RCSE we are dealing with. */ /* AUTOMATIC DATA */ dcl ecode fixed bin(35); /* error_table_ code. */ dcl frcse_off bit(18); /* Offset of RCS entry being freed. */ dcl id_count fixed bin; /* Unique ID count. */ dcl rcse_off bit(18); /* Offset of specified RCS entry. */ dcl kind fixed bin; /* RCS entry kind. */ dcl trcse_ptr ptr; /* Pointer to template RCSE. */ dcl urcse_off bit(18); /* Offset of next entry on process list. */ /* BASED DATA */ dcl 1 trcse like rcse based(trcse_ptr) aligned; /* Used to copy template RCSE. */ /* INTERNAL STATIC DATA ** Used to keep per process RCP info. */ dcl attach_off bit(18) /* Top of attach RCS entry list for this process. */ internal static init ("0"b); dcl num_attach fixed bin /* Number of attach RCS entries for process. */ internal static init(0); dcl max_attach fixed bin /* Maximum number of attach entries allowed. */ internal static init (16); dcl assign_off bit(18) /* Top of assign list. */ internal static init ("0"b); dcl num_assign fixed bin /* Number of assign entries. */ internal static init (0); dcl max_assign fixed bin /* Max number of assign entries. */ internal static init (16); /* EXTERNAL ENTRIES CALLED */ dcl cleanup condition; /* Cleanup handler needed to reset lock. */ dcl ( addr, null, ptr, rel, string ) builtin; dcl ( error_table_$bad_index, error_table_$fatal_error, error_table_$noalloc ) fixed bin(35) external; dcl clock_ entry returns (fixed bin(71)); dcl rcp_lock_$lock entry (ptr, fixed bin(35)); dcl rcp_lock_$unlock entry (ptr); dcl rcp_pointers_$com_seg entry returns (ptr); /* */ %include rcp_com_seg; /* */ get: entry (arg_rcse_ptr, arg_ecode); /* This entry will get a free RCS entry and assign it to the calling process. * It will initialize the fields in this entry that are common to all kinds * of requests. It will add this entry to the correct list of RCS entries * maintained for this process. */ trcse_ptr = arg_rcse_ptr; /* Get pointer to template RCSE. */ rcs_ptr = rcp_pointers_$com_seg (); /* Get pointer to base of RCS. */ rcse_ptr = null(); /* No entry assigned yet. */ lock_info_ptr = addr(rcs.lock_info); /* Get pointer to lock structure. */ kind = trcse.kind; /* Get kind of RCSE to be allocated. */ if kind = 1 /* Has process RCS entry limit been reached? */ then if num_attach = max_attach then do; /* Yes, too many attach RCS entries. */ arg_ecode = error_table_$noalloc; return; end; else; else if num_assign = max_assign then do; /* Yes, too many assign RCS entries. */ arg_ecode = error_table_$noalloc; return; end; on cleanup begin; /* Must unlock RCS if trouble. */ call rcp_lock_$unlock (lock_info_ptr); end; call rcp_lock_$lock (lock_info_ptr, ecode); if ecode ^= 0 /* Can't get entry if error in locking. */ then goto GET_RETURN; call GET_FREE_ENTRY; /* Get pointer and offset of next free entry. */ if ecode ^= 0 /* Did we get one? */ then do; /* No, unlock RCS. */ call rcp_lock_$unlock (lock_info_ptr); goto GET_RETURN; end; rcse = trcse; /* Copy template RCSE into its real entry slot. */ rcse.free_off = "0"b; /* Not on free list now. */ rcse.state = 1; /* 1 => entry no longer free. */ id_count, /* Get next unique ID index. */ rcs.id_count = rcs.id_count + 1; call rcp_lock_$unlock (lock_info_ptr); revert cleanup; rcse.state_time = clock_(); /* Now fill in other RCS entry fields. */ addr(rcse.rcp_id)->based_rcp_id.id_count = id_count; addr(rcse.rcp_id)->based_rcp_id.rcse_off = rcse_off; /* Put this RCS entry at the top of the correct process entry list. */ if kind = 1 /* Which list should we add it to? */ then do; /* Attachment list. */ rcse.user_off = attach_off; /* Link to previous first entry. */ attach_off = rcse_off; /* Set up new first entry. */ num_attach = num_attach + 1; /* Update count of attach RCS entries. */ end; else do; /* Assignment list. */ rcse.user_off = assign_off; /* Link up the same way. */ assign_off = rcse_off; num_assign = num_assign + 1; end; GET_RETURN: arg_rcse_ptr = rcse_ptr; /* Return arguments. */ arg_ecode = ecode; return; /* */ free: entry (arg_rcse_ptr, arg_ecode); /* This entry will put the specified RCS entry back onto the free list. * It will remove it from the correct RCP entries list maintained for * the process. */ rcse_ptr = arg_rcse_ptr; /* Argument points to specified entry. */ kind = rcse.kind; /* Get entry kind. */ rcs_ptr = ptr(rcse_ptr, "0"b); /* Get pointer to base of RCS. */ lock_info_ptr = addr(rcs.lock_info); frcse_off = rel(rcse_ptr); /* Get offset of RCS entry to be freed. */ urcse_off = rcse.user_off; /* Offset of next RCS entry on process list. */ on cleanup begin; /* Must unlock RCS if trouble. */ call rcp_lock_$unlock (lock_info_ptr); end; call rcp_lock_$lock (lock_info_ptr, ecode); if ecode ^= 0 /* Can't free if there is an error in locking. */ then goto FREE_RETURN; /* Reset entry values and put it back on free list. */ rcse.state = 0; /* Entry free. */ rcse.kind = 0; /* Free => no kind of RCS entry. */ rcse.free_off = rcs.first_free_off; /* Get offset of next free entry. */ rcs.first_free_off = frcse_off; /* Put on top of free list. */ rcse.process_id = "0"b; /* Process no longer owns this entry. */ call rcp_lock_$unlock (lock_info_ptr); revert cleanup; /* Take this entry out of the process list that it is in. */ if kind = 1 /* Which list is it in? */ then do; /* Attach list. */ rcse_off = attach_off; /* Get first attach RCS entry. */ num_attach = num_attach - 1; /* Update count of attach RCS entries. */ end; else do; /* Assign list. */ rcse_off = assign_off; num_assign = num_assign - 1; end; if rcse_off = frcse_off /* Are we freeing first entry on list? */ then do; /* Yes, get new first entry. */ if kind = 1 /* Again, decide which list. */ then attach_off = urcse_off; else assign_off = urcse_off; goto FREE_RETURN; end; do while (rcse_off ^= "0"b); /* Not first entry. Look through list. */ rcse_ptr = ptr(rcs_ptr, rcse_off); /* Get pointer to current entry. */ if rcse.user_off = frcse_off /* Is next entry the one? */ then do; /* Yes, update value in next user offset. */ rcse.user_off = urcse_off; goto FREE_RETURN; end; rcse_off = rcse.user_off; /* No, get next entry in this list. */ end; ecode = error_table_$bad_index; /* Bad trouble, entry not on list. */ FREE_RETURN: arg_ecode = ecode; return; /* */ info: entry (arg_attach_off, arg_num_attach, arg_assign_off, arg_num_assign); /* This entry is called to get the offsets of the first RCS entry * on each of the process lists. It will also return the number * of each kind of RCS entries. */ arg_attach_off = attach_off; /* Just get them from internal static. */ arg_num_attach = num_attach; arg_assign_off = assign_off; arg_num_assign = num_assign; return; GET_FREE_ENTRY: procedure; /* This procedure is called to get the pointer and offset of a free RCS entry. * We will always get the first free entry. If there are no free entries we * will add a new entry to RCS. */ rcse_off = rcs.first_free_off; /* Get offset of first free entry. */ if rcse_off ^= "0"b /* Is there a free entry? */ then do; /* Yes. */ rcse_ptr = ptr(rcs_ptr,rcse_off); /* Get pointer to this free entry. */ rcs.first_free_off = rcse.free_off; /* Get next first free entry. */ return; end; if rcs.num_entries = rcs.max_entries /* No, is there room for another entry? */ then do; /* No, we cannot get a free entry. */ ecode = error_table_$fatal_error; return; end; rcs.num_entries = rcs.num_entries + 1; /* Room for another entry. */ rcse_ptr = addr(rcs.entry(rcs.num_entries)); rcse_off = rel(rcse_ptr); /* Get pointer and offset of new entry. */ end GET_FREE_ENTRY; end rcp_rcse_;  rcp_reconfigure_.pl1 11/11/89 1110.3rew 11/11/89 0805.9 36801 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ rcp_reconfigure_: procedure; /* This program implements the rcp_sys_$delete_device & rcp_sys_$add_device entries. * Created on 12/09/74 by Bill Silver. * Changed on 04/20/76 by Bill Silver for storage system disks. * Modified 6/79 by Michael R. Jordan for MR7.0R. * Modified 841009 to interface to rcp_control_ instead of * rcp_initializer_... - M. M. Pozzo * Modified 841121 to remove initializer variable bug introduced * during auditing (operation set to "" at COMMON)... -M. M. Pozzo * * This program contains the following entry points: * 1. delete_device - Delete a device from the system. * 2. add_device - Add a deleted device back to the system. */ /* ARGUMENT DATA */ dcl arg_device_name char (*); /* (I) Device name. */ dcl arg_ecode fixed bin (35); /* (O) error_table_ code. */ /* AUTOMATIC DATA */ dcl device_offset bit (18) aligned; /* needed by rcp_control_ */ dcl process_id bit (36) aligned; /* needed by rcp_control */ dcl ssys_flag bit (1) aligned; /* ON => storage system disk. */ dcl volume_offset bit (18) aligned; /* needed by rcp_control_ */ dcl device_name char (32); /* Device name. */ dcl operation bit (36) aligned; /* Operation requested of rcp_control_ */ dcl caller_level fixed bin; /* Caller's validation level. */ dcl ecode fixed bin (35); dcl error_count fixed bin (17); /* Errors on device attachment */ /* EXTERNAL ENTRIES CALLED */ dcl cleanup condition; /* Used to set up cleanup handler. */ dcl (addr, substr) builtin; dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl get_ring_ entry returns (fixed bin); dcl mdx$add_del entry (char (*), bit (1) aligned, bit (1) aligned, fixed bin (35)); dcl rcp_control_ entry (bit (36) aligned, bit (18) aligned, bit (18) aligned, char (*), fixed bin (17), bit (36) aligned, fixed bin (35)); dcl access_operations_$rcp_add_device ext static bit (36) aligned; dcl access_operations_$rcp_delete_device ext static bit (36) aligned; /* These two entriy points are called to delete or add a device. * A deleted device cannot be assigned to any process. */ delete_device: entry (arg_device_name, arg_ecode); operation = access_operations_$rcp_delete_device; /* Delete this device. */ goto COMMON; add_device: entry (arg_device_name, arg_ecode); operation = access_operations_$rcp_add_device; /* Add this device. */ COMMON: device_offset = ""b; process_id = ""b; volume_offset = ""b; device_name = ""; error_count = 0; ecode = 0; call cu_$level_get (caller_level); on cleanup begin; call cu_$level_set (caller_level); end; call cu_$level_set (get_ring_ ()); device_name = arg_device_name; /* Get argument. */ if substr (device_name, 1, 3) = "dsk" /* Is this a DISK type device? */ then do; /* Yes, see if it belongs to the storage system. */ call mdx$add_del (device_name, (operation = access_operations_$rcp_add_device), ssys_flag, ecode); if ssys_flag then goto RETURN; /* Is storage system then all done. */ end; call rcp_control_ (operation, volume_offset, device_offset, device_name, error_count, process_id, ecode); RETURN: call cu_$level_set (caller_level); arg_ecode = ecode; return; end rcp_reconfigure_;  rcp_reserve_.pl1 11/11/89 1110.3rew 11/11/89 0805.5 291051 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_reserve_: proc (a_resource_desc_ptr, a_resource_res_ptr, a_code); /* * This subroutine implements reservation in RCP. It takes a * reservation description and a resource description and manipulates * rcp_data to make the reservations. * This is a radical departure from RCP protocol which in the * past required calling rcp_initializer_ to change rcp_data_. */ /* Written by R.J.C. Kissel 5/78. Modified by R.J.C. Kissel 1/79 to add unprivileged user reservations. Modified by R.J.C. Kissel 3/79 to allow multiple density requests. Modified 6/79 by Michael R. Jordan for MR7.0R. Modified 6/81 by C. D. Tavares to make scratch tapes re-usable. Modified 12/84 by Chris Jones for B2 security cleanup. */ /****^ HISTORY COMMENTS: 1) change(85-07-12,Pozzo), approve(86-02-21,MCR7346), audit(86-07-29,Farley), install(86-08-01,MR12.0-1108): Modified to add auditing for denial of reservations of devices requested by name. 2) change(85-07-24,ABall), approve(86-02-21,MCR7346), audit(86-07-29,Farley), install(86-08-01,MR12.0-1108): Fix bug involving validation level not being the caller's before calling rcprm_find_resource_$(reserve reserve_proxy). 3) change(87-06-25,Rauschelbach), approve(87-06-29,MCR7736), audit(87-07-21,Farley), install(87-08-06,MR12.1-1063): System error message documentation was added. END HISTORY COMMENTS */ /* Arguments */ dcl a_resource_desc_ptr ptr; /* The resource description structure. */ dcl a_resource_res_ptr ptr; /* The reservation description structure. */ dcl a_code fixed bin (35); /* A standard system status code. */ /* Local Variables */ /* See the resource_control_desc include file for local declarations of the input argument pointers. */ dcl any_reserved bit (1) aligned; /* Have any reservations been made. (for cleanup). */ dcl attributes char (256) varying; /* Storage for the attributes character string. */ dcl authorization bit (72) aligned; /* Authorization to be used for the reservation. */ dcl caller_level fixed bin; /* Caller's validation level. */ dcl callers_resource_desc_ptr ptr; /* copy of caller supplied pointer */ dcl callers_resource_res_ptr ptr; /* copy of caller supplied pointer */ dcl code fixed bin (35); dcl density bit (5) aligned; /* Density value for a tape drive. */ dcl dtype_idx fixed bin; /* Index into the dtype structure in rcpd. */ dcl i fixed bin; /* Current resource index. */ dcl is_volume bit (1); /* ON => resource type is a volume type */ dcl log_res_id char (19); dcl model fixed bin (35); /* Model number of a resource. */ dcl num_free fixed bin; dcl operation bit (36) aligned; /* RCP operation */ dcl primary_type char (32); dcl process_id bit (36) aligned; dcl 1 req_info aligned like requestor_info; dcl res_by char (32); dcl res_for char (32); /* for cleanup handling. */ dcl res_id fixed bin (71); /* Copies of critical information needed */ dcl 1 res_info aligned like resource_info; dcl registry_directory char (64); /* local var */ dcl ret_ptr ptr; dcl rsc_name char (32); dcl rsc_type char (32); dcl saved_code fixed bin (35); /* so we can remember we saw at least one error */ dcl special_rdesc_ptr ptr; dcl special_resv_ptr ptr; dcl speed bit (3) aligned; /* Allowable speeds */ dcl system bit (1) aligned; /* True if called through rcp_sys_ gate. */ dcl tot_disk_drives fixed bin; /* Number of tdisk drives requested. */ dcl tot_tape_drives fixed bin; /* Number of tape drives requested. */ dcl tracks fixed bin (35); /* Number of tracks for a tape drive. */ dcl system_free_area area based (get_system_free_area_ ()); /* External Entries */ dcl access_audit_r1_$log_general entry options (variable); dcl admin_gate_$syserr entry options (variable); dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl cv_rcp_attributes_$to_string_rel entry (char (*), bit (72) dim (4), char (*) varying, fixed bin (35)); dcl get_authorization_ entry () returns (bit (72) aligned); dcl get_ring_ entry returns (fixed bin); dcl get_process_id_ entry () returns (bit (36)); dcl get_system_free_area_ entry () returns (ptr); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl mode_string_$parse entry (char (*), ptr, ptr, fixed bin (35)); dcl rcp_access_kernel_ entry (bit (36) aligned, ptr, ptr, bit (3), fixed bin (35)); dcl rcp_pointers_$data entry returns (ptr); dcl rcp_pointers_$com_seg entry returns (ptr); dcl rcp_lock_$lock entry (ptr, fixed bin (35)); dcl rcp_lock_$unlock entry (ptr); dcl rcprm_find_resource_$reserve entry (ptr, char (*), ptr, fixed bin (35)); dcl rcprm_find_resource_$reserve_proxy entry (ptr, char (*), ptr, char (*), bit (72) aligned, fixed bin (35)); dcl request_id_ entry (fixed bin (71)) returns (char (19)); dcl resource_info_$get_type entry (char (*), bit (1), fixed bin (35)); dcl resource_info_$get_primary_type entry (char (*), char (*), fixed bin (35)); /* External Constants */ dcl error_table_$bad_conversion fixed bin (35) external; dcl error_table_$badcall fixed bin (35) external; dcl error_table_$resource_unknown fixed bin (35) external; dcl error_table_$reservation_failed fixed bin (35) external; dcl error_table_$unimplemented_version fixed bin (35) external; dcl error_table_$device_limit_exceeded fixed bin (35) external; dcl access_operations_$rcp_reserve bit (36) aligned ext static; /* Builtin Functions and Conditions */ dcl (addr, clock, hbound, lbound, null, ptr, rel, rtrim, size, unspec) builtin; dcl (cleanup) condition; authorization = get_authorization_ (); system = "0"b; goto START; sys: entry (a_resource_desc_ptr, a_resource_res_ptr, a_authorization, a_code); dcl a_authorization bit (72) aligned; authorization = a_authorization; system = "1"b; goto START; START: operation = access_operations_$rcp_reserve; any_reserved = "0"b; rcpd_ptr = null (); rcs_ptr = null (); registry_directory = ">sc1>rcp"; resource_desc_ptr = null (); resource_res_ptr = null (); mode_string_info_ptr = null (); special_rdesc_ptr = null (); special_resv_ptr = null (); call cu_$level_get (caller_level); on cleanup call cleanup_handler; call cu_$level_set (get_ring_ ()); call copy_resource_and_reservation_structures; rcpd_ptr = rcp_pointers_$data (); rcs_ptr = rcp_pointers_$com_seg (); res_for = reservation_description.reserved_for; res_by = reservation_description.reserved_by; res_id = clock (); log_res_id = request_id_ (res_id); process_id = get_process_id_ (); /* * The following code will do some consistency checks and * limit checks on the input structures before actually trying * to make the reservations. */ if ^system & (res_for ^= res_by) then goto BAD_NAME; if resource_descriptions.version_no ^= resource_desc_version_1 | reservation_description.version_no ^= resource_res_version_1 then goto BAD_VERSION; if resource_descriptions.n_items ^= reservation_description.n_items | resource_descriptions.n_items = 0 then goto BAD_CALL; tot_tape_drives = 0; tot_disk_drives = 0; saved_code = 0; do i = 1 to Resource_count; /* Check device limits. */ call resource_info_$get_primary_type ((resource_descriptions.item (i).type), primary_type, code); if code ^= 0 then do; rsc_type = resource_descriptions.item (i).type; saved_code, callers_resource_desc_ptr -> resource_descriptions.item (i).status_code = code; end; else callers_resource_desc_ptr -> resource_descriptions.item (i).type = primary_type; if primary_type = DEVICE_TYPE (TAPE_DRIVE_DTYPEX) then tot_tape_drives = tot_tape_drives + 1; else if primary_type = DEVICE_TYPE (DISK_DRIVE_DTYPEX) then tot_disk_drives = tot_disk_drives + 1; end; /* Check device limits. */ if saved_code ^= 0 then goto BAD_RESOURCE; if ^system then do; /* Check all device usage for this process. */ do device_ptr = ptr (rcpd_ptr, rcpd.dtype (TAPE_DRIVE_DTYPEX).first_off) repeat ptr (device_ptr, device.next_off) while (rel (device_ptr) ^= ""b); if device.state ^= FREE & device.process_id = process_id then tot_tape_drives = tot_tape_drives + 1; end; do device_ptr = ptr (rcpd_ptr, rcpd.dtype (DISK_DRIVE_DTYPEX).first_off) repeat ptr (device_ptr, device.next_off) while (rel (device_ptr) ^= ""b); if device.state ^= FREE & device.process_id = process_id then tot_disk_drives = tot_disk_drives + 1; end; end; /* Check all device usage for this process. */ if rcpd.dtype (TAPE_DRIVE_DTYPEX).max_concurrent < tot_tape_drives | rcpd.dtype (DISK_DRIVE_DTYPEX).max_concurrent < tot_disk_drives then goto TOO_MANY_DEVICES; /* * Process each resource in turn, doing all the work ourselves. * Rcp_initializer_ is not called to manipulate rcp_data. This is a * break with the past protocol for RCP. * The cleanup handler will cancel any reservations already * made if any one fails. This makes the reservation of a group * of resources appear as an indivisible operation to the caller * of this subroutine. */ call rcp_lock_$lock (addr (rcpd.lock_info), code); if code ^= 0 then goto BAD_ERROR; allocate resource_descriptions in (system_free_area) set (special_rdesc_ptr); allocate reservation_description in (system_free_area) set (special_resv_ptr); call copy_rdesc_and_resv (); do i = 1 to resource_descriptions.n_items; special_rdesc_ptr -> resource_descriptions.item (1) = resource_descriptions.item (i); special_resv_ptr -> reservation_description.reservation_group (1) = reservation_description.reservation_group (i); rsc_type = resource_descriptions.item (i).type; rsc_name = resource_descriptions.item (i).name; if rsc_type = DEVICE_TYPE (TAPE_DRIVE_DTYPEX) then dtype_idx = TAPE_DRIVE_DTYPEX; else if rsc_type = DEVICE_TYPE (DISK_DRIVE_DTYPEX) then dtype_idx = DISK_DRIVE_DTYPEX; else if rsc_type = VOLUME_TYPE (TAPE_VOL_VTYPEX) | rsc_type = VOLUME_TYPE (DISK_VOL_VTYPEX) then dtype_idx = 0; else goto BAD_RESOURCE; if dtype_idx ^= 0 then do; /* Reserve a device. */ dtype_ptr = addr (rcpd.dtype (dtype_idx)); call select_device (ret_ptr); if ret_ptr = null then goto RESERVATION_FAILED; device_ptr = ret_ptr; /* The device.group_id will be set later after we know that the reservation is possible. This will avoid destroying information needed for pre-loaded volumes if the reservation fails. */ device.reservation_id = res_id; device.reserved_by = res_by; if system then device.process_id = "0"b; else device.process_id = process_id; device.current_authorization = authorization; device.state_time = clock (); device.state = RESERVED; any_reserved = "1"b; if ^system /* For system, call is in rcp_pre_claim_ */ then call ACCOUNT_WAKEUP (device_ptr, RCP_ACCTMSG_assign); call admin_gate_$syserr (JUST_LOG, "RCP: Reserved device ^a for ^a (id=^a)", device.device_name, res_for, log_res_id); end; /* Reserve a device. */ else do; /* Reserve a volume. */ call select_volume (ret_ptr); if ret_ptr = null then goto RESERVATION_FAILED; volume_ptr = ret_ptr; volume.volume_name = rsc_name; volume.group_id = res_for; do volume.vtypex = lbound (VOLUME_TYPE, 1) to hbound (VOLUME_TYPE, 1) while (rsc_type ^= VOLUME_TYPE (volume.vtypex)); end; /* Look up the volume type index. */ if volume.volume_name = "scratch" then volume.volume_name = ""; volume.reservation_id = res_id; volume.reserved_by = res_by; if system then volume.process_id = "0"b; else volume.process_id = process_id; volume.current_authorization = authorization; volume.state_time = clock (); volume.state = RESERVED; any_reserved = "1"b; call admin_gate_$syserr (JUST_LOG, "RCP: Reserved volume ^a for ^a (id=^a)", volume.volume_name, volume.group_id, log_res_id); end; /* Reserve a volume. */ call copy_back_rdesc_and_resv (i); end; /* do loop */ /* If these reservations would leave too few tape drives for system processes, the reservation must fail. */ num_free = 0; do device_ptr = ptr (rcpd_ptr, rcpd.dtype (TAPE_DRIVE_DTYPEX).first_off) repeat ptr (device_ptr, device.next_off) while (rel (device_ptr) ^= ""b); if device.state = FREE then num_free = num_free + 1; end; if num_free < rcpd.dtype (TAPE_DRIVE_DTYPEX).num_reserved then goto RESERVATION_FAILED; do i = 1 to rcpd.tot_devices; /* Set group id's for a successful reservation. */ if rcpd.device (i).reservation_id = res_id then /* Set the group id and interact with preloaded volumes. */ rcpd.device (i).group_id = res_for; end; call rcp_lock_$unlock (addr (rcpd.lock_info)); call free_storage; callers_resource_res_ptr -> reservation_description.reservation_id = res_id; a_code = 0; /* Everything went all right. */ call cu_$level_set (caller_level); return; approve_schedule: entry (a_resource_desc_ptr, resource_no, registry_dir, reserver_info_ptr, reserver_chain, a_code); /* This entry is called by rcprm_find_resource_$reserve when it wants to ask if its choice of an appropriate and accessible resource happens to be available at the required time. */ /* Currently, only tape or disk volumes will be checked, devices are handled at other places in RCP. */ dcl ( resource_no fixed bin, registry_dir char (*), reserver_info_ptr pointer, reserver_chain bit (18) unaligned ) parameter; dcl error_table_$resource_reserved fixed bin (35) external; resource_desc_ptr = a_resource_desc_ptr; /* special copying not necessary since caller has done it */ rsc_name = resource_descriptions.item (resource_no).name; call resource_info_$get_type ((resource_descriptions.item (resource_no).type), is_volume, code); if code ^= 0 then do; a_code, resource_descriptions.item (resource_no).status_code = code; return; end; if is_volume then do; /* Check rcpdata for these. */ rcpd_ptr = rcp_pointers_$data (); do i = 1 to rcpd.last_volume while (rcpd.volume (i).volume_name ^= rsc_name); end; if i > rcpd.last_volume then a_code = 0; else if rcpd.volume (i).state = FREE then a_code = 0; else a_code = error_table_$resource_reserved; end; /* Check rcp data for these. */ else a_code = 0; return; BAD_CALL: call cleanup_handler; a_code = error_table_$badcall; return; BAD_VERSION: call cleanup_handler; a_code = error_table_$unimplemented_version; return; TOO_MANY_DEVICES: call cleanup_handler; a_code = error_table_$device_limit_exceeded; return; BAD_RESOURCE: call cleanup_handler; a_code = error_table_$resource_unknown; return; BAD_ERROR: call admin_gate_$syserr (JUST_LOG, "RCP: An error locking rcpd for reservation for ^a ^[^s^;^xby^x^a^] (id=^a).", res_for, res_for = res_by, res_by, log_res_id); call cleanup_handler; a_code = code; return; RESERVATION_FAILED: call cleanup_handler; a_code = error_table_$reservation_failed; return; BAD_NAME: call cleanup_handler; a_code = error_table_$reservation_failed; return; BAD_ATTRIBUTE: call cleanup_handler; a_code = error_table_$bad_conversion; return; select_device: proc (dptr); /* Arguments */ dcl dptr ptr; /* Pointer to device entry we eventurally select. */ /* Local Variables */ dcl MAX_AVAILABLE fixed bin (17) static internal options (constant) init (128); dcl 1 AA_array (MAX_AVAILABLE), 2 name char (8), 2 last_time fixed bin (71), 2 dptr ptr; dcl loop fixed bin; dcl current_AA fixed bin; dcl start fixed bin; dcl found bit (1); call get_attr_values (); dptr = null; current_AA = 0; do device_ptr = ptr (rcpd_ptr, dtype.first_off) repeat ptr (device_ptr, device.next_off) while (rel (device_ptr) ^= ""b & (current_AA <= MAX_AVAILABLE)); if device.state = FREE then /* It's available. */ if (model = 0 | device.model = model) then if (tracks = 0 | device.qualifiers (1) = tracks) then if (density = "0"b | (unspec (device.qualifiers (2)) & density) = density) then if (speed = ""b | (unspec (device.qualifiers (3)) & speed) ^= "0"b) then if (rsc_name = "" | device.device_name = rsc_name) then do; start = 1; found = "0"b; do start = 1 to current_AA while (^found); if device.state_time < AA_array.last_time (start) then found = "1"b; end; if found & (start ^= 1) then start = start - 1; do loop = current_AA to start by -1; AA_array.dptr (loop + 1) = AA_array.dptr (loop); AA_array.name (loop + 1) = AA_array.name (loop); AA_array.last_time (loop + 1) = AA_array.last_time (loop); end; AA_array.dptr (start) = device_ptr; AA_array.name (start) = device.device_name; AA_array.last_time (start) = device.state_time; current_AA = current_AA + 1; end; end; /* Now let's see if we have access to any of the AA devices. */ /* The AA_array is sorted with the device used the longest */ /* time ago first. So they will be checked in order of when */ /* they were used last. */ found = "0"b; do loop = 1 to current_AA while (^found); if have_access (AA_array.name (loop)) then found = "1"b; end; /* If we found one that we have access to then it was also audited in */ /* rcprm_find_resource_. If a specific device was not asked for then */ /* no auditing was needed. However, if a specific device was requested */ /* and we did not have access to it then the auditing still needs to be */ /* done. It can't be done in rcprm_find_resource_ since that routine has */ /* no way of knowing if the name it recieves comes from rcp_reserve_ or */ /* the user. So we audit it here. */ if found then dptr = AA_array.dptr (loop - 1); else if rsc_name ^= "" then call audit (rsc_name); end select_device; audit: proc (P_rsc_name); dcl P_rsc_name char (*); dcl 1 auto_event_flags like audit_event_flags aligned; unspec (auto_event_flags) = ""b; auto_event_flags.grant = "0"b; auto_event_flags.priv_op = system; call access_audit_r1_$log_general ("rcp_reserve_", caller_level, unspec (auto_event_flags), access_operations_$rcp_reserve, (rtrim (rsc_type) || " " || P_rsc_name), (error_table_$reservation_failed), null (), 0); return; end audit; %page; select_volume: proc (vptr); /* Arguments */ dcl vptr ptr; /* Pointer to the volume entry we eventually select. */ dcl i fixed bin; /* Index for rcpd. */ vptr = null; if rsc_name = "scratch" then rsc_name = ""; if ^have_access (rsc_name) then return; /* Make sure user has access to this volume. */ do i = 1 to rcpd.last_volume; volume_ptr = addr (rcpd.volume (i)); if volume.volume_name = rsc_name & rsc_name ^= "" then do; if volume.state = FREE then do; vptr = volume_ptr; end; else do; vptr = null; return; end; end; else do; if volume.volume_name = "" & volume.state = FREE then do; if vptr = null then vptr = volume_ptr; end; end; end; if vptr = null then do; if rcpd.last_volume < rcpd.tot_volumes then do; rcpd.last_volume = rcpd.last_volume + 1; vptr = addr (rcpd.volume (rcpd.last_volume)); end; end; end select_volume; have_access: proc (resource_name) returns (bit (1)); dcl resource_name char (*); /* Name of the resource in question. */ /* Local Variables */ dcl actual_access bit (3); dcl local_code fixed bin (35); dcl addr builtin; if rcpd.modes.resource_mgmt_enabled then do; special_rdesc_ptr -> resource_descriptions.item (1).name = resource_name; special_rdesc_ptr -> resource_descriptions.item (1).given.name = "1"b; /**** Set the validation level back up so RCPRM will make the correct access decisions. ****/ call cu_$level_set (caller_level); if system then call rcprm_find_resource_$reserve_proxy (special_rdesc_ptr, registry_directory, special_resv_ptr, (reserved_for), authorization, local_code); else call rcprm_find_resource_$reserve (special_rdesc_ptr, registry_directory, special_resv_ptr, local_code); /**** Now set the validation level back so we can get on with our work. ****/ call cu_$level_set (get_ring_ ()); end; else do; req_info.user_id = res_for; req_info.current_authorization = authorization; req_info.validation_level = caller_level; res_info.registry_dir = ""; res_info.registry_record_ptr, res_info.registry_switch_ptr = null (); res_info.resource_type = rsc_type; res_info.resource_name = resource_name; call rcp_access_kernel_ (operation, addr (req_info), addr (res_info), actual_access, local_code); end; return (local_code = 0); end have_access; get_attr_values: proc; /* This routine takes the caller's attribute string and turns it into a form suitable for the rest of RCP. */ dcl mode_idx fixed bin; model = 0; tracks = 0; density = "0"b; speed = ""b; if resource_descriptions.item (i).given.desired_attributes then do; /* Use what the user set. */ call cv_rcp_attributes_$to_string_rel ((resource_descriptions.item (i).type), (resource_descriptions.item (i).desired_attributes (*)), attributes, code); if code ^= 0 then goto BAD_ERROR; call mode_string_$parse ((attributes), get_system_free_area_ (), mode_string_info_ptr, code); if code ^= 0 then goto BAD_ERROR; do mode_idx = 1 to mode_string_info.number; if ^mode_string_info.modes (mode_idx).numeric_valuep then goto BAD_ATTRIBUTE; if mode_string_info.modes (mode_idx).mode_name = "model" then call model_mode_proc; else if resource_descriptions.item (i).type = DEVICE_TYPE (TAPE_DRIVE_DTYPEX) then do; if mode_string_info.modes (mode_idx).mode_name = "track" then call track_mode_proc; else if mode_string_info.modes (mode_idx).mode_name = "den" then call den_mode_proc; else if mode_string_info.modes (mode_idx).mode_name = "speed" then call speed_mode_proc; end; end; end; /* Use what the user set. */ return; model_mode_proc: proc; if model ^= 0 then goto BAD_ATTRIBUTE; model = mode_string_info.modes (mode_idx).numeric_value; end model_mode_proc; track_mode_proc: proc; if tracks ^= 0 then goto BAD_ATTRIBUTE; tracks = mode_string_info.modes (mode_idx).numeric_value; end track_mode_proc; den_mode_proc: proc; dcl den_conversion_idx fixed bin; dcl den_conversion_table (5) fixed bin internal static options (constant) init (200, 556, 800, 1600, 6250); dcl density_in_bits (5) bit (5) aligned internal static options (constant) init ("10000"b, "01000"b, "00100"b, "00010"b, "00001"b); do den_conversion_idx = lbound (den_conversion_table, 1) to hbound (den_conversion_table, 1) while (mode_string_info.modes (mode_idx).numeric_value ^= den_conversion_table (den_conversion_idx)); end; if den_conversion_idx > hbound (den_conversion_table, 1) then goto BAD_ATTRIBUTE; density = density | density_in_bits (den_conversion_idx); end den_mode_proc; speed_mode_proc: proc; dcl speed_conversion_idx fixed bin; dcl speed_conversion_table (3) fixed bin internal static options (constant) init (75, 125, 200); dcl speed_in_bits (3) bit (3) aligned internal static options (constant) init ("100"b, "010"b, "001"b); do speed_conversion_idx = lbound (speed_conversion_table, 1) to hbound (speed_conversion_table, 1) while (speed_conversion_table (speed_conversion_idx) ^= mode_string_info.modes (mode_idx).numeric_value); end; if speed_conversion_idx > hbound (speed_conversion_table, 1) then goto BAD_ATTRIBUTE; speed = speed | speed_in_bits (speed_conversion_idx); end speed_mode_proc; end get_attr_values; ACCOUNT_WAKEUP: procedure (a_devptr, a_action); /* This procedure is called to format an accounting message, and send it to the * accounting process. If the accounting event channel has not been set up, no message is sent. */ dcl a_devptr ptr; /* Pointer to rcp_data entry */ dcl a_action fixed bin; /* Accounting action */ dcl wakeup_buf fixed bin (71); dcl 1 auto_rcpamsg like rcp_account_msg aligned; unspec (auto_rcpamsg) = "0"b; auto_rcpamsg.device_user_procid = a_devptr -> device.process_id; auto_rcpamsg.rcp_data_relp = rel (a_devptr); auto_rcpamsg.devtype = a_devptr -> device.dtypex; auto_rcpamsg.action = a_action; unspec (wakeup_buf) = unspec (auto_rcpamsg); if rcpd.accounting_chan ^= 0 then call hcs_$wakeup (rcpd.accounting_pid, rcpd.accounting_chan, wakeup_buf, (0)); end ACCOUNT_WAKEUP; cleanup_handler: proc; /* This subroutine will clean up everything and cancel any reservations which may have already been made so that the reservation of a group of resources can appear as an indivisible operation. */ /* * Scan through all device and volume entries cleaning up the ones * with the appropriate reservation_id. We will ignore the group_id * since the reservation_id is assumed to be right. */ call free_storage; if any_reserved then do; do i = 1 to rcpd.tot_devices; if rcpd.device (i).reservation_id = res_id then do; device_ptr = addr (rcpd.device (i)); call admin_gate_$syserr (JUST_LOG, "RCP: Cancelled device ^a for ^a (id=^a)", device.device_name, device.group_id, log_res_id); if device.volume_name = "" then device.group_id = ""; /* Might be preloaded. */ device.reservation_id = 0; device.reserved_by = ""; device.process_id = "0"b; device.state_time = clock (); device.state = FREE; end; end; do i = 1 to rcpd.last_volume; if rcpd.volume (i).reservation_id = res_id then do; volume_ptr = addr (rcpd.volume (i)); call admin_gate_$syserr (JUST_LOG, "RCP: Cancelled volume ^a for ^a (id=^a)", volume.volume_name, volume.group_id, log_res_id); volume.group_id = ""; volume.reservation_id = 0; volume.reserved_by = ""; volume.process_id = "0"b; volume.state_time = clock (); volume.state = FREE; end; end; end; if rcpd_ptr ^= null () then call rcp_lock_$unlock (addr (rcpd.lock_info)); call cu_$level_set (caller_level); if callers_resource_res_ptr ^= null () then callers_resource_res_ptr -> reservation_description.reservation_id = 0b; end cleanup_handler; free_storage: proc; if resource_desc_ptr ^= null () then do; free resource_descriptions; resource_desc_ptr = null (); end; if resource_res_ptr ^= null () then do; free reservation_description; resource_res_ptr = null (); end; if mode_string_info_ptr ^= null () then do; free mode_string_info; mode_string_info_ptr = null (); end; if special_rdesc_ptr ^= null () then do; free special_rdesc_ptr -> resource_descriptions; special_rdesc_ptr = null (); end; if special_resv_ptr ^= null () then do; free special_resv_ptr -> reservation_description; special_resv_ptr = null (); end; end free_storage; copy_resource_and_reservation_structures: proc; /**** Routine to copy the resource and reservation structures from the caller's stack to ours. It is done pretty carefully to ensure that we get a consistent copy (i.e. no fiddling by the caller can cause us to screw up). ****/ dcl based_bits (wordcount) bit (36) aligned based; dcl wordcount fixed bin (21); callers_resource_desc_ptr = a_resource_desc_ptr; callers_resource_res_ptr = a_resource_res_ptr; Resource_count = callers_resource_desc_ptr -> resource_descriptions.n_items; wordcount = size (resource_descriptions); allocate resource_descriptions in (system_free_area); resource_desc_ptr -> based_bits = callers_resource_desc_ptr -> based_bits; resource_descriptions.n_items = Resource_count; /* avoid any tomfoolery on caller's part */ wordcount = size (reservation_description); allocate reservation_description in (system_free_area); resource_res_ptr -> based_bits = callers_resource_res_ptr -> based_bits; end copy_resource_and_reservation_structures; %page; copy_rdesc_and_resv: proc (); special_rdesc_ptr -> resource_descriptions.n_items = 1; special_resv_ptr -> reservation_description.n_items = 1; special_rdesc_ptr -> resource_descriptions.version_no = resource_descriptions.version_no; special_resv_ptr -> reservation_description.version_no = reservation_description.version_no; special_resv_ptr -> reservation_description.reserved_for = reservation_description.reserved_for; special_resv_ptr -> reservation_description.reserved_by = reservation_description.reserved_by; special_resv_ptr -> reservation_description.reservation_id = reservation_description.reservation_id; special_resv_ptr -> reservation_description.group_starting_time = reservation_description.group_starting_time; special_resv_ptr -> reservation_description.asap_duration = reservation_description.asap_duration; special_resv_ptr -> reservation_description.flags = reservation_description.flags; end copy_rdesc_and_resv; %page; copy_back_rdesc_and_resv: proc (ii); dcl ii fixed bin; resource_descriptions.item (ii) = special_rdesc_ptr -> resource_descriptions.item (1); reservation_description.reservation_group (ii) = special_resv_ptr -> reservation_description.reservation_group (1); end copy_back_rdesc_and_resv; %page; %include access_audit_eventflags; %page; %include resource_control_desc; %page; %include rcp_com_seg; %page; %include rcp_data; %page; %include rcp_account_msg; %page; %include rcp_resource_types; %page; %include rcp_requestor_info; %page; %include rcp_resource_info; %page; %include rcp_resource_states; %page; %include mode_string_info; %page; %include syserr_constants; %page; /* BEGIN MESSAGE DOCUMENTATION Message: RCP: Reserved device devX_MM for RESERVER (id=RES_ID) S: $log T: $run M: Device devX_MM has been reserved for RESERVER. A: $ignore Message: RCP: Reserved volume volume_name for RESERVER (id=RES_ID) S: $log T: $run M: Volume volume_name has been reserved for RESERVER. A: $ignore Message: RCP: An error locking rcpd for reservation for RESERVED_FOR by RESERVER [if they're not the same] (id=RES_ID). S: $log T: $run M: An error was found in the locking data for the resource. A: $ignore Message: RCP: Cancelled device devX_MM for GRP_ID (id=RES_ID) S: $log T: $run M: The reservation for the named device has been cancelled. A: $ignore Message: RCP: Cancelled volume volume_name for GRP_ID (id=RES_ID) S: $log T: $run M: The reservation for the named volume has been cancelled. A: $ignore END MESSAGE DOCUMENTATION */ end rcp_reserve_;  rcp_resource_info_.pl1 11/11/89 1110.3r 11/11/89 0804.6 39915 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_resource_info_: proc (); /* * * This procedure and its entries constitue the interfaces in RCP to return information to RCPRM from rcp_data. * The entries currently defined are: * * current_access_class * returns the current access class of the resource in question. If it is in use (assigned/reserved) * a pair of bit(1)s are returned to identify who is using the resource. * * * Initially coded 3/79 by Michael R. Jordan * Modifed during B2 cleanup by Chris Jones to stop using magic numbers. * */ /* PARAMETERS */ dcl access_class bit (72) aligned; /* If in use, the current access class. */ dcl code fixed bin (35); /* Error code. */ dcl in_use bit (1) aligned; /* ON => Resource is in use (assigned/reserved). */ dcl in_use_by_other bit (1) aligned; /* ON => Resource in use by another process. */ dcl rsc_name char (*); /* Resource name. */ dcl rsct char (*); /* Resource type. */ /* AUTOMATIC */ dcl device_off bit (18); /* Offset into rcp_data of device entry. */ dcl i fixed bin; /* Temporary index. */ dcl this_process bit (36); /* Process id of the current process. */ dcl vi fixed bin; /* Volume index. */ /* ERROR CODES */ dcl error_table_$resource_type_unknown fixed bin (35) ext; dcl error_table_$resource_unknown fixed bin (35) ext; /* ENTRIES CALLED */ dcl get_process_id_ entry () returns (bit (36)); dcl rcp_pointers_$data entry () returns (ptr); /* BUILTIN FUNCTIONS */ dcl addr builtin; dcl hbound builtin; dcl ptr builtin; current_access_class: entry (rsct, rsc_name, in_use, in_use_by_other, access_class, code); /* * * This entry tells RCPRM whether a resource is in use and if by another process. * * Input parameters are: * * (I) rsct -- resource type. * (I) rsc_name -- resource name. * (O) in_use -- ON => resource is assigned/reserved. * (O) in_use_by_other -- ON => resource in use by another process. * (O) access_class -- if in use, the access class. * (O) code -- error code. * * */ in_use = "0"b; /* Not in use. */ in_use_by_other = "0"b; /* Not in use by anyone. */ access_class = (72)"0"b; /* No current access class. */ code = 0; /* No error, yet. */ this_process = get_process_id_ (); rcpd_ptr = rcp_pointers_$data (); /* Let's see if this resource type is one of the types we know (and love). */ do i = 1 to hbound (DEVICE_TYPE, 1) ; if rsct = DEVICE_TYPE (i) then do; /* Found it! */ do device_off = rcpd.dtype (i).first_off repeat device.next_off while (device_off ^= (18)"0"b); device_ptr = ptr (rcpd_ptr, device_off); if device.device_name = rsc_name then do; in_use = (device.state ^= FREE); in_use_by_other = in_use & (device.process_id ^= this_process); access_class = device.current_authorization; return; end; end; code = error_table_$resource_unknown; return; end; end; do i = 1 to hbound (VOLUME_TYPE, 1); if rsct = VOLUME_TYPE (i) then do; /* Found the right one. */ do vi = 1 to rcpd.last_volume; volume_ptr = addr (rcpd.volume (vi)); if volume.volume_name = rsc_name & volume.vtypex = i then do; in_use = (volume.state ^= FREE); in_use_by_other = in_use & (volume.process_id ^= this_process); access_class = volume.current_authorization; return; end; end; return; end; end; code = error_table_$resource_type_unknown ; return; %include rcp_data; %page; %include rcp_com_seg; %page; %include rcp_resource_types; %page; %include rcp_resource_states; end rcp_resource_info_;  rcp_ring1_init_.pl1 11/11/89 1110.3rew 11/11/89 0805.9 116937 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-09-11,Fawcett), approve(85-09-11,MCR6979), audit(85-12-19,CLJones), install(86-03-21,MR12.0-1033): Add MCA support 2) change(86-05-13,GJohnson), approve(86-05-13,MCR7387), audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056): Correct error message documentation. END HISTORY COMMENTS */ /* format: indattr,inddcls,dclind5,idind30,struclvlind5,ifthenstmt,ifthendo,^inditerdo,^indnoniterend,case,^tree,^indproc,^indend,^delnl,^insnl,comcol81,indcom,linecom,^indcomtxt */ rcp_ring1_init_: procedure (arg_rif, arg_ecode); /* This program is called to perform RCP initialization during the * initialization of the answering service. It is called by as_init_. * It will create the RCP directory if it does not already exist. * It will create an ACS for each device that does not already have one. * * Created on 05/08/75 by Bill Silver. * Modified on 09/21/77 by R.J.C. Kissel to add the workspace ACS. * Modified on 04/24/78 by Michael R. Jordan to add RCPD modes initialization. * Modified 11/14/78 by C. D. Tavares to add >sss to initializer's search rules for RCPRM use. * Modified 3/79 by Michael R. Jordan for MR7.0R. * Modified 04/79 by CDT for new authentication levels. * Modified 4/82 by E. N. Kittlitz to log error setting search rules. * Modified 830103 to preassign operator's consoles... -E. A. Ranzenbach * Modified 1984-10-27 by E. Swenson to remove setting of search rules * for ring-1. In a cold boot, the shutting down and rebooting * which is directed in the installation instructions will get * the ring-1 search rules in order. In a non-cold boot, the * the search rules will already be those specified as default in * active_hardcore_data. * Modified 1985-03-08, BIM: remove OPC preassignment -- it does * the wrong thing. * Modified 1985-04-03, PKF / RAF to add MCA support */ dcl arg_ecode fixed bin (35); /* (O) error_table_ code. */ dcl 1 arg_rif like rcp_init_flags; /* pointer to rcp_info in installation parms */ dcl rings (3) fixed bin (3); /* Ring brackets for RCP directory. */ dcl access fixed bin (5); /* Access to an ACS segment. */ dcl caller_level fixed bin; /* Caller's validation level. */ dcl dir_name char (168); /* Directory containing the RCP direcotry. */ dcl ecode fixed bin (35); dcl entryname char (32); /* Entry name of the RCP directory. */ dcl group_id char (32); /* Initializer process group ID. */ dcl i fixed bin; dcl rcp_level fixed bin; /* Current validation level. */ dcl syserr_code fixed bin; /* used in calls to syserr. */ dcl wkspace_acs char (13) aligned internal static options (constant) init ("workspace.acs"); dcl (addr, substr, unspec) builtin; dcl cleanup condition; dcl (error_table_$no_dir, error_table_$noentry) fixed bin (35) external; dcl admin_gate_$syserr entry options (variable); dcl admin_gate_$syserr_error_code entry options (variable); dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); dcl get_group_id_ entry returns (char (32)); dcl get_ring_ entry returns (fixed bin); dcl hcs_$append_branch entry (char (*) aligned, char (*) aligned, fixed bin (5), fixed bin (35)); dcl hcs_$append_branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin (3), char (*), fixed bin (1), fixed bin (1), fixed bin (24), fixed bin (35)); dcl hcs_$get_user_effmode entry (char (*) aligned, char (*) aligned, char (*), fixed bin, fixed bin (5), fixed bin (35)); dcl hcs_$set_max_length entry (char (*) aligned, char (*) aligned, fixed bin (19), fixed bin (35)); dcl rcp_pointers_$com_seg entry returns (ptr); dcl rcp_pointers_$data entry returns (ptr); dcl rcprm_verify_registries_ ext entry (char (*), fixed bin (35)); %include access_mode_values; %include rcp_data; %include rcp_com_seg; %include syserr_constants; /* Begin rcp_ring1_init_.pl1 */ rcp_level = get_ring_ (); /* Get RCP's validation level. */ call cu_$level_get (caller_level); /* Get caller's validation level. */ on cleanup begin; /* If trouble cleanup. */ call cu_$level_set (caller_level); end; call cu_$level_set (rcp_level); /* Set validation level to RCP level. */ rcpd_ptr = rcp_pointers_$data (); /* We need info in rcp_data and rcp_com_seg. */ rcs_ptr = rcp_pointers_$com_seg (); call cu_$level_set (caller_level); /* Now we have pointers, use caller level. */ arg_ecode = 0; /* No bad error code returned. */ unspec (rcpd.modes) = unspec (arg_rif); if rcpd.init then return; /* already initalized, don't bother */ group_id = get_group_id_ (); /* Get this info once. */ syserr_code = SYSERR_PRINT_WITH_ALARM; /* Turn on bleeper once. */ /* First just see if directory is there. */ call hcs_$get_user_effmode (rcs.acs_directory, rcpd.device (1).acs_name, group_id, caller_level, access, ecode); if ecode = error_table_$no_dir /* Is directory there? */ then do; /* No, go create the RCP directory. */ call CREATE_RCP_DIR; if ecode ^= 0 then goto err_return; end; if ^rcpd.modes.resource_mgmt_enabled then do i = 1 to rcpd.tot_devices; /* Test each device. */ device_ptr = addr (rcpd.device (i)); call hcs_$get_user_effmode (rcs.acs_directory, device.acs_name, group_id, rcp_level, access, ecode); if ecode = error_table_$noentry /* Does this ACS exist? */ then call CREATE_ACS (device.acs_name); /* No, we will create it. */ end; call hcs_$get_user_effmode (rcs.acs_directory, wkspace_acs, group_id, rcp_level, access, ecode); if ecode = error_table_$noentry /* Is there a workspace ACS? */ then call CREATE_ACS (wkspace_acs); /* No, create it. */ if rcpd.modes.resource_mgmt_enabled then call rcprm_verify_registries_ (">system_control_1", ecode); if ecode ^= 0 then goto err_return; if rcpd.modes.resource_mgmt_enabled & rcpd.modes.auto_registration & (rcpd.modes.authentication_level < Automatic_authentication) then call admin_gate_$syserr (SYSERR_PRINT_WITH_ALARM, "RCP: Auto registration enabled without strict authentication required. ^8xThis may cause errors in automatic registration of volumes."); rcpd.init = "1"b; /* initialization complete */ return; err_return: arg_ecode = ecode; return; /* */ CREATE_RCP_DIR: procedure; /* This procedure is called to create the RCP directory that will contain * the Access Control Segments for each device. The default access to * this directory will be taken from the initial directory ACL of the * containing directory. In addition all users will be given S access. */ call expand_pathname_ ((rcs.acs_directory), dir_name, entryname, ecode); if ecode ^= 0 then do; call admin_gate_$syserr_error_code (SYSERR_PRINT_WITH_ALARM, ecode, "RCP: Error expanding ^a:", rcs.acs_directory); return; end; rings (*) = 7; call hcs_$append_branchx (dir_name, entryname, S_ACCESS_BIN, rings, "*.*.*", 1, 0, 0, ecode); if ecode ^= 0 then do; call admin_gate_$syserr_error_code (SYSERR_PRINT_WITH_ALARM, ecode, "RCP: Error creating ^a:", rcs.acs_directory); return; end; call admin_gate_$syserr (SYSERR_PRINT_WITH_ALARM, "RCP: Created ^a with default access.", rcs.acs_directory); syserr_code = SYSERR_PRINT_ON_CONSOLE; /* Only turn on bleeper once. */ end CREATE_RCP_DIR; /* */ CREATE_ACS: procedure (acs_name); /* This procedure is called to create an ACS for the current device. * The default access to this device will be RW for the current process. * In addition to creating the ACS we will set the max segment length * of this segment to 0. */ dcl acs_name char (*) aligned; /* name of the segment to create. */ call cu_$level_get (caller_level); if substr (acs_name, 1, 3) = "mca" then do; rcp_level = get_ring_ (); on cleanup begin; call cu_$level_set (caller_level); end; call cu_$level_set (rcp_level); rings (*) = 1; /* must be in ring 1 */ call hcs_$append_branchx ((rcs.acs_directory), (acs_name), RW_ACCESS_BIN, rings, "", 0, 0, 0, ecode); if ecode ^= 0 then do; call admin_gate_$syserr_error_code (SYSERR_PRINT_WITH_ALARM, ecode, "RCP: Error creating ACS ^a:", acs_name); goto CREATE_ACS_EXIT; end; call admin_gate_$syserr (syserr_code, "RCP: Created ^a>^a with default access.", rcs.acs_directory, acs_name); call hcs_$set_max_length (rcs.acs_directory, acs_name, 0, ecode); if ecode ^= 0 then call admin_gate_$syserr_error_code (SYSERR_PRINT_WITH_ALARM, ecode, "RCP: Error setting max length of ^a:", acs_name); goto CREATE_ACS_EXIT; end; else do; call hcs_$append_branch (rcs.acs_directory, acs_name, RW_ACCESS_BIN, ecode); if ecode ^= 0 then do; call admin_gate_$syserr_error_code (SYSERR_PRINT_WITH_ALARM, ecode, "RCP: Error creating ACS ^a:", acs_name); goto CREATE_ACS_EXIT; end; call admin_gate_$syserr (syserr_code, "RCP: Created ^a>^a with default access.", rcs.acs_directory, acs_name); call hcs_$set_max_length (rcs.acs_directory, acs_name, 0, ecode); if ecode ^= 0 then call admin_gate_$syserr_error_code (SYSERR_PRINT_WITH_ALARM, ecode, "RCP: Error setting max length of ^a:", acs_name); end; CREATE_ACS_EXIT: syserr_code = SYSERR_PRINT_ON_CONSOLE; /* Turn on bleeper only once. */ call cu_$level_set (caller_level); end CREATE_ACS; %page; /* BEGIN MESSAGE DOCUMENTATION Message: RCP: Error expanding DIR: ERROR_MESSAGE S: $beep T: $run M: The pathname of the acs directory is incorrect. It should be >system_control_1>acs. $err The system may be unable to use I/O devices. A: $contact Message: RCP: Error creating DIR: ERROR_MESSAGE S: $beep T: $run M: The system was unable to create the ACS directory. It should be >system_control_1>acs. The system may be unable to use I/O devices. A: $contact Message: RCP: Created DIR with default access. S: $beep T: $run M: The directory (usually >system_control_1>rcp) was created because it was not found at startup. It may have been destroyed in a crash. This message is normal during a cold boot of the Multics hierarchy. A: If users other than system processes should have access to the directory, the system administrator must set the ACL appropriately. Message: RCP: Error creating ACS DEVICE.acs: ERROR_MESSAGE S: $beep T: $run M: The system was unable to create an access control segment for DEVICE. No user will be able to attach it. A: $contact Message: RCP: Created DIR>DEVICE.acs with default access. S: $beep T: $run M: The system has created an access control segment for DEVICE because one was not found at startup. It may have been destroyed in a crash. This message is normal during the first use of a device on the system, and at cold boot. A: If users other than system processes should have access to DEVICE, the system administrator must set the ACL of DEVICE.acs appropriately. Message: RCP: Error setting max length of DEVICE.acs: ERROR_MESSAGE S: $beep T: $run M: $err A: $contact Message: RCP: Auto Registration is enabled without Exact Authentication required. This could lead to errors in automatic registration of volumes. S: $beep T: $run M: This is a warning. If the system is operated with auto registration enabled and exact authentication of tape volumes is not required, there is a better chance of errors occurring in the registration of tape volumes. Again, it is very important to make sure the volume mounted is the proper one for the request if auto registration is enabled. A: $ignore END MESSAGE DOCUMENTATION */ end rcp_ring1_init_;  rcp_set_lock_.pl1 11/11/89 1110.3rew 11/11/89 0805.2 79524 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ rcp_set_lock_: procedure; /* rcp_set_lock_ taken from set_lock_. * Will be made into the real set_lock_ later. */ /* set_lock_ - This procedure allows a user to guarantee that two processes will not simultaneously execute the same critical section of code. A user provided lock word can be set to the lock identifier of only one process at a time thereby guaranteeing, assuming the proper conventions are followed, that only this process can be currently executing in the critical section of code. Originally coded by R. J. Feiertag on November 5, 1971 Modified on April 6, 1972 by R. J. Feirtag to work in all rings. Modified on October 1, 1974 by J. Stern to eliminate message segment metering. Modified on December 7, 1974 by Bill Silver to add generalized metering. */ dcl arg_code fixed bin(35); /* (O) error_table_ code. */ dcl arg_lock bit(36) aligned; /* (I) The lock to lock or unlock. */ dcl arg_time_of_lock fixed bin(71); /* (I/O) Raw time lock locked. */ dcl arg_time_locked fixed bin(71); /* (O) Raw time (duration) lock was locked. */ dcl arg_time_waiting fixed bin(71); /* (O) Raw time waiting for lock. */ dcl arg_wait_time fixed bin; /* (I) Time in seconds to wait for lock. */ dcl lock_ptr ptr, /* Pointer to lock. */ wait_time fixed bin, /* time in seconds to wait for lock to be unlocked */ code fixed bin(35), /* indicates success of call */ time_locked fixed bin(71), /* time locked locked. */ time_started fixed bin(71), /* time we started to wait for lock. */ alarm_time fixed bin(71), /* saved value of alarm timer */ alarm_channel fixed bin(71), /* saved value of alarm timer channel */ message(4) fixed bin(71), /* message from ipc */ failure_time fixed bin(71) init(0), /* is the time at which this call will give up */ sleep_time fixed bin(71), /* is the number of microseconds until this call gives up */ ttul_code fixed bin, /* is the status from try_to_unlock_lock */ lock_id bit(36) aligned internal static init(""b); /* is the lock identifier of this process */ dcl based_lock bit(36) aligned based(lock_ptr); dcl 1 wait_list aligned internal static, /* list of channels to wait on for ipc */ 2 channel_count fixed bin init(1), /* number of channels to wait on */ 2 channel fixed bin(71) init(0); /* channel for waiting */ dcl error_table_$locked_by_other_process ext fixed bin(35), error_table_$locked_by_this_process ext fixed bin(35), error_table_$lock_not_locked ext fixed bin(35), error_table_$invalid_lock_reset ext fixed bin(35), error_table_$lock_wait_time_exceeded ext fixed bin(35); dcl get_lock_id_ ext entry(bit(36) aligned), get_ring_ ext entry returns(fixed bin(3)), get_initial_ring_ ext entry returns(fixed bin(3)), ipc_$create_ev_chn ext entry(fixed bin(71),fixed bin(35)), ipc_$block ext entry(ptr,ptr,fixed bin(35)), stacq ext entry(ptr,bit(36) aligned,fixed bin(35)) returns (bit(1) aligned), hcs_$get_alarm_timer ext entry(fixed bin(71),fixed bin(71)), hcs_$set_alarm_timer ext entry(fixed bin(71),fixed bin,fixed bin(71)), hcs_$try_to_unlock_lock ext entry(ptr,fixed bin), clock_ ext entry returns(fixed bin(71)), timer_manager_$sleep ext entry(fixed bin(71),bit(2)); dcl (stac,min,addr) builtin; /* */ /* This entry attempts to set the lock word to the lock indentifier of the * calling process. If the lock is already set by some other existing process * then it waits for some given period of time for the lock to be unlocked. * If the lock is not unlocked in the given time then set_lock_ gives up and returns. */ lock: entry (arg_lock,arg_wait_time,arg_code); lock_ptr = addr(arg_lock); /* Get pointer to lock to lock. */ wait_time = arg_wait_time; call LOCK; /* Try to lock lock. */ arg_code = code; return; /* This entry performs the same function as unlock except that it allows the * caller to perform metering on the lock. */ meter_lock: entry (arg_lock,arg_wait_time,arg_time_of_lock,arg_time_waiting,arg_code); lock_ptr = addr(arg_lock); /* Get pointer to lock to lock. */ wait_time = arg_wait_time; time_started = 0; /* Initialize time waiting started. */ call LOCK; /* Try to lock the lock. */ if (code = 0) | /* Was lock set OK? */ (code = error_table_$invalid_lock_reset) then do; /* Yes, compute meters. */ time_locked = clock_(); if time_started = 0 then time_started = time_locked; end; else do; /* No, lock not locked. */ time_locked, time_started = 0; end; arg_time_of_lock = time_locked; /* Return meter data. */ arg_time_waiting = time_locked - time_started; arg_code = code; return; /* */ LOCK: procedure; /* This procedure is called to try to lock the lock. */ if lock_id = ""b then call get_lock_id_(lock_id); /* get lock id if we don't already have it */ AGAIN: if stac(lock_ptr,lock_id) then do; /* locked successfully, we are done */ code = 0; /* return successful code */ return; end; call hcs_$try_to_unlock_lock(lock_ptr,ttul_code); if ttul_code = 3 then do; /* lock was invalid and was relocked */ code = error_table_$invalid_lock_reset; /* return successful code */ return; end; if time_started = 0 then time_started = clock_(); if ttul_code = 2 then go to AGAIN; /* lock is not locked, try again */ if based_lock = lock_id then do; /* already locked by this process */ code = error_table_$locked_by_this_process; return; end; if failure_time = 0 then /* calculate when we will give up */ if wait_time < 0 then /* largest possible clock time */ failure_time = /* 2**52 */ 10000000000000000000000000000000000000000000000000000b; else failure_time = clock_() + wait_time * 1000000; /* calculate time to give up */ sleep_time = failure_time - clock_(); /* calculate time to sleep */ if sleep_time <= 0 then do; /* time to give up */ code = error_table_$lock_wait_time_exceeded; /* return unsuccessful code */ return; end; if get_ring_() >= get_initial_ring_() then /* we can call timer_manager_ */ call timer_manager_$sleep(min(sleep_time,2000000),"10"b); /* sleep for some time */ else do; /* we cannot call timer_manager_ */ if channel = 0 then do; /* a channel must be created */ call ipc_$create_ev_chn(channel,code); /* create the channel */ if code ^= 0 then return; /* if trouble then forget it */ end; call hcs_$get_alarm_timer(alarm_time,alarm_channel); /* remember current alarm settings */ call hcs_$set_alarm_timer(min(sleep_time,1000000),1,channel); /* get awakened later */ call ipc_$block(addr(wait_list),addr(message),code); /* wait for wakeup */ call hcs_$set_alarm_timer(alarm_time,2,alarm_channel); /* reset original timer settings */ if code ^= 0 then return; /* if trouble then give up */ end; go to AGAIN; /* try again */ end LOCK; /* */ /* This entry attempts to unlock the lock. */ unlock: entry (arg_lock,arg_code); lock_ptr = addr(arg_lock); /* Get pointer to lock. */ call UNLOCK; /* Try to unlock lock. */ arg_code = code; /* Return error code. */ return; /* This entry performs the same function as unlock except that it also * returns metering data. */ meter_unlock: entry (arg_lock,arg_time_of_lock,arg_time_locked,arg_code); lock_ptr = addr(arg_lock); /* Get pointer to lock. */ call UNLOCK; /* Try to unlock lock. */ if code = 0 /* Was locked unlocked OK? */ then arg_time_locked = clock_() - arg_time_of_lock; else arg_time_locked = 0; /* No. */ arg_code = code; return; UNLOCK: procedure; /* This procedure is called to try to unlock the lock. */ if lock_id = ""b then call get_lock_id_(lock_id); /* get lock id if we don't already have it */ if ^stacq(lock_ptr, lock_id, 0) then /* lock was not locked by this process */ if based_lock = ""b then code = error_table_$lock_not_locked; /* lock was not locked */ else code = error_table_$locked_by_other_process; /* lock was set by another process */ else code = 0; /* everything OK - lock was locked by us and cleared by stacq */ end UNLOCK; end rcp_set_lock_;  rcp_setup_event.pl1 11/11/89 1110.3r 11/11/89 0805.5 46404 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ rcp_setup_event: proc (a_operation, a_effmode, a_event_flag, a_error_code); /* This internal subroutine sets up the event flag * structure needed to determine if auditing of the * event is required. * * Created 850221 by Maria M. Pozzo * */ /* ARGUMENT DATA */ dcl a_operation bit (36) aligned; /* (I) The RCP operation */ dcl a_priv_gate_call bit (1); /* (I) "1"b if the call was made from rcp_sys_, rcp_admin_, rcp_priv_. */ dcl a_effmode bit (3); /* (I) The resulting effective mode of the subject to the resource. */ dcl a_event_flag bit (36) aligned; /* (O) Pointer to the event_flag structure. */ dcl a_error_code fixed bin (35); /* (O) Error code. */ /* AUTOMATIC DATA */ dcl effmode bit (3); dcl operation bit (36) aligned; dcl base_op bit (36) aligned; dcl local_code fixed bin (35); dcl event_ptr ptr; dcl operation_ptr ptr; dcl 1 en_access_op like encoded_access_op aligned based (operation_ptr); /* EXTERNAL ENTRIES */ dcl access_operations_$rcp_register bit (36) aligned external; dcl access_operations_$rcp_deregister bit (36) aligned external; dcl access_operations_$rcp_register_acquire bit (36) aligned external; dcl access_operations_$rcp_preload bit (36) aligned external; dcl access_operations_$rcp_set_access bit (36) aligned external; dcl access_operations_$rcp_clear bit (36) aligned external; dcl access_operations_$rcp_unassign bit (36) aligned external; dcl access_operations_$rcp_add_device bit (36) aligned external; dcl access_operations_$rcp_delete_device bit (36) aligned external; dcl access_operations_$rcp_copy_registry bit (36) aligned ext static; dcl access_operations_$rcp_delete_registry bit (36) aligned ext static; dcl access_operations_$rcp_reconstruct_registry bit (36) aligned ext static; dcl access_operations_$rcp_update_registry_header bit (36) aligned ext static; /* Copy arguments */ operation = a_operation; base_op = operation; addr (base_op) -> en_access_op.detailed_operation = 0; ops_ptr = addr (addr (operation) -> en_access_op.detailed_operation); effmode = a_effmode; event_ptr = addr (a_event_flag); local_code = 0; event_ptr -> audit_event_flags.special_op = special (); event_ptr -> audit_event_flags.admin_op = admin (); event_ptr -> audit_event_flags.priv_op = priv (); event_ptr -> audit_event_flags.grant = (effmode ^= "000"b); event_ptr -> audit_event_flags.cc_1_10 = "0"b; event_ptr -> audit_event_flags.cc_10_100 = "0"b; MAIN_RETURN: a_error_code = local_code; return; %page; special: proc () returns (bit (1)); /* Operations which change the access class range of the object are special. */ /* Operations which change the acs_path are also special. */ if base_op = access_operations_$rcp_set_access then return ("1"b); else return ("0"b); end special; %page; admin: proc () returns (bit (1)); /* Operations that can only be called from rcp_sys_, rcp_admin_ or */ /* rcp_priv_. */ if (base_op = access_operations_$rcp_unassign & (detailed_operation.force | detailed_operation.process)) then return ("1"b); if base_op = access_operations_$rcp_add_device | base_op = access_operations_$rcp_delete_device then return ("1"b); if base_op = access_operations_$rcp_preload then return ("1"b); if base_op = access_operations_$rcp_register | base_op = access_operations_$rcp_register_acquire | base_op = access_operations_$rcp_deregister then return ("1"b); if base_op = access_operations_$rcp_clear then return ("1"b); if base_op = access_operations_$rcp_copy_registry | base_op = access_operations_$rcp_delete_registry | base_op = access_operations_$rcp_reconstruct_registry | base_op = access_operations_$rcp_update_registry_header then return ("1"b); return ("0"b); end admin; %page; priv: proc () returns (bit (1)); /* Standard operations that are called with a -priv or other argument */ /* that causes them to be invoked through a privileged gate. */ /* ADMIN operations are invoked through a privileged gate as well and */ /* they are considered to be PRIV operations also. */ if detailed_operation.priv_gate_call then return ("1"b); else return ("0"b); end priv; %page; %include access_audit_encoded_op; %page; %include rcp_ops; %page; %include access_audit_eventflags; end rcp_setup_event;  rcp_tape_.pl1 11/11/89 1110.3rew 11/11/89 0807.1 406584 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-10-14,Farley), approve(85-10-14,MCR6979), audit(85-12-17,CLJones), install(86-03-21,MR12.0-1033): Issue request_status to FIPS devices. Allow for long unload connect time for FIPS. 2) change(86-05-13,GJohnson), approve(86-05-13,MCR7387), audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056): Correct error message documentation. 3) change(86-12-03,GWMay), approve(86-12-03,PBF7552), audit(86-12-09,Martinson), install(86-12-17,MR12.0-1250): Changed to go ahead and read the tape label so that the caller can display the "real" id and density of the tape when being run as the Initializer or if the authentication_level installation parameter is set to none. 4) change(86-12-23,GDixon), approve(86-12-23,PBF7552), audit(86-12-23,Farley), install(87-01-05,MR12.0-1253): Don't change caller's volume label when rcp_tape_ was unable to read a label from the tape. Set automatic write_flag in TAPE_STATE(4). END HISTORY COMMENTS */ /* format: style4,delnl,insnl,ifthen */ rcp_tape_: procedure (arg_rcse_ptr, arg_ecode); /* This program is an internal interface of RCP. * Created on 02/20/75 by Bill Silver. * Changed on 11/01/76 by Bill Silver to set/reset mount timer. * Changed on 09/19/77 by R.J.C. Kissel to check tape labels. * Modified on 04/26/78 by Michael R. Jordan to allow preloaded tape volumes. * Modified on 01/31/79 by Michael R. Jordan to return label and density info, * to stop label reading on manual halt. * Modified 4/79 by R.J.C. Kissel to handle 6250 bpi tapes. * Modified 3/79 by Michael R. Jordan for MR7.0R * Modified 04/79 by C. D. Tavares tor internal label authentication. * Modified 01/02/81 by J. A. Bush for bootable Multics standard tapes * Modified 3/82 by R.J.C. Kissel for FIPS level 1 by checking the accessibility code in an ANSI label * Modified 7/82 by B. Braun to check 32 chars of the tape label and not just the first 16 characters. * See TRs phx13431, phx12222. * Modified 1/83 by J. A. Bush the set the rcse.label_type directly from the workspace * Modified 12/83 by B. Braun to correct unnecessary authentication of tapes (phx14557 phx14837 phx16233). * Modified 11/84 by Paul Farley to issue request_status to FIPS devices * instead of set_write_permit, because the latter is not supported. * Modified 10/85 by Paul Farley to extend the default IOI timeout during * an unload of a FIPS tape to include a possible full rewind time. * * This program is called to perform special tape attachment processing. */ /* ARGUMENT DATA */ dcl arg_ecode fixed bin (35); /* (O) Return error_table_ code. */ dcl arg_rcse_ptr ptr; /* (I) Pointer to attachment RCS entry. */ /* AUTOMATIC DATA */ dcl command bit (6); /* Initial IDCW command to device. */ dcl device_off bit (18) aligned; /* RCPD device entry offset. */ dcl drive_num fixed bin; /* Tape drive number. */ dcl (ecode, scode) fixed bin (35); /* error_table_ code. */ dcl ioi_index fixed bin; /* IOI internal device index. */ dcl special_status_bits bit (7) aligned; /* Used to isolate the special status bits we need. */ dcl users_requested_volume_name char (32); dcl workspace_ptr ptr; /* Pointer to our workspace. */ dcl write_flag bit (1) aligned; /* BASED DATA */ dcl 1 wspace based (workspace_ptr) aligned, /* Overlay of IOI workspace. */ 2 idcw bit (36), /* Tape IDCW. */ 2 read_idcw bit (36), 2 read_dcw bit (36), 2 rewind_idcw bit (36), 2 state fixed bin, /* Index that => current state of attachment. */ 2 get_authentication_state fixed bin, 2 read_label_state fixed bin, 2 read_record_state fixed bin, 2 rewind_state fixed bin, 2 set_density_state fixed bin, 2 tape_state_4_state fixed bin, 2 mount_state fixed bin, /* Save state used to wait for mounts. */ 2 i fixed bin, /* read_label loop counter. */ 2 j fixed bin, /* read_record loop counter. */ 2 retry_count fixed bin, /* Number of REREADYs we have issued. */ 2 ring_comment char (8), /* Used in tape mount messages. */ 2 special_flag bit (1), /* ON => special interrupt. */ 2 special_status_word bit (36), /* One word of special status. */ 2 label_name char (32) unaligned, /* label read from tape. */ 2 label_type fixed bin, /* see label_msg below for meaning. */ 2 flags, ( 3 bad_mode bit (1), 3 blank_tape bit (1), 3 den_set bit (1), 3 nrzi_den_set bit (1), 3 label_match bit (1), 3 unreadable_tape bit (1), 3 record_read bit (1), 3 wait bit (1), 3 manual_halt bit (1), 3 ansi_non_blank_access bit (1), 3 pad bit (26) ) unaligned, 2 pad_ptr ptr, /* Pad so status queue starts at even offset. */ 2 istatq like istat, /* Our status queue - only 1 entry. */ 2 label_buffer (32) bit (36); /* Place to put the first few words for label checking. */ /* INTERNAL STATIC DATA */ dcl max_num_retries fixed bin options (constant) /* Number of times we will ready a tape drive. */ internal static init (5); dcl template_idcw bit (36) options (constant) /* Template of the IDCW we will use. */ internal static init ("000000700201"b3); dcl template_read_idcw bit (36) options (constant) internal static init ("050000700000"b3); /* Read record binary command. */ dcl template_read_dcw bit (36) options (constant) internal static init ("000000000000"b3); /* We will set the address and tally later. */ dcl template_rewind_idcw bit (36) options (constant) internal static init ("700000700201"b3); dcl rewind_command bit (6) options (constant) /* IDCW command. */ internal static init ("70"b3); dcl rewind_unload_command bit (6) options (constant) /* IDCW command. */ internal static init ("72"b3); dcl reset_status_command bit (6) options (constant) /* IDCW command. */ internal static init ("40"b3); dcl request_status_command bit (6) options (constant) /* IDCW command. */ internal static init ("00"b3); dcl set_write_permit_command bit (6) options (constant) /* IDCW command. */ internal static init ("63"b3); dcl density (5) bit (6) options (constant) /* Set density commands */ internal static init ("60"b3, "61"b3, "64"b3, "65"b3, "41"b3); /* 800, 556, 200, 1600, and 6250 bpi */ dcl DENSITY_INDEX (5) fixed bin options (constant) /* Volume density index */ internal static init (3, 2, 1, 4, 5); /* 800, 556, 200, 1600, 6250 */ dcl FIPS_UNLOAD_TIMEOUT fixed bin (71) options (constant) /* MAX time for connect */ internal static init (90000000); /* EXTERNAL ENTRIES CALLED */ dcl (addr, fixed, null, rel, size, substr, bin, ptr, dim, translate) builtin; dcl (bit, collate9, divide, hbound, lbound, length, min) builtin; dcl ( error_table_$action_not_performed, error_table_$device_attention, error_table_$invalid_state ) fixed bin (35) external; dcl admin_gate_$ioi_set_to_max entry (fixed bin, fixed bin (71), fixed bin (35)); dcl admin_gate_$syserr entry options (variable); dcl cv_dec_ entry (char (*), fixed bin); dcl ioi_$connect entry (fixed bin, fixed bin, fixed bin (35)); dcl ioi_$get_special_status entry (fixed bin, bit (1) aligned, bit (36) aligned, fixed bin (35)); dcl ioi_$set_status entry (fixed bin, fixed bin (18), fixed bin, fixed bin (35)); dcl ioi_$timeout entry (fixed bin, fixed bin (71), fixed bin (35)); dcl ioi_$workspace entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl rcp_auto_register_ entry (char (*), char (*), char (*), fixed bin (35)); dcl rcp_ioi_attach_ entry (ptr, fixed bin (35)); dcl rcp_mount_timer_$reset entry (bit (18) aligned, fixed bin (35)); dcl rcp_mount_timer_$set entry (bit (18) aligned, bit (1) aligned, fixed bin (35)); dcl rcp_pointers_$data entry () returns (ptr); dcl bcd_to_ascii_ entry (bit (*), char (*)); dcl ebcdic8_to_ascii_ entry (bit (*), char (*)); dcl canon_for_volume_label_ entry (char (*), char (*), char (*), fixed bin, fixed bin (35)); dcl authenticate_ ext entry (char (*)) returns (char (3) aligned); %include rcp_com_seg; %include rcp_data; %include rcp_volume_formats; %include iom_pcw; %include iom_dcw; %include ioi_stat; %include iom_stat; %include resource_control_desc; %include rcp_resource_types; %include mstr; /* Begin special tape attachment processing. */ rcse_ptr = arg_rcse_ptr; /* Copy argument. */ rcs_ptr = ptr (rcse_ptr, "0"b); rcpd_ptr = rcp_pointers_$data (); workspace_ptr = rcse.workspace_ptr; /* Get pointer to current workspace. */ ecode = 0; if workspace_ptr ^= null () /* Have we set up a workspace yet? */ then do; /* Yes. */ ioi_index = rcse.ioi_index; /* We will need this to call IOI. */ isp = addr (wspace.istatq); /* Almost every state needs this pointer. */ goto TAPE_STATE (wspace.state); /* Go do next step in tape attachment. */ end; /* No workspace implies that this is the first call to rcp_$check_attach. * We must attach the tape drive in ring 0 via IOI. */ call rcp_ioi_attach_ (rcse_ptr, ecode); if ecode ^= 0 /* Now check for any error at all. */ then do; /* Yes, abort attachment. */ arg_ecode = ecode; return; end; ioi_index = rcse.ioi_index; /* Get IOI index for this attachment. */ /* We have just attached the tape drive to IOI. We must get an IOI workspace. * Then we will try to unload any volume mounted on this tape drive. * For T&D attachments we don't want to do any of this special processing. */ if rcse.flags.t_and_d /* Is this a special T&D attachment? */ then do; /* Yes, nothing to do. */ rcse.state = 4; /* Tell caller that tape is ready for use. */ arg_ecode = 0; return; end; call ioi_$workspace (ioi_index, workspace_ptr, size (wspace), ecode); if ecode ^= 0 then do; arg_ecode = ecode; return; end; rcse.workspace_ptr = workspace_ptr; /* Save workspace pointer for this attachment. */ wspace.idcw = template_idcw; /* Set up template IDCWs. */ wspace.read_idcw = template_read_idcw; wspace.read_dcw = template_read_dcw; wspace.rewind_idcw = template_rewind_idcw; call cv_dec_ (substr (rcse.device_name, 6, 2), drive_num); /* Set the device code in the IDCWs. */ addr (wspace.idcw) -> idcw.device = bit (fixed (drive_num, 6)); addr (wspace.read_idcw) -> idcw.device = bit (fixed (drive_num, 6)); addr (wspace.rewind_idcw) -> idcw.device = bit (fixed (drive_num, 6)); /* Set the buffer address and a tally count in the read DCW. */ addr (wspace.read_dcw) -> dcw.address = rel (addr (wspace.label_buffer)); addr (wspace.read_dcw) -> dcw.tally = bit (bin (dim (wspace.label_buffer, 1), 12), 12); wspace.state, /* Initialize the state variable that controls all. */ wspace.mount_state, wspace.retry_count = 0; /* Initialize retry count. */ if rcse.flags.writing /* Set up mount comment. */ then wspace.ring_comment = "with"; else wspace.ring_comment = "without"; isp = addr (wspace.istatq); /* Call IOI to set up our status queue. */ call ioi_$set_status (ioi_index, fixed (rel (isp), 18), 1, ecode); if ecode ^= 0 then do; /* Can't go on without a status queue. */ arg_ecode = ecode; return; end; if rcse.flags.preloaded then do; wspace.state = 2; wspace.mount_state = 2; command = rewind_command; end; else do; /* If we are unloading a FIPS tape drive, then we need to allow for the * case where a rewind is in progress and the FIPS adapter holds onto the * unload connect till the rewind completes. This is because the tape * subsystem does not allow the unload, because the rewind has it busy. */ if rcse.flags.fips then do; call admin_gate_$ioi_set_to_max (ioi_index, FIPS_UNLOAD_TIMEOUT, ecode); if ecode ^= 0 then do; arg_ecode = ecode; return; end; call ioi_$timeout (ioi_index, FIPS_UNLOAD_TIMEOUT, ecode); if ecode ^= 0 then do; arg_ecode = ecode; return; end; end; wspace.state = 1; command = rewind_unload_command; end; istat.completion.st = "0"b; /* Try to rewind or rewind and unload the current volume. */ addr (wspace.idcw) -> idcw.command = command; call ioi_$connect (ioi_index, 0, ecode); arg_ecode = ecode; return; /* Somehow or other we are trying to use the workspace out of sequence. */ TAPE_STATE (0): /* INVALID STATE */ arg_ecode = error_table_$invalid_state; return; /* The connect issued to perform the rewind & unload has terminated. * We don't really care whether or not the rewind & unload operation worked. * We will tell the operator to mount the tape volume being attached. * Then we will wait for any special interrupts generated by a rewind & unload * or the mounting. */ TAPE_STATE (1): /* REWIND & UNLOAD TERMINATION */ if ^istat.completion.st /* There should at least be some status. */ then return; /* None, so ignore. */ /* REQUEST TAPE MOUNT */ call Print_Mount_Message (); /* Print a mount message for the operator. */ wspace.state, /* Wait for special from tape mounting. */ wspace.mount_state = wspace.state + 1; /* Remember state used to wait for mount. */ /* Turn ON the mount timer. */ device_off = rcse.device_off; /* Need RCPD device entry offset. */ write_flag = rcse.flags.writing; /* Pass on write flag. */ call rcp_mount_timer_$set (device_off, write_flag, ecode); arg_ecode = ecode; return; /* We should come here because we have received a special interrupt. * We will check to see if it is from a rewind & unload or from * a mount. The special status bits we will test are: * REWIND, UNLOAD, READY, STANDBY, LOADED, RELEASED, MALFUNCTIONED. */ TAPE_STATE (2): /* SPECIAL from REWIND, REWIND & UNLOAD or from MOUNT. */ call ioi_$get_special_status (ioi_index, special_flag, special_status_word, ecode); if (ecode ^= 0) then do; arg_ecode = ecode; return; end; if ^special_flag then if rcse.flags.preloaded then do; /* No special and we thought the tape was there, ask for it */ if ^istat.completion.st then do; /* REWIND has not been processed yet, just wait a while */ arg_ecode = 0; return; end; if istat.completion.er | /* If there was an error ... */ (istat.level ^= 3) then /* or this is not a terminate ... */ call REREADY_TAPE ("0"b); /* ask to have the tape rereadied. */ else do; /* turn on mount timer to make sure we don't loose this user. */ device_off = rcse.device_off; /* Get RCPD offset of this device. */ write_flag = rcse.flags.writing; /* Pass on write flag. */ call rcp_mount_timer_$set (device_off, write_flag, ecode); end; arg_ecode = ecode; return; end; else do; /* No special and not preloaded, just wait for it. */ arg_ecode = 0; return; end; if rcse.model = 400 /* Special case 400 type drives. */ then goto CHECK_READY; /* Get the special status bits we need. */ special_status_bits = substr (special_status_word, 30, 7); if special_status_bits = "0101000"b then do; /* If special is from UNLOAD wait for another. */ arg_ecode = 0; return; end; if substr (special_status_bits, 1, 1) /* REWIND COMPLETE is ON. */ then goto CHECK_READY; if ^substr (special_status_bits, 3, 1) /* READY must be ON. */ then do; /* We got special but tape still not ready. */ call REREADY_TAPE ("0"b); arg_ecode = ecode; return; end; CHECK_READY: if rcse.flags.preloaded then /* This is a preloaded volume, let the operator know. */ call admin_gate_$syserr (0, "RCP: Using Reel ^a on ^a for ^a", rcse.volume_name, rcse.device_name, rcse.group_id); istat.completion.st = "0"b; /* TAPE READY - check its current state. */ if rcse.flags.fips then addr (wspace.idcw) -> idcw.command = request_status_command; else addr (wspace.idcw) -> idcw.command = set_write_permit_command; call ioi_$connect (ioi_index, 0, ecode); wspace.state = wspace.state + 1; /* Wait for command to terminate. */ device_off = rcse.device_off; /* Turn OFF mount timer. */ call rcp_mount_timer_$reset (device_off, scode); if ecode = 0 then ecode = scode; arg_ecode = ecode; return; /* Check the status from the (request status, reset status or set write * permit) operation. We must check that the write ring is correct. * If everything is OK we will indicate that the attachment has been * completed. */ TAPE_STATE (3): /* SET WRITE PERMIT TERMINATION. */ if ^istat.completion.st /* Is there any status. */ then do; /* No, ignore. */ arg_ecode = 0; return; end; statp = addr (istat.iom_stat); /* Get pointer to IOM status. */ if (istat.completion.er) | /* Is there an error? */ (istat.level ^= 3) /* Or is this not a terminate? */ then do; /* Yes, try to ready tape again. */ if (status.major = "0101"b) /* Command Reject */ & ((status.sub & "71"b3) = "01"b3) /* Invalid OP Code */ & (addr (wspace.idcw) -> idcw.command = set_write_permit_command) then do; /* We probably tries to set permit when there was no ring */ addr (wspace.idcw) -> idcw.command = reset_status_command; call ioi_$connect (ioi_index, 0, ecode); arg_ecode = ecode; return; end; call REREADY_TAPE ("0"b); arg_ecode = ecode; return; end; if (status.sub & "000010"b) ^= "000010"b then do; /* Tape not at BOT. */ call REREADY_TAPE ("0"b); arg_ecode = ecode; return; end; if rcse.flags.writing = ((status.sub & "001001"b) = "000001"b) then do; /* Write ring is not correct. */ call REREADY_TAPE ("1"b); arg_ecode = ecode; return; end; /* Initialize the internal procedure states for label checking. */ wspace.state = 4; wspace.read_label_state = 1; wspace.get_authentication_state = 1; wspace.tape_state_4_state = 1; /* Initialize the flags used by the label checking procedures. */ wspace.den_set = "0"b; wspace.nrzi_den_set = "0"b; wspace.record_read = "0"b; wspace.unreadable_tape = "0"b; wspace.bad_mode = "0"b; wspace.wait = "0"b; wspace.label_match = "0"b; wspace.label_name = ""; wspace.blank_tape = "0"b; wspace.manual_halt = "0"b; wspace.ansi_non_blank_access = "0"b; /* Initialize the authentication bits in the rcse. */ rcse.flags.have_auth = "0"b; rcse.flags.need_auth = "0"b; rcse.flags.auth_set = "0"b; /* Now we will enter the label checking state. It has a number of internal states which are remembered by the state variables in our workspace. */ TAPE_STATE (4): write_flag = rcse.flags.writing; goto STATE (wspace.tape_state_4_state); /* get to the proper internal state. */ STATE (1): wspace.tape_state_4_state = 1; call read_label (); if wspace.wait then goto RETURN; /* let our caller wait for an event. */ users_requested_volume_name = rcse.volume_name; call validate_tape_label (addr (wspace.label_buffer), rcse.volume_name, wspace.label_match, wspace.label_name, wspace.label_type); rcse.flags.label_type = wspace.label_type; /* copy label type */ if (wspace.label_match & ^rcse.must_auto_register) | rcpd.modes.authentication_level = No_authentication | rcse.group_id = "Initializer.SysDaemon.z" then do; /* We are done */ wspace.rewind_state = 1; STATE (2): wspace.tape_state_4_state = 2; call rewind (); if wspace.wait then goto RETURN; call ioi_$set_status (ioi_index, 0, 0, ecode); if ecode = 0 then do; rcse.state = 4; wspace.state = 0; if ^write_flag & wspace.label_name ^= "" then rcse.volume_name = wspace.label_name; rcse.flags.volume_density_index = DENSITY_INDEX (wspace.i); /* return density */ rcse.flags.label_type = wspace.label_type; /* and label type */ end; end; else do; /* label did not match. */ STATE (3): wspace.tape_state_4_state = 3; call get_authentication (); if wspace.wait then goto RETURN; if rcse.flags.have_auth then do; /* We are done */ wspace.rewind_state = 1; STATE (4): wspace.tape_state_4_state = 4; call rewind (); if wspace.wait then goto RETURN; call ioi_$set_status (ioi_index, 0, 0, ecode); if ecode = 0 then do; rcse.state = 4; wspace.state = 0; if ^write_flag & wspace.label_name ^= "" then rcse.volume_name = wspace.label_name; rcse.flags.volume_density_index = DENSITY_INDEX (wspace.i); /* return density */ rcse.flags.label_type = wspace.label_type; /* and label type */ end; if rcse.flags.must_auto_register /* Must ask RCPRM to register this volume for this user. */ then call rcp_auto_register_ (VOLUME_TYPE (TAPE_VOL_VTYPEX), (users_requested_volume_name), (rcse.group_id), ecode); end; else do; /* authentication was denied. */ call admin_gate_$syserr (0, "RCP: Authentication code for ^a does not match.", rcse.device_name); wspace.retry_count = 0; /* start over with a new tape. */ call REREADY_TAPE ("1"b); /* Remount the (hopefully) correct tape. */ end; end; RETURN: arg_ecode = ecode; return; /* */ REREADY_TAPE: procedure (remount_flag); /* This procedure is called to tell the operator to ready the tape again. * We will have to wspace.wait for the special again. */ dcl remount_flag bit (1); /* ON => remount, OFF => reready. */ if wspace.retry_count = max_num_retries /* Have we retried too many times. */ then do; /* Yes, abort attachment. */ ecode = error_table_$device_attention; return; end; wspace.retry_count = wspace.retry_count + 1; /* Turn ON mount timer. */ device_off = rcse.device_off; /* Get RCPD offset of this device. */ write_flag = rcse.flags.writing; /* Pass on write flag. */ call rcp_mount_timer_$set (device_off, write_flag, ecode); if ecode ^= 0 then return; if remount_flag /* Remount or reready? */ then do; /* Remount. */ istat.completion.st = "0"b; /* Unload reel for operator. */ addr (wspace.idcw) -> idcw.command = rewind_unload_command; call ioi_$connect (ioi_index, 0, ecode); call admin_gate_$syserr (3, "RCP: Remount Reel ^[scratch^s^;^a^] ^a ring on ^a", (rcse.volume_name = ""), rcse.volume_name, wspace.ring_comment, rcse.device_name); end; else if rcse.flags.preloaded then call admin_gate_$syserr (3, "RCP: Reready Reel ^a on ^a for ^a", rcse.volume_name, rcse.device_name, rcse.group_id); else call admin_gate_$syserr (3, "RCP: Reready ^a", rcse.device_name); wspace.state = wspace.mount_state; /* Wait for special(s) again. */ end REREADY_TAPE; /* */ read_label: proc; goto STATE (wspace.read_label_state); STATE (1): wspace.read_label_state = 1; wspace.record_read = "0"b; wspace.unreadable_tape = "0"b; wspace.i = 1; /* Start at NRZI density of 800 bpi. */ wspace.nrzi_den_set = "0"b; /* Haven't sucessfully set one yet. */ try_next_density: /* There is only one transfer to this label. */ wspace.set_density_state = 1; STATE (2): wspace.read_label_state = 2; call set_density (); if wspace.wait then return; if wspace.den_set then do; wspace.nrzi_den_set = "1"b; wspace.read_record_state = 1; STATE (3): wspace.read_label_state = 3; call read_record (); if wspace.wait then return; if wspace.bad_mode then do; /* May be PE mode, 1600 bpi. */ try_pe: wspace.rewind_state = 1; STATE (4): wspace.read_label_state = 4; call rewind (); /* Back to load point to set new density. */ if wspace.wait then return; wspace.set_density_state = 1; STATE (5): wspace.read_label_state = 5; wspace.i = 4; /* Code for 1600 bpi. */ call set_density (); if wspace.wait then return; if wspace.den_set then do; wspace.read_record_state = 1; STATE (6): wspace.read_label_state = 6; call read_record (); if wspace.wait then return; if wspace.bad_mode then do; /* Must be GCR mode, 6250 bpi. */ try_gcr: wspace.rewind_state = 1; STATE (8): wspace.read_label_state = 8; call rewind (); /* Back to load point to set new density. */ if wspace.wait then return; wspace.set_density_state = 1; STATE (9): wspace.read_label_state = 9; wspace.i = 5; /* Code for 6250 bpi. */ call set_density (); if wspace.wait then return; if wspace.den_set then do; wspace.read_record_state = 1; STATE (10): wspace.read_label_state = 10; call read_record (); if wspace.wait then return; if wspace.bad_mode then do; /* This should never happen. */ wspace.unreadable_tape = "1"b; /* Tried NRZI, PE, and GCR modes and still got bad mode. */ end; else if wspace.blank_tape | wspace.record_read then do; /* Success. */ wspace.unreadable_tape = "0"b; end; else if wspace.manual_halt then do; /* Drive in standby. */ wspace.unreadable_tape = "1"b; end; else do; /* Tape is unreadable at the only GCR density. */ wspace.unreadable_tape = "1"b; end; end; else do; /* Could'nt try the only available GCR density. */ wspace.unreadable_tape = "1"b; end; end; /* Must be GCR mode, 6250 bpi. */ else if wspace.blank_tape | wspace.record_read then do; /* Success. */ wspace.unreadable_tape = "0"b; end; else if wspace.manual_halt then do;/* Drive in standby. */ wspace.unreadable_tape = "1"b; end; else do; /* Tape is unreadable at the only PE density. */ wspace.unreadable_tape = "1"b; end; end; else do; /* Could'nt try the only available PE density. */ goto try_gcr; /* Maybe it is GCR, 6250 bpi. */ end; end; /* May be PE mode, 1600 bpi. */ else if wspace.blank_tape | wspace.record_read then do; /* Success. */ wspace.unreadable_tape = "0"b; end; else if wspace.manual_halt then do; /* Drive in standby. */ wspace.unreadable_tape = "1"b; end; else do; /* Unreadable at this NRZI density. */ wrong_density: /* There is only one transfer to this label. */ wspace.unreadable_tape = "1"b; wspace.i = wspace.i + 1; /* Try all 3 NRZI densities */ if wspace.i <= 3 /* before giving up. */ then do; wspace.rewind_state = 1; STATE (7): wspace.read_label_state = 7; call rewind (); /* Back to load point to set new density. */ if wspace.wait then return; goto try_next_density; /* This is the only transfer to this label. */ end; else do; /* Maybe no NRZI density could be set. */ if ^wspace.nrzi_den_set then goto try_pe; end; end; end; else goto wrong_density; /* Could'nt use this NRZI density. */ /* This is the only transfer to this label. */ end read_label; /* */ set_density: proc; /* This procedure uses wspace.i to pick out the density that it is supposed to set. */ goto STATE (wspace.set_density_state); STATE (1): wspace.set_density_state = 1; addr (wspace.idcw) -> idcw.command = density (wspace.i); istat.completion.st = "0"b; call ioi_$connect (ioi_index, 0, ecode); /* Initiate the set density command. */ STATE (2): wspace.set_density_state = 2; if istat.completion.st & istat.level = 3 then do; /* We have some status back */ wspace.wait = "0"b; /* Don't need to wait any more. */ if istat.completion.er then wspace.den_set = "0"b; /* Some error setting the density. */ else wspace.den_set = "1"b; /* Everything is OK. */ end; else wspace.wait = "1"b; /* Must let our caller wait for an event. */ end set_density; /* */ read_record: proc; /* This procedure tries to read the first good record on the tape. The first record is assumed to be the tape label. Notice that even though the Multics Standard Tape (MST) format normally will write up to 64 records to get a good copy for the label record it always backspaces and rewrites until it gets a good label as the first record on the tape. */ goto STATE (wspace.read_record_state); STATE (1): wspace.read_record_state = 1; wspace.j = 1; wspace.record_read = "0"b; wspace.bad_mode = "0"b; wspace.blank_tape = "0"b; wspace.manual_halt = "0"b; istat.completion.st = "0"b; call ioi_$connect (ioi_index, 1, ecode); /* Initiate the read record binary command. */ STATE (2): wspace.read_record_state = 2; if istat.completion.st & istat.level = 3 then do; wspace.wait = "0"b; /* Don't need to wait anymore. */ if istat.completion.er then do; /* Some error occured while reading. */ statp = addr (istat.iom_stat); if status.major = "1010"b /* MPC Device Attention */ & status.sub = "001000"b /* Incompatible Mode */ then do; wspace.bad_mode = "1"b; end; else if status.major = "0011"b /* Device Data Alert */ & status.sub = "000010"b /* Blank Tape on Read */ then do; wspace.blank_tape = "1"b; end; else if status.major = "0010"b /* Device attention */ & (status.sub & "100110"b) = "000100"b /* Device in standby */ then do; wspace.manual_halt = "1"b; end; else ; /* Some other error, give up. */ end; else do; /* Good read. */ wspace.record_read = "1"b; end; end; else wspace.wait = "1"b; /* Let our caller wait for an event. */ end read_record; /* */ rewind: proc; goto STATE (wspace.rewind_state); STATE (1): wspace.rewind_state = 1; istat.completion.st = "0"b; call ioi_$connect (ioi_index, 3, ecode); /* Initiate the rewind command */ STATE (2): wspace.rewind_state = 2; if istat.completion.st & istat.level = 3 then do; /* We got the status from start of rewind. */ if istat.completion.er then do; call admin_gate_$syserr (3, "RCP: Manually rewind and reready ^a.", rcse.device_name); call rcp_mount_timer_$set ((rcse.device_off), (rcse.flags.writing), ecode); end; STATE (3): wspace.rewind_state = 3; call ioi_$get_special_status (ioi_index, special_flag, special_status_word, ecode); if ecode ^= 0 | ^special_flag then wspace.wait = "1"b; /* wait some more for the special. */ else do; /* tape is finished rewinding. */ call rcp_mount_timer_$reset ((rcse.device_off), ecode); wspace.wait = "0"b; end; end; else wspace.wait = "1"b; /* Let our caller wait for an event. */ end rewind; /* */ get_authentication: proc; dcl authentication_label_name char (32); goto STATE (wspace.get_authentication_state); STATE (1): wspace.get_authentication_state = 1; rcse.flags.need_auth = "1"b; rcse.flags.have_auth = "0"b; rcse.flags.auth_set = "0"b; /* Get rid of non-printable chars by replacing with ".", 208+208 = 416 because of implementation restriction */ authentication_label_name = translate (wspace.label_name, (208)"." || (208)".", substr (collate9 (), 1, 32) || substr (collate9 (), 128)); call admin_gate_$syserr (3, "RCP: Authenticate ^a. It has ^a label ^[(Manual Halt)^2s^;^a^[ (with non-blank accessibility code)^]^].^[ RCP: WARNING!! IF YOU AUTHENTICATE THIS REQUEST ^a WILL OWN VOLUME ^a!^]", rcse.device_name, Tape_volume_types (wspace.label_type), wspace.manual_halt, authentication_label_name, wspace.ansi_non_blank_access, rcse.flags.must_auto_register, rcse.group_id, rcse.volume_name); device_off = rcse.device_off; write_flag = rcse.flags.writing; call rcp_mount_timer_$set (device_off, write_flag, ecode); STATE (2): wspace.get_authentication_state = 2; if rcse.flags.auth_set then do; /* The operator has responded. */ wspace.wait = "0"b; device_off = rcse.device_off; call rcp_mount_timer_$reset (device_off, ecode); end; else wspace.wait = "1"b; /* Let our caller wait for an event. */ end get_authentication; /* */ validate_tape_label: proc (label_ptr, user_label, label_match, label_name, label_type); dcl ( label_ptr ptr, /* pointer to label record from tape. */ user_label char (*) aligned, /* user specified volume id. */ label_match bit (1), /* true if labels match, false otherwise. */ label_name char (32), /* volume id from tape label record. */ label_type fixed bin ) parameter; /* type of label. */ dcl user_name char (32), /* fixed length user label. */ canon_user_name char (32), /* canonicalized user name. */ canon_label_name char (32), /* canonicalized label name. */ label_auth char (3), /* authentication code from label */ computed_auth_code char (3) aligned; /* computer from user name */ /* TAPE LABEL FORMATS */ dcl 1 mult based (label_ptr) unaligned, /* Multics standard version 1 label structure */ 2 lab_id bit (36), /* this will be 670314355245 in octal */ 2 pad (15) bit (36), /* we ignore this */ 2 vol_id char (32); /* this is in ascii */ dcl 1 gcos based (label_ptr) unaligned, 2 lab_id bit (12 * 6), /* this will be "GE 600 BTL " in bcd */ 2 installation_id bit (6 * 6), /* we ignore this */ 2 pad_vol_id bit (6), /* pad first bit of vol_id as it is not used */ 2 vol_id bit (6 * 6), /* this is in bcd */ 2 (file_ser, reel_seq, creation_date, retention_days, file_name) bit (6 * 6), /* we don't use these */ 2 label_auth bit (3 * 6); /* authentication code */ dcl 1 ibm based (label_ptr) unaligned, 2 lab_id bit (4 * 8), /* this will be "VOL1" in ebcdic */ 2 vol_id bit (6 * 8), /* this is in ebcdic */ 2 reserved bit (31 * 8), /* we don't use these */ 2 label_auth bit (10 * 8); /* authentication code */ dcl 1 ansi based (label_ptr) unaligned, 2 lab_id bit (4 * 8), /* this will be "VOL1" in ascii (8 bit) */ 2 vol_id bit (6 * 8), /* this is in 8 bit ascii */ 2 accessibility bit (1 * 8), /* this is in 8 bit ascii, blank--OK, non-blank--authenticate */ 2 reserved bit (26 * 8), /* we don't use these */ 2 label_auth bit (14 * 8); /* authentication code */ /* Now see if we can find a volume id on this tape label. */ label_name = ""; label_auth = ""; label_type = Volume_unknown_format; user_name = user_label; if wspace.blank_tape then label_type = Volume_blank; else if wspace.unreadable_tape | wspace.manual_halt then label_type = Volume_unreadable; else if mult.lab_id = header_c1 then do; /* Version 1 Multics standard label? */ label_type = Volume_multics_tape; label_name = mult.vol_id; /* get the volume id. */ label_auth = "***"; end; else if mult.lab_id = label_c1 /* Version 2 Multics standard label? */ then if (label_ptr -> mst_label.head.c1 = header_c1 & label_ptr -> mst_label.head.label) /* if all this is true yes */ then do; label_type = Volume_multics_tape; label_name = label_ptr -> mst_label.tape_reel_id; /* get the volume id. */ label_auth = "***"; end; else ; else if gcos.lab_id = "272520200600002022634320"b3 then do; /* "GE 600 BTL " in bcd */ label_type = Volume_gcos_tape; call bcd_to_ascii_ (string (gcos.vol_id), label_name); call bcd_to_ascii_ (string (gcos.label_auth), label_auth); end; else if ibm.lab_id = "E5D6D3F1"b4 then do; /* "VOL1" in 8 bit ebcdic */ label_type = Volume_ibm_tape; call ebcdic8_to_ascii_ (string (ibm.vol_id), label_name); call ebcdic8_to_ascii_ (string (ibm.label_auth), label_auth); end; else if ansi.lab_id = "564F4C31"b4 then do; /* "VOL1"b in 8 bit ascii */ label_type = Volume_ansi_tape; call unpack (ansi.vol_id, label_name); call unpack (ansi.label_auth, label_auth); if ansi.accessibility ^= "20"b4 then wspace.ansi_non_blank_access = "1"b; end; else label_type = Volume_unknown_format; /* Doesn't look like a recognizable label */ /* Now see if the tape label we found matches the user specified label. */ if label_name = "" then do; label_match = ""b; return; end; label_match = "1"b; /* assume so unless we turn it off */ if rcpd.modes.authentication_level = Manual_authentication then do; label_match = ""b; return; end; /* nominal authentication mechanism is here */ if wspace.ansi_non_blank_access then do; /* Always authenticate this. */ label_match = "0"b; return; end; /* canonicalize the tape label just read */ call canon_for_volume_label_ (VOLUME_TYPE (TAPE_VOL_VTYPEX), label_name, canon_label_name, label_type, ecode); if ecode ^= 0 then label_match = ""b; else do; /* canonicalize the user name */ call canon_for_volume_label_ (VOLUME_TYPE (TAPE_VOL_VTYPEX), user_name, canon_user_name, label_type, ecode) ; if ecode ^= 0 then label_match = ""b; else if canon_user_name ^= canon_label_name then label_match = ""b; end; if rcpd.modes.authentication_level = Nominal_authentication | rcpd.modes.authentication_level = No_authentication | rcse.group_id = "Initializer.SysDaemon.z" then do; label_name = canon_label_name; return; end; /* full, secure automatic authentication mechanism is here */ if label_type = Volume_multics_tape then return; /* no further checks necessary */ computed_auth_code = authenticate_ (user_name); if computed_auth_code ^= label_auth then label_match = ""b; return; end validate_tape_label; /* */ unpack: proc (input, output); dcl input bit (*); dcl output char (*); dcl char_code fixed bin (17); dcl char_limit fixed bin; dcl input_chars (1:divide (length (input), 8, 24)) bit (8) based (addr (input)); dcl char_index fixed bin; output = ""; char_limit = min (hbound (input_chars, 1), length (output)); do char_index = lbound (input_chars, 1) to char_limit by 1; char_code = fixed (input_chars (char_index), 17); substr (output, char_index, 1) = substr (collate9 (), char_code + 1, 1); end; end unpack; Print_Mount_Message: proc (); dcl rcp_pointers_$data entry () returns (ptr); dcl rcprm_find_resource_$status entry (ptr, char (*), fixed bin (35)); if ^rcp_pointers_$data () -> rcpd.modes.resource_mgmt_enabled then call admin_gate_$syserr (3, "RCP: Mount Reel ^[scratch^s^;^a^] ^a ring on ^a for ^a", (rcse.volume_name = ""), rcse.volume_name, wspace.ring_comment, rcse.device_name, rcse.group_id); else do; Resource_count = 1; begin; dcl garbage (size (resource_descriptions)) bit (36); string (garbage) = ""b; resource_desc_ptr = addr (garbage); resource_descriptions.version_no = resource_desc_version_1; resource_descriptions.n_items = 1; resource_descriptions.item (1).type = VOLUME_TYPE (TAPE_VOL_VTYPEX); resource_descriptions.item (1).name = rcse.volume_name; resource_descriptions.item (1).given.name = "1"b; call rcprm_find_resource_$status (resource_desc_ptr, (rcs.acs_directory), ecode); if ecode = error_table_$action_not_performed then ecode = resource_descriptions.item (1).status_code; if ecode ^= 0 /* We won't try to print location if we can't get it. */ then do; resource_descriptions.item (1).location = ""; ecode = 0; end; call admin_gate_$syserr (3, "RCP: Mount ^[(from ""^a"") ^;^s^]Reel ^a ^a ring on ^a for ^a", (resource_descriptions.item (1).location ^= ""), resource_descriptions.item (1).location, rcse.volume_name, wspace.ring_comment, rcse.device_name, rcse.group_id); end; end; return; end Print_Mount_Message; /* BEGIN MESSAGE DOCUMENTATION Message: RCP: Mount Reel REELID with(out) ring on DRIVE for PERSON.PROJ.T. S: $beep T: $run M: A user process has requested the mounting of tape reel REELID on drive DRIVE. A: Locate the requested reel. Check to make sure that the user PERSON.PROJ is allowed to use the reel. Insert or remove a write ring as specified. Mount the reel on the specified drive. If the reel cannot be mounted, either because it cannot be located, access is incorrect, or the drive is down, use the "x deny" function to reject the mount request. Message: RCP: Remount Reel REELID with(out) ring on DRIVE. S: $beep T: $run M: The system found a write ring when one was not required, or did not find one when one was needed. Or the authentication code did not match. The tape is unloaded. A: Correct the write ring status or mount the correct tape and reready the tape. Message: RCP: Reready DRIVE. S: $beep T: $run M: DRIVE has dropped out of ready status. A: Reready it. Message: RCP: Authentication code for DRIVE does not match. S: $info T: $run M: The authentication code typed for the volume on DRIVE does no match the user specified volume name. A: $ignore Message: RCP: Authenticate DRIVE. It has LABEL_TYPE label LABEL. S: $beep T: $run M: The system cannot determine that the volume on DRIVE is the one requested. The operator must authenticate the volume. The label read from the tape on DEVICE was of type LABEL_TYPE and was LABEL. If LABEL is "(Manual Halt)" this indicates that the tape drive was found in standby while trying to read/verify the label. If LABEL_TYPE is ANSI and LABEL is "