1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43 tolts_: proc;
44
45
46
47 dcl c_args (32) char (28) varying;
48 dcl c_len fixed bin;
49 dcl cardp ptr init (null);
50 dcl code fixed bin (35);
51 dcl com_string char (132) aligned;
52 dcl cmd_cnt fixed bin;
53 dcl entry_var entry variable;
54 dcl tandd_ok bit (1);
55 dcl term bit (1);
56 dcl ttl_date char (6);
57 dcl user_access fixed bin (5);
58
59
60
61
62 dcl null builtin;
63
64
65
66 dcl linkage_error condition;
67
68
69
70
71 dcl current_ring fixed bin int static options (constant) init (-1);
72 dcl no_error_expected fixed bin (35) int static options (constant) init (0);
73 dcl pname char (6) static options (constant) init ("tolts_");
74 dcl ring_1 fixed bin int static options (constant) init (1);
75 dcl sl_dir char (4) int static options (constant) init (">sl1");
76 dcl sc_admin_dir char (14) int static options (constant) init (">sc1>admin_acs");
77 dcl sc_dir char (4) int static options (constant) init (">sc1");
78
79
80
81
82 dcl com_err_ entry () options (variable);
83 dcl hcs_$get_user_effmode entry (char (*), char (*), char (*), fixed bin, fixed bin (5), fixed bin (35));
84 dcl ioa_ entry options (variable);
85 dcl isolts_ entry;
86 dcl mca_$attach_mca entry;
87 dcl mtdsim_ entry options (variable);
88 dcl no_save_on_disconnect entry;
89 dcl save_on_disconnect entry;
90 dcl tandd_$ring_0_message entry;
91 dcl tolts_util_$get_ttl_date entry (entry, char (6));
92 dcl tolts_util_$on_off entry (char (6), char (3), char (6));
93 dcl tolts_util_$opr_msg entry;
94 dcl tolts_util_$query entry (char (*), char (132) aligned, fixed bin, (32) char (28) varying, fixed bin);
95
96
97
98
99 dcl error_table_$moderr fixed bin (35) ext static;
100 dcl error_table_$noentry fixed bin (35) ext static;
101
102
103 %page;
104
105
106 call no_save_on_disconnect;
107 call tolts_util_$get_ttl_date (tolts_, ttl_date);
108 call tolts_util_$on_off ("tolts", "on", ttl_date);
109
110
111
112
113
114
115
116
117
118 call check_access (sc_dir, "opr_query_data",
119 RW_ACCESS_BIN, no_error_expected, current_ring);
120
121 call check_access (sc_admin_dir, "tandd.acs",
122 RW_ACCESS_BIN, no_error_expected, current_ring);
123
124 call check_access (sc_dir, "cdt",
125 R_ACCESS_BIN, no_error_expected, current_ring);
126
127 call check_access (sl_dir, "mca_data_seg",
128 RW_ACCESS_BIN, error_table_$noentry, ring_1);
129
130
131 on linkage_error begin;
132 call com_err_ (error_table_$moderr, pname, "^[mca_^;tandd_^]", tandd_ok);
133 goto t_off;
134 end;
135
136 tandd_ok = "0"b;
137 entry_var = tandd_$ring_0_message;
138 tandd_ok = "1"b;
139 entry_var = mca_$attach_mca;
140 revert linkage_error;
141
142
143 %page;
144
145
146
147
148 term = "0"b;
149 do while (^term);
150 call ioa_ (" ^
151
152
153
154
155 if c_args (1) = "quit"
156 | c_args (1) = "q" then
157 term = "1"b;
158 else if c_args (1) = "polts" then
159 call mtdsim_ ("polt");
160 else if c_args (1) = "molts" then
161 call mtdsim_ ("molt");
162 else if c_args (1) = "colts" then
163 call mtdsim_ ("colt");
164 else if c_args (1) = "isolts" then
165 call isolts_;
166 else if c_args (1) = "msg" then
167 call tolts_util_$opr_msg;
168 else call ioa_ ("^/invalid response - ^a", com_string);
169 end;
170
171
172
173 t_off: call tolts_util_$on_off ("tolts", "off", ttl_date);
174 call save_on_disconnect;
175
176 return;
177
178 %page;
179
180
181
182 check_access: proc (dir, entry, lowest_access, error_expected, ring);
183
184 dcl error_expected fixed bin (35);
185 dcl dir char (*);
186 dcl entry char (*);
187 dcl lowest_access fixed bin (5);
188 dcl ring fixed bin;
189
190 call hcs_$get_user_effmode (dir, entry, "", ring, user_access, code);
191 if code ^= 0 then do;
192 if code = error_expected then return;
193 call com_err_ (code, pname, "attemping to get user access to ^a>^a.",
194 dir, entry);
195 go to t_off;
196 end;
197
198 if user_access >= lowest_access then return;
199
200 call com_err_ (error_table_$moderr, pname, "^a>^a", dir, entry);
201 goto t_off;
202
203 end check_access;
204
205 %page;
206
207 %include access_mode_values;
208
209
210 end tolts_;