?? RIGHT := 110 ??
?? NEWTITLE := ' NOS/VE File Server: Server: Family Client Access Manager', EJECT ??
MODULE dfm$family_client_manager;

{ PURPOSE:
{   The purpose of this module is to provide procedures for the
{   creation, display, and maintenance of client family accesses.
{
{ DESIGN:
{   Each family on the server mainframe can be assigned a particular
{   "family access" for one or more client mainframes. The family access
{   determines how a user on the client mainframe may access the family.
{   At installation deadstart time all families allow no access from any
{   client. The CHANGE_CLIENT_ACCESS (implemented in this module) allows the
{   site personnel on the server mainframes to specify how the client users
{   may access server files.
{
{   Access designations start as catalog permits and are also placed in the
{   set/family table.  At recovery deadstart time, the catlog permits are
{   used to re-generate the access information in the set/family table.
{   Manipulations of the set/family are performed by procedures in Ring 1.
{
{   The catalog permits for the access designations of a family consist of
{   "family" groups with the "family_name" being the name of the client
{   mainframe prefixed with the 3 characters "DF$".  Application_information
{   is used to store the family access allowed.
{
{   On the change_client_access command and in the application_information
{   of the catalog permit the family_access is a single name.
{   In the served family table, and family table this single 'access' is
{   stored as a set of family_access_kinds under the following rules.
{   Login implies login and file access.
{   Leveled_access implies login and file access.
{
{ NOTES:
{   1. The order of procedures in this deck is
{       .XDCL procedures.
{       .Local procedures
{      Procedures are arranged alphabetically within each group.

?? TITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc amt$file_identifier
*copyc cle$all_must_be_used_alone
*copyc dfe$error_condition_codes
*copyc dft$family_access
*copyc dft$family_list
*copyc dft$served_family_table_index
*copyc jmc$system_family
*copyc ost$family_table
?? POP ??
*copyc amp$put_next
*copyc clp$get_set_count
*copyc clp$get_value
*copyc clp$scan_argument_list
*copyc clp$scan_parameter_list
*copyc dfp$crack_mainframe_id
*copyc dfp$find_mainframe_id
*copyc dfp$get_partner_mainframes
*copyc dfi$display
*copyc dfi$fsp_open_close
*copyc dfp$verify_system_administrator
*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$clear_mainframe_sig_lock
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$get_accessed_families
*copyc osp$get_accessed_clients
*copyc osp$get_client_family_access
*copyc osp$get_families_for_client
*copyc osp$set_client_access
*copyc osp$set_mainframe_sig_lock
*copyc osp$set_status_abnormal
*copyc osp$verify_system_privilege
*copyc pfp$find_direct_info_record
*copyc pfp$find_directory_array
*copyc pfp$find_next_info_record
*copyc pfp$find_permit_array
*copyc pfp$get_item_info
*copyc pfp$permit_catalog
*copyc pfp$validate_local_family
*copyc pmp$convert_binary_mainframe_id
*copyc pmp$convert_mainframe_to_binary
*copyc amv$nil_file_identifier
*copyc dfv$number_served_family_lists
*copyc osv$family_table
*copyc osv$system_family_name
?? TITLE := 'Global Declarations Declared by This Module', EJECT ??
  {Constants used for translating family access to legible and vice-versa

  CONST
    access_value_size_in_app_info = 7,
    legible_for_remote_file_access = 'FILE   ',
    legible_for_remote_login_access = 'LOGIN  ',
    legible_for_job_leveling_access = 'LEVELED';


?? TITLE := '     [XDCL, #GATE] dfp$change_client_access', EJECT ??

{ PURPOSE:
{   The purpose of this request is to change the family access allowed to
{   specified clients. This command can be issued only by the system       .
{   administrator.
{
{ NOTES:
{
{   1.This command is disallowed if any family-client combination exists
{     such that the access of the family before this command is not NONE
{     and the state of the client is active, inactive or deactivated. That
{     is, no family known to a client can have its access changed unless
{     the client is terminated.
{
{   2.For each client in an active state, the list of new families (access
{     changed from NONE) will be transmitted to the client.  This is done
{     by the server notifying the client that new families exist and the
{     client sending a verify_family request poll as though the operator
{     had typed a DEFINE_SERVED_FAMILY command.

  PROCEDURE [XDCL, #GATE] dfp$change_client_access_cmnd
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ pdt change_client_access_pdt (
{ client_mainframe_identifier, client_mainframe_identifiers, cmi: ..
{         list 1 .. dfc$maximum_partner_mainframes of name ..
{         pmc$mainframe_id_size or key all = $required
{ family, families, f: list 1 .. dfc$max_family_parameters of name = $required
{ family_access, fa: key file_access, fa, login, l, leveled_access, ..
{         la, none = $required
{ status)

?? PUSH (LISTEXT := ON) ??

    VAR
      change_client_access_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^change_client_access_pdt_names, ^change_client_access_pdt_params];

    VAR
      change_client_access_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 9] of
            clt$parameter_name_descriptor := [['CLIENT_MAINFRAME_IDENTIFIER', 1],
            ['CLIENT_MAINFRAME_IDENTIFIERS', 1], ['CMI', 1], ['FAMILY', 2], ['FAMILIES', 2], ['F', 2],
            ['FAMILY_ACCESS', 3], ['FA', 3], ['STATUS', 4]];

    VAR
      change_client_access_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 4] of
            clt$parameter_descriptor := [

{ CLIENT_MAINFRAME_IDENTIFIER CLIENT_MAINFRAME_IDENTIFIERS CMI }
      [[clc$required], 1, dfc$maximum_partner_mainframes, 1, 1, clc$value_range_not_allowed,
            [^change_client_access_pdt_kv1, clc$name_value, pmc$mainframe_id_size, pmc$mainframe_id_size]],

{ FAMILY FAMILIES F }
      [[clc$required], 1, dfc$max_family_parameters, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$name_value, 1, osc$max_name_size]],

{ FAMILY_ACCESS FA }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed,
            [^change_client_access_pdt_kv3, clc$keyword_value]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$variable_reference, clc$array_not_allowed, clc$status_value]]];

    VAR
      change_client_access_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1] of
            ost$name := ['ALL'];

    VAR
      change_client_access_pdt_kv3: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 7] of
            ost$name := ['FILE_ACCESS', 'FA', 'LOGIN', 'L', 'LEVELED_ACCESS', 'LA', 'NONE'];

?? POP ??

    VAR
      all_clients: boolean,
      application_info: pft$application_info,
      client_index: 0 .. clc$max_value_sets,
      family: ost$family_name,
      family_access: dft$family_access,
      family_index: 0 .. clc$max_value_sets,
      found: boolean,
      group: pft$group,
      mainframe_found: boolean,
      number_of_clients: 0 .. dfc$maximum_partner_mainframes,
      number_of_clients_input: 0 .. clc$max_value_sets,
      number_of_families: 0 .. dfc$max_family_ptr_array_size,
      number_of_families_input: 0 .. clc$max_value_sets,
      path: array [1 .. 2] of pft$name,
      permit_selections: pft$permit_selections,
      p_binary_client_list: ^array [1 .. * ] of pmt$binary_mainframe_id,
      p_client_list: ^array [1 .. * ] of pmt$mainframe_id,
      p_family_list: ^array [1 .. * ] of ost$family_name,
      set_table_family_access: dft$family_access,
      share_requirements: pft$share_requirements,
      value: clt$value;

    status.normal := TRUE;

    dfp$verify_system_administrator ('CHANGE_CLIENT_ACCESS', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{
{   Process the input parameters.
{

    clp$scan_parameter_list (parameter_list, change_client_access_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('CLIENT_MAINFRAME_IDENTIFIER', number_of_clients_input, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    number_of_clients := number_of_clients_input;

    PUSH p_binary_client_list: [1 .. number_of_clients];
    PUSH p_client_list: [1 .. number_of_clients];
    crack_clients (number_of_clients, p_client_list, p_binary_client_list, all_clients, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('FAMILY', number_of_families_input, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    number_of_families := number_of_families_input;

    PUSH p_family_list: [1 .. number_of_families];

    crack_families (number_of_families, number_of_clients, p_client_list, all_clients, p_family_list, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    crack_family_access (family_access, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{
{   Input parameters have been cracked and checked.
{   Generate the permanent file permits for each family. The type of permit
{   is "family" and the "family name" is the client mainframe name prefixed
{   with "DF$".
{

    path [2] := jmc$system_user;

    group.group_type := pfc$family;

    permit_selections := $pft$permit_selections [];
    share_requirements := -$pft$share_requirements [];

    build_a_i_from_family_access (family_access, application_info);

    FOR family_index := 1 TO number_of_families DO
      family := p_family_list^ [family_index];
      path [1] := family;

      IF all_clients THEN
        group.family_description.family (1, * ) := 'DF$ALL';
        pfp$permit_catalog (path, group, permit_selections, share_requirements, application_info, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      ELSE
        FOR client_index := 1 TO number_of_clients DO
          group.family_description.family (1, * ) := 'DF$';
          group.family_description.family (4, * ) := p_client_list^ [client_index];
          pfp$permit_catalog (path, group, permit_selections, share_requirements, application_info, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        FOREND;
      IFEND;

{
{     Generate the family/set table entries
{

      osp$set_client_access (family, family_access, all_clients, p_binary_client_list, number_of_clients,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;

{
{   Set flags to inform clients that new families exist.
{

    set_verify_family (all_clients, p_client_list, status);

  PROCEND dfp$change_client_access_cmnd;

?? TITLE := '  [XDCL, #GATE] dfp$display_client_access_cmnd', EJECT ??

{ PURPOSE:
{   The purpose of this request is to display the family accesses for the
{   specified client mainframe(s). This command can be issued only by the
{   system administrator.
{

  PROCEDURE [XDCL, #GATE] dfp$display_client_access_cmnd
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{  pdt display_client_pdt (
{   client_mainframe_identifier, client_mainframe_identifiers, cmi, ..
{         mainframe_identifier, mi: ..
{         list 1 .. dfc$maximum_partner_mainframes of name ..
{         pmc$mainframe_id_size or key all = $required
{    output, o: file = $OUTPUT
{    status)

?? PUSH (LISTEXT := ON) ??

  VAR
    display_client_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^display_client_pdt_names,
  ^display_client_pdt_params];

  VAR
    display_client_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 8] of
  clt$parameter_name_descriptor := [['CLIENT_MAINFRAME_IDENTIFIER', 1], ['CLIENT_MAINFRAME_IDENTIFIERS', 1], [
  'CMI', 1], ['MAINFRAME_IDENTIFIER', 1], ['MI', 1], ['OUTPUT', 2], ['O', 2], ['STATUS', 3]];

  VAR
    display_client_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of clt$parameter_descriptor
  := [

{ CLIENT_MAINFRAME_IDENTIFIER CLIENT_MAINFRAME_IDENTIFIERS CMI MAINFRAME_IDENTIFIER MI }
    [[clc$required], 1, dfc$maximum_partner_mainframes, 1, 1, clc$value_range_not_allowed, [^
  display_client_pdt_kv1, clc$name_value, pmc$mainframe_id_size, pmc$mainframe_id_size]],

{ OUTPUT O }
    [[clc$optional_with_default, ^display_client_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
  clc$file_value]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
  clc$array_not_allowed, clc$status_value]]];

  VAR
    display_client_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1] of ost$name := ['ALL'];

  VAR
    display_client_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (7) := '$OUTPUT';

?? POP ??
?? NEWTITLE := 'abort_handler', EJECT ??

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

       clean_up;

    PROCEND abort_handler;
?? TITLE := 'clean_up', EJECT ??

    PROCEDURE clean_up;

      VAR
        ignore_status: ost$status;

      IF output_fid <> amv$nil_file_identifier THEN
        dfp$fsp_close (output_fid, seqp, ignore_status);
      IFEND;

    PROCEND clean_up;
?? OLDTITLE, EJECT ??

    VAR
      access_list: array [1 .. dfc$max_family_ptr_array_size] of dft$family_access,
      all_clients: boolean,
      application_info: pft$application_info,
      client_binary_id: pmt$binary_mainframe_id,
      client_count: 0 .. dfc$maximum_partner_mainframes,
      client_index: 1 .. dfc$maximum_partner_mainframes,
      family_count: 0 .. dfc$max_family_ptr_array_size,
      family_list: array [1 .. dfc$max_family_ptr_array_size] of ost$family_name,
      header_written: boolean,
      ignore_byte_address: amt$file_byte_address,
      ignore_eoi: amt$file_byte_address,
      index: 1 .. dfc$max_family_ptr_array_size,
      local_status: ost$status,
      line: string (100),
      mainframe_id: pmt$binary_mainframe_id,
      mainframe_name: pmt$mainframe_id,
      number_of_clients_input: 0 .. clc$max_value_sets,
      output_fid: amt$file_identifier,
      output_file_name: amt$local_file_name,
      p_binary_client_list: ^array [1 .. dfc$maximum_partner_mainframes] of pmt$binary_mainframe_id,
      p_client_names: ^array [1 .. *] of pmt$mainframe_id,
      search_completed: boolean,
      seqp: ^SEQ ( * ),
      size: integer,
      value: clt$value;

    dfp$verify_system_administrator ('DISPLAY_CLIENT_ACCESS', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$scan_parameter_list (parameter_list, display_client_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('CLIENT_MAINFRAME_IDENTIFIER', number_of_clients_input, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    client_count := number_of_clients_input;
    all_clients := FALSE;

    IF number_of_clients_input = 1 THEN
      clp$get_value ('CLIENT_MAINFRAME_IDENTIFIER', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF value.name.value = 'ALL' THEN
        all_clients := TRUE;
        PUSH p_binary_client_list;
        osp$get_accessed_clients (p_binary_client_list, client_count);
      IFEND;
    IFEND;

    clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    output_file_name := value.file.local_file_name;

    output_fid := amv$nil_file_identifier;
    osp$establish_block_exit_hndlr (^abort_handler);

    dfp$fsp_open (output_file_name, amc$record, {read_not_write} FALSE,
          {open_for_attach} FALSE, {seq_and_read_behind} FALSE,
          'DISPLAY_CLIENT_ACCESS', output_fid, seqp, ignore_eoi, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    header_written := FALSE;
 /process_clients/
    FOR client_index := 1 TO client_count DO
      IF all_clients THEN
        client_binary_id := p_binary_client_list^ [client_index];
        pmp$convert_binary_mainframe_id (client_binary_id, mainframe_name, status);
        IF NOT status.normal THEN
          EXIT /process_clients/;
        IFEND;
      ELSE
        clp$get_value ('CLIENT_MAINFRAME_IDENTIFIER',  client_index, 1, clc$low, value, status);
        IF NOT status.normal THEN
          EXIT /process_clients/;
        IFEND;
        mainframe_name := value.name.value;
        IF mainframe_name = 'ALL' THEN
          osp$set_status_abnormal ('CL', cle$all_must_be_used_alone, 'CLIENT_MAINFRAME_IDENTIFIER',
                status);
          EXIT /process_clients/;
        IFEND;
        pmp$convert_mainframe_to_binary (mainframe_name, client_binary_id, status);
        IF NOT status.normal THEN
          EXIT /process_clients/;
        IFEND;
      IFEND;
      IF NOT header_written THEN
        header_written := TRUE;
        line := '  MAINFRAME             FAMILY';
        line (59, 6) := 'ACCESS';
        amp$put_next (output_fid, ^line, 65, ignore_byte_address, status);
        IF NOT status.normal THEN
          EXIT /process_clients/;
        IFEND;
      IFEND;

      amp$put_next (output_fid, ^line, 1, ignore_byte_address, status);
      IF NOT status.normal THEN
        EXIT /process_clients/;
      IFEND;

      osp$get_families_for_client (client_binary_id, ^family_list, ^access_list, family_count);

      FOR index := 1 TO family_count DO
        IF access_list [index] = $dft$family_access [] THEN
          application_info := 'NONE';
        ELSE
          build_a_i_from_family_access (access_list [index], application_info);
        IFEND;
        STRINGREP (line, size, '  ', mainframe_name, '     ', family_list[index], '   ',
              application_info (1, access_value_size_in_app_info));
        amp$put_next (output_fid, ^line, size, ignore_byte_address, status);
        IF NOT status.normal THEN
          EXIT /process_clients/;
        IFEND;
      FOREND;

      IF family_count = 0 THEN
        STRINGREP (line, size , '    No served families can be accessed by client mainframe ',
              mainframe_name);
        amp$put_next (output_fid, ^line, size, ignore_byte_address, status);
        IF NOT status.normal THEN
          EXIT /process_clients/;
        IFEND;
      IFEND;

    FOREND /process_clients/;

    IF client_count = 0 THEN
      line := '   (No served families can be accessed by any client.)';
      amp$put_next (output_fid, ^line, 70, ignore_byte_address, status);
    IFEND;

    dfp$fsp_close (output_fid, seqp, local_status);
    IF status.normal THEN
      status := local_status;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND dfp$display_client_access_cmnd;

?? TITLE := '  [XDCL] dfp$rebuild_set_table_clients', EJECT ??
*copy dfh$rebuild_set_table_clients

  PROCEDURE [XDCL] dfp$rebuild_set_table_clients
    (    family: ost$family_name;
     VAR status: ost$status);

    VAR
      binary_client_list: array [1 .. 1] of pmt$binary_mainframe_id,
      catalog_info_selections: pft$catalog_info_selections,
      family_access: dft$family_access,
      group: pft$group,
      info_segment_pointer: amt$segment_pointer,
      local_status: ost$status,
      mainframe_id: pmt$mainframe_id,
      number_of_clients: integer,
      path: array [1 .. 2] of pft$name,
      permit_index: pft$array_index,
      p_directory_array: pft$p_directory_array,
      p_info_record: pft$p_info_record,
      p_info: pft$p_info,
      p_permit_array: pft$p_permit_array;

    status.normal := TRUE;
    osp$verify_system_privilege;
    catalog_info_selections := $pft$catalog_info_selections
          [pfc$catalog_directory, pfc$catalog_permits, pfc$indirect_catalog_permits];

    path [1] := family;
    path [2] := jmc$system_user;

  /main/
    BEGIN

      mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, info_segment_pointer, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      p_info := info_segment_pointer.sequence_pointer;
      RESET p_info;

      group.group_type := pfc$member;
      group.member_description.family := osc$null_name;
      group.member_description.account := osc$null_name;
      group.member_description.project := osc$null_name;
      group.member_description.user := osc$null_name;

      pfp$get_item_info (path, group, catalog_info_selections, $pft$file_info_selections [], p_info, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      RESET p_info;

      pfp$find_next_info_record (p_info, p_info_record, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      pfp$find_directory_array (p_info_record, p_directory_array, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      IF p_directory_array = NIL THEN
        osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_master_catalog, family, status);
        EXIT /main/;
      IFEND;

      pfp$find_direct_info_record (^p_info_record^.body, p_directory_array^ [1].info_offset, p_info_record,
            status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      pfp$find_permit_array (p_info_record, p_permit_array, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      IF p_permit_array = NIL THEN
        EXIT /main/;
      IFEND;

{     Since osp$set_client_access sets all known clients to the access specifed,
{     ALL is processed first here in order to prevent resetting values which
{     may have been set after the "change_client_access all .." command had
{     been issued.

    /do_df$all_first/
      FOR permit_index := LOWERBOUND (p_permit_array^) TO UPPERBOUND (p_permit_array^) DO
        IF p_permit_array^ [permit_index].group.group_type = pfc$family THEN
          IF p_permit_array^ [permit_index].group.family_description.family = 'DF$ALL ' THEN
            get_family_access_from_a_i (p_permit_array^ [permit_index].application_info, family_access);
            osp$set_client_access (family, family_access, {all_mainframes =}
                  TRUE, ^binary_client_list, 1, status);
            IF NOT status.normal THEN
              EXIT /main/;
            IFEND;
            EXIT /do_df$all_first/;
          IFEND
        IFEND;
      FOREND /do_df$all_first/;

    /do_each_client/
      FOR permit_index := LOWERBOUND (p_permit_array^) TO UPPERBOUND (p_permit_array^) DO
        IF p_permit_array^ [permit_index].group.group_type = pfc$family THEN
          IF p_permit_array^ [permit_index].group.family_description.family = 'DF$ALL ' THEN
            CYCLE /do_each_client/;
          IFEND;
          IF p_permit_array^ [permit_index].group.family_description.family(1, 3) <> 'DF$' THEN
            CYCLE /do_each_client/;
          IFEND;
          mainframe_id := p_permit_array^ [permit_index].group.family_description.
                family (4, pmc$mainframe_id_size);
          pmp$convert_mainframe_to_binary (mainframe_id, binary_client_list [1], status);
          IF NOT status.normal THEN
            EXIT /main/;
          IFEND;
          get_family_access_from_a_i (p_permit_array^ [permit_index].application_info, family_access);
          osp$set_client_access (family, family_access, {all_mainframes =}
                FALSE, ^binary_client_list, 1, status);
          IF NOT status.normal THEN
            EXIT /main/;
          IFEND;

        IFEND;
      FOREND /do_each_client/;


    END /main/;

    IF info_segment_pointer.sequence_pointer <> NIL THEN
      mmp$delete_scratch_segment (info_segment_pointer, local_status);
      info_segment_pointer.sequence_pointer := NIL;
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

  PROCEND dfp$rebuild_set_table_clients;

?? TITLE := ' [XDCL, #GATE] dfp$$client_family_access', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to implement the command language
{   function $client_family_access.
{

  PROCEDURE [XDCL, #GATE] dfp$$client_family_access
    (    function_name: clt$name;
         argument_list: string ( * );
     VAR value: clt$value;
     VAR status: ost$status);

    VAR
      client_adt: [STATIC, READ, cls$adt] array [1 .. 2] of clt$argument_descriptor :=
            [[[clc$required], [NIL, clc$name_value, 1, osc$max_name_size]],
            [[clc$required], [NIL, clc$name_value, 1, osc$max_name_size]]];

    VAR
      access_string: pft$application_info,
      avt: array [1 .. 2] of clt$value,
      client_binary_id: pmt$binary_mainframe_id,
      client_mainframe_name: pmt$mainframe_id,
      family_access: dft$family_access,
      family_name: ost$family_name;

    clp$scan_argument_list (function_name, argument_list, ^client_adt, ^avt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    client_mainframe_name := avt [1].name.value;
    pmp$convert_mainframe_to_binary (client_mainframe_name, client_binary_id, status);
    IF NOT status.normal THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$improper_mainframe_id, client_mainframe_name, status);
      RETURN;
    IFEND;
    IF status.normal AND (client_binary_id.model_number = osc$cyber_180_model_unknown) THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$unknown_model_number,
            client_mainframe_name (9, pmc$processor_model_number_size), status);
      osp$append_status_parameter (osc$status_parameter_delimiter, client_mainframe_name, status);
      RETURN;
    IFEND;

    family_name := avt [2].name.value;
    osp$get_client_family_access (client_binary_id, family_name, family_access);

    value.descriptor := 'STRING';
    value.kind := clc$string_value;

    value.str.size := access_value_size_in_app_info;
    IF family_access = $dft$family_access [] THEN
      value.str.value := 'NONE';
    ELSE
      build_a_i_from_family_access (family_access, access_string);
      value.str.value := access_string;
    IFEND;

  PROCEND dfp$$client_family_access;
?? TITLE := ' build_a_i_from_family_access', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to build the application information
{   (actually a string) from the given specified family access.
{
{ NOTES:
{   1.Although family_access is a set the application_information is only
{     stored as one value (see the CHANGE_CLIENT_ACCESS command).
{

  PROCEDURE build_a_i_from_family_access
    (    family_access: dft$family_access;
     VAR application_info: pft$application_info);

    application_info := ' ';
    IF dfc$job_leveling_access IN family_access THEN
      application_info (1, access_value_size_in_app_info) := legible_for_job_leveling_access;
    ELSEIF dfc$remote_login_access IN family_access THEN
      application_info (1, access_value_size_in_app_info) := legible_for_remote_login_access;
    ELSEIF dfc$remote_file_access IN family_access THEN
      application_info (1, access_value_size_in_app_info) := legible_for_remote_file_access;
    IFEND;

  PROCEND build_a_i_from_family_access;

?? TITLE := ' crack_clients', EJECT ??

{ PURPOSE:
{   The purpose of this request is to crack and validate the
{   client_mainframe_identifier parameter of the change_client_access command.
{
{ NOTES:
{
{   1.This procedure ensures that the total number of client mainframes
{     known to this server does not exceed the maximum.  This requires
{     obtaining the list of all the currently known clients and checking
{     this list for each client specified. If a specified client is not in
{     the list, it will be added (locally) provided that the maximum is not
{     reached.

  PROCEDURE crack_clients
    (    number_of_clients: 1 .. dfc$maximum_partner_mainframes;
         p_client_list {output} : ^array [1 .. * ] of pmt$mainframe_id;
         p_binary_client_list {output} : ^array [1 .. * ] of pmt$binary_mainframe_id;
     VAR all_clients: boolean;
     VAR status: ost$status);

    VAR
      all_clients_array: array [1 .. dfc$maximum_partner_mainframes] of dft$partner_mainframe_entry,
      client_index: 0 .. clc$max_value_sets,
      found: boolean,
      i_client: 0 .. dfc$maximum_partner_mainframes,
      mainframe_name: pmt$mainframe_id,
      p_all_clients_array: ^dft$partner_mainframe_list,
      total_number_of_clients: 0 .. dfc$maximum_partner_mainframes,
      value: clt$value;

    status.normal := TRUE;
    all_clients := FALSE;

    IF number_of_clients = 1 THEN
      clp$get_value ('CLIENT_MAINFRAME_IDENTIFIER', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF value.name.value = 'ALL ' THEN
        all_clients := TRUE;
        RETURN;
      IFEND;
    IFEND;

    p_all_clients_array := ^all_clients_array;
    dfp$get_partner_mainframes (FALSE, p_all_clients_array, total_number_of_clients);

  /get_clients/
    FOR client_index := 1 TO number_of_clients DO
      clp$get_value ('CLIENT_MAINFRAME_IDENTIFIER', client_index, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      mainframe_name := value.name.value;
      IF mainframe_name = 'ALL' THEN
        osp$set_status_abnormal ('CL', cle$all_must_be_used_alone, 'CLIENT_MAINFRAME_IDENTIFIER', status);
        RETURN;
      IFEND;
      p_client_list^ [client_index] := mainframe_name;
      pmp$convert_mainframe_to_binary (mainframe_name, p_binary_client_list^ [client_index], status);
      IF (NOT status.normal) OR (status.normal AND (p_binary_client_list^ [client_index].model_number =
            osc$cyber_180_model_unknown)) THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$improper_mainframe_id, value.name.value, status);
        RETURN;
      IFEND;

      found := FALSE;

    /search_all_clients/
      FOR i_client := 1 TO total_number_of_clients DO
        IF all_clients_array [i_client].mainframe_id = p_binary_client_list^ [client_index] THEN
          found := TRUE;
          EXIT /search_all_clients/;
        IFEND;
      FOREND /search_all_clients/;

      IF NOT found THEN
        IF total_number_of_clients >= dfc$maximum_partner_mainframes THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$max_families_or_clients, 'clients', status);
          osp$append_status_integer (osc$status_parameter_delimiter, dfc$maximum_partner_mainframes, 10,
                FALSE, status);
          RETURN;
        IFEND;
        total_number_of_clients := total_number_of_clients + 1;
        all_clients_array [total_number_of_clients].mainframe_id := p_binary_client_list^ [client_index];
      IFEND;

    FOREND /get_clients/;

  PROCEND crack_clients;

?? TITLE := ' crack_families', EJECT ??

{ PURPOSE:
{   The purpose of this request is to crack and validate the
{   family parameter of the change_client_access command.
{
{ NOTES:
{
{   1.This procedure ensures that the total number accessible families
{     known to this server does not exceed the maximum.  This requires
{     obtaining the list of all the currently known families and checking
{     this list for each family specified. If a specified family is not in
{     the list, it will be added (locally) provided that the maximum is not
{     reached.
{
{   2.Since it is not permitted to change the access of a family which is
{     already accessible to an active client, checks must be made for
{     each family concerning possible current accesses by active clients.
{

  PROCEDURE crack_families
    (    number_of_families: 0 .. dfc$max_family_ptr_array_size;
         number_of_clients: 0 .. dfc$maximum_partner_mainframes;
         p_client_list: ^array [1 .. * ] of pmt$mainframe_id;
         all_clients: boolean;
         p_family_list: ^array [1 .. * ] of ost$family_name;
     VAR status: ost$status);

    VAR
      accessed_client_index: 1 .. dfc$maximum_partner_mainframes,
      all_families_array: array [1 .. dfc$max_family_ptr_array_size] of ost$family_name,
      client_access_array: array [1 .. dfc$maximum_partner_mainframes] of dft$family_access,
      client_index: 0 .. dfc$maximum_partner_mainframes,
      client_specified_on_command: boolean,
      clients_with_access_array: array [1 .. dfc$maximum_partner_mainframes] of pmt$mainframe_id,
      family: ost$family_name,
      family_index: 0 .. clc$max_value_sets,
      found: boolean,
      ignore_p_q_interf_direc: ^dft$q_interface_directory_entry,
      ignore_p_q_interf_table: dft$p_queue_interface_table,
      ignore_queue_index: dft$queue_index,
      i_family: 1 .. dfc$max_family_ptr_array_size,
      mainframe_found: boolean,
      mainframe_name: pmt$mainframe_id,
      max_families: 0 .. dfc$max_family_ptr_array_size,
      number_of_clients_with_access: 0 .. dfc$maximum_partner_mainframes,
      p_cpu_queue: ^dft$cpu_queue,
      server_state: dft$server_state,
      total_number_of_families: 0 .. dfc$max_family_ptr_array_size,
      value: clt$value;

    status.normal := TRUE;
    max_families := dfc$served_family_list_size * dfv$number_served_family_lists;
    osp$get_accessed_families (^all_families_array, total_number_of_families);

  /process_family_input/
    FOR family_index := 1 TO number_of_families DO
      clp$get_value ('FAMILY', family_index, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      family := value.name.value;
      IF family = osv$system_family_name THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$system_family_not_allowed, family, status);
        RETURN;
      IFEND;

      pfp$validate_local_family (family, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      found := FALSE;

{
{     Ensure that the number of accessible families on this server does no
{     exceed the maximum.
{

    /search_all_families/
      FOR i_family := 1 TO total_number_of_families DO
        IF all_families_array [i_family] = family THEN
          found := TRUE;
          EXIT /search_all_families/;
        IFEND;
      FOREND /search_all_families/;

      IF NOT found THEN
        IF total_number_of_families >= max_families THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$max_families_or_clients, 'families', status);
          osp$append_status_integer (osc$status_parameter_delimiter, max_families, 10, FALSE, status);
          RETURN;
        IFEND;
        total_number_of_families := total_number_of_families + 1;
        all_families_array [total_number_of_families] := family;
      IFEND;
      p_family_list^ [family_index] := family;

{
{     Verify that the family is not currently accessible by an active (or
{     semi_active) client.
{

      find_clients_for_family (family, ^clients_with_access_array, ^client_access_array,
            number_of_clients_with_access, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    /check_clients_with_access/
      FOR accessed_client_index := 1 TO number_of_clients_with_access DO
        mainframe_name := clients_with_access_array [accessed_client_index];
        IF mainframe_name = 'ALL' THEN
          CYCLE /check_clients_with_access/;
        IFEND;
        IF client_access_array [accessed_client_index] = $dft$family_access [] THEN
          CYCLE /check_clients_with_access/;
        IFEND;

        client_specified_on_command := FALSE;
        IF all_clients THEN
          client_specified_on_command := TRUE;
        ELSE

        /search_client_input/
          FOR client_index := 1 TO number_of_clients DO
            IF mainframe_name = p_client_list^ [client_index] THEN
              client_specified_on_command := TRUE;
              EXIT /search_client_input/
            IFEND;
          FOREND /search_client_input/;
        IFEND;

        IF client_specified_on_command THEN
          dfp$find_mainframe_id (mainframe_name, {host_is_server=} TRUE, mainframe_found,
                ignore_p_q_interf_table, p_cpu_queue, ignore_queue_index, ignore_p_q_interf_direc);
          IF mainframe_found THEN
            server_state := p_cpu_queue^.queue_header.partner_status.server_state;
            IF (server_state = dfc$active) OR (server_state = dfc$deactivated) OR
                  (((server_state = dfc$terminated) OR (server_state = dfc$inactive)
                  OR (server_state = dfc$awaiting_recovery)) AND
                  p_cpu_queue^.queue_header.partner_status.verify_queue) THEN
              osp$set_status_abnormal (dfc$file_server_id, dfe$client_too_active_for_chaca, mainframe_name,
                    status);
              RETURN;
            IFEND;
          IFEND;
        IFEND;
      FOREND /check_clients_with_access/;
    FOREND /process_family_input/;

  PROCEND crack_families;

?? TITLE := ' crack_family_access ', EJECT ??

  PROCEDURE crack_family_access
    (VAR family_access: dft$family_access;
     VAR status: ost$status);

    VAR
      value: clt$value;

    status.normal := TRUE;
    family_access := $dft$family_access [];
    clp$get_value ('FAMILY_ACCESS', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.name.value (1) = 'A' THEN
      family_access := $dft$family_access [dfc$remote_file_access, dfc$remote_login_access,
            dfc$job_leveling_access];
    ELSEIF value.name.value (1) = 'F' THEN
      family_access := $dft$family_access [dfc$remote_file_access];
    ELSEIF (value.name.value (1, 2) = 'LE') OR (value.name.value (1, 2) = 'LA') THEN
      family_access := $dft$family_access [dfc$remote_file_access, dfc$remote_login_access,
            dfc$job_leveling_access];
    ELSEIF (value.name.value (1, 2) = 'LO') OR (value.name.value (1, 2) = 'L ') THEN
      family_access := $dft$family_access [dfc$remote_file_access, dfc$remote_login_access];
    IFEND;

  PROCEND crack_family_access;

?? TITLE := '  find_clients_for_family', EJECT ??

{ PURPOSE:
{   The purpose of this request is to find all the clients for the specified
{   family and to return the client names and associated family accesses.
{
{ NOTES:
{   1.The information is obtained from the permanent file permit array in the
{     permanent file catalog.
{

  PROCEDURE find_clients_for_family
    (    family: ost$family_name;
         p_client_list: ^array [1 .. * ] of pmt$mainframe_id;
         p_access_list: ^array [1 .. * ] of dft$family_access;
     VAR number_of_entries: 0 .. dfc$maximum_partner_mainframes;
     VAR status: ost$status);

    VAR
      catalog_info_selections: pft$catalog_info_selections,
      client_list_size: integer,
      family_access: dft$family_access,
      group: pft$group,
      info_segment_pointer: amt$segment_pointer,
      local_status: ost$status,
      mainframe_id: pmt$mainframe_id,
      path: array [1 .. 2] of pft$name,
      permit_index: pft$array_index,
      p_directory_array: pft$p_directory_array,
      p_info_record: pft$p_info_record,
      p_info: pft$p_info,
      p_permit_array: pft$p_permit_array;

    catalog_info_selections := $pft$catalog_info_selections
          [pfc$catalog_directory, pfc$catalog_permits, pfc$indirect_catalog_permits];

    path [1] := family;
    path [2] := jmc$system_user;
    client_list_size := UPPERBOUND (p_client_list^) - LOWERBOUND (p_client_list^) + 1;
    number_of_entries := 0;

  /main/
    BEGIN
      mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, info_segment_pointer, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      p_info := info_segment_pointer.sequence_pointer;
      RESET p_info;

      group.group_type := pfc$member;
      group.member_description.family := osc$null_name;
      group.member_description.account := osc$null_name;
      group.member_description.project := osc$null_name;
      group.member_description.user := osc$null_name;

      pfp$get_item_info (path, group, catalog_info_selections, $pft$file_info_selections [], p_info, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      RESET p_info;

      pfp$find_next_info_record (p_info, p_info_record, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      pfp$find_directory_array (p_info_record, p_directory_array, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      IF p_directory_array = NIL THEN
        osp$set_status_abnormal (pfc$permanent_file_manager_id, pfe$unknown_master_catalog, family, status);
        EXIT /main/;
      IFEND;

      pfp$find_direct_info_record (^p_info_record^.body, p_directory_array^ [1].info_offset, p_info_record,
            status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      pfp$find_permit_array (p_info_record, p_permit_array, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;

      IF p_permit_array = NIL THEN
        EXIT /main/;
      IFEND;

    /search/
      FOR permit_index := LOWERBOUND (p_permit_array^) TO UPPERBOUND (p_permit_array^) DO
        IF p_permit_array^ [permit_index].group.group_type = pfc$family THEN
          IF p_permit_array^ [permit_index].group.family_description.family (1, 3) = 'DF$' THEN
            number_of_entries := number_of_entries + 1;
            IF number_of_entries <= client_list_size THEN
              p_client_list^ [number_of_entries] := p_permit_array^ [permit_index].group.family_description.
                    family (4, pmc$mainframe_id_size);
              IF p_access_list <> NIL THEN
                get_family_access_from_a_i (p_permit_array^ [permit_index].
                      application_info, p_access_list^ [number_of_entries]);
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      FOREND /search/;
    END /main/;

    IF info_segment_pointer.sequence_pointer <> NIL THEN
      mmp$delete_scratch_segment (info_segment_pointer, local_status);
      info_segment_pointer.sequence_pointer := NIL;
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

  PROCEND find_clients_for_family;

?? TITLE := '    [INLINE] get_family_access_from_a_i', EJECT ??

{ PURPOSE:
{   The purpose of this request is to return the family access from the
{   application_information string.
{
{ NOTES:
{   1.Although dft$family_access is a set, only one element of the set is
{     is stored in the application information.  The set is expanded here
{     so that login_access includes file_access, and leveled_access
{     includes login_access and file_access.
{

  PROCEDURE [INLINE] get_family_access_from_a_i
    (    application_info: pft$application_info;
     VAR family_access: dft$family_access);

    family_access := $dft$family_access [];
    IF application_info (1, access_value_size_in_app_info) = legible_for_remote_file_access THEN
      family_access := $dft$family_access [dfc$remote_file_access];
    ELSEIF application_info (1, access_value_size_in_app_info) = legible_for_remote_login_access THEN
      family_access := $dft$family_access [dfc$remote_file_access, dfc$remote_login_access];
    ELSEIF application_info (1, access_value_size_in_app_info) = legible_for_job_leveling_access THEN
      family_access := $dft$family_access [dfc$remote_file_access, dfc$remote_login_access,
            dfc$job_leveling_access];
    IFEND;

  PROCEND get_family_access_from_a_i;

?? TITLE := '  set_verify_family', EJECT ??

{ PURPOSE:
{   The purpose of this request is to inform the file server poller - via the cpu queue header -
{   that new families are available to the client/

  PROCEDURE set_verify_family
    (    all_clients: boolean,
         p_client_list: ^array [1 .. * ] of pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      client_index: 0 .. dfc$maximum_partner_mainframes,
      ignore_p_q_interf_direc: ^dft$q_interface_directory_entry,
      ignore_p_q_interf_table: dft$p_queue_interface_table,
      ignore_queue_index: dft$queue_index,
      mainframe_found: boolean,
      mainframe_name: pmt$mainframe_id,
      number_of_clients: 0 .. dfc$maximum_partner_mainframes,
      p_all_clients: ^array [1 .. dfc$maximum_partner_mainframes] of dft$partner_mainframe_entry,
      p_cpu_queue: ^dft$cpu_queue;

    IF all_clients THEN
      PUSH p_all_clients;
      dfp$get_partner_mainframes ({partners_are_servers=} FALSE, p_all_clients, number_of_clients);
    ELSE
      number_of_clients := UPPERBOUND (p_client_list^);
    IFEND;


    FOR client_index := 1 TO number_of_clients DO
      IF all_clients THEN
        pmp$convert_binary_mainframe_id (p_all_clients^ [client_index].mainframe_id, mainframe_name, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      ELSE
        mainframe_name := p_client_list^ [client_index];
      IFEND;

      dfp$find_mainframe_id (mainframe_name, {host_is_server=} TRUE, mainframe_found, ignore_p_q_interf_table,
            p_cpu_queue, ignore_queue_index, ignore_p_q_interf_direc);
      IF mainframe_found THEN
        IF p_cpu_queue^.queue_header.partner_status.server_state = dfc$active THEN
          IF p_cpu_queue^.queue_header.number_of_monitor_queue_entries > 0 THEN
            p_cpu_queue^.queue_header.partner_status.verify_family := TRUE;
          IFEND;
        IFEND;
      IFEND;
    FOREND;

  PROCEND set_verify_family;

MODEND dfm$family_client_manager;
