1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 /* format: style4 */
 13 tty_lines: tln: procedure;
 14 
 15 
 16 /*
 17    This command prints certain information from the answer_table
 18    about each channel that is attached to Multics. It has one optional
 19    argument, used to elicit subsets of the information. Normal printed
 20    data consists of tty channel name, type of device to last dialup
 21    the channel, dialup count, channel state (1 = hungup,
 22    2 = listening, 5 = dialedup), location in dialup (see SPS),
 23    activity value (1 = hungup, 2 = listening, 3 = dialed-up,
 24    4 = user is logged-in, 5 = user has process), and user and
 25    project names and device ID if activity is 4 or 5 (also for
 26    2 or 3 if information is available).  This option
 27    to the command is either a channel name or a selector of the form xxyyyy. Values of xx and yyyy
 28    are as follows:
 29 
 30    V^H__^Ha_^Hl_^Hu_^He _^Ho_^Hf "_^Hx_^Hx"     M^H__^He_^Ha_^Hn_^Hi_^Hn_^Hg _^Ho_^Hf "_^Hy_^Hy_^Hy_^Hy"
 31 
 32    id      Teletype ID code (value printed in ID column)
 33 
 34    ct      Channels with "experiment-count" >^H_  yyyy  Since
 35    channel  last  initialized (value printed in ID
 36    column)
 37 
 38    dl      Channels  with  "dialup-count"  >^H_   yyyy   since
 39    answer_table  last  truncated (value printed in
 40    ID column)
 41 
 42    st      Channels in state yyyy (possible values 1, 2 or 5)
 43 
 44 
 45    wp      Channels at "wait-point" yyyy (1-21)
 46 
 47    ac      Channels with "activity" yyyy (0-7)
 48 
 49    sl      Information for "slot" yyyy (1-999) (0 or blank
 50    means entire table)
 51 
 52    c=      Channels for  which  "experiment-count"  equals
 53    _^Hy_^Hy_^Hy_^Hy (value printed in ID column)
 54 
 55    d=      Channels for which "dialup count"  equals  _^Hy_^Hy_^Hy_^Hy
 56    (value printed in ID column)
 57 
 58    Note that a null part of the option is equivalent to a value of 0
 59    in the selection mechanism (except for the "ID" option,
 60    where _^Hy_^Hy_^Hy_^Hy is alpha-numeric).
 61 
 62    Alternatively, a pair of arguments, -type <term_type>, can be specified to
 63    get information for those lines most recently accessed by a terminal of
 64    the specified type.
 65 
 66    Modified by Robert Coren, June 1977, to add -type argument.
 67    Modified 1980 December by Art Beattie to obtain process ident information from daemon and absentee user tables.
 68    Also improved display with header by determining longest terminal type name and adjusting column placement
 69    accordingly.
 70    Modified December 1981, E. N. Kittlitz, for user_table_entry conversion.
 71    Modified June 1982, E. N. Kittlitz, for user_attributes.incl.pl1.
 72 */
 73 
 74 
 75 /****^  HISTORY COMMENTS:
 76   1) change(87-04-26,GDixon), approve(87-07-08,MCR7741),
 77      audit(87-07-15,Hartogs), install(87-08-04,MR12.1-1055):
 78      Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1
 79                                                    END HISTORY COMMENTS */
 80 
 81 %page;
 82 dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)),
 83      cu_$arg_count entry (fixed bin),
 84      hcs_$terminate_noname entry (ptr, fixed bin (35)),
 85      hcs_$initiate entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin, fixed bin, ptr, fixed bin (35)),
 86      cv_dec_ entry (char (*) aligned, fixed bin),
 87      date_time_ entry (fixed bin (71), char (*) aligned),
 88      clock_ returns (fixed bin (71)),
 89      (ioa_, ioa_$nnl, com_err_) entry options (variable);
 90 
 91 dcl  (addr, char, hbound, length, low, max, min, null, ptr, rel, rtrim, substr) builtin;
 92 
 93 dcl  keyp ptr,
 94      (fmtmax, fmtmin, t_active, isearch, islot,
 95      lasti, ndial, i, table_idx) fixed bin,
 96      code fixed bin (35);
 97 
 98 dcl  argp ptr,
 99      argln fixed bin (17),
100      arg char (argln) based (argp) unaligned;
101 
102 dcl  (c2 char (2),
103      c4 char (4),
104      type_str char (32),
105      test_type char (32),
106      time_str char (16)) aligned;
107 
108 dcl  test_name char (32);
109 
110 dcl  hdrflag bit (1) init ("1"b),
111      j fixed bin,
112      count fixed bin;
113 dcl  (max_name_len, max_type_len) fixed bin;
114 dcl  NL char (1) init ("
115 ");
116 
117 dcl  collapse (11) fixed bin (17) static
118           init (0, 1, 2, 2, 2, 3, 3, 3, 0, 2, 2);
119 
120 dcl  keys char (22) static aligned
121           init ("  idslctdlacwpst  c=d=");
122 
123 dcl  scd char (48) aligned static init (">system_control_1");
124 
125 dcl  1 key aligned based (keyp),
126        2 k2 (14) char (2) unaligned;
127 
128 dcl  answer_table_ptrs (3) pointer;
129 %page;
130           call hcs_$initiate (scd, "cdt", "", 0, 1, cdtp, code);
131           if cdtp = null
132           then do;
133                call com_err_ (code, "tty_lines", "cdt");
134                return;
135           end;
136 
137           call hcs_$initiate (scd, "answer_table", "", 0, 1, answer_table_ptrs (1), code);
138           if answer_table_ptrs (1) = null
139           then do;
140                call com_err_ (code, "tty_lines", "answer_table");
141                return;
142           end;
143 
144           call hcs_$initiate (scd, "absentee_user_table", "", 0, 1, answer_table_ptrs (2), code);
145           if answer_table_ptrs (2) = null
146           then call com_err_ (code, "tty_lines", "^/Cannot get pointer to absentee_user_table; continuing.");
147 
148           call hcs_$initiate (scd, "daemon_user_table", "", 0, 1, answer_table_ptrs (3), code);
149           if answer_table_ptrs (3) = null
150           then call com_err_ (code, "tty_lines", "^/Cannot get pointer to daemon_user_table; continuing.");
151 
152           isearch = 0;                                      /* Initialize default */
153           fmtmax = 4;
154           fmtmin = 0;
155 
156           call cu_$arg_count (count);
157 
158           do j = 1 to count;
159                call cu_$arg_ptr (j, argp, argln, code);
160                if arg = "-lines" then ;
161 
162                else
163                     if arg = "-type"
164                then do;                                     /* terminal type specified */
165                     j = j + 1;                              /* get following argument */
166                     call cu_$arg_ptr (j, argp, argln, code);
167                     if code ^= 0
168                     then do;
169                          call com_err_ (code, "tty_lines");
170                          return;
171                     end;
172 
173                     test_type = arg;
174                     isearch = 9;
175                end;
176 
177                else do;
178 
179                     hdrflag = "0"b;
180                     keyp = addr (keys);                     /* get ptr to argument key values */
181                     c2 = char (arg, 2);                     /* pick off key */
182                     c4 = substr (arg, 3);                   /* and get key argument */
183 
184                     do i = 1 to hbound (collapse, 1);
185 
186                          if c2 = k2 (i)
187                          then do;                           /* look for key match */
188 
189                               isearch = i;
190                               go to setup (collapse (i));
191 
192 setup (1):                                                  /* here for key "id" */
193                               fmtmin = 3;
194                               go to end_setup;
195 
196 setup (2):                                                  /* here for keys "sl","ct", "dl", "c=", and "d=" */
197                               fmtmax = 2;
198 
199 setup (3):                                                  /* here for keys "ac", "wp", and "st" */
200                               call cv_dec_ (c4, islot);
201 
202                               go to end_setup;
203 
204                          end;
205 
206                          else do;
207                               isearch = 1;                  /* not recognized, assume it's a channel name */
208                               test_name = arg;
209                          end;
210 
211                     end;
212 
213                end;
214 
215 setup (0):                                                  /* here for key "tt" */
216 end_setup: end;
217 
218           call date_time_ ((clock_ ()), time_str);
219 
220           if hdrflag
221           then do;
222                max_name_len, max_type_len = 0;
223                do i = 1 to cdt.current_size;
224                     cdtep = addr (cdt.cdt_entry (i));
225                     if cdte.in_use ^= 0
226                     then do;
227                          max_name_len = max (max_name_len, length (rtrim (cdte.name)));
228                          max_type_len = max (max_type_len, length (rtrim (cdte.current_terminal_type)));
229                     end;
230                end;
231                call ioa_ ("^/Attached lines = ^d (size = ^d) at ^16a^2/Name^vxType^vxNo. S WP A Baud User^/",
232                     cdt.n_cdtes, cdt.current_size, time_str, max_name_len - 3, max_type_len - 2);
233           end;
234 
235           lasti = 1;
236 
237 
238           do i = 1 to cdt.current_size;
239                cdtep = addr (cdt.cdt_entry (i));
240                if cdte.in_use <= 0
241                then go to end_i;
242 
243                ndial = cdte.n_dialups;
244                if ndial ^= 0 & cdte.current_terminal_type ^= low (32)
245                then type_str = cdte.current_terminal_type;
246                else type_str = "(NU)";
247 
248                t_active = cdte.in_use;
249                go to request (isearch);                     /* dispatch on key type */
250 
251 request (1):
252                if cdte.name = test_name
253                then go to print_it;
254 
255                go to end_i;
256 
257 request (2):                                                /* id */
258                if c4 = cdte.tty_id_code
259                then go to print_it;
260 
261                go to end_i;
262 
263 request (3):                                                /* sl */
264                if islot = 0
265                then go to print_it;                         /* if slot = 0, print all entries */
266 
267                if i = islot
268                then go to print_it;
269 
270                go to end_i;
271 
272 request (4):                                                /* ct */
273                ndial = cdte.count;
274 request (5):                                                /* dl */
275                if ndial >= islot
276                then go to print_it;
277 
278                go to end_i;
279 
280 request (6):                                                /* ac */
281                if t_active = islot
282                then go to print_it;
283 
284                go to end_i;
285 
286 request (7):                                                /* wp */
287                if cdte.tra_vec = islot
288                then go to print_it;
289 
290 
291                go to end_i;
292 
293 request (8):                                                /* st */
294                if cdte.state = islot
295                then go to print_it;
296 
297                go to end_i;
298 
299 request (9):                                                /* ty */
300                if type_str = test_type
301                then go to print_it;
302 
303                go to end_i;
304 
305 request (10):                                               /* c= */
306                ndial = cdte.count;
307 request (11):                                               /* d= */
308                if ndial = islot
309                then go to print_it;
310 
311                go to end_i;
312 
313 request (0):                                                /* if printing everything */
314                if t_active = 0                              /* if slot not active */
315                then go to end_i;
316 
317 print_it:
318                if i ^= lasti
319                then call ioa_$nnl ("(^d)^/", i - lasti);
320 
321                if ^hdrflag
322                then do;
323                     max_name_len = length (rtrim (cdte.name));
324                     max_type_len = length (rtrim (type_str));
325                end;
326 
327                go to print_hlr (max (min (t_active, fmtmax), fmtmin)); /* select proper printing format */
328 
329 print_hlr (2):
330 print_hlr (3):
331                if cdte.dialed_to_procid = "0"b then go to print_hlr (1);
332 
333                do table_idx = 1 to hbound (answer_table_ptrs, 1);
334                     if answer_table_ptrs (table_idx) ^= null then do;
335                          utep = ptr (answer_table_ptrs (table_idx), rel (cdte.process));
336                          if ute.proc_id = cdte.dialed_to_procid
337                          then do;
338                               if table_idx = 1              /* this is the answer_table */
339                               then call ioa_ ("^va ^va ^4d ^1d ^2d ^1d ^4d ^a ^a (^a) ^a", max_name_len, cdte.name,
340                                         max_type_len, type_str, ndial, cdte.state, cdte.tra_vec, t_active, cdte.baud_rate,
341                                         ute.person, ute.project, ute.tty_id_code, cdte.comment);
342                               else call ioa_ ("^va ^va ^4d ^1d ^2d ^1d ^4d ^a ^a (^a) ^a", max_name_len, cdte.name,
343                                         max_type_len, type_str, ndial, cdte.state, cdte.tra_vec, t_active, cdte.baud_rate,
344                                         ute.person, ute.project, ute.tty_name, cdte.comment);
345                               go to upd_last;
346                          end;
347                     end;
348                end;
349                                                             /* couldn't find anything in any of the */
350                                                             /* tables to display */
351                go to print_hlr (1);
352 
353 print_hlr (4):
354                utep = ptr (answer_table_ptrs (1), rel (cdte.process)); /* Get user table entry */
355                call ioa_ ("^va ^va ^4d ^1d ^2d ^1d ^4d ^a ^a (^a) ^a", max_name_len, cdte.name,
356                     max_type_len, type_str, ndial, cdte.state, cdte.tra_vec, t_active, cdte.baud_rate,
357                     ute.person, ute.project, cdte.tty_id_code, cdte.comment);
358                go to upd_last;
359 
360 print_hlr (0):
361 print_hlr (1):
362                                                             /* just display what's in CDT */
363                call ioa_ ("^va ^va ^4d ^1d ^2d ^1d ^4d ^a", max_name_len, cdte.name, max_type_len, type_str,
364                     ndial, cdte.state, cdte.tra_vec, t_active, cdte.baud_rate, cdte.comment);
365 
366 upd_last:
367                lasti = i + 1;
368 end_i:
369           end;
370 
371           if i = lasti
372           then call ioa_ ("");
373           else call ioa_ ("(^d)^/", i - lasti);
374 
375           do i = 1 to hbound (answer_table_ptrs, 1);
376                if answer_table_ptrs (i) ^= null then call hcs_$terminate_noname (answer_table_ptrs (i), code);
377           end;
378           call hcs_$terminate_noname (cdtp, code);
379 
380           return;
381 %skip (4);
382 tln_test: entry (test_dir);
383 
384 dcl  test_dir char (*) unaligned;
385 
386           scd = test_dir;
387 
388 %page; %include answer_table;
389 %page; %include author_dcl;
390 %page; %include cdt;
391 %page; %include ttyp;
392 %page; %include user_attributes;
393 %page; %include user_table_entry;
394 %page; %include user_table_header;
395 
396      end tty_lines;