1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59 dprint:
60 dp: procedure () options (variable);
61
62
63 dcl count fixed bin;
64 dcl indx fixed bin;
65 dcl lng fixed bin;
66 dcl lcnt fixed bin;
67 dcl nargs fixed bin;
68 dcl i fixed bin;
69 dcl queue fixed bin;
70 dcl mode bit (36) aligned;
71 dcl pub_bit bit (1) aligned;
72 dcl code fixed bin (35);
73 dcl bc fixed bin (24);
74 dcl fcbp ptr;
75 dcl dum ptr;
76
77 dcl max_queues fixed bin int static options (constant) init (4);
78 dcl MAX_PAGE_WIDTH fixed bin int static options (constant) init (136);
79 dcl io_coord char (16) int static options (constant) init ("IO.SysDaemon");
80
81 dcl (addr, index, length, max, null, substr, fixed, rtrim, string) builtin;
82
83 dcl cleanup condition;
84
85 dcl punching initial ("0"b) bit (1);
86 dcl no_questions initial ("0"b) bit (1);
87
88 dcl control_arg bit (1);
89 dcl some_path bit (1);
90 dcl brief bit (1);
91 dcl top_lbl_sw bit (1);
92 dcl bottom_lbl_sw bit (1);
93 dcl access_lbl_sw bit (1);
94
95 dcl (del_acc, r_acc) bit (1) aligned;
96 dcl s_acc bit (1) aligned;
97
98 dcl access_class bit (72) aligned;
99 dcl access_label char (136);
100
101 dcl accname character (32);
102 dcl generic_type char (32);
103 dcl rqt_gen_type char (32);
104 dcl last_arg char (32);
105
106 dcl argptr ptr;
107 dcl seg_ptr ptr;
108 dcl based_arg char (lng) based (argptr) unaligned;
109 dcl arg char (32) aligned;
110 dcl ans char (12) varying;
111
112 dcl question char (132);
113 dcl quest_len fixed bin;
114
115 dcl dname char (168);
116 dcl ename char (32);
117 dcl lvname char (32);
118 dcl suf char (1) aligned;
119 dcl id char (6) aligned;
120
121 dcl (error_table_$lock_wait_time_exceeded, error_table_$dirseg, error_table_$no_s_permission, error_table_$noentry,
122 error_table_$nostars, error_table_$moderr, error_table_$badopt, error_table_$notalloc, error_table_$id_not_found,
123 error_table_$zero_length_seg)
124 fixed binary (35) external;
125
126 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin);
127 dcl dprint_ entry (char (*), char (*), ptr, fixed bin (35));
128 dcl dprint_$check_daemon_access entry (character (*), character (*), character (*), bit (1) aligned, bit (1) aligned,
129 bit (1) aligned, character (*), fixed binary (35));
130 dcl dprint_$queue_contents entry (character (*), fixed binary, fixed binary, fixed binary (35));
131 dcl check_star_name_$entry entry (char (*), fixed bin (35));
132 dcl cu_$arg_ptr ext entry (fixed bin, ptr, fixed bin, fixed bin (35));
133 dcl cu_$arg_count entry (fixed bin, fixed binary (35));
134 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
135 dcl (com_err_, com_err_$suppress_name) entry options (variable);
136 dcl ioa_ entry options (variable);
137 dcl ioa_$ioa_stream entry options (variable);
138 dcl ioa_$rsnnl entry options (variable);
139 dcl command_query_ entry options (variable);
140 dcl hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35));
141 dcl hcs_$get_access_class entry (char (*), char (*), bit (72) aligned, fixed bin (35));
142 dcl convert_authorization_$to_string entry (bit (72) aligned, char (*), fixed bin (35));
143 dcl mdc_$find_lvname entry (bit (36), char (*), fixed bin (35));
144 dcl mdc_$get_lv_access entry (char (*), fixed bin (3), bit (36) aligned, bit (1) aligned, fixed bin (35));
145 dcl iod_info_$generic_type entry (char (*), char (32), fixed bin (35));
146 dcl msf_manager_$open entry (char (*), char (*), ptr, fixed bin (35));
147 dcl msf_manager_$close entry (ptr);
148 dcl msf_manager_$get_ptr entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35));
149
150 dcl hcs_$terminate_noname entry (ptr, fixed bin (35));
151 dcl object_lib_$initiate entry (char (*), char (*), char (*), bit (1), ptr, fixed bin (24), bit (1), fixed bin (35));
152
153 %include dprint_arg;
154
155 %include query_info;
156
157 %include branch_status;
158 ^L
159
160
161 queue = 0;
162 go to start_1;
163
164
165 no_questions:
166 entry () options (variable);
167 no_questions = "1"b;
168 queue = 0;
169 go to start_1;
170
171
172 dp1: entry () options (variable);
173 queue = 1;
174 go to start_1;
175
176 dp2: entry () options (variable);
177 queue = 2;
178 go to start_1;
179
180 dpunch:
181 dpn: entry () options (variable);
182 punching = "1"b;
183 queue = 0;
184 go to start_1;
185
186 dpn1: entry () options (variable);
187 punching = "1"b;
188 queue = 1;
189 go to start_1;
190
191 dpn2: entry () options (variable);
192 punching = "1"b;
193 queue = 2;
194
195
196 start_1: call init_variables;
197
198 if punching then do;
199 dprint_arg.pt_pch = 2;
200 dprint_arg.output_module = 3;
201 generic_type,
202 dprint_arg.request_type = "punch";
203 id = "dpunch";
204 end;
205 else do;
206 dprint_arg.pt_pch = 1;
207 dprint_arg.output_module = 1;
208 generic_type,
209 dprint_arg.request_type = "printer";
210 id = "dprint";
211 end;
212
213
214 on cleanup begin;
215 if fcbp ^= null then call msf_manager_$close (fcbp);
216 end;
217
218 call cu_$arg_count (nargs, code);
219 if code ^= 0 then do;
220 call com_err_ (code, id);
221 return;
222 end;
223
224 do indx = 1 to nargs;
225 call cu_$arg_ptr (indx, argptr, lng, code);
226 arg = based_arg;
227
228 if index (based_arg, "-") = 1 then call process_control_arg;
229 else do;
230 some_path = "1"b;
231 control_arg = "0"b;
232 call expand_pathname_ (based_arg, dname, ename, code);
233 if code ^= 0 then do;
234 call com_err_ (code, id, "^a", based_arg);
235 go to no_request;
236 end;
237 else do;
238 call check_star_name_$entry (ename, code);
239 if code ^= 0 then do;
240 if code <= 2 then
241 code = error_table_$nostars;
242 call com_err_ (code, id, "^a^[>^]^a", dname, (dname ^= ">"), ename);
243 go to no_request;
244 end;
245 else do;
246
247 call hcs_$status_long (dname, ename, 1, addr (branch_status), null, code);
248 if (code ^= 0) & (code ^= error_table_$no_s_permission) then do;
249 call com_err_ (code, id, "^a^[>^]^a", dname, (dname ^= ">"), ename);
250 no_request: call com_err_$suppress_name (0, id, "Request not submitted.");
251 end;
252 else do;
253
254
255
256 if ^punching then do;
257 call object_lib_$initiate (dname, ename, "", "1"b, seg_ptr, (0), (""b), code);
258 if seg_ptr ^= null then do;
259 call hcs_$terminate_noname (seg_ptr, (0));
260 call com_err_ (0, id, "^a^[>^]^a is an object segment.",
261 dname, (dname ^= ">"), ename);
262 go to no_request;
263 end;
264 end;
265
266
267
268 if ^substr (branch_status.mode, 2, 1) then do;
269 code = error_table_$moderr;
270 CALL_COM: call com_err_ (code, id, "^a^[>^]^a", dname, (dname ^= ">"), ename);
271 go to no_request;
272 end;
273
274 dprint_arg.bit_count = 0;
275
276 if branch_status.type = directory_type then do;
277 if branch_status.bit_count = "0"b then do;
278 code = error_table_$dirseg;
279 go to CALL_COM;
280 end;
281
282
283
284 call msf_manager_$open (dname, ename, fcbp, code);
285 if code ^= 0 then go to CALL_COM;
286
287 do i = 0 to fixed (branch_status.bit_count, 17, 0) - 1;
288 bc = 0;
289 call msf_manager_$get_ptr (fcbp, i, "0"b, dum, bc, code);
290 if code ^= 0 then go to CALL_COM;
291 dprint_arg.bit_count = dprint_arg.bit_count + bc;
292 end;
293
294 call msf_manager_$close (fcbp);
295 fcbp = null;
296 end;
297 else dprint_arg.bit_count = fixed (branch_status.bit_count, 24);
298
299 if dprint_arg.bit_count = 0 then do;
300 code = error_table_$zero_length_seg;
301 go to CALL_COM;
302 end;
303
304
305 call mdc_$find_lvname (branch_status.lvid, lvname, code);
306 if code ^= 0 then go to CALL_COM;
307 call mdc_$get_lv_access (lvname, 1, mode, pub_bit, code);
308 if code ^= 0 then go to CALL_COM;
309 if ^pub_bit then do;
310 call com_err_ (0, id, "^a^[>^]^a is not on a public volume.",
311 dname, (dname ^= ">"), ename);
312 go to no_request;
313 end;
314
315
316
317 call dprint_$check_daemon_access (dname, ename, dprint_arg.request_type, del_acc,
318 r_acc, s_acc, accname, code);
319 if code ^= 0 then
320 call com_err_ (0, id, "Warning: Unable to check IO daemon access to ^a^[>^]^a",
321 dname, (dname ^= ">"), ename);
322 else do;
323 if ^r_acc then do;
324 call com_err_ (0, id, "^a requires r access to ^a^[>^]^a",
325 accname, dname, (dname ^= ">"), ename);
326 go to no_request;
327 end;
328 if ^s_acc then
329 call ask ("^a does not have status access on ^a^s");
330 if ^del_acc & (dprint_arg.delete ^= 0) then
331 call com_err_ (0, "Warning", "^a has insufficient access to delete ^a^[>^]^a",
332 io_coord, dname, (dname ^= ">"), ename);
333 end;
334
335 QUEUE_IT: if access_lbl_sw then call make_access_lbl;
336 dprint_arg.queue = queue;
337 code = 0;
338 call dprint_ (dname, ename, dpap, code);
339 if code ^= 0 then do;
340 call com_err_ (code, id, "Queue ^d for request type ^a",
341 dprint_arg.queue, dprint_arg.request_type);
342 if code = error_table_$lock_wait_time_exceeded then do;
343 if no_questions then go to next_arg;
344 query_info.status_code = code;
345 call command_query_ (addr (query_info), ans, id, "Do you wish to try again?");
346 if ans = "yes" then go to QUEUE_IT;
347 end;
348
349 else if code = error_table_$noentry then
350 call ioa_$ioa_stream ("error_output",
351 "Request type or queue argument is probably invalid.");
352
353 else if code = error_table_$notalloc then
354 call ioa_$ioa_stream ("error_output", "Queue is full at present.");
355 go to no_request;
356 end;
357
358 else count = count + 1;
359 end;
360 end;
361 end;
362 end;
363 next_arg: end;
364
365 if count > 0 | ^some_path then call print_counts;
366 if some_path then if control_arg then call com_err_ (0, id,
367 "Warning: Control arguments following last pathname are ignored.");
368
369 RETURN: return;
370
371
372
373 process_control_arg: proc;
374
375 if arg = "-bf" | arg = "-brief" then do;
376 brief = "1"b;
377 return;
378 end;
379
380 control_arg = "1"b;
381
382 if arg = "-dl" | arg = "-delete" | arg = "-d" then
383 dprint_arg.delete = 1;
384 else if arg = "-he" | arg = "-header" | arg = "-h" then do;
385 call get_parameter;
386 dprint_arg.heading = " for " || based_arg;
387 end;
388 else if arg = "-ds" | arg = "-destination" then do;
389 call get_parameter;
390 dprint_arg.destination = based_arg;
391 end;
392 else if arg = "-rqt" | arg = "-request_type" then do;
393 if count > 0 then call print_counts;
394 call get_parameter;
395 call iod_info_$generic_type (based_arg, rqt_gen_type, code);
396 if code ^= 0 then
397 if code = error_table_$id_not_found then do;
398 call com_err_ (0, id, "Unknown request type. ^a", based_arg);
399 go to RETURN;
400 end;
401 else call com_err_ (0, id, "Warning
402 else if rqt_gen_type ^= generic_type then do;
403 call com_err_ (0, id, "Request type ^a is not of generic type ^a.", based_arg, generic_type);
404 go to RETURN;
405 end;
406 else if length (rtrim (based_arg)) > length (dprint_arg.request_type) then do;
407 call com_err_ (0, id, "Request type name ""^a"" must be ^d characters or less in length.",
408 based_arg, length (dprint_arg.request_type));
409 go to RETURN;
410 end;
411 else dprint_arg.request_type = based_arg;
412 end;
413 else if arg = "-cp" | arg = "-copy" then do;
414 call get_parameter;
415 dprint_arg.copies = cv_dec_check_ (based_arg, code);
416 if code ^= 0 | dprint_arg.copies < 1 then do;
417 call com_err_ (0, id, "Invalid copy request ^a", based_arg);
418 go to RETURN;
419 end;
420 else if dprint_arg.copies > 4 then do;
421 dprint_arg.copies = 4;
422 call com_err_ (0, id, "Too many copies specified; 4 will be supplied.");
423 end;
424 end;
425 else if arg = "-nt" | arg = "-notify" then
426 dprint_arg.notify = 1;
427 else if arg = "-q" | arg = "-queue" then do;
428 if count > 0 then call print_counts;
429 call get_parameter;
430 queue = cv_dec_check_ (based_arg, code);
431 if code ^= 0 | queue < 1 | queue > max_queues then do;
432 call com_err_ (0, id, "Invalid queue number ^a", based_arg);
433 go to RETURN;
434 end;
435 end;
436 else if arg = "-dupt" | arg = "-defer_until_process_termination" then
437 dprint_arg.defer_until_process_termination = 1;
438 else if ^punching then do;
439 if arg = "-nep" | arg = "-no_endpage" then do;
440 dprint_arg.nep = "1"b;
441 go to NL_OPT;
442 end;
443 else if arg = "-ned" | arg = "-non_edited" then
444 dprint_arg.non_edited = "1"b;
445 else if arg = "-tc" | arg = "-truncate" then
446 dprint_arg.truncate = "1"b;
447 else if arg = "-ll" | arg = "-line_length" then do;
448 call get_parameter;
449 dprint_arg.line_lth = cv_dec_check_ (based_arg, code);
450 if code ^= 0 | dprint_arg.line_lth < 1 then do;
451 call com_err_ (0, id, "Invalid line length ^a", based_arg);
452 go to RETURN;
453 end;
454 if dprint_arg.line_lth > MAX_PAGE_WIDTH then
455 call com_err_ (0, "Warning", "Specified line length is greater then normal printer maximum.");
456 end;
457 else if arg = "-in" | arg = "-ind" | arg = "-indent" then do;
458 call get_parameter;
459 dprint_arg.lmargin = cv_dec_check_ (based_arg, code);
460 if code ^= 0 | dprint_arg.lmargin < 0 | dprint_arg.lmargin > MAX_PAGE_WIDTH then do;
461 call com_err_ (0, id, "Invalid indentation ^a", based_arg);
462 go to RETURN;
463 end;
464 end;
465 else if arg = "-sg" | arg = "-single" then
466 dprint_arg.single = "1"b;
467 else if arg = "-pl" | arg = "-page_length" then do;
468 call get_parameter;
469 dprint_arg.page_lth = cv_dec_check_ (based_arg, code);
470 if code ^= 0 | dprint_arg.page_lth < 1 then do;
471 call com_err_ (0, id, "Invalid page length ^a", based_arg);
472 go to RETURN;
473 end;
474 end;
475 else if arg = "-lbl" | arg = "-label" then do;
476 call get_parameter;
477 if dprint_arg.nep then do;
478 skip_labels: call com_err_ (0, id, "Warning: Labels are ignored with -no_endpage.");
479 return;
480 end;
481 dprint_arg.top_label,
482 dprint_arg.bottom_label = based_arg;
483 access_lbl_sw = "0"b;
484 top_lbl_sw, bottom_lbl_sw = "1"b;
485 dprint_arg.center_top_label,
486 dprint_arg.center_bottom_label = "0"b;
487 end;
488 else if arg = "-tlbl" | arg = "-top_label" then do;
489 call get_parameter;
490 if dprint_arg.nep then go to skip_labels;
491 dprint_arg.top_label = based_arg;
492 if bottom_lbl_sw then access_lbl_sw = "0"b;
493 top_lbl_sw = "1"b;
494 dprint_arg.center_top_label = "0"b;
495 end;
496 else if arg = "-blbl" | arg = "-bottom_label" then do;
497 call get_parameter;
498 if dprint_arg.nep then go to skip_labels;
499 dprint_arg.bottom_label = based_arg;
500 if top_lbl_sw then access_lbl_sw = "0"b;
501 bottom_lbl_sw = "1"b;
502 dprint_arg.center_bottom_label = "0"b;
503 end;
504 else if arg = "-albl" | arg = "-access_label" then do;
505 if dprint_arg.nep then go to skip_labels;
506 access_lbl_sw = "1"b;
507 top_lbl_sw, bottom_lbl_sw = "0"b;
508 end;
509 else if arg = "-nlbl" | arg = "-no_label" then do;
510 NL_OPT: access_lbl_sw = "0"b;
511 top_lbl_sw, bottom_lbl_sw = "0"b;
512 dprint_arg.center_top_label, dprint_arg.center_bottom_label = "0"b;
513 dprint_arg.top_label, dprint_arg.bottom_label = "";
514 end;
515 else if arg = "-forms" then do;
516 call get_parameter;
517 if length (rtrim (based_arg)) > length (dprint_arg.form_name) then do;
518 call com_err_ (0, id, "Forms specification ""^a"" must be ^d characters or less in length.",
519 based_arg, length (dprint_arg.form_name));
520 go to RETURN;
521 end;
522 dprint_arg.form_name = based_arg;
523 end;
524 else do;
525 BAD_OPT: call com_err_ (error_table_$badopt, id, " ^a ", based_arg);
526 go to RETURN;
527 end;
528 end;
529 else if punching then do;
530 if arg = "-mcc" then
531 dprint_arg.output_module = 3;
532 else if arg = "-raw" then
533 dprint_arg.output_module = 4;
534 else if arg = "-7p" | arg = "-7punch" then
535 dprint_arg.output_module = 2;
536 else go to BAD_OPT;
537 end;
538
539 end process_control_arg;
540
541 print_counts: proc;
542
543 if ^brief then do;
544 dprint_arg.queue = queue;
545
546 call dprint_$queue_contents (dprint_arg.request_type, dprint_arg.queue, lcnt, code);
547 if code ^= 0 then
548 call com_err_ (code, id, "Cannot get count for request type ^a, queue ^d",
549 dprint_arg.request_type, dprint_arg.queue);
550
551 else if count = 0 then do;
552 if lcnt = 1 then suf = ""; else suf = "s";
553 call ioa_ ("^d request^a in ^a queue ^d", lcnt, suf, dprint_arg.request_type, dprint_arg.queue);
554 end;
555 else do;
556 if count = 1 then suf = ""; else suf = "s";
557 call ioa_ ("^d request^a signalled, ^d already in ^a queue ^d", count, suf, max (0, lcnt - count),
558 dprint_arg.request_type, dprint_arg.queue);
559 count = 0;
560 end;
561
562 end;
563
564 end print_counts;
565
566 ask: proc (format);
567
568 dcl format char (*);
569
570 if no_questions then go to next_arg;
571 call ioa_$rsnnl (format, question, quest_len, accname, dname, ename);
572 query_info.status_code = code;
573 call command_query_ (addr (query_info), ans, id, "^a. Do you still wish request? ", question);
574 if substr (ans, 1, 3) ^= "yes" then go to next_arg;
575 go to QUEUE_IT;
576
577 end ask;
578
579 make_access_lbl: proc;
580
581 access_label = "";
582 call hcs_$get_access_class (dname, ename, access_class, code);
583 if code ^= 0 then go to CALL_COM;
584 call convert_authorization_$to_string (access_class, access_label, code);
585 if ^top_lbl_sw then do;
586 dprint_arg.top_label = access_label;
587 dprint_arg.center_top_label = "1"b;
588 end;
589 if ^bottom_lbl_sw then do;
590 dprint_arg.bottom_label = access_label;
591 dprint_arg.center_bottom_label = "1"b;
592 end;
593 end make_access_lbl;
594
595
596
597
598 get_parameter: proc;
599
600 last_arg = arg;
601 indx = indx + 1;
602 call cu_$arg_ptr (indx, argptr, lng, code);
603 if code ^= 0 then do;
604 call com_err_ (0, id, "No value specified for ^a.", last_arg);
605 go to RETURN;
606 end;
607
608 end get_parameter;
609
610 init_variables: proc;
611
612 fcbp = null;
613 count = 0;
614
615 query_info.yes_or_no_sw = "1"b;
616
617 control_arg = "0"b;
618 some_path = "0"b;
619 brief = "0"b;
620 top_lbl_sw = "0"b;
621 bottom_lbl_sw = "0"b;
622 access_lbl_sw = "1"b;
623
624 dpap = addr (dprint_arg_buf);
625 dprint_arg.version = dprint_arg_version_7;
626 dprint_arg.queue = queue;
627 dprint_arg.notify = 0;
628 dprint_arg.copies = 1;
629 dprint_arg.delete = 0;
630 dprint_arg.dest = "";
631 dprint_arg.forms = "";
632 dprint_arg.heading = "";
633 string (dprint_arg.carriage_control) = "0"b;
634 dprint_arg.lmargin = 0;
635 dprint_arg.line_lth = 0;
636 dprint_arg.page_lth = 0;
637 dprint_arg.top_label = "";
638 dprint_arg.bottom_label = "";
639 dprint_arg.chan_stop_path = "";
640 dprint_arg.destination = "";
641 dprint_arg.form_name = "";
642 dprint_arg.defer_until_process_termination = 0;
643
644 end init_variables;
645
646 end dprint;