COMPILATION LISTING OF SEGMENT lar_util_ Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-04-18_1150.56_Tue_mdt Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1990 * 4* * * 5* * Copyright, (C) Honeywell Bull Inc., 1987 * 6* * * 7* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 8* * * 9* * Copyright (c) 1972 by Massachusetts Institute of * 10* * Technology and Honeywell Information Systems, Inc. * 11* * * 12* *********************************************************** */ 13 14 /* format: style4,delnl,insnl,^ifthendo */ 15 16 /* format: off */ 17 18 lar_util_: procedure (a_info_ptr, a_code); 19 20 /* This procedure is called by the queue-listing commands lar, ldr, and lrr (entry points in the same command procedure). 21* It formats information about absentee, I/O daemon, and retrieval requests, and places its output in a printable segment. 22* It leaves room for a totals line at the beginning, and then goes back and fills it in after it has scanned all the 23* pertinent requests and knows what the totals are. It operates on only one queue message segment at a time. 24* If the user specified that all queues (of a certain kind) be listed, the command procedure calls this one once for 25* each queue. The offset in the printable segment at which to start placing output is specified in the argument structure. 26* 27* All input and output arguments (except the error code) are passed in an argument structure, lar_info, a pointer to 28* which is the first argument in the call. The structure is defined in lar_info.incl.pl1, and comments in that 29* include file describe the meaning of each variable in the structure. 30* 31* There is one implicit convention observed between this procedure and its caller: this procedure avoids outputting 32* totals lines that contain only zeros, when the -all argument was given, and it avoids outputting totals lines for 33* queues from which no requests are selected, when the -search_all argument is given (or is in effect by default). 34* The calling procedure, realizing this, must check whether anything is in the output segment, and, if not, print a 35* message saying "No requests in any queue", or "No requests selected from any queue". 36**/ 37 38 /****^ HISTORY COMMENTS: 39* 1) change(86-03-01,Gilcrease), approve(86-03-27,MCR7370), 40* audit(86-07-07,Fawcett), install(86-06-30,MR12.0-1082): 41* Dummy comment for hcom. 42* 43* Modified by E. Stone 10/06/71 44* Modified by Dennis Capps 3/20/72 45* Modified by Robert Coren 4/17/73 to handle io_daemon requests 46* Modified by J. Stern 4/4/75 to print access classes in long mode 47* Modified by D. Vinograd 5/77 to return info about retrieval queues 48* Modified by J.Whitmore and T. Casey, April 1978, for new daemon and absentee queue entry formats 49* Modified by T. Casey, November 1978, for MR7.0, to list absentee queues zero and foreground, and other absentee changes. 50* Modified by T. Casey, April 1979, for MR7.0a, to identify deferred absentee requests that have not yet been processed. 51* Modified by R. Brinegar, Summer 1979 to fix output format problems. 52* Modified by S. Herbst, Fall 1979 to print request type in header. 53* Modified by T. Casey, November 1979 to print 8 digits of request ID and to identify bumped absentee jobs properly. 54* Modified by J. C. Whitmore, April 1980 for new retrieval request format using queue_msg_hdr 55* Modified by G. Palter, 8 September 1981 to print the I/O daemon forms if given 56* Modified by G. C. Dixon, Jan 1982 to support lor command. 57* Modified by R. Kovalcik, June 1982 to understand dprint -dupt. 58* Modified by C. Marker, November 1983 to add support for -no_separator 59* Modified by JAFalksen, August 1984 to use new time facilities 60* Modified by C. Marker, February 23, 1985 to use version 5 message segments 61* 2) change(86-03-27,Gilcrease), approve(86-03-27,MCR7370), 62* audit(86-07-07,Fawcett), install(86-06-30,MR12.0-1082): 63* Add handling of truncate absout & restarted bits. SCP 6297. 64* 3) change(87-07-07,GDixon), approve(87-07-07,MCR7741), 65* audit(87-07-07,Hartogs), install(87-08-04,MR12.1-1055): 66* Include user_abs_attributes.incl.pl1 as part of splitting 67* abs_message_format.incl.pl1. 68* 4) change(87-08-06,Gilcrease), approve(87-08-06,MCR7686), 69* audit(88-02-01,Farley), install(88-02-02,MR12.2-1019): 70* Add -nb message to lor/ldr -long. 71* 5) change(87-11-11,Parisek), approve(88-02-11,MCR7849), 72* audit(88-03-07,Lippard), install(88-07-13,MR12.2-1047): 73* Reference version 6 abs_message_format structure, and if version 6 74* format output for the structure's new data. 75* 6) change(87-11-13,Parisek), approve(88-02-11,MCR7849), 76* audit(88-03-07,Lippard), install(88-07-13,MR12.2-1047): 77* Display the request version 6 elements; no_start_up, home_dir, init_proc. 78* SCP 6367. 79* 7) change(88-04-20,Parisek), approve(88-06-13,MCR7913), 80* audit(88-08-16,Farley), install(88-08-22,MR12.2-1089): 81* Added the request_info entrypoint which called by the 82* request_info command/active_function to return specific queue 83* information about absentee, output, io, retrieval, and file transfer 84* requests. Added the internal procedures, buffer_abs_element, 85* buffer_com_element, buffer_out_element, buffer_retv_element, and 86* buffer_imft_element to format the return information for the caller. 87* Alter the flow of code execution at various points when the rqi_sw switch 88* is ON. The rqi_sw informs lar_util_ that it was called by the 89* request_info command/AF. 90* Added checks for selecting OUTPUT requests with special forms only. 91* 8) change(88-09-01,Parisek), approve(88-09-01,PBF7913), 92* audit(88-09-07,Farley), install(88-09-09,MR12.2-1101): 93* Removed the displaying of the "delete" and "dupt" request flags for 94* request types they do not pertain to. Also check imft's 95* "remote_transfer" flag before displaying the "files" and "subtrees" 96* flags for the imft request type. "files" and "subtrees" do not pertain 97* to imft requests coming from the remote system. 98* 9) change(88-09-13,Beattie), approve(88-08-01,MCR7948), 99* audit(88-10-11,Farley), install(88-10-14,MR12.2-1165): 100* Add support for displaying extend, update and delete for IMFT requests. 101* 10) change(88-09-13,Farley), approve(88-09-16,MCR7911), 102* audit(88-10-25,Wallman), install(88-10-28,MR12.2-1199): 103* Updated to use version 5 dprint_msg. Also added "plotter" as one of the 104* valid output_modules. 105* 11) change(90-12-10,Vu), approve(90-12-10,MCR8231), audit(92-09-25,Zimmerman), 106* install(92-10-06,MR12.5-1021): 107* Header for list_absentee_request has garbage total. 108* END HISTORY COMMENTS */ 109 110 /* format: on */ 111 112 /* Arguments */ 113 114 dcl a_info_ptr ptr; 115 dcl a_code fixed bin (35); 116 117 /* Automatic variables, in alphabetic order */ 118 119 120 dcl abs_name char (32); 121 dcl access_class bit (72) aligned; 122 dcl aclass_string char (170); 123 dcl af_flag_str char (512) varying; 124 dcl afsw bit (1) aligned; /* active function call */ 125 dcl agdd char (168); /* argument directory, directory portion */ 126 dcl agde char (32); /* argument directory, entry portion */ 127 dcl aguid bit (36); /* argument directory, UID */ 128 dcl allsw bit (1) aligned; /* print all for request_info */ 129 dcl areap ptr; 130 dcl argl fixed bin; 131 dcl argx fixed bin; /* argument string index */ 132 dcl auto_forms_name char (forms_max_lth) varying; 133 dcl buffer char (512) aligned; 134 dcl check_abs_name bit (1) aligned; 135 dcl check_user bit (1) aligned; 136 dcl code fixed bin (35); 137 dcl curarg_start fixed bin; 138 dcl deferred_abs bit (1) aligned; 139 dcl deferred_count fixed bin; 140 dcl dirname char (168); 141 dcl ename char (32); 142 dcl expandedlen fixed bin; 143 dcl expandlen fixed bin; 144 dcl expandp ptr; 145 dcl header_position fixed bin; 146 dcl i fixed bin; 147 dcl j fixed bin; 148 dcl last_comma fixed bin; 149 dcl len fixed bin; 150 dcl len_offset fixed bin; 151 dcl ll fixed bin; 152 dcl 1 local_mseg_message_info like mseg_message_info aligned; 153 dcl long_id bit (1) aligned; 154 dcl messcount fixed bin; 155 dcl modes char (100) var; 156 dcl msg_time fixed bin (71); 157 dcl n_bad_vrsn fixed bin; 158 dcl no_totals bit (1) aligned; 159 dcl offs char (256) varying; 160 dcl offslen fixed bin (21); 161 dcl old_ms_id bit (72) aligned; 162 dcl ons char (256) varying; 163 dcl onslen fixed bin (21); 164 dcl pass1 bit (1) aligned; 165 dcl person char (32); 166 dcl position fixed bin; 167 dcl print_requests bit (1) aligned; 168 dcl print_user_column bit (1) aligned; 169 dcl project char (32); 170 dcl psn_ll fixed bin; 171 dcl psn_s fixed bin; 172 dcl queue_string char (32); 173 dcl read_all bit (1) aligned; 174 dcl reqp ptr; 175 dcl retrying bit (1) aligned; 176 dcl rqdd char (168); /* request directory, directory portion */ 177 dcl rqde char (32); /* request directory, entry portion */ 178 dcl rqid char (19); /* request directory, UID */ 179 dcl rqi_buffered bit (1) aligned; /* ON if output buffered for rqi */ 180 dcl rqi_sw bit (1) aligned; /* command/active function entry point */ 181 dcl rs_len fixed bin; 182 dcl s char (1) aligned; 183 dcl scrunchedp ptr; 184 dcl select_sw bit (1) aligned; 185 dcl sender_id char (32); 186 dcl state fixed bin; 187 dcl str char (32) varying; 188 dcl tbf char (32) var; 189 dcl time char (64) var; 190 dcl time_now fixed bin (71); 191 dcl total_for_user fixed bin; 192 dcl total_selected fixed bin; 193 dcl user_matches bit (1) aligned; 194 195 /* Based */ 196 197 dcl region area (1000) based (areap); 198 dcl cstrng char (info.output_count) aligned based (info.temptr); 199 dcl args_con_blanks char (expandlen) aligned based (expandp); 200 dcl args_sans_blanks char (expandlen) aligned based (scrunchedp); 201 dcl based_dummy fixed bin based; /* for freeing requests without computing their extents */ 202 203 /* Conditions */ 204 205 dcl cleanup condition; 206 207 /* Internal Static */ 208 209 dcl header_length int static options (constant) fixed bin init (74); 210 dcl ABS_VER_5 fixed bin (17) init (5) static options (constant); 211 dcl ABS_VER_4 fixed bin (17) init (4) static options (constant); 212 /* a request_version of 4 means that this abs was queued under MR11. */ 213 /* Any abs queued under MR12 will be version 5. */ 214 dcl DEFAULT_LINE_LTH int static options (constant) fixed bin init (79); 215 dcl DEFAULT_OUTPUT_LTH int static options (constant) fixed bin init (-1); 216 dcl IMFT fixed bin (17) int static options (constant) init (5); 217 dcl TAB_39 int static options (constant) fixed bin init (39); 218 dcl TAB_44 int static options (constant) fixed bin init (44); 219 dcl TOO_SMALL_LINE_LTH int static options (constant) fixed bin init (50); 220 dcl Notify_msg char (13) static options (constant) init ("Notify: yes 221 "); 222 dcl Restarted_msg char (16) int static options (constant) init ("Restarted: yes 223 "); 224 dcl Truncate_msg char (15) int static options (constant) init ("Truncate: yes 225 "); 226 dcl line_nbrs_msg char (18) static options (constant) init ("Line numbers: yes 227 "); 228 dcl DUPT_msg char (11) static options (constant) init ("DUPT: yes 229 "); 230 dcl NL char (1) int static options (constant) init (" 231 "); 232 dcl pp_request_type (2:4) char (9) aligned int static options (constant) init ("7punch", "mcc_punch", "raw_punch"); 233 234 dcl state_names (-1:6) char (48) int static options (constant) init ("state undefined", 235 /* -1 */ 236 "unprocessed", /* 0 */ 237 "deferred", /* 1 */ 238 "state changing", /* 2 */ 239 "eligible", /* 3 */ 240 "running", /* 4 */ 241 "bumped", /* 5 */ 242 "deferred until process termination"); /* 6 */ 243 244 dcl static_psn_s fixed bin int static; 245 dcl static_ll fixed bin int static; 246 dcl static_header_position fixed bin int static; 247 dcl static_total_selected fixed bin int static; 248 dcl static_messcount fixed bin int static; 249 dcl static_deferred_count fixed bin int static; 250 dcl static_position fixed bin int static; 251 252 /* Ext Entries */ 253 254 dcl aim_check_$greater entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); 255 dcl convert_authorization_$to_string_short ext entry (bit (72) aligned, char (*), fixed bin (35)); 256 dcl date_time_$format entry (char (*), fixed bin (71), char (*), char (*)) returns (char (250) var); 257 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 258 dcl get_group_id_ entry returns (char (32)); 259 dcl hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)); 260 dcl ioa_$rs entry options (variable); 261 dcl ioa_$rsnnl entry options (variable); 262 dcl get_line_length_ entry (char (*), fixed bin, fixed bin (35)); 263 dcl get_system_free_area_ entry (ptr); 264 dcl match_request_id_ entry (fixed bin (71), char (*)) returns (bit (1) aligned); 265 dcl match_star_name_ entry (char (*), char (*), fixed bin (35)); 266 dcl message_segment_$get_message_count_index entry (fixed bin, fixed bin, fixed bin (35)); 267 dcl message_segment_$read_message_index entry (fixed bin, pointer, pointer, fixed bin (35)); 268 dcl request_id_ entry (fixed bin (71)) returns (char (19)); 269 270 271 /* Builtins */ 272 273 dcl (addr, after, before, clock, hbound, length, index, lbound, null, reverse, rtrim, substr, unspec) builtin; 274 275 /* Error table */ 276 277 dcl error_table_$moderr ext fixed bin; 278 dcl error_table_$no_message ext fixed bin; 279 dcl error_table_$bad_segment ext fixed bin (35); 280 281 282 afsw = "0"b; 283 rqi_sw = "0"b; 284 goto COMMON_INIT; 285 286 request_info: 287 entry (a_info_ptr, a_afsw, a_code); 288 289 dcl a_afsw bit (1) aligned; /* On if rqi called as AF */ 290 291 /* This entry is called by the queue-info command/active function request_info. 292* It produces output in a simple formatted line by line format. It does not produce 293* any header or totals information in its output. 294**/ 295 296 afsw = a_afsw; 297 rqi_sw = "1"b; 298 299 COMMON_INIT: /* Initialize */ 300 info_ptr = a_info_ptr; 301 a_code = 0; 302 reqp = null; 303 total_selected, total_for_user, deferred_count, n_bad_vrsn, position, code = 0; 304 305 time_now = clock (); 306 307 /* Set some local switches, based on combinations of input switches */ 308 309 if info.long_id_sw | info.long_sw 310 then /* if -long or -long_id */ 311 long_id = "1"b; /* print the long form of request IDs */ 312 else long_id = ""b; /* else print the short form */ 313 314 check_user = info.user_sw; /* see if a user name was specified by the caller */ 315 if info.person = "*" & info.project = "*" 316 then /* if caller said -user *.* */ 317 check_user = ""b; /* pretend user was not specified */ 318 319 if info.abs_q_1 & info.queue = 0 320 then /* if running Qs 0 and 1 together and this is Q 0 */ 321 static_header_position = 0; /* indicate that we have no Q 0 output yet */ 322 323 /* Decide whether to print the user column */ 324 325 if info.admin_sw /* if we are in admin mode */ 326 & (^check_user /* and we don't have a user name */ 327 | (check_user /* or we have a user name */ 328 & (info.person = "*" | info.project = "*"))) 329 then /* but it could match several users */ 330 print_user_column = "1"b; /* then print the user name for each request */ 331 else print_user_column = ""b; /* else they're all from the same user so don't print the name */ 332 333 /* See if we have to read all requests, or just those for the user whose process we're running in */ 334 335 if info.admin_sw | info.position_sw 336 then read_all = "1"b; 337 else read_all = ""b; 338 339 /* See if we have to look at the contents of a request to decide whether to select it */ 340 341 if info.user_sw | info.immediate | info.resource_sw | info.dirname_sw | info.ename_sw | info.id_sw 342 | info.deferred_indefinitely | info.sender_sw | info.forms_sw 343 then select_sw = "1"b; /* we do */ 344 else select_sw = ""b; /* we don't */ 345 346 /* Initialize some variables used for checking the user ID of each request */ 347 348 if check_user 349 then do; /* if we have to check the user, copy the name and project */ 350 person = info.person; 351 project = info.project; 352 end; /* but if user not specified */ 353 else if info.position_sw /* and we can't use the "own" primitives because we have to read 354* every request to get the positions of the ones we select */ 355 & ^info.admin_sw 356 then do; /* and we're not listing all users' requests */ 357 person = get_group_id_ (); /* get the ID of this user so we can pick out his requests */ 358 project = before (after (person, "."), "."); 359 person = before (person, "."); 360 check_user = "1"b; /* and remember to check each request for a matching user name */ 361 end; 362 363 /* If directory name supplied, get its UID, so we can try UID matching to get around the multiply-named directory problem */ 364 365 if info.dirname_sw 366 then do; 367 call expand_pathname_ ((info.dirname), agdd, agde, code); 368 if code ^= 0 369 then goto return_code; /* can't happen since caller already expanded it ok */ 370 call hcs_$status_long (agdd, agde, (1), addr (branch_status), null, code); 371 if code = 0 372 then aguid = branch_status.unique_id; 373 else aguid = ""b; /* ""b means don't try UID matching */ 374 end; 375 376 /* If listing absentee requests, see if we have to append the .absin suffix to a name given by the user */ 377 378 check_abs_name = ""b; 379 if info.request_type = ABS 380 then if index (info.ename, ".absin") = 0 & length (rtrim (info.ename)) <= 26 381 then do; 382 abs_name = rtrim (info.ename) || ".absin"; 383 check_abs_name = "1"b; 384 end; 385 386 /* Figure out where in the output segment to start putting our output lines . This gets complicated because 387* we list absentee queues 0 and 1 as if they were one queue. Queue zero exists only so the operator can 388* move requests "to the head of queue 1", even though it is impossible to add messages to the head 389* of a message segment. 390* 391* So here, we have to adjust some variables to run the Q 0 and Q 1 listings together, 392* instead of separating them by a header. */ 393 394 info.output_count = info.input_count + 1; /* point output_count at first vacant char */ 395 396 if rqi_sw 397 then goto message_count; 398 399 if info.output_count = 1 400 then /* if nothing in segment yet */ 401 call put_message (NL); /* skip a line */ 402 403 if (info.abs_q_1 & static_header_position > 0 & info.queue = 1) 404 then do; /* if running Qs 0 and 1 together */ 405 header_position = static_header_position; /* get position of header that's already there */ 406 position = static_position; /* and Q position of last request in Q 0 */ 407 deferred_count = static_deferred_count; /* and count of deferred requests */ 408 409 410 if substr (cstrng, info.output_count - 2, 2) = NL || NL 411 then /* if output seg ends in double newline */ 412 info.output_count = info.output_count - 1; 413 /* get rid of one of them */ 414 415 if info.total_sw & info.position_sw & static_total_selected > 0 416 then do; /* continue position list from Q 0 */ 417 psn_s = static_psn_s; /* position of the "s" in "Positions" */ 418 ll = static_ll; /* terminal's line length */ 419 psn_ll = 0; /* too difficult to append to current line, so start a new one */ 420 if substr (cstrng, info.output_count - 2, 1) = "." 421 then /* but if we can find the trailing period */ 422 substr (cstrng, info.output_count - 2, 1) = ","; 423 /* change it back to a comma */ 424 substr (cstrng, psn_s, 2) = "s:"; /* and be sure it says "Positions:" */ 425 end; /* end continue position list */ 426 end; 427 428 else do; /* else reserve a place for the header */ 429 header_position = info.output_count; /* remember where it starts */ 430 info.output_count = info.output_count + header_length; 431 /* move vacant char index past space for header */ 432 substr (cstrng, header_position, header_length) = ""; 433 /* clear it, so we don't print lots of \000's if we 434* exit with an error before getting around to filling it in */ 435 static_total_selected = 0; /* and make sure there's no garbage in this variable */ 436 end; 437 438 439 /* See if we can get the total number of requests in the queue */ 440 441 message_count: 442 no_totals = ""b; /* assume we can */ 443 call message_segment_$get_message_count_index (info.mseg_idx, messcount, code); 444 if code ^= 0 445 then do; /* user might have read or own permission, but not status */ 446 messcount = 0; 447 if code ^= error_table_$moderr 448 then goto return_code; /* if that is not the case, give up immediately */ 449 else do; /* that was the case */ 450 code = 0; 451 no_totals = "1"b; /* remember not to print the total requests */ 452 info.no_total_sw = "1"b; /* tell caller not to print "No requests in any queue" */ 453 end; 454 end; 455 else if messcount = 0 456 then go to fin; /* if no requests then we are done */ 457 458 if info.admin_sw /* if reading all requests */ 459 & info.total_sw /* just to count them */ 460 & ^select_sw /* and not being selective about it */ 461 & ^info.position_sw /* and not printing their positions */ 462 & ^no_totals /* and we were able to get the count */ 463 then do; /* save lots of time */ 464 total_for_user = messcount; 465 total_selected = messcount; /* don't bother reading thru the queue */ 466 goto fin; /* just go print the total */ 467 end; 468 469 /* Set up to read requests from the queue */ 470 471 call get_system_free_area_ (areap); /* get area in which to place request */ 472 mseg_message_info_ptr = addr (local_mseg_message_info); 473 reqp, expandp, scrunchedp = null (); /* init for cleanup handler */ 474 on cleanup call cleaner_up; /* establish cleanup handler */ 475 476 /* Get started through the queue by reading either the first message in the queue, or the first message for this user */ 477 478 retrying = ""b; 479 retry_1: 480 reqp, requestp, dmp = null; /* init these to avoid faults */ 481 unspec (local_mseg_message_info) = ""b; 482 local_mseg_message_info.version = MSEG_MESSAGE_INFO_V1; 483 local_mseg_message_info.own = ^read_all; 484 local_mseg_message_info.message_code = MSEG_READ_FIRST; 485 call message_segment_$read_message_index (info.mseg_idx, areap, mseg_message_info_ptr, code); 486 487 if ^retrying 488 then /* retry the read once, if queue has been salvaged */ 489 if code = error_table_$bad_segment 490 then do; 491 retrying = "1"b; 492 goto retry_1; 493 end; 494 495 /* Top of loop through all requests in queue. The bottom of this loop, at the 496* label "skip", does an incremental read and then comes here. We exit the loop 497* by going to mess_err if code is nonzero. This is for both normal and abnormal exits. */ 498 499 loop: 500 if code ^= 0 501 then go to mess_err; /* exit loop if no message or real error */ 502 reqp, requestp, dmp, ft_request_ptr = mseg_message_info.ms_ptr; 503 /* set ptrs to all of the request structures */ 504 sender_id = mseg_message_info.sender_id; 505 access_class = mseg_message_info.ms_access_class; 506 507 /* Check version of request, and complain if not current. It is worthwhile to diagnose this error, since it is 508* likely to occur often now. We are changing the request versions, and there are lots of private 509* versions of the ear and dprint commands around to put old version requests into the queues. */ 510 511 if request.hdr_version ^= queue_msg_hdr_version_1 512 then goto vrsn_ng; 513 514 if info.request_type = RETV 515 then if retv_request.version = retv_request_version_2 516 then goto vrsn_ok; 517 else goto vrsn_ng; 518 else if info.request_type = ABS 519 then if (request.request_version = abs_message_version_6 | request.request_version = ABS_VER_5 520 | request.request_version = ABS_VER_4) /* Allow old versions */ 521 then goto vrsn_ok; 522 else goto vrsn_ng; 523 else if info.request_type = IO | info.request_type = OUTPUT 524 then if dprint_msg.version = dprint_msg_version_5 | dprint_msg.version = dprint_msg_version_4 525 | dprint_msg.version = dprint_msg_version_3 526 then goto vrsn_ok; 527 else goto vrsn_ng; 528 else if (rqi_sw & info.request_type = IMFT) /* We only deal with IMFT in this module if invoked as request_info */ 529 then if ft_request.version = FT_REQUEST_VERSION_1 530 then goto vrsn_ok; 531 532 vrsn_ng: 533 if rqi_sw & afsw 534 then goto skip; /* simply ignore */ 535 n_bad_vrsn = n_bad_vrsn + 1; /* count bad ones for printing in totals at end */ 536 537 if check_user 538 then do; /* don't complain to one user about another's bad requests */ 539 if person ^= "*" 540 then if person ^= before (sender_id, ".") 541 then goto skip; 542 if project ^= "*" 543 then if project ^= before (after (sender_id, "."), ".") 544 then goto skip; 545 end; 546 547 total_selected = total_selected + 1; /* we have "selected" this one, to complain about it */ 548 total_for_user = total_for_user + 1; /* also count it among this user's requests */ 549 550 if ^info.total_sw 551 then do; /* long or normal mode; print stuff in mseg return args */ 552 unspec (msg_time) = mseg_message_info.ms_id; /* this tells us when it was entered */ 553 time = date_time_$format ("date_time", msg_time, "", ""); 554 /* format it so we can show it to the user */ 555 if info.long_sw 556 then do; /* might as well make it look pretty */ 557 call put_message (NL); 558 call ioa_$rs ("User:^21t^a", buffer, len, sender_id); 559 call put_buffer; 560 call ioa_$rs ("Time queued:^21t^a", buffer, len, time); 561 call put_buffer; 562 call put_message_nl ("Request has obsolete or incorrect format"); 563 end; 564 else do; /* normal format */ 565 if print_user_column 566 then do; 567 call ioa_$rsnnl ("^30a", buffer, len, sender_id); 568 call put_buffer; 569 end; 570 call ioa_$rs ("Request has obsolete or incorrect format. Time queued: ^a", buffer, len, time); 571 call put_buffer; 572 end; 573 end; /* end not totals */ 574 575 goto skip; 576 577 vrsn_ok: /* See if the user matches */ 578 user_matches = ""b; /* start out being pessimistic */ 579 if check_user 580 then do; /* if user name was given, see if it matches */ 581 if person ^= "*" 582 then do; /* require matching person ID */ 583 if person ^= before (sender_id, ".") 584 then do; /* user does not match */ 585 if info.request_type ^= ABS 586 then goto wrong_user; 587 if ^request.proxy 588 then goto wrong_user; /* wrong_user unless proxy request */ 589 if person ^= before (request.proxy_name, ".") 590 then goto wrong_user; /* proxy user doesn't match */ 591 end; 592 end; 593 594 if project ^= "*" 595 then do; /* require matching project ID */ 596 if project ^= before (after (sender_id, "."), ".") 597 then do; /* project does not match */ 598 if info.request_type ^= ABS 599 then goto wrong_user; 600 if ^request.proxy 601 then goto wrong_user; /* wrong_user unless proxy request */ 602 if project ^= before (after (request.proxy_name, "."), ".") 603 then goto wrong_user; 604 end; 605 end; 606 607 end; /* end check user */ 608 609 user_matches = "1"b; /* true if we fell thru ok or if ^check_user */ 610 wrong_user: /* come here from above as soon as user is found not to match */ 611 if user_matches 612 then total_for_user = total_for_user + 1; /* count requests belonging to the specified user */ 613 614 615 /* Now see if the request is deferred or not, and update the request position counter. 616* If printing position, we count the request even if we are not listing it, so we will 617* know the positions of subsequent requests that we do list. So we make this check before 618* eliminating the request by going to skip. 619* 620* But, if -immediate was given, we not only don't list deferred requests, but we don't count 621* them when computing the positions of other requests. We assume the deferred requests will 622* be passed by the other requests whose positions we will print. */ 623 624 if info.immediate | read_all 625 then do; /* check for immediate first */ 626 if info.request_type = IO | info.request_type = OUTPUT 627 then /* for I/O requests */ 628 if request.state = STATE_DEFERRED 629 then goto deferred_request; /* the decision is very simple */ 630 if info.request_type = ABS 631 then do; /* for absentee, it is a bit more complicated */ 632 if request.state < STATE_ELIGIBLE 633 then do; 634 if request.user_deferred_until_time 635 then if request.deferred_time > time_now 636 then goto deferred_request; 637 if request.user_deferred_indefinitely 638 then goto deferred_request; 639 if request.operator_deferred_until_time 640 then if request.deferred_time > time_now 641 then goto deferred_request; 642 if request.operator_deferred_indefinitely 643 then goto deferred_request; 644 if request.cpu_time_limit 645 then goto deferred_request; 646 end; 647 end; /* retrieval requests do not have a non-immediate mode */ 648 goto immediate_request; 649 650 deferred_request: 651 deferred_count = deferred_count + 1; /* count deferred requests for totals line */ 652 if info.immediate 653 then goto skip; 654 655 immediate_request: 656 end; /* end immediate checking */ 657 658 position = position + 1; /* this request counts for position computation */ 659 660 /* Now start checking whether we want to list this request or count it in the totals */ 661 662 /* First, check the user match switch that we set above */ 663 664 if ^user_matches 665 then goto skip; 666 667 /* Copy a few variables out of the queue_msg_hdr part of the request structure */ 668 669 dirname = request.dirname; 670 ename = request.ename; 671 msg_time = request.msg_time; 672 state = request.state; 673 if state > hbound (state_names, 1) | state < lbound (state_names, 1) 674 then state = -1; 675 676 /* See if the ID, dirname, and entry name match */ 677 678 if info.id_sw 679 then if ^match_request_id_ (msg_time, (info.request_id)) 680 then goto skip; 681 682 if info.dirname_sw 683 then if dirname ^= info.dirname 684 then do; 685 if aguid = ""b 686 then goto skip; /* if we don't have UID of info.dirname, don't try UID match */ 687 call expand_pathname_ (dirname, rqdd, rqde, code); 688 if code ^= 0 689 then goto skip; 690 call hcs_$status_long (rqdd, rqde, (1), addr (branch_status), null, code); 691 if code ^= 0 692 then goto skip; 693 if aguid ^= branch_status.unique_id 694 then goto skip; 695 end; 696 697 if info.ename_sw 698 then if ename ^= info.ename 699 then do; 700 call match_star_name_ (ename, (info.ename), code); 701 if code ^= 0 702 then if ^check_abs_name 703 then goto skip; 704 else do; /* user left off the .absin */ 705 if ename ^= abs_name 706 then do; 707 call match_star_name_ (ename, abs_name, code); 708 if code ^= 0 709 then goto skip; 710 end; 711 end; 712 end; 713 714 /* These checks just apply to absentee requests */ 715 716 if info.request_type = ABS 717 then do; 718 if info.resource_sw 719 then do; 720 if request.len_resource = 0 721 then goto skip; 722 if index (request.resource, info.resource_name) = 0 723 then goto skip; 724 end; 725 if info.deferred_indefinitely 726 then if ^request.user_deferred_indefinitely & ^request.operator_deferred_indefinitely 727 then goto skip; 728 if info.sender_sw 729 then /* check sender (RJE station) */ 730 if request.sender ^= info.sender 731 then do; 732 call match_star_name_ ((request.sender), (info.sender), code); 733 if code ^= 0 734 then goto skip; 735 end; 736 737 /* Later, add more checks to select absentee requests by their state, and 738* by their cpu time and resource requirements, mainly for the operator's use. */ 739 740 end; /* end absentee only checks */ 741 742 if info.request_type = OUTPUT 743 then do; 744 if info.forms_sw 745 then do; 746 if dprint_msg.version < dprint_msg_version_5 747 then auto_forms_name = rtrim (dprint_msg.forms); 748 else auto_forms_name = dprint_msg.forms_name; 749 if length (auto_forms_name) = 0 750 then goto skip; 751 if info.forms_name ^= "" 752 then if index (auto_forms_name, rtrim (info.forms_name)) = 0 753 then goto skip; 754 end; 755 end; /* end output only checks */ 756 757 /* Arriving here, we have selected this request, either for printing or counting in the totals */ 758 759 total_selected = total_selected + 1; /* increment number of requests */ 760 761 /* The following loops apply to request_info data */ 762 763 allsw = "0"b; 764 offs, ons, af_flag_str = ""; 765 if rqi_sw 766 then do; /* request_info */ 767 if substr (info.com_rqi, 1, 1) = "1"b 768 then do; /* bit 1 means "all" */ 769 allsw = "1"b; 770 info.com_rqi = "11111111111"b; 771 end; 772 do i = 1 to length (info.com_rqi); 773 if substr (info.com_rqi, i, 1) = "1"b 774 then do; 775 call buffer_com_element (i); 776 rqi_buffered = "1"b; 777 end; 778 end; 779 if info.request_type = ABS 780 then do; 781 if allsw 782 then info.abs_rqi = "1111111111111"b; 783 do i = 1 to length (info.abs_rqi); 784 if substr (info.abs_rqi, i, 1) = "1"b 785 then do; 786 call buffer_abs_element (i); 787 rqi_buffered = "1"b; 788 end; 789 end; 790 goto skip; 791 end; 792 if info.request_type = IO | info.request_type = OUTPUT 793 then do; 794 if allsw 795 then info.output_rqi = "11111111111"b; 796 do i = 1 to length (info.output_rqi); 797 if substr (info.output_rqi, i, 1) = "1"b 798 then do; 799 call buffer_output_element (i); 800 rqi_buffered = "1"b; 801 end; 802 end; 803 goto skip; 804 end; 805 if info.request_type = RETV 806 then do; 807 if allsw 808 then info.retv_rqi = "1111"b; 809 do i = 1 to length (info.retv_rqi); 810 if substr (info.retv_rqi, i, 1) = "1"b 811 then do; 812 call buffer_retv_element (i); 813 rqi_buffered = "1"b; 814 end; 815 end; 816 goto skip; 817 end; 818 if info.request_type = IMFT 819 then do; 820 if allsw 821 then info.imft_rqi = "111"b; 822 do i = 1 to length (info.imft_rqi); 823 if substr (info.imft_rqi, i, 1) = "1"b 824 then do; 825 call buffer_imft_element (i); 826 rqi_buffered = "1"b; 827 end; 828 end; 829 goto skip; 830 end; 831 end; 832 833 if info.total_sw 834 then do; 835 if info.position_sw 836 then do; /* print positions of selected requests */ 837 if total_selected + static_total_selected = 1 838 then do; /* if first one */ 839 psn_s = info.output_count + 8; /* remember where the s in Positions is */ 840 call ioa_$rsnnl ("Positions:^2x^d,", buffer, len, position); 841 call put_buffer; 842 psn_ll = len; /* the position string could get extremely long */ 843 call get_line_length_ ("user_output", ll, code); 844 /* so split it into terminal-sized sections */ 845 if code ^= 0 846 then ll = DEFAULT_LINE_LTH; /* guess low */ 847 if ll < TOO_SMALL_LINE_LTH 848 then ll = DEFAULT_LINE_LTH; 849 end; 850 else do; 851 call ioa_$rsnnl ("^x^d,", buffer, len, position); 852 if psn_ll + len > ll 853 then do; /* output lines split by the tty dim look sloppy */ 854 call put_message (NL); 855 psn_ll = 0; 856 end; 857 call put_buffer; 858 psn_ll = psn_ll + len; 859 end; 860 end; /* end print positions */ 861 goto skip; /* just totals, so don't print anything more about the request */ 862 end; 863 864 /* Not just totals. We will list this request, so start formatting some of its parameters. */ 865 866 rqid = request_id_ (msg_time); 867 if ^long_id 868 then rqid = substr (rqid, 7, 8); 869 870 /* If normal (not long) output form specified, summarize the request in a single line */ 871 872 if ^info.long_sw 873 then do; 874 875 if total_selected + static_total_selected = 1 876 then do; /* if we are about to list our first request */ 877 call put_message (NL); /* put blank line after totals line */ 878 if print_user_column 879 then do; /* if admin, for all users, print heading */ 880 call ioa_$rs ("User^31t^[^7x^]ID^[^18x^;^7x^]^[Input segment^s^;^[Pathname^;Entry name^]^]", 881 buffer, len, info.position_sw, long_id, (info.request_type = ABS), info.path_sw); 882 call put_buffer; 883 end; 884 end; 885 886 /* Build up the line one field at a time. Some fields are optional, depending 887* on arguments given by user and passed in info.switches */ 888 889 if print_user_column 890 then do; /* if listing more than one user's requests */ 891 call ioa_$rsnnl ("^30a", buffer, len, sender_id); 892 /* say who this one is from */ 893 call put_buffer; 894 end; 895 896 if info.position_sw 897 then do; 898 call ioa_$rsnnl ("^3d)^x", buffer, len, position); 899 call put_buffer; 900 end; 901 902 call ioa_$rsnnl ("^a", buffer, len, rqid); 903 call put_buffer; 904 905 if info.path_sw 906 then call ioa_$rsnnl ("^x^a^[>^]^a", buffer, len, dirname, (dirname ^= ">"), ename); 907 else call ioa_$rsnnl ("^x^a", buffer, len, ename); 908 call put_buffer; 909 910 deferred_abs = ""b; 911 if ^info.brief_sw 912 then do; /* don't print request state if -brief given */ 913 if info.request_type = ABS & state = 0 914 then do; /* check for deferred but unprocessed abs jobs */ 915 if request.user_deferred_indefinitely 916 then deferred_abs = "1"b; 917 else if request.user_deferred_until_time 918 then if request.deferred_time > time_now 919 then deferred_abs = "1"b; 920 if deferred_abs 921 then call put_message (" (unprocessed, deferred"); 922 end; 923 924 if state > 0 925 then do; /* print state, if nonzero */ 926 if state > hbound (state_names, 1) 927 then state = -1; /* avoid fault if bad state */ 928 call ioa_$rsnnl ("^x(^a^[^;)^]", buffer, len, state_names (state), 929 (info.request_type = ABS & state = STATE_DEFERRED)); 930 call put_buffer; 931 end; 932 end; 933 934 /* The rest of these only apply to absentee requests */ 935 936 if info.request_type = ABS 937 then do; 938 if ^info.brief_sw 939 then do; 940 if state = STATE_DEFERRED | deferred_abs 941 then do; 942 call explain_abs_deferral; 943 call put_message (")"); 944 end; 945 946 if request.len_comment > 0 947 then do; 948 call ioa_$rsnnl ("^x""^a""", buffer, len, request.comment); 949 call put_buffer; 950 end; 951 952 953 if info.resource_sw 954 then do; /* print resources even in normal mode */ 955 i = index (request.resource, " "); 956 /* if blanks in resource string, quote it */ 957 call ioa_$rsnnl ("^x-rsc ^[""^]^a^[""^]", buffer, len, (i > 0), request.resource, (i > 0)); 958 call put_buffer; 959 end; 960 end; /* end not -brief */ 961 962 end; /* end absentee */ 963 964 if info.request_type = OUTPUT 965 then do; 966 if ^info.brief_sw 967 then do; 968 if info.forms_sw 969 then do; 970 if dprint_msg.version < dprint_msg_version_5 971 then auto_forms_name = rtrim (dprint_msg.forms); 972 else auto_forms_name = dprint_msg.forms_name; 973 i = index (auto_forms_name, " "); 974 call ioa_$rsnnl ("^x-forms ^[""^]^a^[""^]", buffer, len, (i > 0), auto_forms_name, (i > 0)); 975 call put_buffer; 976 end; 977 end; 978 end; /* end output */ 979 980 call put_message (NL); /* we finally got to the end of that line */ 981 982 end; /* end normal (not long) output mode */ 983 984 /* Long form. Print each variable in the request in a separate line. 985* The first few variables are common to all request types. */ 986 987 else do; /* long form */ 988 call put_message (NL); /* insert leading NL */ 989 if print_user_column 990 then do; /* if more than one user's requests are being listed */ 991 call ioa_$rs ("User:^21t^a", buffer, len, sender_id); 992 call put_buffer; 993 end; 994 aclass_string = ""; 995 call convert_authorization_$to_string_short (access_class, aclass_string, code); 996 if aclass_string ^= "" 997 then do; /* print access class */ 998 call ioa_$rs ("Access class:^21t^a", buffer, len, aclass_string); 999 call put_buffer; 1000 end; 1001 if info.position_sw 1002 then do; 1003 call ioa_$rs ("Position in queue:^21t^d", buffer, len, position); 1004 call put_buffer; 1005 end; 1006 call ioa_$rs ("Request ID:^21t^a", buffer, len, rqid); 1007 call put_buffer; 1008 time = date_time_$format ("date_time", msg_time, "", ""); 1009 call ioa_$rs ("Time queued:^21t^a", buffer, len, time); 1010 call put_buffer; 1011 call ioa_$rs ("^[Input segment:^;Pathname:^]^21t^a^[>^]^a", buffer, len, (info.request_type = ABS), 1012 dirname, (dirname ^= ">"), ename); 1013 call put_buffer; 1014 call ioa_$rsnnl ("State:^21t^a", buffer, len, state_names (state)); 1015 call put_buffer; 1016 if state = STATE_DEFERRED & info.request_type = ABS 1017 then call explain_abs_deferral; 1018 call put_message (NL); 1019 1020 /* Now print per-request-type information */ 1021 1022 /* Absentee request */ 1023 1024 if info.request_type = ABS 1025 then do; 1026 1027 /* First print information that's always there */ 1028 1029 if request.restartable 1030 then str = "yes"; 1031 else str = "no"; 1032 call ioa_$rs ("Restartable:^21t^a", buffer, len, str); 1033 call put_buffer; 1034 1035 /* Then print values of optional items, but only if they were specified in the request */ 1036 1037 if request.notify 1038 then call put_message (Notify_msg); 1039 if request_version > ABS_VER_4 1040 then do; 1041 1042 /* The Following two messages only apply to newer request_version */ 1043 1044 if request.restarted 1045 then call put_message (Restarted_msg); 1046 if request.truncate_absout 1047 then call put_message (Truncate_msg); 1048 end; 1049 if request.user_deferred_until_time 1050 then do; 1051 time = date_time_$format ("date_time", request.deferred_time, "", ""); 1052 call ioa_$rs ("Deferred time:^21t^a", buffer, len, time); 1053 call put_buffer; 1054 end; 1055 if request.user_deferred_indefinitely 1056 then call put_message_nl ("Deferred: indefinitely"); 1057 if request.arg_count > 0 1058 then do; 1059 expandlen = request.len_args + 25; 1060 allocate args_con_blanks in (region) set (expandp); 1061 allocate args_sans_blanks in (region) set (scrunchedp); 1062 argl = request.arg_lengths (1); 1063 curarg_start = 1; 1064 args_sans_blanks = substr (request.args, 1, argl); 1065 call ioa_$rs ("Argument string:^21t""^a""", args_con_blanks, expandedlen, args_sans_blanks); 1066 info.output_count = info.output_count + expandedlen; 1067 substr (cstrng, info.output_count - expandedlen) = substr (args_con_blanks, 1, expandedlen); 1068 curarg_start = curarg_start + argl; 1069 do argx = 2 to request.arg_count; 1070 argl = request.arg_lengths (argx); 1071 args_sans_blanks = substr (request.args, curarg_start, argl); 1072 call ioa_$rs ("^21t""^a""", args_con_blanks, expandedlen, args_sans_blanks); 1073 info.output_count = info.output_count + expandedlen; 1074 substr (cstrng, info.output_count - expandedlen) = substr (args_con_blanks, 1, expandedlen); 1075 curarg_start = curarg_start + argl; 1076 end; 1077 free scrunchedp -> args_sans_blanks in (region); 1078 free expandp -> args_con_blanks in (region); 1079 end; 1080 if request.max_cpu_time > 0 1081 then do; 1082 call ioa_$rs ("CPU limit:^21t^d seconds", buffer, len, request.max_cpu_time); 1083 call put_buffer; 1084 end; 1085 if request.len_output > 0 1086 then do; 1087 call ioa_$rs ("Output file:^21t^a", buffer, len, request.output_file); 1088 call put_buffer; 1089 end; 1090 if aim_check_$greater (request.requested_authorization, access_class) 1091 then do; 1092 aclass_string = ""; 1093 call convert_authorization_$to_string_short (request.requested_authorization, aclass_string, 1094 code); 1095 if aclass_string ^= "" 1096 then do; 1097 call ioa_$rs ("Requested auth:^21t^a", buffer, len, aclass_string); 1098 call put_buffer; 1099 end; 1100 end; 1101 if request.len_proxy > 0 1102 then do; 1103 call ioa_$rs ("Proxy user:^21t^a", buffer, len, request.proxy_name); 1104 call put_buffer; 1105 end; 1106 if request.len_resource > 0 1107 then do; 1108 call ioa_$rs ("Resources required:^21t^a", buffer, len, request.resource); 1109 call put_buffer; 1110 end; 1111 if request.len_sender > 0 1112 then do; 1113 call ioa_$rs ("Sender:^21t^a", buffer, len, request.sender); 1114 call put_buffer; 1115 end; 1116 if request.len_comment > 0 1117 then do; 1118 call ioa_$rs ("Comment:^21t^a", buffer, len, request.comment); 1119 call put_buffer; 1120 end; 1121 if request.request_version > ABS_VER_5 /* version 6 elements */ 1122 then do; 1123 if request.no_start_up 1124 then do; 1125 str = "yes"; 1126 call ioa_$rs ("No start_up:^21t^a", buffer, len, str); 1127 call put_buffer; 1128 end; 1129 if request.initial_ring ^= -1 1130 then do; 1131 call ioa_$rs ("Initial ring:^21t^d", buffer, len, request.initial_ring); 1132 call put_buffer; 1133 end; 1134 if request.len_homedir > 0 1135 then do; 1136 call ioa_$rs ("Home dir:^21t^a", buffer, len, request.home_dir); 1137 call put_buffer; 1138 end; 1139 if request.len_initproc > 0 1140 then do; 1141 call ioa_$rs ("Initial proc:^21t^a", buffer, len, 1142 substr (request.init_proc, 1, request.len_initproc)); 1143 call put_buffer; 1144 end; 1145 end; 1146 end; 1147 1148 /* I/O daemon request */ 1149 1150 else if info.request_type = IO | info.request_type = OUTPUT 1151 then do; 1152 1153 /* Print stuff that's always given */ 1154 1155 if lbound (pp_request_type, 1) <= dprint_msg.output_module 1156 & dprint_msg.output_module <= hbound (pp_request_type, 1) 1157 then do; 1158 call ioa_$rs ("Punch format:^21t^a", buffer, len, pp_request_type (dprint_msg.output_module)); 1159 call put_buffer; 1160 end; 1161 call ioa_$rs ("Copies:^21t^d", buffer, len, dprint_msg.copies); 1162 call put_buffer; 1163 if dprint_msg.delete_sw 1164 then str = "yes"; 1165 else str = "no"; 1166 call ioa_$rs ("Delete:^21t^a", buffer, len, str); 1167 call put_buffer; 1168 1169 /* Then print optional stuff, but only if it was given */ 1170 1171 if dprint_msg.heading ^= "" 1172 then do; 1173 if substr (dprint_msg.heading, 1, 5) = " for " 1174 then i = 6; 1175 else i = 1; /* start at char one if dprint added " for" */ 1176 call ioa_$rs ("Heading:^21t^a", buffer, len, substr (dprint_msg.heading, i)); 1177 call put_buffer; 1178 end; 1179 if dprint_msg.destination ^= "" 1180 then do; 1181 call ioa_$rs ("Destination:^21t^a", buffer, len, dprint_msg.destination); 1182 call put_buffer; 1183 end; 1184 if dprint_msg.top_label = dprint_msg.bottom_label & dprint_msg.top_label_lth > 0 1185 then do; 1186 call ioa_$rs ("Labels:^21t^a", buffer, len, dprint_msg.top_label); 1187 call put_buffer; 1188 end; 1189 else do; 1190 if dprint_msg.top_label_lth > 0 1191 then do; 1192 call ioa_$rs ("Top label:^21t^a", buffer, len, dprint_msg.top_label); 1193 call put_buffer; 1194 end; 1195 if dprint_msg.bottom_label_lth > 0 1196 then do; 1197 call ioa_$rs ("Bottom label:^21t^a", buffer, len, dprint_msg.bottom_label); 1198 call put_buffer; 1199 end; 1200 end; 1201 if dprint_msg.version < dprint_msg_version_5 1202 then auto_forms_name = rtrim (dprint_msg.forms); 1203 else auto_forms_name = dprint_msg.forms_name; 1204 if auto_forms_name ^= "" 1205 then do; 1206 call ioa_$rs ("Forms:^21t^a", buffer, len, auto_forms_name); 1207 call put_buffer; 1208 end; 1209 if dprint_msg.notify 1210 then call put_message (Notify_msg); 1211 if dprint_msg.line_nbrs 1212 then if dprint_msg.version > dprint_msg_version_3 1213 then call put_message (line_nbrs_msg); 1214 if dprint_msg.defer_until_process_termination 1215 then call put_message (DUPT_msg); 1216 modes = ""; 1217 if dprint_msg.nep 1218 then modes = modes || "-no_endpage "; 1219 if dprint_msg.non_edited 1220 then modes = modes || "-non_edited "; 1221 if dprint_msg.single 1222 then modes = modes || "-single "; 1223 if dprint_msg.truncate 1224 then modes = modes || "-truncate "; 1225 if dprint_msg.no_separator 1226 then modes = modes || "-no_separator "; 1227 if dprint_msg.esc 1228 then modes = modes || "-esc "; 1229 if dprint_msg.lmargin > 0 1230 then do; 1231 call ioa_$rsnnl ("^a ^d ", tbf, j, "-indent", dprint_msg.lmargin); 1232 modes = modes || tbf; 1233 end; 1234 if dprint_msg.line_lth > 0 1235 then do; 1236 call ioa_$rsnnl ("^a ^d ", tbf, j, "-line_length", dprint_msg.line_lth); 1237 modes = modes || tbf; 1238 end; 1239 if dprint_msg.page_lth > 0 1240 then do; 1241 call ioa_$rsnnl ("^a ^d ", tbf, j, "-page_length", dprint_msg.page_lth); 1242 modes = modes || tbf; 1243 end; 1244 if modes ^= "" 1245 then do; 1246 call ioa_$rs ("Options:^21t^a", buffer, len, modes); 1247 call put_buffer; 1248 end; 1249 if dprint_msg.chan_stop_path_lth > 0 1250 then do; 1251 call ioa_$rs ("Channel stops:^21t^a", buffer, len, dprint_msg.chan_stop_path); 1252 call put_buffer; 1253 end; 1254 end; 1255 1256 /* Retrieval request */ 1257 1258 else if info.request_type = RETV 1259 then do; 1260 if retv_request.new_dirname ^= "" 1261 then do; 1262 call ioa_$rs ("New pathname:^21t^a^[>^]^a", buffer, len, retv_request.new_dirname, 1263 (retv_request.new_dirname ^= ">"), retv_request.new_ename); 1264 call put_buffer; 1265 end; 1266 if retv_request.from_time ^= 0 1267 then do; 1268 time = date_time_$format ("date_time", retv_request.from_time, "", ""); 1269 call ioa_$rs ("From Time:^21t^a", buffer, len, time); 1270 call put_buffer; 1271 end; 1272 if retv_request.to_time ^= 0 & ^retv_request.previous 1273 then do; 1274 time = date_time_$format ("date_time", retv_request.to_time, "", ""); 1275 call ioa_$rs ("To Time:^21t^a", buffer, len, time); 1276 call put_buffer; 1277 end; 1278 modes = ""; 1279 if retv_request.subtree 1280 then modes = modes || "subtree "; 1281 if retv_request.notify 1282 then modes = modes || "notify "; 1283 if retv_request.previous 1284 then modes = modes || "previous "; 1285 if modes ^= "" 1286 then do; 1287 call ioa_$rs ("Options:^21t^a", buffer, len, modes); 1288 call put_buffer; 1289 end; 1290 end; /* end retrieval request */ 1291 end; /* end long output mode */ 1292 1293 /* As the label suggests, we come here to skip a request that does not meet the user-specified criteria */ 1294 1295 skip: /* Free the storage occupied by this request */ 1296 free reqp -> based_dummy in (region); /* This will correctly free any one of the request types */ 1297 1298 /* Read another request from the queue */ 1299 1300 old_ms_id = mseg_message_info.ms_id; /* copy message id of last request, for use in incremental read */ 1301 1302 retrying = ""b; 1303 retry_2: 1304 reqp, requestp, dmp = null; /* init these to avoid faults */ 1305 local_mseg_message_info.ms_id = old_ms_id; 1306 local_mseg_message_info.message_code = MSEG_READ_AFTER_SPECIFIED; 1307 local_mseg_message_info.own = ^read_all; 1308 1309 call message_segment_$read_message_index (info.mseg_idx, areap, mseg_message_info_ptr, code); 1310 1311 if ^retrying 1312 then /* retry the read once, if queue has been salvaged */ 1313 if code = error_table_$bad_segment 1314 then do; 1315 retrying = "1"b; 1316 goto retry_2; 1317 end; 1318 1319 if (rqi_sw & rqi_buffered & allsw) 1320 then do; 1321 rqi_buffered = "0"b; 1322 call put_message (NL); /* insert NL after each request entity */ 1323 end; 1324 1325 go to loop; 1326 1327 /* End of loop through all requests. The statement at label "loop" checks 1328* code and comes right back here if it is nonzero. We exit the loop normally 1329* if code = error_table_$no_message, and abnormally if it is any other nonzero value. */ 1330 1331 mess_err: 1332 if reqp ^= null 1333 then /* free up allocated space if necessary */ 1334 free reqp -> request in (region); /* This will correctly free any one of the request types */ 1335 if code ^= 0 1336 then /* if encounter no message - not an error */ 1337 if code ^= error_table_$no_message 1338 then /* otherwise return code to caller */ 1339 return_code: 1340 a_code = code; 1341 1342 /* Normal exit. Put totals figures into the header line that we left room for at the top of the temp segment. */ 1343 1344 fin: /* But first, add totals for this queue to cumulative totals */ 1345 if rqi_sw 1346 then do; /* no more formatting neccessary for rqi */ 1347 info.output_count = info.output_count - 1; /* reflect actual output count */ 1348 return; 1349 end; 1350 1351 info.user_select_count = info.user_select_count + total_for_user; 1352 /* tell caller how many he had in the queue */ 1353 info.select_count = info.select_count + total_selected; 1354 /* and how many we listed */ 1355 info.message_count = info.message_count + messcount; 1356 /* and how many total requests were in the queue */ 1357 1358 /* End a partial "positions" line, if there is one */ 1359 1360 if info.total_sw & info.position_sw & total_selected > 0 1361 then do; /* if printing positions, end the line */ 1362 if total_selected = 1 1363 then substr (cstrng, psn_s, 2) = ": "; /* make Positions: into Position: */ 1364 substr (cstrng, info.output_count - 1, 1) = "."; 1365 /* make trailing , into . */ 1366 call put_message (NL); /* end the line */ 1367 end; 1368 1369 /* Report on bad requests in this queue, if any */ 1370 1371 if n_bad_vrsn > 0 & (info.total_sw | n_bad_vrsn ^= total_selected) 1372 then do; 1373 call ioa_$rs ("^12x^d requests had obsolete or incorrect formats", buffer, len, n_bad_vrsn); 1374 call put_buffer; 1375 end; 1376 1377 /* And finally, add up totals for queues 0 and 1 if appropriate */ 1378 1379 if (info.abs_q_1 & info.queue = 1 & static_header_position > 0) 1380 then do; /* if this is Q 1 and there is Q 0 data */ 1381 messcount = messcount + static_messcount; /* add Q 0 total messages to those for Q 1 */ 1382 total_selected = total_selected + static_total_selected; 1383 /* likewise for total selected */ 1384 end; 1385 1386 /* Now, if -all (or search_all) was given, eliminate any heading lines that have only zeros in them */ 1387 1388 if (info.all_opt_sw /* if -all was given */ 1389 & (messcount = 0 & ^no_totals)) /* and we know this queue is empty */ 1390 | (info.search_all /* or if the search_all option is in effect */ 1391 & total_selected = 0) /* and we selected no requests from this queue */ 1392 then info.output_count = info.output_count - header_length - 1; 1393 /* then omit the heading */ 1394 1395 /* Otherwise, fill in the header */ 1396 1397 else do; 1398 if (info.queue = 0 & info.abs_q_1) 1399 then do; /* if treating abs Q 0 as Q 1 */ 1400 static_header_position = header_position; 1401 /* save some stuff for use when we list Q 1 */ 1402 static_total_selected = total_selected; 1403 static_messcount = messcount; 1404 static_deferred_count = deferred_count; 1405 static_position = position; 1406 static_psn_s = psn_s; 1407 static_ll = ll; 1408 end; 1409 1410 if ^((info.all_opt_sw | info.search_all) & info.total_sw) 1411 then /* single space the totals lines for -a -tt */ 1412 substr (cstrng, info.output_count, 1) = NL; 1413 /* put new line at end of information for this queue */ 1414 else info.output_count = info.output_count - 1; 1415 /* this is where the NL would have gone */ 1416 1417 /* Decide if we want to print Queue N: R requests. T total requests. 1418* or Queue N: R requests. 1419* or Queue N: T total requests. 1420**/ 1421 1422 print_requests = "1"b; /* start by assuming we will print R requests */ 1423 if ^no_totals 1424 then /* if we are going to print T total requests, 1425* we might want to leave out R requests */ 1426 if messcount = 0 /* 0 requests. 0 total requests. looks dumb */ 1427 | (messcount = total_selected /* as does N requests. N total requests (N the same) */ 1428 & info.admin_sw /* when you said -admin */ 1429 & ^select_sw) /* and didn't give any other selection arguments */ 1430 then print_requests = ""b; /* so leave out R requests in those cases */ 1431 1432 if total_selected = 1 1433 then s = ""; 1434 else s = "s"; /* place queue number + number of requests found in header */ 1435 if info.request_type = ABS 1436 then queue_string = "Absentee"; 1437 else if info.request_type = RETV 1438 then queue_string = "Retriever"; 1439 else do; 1440 queue_string = info.queue_name; 1441 end; 1442 i = info.queue; /* get queue priority number */ 1443 if i = 0 & info.abs_q_1 1444 then i = 1; /* fake queue number if necessary */ 1445 call ioa_$rsnnl ("^[Foreground:^x^2s^;^a queue ^d:^4x^]^[^d request^a.^]", buffer, len, (i = -1), 1446 queue_string, i, print_requests, total_selected, s); 1447 i = header_length - 1; /* and pad remainder of header with blanks */ 1448 substr (cstrng, header_position, i) = substr (buffer, 1, len); 1449 substr (cstrng, header_position + i, 1) = NL;/* place a new line at end of header */ 1450 if ^no_totals 1451 then do; /* if caller has correct access put total number in header */ 1452 header_position = header_position + len; 1453 if messcount = 1 1454 then s = ""; 1455 else s = "s"; 1456 call ioa_$rsnnl (" ^d total request^a^[^x(^d deferred)^].", buffer, len, messcount, s, 1457 (deferred_count > 0), deferred_count); 1458 substr (cstrng, header_position, len) = substr (buffer, 1, len); 1459 end; 1460 end; /* end fill in header */ 1461 1462 return; 1463 1464 1465 /* ********** INTERNAL PROCEDURES ********** */ 1466 1467 put_buffer: 1468 proc; /* replaces about 35 instances of these two statements */ 1469 info.output_count = info.output_count + len; 1470 substr (cstrng, info.output_count - len) = substr (buffer, 1, len); 1471 return; 1472 1473 end put_buffer; 1474 1475 /* ********** */ 1476 1477 put_message: 1478 proc (message); 1479 1480 dcl message char (*); 1481 1482 nlsw = ""b; 1483 putmsg: 1484 info.output_count = info.output_count + length (message); 1485 substr (cstrng, info.output_count - length (message)) = message; 1486 if nlsw 1487 then do; 1488 info.output_count = info.output_count + 1; 1489 substr (cstrng, info.output_count - 1) = NL; 1490 end; 1491 return; 1492 1493 put_message_nl: 1494 entry (message); 1495 1496 dcl nlsw bit (1) aligned; 1497 1498 nlsw = "1"b; 1499 goto putmsg; 1500 1501 end put_message; 1502 1503 1504 /* ********** */ 1505 1506 cleaner_up: 1507 proc; 1508 if reqp ^= null 1509 then free reqp -> request in (region); 1510 if expandp ^= null 1511 then free expandp -> args_con_blanks in (region); 1512 if expandp ^= null 1513 then free scrunchedp -> args_sans_blanks in (region); 1514 1515 return; 1516 end cleaner_up; 1517 1518 /* ********** */ 1519 1520 explain_abs_deferral: 1521 proc; 1522 1523 if request.operator_deferred_indefinitely 1524 then call put_message (" indefinitely by operator"); 1525 else if request.cpu_time_limit 1526 then call put_message (" because of cpu time limit"); 1527 else if request.resources_unavailable 1528 then call put_message (" - requested resources unavailable"); 1529 else if request.queue_limit 1530 then call put_message (" because of queue limit"); 1531 else if request.user_limit 1532 then call put_message (" because of user limit"); 1533 else if request.load_control 1534 then call put_message (" because of load control group limits"); 1535 else if request.user_deferred_until_time 1536 then do; 1537 call put_message (" by user"); 1538 if ^info.long_sw 1539 then do; /* if summarizing it on one line, append deferred time */ 1540 time = date_time_$format ("^ ^