1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1984 *
  4    *                                                         *
  5    *********************************************************** */
  6 /* delete_fnp.pl1 command interface (perhaps interim) to FNP reconfiguration */
  7 /* format: style2 */
  8 
  9 delete_fnp:
 10      procedure options (variable);
 11 
 12           declare cu_$arg_count          entry (fixed bin, fixed bin (35));
 13           declare cu_$arg_ptr            entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
 14           declare com_err_               entry () options (variable);
 15           declare expand_pathname_$add_suffix
 16                                          entry (character (*), character (*), character (*), character (*),
 17                                          fixed binary (35));
 18           declare get_fnp_name_          entry (fixed binary) returns (character (32));
 19           declare multiplexer_mgr_$count_mpx_users
 20                                          entry (character (*), pointer, fixed binary, fixed binary (35));
 21           declare parse_fnp_name_        entry (character (*), fixed binary);
 22           declare pathname_              entry (character (*), character (*)) returns (character (168));
 23           declare hphcs_$deconfigure_fnp entry (fixed bin, fixed bin (35));
 24           declare ioa_                   entry () options (variable);
 25           declare command_query_$yes_no  entry () options (variable);
 26           declare initiate_file_         entry (character (*), character (*), bit (*), pointer, fixed binary (24),
 27                                          fixed binary (35));
 28           declare terminate_file_        entry (pointer, fixed binary (24), bit (*), fixed binary (35));
 29 
 30           declare ap                     ptr;
 31           declare al                     fixed bin (21);
 32           declare argument               char (al) based (ap);
 33           declare code                   fixed bin (35);
 34           declare fnp_no                 fixed bin;
 35           declare argx                   fixed bin;
 36           declare n_args                 fixed bin;
 37           declare force                  bit (1) aligned;
 38           declare test                   bit (1) aligned;
 39           declare n_users                fixed bin;
 40           declare cdt_dir_name           char (168);
 41           declare cdt_entryname          char (32);
 42           declare query_response         bit (1) aligned;
 43 
 44           declare error_table_$bad_channel
 45                                          fixed bin (35) ext static;
 46           declare error_table_$noarg     fixed bin (35) ext static;
 47           declare error_table_$too_many_args
 48                                          fixed bin (35) ext static;
 49           declare error_table_$badopt    fixed bin (35) ext static;
 50 
 51           declare ME                     char (32) init ("delete_fnp") int static options (constant);
 52           declare cleanup                condition;
 53 ^L
 54 
 55           call cu_$arg_count (n_args, code);
 56           if code ^= 0
 57           then do;
 58                     call com_err_ (code, ME);
 59                     return;
 60                end;
 61 
 62           if n_args = 0
 63           then do;
 64                     call com_err_ (0, ME, "Usage: delete_fnp FNP_TAG {-force} {-test CDT_PATH}");
 65                     return;
 66                end;
 67 
 68           force, test = "0"b;
 69           cdt_dir_name = ">system_control_dir";
 70           cdt_entryname = "cdt";
 71           fnp_no = -1;
 72 
 73           do argx = 1 to n_args;
 74                call cu_$arg_ptr (argx, ap, al, (0));
 75                if index (argument, "-") = 1
 76                then do;                                     /* control argument */
 77                          if argument = "-force"
 78                          then force = "1"b;
 79                          else if argument = "-no_force"
 80                          then force = "0"b;
 81                          else if argument = "-test"
 82                          then do;
 83                                    test = "1"b;
 84                                    if argx = n_args
 85                                    then do;
 86                                              call com_err_ (error_table_$noarg, ME,
 87                                                   "-test must be followed by a CDT pathname.");
 88                                              return;
 89                                         end;
 90                                    argx = argx + 1;
 91                                    call cu_$arg_ptr (argx, ap, al, (0));
 92                                    call expand_pathname_$add_suffix (argument, "cdt", cdt_dir_name, cdt_entryname, code);
 93                                    if code ^= 0
 94                                    then do;
 95                                              call com_err_ (code, ME, "^a.", argument);
 96                                              return;
 97                                         end;
 98                               end;
 99                          else if argument = "-no_test"
100                          then do;
101                                    test = "0"b;
102                                    cdt_dir_name = ">system_control_dir";
103                                    cdt_entryname = "cdt";
104                               end;
105                          else do;
106                                    call com_err_ (error_table_$badopt, ME, "^a.", argument);
107                                    return;
108                               end;
109                     end;
110                else do;
111                          if fnp_no > 0                      /* already got */
112                          then do;
113                                    call com_err_ (error_table_$too_many_args, ME, "Only one FNP may be specified.");
114                                    return;
115                               end;
116                          call parse_fnp_name_ (argument, fnp_no);
117                          if fnp_no ^> 0
118                          then do;
119                                    call com_err_ (error_table_$bad_channel, ME, "Invalid FNP name ^a.", argument);
120                                    return;
121                               end;
122                     end;                                    /* FNP Spec */
123           end;                                              /* arg loop */
124 
125           cdtp = null ();
126           on cleanup
127                begin;
128                     if cdtp ^= null ()
129                     then call terminate_file_ (cdtp, (0), TERM_FILE_TERM, (0));
130                     cdtp = null ();
131                end;
132 
133           if ^force
134           then do;
135                     call initiate_file_ (cdt_dir_name, cdt_entryname, R_ACCESS, cdtp, (0), code);
136                     if code ^= 0
137                     then do;
138                               call com_err_ (code, ME,
139                                    "Could not access ^a to check for users of the FNP. Use -force if you really want to delete it."
140                                    , pathname_ (cdt_dir_name, cdt_entryname));
141                               return;
142                          end;
143 
144                     fnpep = addr (cdt.fnp_entry (fnp_no));
145                     mpxep = addr (fnpe.mpxe);
146 
147                     if mpxe.state ^= MPX_DOWN & mpxe.state ^= MPX_FREE
148                                                             /* might be just running T&D */
149                     then do;
150                               call multiplexer_mgr_$count_mpx_users (get_fnp_name_ (fnp_no), cdtp, n_users, code);
151                               if code ^= 0
152                               then n_users = 0;             /* something wrong with cdt */
153                               call command_query_$yes_no (query_response, (0), ME,
154                                    "Deleting the FNP will crash it and disconnect the users.",
155                                    "FNP ^a is ^[in an unknown state^;down^;booting^;up^]^[ and has ^d user^[s^]^]. Are you sure that you want to delete it?"
156                                    , get_fnp_name_ (fnp_no), mpxe.state, n_users > 0, n_users, n_users > 1);
157                               if ^query_response
158                               then do;
159                                         call ioa_ ("FNP ^a not deleted.", get_fnp_name_ (fnp_no));
160                                         go to RETURN;
161                                    end;
162                          end;
163                end;
164           if test
165           then go to RETURN;
166           call hphcs_$deconfigure_fnp (fnp_no, code);
167           if code = 0
168           then call ioa_ ("FNP ^a deleted from configuration.", get_fnp_name_ (fnp_no));
169           else call com_err_ (code, ME, "Could not delete FNP ^a from configuration");
170 RETURN:
171           call terminate_file_ (cdtp, (0), TERM_FILE_TERM, (0));
172 
173           return;
174 
175 %include cdt;
176 %include access_mode_values;
177 %include terminate_file;
178 %include author_dcl;
179      end delete_fnp;