1
2
3
4
5
6
7
8
9
10
11 mail_errfiles: proc;
12
13
14
15 dcl get_wdir_ entry returns (char (168));
16 dcl (temp_string1, temp_string) char(32);
17 dcl hcs_$star_ entry (char (*) aligned, char (*) aligned, fixed bin (2), ptr,
18 fixed bin, ptr, ptr, fixed bin (35));
19 dcl hcs_$fs_get_mode entry (ptr, fixed bin (5), fixed bin (35));
20 dcl delete_$path entry (char (*) aligned, char (*), bit (6), char (*), fixed bin (35));
21 dcl continue_to_signal_ entry (fixed bin(35));
22 dcl find_condition_info_ entry (ptr, ptr, fixed bin(35));
23 dcl ioa_$ioa_stream entry options (variable);
24 dcl com_err_ entry options(variable);
25 dcl mailbox_$close entry(fixed bin,fixed bin(35));
26 dcl mailbox_$get_mode_index entry(fixed bin,bit(*)aligned,fixed bin(35));
27 dcl mailbox_$open entry(char(*)aligned,char(*)aligned,fixed bin,fixed bin(35));
28 dcl mail entry options(variable);
29 dcl old_mail entry options(variable);
30 dcl hcs_$terminate_noname
31 entry (ptr, fixed bin (35));
32 dcl dprint_ entry (char (*) aligned, char (*) aligned, ptr, fixed bin (35));
33 dcl get_system_free_area_
34 entry returns (ptr);
35 dcl hcs_$initiate_count entry (char (*) aligned, char (*) aligned, char (*), fixed bin (24),
36 fixed bin (2), ptr, fixed bin (35));
37 dcl hcs_$delentry_seg entry (ptr, fixed bin (35));
38
39
40
41 dcl (addr, after, before, null, substr) builtin;
42
43
44
45 dcl 1 box based (p) aligned,
46 2 lock bit (36) aligned,
47 2 nchr fixed bin,
48 2 nmsg fixed bin,
49 2 lins fixed bin,
50 2 secret fixed bin,
51 2 pad (3) fixed bin,
52 2 b,
53 3 yte (1000) bit (9) unaligned;
54
55 dcl 1 in based (p) aligned,
56 2 put (1000)bit (9) unaligned;
57
58
59 % include dprint_arg;
60 dcl 1 entries (encount) aligned based (eptr),
61 2 type bit (2) unaligned,
62 2 nname bit (16) unaligned,
63 2 nindex bit (18) unaligned;
64
65
66
67 dcl names (0:100) char (32) aligned based (nptr);
68 dcl areap ptr init (null);
69 dcl encount fixed bin (17);
70 dcl mseg_index fixed bin(17) init(0);
71 dcl (eptr, delptr, nptr) ptr init (null);
72 dcl xmode bit(36) aligned;
73 dcl star_arg char (6) aligned init ("EF.**");
74 dcl mode fixed bin (5);
75 dcl bmode bit (36) based (addr (mode));
76 dcl ind fixed bin;
77 dcl dptr ptr init (null);
78 dcl dir_name char(168) aligned int static
79 init(">udd>SysDaemon>error_file");
80 dcl code fixed bin (35);
81 dcl dirp char(168) aligned;
82 dcl p ptr init (null);
83 dcl enamep char(32) aligned;
84 dcl ec fixed bin (35);
85 dcl bitct fixed bin (24);
86 dcl (this_seg, cur_seg) char (70);
87 dcl cur_name char (22) aligned;
88 dcl error_table_$noentry fixed bin (35) ext;
89 dcl error_table_$no_dir fixed bin (35) ext;
90 dcl error_table_$no_info fixed bin (35) ext;
91 dcl cur_proj char (9) aligned;
92 dcl my_path char (168) aligned;
93 dcl any_other condition;
94 ^L
95
96
97
98
99
100
101
102
103
104
105
106 dpap = addr (dprint_arg_buf);
107 dpap -> dprint_arg.version = 1;
108 dpap -> dprint_arg.copies = 1;
109 dpap -> dprint_arg.delete = 1;
110 dpap -> dprint_arg.queue = 3;
111 dpap -> dprint_arg.pt_pch = 1;
112 dpap -> dprint_arg.notify = 1;
113 dpap -> dprint_arg.output_module = 1;
114 dpap -> dprint_arg.class = "printer";
115
116
117
118
119
120
121
122
123
124
125
126 areap = get_system_free_area_ ();
127 call hcs_$star_ (dir_name, star_arg, 11b, areap, encount, eptr, nptr, code);
128 if code ^= 0 then do;
129 call com_err_ (code, "mail_errfiles", "Error in obtaining error segments.");
130 go to fin;
131 end;
132
133
134
135
136
137
138
139
140
141
142 do ind = 1 to encount;
143 this_seg = nptr -> names (ind-1);
144 my_path = before(dir_name," ")||">"||this_seg;
145 cur_seg = after (this_seg, "EF.");
146 temp_string = cur_seg;
147 do while (index (temp_string, ".") ^= 0);
148 temp_string1 = before (temp_string, ".");
149 temp_string = after (temp_string, ".");
150 end;
151 cur_name = temp_string1;
152 cur_proj = temp_string;
153
154
155
156
157
158
159
160
161
162
163
164
165 if cur_name = "strange" then go to fin;
166
167
168
169
170
171
172
173
174
175
176
177
178
179 on condition(any_other) call default_handler;
180 dirp = ">udd>"||before (cur_proj, " ")||">"||before (cur_name, " ");
181 enamep = before(cur_name," ")||".mbx";
182 call mailbox_$open(dirp,enamep,mseg_index,code);
183 if mseg_index=0 then do;
184
185 try_old: enamep = "mailbox";
186 call hcs_$initiate_count (dirp, enamep, "", bitct, 1, p, ec);
187 if p=null then do;
188
189 if ec = error_table_$no_info then go to del_seg;
190 else if ec = error_table_$noentry | ec = error_table_$no_dir then do;
191 print_it:
192 dpap -> dprint_arg.dest = cur_proj;
193 dpap -> dprint_arg.heading = cur_name;
194
195 call dprint_ (dir_name, ("EF."||before(cur_name, " ")||"."||cur_proj), dpap, code);
196 go to fin;
197 end;
198
199
200
201
202
203
204
205
206
207
208
209
210 call com_err_ (ec, "mail_errfiles", "Null pointer returned to mailbox ^a>^a",dirp,enamep);
211 go to fin;
212 end;
213 call hcs_$fs_get_mode (p, mode, code);
214 if ^substr (bmode, 33, 1) | ^substr (bmode, 35, 1) then do;
215
216 call hcs_$terminate_noname(p,code);
217 del_seg:
218 call delete_$path (dir_name, this_seg, "000100"b, "mail_errfiles", code);
219 if code ^= 0 then
220 call com_err_ (code, "mail_errfiles", "Unsuccessful delete attempt of seg", "^a", my_path);
221 go to fin;
222 end;
223
224
225
226
227
228
229
230
231
232
233
234
235
236 if bitct > 0 then if p -> box.secret ^= 2962 then do;
237 call hcs_$terminate_noname (p, code);
238 go to print_it;
239 end;
240 call old_mail (my_path, before(cur_name, " "), before(cur_proj, " "));
241 call hcs_$terminate_noname (p, ec);
242 p = null;
243 end;
244
245
246
247
248
249
250
251
252
253
254 else do;
255 call mailbox_$get_mode_index(mseg_index,xmode,ec);
256 if ec^=0 | ^substr(xmode,1,1) then do;
257 call mailbox_$close(mseg_index,code);
258 go to try_old;
259 end;
260
261 call mail (my_path,before(cur_name," "),before(cur_proj," "));
262 call mailbox_$close(mseg_index,code);
263 end;
264 fin: end;
265
266 default_handler: proc;
267
268 dcl 1 cond_info aligned,
269 2 mcptr ptr,
270 2 version fixed bin,
271 2 condition_name char(32) varying,
272 2 infop ptr,
273 2 wcptr ptr,
274 2 loc_ptr ptr,
275 2 flags aligned,
276 3 crawlout bit(1) unal,
277 3 pad1 bit(35) unal,
278
279 2 pad_word bit(36) aligned,
280 2 user_loc ptr,
281 2 pad(4) bit(36) aligned;
282
283
284 call find_condition_info_ (null, addr(cond_info), code);
285 if code ^= 0 then do;
286
287 call ioa_$ioa_stream ("error_output", "Error: Unknown signal has been received.");
288 return;
289 end;
290
291 if cond_info.condition_name = "alrm" then do;
292
293 continue:
294 call continue_to_signal_ (code);
295 return;
296 end;
297
298 if cond_info.condition_name = "cput" then go to continue;
299 if cond_info.condition_name = "linkage_error" then go to continue;
300 if cond_info.condition_name = "mme2" then go to continue;
301 if cond_info.condition_name = "quit" then go to continue;
302 if cond_info.condition_name = "command_error" then go to continue;
303 if cond_info.condition_name = "finish" then go to continue;
304 if cond_info.condition_name = "stack" then go to continue;
305 if cond_info.condition_name = "program_interrupt" then return;
306
307 call hcs_$terminate_noname (p, code);
308 go to fin;
309
310 end default_handler;
311
312
313
314
315 end;