1
2
3
4
5
6
7
8
9
10
11
12
13
14 user: procedure options (variable);
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
44
45
46
47
48
49
50 dcl alp pointer;
51 dcl ap ptr,
52 al fixed bin (21),
53 all_switch bit (1) aligned,
54 bchr char (al) based (ap) unal,
55 answer char (al) varying based (ap);
56
57 dcl time fixed bin (71),
58 nactsw bit (1),
59 (got_login_data, got_auth, got_limits) bit (1) aligned,
60 term_id_sw bit (1),
61 K256_switch bit (2) aligned,
62 switch fixed bin,
63 ec fixed bin (35),
64 attr char (300) varying,
65 (nm, pj, ac, grp) char (32),
66 f float bin,
67 (an, sb, wt) fixed bin,
68 (tli, ocpu) fixed bin (71),
69 wd char (9),
70 dn char (168),
71 id char (8),
72 (np, pf, pp) fixed bin,
73 tt char (32),
74 (i, n) fixed bin,
75 b36 bit (36),
76 (auth, max_auth) bit (72) aligned,
77 auth_range (2) bit (72) aligned,
78 rs_number fixed bin,
79 string char (300) varying,
80 auth_string char (644),
81 (absolute_limit, absolute_spending, monthly_limit, monthly_spending) float bin,
82 (shift_limits, shift_spendings) dimension (0:7) float bin,
83 cutoff_date fixed bin (71),
84 limit_type fixed bin,
85 current_shift fixed bin,
86 fb71 fixed bin (71),
87 char19 char (19),
88 (truncate, restarted) bit (1),
89 rg_range (2) fixed bin,
90 ring_string char (3);
91
92 dcl process_type (0:3) char (12) static options (constant)
93 init ("initializer", "interactive", "absentee", "daemon");
94
95 dcl service_type (0:7) char (8) static options (constant)
96 init ("unknown", "login", "FTP", "MC", "slave", "type5", "autocall", "inactive");
97
98 %include line_types;
99 %include iocbx;
100
101 dcl 1 terminal_info aligned,
102 2 version fixed bin init (1),
103 2 id char (4) unaligned,
104 2 term_type char (32) unaligned,
105 2 line_type fixed bin,
106 2 baud_rate fixed bin,
107 2 reserved (4) fixed bin;
108
109 dcl inarg char (24);
110
111
112
113
114
115
116
117
118
119 dcl ITEM_ALPHA_ORDER (58) fixed bin int static options (constant) init (1, 2, 3, 4, 54, 5, 6, 7, 55, 8, 9, 0, 11, 12, 0, 53, 56, 57, 58, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 0, 28, 29, 0, 51, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49);
120 dcl item (58) char (24) aligned int static options (constant) init (
121 "256k_switch",
122 "abs_queue",
123 "absentee",
124 "absentee_request_id",
125 "absin",
126 "absout",
127 "account",
128 "anonymous",
129 "attributes",
130 "auth",
131 "auth_long",
132 "brief_bit",
133 "charge_type",
134 "cpu_secs",
135 "cutoff_date",
136 "device_channel",
137 "group",
138 "initial_term_id",
139 "initial_term_type",
140 "limit",
141 "limit_type",
142 "line_type",
143 "log_time",
144 "login_date",
145 "login_time",
146 "login_word",
147 "max_auth",
148 "max_auth_long",
149 "monthly_limit",
150 "monthly_spending",
151 "n_processes",
152 "name",
153 "outer_module",
154 "preemption_time",
155 "process_id",
156 "process_overseer",
157 "process_type",
158 "project",
159 "protected",
160 "rate_structure_name",
161 "rate_structure_number",
162 "secondary",
163 "service_type",
164 "shift_limit",
165 "shift_spending",
166 "spending",
167 "term_id",
168 "term_type",
169 "weight",
170 "min_auth",
171 "min_auth_long",
172 "auth_range",
173 "auth_range_long",
174 "absentee_restarted",
175 "absout_truncation",
176 "min_ring",
177 "max_ring",
178 "ring_range");
179
180 dcl user_data (58) fixed bin int static options (constant) init
181 ((6) 0, 1, 1, 0, 2, 2, 0, 0, 0, 3, (4) 0, 3, 3, 0, (4) 1, 2, 2,
182 3, 3, 0, 1, (5) 0, 1, 0, 0, 0, 1, 0, 0, 3, 3, 0, 0, 1, (4) 0, 0, 0,
183 0, 0, 0);
184
185 dcl item_synonyms (3) char (24) int static options (constant) init
186 ("abs_rqid", "256k", "256K");
187 dcl item_synonyms_position (3) fixed bin int static options (constant) init (4, 1, 1);
188
189 dcl error_table_$not_act_fnc fixed bin (35) ext;
190 dcl error_table_$badopt fixed bin(35) ext static;
191
192 dcl cu_$arg_list_ptr entry (ptr);
193 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
194 dcl cu_$af_arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
195 dcl get_process_id_ entry () returns (bit (36));
196 dcl cu_$af_return_arg_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr);
197 dcl active_fnc_err_ entry options (variable);
198 dcl com_err_ entry options (variable);
199 dcl ioa_ entry options (variable);
200 dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35));
201 dcl iox_$user_io ptr external;
202 dcl date_time_$format entry (char(*), fixed bin(71), char(*), char(*)) returns(char(250) var);
203 dcl requote_string_ entry (char (*)) returns (char (*));
204 dcl user_info_$authorization_range entry ((2) bit (72) aligned);
205 dcl user_info_$login_data entry options (variable);
206 dcl user_info_$absin entry (char (*));
207 dcl user_info_$absout entry (char (*));
208 dcl (user_info_$absout_truncation, user_info_$absentee_restarted) entry (bit(1));
209 dcl user_info_$outer_module entry (char (*));
210 dcl user_info_$attributes entry (char (*) varying);
211 dcl user_info_$service_type entry (fixed bin);
212 dcl user_info_$process_type entry (fixed bin);
213 dcl user_info_$terminal_data entry options (variable);
214 dcl user_info_$responder entry (char (*));
215 dcl user_info_$usage_data entry options (variable);
216 dcl user_info_$load_ctl_info entry options (variable);
217 dcl user_info_$absentee_queue entry (fixed bin);
218 dcl user_info_$rs_name entry (char (*));
219 dcl user_info_$rs_number entry (fixed bin);
220 dcl user_info_$limits entry (float bin, float bin, fixed bin (71), fixed bin,
221 (0:7) float bin, float bin, float bin, (0:7) float bin);
222 dcl user_info_$absentee_request_id entry (fixed bin (71));
223 dcl user_info_$ring_range entry ((2) fixed bin);
224 dcl system_info_$next_shift_change entry (fixed bin, fixed bin (71), fixed bin, fixed bin (71));
225 dcl hcs_$get_usage_values entry (fixed bin, fixed bin (71), fixed bin);
226 dcl hcs_$get_authorization entry (bit (72) aligned, bit (72) aligned);
227 dcl hcs_$set_256K_switch entry (bit (2) aligned, bit (2) aligned, fixed bin (35));
228 dcl convert_access_class_$to_string entry (bit (72) aligned, char (*), fixed bin (35));
229 dcl convert_access_class_$to_string_short entry (bit (72) aligned, char (*), fixed bin (35));
230 dcl convert_access_class_$to_string_range entry ((2) bit (72) aligned, character (*), fixed binary (35));
231 dcl convert_access_class_$to_string_range_short entry ((2) bit (72) aligned, character (*),
232 fixed binary (35));
233 dcl request_id_ entry (fixed bin (71)) returns (char (19));
234 dcl ioa_$rsnnl entry options (variable);
235
236 dcl (addr, clock, hbound, index, ltrim, rtrim) builtin;
237
238
239
240 all_switch, nactsw, got_limits, got_auth, got_login_data = "0"b;
241 call cu_$arg_list_ptr (alp);
242 call cu_$af_arg_ptr (1, ap, al, ec);
243 if ec = error_table_$not_act_fnc then do;
244 call cu_$arg_ptr (1, ap, al, ec);
245 nactsw = "1"b;
246 end;
247 if ec ^= 0 then do;
248 er: if nactsw then call com_err_ (ec, "user", "");
249 else call active_fnc_err_ (ec, "user", "");
250 return;
251 end;
252 inarg = bchr;
253
254 if inarg = "all" then all_switch = "1"b;
255 else do;
256 do switch = 1 to hbound (item, 1);
257 if inarg = item (switch) then go to have_good_item;
258 end;
259 do switch = 1 to hbound (item_synonyms, 1);
260 if inarg = item_synonyms (switch) then do;
261 switch = item_synonyms_position (switch);
262 goto have_good_item;
263 end;
264 end;
265 if nactsw then call com_err_ (0, "user", "Invalid keyword: ^a", inarg);
266 else call active_fnc_err_ (0, "user", "Invalid keyword: ^a", inarg);
267 return;
268 end;
269
270 have_good_item:
271 if all_switch & ^nactsw then do;
272 call active_fnc_err_ (error_table_$badopt, "user", "The ""all"" keyword is invalid in an active function invocation.");
273 return;
274 end;
275
276 if all_switch then
277 do i = 1 to 3;
278 call get_user_data (i);
279 end;
280 else
281 call get_user_data (user_data (switch));
282
283
284 if all_switch then do i = 1 to hbound (ITEM_ALPHA_ORDER, 1);
285 if ITEM_ALPHA_ORDER (i) ^= 0 then call process_one_item (ITEM_ALPHA_ORDER (i));
286 end;
287 else call process_one_item (switch);
288 return;
289 ^L
290
291 get_user_data:
292 proc (type);
293
294 dcl type fixed bin;
295
296 if type = 1 then call user_info_$login_data (nm, pj, ac, an, sb, wt, tli, wd);
297 else if type = 2 then call hcs_$get_authorization (auth, max_auth);
298 else if type = 3 then call user_info_$limits (monthly_limit, absolute_limit, cutoff_date,
299 limit_type, shift_limits, monthly_spending, absolute_spending, shift_spendings);
300
301 return;
302 end get_user_data;
303
304 process_one_item:
305 procedure (switch) options (non_quick);
306 declare switch fixed bin;
307 declare i fixed bin;
308
309 go to case (switch);
310
311 case (32):
312 dn = nm;
313 go to j1;
314
315 case (38):
316 dn = pj;
317 go to j1;
318
319 case (7):
320 dn = ac;
321 go to j1;
322
323 case (25):
324 j3: string = date_time_$format ("time", tli, "", "");
325 go to exit;
326
327 case (24):
328 string = date_time_$format ("date", tli, "", "");
329 go to exit;
330
331 case (8):
332 if an = 1 then string = "true";
333 else string = "false";
334 go to exit;
335
336 case (42):
337 if sb = 1 then string = "true";
338 else string = "false";
339 go to exit;
340
341 case (49):
342 f = wt / 1e1;
343 go to j2;
344
345 case (26):
346 dn = wd;
347 go to j1;
348
349 case (23):
350 time = clock () - tli;
351 f = time / 60e6;
352 go to j2;
353
354 case (36):
355 call user_info_$responder (dn);
356 go to j1;
357
358 case (18):
359 iterm_id:
360 call user_info_$terminal_data (id, tt);
361 dn = id;
362 go to j1;
363
364 case (19):
365 call user_info_$absentee_queue (n);
366 if n ^= -1 then do;
367 string = "Absentee";
368 go to exit;
369 end;
370 iterm_type:
371 call user_info_$terminal_data (id, tt);
372 string = rtrim (tt);
373 go to exit;
374
375 case (14):
376 call user_info_$usage_data (np, ocpu);
377 call hcs_$get_usage_values (pf, time, pp);
378 time = time + ocpu;
379 f = time / 1e6;
380 j2: call ioa_$rsnnl ("^.1f", string, i, f);
381 go to exit;
382
383 case (16):
384 call user_info_$terminal_data (id, tt, dn);
385 j1: string = rtrim (dn);
386 go to exit;
387
388 case (31):
389 call user_info_$usage_data (np, ocpu);
390 call ioa_$rsnnl ("^d", string, i, np);
391 go to exit;
392
393 case (3):
394 call user_info_$absentee_queue (n);
395 if n = -1 then string = "false";
396 else string = "true";
397 go to exit;
398
399 case (2):
400 call user_info_$absentee_queue (n);
401 if n = -1 then string = "interactive";
402 else if n = 0 then string = "foreground";
403 else call ioa_$rsnnl ("^d", string, i, n);
404 go to exit;
405
406 case (39):
407 call user_info_$load_ctl_info (grp, sb, tli);
408 string = "false";
409 if sb = 0 then if tli > clock () then string = "true";
410 go to exit;
411
412 case (12):
413 call user_info_$attributes (attr);
414 if index (attr, "brief") = 0 then string = "false";
415 else string = "true";
416 go to exit;
417
418 case (17):
419 call user_info_$load_ctl_info (grp);
420 dn = grp;
421 go to j1;
422
423 case (34):
424 call user_info_$load_ctl_info (grp, sb, tli);
425 go to j3;
426
427 case (9):
428 call user_info_$attributes (string);
429 go to exit;
430
431 case (5):
432 call user_info_$absin (dn);
433 go to j1;
434
435 case (6):
436 call user_info_$absout (dn);
437 go to j1;
438
439 case (33):
440 call user_info_$outer_module (dn);
441 go to j1;
442
443 case (35):
444 b36 = get_process_id_ ();
445 call ioa_$rsnnl ("^w", string, i, b36);
446 go to exit;
447
448 case (10):
449 call convert_access_class_$to_string_short (auth, auth_string, ec);
450 if ec ^= 0 then go to er;
451 if auth_string = "" then string = "system_low";
452 else string = rtrim (auth_string);
453 go to exit;
454
455 case (11):
456 call convert_access_class_$to_string (auth, auth_string, ec);
457 if ec ^= 0 then go to er;
458 if auth_string = "" then string = "system_low";
459 else string = rtrim (auth_string);
460 go to exit;
461
462 case (27):
463 call convert_access_class_$to_string_short (max_auth, auth_string, ec);
464 if ec ^= 0 then go to er;
465 if auth_string = "" then string = "system_low";
466 else string = rtrim (auth_string);
467 go to exit;
468
469 case (28):
470 call convert_access_class_$to_string (max_auth, auth_string, ec);
471 if ec ^= 0 then go to er;
472 if auth_string = "" then string = "system_low";
473 else string = rtrim (auth_string);
474 go to exit;
475
476 case (50):
477 call user_info_$authorization_range (auth_range);
478 call convert_access_class_$to_string_short (auth_range (1), auth_string, ec);
479 if ec ^= 0 then go to er;
480 if auth_string = "" then auth_string = "system_low";
481 string = rtrim (auth_string);
482 go to exit;
483
484 case (51):
485 call user_info_$authorization_range (auth_range);
486 call convert_access_class_$to_string (auth_range (1), auth_string, ec);
487 if ec ^= 0 then go to er;
488 if auth_string = "" then auth_string = "system_low";
489 string = rtrim (auth_string);
490 go to exit;
491
492 case (52):
493 call user_info_$authorization_range (auth_range);
494 call convert_access_class_$to_string_range_short (auth_range, auth_string, ec);
495 if ec ^= 0 then go to er;
496 if auth_string = "" then auth_string = "system_low";
497 string = rtrim (auth_string);
498 go to exit;
499
500 case (53):
501 call user_info_$authorization_range (auth_range);
502 call convert_access_class_$to_string_range (auth_range, auth_string, ec);
503 if ec ^= 0 then go to er;
504 if auth_string = "" then auth_string = "system_low";
505 string = rtrim (auth_string);
506 go to exit;
507
508 case (22):
509 call user_info_$terminal_data ((""), (0), (""), i);
510 dn = line_types (i);
511 goto j1;
512
513 case (43):
514 call user_info_$service_type (i);
515 dn = service_type (i);
516 goto j1;
517
518 case (37):
519 call user_info_$process_type (i);
520 dn = process_type (i);
521 goto j1;
522
523 case (13):
524 call user_info_$terminal_data ((""), (""), (""), (0), dn);
525 go to j1;
526
527 case (47):
528 term_id_sw = "1"b;
529 get_term: call user_info_$process_type (i);
530 if i > 1 then
531 if term_id_sw then go to iterm_id;
532 else if i = 2 then do;
533 string = "Absentee";
534 go to exit;
535 end;
536 else go to iterm_type;
537
538
539
540 call iox_$control (iox_$user_io, "terminal_info", addr (terminal_info), ec);
541 if ec ^= 0 then do;
542 if term_id_sw then go to iterm_id;
543 else go to iterm_type;
544 end;
545 if term_id_sw then string = rtrim (terminal_info.id);
546 else string = rtrim (terminal_info.term_type);
547 go to exit;
548
549 case (48):
550 term_id_sw = "0"b;
551 go to get_term;
552
553 case (40):
554 call user_info_$rs_name (nm);
555 string = nm;
556 go to exit;
557
558 case (41):
559 call user_info_$rs_number (rs_number);
560 call ioa_$rsnnl ("^d", string, i, rs_number);
561 go to exit;
562
563 case (20):
564 call ioa_$rsnnl ("^.2f", string, i, absolute_limit);
565 goto exit;
566
567 case (15):
568 string = date_time_$format ("date_time", cutoff_date, "", "");
569 goto exit;
570
571 case (29):
572 call ioa_$rsnnl ("^.2f", string, i, monthly_limit);
573 goto exit;
574
575 case (44):
576 call system_info_$next_shift_change (current_shift, (0), (0), (0));
577 call ioa_$rsnnl ("^.2f", string, i, shift_limits (current_shift));
578 goto exit;
579
580 case (46):
581 call ioa_$rsnnl ("^.2f", string, i, absolute_spending);
582 goto exit;
583
584 case (30):
585 call ioa_$rsnnl ("^.2f", string, i, monthly_spending);
586 goto exit;
587
588 case (45):
589 call system_info_$next_shift_change (current_shift, (0), (0), (0));
590 call ioa_$rsnnl ("^.2f", string, i, shift_spendings (current_shift));
591 goto exit;
592
593 case (21):
594 if limit_type = 0
595 then string = "absolute";
596 else if limit_type = 1
597 then string = "day";
598 else if limit_type = 2
599 then string = "month";
600 else if limit_type = 3
601 then string = "year";
602 else if limit_type = 4
603 then string = "calendar_year";
604 else if limit_type = 5
605 then string = "fiscal_year";
606 goto exit;
607
608 case (4):
609 call user_info_$absentee_request_id (fb71);
610 if fb71 ^= 0 then do;
611 char19 = request_id_ (fb71);
612 string = char19;
613 end;
614 else string = "0";
615 go to exit;
616
617 case (1):
618 call hcs_$set_256K_switch ("00"b, K256_switch, (0));
619 if K256_switch = "11"b then string = "true";
620 else string = "false";
621 go to exit;
622
623 case (54):
624 call user_info_$absentee_restarted (restarted);
625 if restarted then string = "true";
626 else string = "false";
627 go to exit;
628
629 case (55):
630 call user_info_$absout_truncation (truncate);
631 if truncate then string = "true";
632 else string = "false";
633
634 case (56):
635 call user_info_$ring_range (rg_range);
636 call ioa_$rsnnl ("^d", ring_string, (0), rg_range (1));
637 string = rtrim(ring_string);
638 go to exit;
639
640 case (57):
641 call user_info_$ring_range (rg_range);
642 call ioa_$rsnnl ("^d", ring_string, (0), rg_range (2));
643 string = rtrim(ring_string);
644 go to exit;
645
646 case (58):
647 call user_info_$ring_range (rg_range);
648 call ioa_$rsnnl ("^d:^d", ring_string, (0), rg_range (1), rg_range (2));
649 string = rtrim(ring_string);
650 go to exit;
651
652
653
654 ^L
655
656
657 exit: if all_switch then do;
658 if string ^= ""
659 then call ioa_ ("^a:^24t^a", item (switch), ltrim (string));
660 end;
661 else if nactsw then
662 call ioa_ ("^a", string);
663 else do;
664 call cu_$af_return_arg_rel (i, ap, al, (0), alp);
665 answer = requote_string_ ((string));
666 end;
667 return;
668 end process_one_item;
669 end user;