1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1983 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 /* format: style3 */
 13 hc_ipc:
 14      procedure;
 15 
 16 /* Rewritten by E Donner Jan 1981 for new ipc */
 17 /* Modified 04/26/82 by S Krupp to print module name with all syserr msgs. */
 18 /* Modified 10/03/83 by Jeffrey I. Schiller to fix bug with messages for
 19    bad rings. */
 20 /* Modified 1984-11-21 by E. Swenson for IPC event channel validation. */
 21 /* Modified 1985-01-25 by EJ Sharpe to use access_audit_ */
 22 
 23 
 24 /****^  HISTORY COMMENTS:
 25   1) change(86-08-09,Kissel), approve(86-08-12,MCR7479),
 26      audit(86-10-20,Fawcett), install(86-11-03,MR12.0-1206):
 27      Changed to allow wakeups on fast channels by other than the creating
 28      process.  The changes to support async event channels are all handled in
 29      pxss$wakeup.
 30                                                    END HISTORY COMMENTS */
 31 
 32 
 33 /*  entries  */
 34 
 35 dcl       ipc_validate_$decode_event_channel_name
 36                               entry (fixed bin (18), fixed bin (35), fixed bin (71), bit (3) aligned, fixed bin (15),
 37                               fixed bin (3), bit (1) aligned, fixed bin (18), fixed bin (35));
 38 dcl       ipc_validate_$encode_event_channel_name
 39                               entry (fixed bin (18), fixed bin (35), bit (3) aligned, fixed bin (15), fixed bin (3),
 40                               bit (1) aligned, fixed bin (18), fixed bin (71));
 41 dcl       level$get           entry returns (fixed bin (3));
 42 dcl       access_audit_$log_general
 43                               entry options (variable);
 44 dcl       pxss$free_itt       entry (bit (18) aligned);
 45 dcl       pxss$wakeup         entry (bit (36) aligned, bit (72) aligned, fixed bin (71), fixed bin (35));
 46 dcl       syserr              entry options (variable);
 47 dcl       tc_util$get_ipc_operands
 48                               entry (fixed bin (18), fixed bin (35));
 49 dcl       tc_util$get_ipc_operands_priv
 50                               entry (bit (36) aligned, fixed bin (18), fixed bin (35), fixed bin (35));
 51 dcl       terminate_proc      entry (fixed bin (35));
 52 
 53 /* internal static */
 54 dcl       last_sender         bit (36) internal static init ("0"b);
 55                                                             /* on of the few uses of internal static in ring zero */
 56 
 57 /* Constants */
 58 
 59 dcl       ME                  char (32) initial ("hc_ipc") internal static options (constant);
 60 dcl       OFF                 bit (1) aligned internal static options (constant) init ("0"b);
 61 dcl       (ON, YES)           bit (1) aligned internal static options (constant) init ("1"b);
 62 dcl       QUITSTOP            char (8) internal static options (constant) init ("quitstop");
 63 
 64 /* external static */
 65 dcl       access_operations_$ipc_wakeup
 66                               bit (36) aligned ext;
 67 dcl       error_table_$ect_full
 68                               fixed bin (35) ext;
 69 dcl       error_table_$inconsistent_ect
 70                               fixed bin (35) ext;
 71 dcl       error_table_$invalid_channel
 72                               fixed bin (35) ext;
 73 dcl       error_table_$itt_overflow
 74                               fixed bin (35) ext;
 75 dcl       error_table_$process_stopped
 76                               fixed bin (35) ext;
 77 dcl       error_table_$process_unknown
 78                               fixed bin (35) ext;
 79 dcl       error_table_$special_channels_full
 80                               fixed bin (35) ext;
 81 dcl       error_table_$wakeup_denied
 82                               fixed bin (35) ext;
 83 dcl       error_table_$wrong_channel_ring
 84                               fixed bin (35) ext;
 85 
 86 dcl       pds$event_masks     (7) bit (36) aligned ext;
 87 dcl       pds$events_pending  bit (36) aligned ext;
 88 dcl       pds$itt_head        bit (18) aligned ext;
 89 dcl       pds$process_group_id
 90                               char (32) aligned ext;
 91 dcl       pds$process_id      bit (36) aligned ext;
 92 dcl       pds$ring_events     bit (36) aligned ext;         /* per ring indicator of messages copied from itt to ect */
 93 
 94 dcl       pds$special_channels
 95                               bit (36) aligned ext;
 96 dcl       pds$stacks          (0:7) ext ptr;
 97 dcl       tc_data$            fixed bin (17) ext;
 98 dcl       tc_data$max_channels
 99                               fixed bin (35) ext;
100 
101 
102 /* builtins */
103 
104 dcl       addr                builtin;
105 dcl       index               builtin;
106 dcl       null                builtin;
107 dcl       ptr                 builtin;
108 dcl       string              builtin;
109 dcl       substr              builtin;
110 dcl       unspec              builtin;
111 
112 /* conditions */
113 
114 dcl       area                condition;
115 
116 /* Automatic */
117 
118 dcl       channel_ring        fixed bin (3);
119 dcl       code                fixed bin (35);
120 dcl       ev_chn_flags        bit (3) aligned;
121 dcl       ev_chn_index        fixed bin (15);
122 dcl       ev_chn_ring         fixed bin (3);
123 dcl       ev_chn_type         bit (1) aligned;
124 dcl       ev_chn_unique_id    fixed bin (18);
125 dcl       event_channel_name_fb71
126                               fixed bin (71) automatic;
127 dcl       event_channel_message
128                               fixed bin (71);
129 dcl       fast_channel_id     fixed bin (18);
130 dcl       1 event_flags       aligned like audit_event_flags;
131                                                             /* for access_audit_ */
132 dcl       1 itt_dummy         like itt_entry aligned;       /* used to send self wakeup */
133 dcl       itt_relp            bit (18) aligned;
134 dcl       msg_ptr             ptr;                          /* pointer to allocated itt msg entry in ECT */
135 dcl       r_offset            fixed bin (18);               /* IPC validation operand */
136 dcl       r_factor            fixed bin (35);               /* IPC validation operand */
137 dcl       target_process      bit (36) aligned;
138 dcl       same_process        bit (1) aligned;
139 dcl       pxss_status         fixed bin (35);
140 dcl       target_ring         fixed bin (3);                /* target ring of message */
141 dcl       val_ring            fixed bin (3);
142 
143 /* based */
144 
145 dcl       ect_area            area (ect_header.ect_area_size) based (ect_header.ect_areap);
146 %page;
147 ipc_wakeup:
148      entry (a_target_process, a_event_channel, a_event_channel_message, a_code);
149 
150 /**** This entry (target of the gate hcs_$wakeup) performs IPC signalling.
151       Note that pxss$wakeup may also send an IPS "wkp_" signal if the event
152       channel flags indicate that it is that type of event channel.
153       It validates the supplied processid as well as the event channel
154       name before calling pxss to process the wakeup. */
155 
156 dcl       a_target_process    bit (36) aligned parameter;
157 dcl       a_event_channel     fixed bin (71) parameter;
158 dcl       a_event_channel_message
159                               fixed bin (71) parameter;
160 dcl       a_code              fixed bin (35) parameter;
161 
162 /* wakeup can be called from all rings (1-7) in order to send an IPC
163    signal to any currently-active process. It returns the following code:
164 
165    code = 0         Signalling correctly accomplished
166    code = error_table_$process_stopped
167                     Signalling correctly done & target process was found to be stopped
168    code = error_table_$invalid_channel
169                     The specified event channel name was bad.
170    code = error_table_$process_unknown
171                     Target process not found (either process-id wrong or process deactivated)
172    code = error_table_$itt_overflow
173                     ITT overflow resulted, signalling aborted
174    code = error_table_$wakeup_denied
175                     The access authorization of the target process
176                     is not greater than or equal to the access authorization
177                     of the sender process, so signalling is aborted.
178 */
179 
180           code = 0;                                         /* reset returned code to zero */
181           target_process = a_target_process;                /* copy args into stack */
182           event_channel_name_fb71 = a_event_channel;        /* copy parameters */
183           event_channel_message = a_event_channel_message;
184 
185           val_ring = level$get ();                          /* save validation level */
186 
187           call tc_util$get_ipc_operands_priv (target_process, r_offset, r_factor, code);
188           if code ^= 0
189           then do;
190                     call syserr (LOG, "^a: Denied wakeup by ^a in ring ^d.  Invalid process id ^w.", ME,
191                          pds$process_group_id, val_ring, target_process);
192                     goto WAKEUP_RETURNS;
193                end;
194 
195           call ipc_validate_$decode_event_channel_name (r_offset, r_factor, event_channel_name_fb71, ev_chn_flags,
196                ev_chn_index, ev_chn_ring, ev_chn_type, ev_chn_unique_id, code);
197           if code ^= 0
198           then do;
199                     call syserr (LOG, "^a: Denied wakeup by ^a in ring ^d to process ^w.  Invalid event channel ^24.3b",
200                          ME, pds$process_group_id, val_ring, target_process, unspec (event_channel_name_fb71));
201                     goto WAKEUP_RETURNS;
202                end;
203 
204 /* is wakeup being sent to self */
205           same_process = (target_process = pds$process_id);
206 
207 /* Determine if channel is a fast channel and do not allow */
208 /* sending wakeup to an inner ring */
209 
210           if ev_chn_type = FAST_CHANNEL_TYPE                /* it's a fast channel */
211           then do;
212                     if ev_chn_ring < val_ring
213                     then do;
214                               code = error_table_$invalid_channel;
215                               call syserr (LOG,
216                                    "^a: Denied wakeup by ^a in ring ^d to process ^w.  Fast channel (^24.3b) not allowed.",
217                                    ME, pds$process_group_id, val_ring, target_process, unspec (event_channel_name_fb71));
218 
219                               go to WAKEUP_RETURNS;
220                          end;
221                end;
222 
223 /* It's not a fast channel and sending self wakeup */
224 /* Special case - avoid calling pxss and allocate entry in ECT directly */
225 
226           else if (same_process = YES)
227           then do;
228                     if ev_chn_ring = val_ring
229                     then do;
230                               unspec (itt_dummy) = "0"b;    /* set up replica of entry in ITT */
231                                                             /* fill in values */
232                               itt_dummy.sender, itt_dummy.target_id = target_process;
233                               itt_dummy.ring = val_ring;
234                               unspec (itt_dummy.channel_id) = unspec (event_channel_name_fb71);
235                               itt_dummy.message = event_channel_message;
236 
237                               on area call ect_error_handler (error_table_$ect_full, target_ring);
238 
239                               call dispatch_message (addr (itt_dummy), target_ring);
240                               if target_ring > 0
241                               then go to WAKEUP_RETURNS;    /* it should be done */
242                          end;
243 
244                end;
245 
246 /* send wakeup to other process or send wakeup over fast channel */
247 /* call wakeup which does checks for overflow of ITT */
248 
249           code = 0;                                         /* Start clean. */
250 
251           call pxss$wakeup (target_process, unspec (event_channel_name_fb71), event_channel_message, pxss_status);
252 
253           if pxss_status = 0
254           then code = error_table_$process_unknown;         /* target process unknown */
255 
256           else if pxss_status = 5
257           then code = error_table_$process_stopped;         /* target process is quit */
258 
259           else if pxss_status = 100
260           then do;
261                     string (event_flags) = ""b;
262                     call access_audit_$log_general (ME, val_ring, string (event_flags), access_operations_$ipc_wakeup, "",
263                          0, null (), 0, "Target process (^w) authorization is lower", target_process);
264                     code = error_table_$wakeup_denied;
265                end;
266 
267           else if pxss_status = 200
268           then do;                                          /* ITT overflow */
269                     code = error_table_$itt_overflow;
270                     if pds$process_id ^= last_sender
271                     then do;                                /* filter useless msgs */
272                               last_sender = pds$process_id;
273                               call syserr (0, "^a: ITT overflow caused by ^a", ME, pds$process_group_id);
274                          end;
275                end;
276 
277 WAKEUP_RETURNS:
278           a_code = code;
279           return;
280 ^L
281 /*        BLOCK = procedure to receive IPC Signals */
282 
283 full_block:
284      entry;
285 
286           val_ring = level$get ();                          /* get validation level */
287           on area call ect_error_handler (error_table_$ect_full, target_ring);
288 
289           itte_ptr = addr (tc_data$);
290           do itt_relp = pds$itt_head repeat (itte_ptr -> itt_entry.next_itt_relp) while (itt_relp);
291                                                             /* go through all ITT messages */
292                itte_ptr = ptr (itte_ptr, itt_relp);
293                call dispatch_message (itte_ptr, target_ring);
294 
295           end;
296 
297           call pxss$free_itt (pds$itt_head);                /* free all messages */
298 
299           return;
300 ^L
301 assign_channel:
302      entry (a_channel_name, a_code);
303 
304 dcl       a_channel_name      fixed bin (71);               /* name of channel assigned */
305 
306           code = 0;
307 
308           fast_channel_id = index (pds$special_channels, "0"b);
309                                                             /* get index of new channel */
310           if (fast_channel_id > tc_data$max_channels) | (fast_channel_id = 0)
311           then do;                                          /* channels exhausted */
312                     code = error_table_$special_channels_full;
313                     a_channel_name = 0;
314                     go to FAST_CHANNEL_RETURNS;
315                end;
316           substr (pds$special_channels, fast_channel_id, 1) = ON;
317                                                             /* channel is asigned */
318           val_ring = level$get ();
319           substr (pds$event_masks (val_ring), fast_channel_id, 1) = ON;
320                                                             /* channel assigned to ring */
321           substr (pds$events_pending, fast_channel_id, 1) = OFF;
322                                                             /* turn off any pending wakeups */
323 
324 /**** Retrieve the values of R-Offset and R-Factor from the APTE.  These
325       values are needed to encode the event channel name. */
326 
327           call tc_util$get_ipc_operands (r_offset, r_factor);
328 
329 /* fill in channel name */
330 
331           call ipc_validate_$encode_event_channel_name (r_offset, r_factor, NORMAL_CHANNEL_FLAGS, (fast_channel_id),
332                val_ring, FAST_CHANNEL_TYPE, fast_channel_id, event_channel_name_fb71);
333 
334           unspec (a_channel_name) = unspec (event_channel_name_fb71);
335           go to FAST_CHANNEL_RETURNS;
336 ^L
337 delete_channel:
338      entry (a_channel_name, a_code);
339 
340           unspec (event_channel_name_fb71) = unspec (a_channel_name);
341           code = 0;
342           val_ring = level$get ();
343 
344 /**** Retrieve the values of R-Offset and R-Factor from the APTE.  These
345       values are needed to decode the event channel name. */
346 
347           call tc_util$get_ipc_operands (r_offset, r_factor);
348 
349           call ipc_validate_$decode_event_channel_name (r_offset, r_factor, event_channel_name_fb71, ev_chn_flags,
350                ev_chn_index, channel_ring, ev_chn_type, fast_channel_id, code);
351           if code ^= 0
352           then goto FAST_CHANNEL_RETURNS;
353 
354           if fast_channel_id ^= ev_chn_index
355           then do;
356                     code = error_table_$invalid_channel;
357                     goto FAST_CHANNEL_RETURNS;
358                end;
359 
360           if val_ring > channel_ring
361           then do;                                          /* access violation */
362                     code = error_table_$wrong_channel_ring;
363                     go to FAST_CHANNEL_RETURNS;
364                end;
365 
366           if ev_chn_type ^= FAST_CHANNEL_TYPE
367           then do;
368                     code = error_table_$invalid_channel;
369                     goto FAST_CHANNEL_RETURNS;
370                end;
371 
372           if fast_channel_id > tc_data$max_channels | fast_channel_id <= 0
373           then do;
374                     code = error_table_$invalid_channel;
375                     go to FAST_CHANNEL_RETURNS;
376                end;
377 
378           if (substr (pds$event_masks (channel_ring), fast_channel_id, 1) = OFF)
379           then do;
380                     code = error_table_$invalid_channel;
381                     go to FAST_CHANNEL_RETURNS;
382                end;
383 
384 /* deallocate channel in ring */
385           substr (pds$event_masks (channel_ring), fast_channel_id, 1) = OFF;
386           substr (pds$special_channels, fast_channel_id, 1) = OFF;
387                                                             /* deallocate channel */
388 FAST_CHANNEL_RETURNS:
389           a_code = code;
390           return;
391 ^L
392 dispatch_message:
393      proc (a_itte_ptr, a_target_ring);
394 
395 dcl       a_itte_ptr          ptr parameter;
396 dcl       a_target_ring       fixed bin (3) parameter;
397 
398 /* following is the unthreading of the event queue and the dispatching
399    of the event messages into their corresponding rings */
400 
401           a_target_ring = 0;
402 
403 /* process is being destroyed */
404           if unspec (a_itte_ptr -> itt_entry.channel_id) = unspec (QUITSTOP)
405           then return;
406 
407 /* pick up ring from channel name and check its validity */
408           a_target_ring = addr (a_itte_ptr -> itt_entry.channel_id) -> event_channel_name.ring;
409           if a_target_ring = 0
410           then return;
411           sb = pds$stacks (a_target_ring);
412           if sb = null                                      /* sender could have put bad ring in name */
413           then return;
414 
415 /* pick up pointer to ect and ect area and check that all goes well */
416           ect_ptr = sb -> stack_header.ect_ptr;
417 
418 /* ect_ptr is null in rings that don't have an ECT (like inner rings that
419 haven't called ipc_$create_ev_chn). DONT KILL PROCESS BECAUSE OF THIS, just
420 ignore the event. Note that anyone can send an event message to an event
421 channel that specifies any old ring... The old code here used to terminate
422 the process on this condition thus allowing malicious users to trash
423 any process */
424 
425           if ect_ptr = null
426           then return;
427 
428           if ect_header.ect_areap = null
429           then call ect_error_handler (error_table_$inconsistent_ect, a_target_ring);
430 
431           allocate itt_message in (ect_area) set (msg_ptr);
432           ect_header.count (ITT_MESSAGE) = ect_header.count (ITT_MESSAGE) + 1;
433           ect_header.count (TOTAL) = ect_header.count (TOTAL) + 1;
434           unspec (msg_ptr -> itt_message) = "0"b;
435           msg_ptr -> itt_message.type = ITT_MESSAGE;
436           call thread_itt_message (ect_ptr, msg_ptr);
437 
438           msg_ptr -> itt_message.message_data = a_itte_ptr -> itt_entry, by name;
439 
440           substr (pds$ring_events, a_target_ring, 1) = ON;  /* record that messages copied into this ring's ect */
441                                                             /* may not be validation ring */
442 
443      end dispatch_message;
444 ^L
445 thread_itt_message:
446      proc (a_ect_ptr, a_msgp);
447 
448 dcl       a_ect_ptr           ptr parameter;
449 dcl       a_msgp              ptr parameter;
450 
451 dcl       prev_ittp           ptr;
452 
453           prev_ittp = a_ect_ptr -> ect_header.lastp (ITT_MESSAGE);
454           if prev_ittp = null
455           then a_ect_ptr -> ect_header.firstp (ITT_MESSAGE) = a_msgp;
456           else prev_ittp -> itt_message.next_itt_msgp = a_msgp;
457           a_ect_ptr -> ect_header.lastp (ITT_MESSAGE) = a_msgp;
458           a_msgp -> itt_message.next_itt_msgp = null;
459 
460      end thread_itt_message;
461 ^L
462 ect_error_handler:
463      proc (a_code, a_ring);
464 
465 dcl       a_code              fixed bin (35) parameter;
466 dcl       a_ring              fixed bin (3) parameter;
467 
468           call syserr (4, "^a: Unable to allocate in ring ^d ECT for ^a", ME, a_ring, pds$process_group_id);
469           call terminate_proc (a_code);
470 
471      end ect_error_handler;
472 
473 /* format: off */
474 %page; %include access_audit_eventflags;
475 %page; %include ect_structures;
476 %page; %include event_channel_name;
477 %page; %include itt_entry;
478 %page; %include stack_header;
479 %page; %include syserr_constants;
480 %page;
481 /* BEGIN MESSAGE DOCUMENTATION
482 
483    Message:
484    hc_ipc: ITT overflow caused by NAME.PROJ
485 
486    S:     $info
487 
488    T:     $run
489 
490    M:     When wakeups are sent from one process to another, or from a device
491    like a tape drive to a process, the wakeups are stored temporarily in the
492    Interprocess Transmission Table (ITT). If wakeups are sent too fast,
493    or if the receiving process never calls block to read its wakeups,
494    the ITT may overflow. When the ITT is full, this message is printed
495    for each lost wakeup. The message identifies the sender of the wakeup,
496    who may be innocent of any error or wrongdoing.
497 
498    If a critical system function cannot send a wakeup, the system may crash.
499 
500    A:     If the ITT overflow is a transient condition, this message will stop
501    coming out after a few minutes. If so, system operation may return to normal.
502    If the message comes out repeatedly, the system will have to be crashed,
503    since user terminal operation, daemon operations, and the message
504    coordinator depend on wakeups.
505    $recover
506 
507 
508    Message:
509    hc_ipc: Unable to allocate in ring RINGNO ECT for  NAME.PROJ
510 
511    S:     $log
512 
513    T:     $run
514 
515    M:     When a process recieves wakeups, they are copied from the
516    Interprocess Transmission Table to an Event Channel Table (ECT).
517    A process owns one ECT per ring.  If, for any reason, an entry
518    for a wakeup cannot be allocated in a process' ECT, that
519    process is terminated.
520 
521    A:     If the process is a daemon process, it must be reinitialized.
522    If the process is the initializer process, the system will crash.
523 
524    END MESSAGE DOCUMENTATION */
525 /* format: on */
526 
527      end hc_ipc;