COMPILATION LISTING OF SEGMENT mail Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Bull, Phx. Az., Sys-M Compiled on: 05/20/87 1424.3 mst Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Bull Inc., 1987 * 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 15 /****^ HISTORY COMMENTS: 16* 1) change(86-06-02,Herbst), approve(86-06-02,MCR7432), audit(86-06-30,Wong), 17* install(86-06-30,MR12.0-1080): 18* Fixed to zero unused portions of mail_format. 19* 2) change(87-02-26,Lippard), approve(87-03-18,MECR0001), 20* audit(87-03-12,Fawcett), install(87-03-19,MR12.1-1002): 21* Modified to strip control characters from message comment field. 22* 3) change(87-05-08,Lippard), approve(87-04-20,MCR7669), 23* audit(87-05-11,Fawcett), install(87-05-20,MR12.1-1032): 24* Formal installation to close out MECR0001. 25* END HISTORY COMMENTS */ 26 27 28 mail: ml: proc; 29 30 /* Usage: 31* mail to read own mail 32* mail -path- to read any mail 33* mail path user1_ proj1_ ... user_i proj_i to send a segment 34* mail * user1_ proj1_ ... user_i proj_i to send console input 35* 36* Mailbox names end in ".mbx" */ 37 38 39 /* -notify and -no_notify added 7/27/78 by S. Herbst */ 40 /* Modified: 1 May 1985 by G. Palter to remove reference to mseg_hdr.incl.pl1 */ 41 1 1 /* BEGIN Mailbox Message Include File (mail_format.incl.pl1) */ 1 2 1 3 1 4 /****^ HISTORY COMMENTS: 1 5* 1) change(86-01-09,Herbst), approve(86-03-25,MCR7367), 1 6* audit(86-04-28,Margolin), install(86-05-22,MR12.0-1059): 1 7* Added "seen" switch. 1 8* 2) change(86-06-02,Herbst), approve(86-06-02,MCR7367), audit(86-06-30,Wong), 1 9* install(86-06-30,MR12.0-1080): 1 10* Updated to version 4 for seen switch. 1 11* END HISTORY COMMENTS */ 1 12 1 13 /* Last modified by K. T. Pogran, 3/6/75 */ 1 14 /* Modified by D. M. Wells, August 10, 1977 for v4 message segments. */ 1 15 /* Modified: 3 June 1981 by G. Palter for mail system subroutine interface */ 1 16 1 17 declare mail_format_ptr pointer aligned; 1 18 1 19 declare MAIL_FORMAT_VERSION_4 initial (4) 1 20 fixed bin internal static options (constant); 1 21 1 22 declare text_length fixed bin (21); 1 23 1 24 declare 1 mail_format aligned based (mail_format_ptr), 1 25 2 header, 1 26 3 version fixed bin (17), 1 27 3 sent_from char (32) aligned, 1 28 3 lines fixed bin (17), 1 29 3 text_len fixed bin (21), 1 30 3 switches aligned, 1 31 4 wakeup bit (1) unaligned, 1 32 4 urgent bit (1) unaligned, 1 33 4 notify bit (1) unaligned, 1 34 4 acknowledge bit (1) unaligned, 1 35 4 obsolete bit (1) unaligned, 1 36 4 canonical bit (1) unaligned, 1 37 4 seen bit (1) unaligned, 1 38 4 others bit (65) unaligned, 1 39 2 text char(text_length refer (mail_format.header.text_len)) aligned; 1 40 1 41 /* END Mailbox Message Include File (mail_format.incl.pl1) */ 42 /* this based structure should call the ASCII part "text" */ 43 dcl 1 send_mail_info aligned, /* structure for sending acknowledgement message */ 44 2 version fixed bin, /* = 1 */ 45 2 from char (32) aligned, 46 2 switches, 47 3 wakeup bit (1) unal, 48 3 mbz1 bit (1) unal, 49 3 always_add bit (1) unal, 50 3 never_add bit (1) unal, 51 3 mbz2 bit (1) unal, 52 3 acknowledge bit (1) unal, 53 3 mbz bit (30) unal; 54 55 dcl area area based (areap); 56 57 dcl segment char (4096) based (segp); 58 dcl page char (4096) aligned; 59 dcl node_space (48) ptr aligned; /* space for first 24 deletion nodes */ 60 61 dcl alphabet char (256) init /* alphabetics plus BS HT NL RRS BRS */ 62 ((8)" " || " 63 " || (3)" " || "" || (16)" " || substr (collate (), 33)); 64 dcl BS char (1) internal static options (constant) init (""); 65 dcl (buffer, dn) char (168); 66 dcl (en, last_sender, last_sent_from, sender, sender_name) char (32); 67 dcl atime char (24); 68 dcl (match_person, match_project) char (32) init ("*"); 69 dcl (exclude_person, exclude_project) char (32) init ("."); 70 dcl name char (22); 71 dcl proj char (9); 72 dcl vname char (22) varying; 73 dcl vproj char (9) varying; 74 dcl last_date char (8); 75 dcl command char (7); 76 dcl answer char (3) varying; 77 dcl s char (1) init (""); 78 dcl nlx char (1); 79 dcl newline char (1) init (" 80 "); 81 82 dcl arg char (al) based (ap); 83 84 dcl node (24) char (16) aligned based (stack_ptr); /* deletion nodes */ 85 86 dcl stack_bits bit (3456) aligned based (stack_ptr); 87 dcl clock bit (54) aligned; 88 dcl exmode bit (36) aligned; 89 dcl (acknowledge, /* request acknowledgement when sending */ 90 brief, /* -brief option when reading */ 91 head_mode, /* -header mode when reading */ 92 dont_print_count, 93 console, /* sending console input */ 94 got_input, /* already copied into "page" */ 95 more, /* more input in input mode */ 96 my_mbx, /* reading from user's own mailbox */ 97 notify_sw, /* send notification with the mail */ 98 own, /* reading own messages */ 99 path_sw, /* read mail by pathname */ 100 pdir_flag, /* save mail in process directory */ 101 printing, /* printing mail */ 102 salvaged, /* mailbox was salvaged */ 103 saved, /* already saved in unsent_mail */ 104 seg_initiated) /* initiated a segment to send */ 105 bit (1) aligned init ("0"b); 106 107 dcl (al, anonymous, arg_count, argno, chars, header_length, i, msg_bitcnt, nlines) fixed bin; 108 dcl (count, mseg_index) fixed bin init (0); 109 dcl node_index fixed bin init (0); 110 dcl (last_type, interactive init (1), mail_type init (2)) fixed bin; 111 dcl (five_minutes, last_time, time) fixed bin (71); 112 dcl bitcnt fixed bin (24); 113 dcl j fixed bin (21); 114 dcl mode fixed bin (5); 115 dcl chase fixed bin (1) init (1); 116 117 dcl (ap, argp, idp, node_ptr) pointer; 118 dcl (areap, mbxp, segp) pointer init (null); 119 dcl stack_ptr ptr; 120 121 dcl 1 id_node aligned based, 122 2 next pointer aligned, 123 2 delete_id bit (72) aligned; /* message id saved for deletion */ 124 125 dcl 1 mseg_return_args aligned, 126 2 msg_ptr pointer, /* -> returned message */ 127 2 bitcnt fixed bin (18), /* bit count of message */ 128 2 sender_id char (32), /* sender's group id */ 129 2 level fixed bin, /* validation level */ 130 2 id bit (72), /* loc_and_time */ 131 2 sender_authorization bit (72), 132 2 access_class bit (72); 133 134 dcl 1 query_info aligned internal static, 135 2 vsn fixed bin init (1), 136 2 yes_or_no_sw bit (1) unaligned init ("1"b), 137 2 suppress_name_sw bit (1) unaligned init ("0"b), 138 2 status_code fixed bin (35) init (0), 139 2 query_code fixed bin (35) init (0); 140 141 dcl canonicalize_ entry (ptr, fixed bin(21), ptr, fixed bin(21), fixed bin(35)); 142 dcl com_err_ entry options (variable); 143 dcl command_query_ entry options (variable); 144 dcl cu_$arg_count entry (fixed bin); 145 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 146 dcl cu_$grow_stack_frame entry (fixed bin, ptr, fixed bin (35)); 147 dcl date_time_ entry (fixed bin (71), char (*)); 148 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 149 dcl expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35)); 150 dcl get_system_free_area_ entry returns (ptr); 151 dcl get_pdir_ entry returns (char (168)aligned); 152 dcl get_wdir_ entry returns (char (168)aligned); 153 dcl hcs_$delentry_file entry (char (*), char (*), fixed bin (35)); 154 dcl hcs_$fs_get_mode entry (ptr, fixed bin (5), fixed bin (35)); 155 dcl hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35)); 156 dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); 157 dcl hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)); 158 dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); 159 dcl ioa_ entry options (variable); 160 dcl ioa_$nnl entry options (variable); 161 dcl ioa_$rsnnl entry options (variable); 162 dcl iox_$get_line entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)); 163 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 164 dcl iox_$user_input pointer external; 165 dcl iox_$user_output pointer external; 166 dcl send_mail_ entry (char (*)aligned, char (*)aligned, ptr, fixed bin (35)); 167 dcl send_message_$notify_mail entry (char (*), char (*), fixed bin (35)); 168 dcl user_info_ entry (char (*)); 169 dcl user_info_$login_data entry (char (*), char (*), char (*), fixed bin); 170 dcl mailbox_$add_index entry (fixed bin, ptr, fixed bin, bit (72)aligned, fixed bin (35)); 171 dcl mailbox_$check_salv_bit_index entry (fixed bin, bit (1)aligned, bit (1)aligned, fixed bin (35)); 172 dcl mailbox_$close entry (fixed bin (17), fixed bin (35)); 173 dcl mailbox_$create entry (char (*), char (*), fixed bin (35)); 174 dcl mailbox_$delete_index entry (fixed bin, bit (72)aligned, fixed bin (35)); 175 dcl mailbox_$get_mode_index entry (fixed bin, bit (*)aligned, fixed bin (35)); 176 dcl mailbox_$incremental_read_index entry (fixed bin, ptr, bit (2), bit (72)aligned, ptr, fixed bin (35)); 177 dcl mailbox_$open entry (char (*), char (*), fixed bin, fixed bin (35)); 178 dcl mailbox_$open_if_full entry (char (*), char (*), bit (1) aligned, 179 fixed bin (17), fixed bin (17), fixed bin (35)); 180 dcl mailbox_$own_incremental_read_index entry (fixed bin, ptr, bit (2), bit (72)aligned, ptr, fixed bin (35)); 181 dcl mailbox_$own_read_index entry (fixed bin, ptr, bit (1), ptr, fixed bin (35)); 182 dcl mailbox_$read_index entry (fixed bin, ptr, bit (1), ptr, fixed bin (35)); 183 dcl mailbox_$update_message_index entry (fixed bin, fixed bin, bit (72)aligned, ptr, fixed bin (35)); 184 185 186 dcl code fixed bin (35); 187 dcl error_table_$bad_segment fixed bin (35) external; 188 dcl error_table_$badopt fixed bin (35) external; 189 dcl error_table_$long_record fixed bin (35) external; 190 dcl error_table_$moderr fixed bin (35) external; 191 dcl error_table_$noentry fixed bin (35) external; 192 dcl error_table_$no_message fixed bin (35) external; 193 dcl error_table_$root fixed bin (35) ext; 194 dcl error_table_$rqover fixed bin (35) external; 195 196 dcl (cleanup, no_write_permission, program_interrupt, record_quota_overflow) condition; 197 198 dcl (addr, bin, collate, divide, fixed, index, length, min, null) builtin; 199 dcl (rel, reverse, rtrim, search, size, substr, translate, unspec, verify) builtin; 200 /* */ 201 mail_format_ptr = null; 202 on condition (cleanup) call mail_cleanup; 203 command = "mail"; 204 call cu_$arg_count (arg_count); 205 buffer = ""; 206 path_sw = "0"b; 207 do i = 1 to arg_count; 208 call cu_$arg_ptr (i, ap, al, code); 209 if substr (arg, 1, 1) = "-" then 210 if arg = "-brief" | arg = "-bf" then brief = "1"b; 211 else if arg = "-header" | arg = "-he" then head_mode = "1"b; 212 else if arg = "-match" then do; 213 dont_print_count = "1"b; 214 i = i + 1; 215 if i>arg_count then do; 216 call com_err_ (0, command, "No value specified for -match"); 217 return; 218 end; 219 call cu_$arg_ptr (i, ap, al, code); 220 j = index (arg, "."); 221 if j = 0 then match_person = arg; 222 else do; 223 match_person = substr (arg, 1, j-1); 224 match_project = substr (arg, j+1); 225 end; 226 end; 227 else if arg = "-exclude" | arg = "-ex" then do; 228 dont_print_count = "1"b; 229 i = i + 1; 230 if i>arg_count then do; 231 call com_err_ (0, command, "No value specified for -exclude"); 232 return; 233 end; 234 call cu_$arg_ptr (i, ap, al, code); 235 j = index (arg, "."); 236 if j = 0 then exclude_person = arg; 237 else do; 238 exclude_person = substr (arg, 1, j-1); 239 exclude_project = substr (arg, j+1); 240 end; 241 end; 242 else if arg = "-acknowledge" | arg = "-ack" then go to SEND; 243 else if arg = "-notify" | arg = "-nt" then go to SEND; 244 else if arg = "-no_notify" | arg = "-nnt" then go to SEND; 245 else if arg = "-pathname" | arg = "-pn" then do; 246 if buffer ^= "" then go to SEND; 247 i = i+1; 248 if i>arg_count then do; 249 call com_err_ (0, command, "No value specified for -pathname"); 250 return; 251 end; 252 call cu_$arg_ptr (i, ap, al, code); 253 buffer = arg; 254 path_sw = "1"b; 255 end; 256 else do; 257 call com_err_ (error_table_$badopt, command, "^a", arg); 258 return; 259 end; 260 else if buffer ^= "" then go to SEND; 261 else buffer = arg; 262 end; 263 if buffer = "" then do; 264 265 /* Read from default mailbox */ 266 267 READ: my_mbx = "1"b; 268 bitcnt = 0; 269 call user_info_$login_data (name, proj, "", anonymous); 270 if anonymous = 1 then do; /* anonymous user */ 271 dn = ">udd>" || rtrim (proj) || ">anonymous"; 272 en = "anonymous.mbx"; 273 end; 274 else do; 275 dn = ">udd>" || rtrim (proj) || ">" || name; 276 en = rtrim (name) || ".mbx"; 277 end; 278 call mailbox_$open_if_full (dn, en, salvaged, count, mseg_index, code); 279 if code = error_table_$noentry then do; 280 281 /* Create a new mailbox */ 282 283 on condition (record_quota_overflow) begin; 284 call com_err_ (error_table_$rqover, command, "Unable to create default mailbox."); 285 go to RETURN; 286 end; 287 288 call mailbox_$create (dn, en, code); 289 if code ^= 0 then do; 290 call com_err_ (code, command, "Unable to create default mailbox."); 291 go to RETURN; 292 end; 293 294 revert condition (record_quota_overflow); 295 296 call ioa_ ("^a>^a created. No mail.", dn, en); 297 return; 298 end; 299 end; 300 else do; 301 302 /* Read from specified mailbox */ 303 304 if buffer = ">" then do; 305 code = error_table_$root; 306 go to ERROR2; 307 end; 308 else if search (buffer, "<>") ^= 0 | path_sw then do; /* mbx pathname */ 309 call expand_pathname_$add_suffix (buffer, "mbx", dn, en, code); 310 if code ^= 0 then go to ERROR2; 311 end; 312 else do; /* Person.Project destination */ 313 i = index (buffer, "."); 314 if i = 0 then do; 315 call com_err_ (0, command, "No project specified for ^a", buffer); 316 return; 317 end; 318 call ioa_$rsnnl (">udd>^a>^a", dn, 168, substr (buffer, i+1), substr (buffer, 1, i-1)); 319 en = substr (buffer, 1, i-1)||".mbx"; 320 end; 321 call mailbox_$open_if_full (dn, en, salvaged, count, mseg_index, code); 322 end; 323 324 if code ^= 0 & (code ^= error_table_$moderr | mseg_index = 0) then go to ERROR1; 325 326 if salvaged then do; 327 if my_mbx then call mailbox_$check_salv_bit_index (mseg_index, "1"b, salvaged, code); 328 call ioa_ ("Mailbox ^a^[>^]^a has been salvaged since mail was last read. 329 Messages may have been lost.", dn, dn ^= ">", en); 330 end; 331 if code = 0 then do; 332 if count = 0 then do; 333 if ^brief then 334 call ioa_ ("No mail."); 335 go to CLOSE; 336 end; 337 if count>1 then s = "s"; /* plural */ 338 if ^dont_print_count then 339 call ioa_ ("^d message^a.", count, s); 340 if brief then go to CLOSE; 341 end; 342 343 areap = get_system_free_area_ (); 344 argp = addr (mseg_return_args); 345 346 call mailbox_$read_index (mseg_index, areap, "0"b, argp, code); /* read earliest message first */ 347 if code ^= 0 then 348 if code = error_table_$no_message then do; 349 if ^brief then call ioa_ ("No mail."); 350 go to CLOSE; 351 end; 352 else if code = error_table_$moderr then own = "1"b; 353 else go to ERROR1; 354 355 if own then do; 356 call mailbox_$own_read_index (mseg_index, areap, "0"b, argp, code); 357 if code ^= 0 then if code = error_table_$no_message then do; 358 if ^brief then call ioa_ ("You have no messages in ^a^[>^]^a.", dn, dn ^= ">", en); 359 go to CLOSE; 360 end; 361 else go to ERROR1; 362 else if brief then do; 363 call ioa_ ("You have messages in ^a^[>^]^a", dn, dn ^= ">", en); 364 go to CLOSE; 365 end; 366 else call ioa_ ("^/Your messages:^/"); 367 end; 368 369 printing = "1"b; 370 371 on condition (program_interrupt) begin; /* pi turns off printing */ 372 printing = "0"b; 373 go to REMEMBER; 374 end; 375 376 last_type = mail_type; /* initialize some variables */ 377 last_sender, last_date = ""; 378 last_time = 0; 379 five_minutes = (3*10**8)* (2**18); 380 idp, stack_ptr = addr (node_space); 381 idp -> stack_bits = "0"b; 382 383 do count = 1 by 1 while (code = 0); /* if a message is deleted while in this loop, 384* all messages after it won't get printed. 385* They will appear with next "mail". */ 386 mail_format_ptr = msg_ptr; 387 388 if ^printing then go to REMEMBER; 389 390 clock = substr (id, 19, 54); 391 unspec (time) = clock; 392 call date_time_ (bin (clock, 71), atime); 393 if lines ^= 1 then s = "s"; 394 else s = ""; 395 i = index (mseg_return_args.sender_id, " "); /* remove instance tag */ 396 if i = 0 then i = 33; 397 sender = substr (mseg_return_args.sender_id, 1, i-3); 398 j = index (sender, "."); 399 if exclude_person = "*" | exclude_person = substr (sender, 1, j-1) then go to RNEXT; 400 if exclude_project = "*" | exclude_project = substr (sender, j+1) then go to RNEXT; 401 if match_person ^= "*" & match_person ^= substr (sender, 1, j-1) then go to RNEXT; 402 if match_project ^= "*" & match_project ^= substr (sender, j+1) then go to RNEXT; 403 if head_mode then nlx = ""; else nlx = newline; 404 405 if mail_format.wakeup then do; /* interractive message */ 406 if last_type = mail_type then do; 407 call ioa_ (""); 408 last_sender = ""; 409 end; 410 if sender = last_sender & sent_from = last_sent_from & ^head_mode then do; 411 if time-last_time>five_minutes then 412 if substr (atime, 1, 8) ^= last_date then call ioa_$nnl ("=:(^a) ", atime); 413 else call ioa_$nnl ("=:(^a) ", substr (atime, index (atime, ".")-4, 6)); 414 else call ioa_$nnl ("=: "); 415 end; 416 else if sent_from = "" | sent_from = sender 417 | sent_from = substr (sender, 1, length (sender)-index (reverse (sender), ".")) then 418 call ioa_ ("^aMessage from ^a ^a:", nlx, sender, atime); 419 else call ioa_ ("^aMessage from ^a (^a) ^a:", nlx, sender, rtrim (canon (rtrim (sent_from), length (rtrim (sent_from)))), atime); 420 last_type = interactive; 421 last_sender = sender; 422 last_sent_from = sent_from; 423 last_time = time; 424 last_date = substr (atime, 1, 8); 425 end; 426 427 else do; 428 last_type = mail_type; 429 if sent_from = "" | sent_from = sender 430 | sent_from = substr (sender, 1, length (sender)-index (reverse (sender), ".")) 431 then call ioa_ ("^a^d) From: ^a ^a^[ (^d line^a)^;^s^s^]^a", 432 nlx, count, sender, atime, (lines > 0), lines, s, nlx); 433 else call ioa_ ("^a^d) From: ^a (^a) ^a^[ (^d line^a)^;^2s^]^a", 434 nlx, count, rtrim (canon (rtrim (sent_from), length (rtrim (sent_from)))), sender, atime, (lines > 0), lines, s, nlx); 435 end; 436 437 /* Print the message */ 438 439 if ^head_mode then do; 440 i = 1; 441 do while (i <= mail_format.text_len); 442 j = min (mail_format.text_len-i+1, length (buffer)); 443 buffer = rtrim (canon (substr (mail_format.text, i, j), length (substr (mail_format.text, i, j)))); 444 call iox_$put_chars (iox_$user_output, addr (buffer), j, code); 445 i = i+j; 446 end; 447 if substr (buffer, j, 1) ^= newline then call ioa_ (""); 448 449 /* Acknowledge the message */ 450 451 if mail_format.acknowledge then do; 452 453 send_mail_info.version = 1; 454 send_mail_info.from = ""; 455 send_mail_info.wakeup = "1"b; 456 send_mail_info.mbz1 = "0"b; 457 send_mail_info.always_add = "1"b; 458 send_mail_info.never_add = "0"b; 459 send_mail_info.mbz2 = "0"b; 460 send_mail_info.acknowledge = "0"b; 461 send_mail_info.mbz = "0"b; 462 clock = substr (mseg_return_args.id, 19, 54); 463 unspec (time) = clock; 464 call date_time_ (bin (clock, 71), atime); 465 i = length (mseg_return_args.sender_id)+1-verify (reverse (mseg_return_args.sender_id), " "); 466 467 call send_mail_ (substr (mseg_return_args.sender_id, 1, i-2), 468 "Acknowledge message of "||atime, addr (send_mail_info), code); 469 470 mail_format.acknowledge = "0"b; /* turn off acknowledge bit in message */ 471 call mailbox_$update_message_index (mseg_index, 472 36 * (fixed (rel (addr (mail_format.text)))-fixed (rel (addr (mail_format.version)))), 473 mseg_return_args.id, mseg_return_args.msg_ptr, code); 474 end; 475 end; 476 477 /* Remember to delete later */ 478 479 REMEMBER: if ^head_mode then do; 480 call get_id_node; 481 idp -> id_node.next = node_ptr; 482 idp = node_ptr; 483 idp -> id_node.next = null; 484 idp -> id_node.delete_id = id; 485 end; 486 487 /* Read the next message */ 488 489 RNEXT: free mail_format in (area); 490 491 if own then call mailbox_$own_incremental_read_index (mseg_index, areap, "01"b, id, argp, code); 492 else call mailbox_$incremental_read_index (mseg_index, areap, "01"b, id, argp, code); 493 494 end; 495 496 revert condition (program_interrupt); 497 on condition (program_interrupt) go to QUERY; 498 499 if code ^= error_table_$no_message then go to ERROR1; 500 501 QUERY: if node_index = 0 then answer = "no"; 502 else call command_query_ (addr (query_info), answer, command, "Delete?"); 503 revert condition (program_interrupt); 504 if answer ^= "yes" then go to CLOSE; 505 506 count = 0; 507 idp = addr (node_space); 508 do while (idp ^= null); 509 count = count+1; 510 call mailbox_$delete_index (mseg_index, idp -> id_node.delete_id, code); 511 if code ^= 0 then do; 512 call com_err_ (code, command, "Message ^d not deleted.", count); 513 code = 0; 514 end; 515 idp = idp -> id_node.next; 516 end; 517 518 go to CLOSE; 519 /* */ 520 /* Send mail */ 521 522 SEND: notify_sw = "1"b; 523 do i = 1 to arg_count; 524 call cu_$arg_ptr (i, ap, al, code); 525 if substr (arg, 1, 1) = "-" then /* look for control arguments */ 526 if arg = "-acknowledge" | arg = "-ack" then acknowledge = "1"b; 527 else if arg = "-notify" | arg = "-nt" then notify_sw = "1"b; 528 else if arg = "-no_notify" | arg = "-nnt" then notify_sw = "0"b; 529 else if arg ^= "-pathname" & arg ^= "-pn" then do; 530 call com_err_ (error_table_$badopt, "mail", "^a", arg); 531 return; 532 end; 533 end; 534 535 on condition (record_quota_overflow) begin; /* from adding a message */ 536 call com_err_ (error_table_$rqover, command, 537 "Unable to add message to mailbox ^a^[>^]^a", dn, dn ^= ">", en); 538 call save; 539 go to RETURN; 540 end; 541 542 argno = 1; 543 GET_PATH: call cu_$arg_ptr (argno, ap, al, code); 544 argno = argno+1; 545 if substr (arg, 1, 1) = "-" then go to GET_PATH; 546 buffer = arg; 547 if buffer = ">" then do; 548 code = error_table_$root; 549 go to ERROR2; 550 end; 551 text_length = 0; 552 mail_format_ptr = null; 553 call user_info_ (sender_name); 554 555 SEND_LOOP: 556 call cu_$arg_ptr (argno, ap, al, code); 557 if code ^= 0 then do; /* Normal exit - no more destinations */ 558 CLEANUP: call mail_cleanup; 559 return; 560 end; 561 if substr (arg, 1, 1) = "-" then 562 if arg = "-pathname" | arg = "-pn" then do; 563 argno = argno + 1; 564 call cu_$arg_ptr (argno, ap, al, code); 565 if code ^= 0 then do; 566 call com_err_ (0, command, "No value specified for -pathname"); 567 return; 568 end; 569 call expand_pathname_$add_suffix (arg, "mbx", dn, en, code); 570 if code ^= 0 then do; 571 call com_err_ (code, command, "^a", arg); 572 return; 573 end; 574 go to OPEN; 575 end; 576 else do; 577 argno = argno+1; 578 go to SEND_LOOP; 579 end; 580 i = index (arg, "."); 581 if i ^= 0 then do; /* Person.Project destination */ 582 argno = argno-1; 583 name, vname = substr (arg, 1, i-1); 584 proj, vproj = substr (arg, i+1); 585 end; 586 else do; 587 name, vname = arg; 588 GET_PROJ: call cu_$arg_ptr (argno+1, ap, al, code); 589 if code ^= 0 then do; 590 NO_PROJ: call com_err_ (0, command, "No project name specified for ^a.", vname); 591 call save; 592 return; 593 end; 594 if substr (arg, 1, 1) = "-" then 595 if arg = "-pathname" | arg = "-pn" then go to NO_PROJ; 596 else do; 597 argno = argno+1; 598 go to GET_PROJ; 599 end; 600 proj, vproj = arg; /* project id for concatenating */ 601 end; 602 en = vname || ".mbx"; 603 dn = ">udd>" || vproj || ">" || vname; 604 605 OPEN: call mailbox_$open (dn, en, mseg_index, code); /* get index of mailbox */ 606 if code ^= 0 then do; 607 call com_err_ (code, command, "^a^[>^]^a", dn, dn ^= ">", en); 608 call save; 609 go to NEXT; 610 end; 611 else do; 612 call mailbox_$get_mode_index (mseg_index, exmode, code); /* get effective access to mailbox */ 613 if ^substr (exmode, 1, 1) then do; /* no "a" access */ 614 call com_err_ (0, command, 615 "Insufficient access to send to ^a^[>^]^a", dn, dn ^= ">", en); 616 call save; 617 go to NEXT; 618 end; 619 end; 620 621 if ^got_input then do; /* copy the message in once */ 622 623 areap = get_system_free_area_ (); 624 625 nlines = 0; 626 if buffer = "*" then do; /* console input */ 627 console = "1"b; 628 got_input = "1"b; 629 segp = addr (page); 630 631 on condition (program_interrupt) begin; /* pi saves what is typed so far and quits */ 632 call save; 633 go to CLOSE; 634 end; 635 636 call ioa_ ("Input:"); 637 638 more = "1"b; 639 do while (more); 640 call iox_$get_line (iox_$user_input, addr (buffer), 168, j, code); 641 if code ^= 0 then if code ^= error_table_$long_record then do; 642 call save; 643 buffer = "user_input"; 644 go to ERROR2; 645 end; 646 647 if j = 2 & substr (buffer, 1, 1) = "." then more = "0"b; /* dot ends input mode */ 648 else do; 649 if text_length+j>4096 then do; 650 call com_err_ (0, command, "Message cannot be longer than 1 record."); 651 call save; 652 return; 653 end; 654 if code ^= error_table_$long_record then nlines = nlines + 1; 655 substr (segp -> segment, text_length+1, j) = substr (buffer, 1, j); /* copy the line in */ 656 text_length = text_length+j; 657 end; 658 end; 659 660 revert condition (program_interrupt); 661 if nlines = 0 then return; 662 bitcnt = text_length*9; 663 end; 664 else do; /* input is a segment */ 665 got_input = "1"b; 666 call expand_pathname_ (rtrim (buffer), dn, en, code); 667 if code ^= 0 then go to ERROR2; 668 669 call hcs_$initiate_count (dn, en, "", bitcnt, 1, segp, code); 670 if segp = null then go to ERROR1; 671 672 seg_initiated = "1"b; 673 674 call hcs_$fs_get_mode (segp, mode, code); /* see if access to read */ 675 if mode<1000b then if code = 0 then do; 676 call com_err_ (0, command, "Need ""r"" access to ^a^[>^]^a", dn, dn ^= ">", en); 677 call hcs_$terminate_noname (segp, code); 678 go to CLOSE; 679 end; 680 text_length = divide (bitcnt+8, 9, 17, 0); 681 chars = text_length; 682 if text_length>4096 then do; 683 call com_err_ (0, command, "Message cannot be longer than 1 record."); 684 go to CLOSE; 685 end; 686 count = 1; 687 NL_LOOP: i = index (substr (segp -> segment, count, chars), newline); 688 if i>0 then do; 689 count = count+i; 690 chars = chars-i; 691 nlines = nlines+1; /* count newlines in input segment */ 692 go to NL_LOOP; 693 end; 694 end; 695 end; 696 697 allocate mail_format in (area) set (mail_format_ptr); 698 header_length = size (mail_format)-divide (text_length, 4, 17, 0); 699 mail_format.version = MAIL_FORMAT_VERSION_4; 700 mail_format.sent_from = sender_name; /* login name */ 701 mail_format.lines = nlines; 702 mail_format.acknowledge = acknowledge; 703 mail_format.wakeup, mail_format.urgent, mail_format.seen, mail_format.others = "0"b; 704 mail_format.text = substr (segp -> segment, 1, text_length); 705 msg_bitcnt = bitcnt+36*header_length; /* total bit count includes header */ 706 707 call mailbox_$add_index (mseg_index, mail_format_ptr, msg_bitcnt, id, code); /* try to add the message */ 708 if code ^= 0 then 709 if code = error_table_$bad_segment then go to ERROR1; 710 else do; 711 call com_err_ (code, command, 712 "Unable to add message to mailbox ^a^[>^]^a", dn, dn ^= ">", en); 713 call save; 714 end; 715 716 else if notify_sw then call send_message_$notify_mail (name, proj, code); /* send notification */ 717 718 NEXT: argno = argno+2; /* on to the next pair */ 719 call mailbox_$close (mseg_index, code); 720 go to SEND_LOOP; 721 /* */ 722 /* save a message in working_dir>unsent_mail */ 723 724 save: proc; 725 726 if saved then return; /* do not save twice */ 727 if ^console | ^got_input then return; 728 if text_length = 0 then return; 729 saved = "1"b; 730 dn = get_wdir_ (); 731 732 on condition (record_quota_overflow) begin; /* from unsent_mail */ 733 call hcs_$delentry_file (dn, "unsent_mail", code); 734 if ^pdir_flag then go to TRY_PDIR; 735 call com_err_ (error_table_$rqover, command, 736 "Unable to save message in unsent_mail."); 737 go to CLEANUP; 738 end; 739 740 CREATE: call hcs_$make_seg (dn, "unsent_mail", "", 1011b, mbxp, code); 741 if mbxp = null then do; 742 if ^pdir_flag then go to TRY_PDIR; 743 call com_err_ (code, command, "Unable to save message in unsent_mail."); 744 go to CLOSE; 745 end; 746 747 on condition (no_write_permission) begin; 748 if ^pdir_flag then go to TRY_PDIR; 749 end; 750 751 substr (mbxp -> segment, 1, text_length) = substr (segp -> segment, 1, text_length); 752 753 bitcnt = text_length*9; 754 call hcs_$set_bc_seg (mbxp, bitcnt, code); 755 756 if pdir_flag then call ioa_ ("Text was saved in unsent_mail in process directory."); 757 else call ioa_ ("Text was saved in unsent_mail."); 758 759 return; 760 761 762 TRY_PDIR: pdir_flag = "1"b; 763 dn = get_pdir_ (); 764 go to CREATE; 765 766 end save; 767 /* */ 768 ERROR1: if code = error_table_$bad_segment then do; 769 call com_err_ (code, command, 770 "^a^[>^]^a^/Mailbox has been salvaged. Try again.", dn, dn ^= ">", en); 771 call save; 772 end; 773 else call com_err_ (code, command, "^a^[>^]^a", dn, dn ^= ">", en); 774 go to CLOSE; 775 776 ERROR2: call com_err_ (code, command, "^a", buffer); 777 778 CLOSE: if ^my_mbx & mseg_index ^= 0 then call mailbox_$close (mseg_index, code); 779 if seg_initiated then call hcs_$terminate_noname (segp, code); 780 781 RETURN: return; 782 783 784 /* This procedure removes control characters (except backspace, tab, 785* red ribbon shift, and black ribbon shift) and canonicalizes strings 786* to prevent backspacing past the front of the string. */ 787 canon: procedure (P_string, P_string_len) returns (char (*)); 788 dcl P_string char (*) parm; 789 dcl P_string_len fixed bin (21) parm; 790 dcl output_string char (P_string_len); 791 792 P_string = translate (P_string, alphabet); 793 if index (P_string, BS) ^= 0 then do; 794 output_string = ""; 795 call canonicalize_ (addr (P_string), length (P_string), addr (output_string), P_string_len, (0)); 796 return (output_string); 797 end; 798 else return (P_string); 799 end canon; 800 801 get_id_node: proc; 802 803 node_index = node_index+1; 804 if node_index>24 then do; /* allocate another block of 24 */ 805 call cu_$grow_stack_frame (96, stack_ptr, code); 806 stack_bits = "0"b; 807 node_index = 1; 808 end; 809 node_ptr = addr (node (node_index)); 810 811 end get_id_node; 812 813 814 mail_cleanup: proc; 815 816 if mail_format_ptr ^= null then free mail_format in (area); 817 if mbxp ^= null then call hcs_$terminate_noname (mbxp, code); 818 if ^my_mbx & mseg_index ^= 0 then call mailbox_$close (mseg_index, code); 819 if seg_initiated then call hcs_$terminate_noname (segp, code); 820 821 end mail_cleanup; 822 823 end mail; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/20/87 1423.2 mail.pl1 >spec>install>1032>mail.pl1 42 1 06/30/86 2023.8 mail_format.incl.pl1 >ldd>include>mail_format.incl.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. BS constant char(1) initial unaligned dcl 64 ref 793 MAIL_FORMAT_VERSION_4 constant fixed bin(17,0) initial dcl 1-19 ref 699 P_string parameter char unaligned dcl 788 set ref 787 792* 792 793 795 795 795 795 798 P_string_len parameter fixed bin(21,0) dcl 789 set ref 787 790 795* acknowledge 11(05) 000103 automatic bit(1) level 3 in structure "send_mail_info" packed unaligned dcl 43 in procedure "ml" set ref 460* acknowledge 13(03) based bit(1) level 4 in structure "mail_format" packed unaligned dcl 1-24 in procedure "ml" set ref 451 470* 702* acknowledge 002661 automatic bit(1) initial dcl 89 in procedure "ml" set ref 89* 525* 702 addr builtin function dcl 198 ref 344 380 444 444 467 467 471 471 502 502 507 629 640 640 795 795 795 795 809 al 002701 automatic fixed bin(17,0) dcl 107 set ref 208* 209 209 209 211 211 212 219* 220 221 223 224 227 227 234* 235 236 238 239 242 242 243 243 244 244 245 245 252* 253 257 257 261 524* 525 525 525 527 527 528 528 529 529 530 530 543* 545 546 555* 561 561 561 564* 569 569 571 571 580 583 584 587 588* 594 594 594 600 alphabet 002256 automatic char(256) initial unaligned dcl 61 set ref 61* 792 always_add 11(02) 000103 automatic bit(1) level 3 packed unaligned dcl 43 set ref 457* anonymous 002702 automatic fixed bin(17,0) dcl 107 set ref 269* 270 answer 002650 automatic varying char(3) dcl 76 set ref 501* 502* 504 ap 002732 automatic pointer dcl 117 set ref 208* 209 209 209 211 211 212 219* 220 221 223 224 227 227 234* 235 236 238 239 242 242 243 243 244 244 245 245 252* 253 257 261 524* 525 525 525 527 527 528 528 529 529 530 543* 545 546 555* 561 561 561 564* 569 571 580 583 584 587 588* 594 594 594 600 area based area(1024) dcl 55 ref 489 697 816 areap 002742 automatic pointer initial dcl 118 set ref 118* 343* 346* 356* 489 491* 492* 623* 697 816 arg based char unaligned dcl 82 set ref 209 209 209 211 211 212 220 221 223 224 227 227 235 236 238 239 242 242 243 243 244 244 245 245 253 257* 261 525 525 525 527 527 528 528 529 529 530* 545 546 561 561 561 569* 571* 580 583 584 587 594 594 594 600 arg_count 002703 automatic fixed bin(17,0) dcl 107 set ref 204* 207 215 230 248 523 argno 002704 automatic fixed bin(17,0) dcl 107 set ref 542* 543* 544* 544 555* 563* 563 564* 577* 577 582* 582 588 597* 597 718* 718 argp 002734 automatic pointer dcl 117 set ref 344* 346* 356* 491* 492* atime 002552 automatic char(24) unaligned dcl 67 set ref 392* 411 411* 413 413 413 413 416* 419* 424 429* 433* 464* 467 bin builtin function dcl 198 ref 392 392 464 464 bitcnt 002726 automatic fixed bin(24,0) dcl 112 set ref 268* 662* 669* 680 705 753* 754* brief 002662 automatic bit(1) initial dcl 89 set ref 89* 209* 333 340 349 358 362 buffer 002356 automatic char(168) unaligned dcl 65 set ref 205* 246 253* 260 261* 263 304 308 309* 313 315* 318 318 318 318 319 442 443* 444 444 447 546* 547 626 640 640 643* 647 655 666 666 776* canonicalize_ 000016 constant entry external dcl 141 ref 795 chars 002705 automatic fixed bin(17,0) dcl 107 set ref 681* 687 690* 690 chase 002731 automatic fixed bin(1,0) initial dcl 115 set ref 115* cleanup 002776 stack reference condition dcl 196 ref 202 clock 002656 automatic bit(54) dcl 87 set ref 390* 391 392 392 462* 463 464 464 code 002774 automatic fixed bin(35,0) dcl 186 set ref 208* 219* 234* 252* 278* 279 288* 289 290* 305* 309* 310 321* 324 324 327* 331 346* 347 347 352 356* 357 357 383 444* 467* 471* 491* 492* 499 510* 511 512* 513* 524* 543* 548* 555* 557 564* 565 569* 570 571* 588* 589 605* 606 607* 612* 640* 641 641 654 666* 667 669* 674* 675 677* 707* 708 708 711* 716* 719* 733* 740* 743* 754* 768 769* 773* 776* 778* 779* 805* 817* 818* 819* collate builtin function dcl 198 ref 61 com_err_ 000020 constant entry external dcl 142 ref 216 231 249 257 284 290 315 512 530 536 566 571 590 607 614 650 676 683 711 735 743 769 773 776 command 002646 automatic char(7) unaligned dcl 75 set ref 203* 216* 231* 249* 257* 284* 290* 315* 502* 512* 536* 566* 571* 590* 607* 614* 650* 676* 683* 711* 735* 743* 769* 773* 776* command_query_ 000022 constant entry external dcl 143 ref 502 console 002665 automatic bit(1) initial dcl 89 set ref 89* 627* 727 count 002712 automatic fixed bin(17,0) initial dcl 108 set ref 108* 278* 321* 332 337 338* 383* 429* 433* 506* 509* 509 512* 686* 687 689* 689 cu_$arg_count 000024 constant entry external dcl 144 ref 204 cu_$arg_ptr 000026 constant entry external dcl 145 ref 208 219 234 252 524 543 555 564 588 cu_$grow_stack_frame 000030 constant entry external dcl 146 ref 805 date_time_ 000032 constant entry external dcl 147 ref 392 464 delete_id 2 based bit(72) level 2 dcl 121 set ref 484* 510* divide builtin function dcl 198 ref 680 698 dn 002430 automatic char(168) unaligned dcl 65 set ref 271* 275* 278* 288* 296* 309* 318* 321* 328* 328 358* 358 363* 363 536* 536 569* 603* 605* 607* 607 614* 614 666* 669* 676* 676 711* 711 730* 733* 740* 763* 769* 769 773* 773 dont_print_count 002664 automatic bit(1) initial dcl 89 set ref 89* 213* 228* 338 en 002502 automatic char(32) unaligned dcl 66 set ref 272* 276* 278* 288* 296* 309* 319* 321* 328* 358* 363* 536* 569* 602* 605* 607* 614* 666* 669* 676* 711* 769* 773* error_table_$bad_segment 000142 external static fixed bin(35,0) dcl 187 ref 708 768 error_table_$badopt 000144 external static fixed bin(35,0) dcl 188 set ref 257* 530* error_table_$long_record 000146 external static fixed bin(35,0) dcl 189 ref 641 654 error_table_$moderr 000150 external static fixed bin(35,0) dcl 190 ref 324 352 error_table_$no_message 000154 external static fixed bin(35,0) dcl 192 ref 347 357 499 error_table_$noentry 000152 external static fixed bin(35,0) dcl 191 ref 279 error_table_$root 000156 external static fixed bin(35,0) dcl 193 ref 305 548 error_table_$rqover 000160 external static fixed bin(35,0) dcl 194 set ref 284* 536* 735* exclude_person 002600 automatic char(32) initial unaligned dcl 69 set ref 69* 236* 238* 399 399 exclude_project 002610 automatic char(32) initial unaligned dcl 69 set ref 69* 239* 400 400 exmode 002660 automatic bit(36) dcl 88 set ref 612* 613 expand_pathname_ 000034 constant entry external dcl 148 ref 666 expand_pathname_$add_suffix 000036 constant entry external dcl 149 ref 309 569 five_minutes 002720 automatic fixed bin(71,0) dcl 111 set ref 379* 411 fixed builtin function dcl 198 ref 471 471 from 1 000103 automatic char(32) level 2 dcl 43 set ref 454* get_pdir_ 000042 constant entry external dcl 151 ref 763 get_system_free_area_ 000040 constant entry external dcl 150 ref 343 623 get_wdir_ 000044 constant entry external dcl 152 ref 730 got_input 002666 automatic bit(1) initial dcl 89 set ref 89* 621 628* 665* 727 hcs_$delentry_file 000046 constant entry external dcl 153 ref 733 hcs_$fs_get_mode 000050 constant entry external dcl 154 ref 674 hcs_$initiate_count 000052 constant entry external dcl 155 ref 669 hcs_$make_seg 000054 constant entry external dcl 156 ref 740 hcs_$set_bc_seg 000056 constant entry external dcl 157 ref 754 hcs_$terminate_noname 000060 constant entry external dcl 158 ref 677 779 817 819 head_mode 002663 automatic bit(1) initial dcl 89 set ref 89* 211* 403 410 439 479 header based structure level 2 dcl 1-24 header_length 002706 automatic fixed bin(17,0) dcl 107 set ref 698* 705 i 002707 automatic fixed bin(17,0) dcl 107 set ref 207* 208* 214* 214 215 219* 229* 229 230 234* 247* 247 248 252* 313* 314 318 318 318 318 319 395* 396 396* 397 440* 441 442 443 443 443 443 445* 445 465* 467 467 523* 524* 580* 581 583 584 687* 688 689 690 id 14 002752 automatic bit(72) level 2 dcl 125 set ref 390 462 471* 484 491* 492* 707* id_node based structure level 1 dcl 121 idp 002736 automatic pointer dcl 117 set ref 380* 381 481 482* 483 484 507* 508 510 515* 515 index builtin function dcl 198 ref 220 235 313 395 398 413 413 416 429 580 687 793 interactive 002716 automatic fixed bin(17,0) initial dcl 110 set ref 110* 420 ioa_ 000062 constant entry external dcl 159 ref 296 328 333 338 349 358 363 366 407 416 419 429 433 447 636 756 757 ioa_$nnl 000064 constant entry external dcl 160 ref 411 413 414 ioa_$rsnnl 000066 constant entry external dcl 161 ref 318 iox_$get_line 000070 constant entry external dcl 162 ref 640 iox_$put_chars 000072 constant entry external dcl 163 ref 444 iox_$user_input 000074 external static pointer dcl 164 set ref 640* iox_$user_output 000076 external static pointer dcl 165 set ref 444* j 002727 automatic fixed bin(21,0) dcl 113 set ref 220* 221 223 224 235* 236 238 239 398* 399 400 401 402 442* 443 443 443 443 444* 445 447 640* 647 649 655 655 656 last_date 002644 automatic char(8) unaligned dcl 74 set ref 377* 411 424* last_sender 002512 automatic char(32) unaligned dcl 66 set ref 377* 408* 410 421* last_sent_from 002522 automatic char(32) unaligned dcl 66 set ref 410 422* last_time 002722 automatic fixed bin(71,0) dcl 111 set ref 378* 411 423* last_type 002715 automatic fixed bin(17,0) dcl 110 set ref 376* 406 420* 428* length builtin function dcl 198 ref 416 419 419 419 419 429 433 433 433 433 442 443 443 465 795 795 lines 11 based fixed bin(17,0) level 3 dcl 1-24 set ref 393 429 429* 433 433* 701* mail_format based structure level 1 dcl 1-24 set ref 489 697 698 816 mail_format_ptr 000100 automatic pointer dcl 1-17 set ref 201* 386* 393 405 410 416 416 416 419 419 419 419 419 419 419 419 422 429 429 429 429 429 433 433 433 433 433 433 433 433 433 433 441 442 443 443 443 443 451 470 471 471 489 552* 697* 698 699 700 701 702 703 703 703 703 704 707* 816 816 mail_type 002717 automatic fixed bin(17,0) initial dcl 110 set ref 110* 376 406 428 mailbox_$add_index 000110 constant entry external dcl 170 ref 707 mailbox_$check_salv_bit_index 000112 constant entry external dcl 171 ref 327 mailbox_$close 000114 constant entry external dcl 172 ref 719 778 818 mailbox_$create 000116 constant entry external dcl 173 ref 288 mailbox_$delete_index 000120 constant entry external dcl 174 ref 510 mailbox_$get_mode_index 000122 constant entry external dcl 175 ref 612 mailbox_$incremental_read_index 000124 constant entry external dcl 176 ref 492 mailbox_$open 000126 constant entry external dcl 177 ref 605 mailbox_$open_if_full 000130 constant entry external dcl 178 ref 278 321 mailbox_$own_incremental_read_index 000132 constant entry external dcl 180 ref 491 mailbox_$own_read_index 000134 constant entry external dcl 181 ref 356 mailbox_$read_index 000136 constant entry external dcl 182 ref 346 mailbox_$update_message_index 000140 constant entry external dcl 183 ref 471 match_person 002560 automatic char(32) initial unaligned dcl 68 set ref 68* 221* 223* 401 401 match_project 002570 automatic char(32) initial unaligned dcl 68 set ref 68* 224* 402 402 mbxp 002744 automatic pointer initial dcl 118 set ref 118* 740* 741 751 754* 817 817* mbz 11(06) 000103 automatic bit(30) level 3 packed unaligned dcl 43 set ref 461* mbz1 11(01) 000103 automatic bit(1) level 3 packed unaligned dcl 43 set ref 456* mbz2 11(04) 000103 automatic bit(1) level 3 packed unaligned dcl 43 set ref 459* min builtin function dcl 198 ref 442 mode 002730 automatic fixed bin(5,0) dcl 114 set ref 674* 675 more 002667 automatic bit(1) initial dcl 89 set ref 89* 638* 639 647* mseg_index 002713 automatic fixed bin(17,0) initial dcl 108 set ref 108* 278* 321* 324 327* 346* 356* 471* 491* 492* 510* 605* 612* 707* 719* 778 778* 818 818* mseg_return_args 002752 automatic structure level 1 dcl 125 set ref 344 msg_bitcnt 002710 automatic fixed bin(17,0) dcl 107 set ref 705* 707* msg_ptr 002752 automatic pointer level 2 dcl 125 set ref 386 471* my_mbx 002670 automatic bit(1) initial dcl 89 set ref 89* 267* 327 778 818 name 002620 automatic char(22) unaligned dcl 70 set ref 269* 275 276 583* 587* 716* never_add 11(03) 000103 automatic bit(1) level 3 packed unaligned dcl 43 set ref 458* newline 002654 automatic char(1) initial unaligned dcl 79 set ref 79* 403 447 687 next based pointer level 2 dcl 121 set ref 481* 483* 515 nlines 002711 automatic fixed bin(17,0) dcl 107 set ref 625* 654* 654 661 691* 691 701 nlx 002653 automatic char(1) unaligned dcl 78 set ref 403* 403* 416* 419* 429* 429* 433* 433* no_write_permission 000000 stack reference condition dcl 196 ref 747 node based char(16) array dcl 84 set ref 809 node_index 002714 automatic fixed bin(17,0) initial dcl 109 set ref 109* 501 803* 803 804 807* 809 node_ptr 002740 automatic pointer dcl 117 set ref 481 482 809* node_space 002116 automatic pointer array dcl 59 set ref 380 507 notify_sw 002671 automatic bit(1) initial dcl 89 set ref 89* 522* 527* 528* 716 null builtin function dcl 198 ref 118 118 118 201 483 508 552 670 741 816 817 others 13(07) based bit(65) level 4 packed unaligned dcl 1-24 set ref 703* output_string 000100 automatic char unaligned dcl 790 set ref 794* 795 795 796 own 002672 automatic bit(1) initial dcl 89 set ref 89* 352* 355 491 page 000115 automatic char(4096) dcl 58 set ref 629 path_sw 002673 automatic bit(1) initial dcl 89 set ref 89* 206* 254* 308 pdir_flag 002674 automatic bit(1) initial dcl 89 set ref 89* 734 742 748 756 762* printing 002675 automatic bit(1) initial dcl 89 set ref 89* 369* 372* 388 program_interrupt 003004 stack reference condition dcl 196 ref 371 496 497 503 631 660 proj 002626 automatic char(9) unaligned dcl 71 set ref 269* 271 275 584* 600* 716* query_info 000010 internal static structure level 1 dcl 134 set ref 502 502 record_quota_overflow 003012 stack reference condition dcl 196 ref 283 294 535 732 rel builtin function dcl 199 ref 471 471 reverse builtin function dcl 199 ref 416 429 465 rtrim builtin function dcl 199 ref 271 275 276 419 419 419 419 419 419 419 419 419 419 433 433 433 433 433 433 433 433 433 433 443 666 666 s 002652 automatic char(1) initial unaligned dcl 77 set ref 77* 337* 338* 393* 394* 429* 433* salvaged 002676 automatic bit(1) initial dcl 89 set ref 89* 278* 321* 326 327* saved 002677 automatic bit(1) initial dcl 89 set ref 89* 726 729* search builtin function dcl 199 ref 308 seen 13(06) based bit(1) level 4 packed unaligned dcl 1-24 set ref 703* seg_initiated 002700 automatic bit(1) initial dcl 89 set ref 89* 672* 779 819 segment based char(4096) unaligned dcl 57 set ref 655* 687 704 751* 751 segp 002746 automatic pointer initial dcl 118 set ref 118* 629* 655 669* 670 674* 677* 687 704 751 779* 819* send_mail_ 000100 constant entry external dcl 166 ref 467 send_mail_info 000103 automatic structure level 1 dcl 43 set ref 467 467 send_message_$notify_mail 000102 constant entry external dcl 167 ref 716 sender 002532 automatic char(32) unaligned dcl 66 set ref 397* 398 399 400 401 402 410 416 416 416 416 416* 419* 421 429 429 429 429 429* 433* sender_id 3 002752 automatic char(32) level 2 dcl 125 set ref 395 397 465 465 467 467 sender_name 002542 automatic char(32) unaligned dcl 66 set ref 553* 700 sent_from 1 based char(32) level 3 dcl 1-24 set ref 410 416 416 416 419 419 419 419 419 419 419 419 422 429 429 429 433 433 433 433 433 433 433 433 700* size builtin function dcl 199 ref 698 stack_bits based bit(3456) dcl 86 set ref 381* 806* stack_ptr 002750 automatic pointer dcl 119 set ref 380* 805* 806 809 substr builtin function dcl 199 set ref 61 209 223 224 238 239 318 318 318 318 319 390 397 399 400 401 402 411 413 413 416 424 429 443 443 443 443 447 462 467 467 525 545 561 583 584 594 613 647 655* 655 687 704 751* 751 switches 13 based structure level 3 in structure "mail_format" dcl 1-24 in procedure "ml" switches 11 000103 automatic structure level 2 in structure "send_mail_info" dcl 43 in procedure "ml" text 15 based char level 2 dcl 1-24 set ref 443 443 443 443 471 704* text_len 12 based fixed bin(21,0) level 3 dcl 1-24 set ref 441 442 443 443 443 443 471 489 697* 704 816 text_length 000102 automatic fixed bin(21,0) dcl 1-22 set ref 551* 649 655 656* 656 662 680* 681 682 697 697 698 698 704 728 751 751 753 time 002724 automatic fixed bin(71,0) dcl 111 set ref 391* 411 423 463* translate builtin function dcl 199 ref 792 unspec builtin function dcl 199 set ref 391* 463* urgent 13(01) based bit(1) level 4 packed unaligned dcl 1-24 set ref 703* user_info_ 000104 constant entry external dcl 168 ref 553 user_info_$login_data 000106 constant entry external dcl 169 ref 269 verify builtin function dcl 199 ref 465 version based fixed bin(17,0) level 3 in structure "mail_format" dcl 1-24 in procedure "ml" set ref 471 699* version 000103 automatic fixed bin(17,0) level 2 in structure "send_mail_info" dcl 43 in procedure "ml" set ref 453* vname 002631 automatic varying char(22) dcl 72 set ref 583* 587* 590* 602 603 vproj 002640 automatic varying char(9) dcl 73 set ref 584* 600* 603 wakeup 13 based bit(1) level 4 in structure "mail_format" packed unaligned dcl 1-24 in procedure "ml" set ref 405 703* wakeup 11 000103 automatic bit(1) level 3 in structure "send_mail_info" packed unaligned dcl 43 in procedure "ml" set ref 455* NAMES DECLARED BY EXPLICIT CONTEXT. CLEANUP 005272 constant label dcl 558 ref 737 CLOSE 007276 constant label dcl 778 ref 335 340 350 359 364 504 518 633 678 684 744 774 CREATE 007464 constant label dcl 740 ref 764 ERROR1 007124 constant label dcl 768 ref 324 352 357 499 670 708 ERROR2 007247 constant label dcl 776 ref 306 310 549 644 667 GET_PATH 005200 constant label dcl 543 ref 545 GET_PROJ 005561 constant label dcl 588 ref 598 NEXT 007110 constant label dcl 718 ref 609 617 NL_LOOP 006665 constant label dcl 687 ref 692 NO_PROJ 005604 constant label dcl 590 ref 594 OPEN 005760 constant label dcl 605 ref 574 QUERY 004606 constant label dcl 501 ref 497 READ 001513 constant label dcl 267 REMEMBER 004464 constant label dcl 479 ref 373 388 RETURN 007326 constant label dcl 781 ref 285 291 539 RNEXT 004500 constant label dcl 489 ref 399 400 401 402 SEND 004741 constant label dcl 522 ref 242 243 244 246 260 SEND_LOOP 005253 constant label dcl 555 ref 578 720 TRY_PDIR 007674 constant label dcl 762 ref 734 742 748 canon 007714 constant entry internal dcl 787 ref 419 419 433 433 443 get_id_node 010041 constant entry internal dcl 801 ref 480 mail 000742 constant entry external dcl 28 mail_cleanup 010077 constant entry internal dcl 814 ref 202 558 ml 000732 constant entry external dcl 28 save 007330 constant entry internal dcl 724 ref 538 591 608 616 632 642 651 713 771 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 11310 11472 10412 11320 Length 12052 10412 162 344 676 4 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ml 1736 external procedure is an external procedure. on unit on line 202 64 on unit on unit on line 283 88 on unit on unit on line 371 64 on unit on unit on line 497 64 on unit on unit on line 535 102 on unit on unit on line 631 64 on unit save 138 internal procedure enables or reverts conditions. on unit on line 732 96 on unit on unit on line 747 64 on unit canon 88 internal procedure uses auto adjustable storage, uses returns(char(*)) or returns(bit(*)), and is called during a stack extension. get_id_node internal procedure shares stack frame of external procedure ml. mail_cleanup 70 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 query_info ml STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME canon 000100 output_string canon ml 000100 mail_format_ptr ml 000102 text_length ml 000103 send_mail_info ml 000115 page ml 002116 node_space ml 002256 alphabet ml 002356 buffer ml 002430 dn ml 002502 en ml 002512 last_sender ml 002522 last_sent_from ml 002532 sender ml 002542 sender_name ml 002552 atime ml 002560 match_person ml 002570 match_project ml 002600 exclude_person ml 002610 exclude_project ml 002620 name ml 002626 proj ml 002631 vname ml 002640 vproj ml 002644 last_date ml 002646 command ml 002650 answer ml 002652 s ml 002653 nlx ml 002654 newline ml 002656 clock ml 002660 exmode ml 002661 acknowledge ml 002662 brief ml 002663 head_mode ml 002664 dont_print_count ml 002665 console ml 002666 got_input ml 002667 more ml 002670 my_mbx ml 002671 notify_sw ml 002672 own ml 002673 path_sw ml 002674 pdir_flag ml 002675 printing ml 002676 salvaged ml 002677 saved ml 002700 seg_initiated ml 002701 al ml 002702 anonymous ml 002703 arg_count ml 002704 argno ml 002705 chars ml 002706 header_length ml 002707 i ml 002710 msg_bitcnt ml 002711 nlines ml 002712 count ml 002713 mseg_index ml 002714 node_index ml 002715 last_type ml 002716 interactive ml 002717 mail_type ml 002720 five_minutes ml 002722 last_time ml 002724 time ml 002726 bitcnt ml 002727 j ml 002730 mode ml 002731 chase ml 002732 ap ml 002734 argp ml 002736 idp ml 002740 node_ptr ml 002742 areap ml 002744 mbxp ml 002746 segp ml 002750 stack_ptr ml 002752 mseg_return_args ml 002774 code ml THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a r_ne_as alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other return_mac tra_ext_1 alloc_auto_adj mpfx2 enable_op shorten_stack ext_entry int_entry int_entry_desc set_chars_eis return_chars_eis translate_2 op_alloc_ op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. canonicalize_ com_err_ command_query_ cu_$arg_count cu_$arg_ptr cu_$grow_stack_frame date_time_ decimal_exp_ expand_pathname_ expand_pathname_$add_suffix get_pdir_ get_system_free_area_ get_wdir_ hcs_$delentry_file hcs_$fs_get_mode hcs_$initiate_count hcs_$make_seg hcs_$set_bc_seg hcs_$terminate_noname ioa_ ioa_$nnl ioa_$rsnnl iox_$get_line iox_$put_chars mailbox_$add_index mailbox_$check_salv_bit_index mailbox_$close mailbox_$create mailbox_$delete_index mailbox_$get_mode_index mailbox_$incremental_read_index mailbox_$open mailbox_$open_if_full mailbox_$own_incremental_read_index mailbox_$own_read_index mailbox_$read_index mailbox_$update_message_index send_mail_ send_message_$notify_mail user_info_ user_info_$login_data THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_segment error_table_$badopt error_table_$long_record error_table_$moderr error_table_$no_message error_table_$noentry error_table_$root error_table_$rqover iox_$user_input iox_$user_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 61 000636 68 000651 69 000660 77 000666 79 000670 89 000672 108 000712 109 000714 110 000715 115 000721 118 000723 28 000731 201 000750 202 000752 203 000774 204 000776 205 001005 206 001010 207 001011 208 001021 209 001036 211 001057 212 001072 213 001076 214 001100 215 001101 216 001104 217 001131 219 001132 220 001147 221 001162 223 001167 224 001173 226 001201 227 001202 228 001212 229 001214 230 001215 231 001220 232 001245 234 001246 235 001263 236 001276 238 001303 239 001307 241 001315 242 001316 243 001326 244 001336 245 001346 246 001356 247 001362 248 001363 249 001366 250 001413 252 001414 253 001431 254 001436 255 001440 257 001441 258 001473 259 001474 260 001475 261 001501 262 001505 263 001507 267 001513 268 001515 269 001516 270 001543 271 001546 272 001605 273 001611 275 001612 276 001661 277 001710 278 001711 279 001745 283 001751 284 001765 285 002011 288 002014 289 002035 290 002037 291 002063 294 002064 296 002065 297 002111 299 002112 304 002113 305 002117 306 002122 308 002123 309 002137 310 002171 311 002173 313 002174 314 002205 315 002206 316 002237 318 002240 319 002323 320 002342 321 002343 324 002377 326 002406 327 002411 328 002432 331 002467 332 002471 333 002473 335 002510 337 002511 338 002515 340 002544 343 002546 344 002555 346 002557 347 002600 349 002605 350 002621 352 002622 355 002626 356 002630 357 002651 358 002656 359 002714 362 002715 363 002717 364 002754 366 002755 369 002774 371 002776 372 003012 373 003014 376 003017 377 003021 378 003026 379 003030 380 003105 381 003111 383 003115 386 003122 388 003124 390 003126 391 003131 392 003132 393 003151 394 003160 395 003162 396 003173 397 003176 398 003202 399 003213 400 003224 401 003240 402 003252 403 003262 403 003267 405 003271 406 003274 407 003277 408 003310 410 003313 411 003326 413 003355 414 003411 415 003424 416 003425 419 003506 420 003633 421 003636 422 003641 423 003645 424 003647 425 003651 428 003652 429 003654 433 003760 435 004132 439 004133 440 004135 441 004137 442 004144 443 004153 444 004225 445 004245 446 004247 447 004250 451 004266 453 004272 454 004274 455 004277 456 004301 457 004303 458 004305 459 004307 460 004311 461 004313 462 004315 463 004320 464 004321 465 004340 467 004355 470 004422 471 004426 479 004464 480 004466 481 004467 482 004471 483 004472 484 004474 489 004500 491 004507 492 004535 494 004560 496 004562 497 004563 499 004602 501 004606 502 004615 503 004646 504 004647 506 004654 507 004655 508 004657 509 004664 510 004665 511 004701 512 004703 513 004733 515 004734 516 004737 518 004740 522 004741 523 004743 524 004753 525 004770 527 005011 528 005024 529 005036 530 005046 531 005102 533 005103 535 005105 536 005121 538 005166 539 005173 542 005176 543 005200 544 005215 545 005216 546 005223 547 005227 548 005233 549 005236 551 005237 552 005240 553 005242 555 005253 557 005270 558 005272 559 005276 561 005277 563 005315 564 005316 565 005333 566 005335 567 005362 569 005363 570 005421 571 005423 572 005455 574 005456 577 005457 578 005460 580 005461 581 005473 582 005474 583 005476 584 005516 585 005540 587 005542 588 005561 589 005602 590 005604 591 005635 592 005641 594 005642 597 005660 598 005661 600 005662 601 005701 602 005702 603 005720 605 005760 606 006006 607 006010 608 006056 609 006062 612 006063 613 006104 614 006107 616 006155 617 006161 621 006162 623 006164 625 006173 626 006174 627 006200 628 006202 629 006203 631 006205 632 006221 633 006226 636 006231 638 006244 639 006246 640 006250 641 006273 642 006300 643 006304 644 006307 647 006310 649 006321 650 006325 651 006352 652 006356 654 006357 655 006364 656 006372 658 006373 660 006374 661 006375 662 006377 663 006402 665 006403 666 006405 667 006452 669 006455 670 006520 672 006524 674 006526 675 006541 676 006546 677 006614 678 006625 680 006626 681 006632 682 006633 683 006635 684 006662 686 006663 687 006665 688 006701 689 006702 690 006703 691 006705 692 006706 697 006707 698 006721 699 006731 700 006733 701 006736 702 006740 703 006745 704 006756 705 006764 707 006770 708 007007 711 007014 713 007060 714 007064 716 007065 718 007110 719 007112 720 007123 768 007124 769 007130 771 007174 772 007200 773 007201 774 007246 776 007247 778 007276 779 007313 781 007326 724 007327 726 007335 727 007340 728 007344 729 007346 730 007350 732 007362 733 007376 734 007424 735 007433 737 007461 740 007464 741 007530 742 007535 743 007537 744 007563 747 007566 748 007602 749 007611 751 007612 753 007621 754 007624 756 007637 757 007657 759 007673 762 007674 763 007677 764 007712 787 007713 790 007727 792 007737 793 007754 794 007767 795 007774 796 010021 798 010031 801 010041 803 010042 804 010043 805 010046 806 010063 807 010067 809 010071 811 010075 814 010076 816 010104 817 010120 818 010136 819 010154 821 010170 ----------------------------------------------------------- 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