COMPILATION LISTING OF SEGMENT check_iacl Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Honeywell Bull, Phoenix AZ, SysM Compiled on: 01/17/89 1445.8 mst Tue Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1988 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 /****^ HISTORY COMMENTS: 15* 1) change(88-10-11,TLNguyen), approve(88-10-11,MCR8013), 16* audit(88-09-11,Barstad), install(89-01-17,MR12.3-1004): 17* Replace star convention with ACL matching convention for -exclude User_id. 18* END HISTORY COMMENTS */ 19 20 check_iacl: proc; 21 22 /* CHECK_IACL - list any acls which do not correspond to the initial acl. 23* THVV */ 24 /* MCR 4266 Say "Directory empty" instead of error_table_$nomatch 01/07/80 S. Herbst */ 25 26 dcl DIRECTORY_TYPE fixed bin (2) static options (constant) init (2); 27 dcl SEGMENT_TYPE fixed bin (2) static options (constant) init (1); 28 dcl SEGMENT_TYPE_IN_BIT bit (2) static options (constant) init ("01"b); 29 30 dcl MAX_ALLOWANCE_TO_EXCLUDE fixed bin static options (constant) init (10); 31 32 dcl TRUE bit (1) int static options (constant) init ("1"b); 33 dcl FALSE bit (1) int static options (constant) init ("0"b); 34 35 dcl LITERAL_DOT char (1) internal static options (constant) init ("."); 36 dcl LITERAL_DOT_DOT char (2) internal static options (constant) init (".."); 37 dcl LITERAL_DOT_DOT_STAR char (3) internal static options (constant) init ("..*"); 38 dcl LITERAL_STAR char (1) internal static options (constant) init ("*"); 39 40 dcl MY_NAME char (10) static options (constant) init ("check_iacl"); 41 42 dcl (dn1, dn) char (168) aligned, 43 (en1, en) char (32) aligned, 44 ring fixed bin (3), 45 allsw bit (1), 46 got_path bit (1), 47 headed bit (1), 48 exclude_count fixed bin, /* count the number of -exclude control arguments */ 49 (nisacl, nidacl) fixed bin, 50 eptr ptr, 51 nptr ptr, 52 ecount fixed bin, 53 (isaclp, idaclp) ptr, 54 nacl fixed bin, 55 aclp ptr, 56 areap ptr, 57 (arg_index, entry_index) fixed bin, 58 (arg_count, arg_len) fixed bin, 59 arg_ptr ptr, 60 arg char (arg_len) based (arg_ptr), 61 code fixed bin (35); 62 /* the following array of record */ 63 /* is reserved for -exclude User_id */ 64 /* See documentation for details. */ 65 /* It contains the name of User_id, */ 66 /* a flag which is set if User_id */ 67 /* is a null string, the length of */ 68 /* User_id, number of dot characters*/ 69 /* appeared in User_id, and dot */ 70 /* character positions in User_id. */ 71 dcl 1 exclude (MAX_ALLOWANCE_TO_EXCLUDE), 72 2 name char (32), 73 2 null_string_flag bit (1), 74 2 actual_length fixed bin, 75 2 dot_count fixed bin, 76 2 dot_location (2) fixed bin; 77 78 dcl error_table_$entlong fixed bin (35) ext; 79 dcl error_table_$badopt fixed bin (35) ext; 80 dcl error_table_$bad_name fixed bin (35) ext; 81 dcl error_table_$too_many_args fixed bin (35) ext; 82 83 dcl get_system_free_area_ entry () returns (ptr), 84 cu_$arg_count entry (fixed bin, fixed bin (35)), 85 cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)), 86 get_ring_ entry () returns (fixed bin), 87 get_wdir_ entry () returns (char (168)), 88 absolute_pathname_ entry (char (*), char (*) aligned, fixed bin (35)), 89 expand_pathname_ entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (35)), 90 ioa_ entry options (variable), 91 (com_err_, com_err_$suppress_name) entry options (variable); 92 dcl hcs_$star_ entry (char (*) aligned, char (*) aligned, fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35)); 93 dcl hcs_$list_dir_inacl entry (char (*) aligned, char (*) aligned, ptr, ptr, ptr, fixed bin, fixed bin (3), 94 fixed bin (35)); 95 dcl hcs_$list_inacl entry (char (*) aligned, char (*) aligned, ptr, ptr, ptr, fixed bin, fixed bin (3), 96 fixed bin (35)); 97 dcl hcs_$list_dir_acl entry (char (*) aligned, char (*) aligned, ptr, ptr, ptr, fixed bin, fixed bin (35)); 98 dcl hcs_$list_acl entry (char (*) aligned, char (*) aligned, ptr, ptr, ptr, fixed bin, fixed bin (35)); 99 100 dcl (after, before, fixed, index, length, null, rtrim, substr, verify, reverse) builtin; 101 dcl cleanup condition; 102 103 dcl 1 seg_acl (10) aligned, 104 2 name char (32), 105 2 mode bit (36), 106 2 mbz bit (36), 107 2 code fixed bin (35); 108 109 dcl 1 dir_acl (nacl) based (aclp) aligned, 110 2 access_name char (32), 111 2 modes bit (36), 112 2 statuscode fixed bin (35); 113 114 dcl 1 segment_acl (nacl) based (aclp) aligned, 115 2 access_name char (32), 116 2 modes bit (36), 117 2 mbz bit (36), 118 2 statuscode fixed bin (35); 119 120 dcl 1 entries (ecount) aligned based (eptr), 121 2 type bit (2) unal, 122 2 nnames bit (16) unal, 123 2 nindex bit (18) unal; 124 125 dcl names (100) char (32) based (nptr) aligned; 126 127 /* begin check_iacl main program */ 128 129 call cu_$arg_count (arg_count, code); 130 if code ^= 0 then do; 131 call com_err_ (code, MY_NAME); 132 return; 133 end; 134 /* initialized */ 135 ecount = 0; 136 eptr = null; 137 nptr = null; 138 isaclp = null; 139 idaclp = null; 140 141 seg_acl (*).mbz = (36) "0"b; 142 143 allsw, got_path = FALSE; /* indicate that -all and path have not specified yet */ 144 exclude_count = 0; /* indicate that -exclude control argument has not specified yet */ 145 146 do arg_index = 1 to arg_count; /* parsing input arguments specified on the command line */ 147 /* get an input argument specified on the command line */ 148 call cu_$arg_ptr (arg_index, arg_ptr, arg_len, code); 149 if code ^= 0 then do; 150 call com_err_ (code, MY_NAME); 151 return; 152 end; 153 154 if index (arg, "-") = 1 then do; /* the first character of the input argument is a hyphen */ 155 if arg = "-all" | arg = "-a" then allsw = TRUE; 156 157 else if arg = "-exclude" | arg = "-ex" then do; 158 arg_index = arg_index + 1; 159 if arg_index > arg_count then do; 160 call com_err_ (0, MY_NAME, "Missing User_id for -exclude"); 161 return; 162 end; 163 164 call cu_$arg_ptr (arg_index, arg_ptr, arg_len, code); 165 if code ^= 0 then do; 166 call com_err_ (code, MY_NAME, "Trying to get User_id for -exclude."); 167 return; 168 end; 169 170 exclude_count = exclude_count + 1; /* indicate that a -exclude User_id has been found */ 171 172 if exclude_count > MAX_ALLOWANCE_TO_EXCLUDE then do; 173 call com_err_ (error_table_$too_many_args, MY_NAME, "You can only supply up to 10 -exclude User_id."); 174 return; 175 end; 176 /* initialize a specified array of record element */ 177 exclude (exclude_count).name = ""; 178 exclude (exclude_count).null_string_flag = FALSE; 179 exclude (exclude_count).actual_length = 0; 180 exclude (exclude_count).dot_count = 0; 181 exclude (exclude_count).dot_location (*) = 0; 182 /* is null string specified in place of User_id for -exclude? */ 183 if arg = "" then exclude (exclude_count).null_string_flag = TRUE; 184 if (arg_len > 0) & (index (arg, " ") > 0) then exclude (exclude_count).null_string_flag = TRUE; 185 /* save specified User_id for -exclude control argument into the array */ 186 exclude (exclude_count).name = arg; 187 /* scan specified User_id and update its components whenever appropriate */ 188 call set_components; 189 if code ^= 0 then return; 190 end; 191 else do; 192 call com_err_ (error_table_$badopt, MY_NAME, "^a", arg); 193 return; 194 end; 195 end; 196 else do; /* assume that the input argument is the path */ 197 if got_path then do; /* checking for the case of more than one path is specified */ 198 USAGE: 199 call com_err_$suppress_name (0, MY_NAME, "Usage: check_iacl {path} {-control_args}"); 200 return; 201 end; 202 203 got_path = TRUE; /* indicate that the directory path is specified */ 204 205 call absolute_pathname_ (arg, dn1, code); 206 if code ^= 0 then do; 207 call com_err_ (code, MY_NAME, "^a", arg); 208 return; 209 end; 210 end; 211 end; /* end of parsing input arguments specified on the command line */ 212 213 if ^got_path then dn1 = get_wdir_ (); /* case the path is omitted then get the current working directory pathname */ 214 215 call expand_pathname_ (dn1, dn, en, code); 216 217 areap = get_system_free_area_ (); 218 ring = get_ring_ (); 219 220 on condition (cleanup) begin; 221 if isaclp ^= null then free isaclp -> segment_acl; 222 if idaclp ^= null then free idaclp -> dir_acl; 223 if nptr ^= null then free nptr -> names; 224 if eptr ^= null then free eptr -> entries; 225 end; 226 227 /* get information on all segment and directory entries in the directory path */ 228 call hcs_$star_ (dn1, "**", 10b, areap, ecount, eptr, nptr, code); 229 if code ^= 0 then do; 230 call com_err_ (code, MY_NAME, "^a", dn1); 231 return; 232 end; 233 234 /* get the entire IACL for segments in the directory path */ 235 call hcs_$list_inacl (dn, en, areap, isaclp, null, nisacl, ring, code); 236 if code ^= 0 then do; 237 call com_err_ (code, MY_NAME); 238 return; 239 end; 240 241 /* get the entire IACL for directories in the directory path */ 242 call hcs_$list_dir_inacl (dn, en, areap, idaclp, null, nidacl, ring, code); 243 244 do entry_index = 1 to ecount; 245 headed = FALSE; 246 aclp = null; 247 en1 = names (fixed (entries (entry_index).nindex)); 248 249 if entries (entry_index).type = SEGMENT_TYPE_IN_BIT then do; 250 /* list the entire ACL of a segment */ 251 call hcs_$list_acl (dn1, en1, areap, aclp, null, nacl, code); 252 if code ^= 0 then call com_err_ (code, MY_NAME, "^a>^a", dn1, en1); 253 254 call compare_seg_acl (isaclp, aclp, nisacl, nacl, (SEGMENT_TYPE)); 255 end; 256 else do; 257 call hcs_$list_dir_acl (dn1, en1, areap, aclp, null, nacl, code); 258 if code ^= 0 then call com_err_ (code, MY_NAME, "^a>^a", dn1, en1); 259 call compare_dir_acl (idaclp, aclp, nidacl, nacl, (DIRECTORY_TYPE)); 260 end; 261 end; 262 263 call ioa_ (""); 264 265 return; 266 267 /*-----------------------------------------------------------------------*/ 268 269 compare_seg_acl: proc (p1, p2, n1, n2, segment_type); 270 271 /* parameter */ 272 dcl (p1, p2) ptr, 273 (n1, n2) fixed bin, 274 segment_type fixed bin; 275 276 /* local */ 277 dcl (i, j) fixed bin, 278 tcount fixed bin, 279 aclbit bit (n2); 280 281 /* begin compare_seg_acl procedure */ 282 283 if p1 = null then return; 284 if p2 = null then return; 285 /* initialized */ 286 aclbit = FALSE; 287 tcount = n2; 288 289 do i = 1 to n1; 290 if inhibited (rtrim (p1 -> segment_acl.access_name (i))) then 291 goto ACL_OK; 292 293 do j = 1 to n2; 294 if p1 -> segment_acl.access_name (i) = p2 -> segment_acl.access_name (j) then do; 295 substr (aclbit, j, 1) = TRUE; 296 tcount = tcount - 1; 297 298 if p1 -> segment_acl.modes (i) = p2 -> segment_acl.modes (j) then 299 goto ACL_OK; 300 301 if allsw then do; 302 if ^headed then call head; 303 304 call ioa_ ("^-ACL for ^a changed from ^a to ^a", p2 -> segment_acl.access_name (j), 305 cmode (p1 -> segment_acl.modes (i), segment_type), cmode (p2 -> segment_acl.modes (j), segment_type)); 306 end; 307 308 goto ACL_OK; 309 end; 310 end; /* nested do loop */ 311 312 if allsw then do; 313 if ^headed then call head; 314 315 call ioa_ ("^-ACL deleted: ^a ^a", cmode (p1 -> segment_acl.modes (i), segment_type), p1 -> segment_acl.access_name (i)); 316 317 end; 318 319 ACL_OK: 320 end; /* outer do loop */ 321 322 do i = 1 to n2 while (tcount > 0); 323 if ^substr (aclbit, i, 1) then do; 324 tcount = tcount - 1; 325 326 if ^inhibited (rtrim (p2 -> segment_acl.access_name (i))) then do; 327 328 if ^headed then call head; 329 330 call ioa_ ("^-ACL added: ^a ^a", cmode (p2 -> segment_acl.modes (i), segment_type), p2 -> segment_acl.access_name (i)); 331 end; 332 end; 333 end; 334 335 return; 336 337 end compare_seg_acl; 338 339 340 /*-----------------------------------------------------------------------*/ 341 342 compare_dir_acl: proc (p1, p2, n1, n2, directory_type); 343 344 /* parameter */ 345 dcl (p1, p2) ptr, 346 (n1, n2) fixed bin, 347 directory_type fixed bin; 348 349 /* local */ 350 dcl (i, j) fixed bin, 351 tcount fixed bin, 352 aclbit bit (n2); 353 354 /* begin compare_dir_acl procedure */ 355 356 if p1 = null then return; 357 if p2 = null then return; 358 /* initialized */ 359 aclbit = FALSE; 360 tcount = n2; 361 362 do i = 1 to n1; 363 if inhibited (rtrim (p1 -> dir_acl.access_name (i))) then 364 goto ACL_OK; 365 366 do j = 1 to n2; 367 if p1 -> dir_acl.access_name (i) = p2 -> dir_acl.access_name (j) then do; 368 substr (aclbit, j, 1) = TRUE; 369 tcount = tcount - 1; 370 371 if p1 -> dir_acl.modes (i) = p2 -> dir_acl.modes (j) then 372 goto ACL_OK; 373 374 if allsw then do; 375 if ^headed then call head; 376 377 call ioa_ ("^-ACL for ^a changed from ^a to ^a", p2 -> dir_acl.access_name (j), 378 cmode (p1 -> dir_acl.modes (i), directory_type), cmode (p2 -> dir_acl.modes (j), directory_type)); 379 end; 380 381 goto ACL_OK; 382 end; 383 end; /* nested do loop */ 384 385 if allsw then do; 386 if ^headed then call head; 387 388 call ioa_ ("^-ACL deleted: ^a ^a", cmode (p1 -> dir_acl.modes (i), directory_type), p1 -> dir_acl.access_name (i)); 389 end; 390 391 ACL_OK: 392 end; /* outer do loop */ 393 394 do i = 1 to n2 while (tcount > 0); 395 if ^substr (aclbit, i, 1) then do; 396 tcount = tcount - 1; 397 398 if ^inhibited (rtrim (p2 -> dir_acl.access_name (i))) then do; 399 if ^headed then call head; 400 401 call ioa_ ("^-ACL added: ^a ^a", cmode (p2 -> dir_acl.modes (i), directory_type), p2 -> dir_acl.access_name (i)); 402 end; 403 end; 404 end; 405 406 return; 407 408 end compare_dir_acl; 409 410 /*------------------------------------------------------------------------*/ 411 412 cmode: proc (x, t) returns (char (5) aligned); 413 414 dcl x bit (36) aligned; 415 dcl t fixed bin; 416 417 dcl ans char (5) aligned; 418 419 dcl (i, k) fixed bin; 420 dcl XMODE (2, 5) char (1) int static options (constant) init ("r", "e", "w", "a", "", "s", "m", "a", "", ""); 421 422 /* begin cmode internal procedure */ 423 424 k = 1; 425 ans = ""; 426 427 do i = 1 to 5; 428 if substr (x, i, 1) then do; 429 substr (ans, k, 1) = XMODE (t, i); 430 k = k + 1; 431 end; 432 end; 433 434 if ans = "" then ans = "null"; 435 return (ans); 436 437 end cmode; 438 439 /* ------------------------------------------------------------------------*/ 440 441 inhibited: proc (p_access_identifier) returns (bit (1)); 442 443 /* Since up to 10 -exclude control arguments are allowed, so inhibit will */ 444 /* loop until all specified User_id(s) are excluded. */ 445 /* inhibit will return TRUE if the access identifier portion of ACL entry */ 446 /* matches the User_id for -exclude. Otherwise, returns FALSE. */ 447 448 /* input parameter */ 449 dcl p_access_identifier char (*) aligned; /* access name portion of ACL entry */ 450 451 dcl exclude_index fixed bin; /* local */ 452 453 /* begin inhibit internal procedure */ 454 455 do exclude_index = 1 to exclude_count; 456 /* User_id for -ex is a null string */ 457 if exclude (exclude_index).null_string_flag then do; 458 /* for any ACL entry whose 2nd component value is literal "*" and 459* whose 3rd component value is literal "*" then a match is found */ 460 if after (p_access_identifier, LITERAL_DOT) = "*.*" then 461 return (TRUE); /* return to compare_acl internal procedure */ 462 end; 463 else do; /* User_id for -ex is not a null string */ 464 /* the original User_id for -ex did not have a dot character */ 465 if exclude (exclude_index).dot_count = 0 then do; 466 /* a match is found if each component value of ACL entry is the same with each 467* component value of User_id for -ex, repectively. */ 468 if p_access_identifier = exclude (exclude_index).name then 469 return (TRUE); /* return to compare_acl internal procedure */ 470 end; 471 /* the original User_id for -ex had only one dot character */ 472 else if exclude (exclude_index).dot_count = 1 then do; 473 /* case original User_id value for -ex is a dot character */ 474 if exclude (exclude_index).name = LITERAL_DOT_DOT_STAR then do; 475 /* if the 3rd component value of ACL entry is a literal "*", a match is found */ 476 if before (reverse (p_access_identifier), LITERAL_DOT) = LITERAL_STAR then 477 return (TRUE); /* return to compare_acl internal procedure */ 478 end; 479 /* case the original User_id has a dot character in the first letter */ 480 else if exclude (exclude_index).dot_location (1) = 1 then do; 481 /* if the last two component values of ACL entry is the same as those of User_id */ 482 /* then a match is found */ 483 if after (p_access_identifier, LITERAL_DOT) = after (exclude (exclude_index).name, LITERAL_DOT) then 484 return (TRUE); /* return to compare_acl internal procedure */ 485 end; 486 /* case the original User_id has a dot character in the last letter */ 487 else if exclude (exclude_index).dot_location (1) = exclude (exclude_index).actual_length then do; 488 /* if the 1st component value and the 3rd component value of ACL entry is the same */ 489 /* as those of User_id then a match is found */ 490 if (before (p_access_identifier, LITERAL_DOT) = before (exclude (exclude_index).name, LITERAL_DOT)) & 491 (before (reverse (p_access_identifier), LITERAL_DOT) = LITERAL_STAR) then 492 return (TRUE); /* return to compare_acl internal procecudre */ 493 end; 494 495 else do; /* case the original User_id has a dot character between */ 496 /* if the entire component value of ACL entry is the same as those of User_id 497* then a match is found */ 498 if p_access_identifier = exclude (exclude_index).name then 499 return (TRUE); /* return to compare_acl internal procedure */ 500 end; 501 end; /* The specified User_id has one dot character */ 502 else do; /* two dots are found in the specified User_id */ 503 /* if User_id value is ".." then a match is found */ 504 if exclude (exclude_index).name = LITERAL_DOT_DOT then 505 return (TRUE); /* return to compare_acl internal procedure */ 506 /* the original User_id has ".." in the first two letters */ 507 else if (exclude (exclude_index).dot_location (1) = 1) & (exclude (exclude_index).dot_location (2) = 2) then do; 508 /* if the 3rd component value of ACL entry is the same as those of User_id 509* then a match is found */ 510 if before (reverse (p_access_identifier), LITERAL_DOT) = 511 before (reverse (rtrim (exclude (exclude_index).name)), LITERAL_DOT) then 512 return (TRUE); /* return to compare_acl internal procedure */ 513 end; 514 /* the original User_id has ".." in the last two letter */ 515 else if (exclude (exclude_index).dot_location (1) = exclude (exclude_index).actual_length - 1) & 516 (exclude (exclude_index).dot_location (2) = exclude (exclude_index).actual_length) then do; 517 /* if the 1st component value and the 3rd component value of ACL entry are 518* the same as those of User_id then a match is found */ 519 if (before (p_access_identifier, LITERAL_DOT) = before (exclude (exclude_index).name, LITERAL_DOT)) & 520 (before (reverse (p_access_identifier), LITERAL_DOT) = LITERAL_STAR) then 521 return (TRUE); /* return to compare_acl internal procedure */ 522 end; 523 /* the original User_id has dots in the first letter and the last letter */ 524 else if (exclude (exclude_index).dot_location (1) = 1) & 525 (exclude (exclude_index).dot_location (2) <= exclude (exclude_index).actual_length) then do; 526 /* if the last two component values of ACL entry is the same as those of 527* User_id then a match is found */ 528 if after (p_access_identifier, LITERAL_DOT) = after (exclude (exclude_index).name, LITERAL_DOT) then 529 return (TRUE); /* return to compare_acl internal procedure */ 530 end; 531 532 else do; 533 /* otherwise, an exact match to each component value is required in order to return TRUE */ 534 if p_access_identifier = exclude (exclude_index).name then 535 return (TRUE); /* return to compare_acl internal procedure */ 536 end; 537 end; /* two dots are found in the specified User_id */ 538 end; /* User_id for -ex is not a null string */ 539 end; /* looping until all specified User_id for -ex are processed */ 540 541 return (FALSE); /* return to compare_acl internal procedure */ 542 543 end inhibited; /* end of inhibited internal procedure */ 544 545 /*------------------------------------------------------------------------*/ 546 547 head: proc; 548 549 call ioa_ ("^/^a", en1); 550 551 headed = TRUE; 552 return; 553 554 end head; 555 556 /*-----------------------------------------------------------------------*/ 557 558 set_components: proc; 559 560 /* validate specified User_id for -exclude. For cases such as its length */ 561 /* longer than 32 characters long, then report as error. Also, do not */ 562 /* allow mixing of white space characters and other characters in */ 563 /* specified User_id. */ 564 /* For valid specified User_id, locate dot characters in specified */ 565 /* User_id. Maximum number of dots allowed is two. Since ACL matching */ 566 /* is allowed for User_id, several checks have been made to update */ 567 /* specified User_id value. */ 568 /* local */ 569 dcl character_index fixed bin; /* scan User_id to locate dot character positions */ 570 dcl user_id_name_length fixed bin; /* length of specified User_id name */ 571 572 dcl MAX_DOT fixed bin internal static options (constant) init (2); 573 dcl USER_ID_MAX_LENGTH fixed bin internal static options (constant) init (32); 574 575 /* begin set_component internal procedure */ 576 577 code = 0; 578 579 if length (exclude (exclude_count).name) > USER_ID_MAX_LENGTH then do; 580 code = error_table_$entlong; 581 goto set_components_ERROR_RETURN; 582 end; 583 /* are there white spaces in User_id? */ 584 user_id_name_length = index (exclude (exclude_count).name, " ") - 1; 585 /* no white spaces in User_id */ 586 if (user_id_name_length = - 1) then 587 exclude (exclude_count).actual_length = length (exclude (exclude_count).name); 588 else do; /* white space(s) are in User_id */ 589 exclude (exclude_count).actual_length = user_id_name_length; 590 /* if white spaces and other non white space characters are in User_id then treats as error. 591* Otherwise, it is ok for User_id containing only white space(s). */ 592 if verify (substr (exclude (exclude_count).name, exclude (exclude_count).actual_length + 1), " ") ^= 0 then do; 593 code = error_table_$bad_name; 594 goto set_components_ERROR_RETURN; 595 end; 596 end; 597 /* locate dot characters in the specified User_id */ 598 do character_index = 1 to exclude (exclude_count).actual_length; 599 if substr (exclude (exclude_count).name, character_index, 1) = LITERAL_DOT then do; 600 exclude (exclude_count).dot_count = exclude (exclude_count).dot_count + 1; 601 602 if exclude (exclude_count).dot_count > MAX_DOT then do; 603 code = error_table_$bad_name; 604 goto set_components_ERROR_RETURN; 605 end; 606 /* save the dot position in an array of dot locations */ 607 exclude (exclude_count).dot_location (exclude (exclude_count).dot_count) = character_index; 608 end; 609 end; 610 /* do not set component if all three components of User_id are specified. 611* For example: check_iacl -ex Foo.Multics.a */ 612 if (exclude (exclude_count).dot_count = MAX_DOT) & 613 (exclude (exclude_count).dot_location (1) > 1) & 614 (exclude (exclude_count).dot_location (2) < exclude (exclude_count).actual_length) then 615 goto set_components_NORMAL_RETURN; 616 /* specified User_id is not a null string */ 617 if ^exclude (exclude_count).null_string_flag then do; 618 /* for example: check_iacl -ex Foo */ 619 if exclude (exclude_count).dot_count = 0 then 620 621 /* append the literal ".*.*" to the specified User_id */ 622 substr (exclude (exclude_count).name, exclude (exclude_count).actual_length + 1, 4) = ".*.*"; 623 624 else if exclude (exclude_count).dot_count = 1 then do; 625 /* for the case of only one dot char is found in the specified User_id */ 626 if exclude (exclude_count).name = LITERAL_DOT then 627 /* if specified User_id value is "." then update its value */ 628 exclude (exclude_count).name = LITERAL_DOT_DOT_STAR; 629 /* Othewise, for examples: -ex .Multics; -ex Foo.; -ex Foo.Multics, */ 630 /* append literal ".*" to the specified User_id */ 631 else substr (exclude (exclude_count).name, exclude (exclude_count).actual_length + 1, 2) = ".*"; 632 end; 633 /* p_dot_count = 2 and specified User_id value is not ".." */ 634 else if exclude (exclude_count).name ^= LITERAL_DOT_DOT then do; 635 /* for examples: -ex ..a; -ex .Multics.a */ 636 if (exclude (exclude_count).dot_location (1) = 1) & 637 (exclude (exclude_count).dot_location (2) = 2 | 638 exclude (exclude_count).dot_location (2) < exclude (exclude_count).actual_length) then; 639 /* Otherwise, for examples: -ex Foo..; -ex .Multics.; -ex Foo.Multics., 640* append a literal "*" to the specified User_id */ 641 else substr (exclude (exclude_count).name, exclude (exclude_count).actual_length + 1, 1) = LITERAL_STAR; 642 end; 643 else; /* OK for -ex .. */ 644 end; /* specified User_id is not a null string */ 645 else; /* OK for -ex " " */ 646 647 set_components_NORMAL_RETURN: 648 return; /* return to check_iacl main program */ 649 650 set_components_ERROR_RETURN: 651 call com_err_ (code, MY_NAME, "^a", exclude (exclude_count).name); 652 return; /* for error, return to check_iacl main program */ 653 654 end set_components; /* end of set components internal procedure */ 655 656 /*--------------------------------------------------------------------------*/ 657 658 end check_iacl; /* end of check_iacl main program */ 659 SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 01/17/89 1444.5 check_iacl.pl1 >spec>install>1004>check_iacl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. DIRECTORY_TYPE constant fixed bin(2,0) initial dcl 26 ref 259 FALSE constant bit(1) initial packed unaligned dcl 33 ref 143 178 245 286 359 541 LITERAL_DOT 004403 constant char(1) initial packed unaligned dcl 35 ref 460 476 483 483 490 490 490 510 510 519 519 519 528 528 599 626 LITERAL_DOT_DOT 004402 constant char(2) initial packed unaligned dcl 36 ref 504 634 LITERAL_DOT_DOT_STAR 000006 constant char(3) initial packed unaligned dcl 37 ref 474 626 LITERAL_STAR 004401 constant char(1) initial packed unaligned dcl 38 ref 476 490 519 641 MAX_ALLOWANCE_TO_EXCLUDE constant fixed bin(17,0) initial dcl 30 ref 71 172 MAX_DOT constant fixed bin(17,0) initial dcl 572 ref 602 612 MY_NAME 000003 constant char(10) initial packed unaligned dcl 40 set ref 131* 150* 160* 166* 173* 192* 198* 207* 230* 237* 252* 258* 650* SEGMENT_TYPE constant fixed bin(2,0) initial dcl 27 ref 254 SEGMENT_TYPE_IN_BIT constant bit(2) initial packed unaligned dcl 28 ref 249 TRUE constant bit(1) initial packed unaligned dcl 32 ref 155 183 184 203 295 368 460 468 476 483 490 498 504 510 519 528 534 551 USER_ID_MAX_LENGTH constant fixed bin(17,0) initial dcl 573 ref 579 XMODE 000000 constant char(1) initial array packed unaligned dcl 420 ref 429 absolute_pathname_ 000032 constant entry external dcl 83 ref 205 access_name based char(32) array level 2 in structure "dir_acl" dcl 109 in procedure "check_iacl" set ref 363 363 367 367 377* 388* 398 398 401* access_name based char(32) array level 2 in structure "segment_acl" dcl 114 in procedure "check_iacl" set ref 290 290 294 294 304* 315* 326 326 330* aclbit 000103 automatic bit packed unaligned dcl 350 in procedure "compare_dir_acl" set ref 359* 368* 395 aclbit 000103 automatic bit packed unaligned dcl 277 in procedure "compare_seg_acl" set ref 286* 295* 323 aclp 000270 automatic pointer dcl 42 set ref 246* 251* 254* 257* 259* actual_length 11 000303 automatic fixed bin(17,0) array level 2 dcl 71 set ref 179* 487 515 515 524 586* 589* 592 598 612 619 631 636 641 after builtin function dcl 100 ref 460 483 483 528 528 allsw 000245 automatic bit(1) packed unaligned dcl 42 set ref 143* 155* 301 312 374 385 ans 000100 automatic char(5) dcl 417 set ref 425* 429* 434 434* 435 areap 000272 automatic pointer dcl 42 set ref 217* 228* 235* 242* 251* 257* arg based char packed unaligned dcl 42 set ref 154 155 155 157 157 183 184 186 192* 205* 207* arg_count 000276 automatic fixed bin(17,0) dcl 42 set ref 129* 146 159 arg_index 000274 automatic fixed bin(17,0) dcl 42 set ref 146* 148* 158* 158 159 164* arg_len 000277 automatic fixed bin(17,0) dcl 42 set ref 148* 154 155 155 157 157 164* 183 184 184 186 192 192 205 205 207 207 arg_ptr 000300 automatic pointer dcl 42 set ref 148* 154 155 155 157 157 164* 183 184 186 192 205 207 before builtin function dcl 100 ref 476 490 490 490 510 510 519 519 519 character_index 000704 automatic fixed bin(17,0) dcl 569 set ref 598* 599 607* cleanup 000506 stack reference condition dcl 101 ref 220 code 000302 automatic fixed bin(35,0) dcl 42 set ref 129* 130 131* 148* 149 150* 164* 165 166* 189 205* 206 207* 215* 228* 229 230* 235* 236 237* 242* 251* 252 252* 257* 258 258* 577* 580* 593* 603* 650* com_err_ 000040 constant entry external dcl 83 ref 131 150 160 166 173 192 207 230 237 252 258 650 com_err_$suppress_name 000042 constant entry external dcl 83 ref 198 cu_$arg_count 000022 constant entry external dcl 83 ref 129 cu_$arg_ptr 000024 constant entry external dcl 83 ref 148 164 dir_acl based structure array level 1 dcl 109 set ref 222 directory_type parameter fixed bin(17,0) dcl 345 set ref 342 377* 377* 377* 377* 388* 388* 401* 401* dn 000152 automatic char(168) dcl 42 set ref 215* 235* 242* dn1 000100 automatic char(168) dcl 42 set ref 205* 213* 215* 228* 230* 251* 252* 257* 258* dot_count 12 000303 automatic fixed bin(17,0) array level 2 dcl 71 set ref 180* 465 472 600* 600 602 607 612 619 624 dot_location 13 000303 automatic fixed bin(17,0) array level 2 dcl 71 set ref 181* 480 487 507 507 515 515 524 524 607* 612 612 636 636 636 ecount 000260 automatic fixed bin(17,0) dcl 42 set ref 135* 224 228* 244 en 000234 automatic char(32) dcl 42 set ref 215* 235* 242* en1 000224 automatic char(32) dcl 42 set ref 247* 251* 252* 257* 258* 549* entries based structure array level 1 dcl 120 ref 224 entry_index 000275 automatic fixed bin(17,0) dcl 42 set ref 244* 247 249* eptr 000254 automatic pointer dcl 42 set ref 136* 224 224 228* 247 249 error_table_$bad_name 000014 external static fixed bin(35,0) dcl 80 ref 593 603 error_table_$badopt 000012 external static fixed bin(35,0) dcl 79 set ref 192* error_table_$entlong 000010 external static fixed bin(35,0) dcl 78 ref 580 error_table_$too_many_args 000016 external static fixed bin(35,0) dcl 81 set ref 173* exclude 000303 automatic structure array level 1 unaligned dcl 71 exclude_count 000250 automatic fixed bin(17,0) dcl 42 set ref 144* 170* 170 172 177 178 179 180 181 183 184 186 455 579 584 586 586 589 592 592 598 599 600 600 602 607 607 612 612 612 612 617 619 619 619 624 626 626 631 631 634 636 636 636 636 641 641 650 exclude_index 000100 automatic fixed bin(17,0) dcl 451 set ref 455* 457 465 468 472 474 480 483 487 487 490 498 504 507 507 510 515 515 515 515 519 524 524 524 528 534* expand_pathname_ 000034 constant entry external dcl 83 ref 215 fixed builtin function dcl 100 ref 247 get_ring_ 000026 constant entry external dcl 83 ref 218 get_system_free_area_ 000020 constant entry external dcl 83 ref 217 get_wdir_ 000030 constant entry external dcl 83 ref 213 got_path 000246 automatic bit(1) packed unaligned dcl 42 set ref 143* 197 203* 213 hcs_$list_acl 000054 constant entry external dcl 98 ref 251 hcs_$list_dir_acl 000052 constant entry external dcl 97 ref 257 hcs_$list_dir_inacl 000046 constant entry external dcl 93 ref 242 hcs_$list_inacl 000050 constant entry external dcl 95 ref 235 hcs_$star_ 000044 constant entry external dcl 92 ref 228 headed 000247 automatic bit(1) packed unaligned dcl 42 set ref 245* 302 313 328 375 386 399 551* i 000100 automatic fixed bin(17,0) dcl 277 in procedure "compare_seg_acl" set ref 289* 290 290 294 298 304 304 315 315 315* 322* 323 326 326 330 330 330* i 000102 automatic fixed bin(17,0) dcl 419 in procedure "cmode" set ref 427* 428 429* i 000100 automatic fixed bin(17,0) dcl 350 in procedure "compare_dir_acl" set ref 362* 363 363 367 371 377 377 388 388 388* 394* 395 398 398 401 401 401* idaclp 000264 automatic pointer dcl 42 set ref 139* 222 222 242* 259* index builtin function dcl 100 ref 154 184 584 ioa_ 000036 constant entry external dcl 83 ref 263 304 315 330 377 388 401 549 isaclp 000262 automatic pointer dcl 42 set ref 138* 221 221 235* 254* j 000101 automatic fixed bin(17,0) dcl 350 in procedure "compare_dir_acl" set ref 366* 367 368 371 377 377 377* j 000101 automatic fixed bin(17,0) dcl 277 in procedure "compare_seg_acl" set ref 293* 294 295 298 304 304 304* k 000103 automatic fixed bin(17,0) dcl 419 set ref 424* 429 430* 430 length builtin function dcl 100 ref 579 586 mbz 11 000514 automatic bit(36) array level 2 dcl 103 set ref 141* modes 10 based bit(36) array level 2 in structure "dir_acl" dcl 109 in procedure "check_iacl" set ref 371 371 377* 377* 377* 377* 388* 388* 401* 401* modes 10 based bit(36) array level 2 in structure "segment_acl" dcl 114 in procedure "check_iacl" set ref 298 298 304* 304* 304* 304* 315* 315* 330* 330* n1 parameter fixed bin(17,0) dcl 345 in procedure "compare_dir_acl" ref 342 362 n1 parameter fixed bin(17,0) dcl 272 in procedure "compare_seg_acl" ref 269 289 n2 parameter fixed bin(17,0) dcl 345 in procedure "compare_dir_acl" ref 342 350 360 366 394 n2 parameter fixed bin(17,0) dcl 272 in procedure "compare_seg_acl" ref 269 277 287 293 322 nacl 000266 automatic fixed bin(17,0) dcl 42 set ref 221 222 251* 254* 257* 259* name 000303 automatic char(32) array level 2 packed packed unaligned dcl 71 set ref 177* 186* 468 474 483 490 498 504 510 519 528 534 579 584 586 592 599 619* 626 626* 631* 634 641* 650* names based char(32) array dcl 125 ref 223 247 nidacl 000252 automatic fixed bin(17,0) dcl 42 set ref 242* 259* nindex 0(18) based bit(18) array level 2 packed packed unaligned dcl 120 ref 247 nisacl 000251 automatic fixed bin(17,0) dcl 42 set ref 235* 254* nptr 000256 automatic pointer dcl 42 set ref 137* 223 223 228* 247 null builtin function dcl 100 ref 136 137 138 139 221 222 223 224 235 235 242 242 246 251 251 257 257 283 284 356 357 null_string_flag 10 000303 automatic bit(1) array level 2 packed packed unaligned dcl 71 set ref 178* 183* 184* 457 617 p1 parameter pointer dcl 272 in procedure "compare_seg_acl" ref 269 283 290 290 294 298 304 304 315 315 315 p1 parameter pointer dcl 345 in procedure "compare_dir_acl" ref 342 356 363 363 367 371 377 377 388 388 388 p2 parameter pointer dcl 345 in procedure "compare_dir_acl" ref 342 357 367 371 377 377 377 398 398 401 401 401 p2 parameter pointer dcl 272 in procedure "compare_seg_acl" ref 269 284 294 298 304 304 304 326 326 330 330 330 p_access_identifier parameter char dcl 449 ref 441 460 468 476 483 490 490 498 510 519 519 528 534 reverse builtin function dcl 100 ref 476 490 510 510 519 ring 000244 automatic fixed bin(3,0) dcl 42 set ref 218* 235* 242* rtrim builtin function dcl 100 ref 290 290 326 326 363 363 398 398 510 seg_acl 000514 automatic structure array level 1 dcl 103 segment_acl based structure array level 1 dcl 114 set ref 221 segment_type parameter fixed bin(17,0) dcl 272 set ref 269 304* 304* 304* 304* 315* 315* 330* 330* substr builtin function dcl 100 set ref 295* 323 368* 395 428 429* 592 599 619* 631* 641* t parameter fixed bin(17,0) dcl 415 ref 412 429 tcount 000102 automatic fixed bin(17,0) dcl 350 in procedure "compare_dir_acl" set ref 360* 369* 369 394 396* 396 tcount 000102 automatic fixed bin(17,0) dcl 277 in procedure "compare_seg_acl" set ref 287* 296* 296 322 324* 324 type based bit(2) array level 2 packed packed unaligned dcl 120 ref 249 user_id_name_length 000705 automatic fixed bin(17,0) dcl 570 set ref 584* 586 589 verify builtin function dcl 100 ref 592 x parameter bit(36) dcl 414 ref 412 428 NAMES DECLARED BY EXPLICIT CONTEXT. ACL_OK 002212 constant label dcl 319 in procedure "compare_seg_acl" ref 290 298 308 ACL_OK 002774 constant label dcl 391 in procedure "compare_dir_acl" ref 363 371 381 USAGE 000612 constant label dcl 198 check_iacl 000155 constant entry external dcl 20 cmode 003167 constant entry internal dcl 412 ref 304 304 304 304 315 315 330 330 377 377 377 377 388 388 401 401 compare_dir_acl 002405 constant entry internal dcl 342 ref 259 compare_seg_acl 001623 constant entry internal dcl 269 ref 254 head 004063 constant entry internal dcl 547 ref 302 313 328 375 386 399 inhibited 003247 constant entry internal dcl 441 ref 290 326 363 398 set_components 004113 constant entry internal dcl 558 ref 188 set_components_ERROR_RETURN 004347 constant label dcl 650 ref 581 594 604 set_components_NORMAL_RETURN 004346 constant label dcl 647 ref 612 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4676 4754 4407 4706 Length 5174 4407 56 204 267 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME check_iacl 584 external procedure is an external procedure. on unit on line 220 64 on unit compare_seg_acl 122 internal procedure uses auto adjustable storage. compare_dir_acl 122 internal procedure uses auto adjustable storage. cmode 70 internal procedure is called by several nonquick procedures. inhibited 76 internal procedure is called during a stack extension. head 76 internal procedure is called by several nonquick procedures. set_components internal procedure shares stack frame of external procedure check_iacl. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME check_iacl 000100 dn1 check_iacl 000152 dn check_iacl 000224 en1 check_iacl 000234 en check_iacl 000244 ring check_iacl 000245 allsw check_iacl 000246 got_path check_iacl 000247 headed check_iacl 000250 exclude_count check_iacl 000251 nisacl check_iacl 000252 nidacl check_iacl 000254 eptr check_iacl 000256 nptr check_iacl 000260 ecount check_iacl 000262 isaclp check_iacl 000264 idaclp check_iacl 000266 nacl check_iacl 000270 aclp check_iacl 000272 areap check_iacl 000274 arg_index check_iacl 000275 entry_index check_iacl 000276 arg_count check_iacl 000277 arg_len check_iacl 000300 arg_ptr check_iacl 000302 code check_iacl 000303 exclude check_iacl 000514 seg_acl check_iacl 000704 character_index set_components 000705 user_id_name_length set_components cmode 000100 ans cmode 000102 i cmode 000103 k cmode compare_dir_acl 000100 i compare_dir_acl 000101 j compare_dir_acl 000102 tcount compare_dir_acl 000103 aclbit compare_dir_acl compare_seg_acl 000100 i compare_seg_acl 000101 j compare_seg_acl 000102 tcount compare_seg_acl 000103 aclbit compare_seg_acl inhibited 000100 exclude_index inhibited THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_l_a r_e_as alloc_char_temp call_ext_out_desc call_ext_out call_int_this call_int_other_desc call_int_other return_mac alloc_auto_adj mpfx2 enable_op shorten_stack ext_entry int_entry int_entry_desc reverse_cs set_chars_eis op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. absolute_pathname_ com_err_ com_err_$suppress_name cu_$arg_count cu_$arg_ptr expand_pathname_ get_ring_ get_system_free_area_ get_wdir_ hcs_$list_acl hcs_$list_dir_acl hcs_$list_dir_inacl hcs_$list_inacl hcs_$star_ ioa_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_name error_table_$badopt error_table_$entlong error_table_$too_many_args LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 20 000154 129 000162 130 000172 131 000174 132 000211 135 000212 136 000213 137 000215 138 000216 139 000217 141 000220 143 000231 144 000234 146 000235 148 000245 149 000262 150 000264 151 000301 154 000302 155 000316 157 000331 158 000341 159 000342 160 000345 161 000372 164 000373 165 000410 166 000412 167 000436 170 000437 172 000440 173 000443 174 000467 177 000470 178 000475 179 000477 180 000500 181 000501 183 000514 184 000525 186 000543 188 000550 189 000551 190 000553 192 000554 193 000606 195 000607 197 000610 198 000612 200 000637 203 000640 205 000642 206 000666 207 000670 208 000722 211 000723 213 000725 215 000741 217 000765 218 000774 220 001005 221 001021 222 001032 223 001043 224 001052 225 001061 228 001062 229 001131 230 001133 231 001162 235 001163 236 001230 237 001232 238 001247 242 001250 244 001315 245 001325 246 001326 247 001330 249 001345 251 001351 252 001412 254 001447 255 001467 257 001470 258 001531 259 001566 261 001606 263 001610 265 001621 269 001622 277 001630 283 001640 284 001644 286 001650 287 001656 289 001660 290 001667 293 001741 294 001753 295 001775 296 002002 298 002004 301 002010 302 002013 304 002022 308 002122 310 002123 312 002125 313 002130 315 002137 319 002212 322 002214 323 002227 324 002235 326 002237 328 002312 330 002323 333 002401 335 002403 342 002404 350 002412 356 002422 357 002426 359 002432 360 002440 362 002442 363 002451 366 002523 367 002535 368 002557 369 002564 371 002566 374 002572 375 002575 377 002604 381 002704 383 002705 385 002707 386 002712 388 002721 391 002774 394 002776 395 003011 396 003017 398 003021 399 003074 401 003105 404 003163 406 003165 412 003166 424 003174 425 003176 427 003200 428 003205 429 003213 430 003222 432 003223 434 003225 435 003237 441 003246 455 003262 457 003273 460 003301 462 003330 465 003331 468 003333 470 003351 472 003352 474 003354 476 003362 478 003407 480 003410 483 003413 485 003467 487 003470 490 003472 493 003545 498 003546 501 003562 504 003563 507 003577 510 003607 513 003670 515 003671 519 003700 522 003753 524 003754 528 003761 530 004035 534 004036 539 004052 541 004054 547 004062 549 004070 551 004107 552 004112 558 004113 577 004114 579 004115 580 004120 581 004123 584 004124 586 004140 589 004146 592 004150 593 004170 594 004173 598 004174 599 004203 600 004216 602 004220 603 004223 604 004226 607 004227 609 004233 612 004235 617 004254 619 004261 624 004273 626 004275 631 004307 632 004316 634 004317 636 004324 641 004337 647 004346 650 004347 652 004377 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved