1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    * Copyright (c) 1972 by Massachusetts Institute of        *
  6    * Technology and Honeywell Information Systems, Inc.      *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 
 11 /* format: style4 */
 12 who: procedure;
 13 
 14 /* WHO - print information about who's on Multics.
 15 
 16    HMU, HOW_MANY_USERS - give header lines with nusers and load.
 17 
 18    This command types out the userid's of listed logged-in users
 19    from the segment "whotab", which is maintained by the answering service
 20    program "lg_ctl_". The possible arguments are as follows:
 21 
 22    .      -bf       suppress header  (not allowed for af)
 23    .      -lg       print "long who"  (not allowed for af)
 24    .      -nm       sort lines on user name
 25    .      -pj       sort lines on project id
 26    .                (the default sort is by time logged in)
 27    .      -as       print information on absentee users
 28    .      -ia       print information on interactive users
 29    .      -dmn      print information on daemon users
 30    .                (default is -as -ia if none of -as -ia -dmn given)
 31    .      -all      -as, -ia -dmn
 32    .      Name      list only users with person name "Name"
 33    .      .Proj     list only users with project name "Proj"
 34    .      Name.Proj list only users with person name "Name" and project "Proj"
 35 
 36    Initial coding by THVV, 9/6/70 */
 37 /* changed for absentee by EDS 7/71 */
 38 /* various changes by RBR 7/72      */
 39 /* error messages changed 09/15/78 S. Herbst */
 40 /* Modified May 1979 by T. Casey and S. Herbst for MR7.0a to add -interactive and -daemon,
 41    and to list foreground absentee users correctly */
 42 /* who active function added 01/12/81 S. Herbst */
 43 /* 12/24/81 E. N. Kittlitz.  whotab changes */
 44 /* 9/82 BIM -all, no daemons by default */
 45 /* 11/82 E. N. Kittlitz. list daemons if name explicitly given, do selection for af call */
 46 /* 06/84 J A Falksen. Utilize date_time_$format("date_time"|"^<date>!!^<time>"... */
 47 
 48 dcl  return_arg char (return_len) varying based (return_ptr);
 49 dcl  return_ptr ptr;
 50 dcl  return_len fixed bin;
 51 dcl  af_sw bit (1);
 52 
 53 
 54 dcl  argno fixed bin init (1),                              /* number of argument */
 55      arg_count fixed bin,
 56      ap ptr,                                                /* ptr to argument */
 57      al fixed bin,                                          /* lth of argument */
 58      ec fixed bin (35),                                     /* file-system error code */
 59      (f1, f2) float bin,                                    /* conversion temps */
 60      sort fixed bin init (0),                               /* type of sort. 0=date, 1=name, 2=proj */
 61      hmucnt fixed bin init (0),                             /* number of names|projects in */
 62      abscnt fixed bin init (0),                             /* hmucnt as absentee users */
 63      long bit (1) aligned init ("0"b),                      /* 1 if long who wanted */
 64      abs bit (1) aligned init ("0"b),                       /* 1 if listing absentee users */
 65      only_abs bit (1) aligned init ("0"b),                  /* if only listing absentees */
 66      daemon bit (1) aligned init ("0"b),                    /* if listing daemon users */
 67      interactive bit (1) aligned init ("0"b),               /* if listing interactive users */
 68      brief bit (1) aligned init ("0"b),                     /* 1 for no heading at all */
 69      hmuflg bit (1) aligned init ("0"b),                    /* selective hmu flag */
 70      selx fixed bin init (0),                               /* if particular users wanted */
 71      dotl fixed bin,                                        /* location of dot in arg */
 72      nm (50) char (24) aligned,                             /* user names wanted */
 73      pj (50) char (12) aligned,                             /* user projs wanted */
 74      caller char (14) varying,                              /* name of caller to com_err */
 75      why char (128) aligned,                                /* reason for shutdown */
 76      arg char (al) unaligned based (ap),                    /* pickup for args */
 77      sort_arg char (32) init (""),
 78      whoptr ptr int static init (null),                     /* ptr to whotab */
 79      ip ptr int static init (null),                         /* ptr to installation_parms */
 80      sysdir char (64) aligned int static init (">system_control_1"), /* name of dir in which who table resides */
 81      date_l fixed bin,
 82      j fixed bin,                                           /* index */
 83      d fixed bin,                                           /* distance between sorted elems */
 84      last fixed bin,                                        /* highest index in whotab */
 85      swap fixed bin,                                        /* 1 if a swap was done */
 86      ajd fixed bin,                                         /* temp for sort, ary(j+d) */
 87      sss char (1) aligned init ("s"),                       /* pretty for user-not-on */
 88      (time, time1) char (64)var init (""),                  /* ASCII time */
 89      aj fixed bin,                                          /* temp, ary(j) */
 90      did fixed bin init (0),                                /* count of lines printed */
 91      mark char (3) aligned,                                 /* denotation of absentee user if = "*" */
 92      k fixed bin;                                           /* index */
 93 
 94 %include whotab;
 95 
 96 %include installation_parms;
 97 
 98 dcl  complain entry variable options (variable);
 99 
100 dcl  ioa_ ext entry options (variable),                     /* library procedures */
101      active_fnc_err_ entry options (variable),
102      com_err_ ext entry options (variable),
103      date_time_$format entry (char(*), fixed bin(71), char(*), char(*)) returns(char(250) var),
104      cu_$af_return_arg entry (fixed bin, ptr, fixed bin, fixed bin (35)),
105      cu_$arg_ptr ext entry (fixed bin, ptr, fixed bin, fixed bin (35)),
106      hcs_$initiate ext entry (char (*) aligned, char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)),
107      requote_string_ entry (char (*)) returns (char (*));
108 
109 dcl  (after, before, divide, hbound, index, null, rtrim, substr) builtin;
110 dcl  (error_table_$badopt,
111      error_table_$not_act_fnc,
112      error_table_$too_many_args) ext fixed bin;
113 
114 /* - - - - - - - - - - */
115 
116           caller = "who";                                   /* set name of caller to com_err_ */
117           go to join;
118 
119 how_many_users: hmu: entry;
120 
121           caller = "how_many_users";
122           hmuflg = "1"b;
123 
124 join:
125           call cu_$af_return_arg (arg_count, return_ptr, return_len, ec);
126           if ec = error_table_$not_act_fnc then do;
127                af_sw = "0"b;
128                complain = com_err_;
129           end;
130           else if caller = "how_many_users" then do;
131                call active_fnc_err_ (0, caller, "Cannot be called as an active function.");
132                return;
133           end;
134           else do;
135                af_sw = "1"b;
136                complain = active_fnc_err_;
137           end;
138 
139           do argno = 1 to arg_count;
140                call cu_$arg_ptr (argno, ap, al, ec);        /* get nth argument */
141 
142                if arg = "-absentee" | arg = "-as" then abs = "1"b;
143                else if arg = "-daemon" | arg = "-dmn" then daemon = "1"b;
144                else if arg = "-interactive" | arg = "-ia" then interactive = "1"b;
145                else if arg = "-all" | arg= "-a" then interactive, daemon, abs = "1"b;
146                else if arg = "-name" | arg = "-nm" then sort = 1;
147                else if arg = "-project" | arg = "-pj" then sort = 2;
148 
149                else if arg = "-brief" | arg = "-bf" then
150                     if af_sw then do;
151 BAD_AF_OPT:              call active_fnc_err_ (0, caller, "Invalid active function control arg ^a", arg);
152                          return;
153                     end;
154                     else brief = "1"b;
155                else if arg = "-long" | arg = "-lg" then
156                     if af_sw then go to BAD_AF_OPT;
157                     else long = "1"b;
158 
159                else if substr (arg, 1, 1) = "-" then do;    /* then it must be a name or project */
160 bad_opt:            call complain (error_table_$badopt, caller, "^a", arg);
161                     return;
162                end;
163                else do;                                     /* save Name | .Project */
164                     selx = selx + 1;                        /* up index in select array */
165                     if selx > hbound (nm, 1) then do;
166                          call complain (error_table_$too_many_args, caller);
167                          return;
168                     end;
169                     nm (selx), pj (selx) = "";              /* blank selectors */
170                     dotl = index (arg, ".");                /* where's the dot? */
171                     if dotl = 0 then nm (selx) = arg;       /* no dot. is user name. */
172                     else if dotl = 1 then pj (selx) = substr (arg, 2, al - 1);
173                     else do;                                /* dot in middle, is name.proj */
174                          nm (selx) = substr (arg, 1, dotl - 1); /* get name */
175                          pj (selx) = substr (arg, dotl + 1, al - dotl);
176                     end;
177                end;
178                if sort ^= 0 & hmuflg then go to bad_opt;
179           end;
180 
181           if ^interactive & ^abs & ^daemon then do;         /* if process type not specified */
182                interactive, abs = "1"b;                     /* default is to list abs and ia */
183                if selx > 0 then daemon = "1"b;              /* but if name/proj given, list everything */
184           end;
185           only_abs = abs & ^interactive & ^daemon;          /* see if abs only */
186 
187 go:       if whoptr = null then do;                         /* is this the first call? */
188                call hcs_$initiate (sysdir, "whotab", "", 0, 1, whoptr, ec);
189                if whoptr = null then do;
190                     call complain (ec, caller, "^a>whotab", sysdir);
191                     return;
192                end;
193           end;
194 
195           if ^brief & ^af_sw then do;                       /* suppress header */
196                if hmuflg then go to head;                   /* always a header for hmu, except after brief */
197                if selx = 0 then do;                         /* no header with who select */
198                     if only_abs                             /* what type absentee header if any */
199                     then if long
200                          then go to print_long_abs_totals;
201                          else go to print_abs_totals;
202 head:               f1 = whotab.n_units / 10.0e0;           /* format up units */
203                     f2 = whotab.mxunits / 10.0e0;           /* ... */
204                     j = whotab.n_users - whotab.abs_users - whotab.fg_abs_users - whotab.n_daemons; /* compute interactive users */
205 
206                     if long then do;                        /* long who? */
207                          if ip = null then do;
208                               call hcs_$initiate (sysdir, "installation_parms", "", 0, 1, ip, ec);
209                               if ip = null then do;
210                                    call complain (ec, caller, "Insufficient access for -long option");
211                                    return;
212                               end;
213                          end;
214                          time = date_time_$format ("date_time", whotab.timeup, "", ""); /* yup. make heading */
215                          call ioa_ ("^/Multics ^a; ^a", whotab.sysid, installation_parms.installation_id);
216                          call ioa_ ("Load = ^.1f out of ^.1f units; users = ^d, ^d interactive, ^d daemons.",
217                               f1, f2, whotab.n_users, j, whotab.n_daemons);
218                          if (whotab.abs_users + whotab.max_abs_users) ^= 0
219                          then                               /* ! */
220 print_long_abs_totals:        call ioa_ ("^[^/^]Absentee users = ^d background^[, ^d foreground^;^s^]; Max background absentee users = ^d^[^/^]",
221                                    only_abs, whotab.abs_users, (whotab.fg_abs_users > 0), whotab.fg_abs_users, whotab.max_abs_users, only_abs);
222                          if only_abs then go to check_hmu;
223                          call ioa_ ("System up since ^a", time);
224                          if whotab.nextsd ^= 0 then do;
225                               why = whotab.why;
226                               if why < "" then why = "";
227                               time = date_time_$format ("date_time", whotab.nextsd, "", "");
228                               if whotab.until = 0 then call ioa_ ("Scheduled shutdown at ^a ^a", time, why);
229                               else do;
230                                    time1 = date_time_$format ("date_time", whotab.until, "", "");
231                                    call ioa_ ("Scheduled shutdown from ^a to ^a ^a", time, time1, why);
232                               end;
233                          end;
234                          time = date_time_$format ("date_time", whotab.lastsd, "", "");
235                          if whotab.erfno = "crash" then call ioa_ ("Last crash was at ^a^/", time);
236                          else if whotab.lastsd = 0 then call ioa_ ("");
237                          else if whotab.erfno = "" then call ioa_ ("Last shutdown was at ^a^/", time);
238                          else call ioa_ ("Last crash (ERF ^a) was at ^a^/", whotab.erfno, time);
239                          if hmuflg then if selx = 0 then return;
240                               else go to shell_sort;
241                          call ioa_ ("^4xLogin at^6xTTY  Load^3xUser ID^/");
242                     end;
243                     else do;                                /* short who. */
244                          call ioa_ ("^/Multics ^a, load ^.1f/^.1f; ^d users, ^d interactive, ^d daemons.",
245                               whotab.sysid, f1, f2, whotab.n_users, j, whotab.n_daemons);
246                          if (whotab.max_abs_users + whotab.abs_users) ^= 0
247                          then                               /* print absentee totals under certain conditions */
248 print_abs_totals:             call ioa_
249                                    ("^[^/^]Absentee users ^d/^d^[^x(+^d FG)^;^s^]^[^/^]",
250                                    only_abs, whotab.abs_users, whotab.max_abs_users, (whotab.fg_abs_users > 0), whotab.fg_abs_users, only_abs);
251                          if ^abs then call ioa_ ("");
252                     end;
253                end;
254           end;
255 check_hmu:
256           if hmuflg & selx = 0                              /* if a simple hmu entry then finished */
257           then return;
258 
259 shell_sort: last = whotab.laste;                            /* save high limit on whotab */
260           if hmuflg then go to count;                       /* go to selective hmu counting */
261 
262           begin;
263 
264 dcl  sort_array (last) fixed bin;
265 
266                do j = 1 to last;                            /* set up sort array */
267                     sort_array (j) = j;                     /* ... */
268                end;
269 
270                d = last;                                    /* set up for Shell sort */
271 pass:          d = divide (d + 1, 2, 17, 0);                /* ... */
272                swap = 0;                                    /* ... */
273                do j = 1 to last - d;                        /* comparison loop */
274                     aj = sort_array (j);                    /* make temps */
275                     ajd = sort_array (j + d);               /* ... */
276                     if sort = 0 then if whotab.timeon (aj) > whotab.timeon (ajd) then go to ic;
277                     if sort = 1 then if whotab.person (aj) > whotab.person (ajd) then go to ic;
278                     if sort = 2 then if whotab.project (aj) > whotab.project (ajd) then go to ic;
279                          else if whotab.project (aj) = whotab.project (ajd) then if whotab.person (aj)
280                                    > whotab.person (ajd) then do; /* Are items in order? */
281 ic:                                sort_array (j) = ajd;    /* No. Swap entries */
282                                    sort_array (j + d) = aj; /* ... */
283                                    swap = swap + 1;         /* remember a swap */
284                               end;
285                end;
286                if swap > 0 then go to pass;                 /* if out of order do it again */
287                if d > 1 then go to pass;                    /* ... */
288 
289 
290 
291                time1 = "%%%%";                              /* make sure it won't match (time) later on. */
292                if af_sw then return_arg = "";
293 
294                do j = 1 to last;                            /* now the print loop */
295                     aj = sort_array (j);                    /* set up speed temp */
296                     if whotab.active (aj) = 0 then go to skip; /* skip deads */
297                     if selx = 0 then go to print;           /* any users selected? */
298                     do k = 1 to selx;                       /* check for selected users */
299                          if nm (k) = whotab.person (aj) then if pj (k) = "" then go to print;
300                               else if pj (k) = whotab.project (aj) then go to print;
301                          if nm (k) = "" then if pj (k) = whotab.project (aj) then go to print;
302                     end;
303                     go to skip;                             /* user not in selected group */
304 
305 print:
306                     if whotab.proc_type (aj) = 1 & ^interactive
307                          | whotab.proc_type (aj) = 2 & ^abs
308                          | whotab.proc_type (aj) = 3 & ^daemon
309                     then goto skip;
310 
311                     if af_sw then do;
312                          if return_arg ^= "" then return_arg = return_arg || " ";
313                          return_arg = return_arg ||
314                               requote_string_ (rtrim (whotab.person (aj)) || "." || rtrim (whotab.project (aj)));
315                          go to skip;
316                     end;
317 
318                     if whotab.proc_type (aj) ^= 2 then      /* if not absentee */
319                          mark = "";                         /* clear absentee flag */
320                     else if whotab.fg_abs (aj) then         /* if foreground absentee */
321                          mark = "*FG";                      /* flag it as such */
322                     else mark = "*";                        /* else flag it as background absentee */
323 
324                     did = did + 1;                          /* remember we did one */
325                     if long then do;                        /* long who? */
326                          time = date_time_$format ("^<date>!! ^<time>", whotab.timeon (aj), "", "");
327 /****                    Suppress date if it's the same as last printed date */
328                          date_l = index (time, "!!")-1;
329                          if substr (time, 1, date_l) = substr (time1, 1, date_l)
330                          then substr (time, 1, date_l) = " ";
331                          else time1 = time;
332                          f1 = whotab.units (aj) / 10.0e0;   /* get nice units */
333                          call ioa_ ("^va ^a  ^4a ^4.1f^3x^a.^a^a^x^[D^]^[S^]",
334                               date_l, before (time, "!!"), after (time, "!!"),
335                               whotab.idcode (aj), f1, whotab.person (aj), whotab.project (aj),
336                               mark, whotab.disconnected (aj), whotab.suspended (aj));
337                     end;
338                     else do;                                /* short who. */
339                          call ioa_ ("^a.^a^a^x^[D^]^[S^]", whotab.person (aj), whotab.project (aj), mark,
340                               whotab.disconnected (aj), whotab.suspended (aj));
341                     end;
342 
343 skip:          end;
344 
345           end;
346 
347           if ^af_sw then do;
348                if ^brief then
349 
350                     if did = 0 then do;                     /* if printed nobody */
351                          if selx = 1 then if nm (1) ^= "" then sss = "";
352                          call ioa_ ("User^a not logged in.", sss);
353                     end;
354 
355                call ioa_ ("");                              /* extra CR */
356           end;
357 
358           return;                                           /* done. */
359 
360 /* - - - - - - - - */
361 
362 
363 count:    do j = 1 to selx;                                 /* selective hmu counting */
364                hmucnt = 0;                                  /* reset counters */
365                abscnt = 0;
366 
367                if nm (j) = "" then do;                      /* selected project counting */
368                     do aj = 1 to last;
369                          if pj (j) = whotab.project (aj) then
370                               if whotab.proc_type (aj) ^= 2
371                               then hmucnt = hmucnt + 1;
372                               else abscnt = abscnt + 1;
373                     end;
374                     call ioa_ (".^a = ^d + ^d*", pj (j), hmucnt, abscnt);
375                end;
376 
377                if nm (j) ^= "" then
378                     if pj (j) ^= ""                         /* selected name.project counting */
379                     then do;
380                          do aj = 1 to last;
381                               if nm (j) = whotab.person (aj)
382                               then if pj (j) = whotab.project (aj)
383                                    then if whotab.proc_type (aj) ^= 2
384                                         then hmucnt = hmucnt + 1;
385                                         else abscnt = abscnt + 1;
386                          end;
387                          call ioa_ ("^a.^a = ^d + ^d*", nm (j), pj (j), hmucnt, abscnt);
388                     end;
389                     else do;                                /* selected name counting */
390                          do aj = 1 to last;
391 
392                               if nm (j) = whotab.person (aj) then
393                                    if whotab.proc_type (aj) ^= 2
394                                    then hmucnt = hmucnt + 1;
395                                    else abscnt = abscnt + 1;
396                          end;
397                          call ioa_ ("^a = ^d + ^d*", nm (j), hmucnt, abscnt);
398                     end;
399           end;
400           return;
401 
402 who_init: entry (system_directory);                         /* entry used for testing who command */
403 
404 dcl  system_directory char (*);
405 
406           sysdir = system_directory;                        /* copy name of directory containing who table */
407 
408           whoptr = null;                                    /* set pointer to null */
409 
410           return;
411 
412      end who;