1
2
3
4
5
6
7
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;
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
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;
123 end;
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
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;
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;