COMPILATION LISTING OF SEGMENT receive_file_ Compiled by: Multics PL/I Compiler, Release 31a, of October 12, 1988 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 03/15/89 0834.3 mst Wed 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 /* Procedure to receive a file from a remote host and put it into some pool storage */ 15 16 /* Created, Feb 1980, by J. C. Whitmore - based on the read_cards_ proc */ 17 /* Modified: September 1980 by G. Palter to add the request_type keyword to ++CONTROL, make processing of ++FORMAT and 18* ++CONTROL never generate fatal errors, and make use of auto_queue when ++IDENT required not delete */ 19 /* Modified: 30 September 1981 by G. Palter to convert to version 6 dprint_arg (longer request type names) and enable I/O 20* daemon escape processing (logical channel skips) by default when queueing print files */ 21 /* Modified: 8 October 1981 by G. Palter to bypass the "classic" segment to MSF conversion problem */ 22 /* Modified: 27 December 1984 by Keith Loepere for version 2 create_branch_info. */ 23 24 25 /****^ HISTORY COMMENTS: 26* 1) change(87-05-10,Gilcrease), approve(87-05-13,MCR7686), 27* audit(88-02-01,Farley), install(88-02-02,MR12.2-1019): 28* Updated to use latest version (9) of dprint_arg. 29* END HISTORY COMMENTS */ 30 31 32 receive_file_: 33 procedure (a_root_dir, a_sw_info_p, a_station, a_data_ptr, a_code); 34 35 36 /* Parameters */ 37 38 dcl a_root_dir char (*) parameter; /* pool root directory */ 39 dcl a_sw_info_p ptr parameter; /* pointer to the sw_info structure */ 40 dcl a_station char (*) parameter; /* remote_station name for messages */ 41 dcl a_data_ptr ptr parameter; /* pointer to receive_file_data structure of caller */ 42 dcl a_code fixed bin (35) parameter; 43 44 45 /* Remaining declarations */ 46 47 dcl aclec fixed bin; 48 dcl add_nl bit (1); 49 dcl bc fixed bin (24); /* bit count of seg */ 50 dcl record_buffer char (1024) aligned; /* read buffer for character input */ 51 dcl record char (2000) var; 52 dcl record_len fixed bin (24); 53 dcl chars_left_in_seg fixed bin (24); 54 dcl left fixed bin (24); 55 dcl code fixed bin (35); 56 dcl component fixed bin; 57 dcl contin bit (1); 58 dcl file_name char (32) var; /* user supplied name of file */ 59 dcl filep ptr ; 60 dcl dirname char (168); /* pathname of personid directory in pool */ 61 dcl done bit (1); 62 dcl default_person char (32); 63 dcl default_project char (32); 64 dcl default_personid char (32); 65 dcl element_size fixed bin; /* element size for file format */ 66 dcl fcbp ptr; 67 dcl field (40) char (80) var; 68 dcl field_cnt fixed bin; 69 dcl ignore fixed bin (35); 70 dcl input_modes char (256); 71 dcl input_mode_bits bit (36); 72 dcl control_mode_bits bit (36); 73 dcl key char (32) var; 74 dcl key_mode char (32); 75 dcl len fixed bin (24); 76 dcl long char (100); /* space to expand an error_table_ code */ 77 dcl lower_case bit (1); 78 dcl max_chars fixed bin (24); 79 dcl chars_in_last_seg fixed bin (24); /* number of elements transmitted */ 80 dcl new_file_name char (32); /* internal name of file */ 81 dcl overwrite bit (1); 82 dcl person char (32); /* person part of personid */ 83 dcl personid char (32); 84 dcl pool_open bit (1); 85 dcl proc_auth bit (72); /* access class of the process */ 86 dcl project char (32); /* and the project part */ 87 dcl file_path char (168) var; 88 dcl read_done bit (1); 89 dcl root_dir char (168); 90 dcl source fixed bin; /* iocbp index in sw_info structure */ 91 dcl station char (32) var init ("remote-file-input"); 92 dcl short char (8); /* dummy for convert_status_code_ */ 93 dcl tag fixed bin; /* dupe name counter */ 94 dcl testing bit (1); /* our local test mode flag */ 95 dcl user_defined bit (1); 96 dcl user_msg char (136); 97 dcl log_msg char (256); 98 dcl test_iocbp ptr; 99 dcl trim bit (1); 100 dcl data_idx fixed bin; 101 dcl file_in_progress bit (1) init ("0"b); 102 103 dcl master_iocbp ptr; /* iocb pointers which we will use */ 104 dcl slave_iocbp ptr; 105 dcl input_iocbp ptr; 106 107 dcl (record_quota_overflow, command_level, cleanup) condition; 108 109 dcl (addr, null, index, substr, verify, length, multiply, divide, rtrim, before, after, unspec, search, ltrim) builtin; 110 111 dcl string char (string_len) based; 112 dcl string_len fixed bin; 113 dcl based_chars (2000) char (1) based; 114 115 dcl 1 acle (2) aligned, /* ACL entry */ 116 2 name char (32), 117 2 mode bit (36), 118 2 pad bit (36), 119 2 code fixed bin (35); 120 121 dcl 1 cb_info aligned like create_branch_info auto; 122 123 dcl 1 file_data aligned like receive_file_data; /* our working copy of the running parms */ 124 125 dcl 1 count_structure aligned, /* structure used for the get_count control order */ 126 2 line fixed bin, /* most fields are pads, because this structure */ 127 2 page_len fixed bin, /* is based on the printer defined structure */ 128 2 lmarg fixed bin, /* shown in prt_order_info.incl.pl1 */ 129 2 rmarg fixed bin, 130 2 records fixed bin (35), /* this is the normal line count field */ 131 2 page_count fixed bin; 132 133 dcl tell_user bit (1) int static init ("1"b) options (constant); 134 dcl silent bit (1) int static init ("0"b) options (constant); 135 dcl max_record_len fixed bin (24) int static options (constant) init (1024); 136 dcl control_modes char (32) int static init ("^add_nl,lower_case,trim.") options (constant); 137 dcl ESC_c char (2) int static options (constant) init ("c"); 138 dcl ETX char (1) int static options (constant) init (""); 139 dcl SP char (1) int static options (constant) init (" "); 140 dcl NL char (1) int static options (constant) init (" 141 "); 142 dcl FF char (1) int static options (constant) init (" "); 143 144 dcl sys_info$max_seg_size fixed bin (35) ext static; 145 146 dcl (error_table_$bad_arg, error_table_$bigarg, error_table_$short_record, error_table_$end_of_info, 147 error_table_$eof_record, error_table_$namedup, error_table_$noarg, error_table_$unimplemented_version) 148 fixed binary (35) external; 149 150 dcl card_util_$modes entry (char (*), bit (36), char (*), fixed bin (35)); 151 dcl card_util_$translate entry (bit (36), char (*) var); 152 dcl send_mail_ entry (char (*), char (*), ptr, fixed bin (35)); 153 dcl msf_manager_$adjust entry (ptr, fixed bin, fixed bin (24), bit (3), fixed bin (35)); 154 dcl convert_status_code_ entry (fixed bin (35), char (8), char (100)); 155 dcl cu_$level_get entry returns (fixed bin); 156 dcl delete_$path entry (char (*), char (*), bit (6), char (*), fixed bin (35)); 157 dcl dprint_ entry (char (*), char (*), ptr, fixed bin (35)); 158 dcl find_input_switch_ entry (ptr, bit (1), fixed bin, fixed bin (35)); 159 dcl get_authorization_ entry returns (bit (72)); 160 dcl get_group_id_ entry returns (char (32)); 161 dcl msf_manager_$close entry (ptr); 162 dcl msf_manager_$open entry (char (*), char (*), ptr, fixed bin (35)); 163 dcl msf_manager_$get_ptr entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35)); 164 dcl msf_manager_$acl_add entry (ptr, ptr, fixed bin, fixed bin (35)); 165 dcl hcs_$create_branch_ entry (char (*), char (*), ptr, fixed bin (35)); 166 dcl ioa_$rsnnl entry options (variable); 167 dcl iod_info_$generic_type entry (character (*), character (32), fixed binary (35)); 168 dcl iox_$look_iocb entry (char (*), ptr, fixed bin (35)); 169 dcl iox_$get_chars entry (ptr, ptr, fixed bin (24), fixed bin (24), fixed bin (35)); 170 dcl iox_$put_chars entry (ptr, ptr, fixed bin (24), fixed bin (35)); 171 dcl iox_$control entry (ptr, char (*) aligned, ptr, fixed bin (35)); 172 dcl pool_manager_$add_quota entry (char (*), fixed bin, fixed bin (35)); 173 dcl pool_manager_$close_user_pool entry (char (*), char (*), fixed bin, bit (36), fixed bin (35)); 174 dcl pool_manager_$open_user_pool entry (char (*), char (*), char (*), fixed bin (35)); 175 dcl unique_chars_ entry (bit (*)) returns (char (15)); 176 1 1 /* BEGIN INCLUDE FILE - find_input_sw_info.incl.pl1 */ 1 2 1 3 /* this is the structure to be used with the find_input_switch_ subroutine */ 1 4 1 5 dcl sw_info_p ptr; /* automatic pointer for the based structure */ 1 6 1 7 dcl 1 sw_info aligned based (sw_info_p), 1 8 2 version fixed bin, /* version of this structure */ 1 9 2 n_iocb_ptrs fixed bin, /* number of active switches in iocbp array */ 1 10 2 iocbp (10) ptr, /* array of iocb ptrs we are using */ 1 11 2 wait_list, /* wait list for blocking on read events */ 1 12 /* there is one entry for each active iocbp */ 1 13 3 n_channels fixed bin, /* must equal n_iocb_ptrs, must be even word aligned */ 1 14 3 pad fixed bin, /* breakage */ 1 15 3 ev_chan (10) fixed bin (71); /* one event channel for each active iocbp */ 1 16 1 17 dcl sw_info_version_1 fixed bin int static options (constant) init (1); 1 18 1 19 /* END INCLUDE FILE - find_input_sw_info.incl.pl1 */ 177 178 2 1 /* BEGIN INCLUDE FILE - receive_file_data.incl.pl1 */ 2 2 2 3 /* This include file defines the structure which is part of the interface to the receive_file_.pl1 procedure. */ 2 4 2 5 dcl receive_file_data_ptr ptr; 2 6 2 7 dcl 1 receive_file_data aligned based (receive_file_data_ptr), /* data for receive_file_ default file_data */ 2 8 2 version fixed bin, 2 9 2 flags, 2 10 3 testing bit (1) unal, /* TRUE when in test mode */ 2 11 3 no_ident bit (1) unal, /* TRUE when no ++IDENT record is required */ 2 12 3 auto_queue bit (1) unal, /* TRUE when file is to be dp -dl by driver */ 2 13 2 device_type fixed bin, /* code for input device type (see below) */ 2 14 2 request_type char (32); /* default request type for auto_queue */ 2 15 2 16 dcl receive_file_data_version_1 fixed bin int static options (constant) init (1); 2 17 2 18 dcl printer_input_device fixed bin int static options (constant) init (1); 2 19 dcl punch_input_device fixed bin int static options (constant) init (2); 2 20 2 21 2 22 /* END INCLUDE FILE - receive_file_data.incl.pl1 */ 2 23 179 180 3 1 /* BEGIN INCLUDE FILE - - - create_branch_info.incl.pl1 - - - created January 1975 */ 3 2 3 3 3 4 /****^ HISTORY COMMENTS: 3 5* 1) change(89-01-16,TLNguyen), approve(89-01-16,MCR8049), 3 6* audit(89-02-03,Parisek), install(89-03-15,MR12.3-1025): 3 7* 1. Declare version constant properly. 3 8* 2. Remove version 1 since it was never referenced and to force 3 9* callers to upgrade their programs. 3 10* END HISTORY COMMENTS */ 3 11 3 12 3 13 /* Modified December 1984 for dir_quota, Keith Loepere. */ 3 14 3 15 /* this include files gives the argument structure for create_branch_ */ 3 16 3 17 dcl 1 create_branch_info aligned based, 3 18 2 version fixed bin, /* set this to the largest value given below */ 3 19 2 switches unaligned, 3 20 3 dir_sw bit (1) unaligned, /* if on, a directory branch is wanted */ 3 21 3 copy_sw bit (1) unaligned, /* if on, initiating segment will be done by copying */ 3 22 3 chase_sw bit (1) unaligned, /* if on, if pathname is a link, it will be chased */ 3 23 3 priv_upgrade_sw bit (1) unaligned, /* privileged creation (ring 1) of upgraded object */ 3 24 3 parent_ac_sw bit (1) unaligned, /* if on, use parent's access class for seg or dir created */ 3 25 3 mbz1 bit (31) unaligned, /* pad to full word */ 3 26 2 mode bit (3) unaligned, /* segment or directory for acl for userid */ 3 27 2 mbz2 bit (33) unaligned, /* pad to full word */ 3 28 2 rings (3) fixed bin (3), /* branch's ring brackets */ 3 29 2 userid char (32), /* user's access control name */ 3 30 2 bitcnt fixed bin (24), /* bit count of the segment */ 3 31 2 quota fixed bin (18), /* for directories, this am't of quota will be moved to it */ 3 32 2 access_class bit (72), /* is the access class of the body of the branch */ 3 33 2 dir_quota fixed bin (18); /* for directories, this am't of dir quota will be moved to it */ 3 34 3 35 dcl create_branch_version_2 fixed bin int static options (constant) init (2); 3 36 3 37 /* END INCLUDE FILE - - - create_branch_info.incl.pl1 - - - */ 3 38 181 182 4 1 /* BEGIN send_mail_info include file */ 4 2 4 3 dcl send_mail_info_version_2 fixed bin init(2); 4 4 4 5 dcl 1 send_mail_info aligned, 4 6 2 version fixed bin, /* = 2 */ 4 7 2 sent_from char(32) aligned, 4 8 2 switches, 4 9 3 wakeup bit(1) unal, 4 10 3 mbz1 bit(1) unal, 4 11 3 always_add bit(1) unal, 4 12 3 never_add bit(1) unal, 4 13 3 notify bit(1) unal, 4 14 3 acknowledge bit(1) unal, 4 15 3 mbz bit(30) unal; 4 16 4 17 /* END send_mail_info include file */ 183 184 5 1 /* BEGIN INCLUDE FILE ... dprint_arg.incl.pl1 */ 5 2 /* Modified 11/13/74 by Noel I. Morris */ 5 3 /* Modified: 10 April 1981 by G. Palter for version 6 structure -- longer request type names */ 5 4 /* Modified: 30 April 1982 by R. Kovalcik for version 7 structure -- defer_until_process_terminataion */ 5 5 /* Modified: November 1983 by C. Marker for version 8 structure -- no_separator */ 5 6 5 7 /****^ HISTORY COMMENTS: 5 8* 1) change(87-05-10,Gilcrease), approve(87-05-13,MCR7686), 5 9* audit(88-02-01,Farley), install(88-02-02,MR12.2-1019): 5 10* Add line_nbrs bit for line-numbered printouts, version 9. 5 11* 2) change(88-02-05,Farley), approve(88-02-05,PBF7686), audit(88-02-05,GWMay), 5 12* install(88-02-05,MR12.2-1022): 5 13* Corrected alignment of line_nbrs, was aligned s/b unaligned.. 5 14* 3) change(88-08-29,Farley), approve(88-09-16,MCR7911), 5 15* audit(88-09-29,Wallman), install(88-10-28,MR12.2-1199): 5 16* Created a new 64 character forms_name variable, which supersedes the old 5 17* char 24 form_name variable, version 10. 5 18* END HISTORY COMMENTS */ 5 19 5 20 5 21 dcl dpap ptr; /* ptr to argument structure */ 5 22 dcl 1 dprint_arg_buf aligned like dprint_arg; /* Automatic storage for arg. */ 5 23 5 24 dcl 1 dprint_arg based (dpap) aligned, /* argument structure */ 5 25 2 version fixed bin, /* version number of dcl - current version is 9 */ 5 26 2 copies fixed bin, /* number of copies wanted */ 5 27 2 delete fixed bin, /* 1=delete after print */ 5 28 2 queue fixed bin, /* print queue */ 5 29 2 pt_pch fixed bin, /* 1=print, 2=punch */ 5 30 2 notify fixed bin, /* 1 = notify user when done */ 5 31 2 heading char (64), /* first page heading */ 5 32 2 output_module fixed bin, /* 1=print, 2=7punch, 3=mcc, 4=raw, 5=plotter */ 5 33 2 dest char (12), /* version 5 made this a pad - see destination below */ 5 34 /* limit of version 1 structure */ 5 35 2 carriage_control, /* Carriage control flags. */ 5 36 3 nep bit (1) unal, /* TRUE if print trhu perf. */ 5 37 3 single bit (1) unal, /* TRUE if ignore FF and VT */ 5 38 3 non_edited bit (1) unal, /* TRUE if printing in non-edited mode */ 5 39 3 truncate bit (1) unal, /* TRUE if truncating lines at line length */ 5 40 3 center_top_label bit (1) unal, /* TRUE if top label to be centered */ 5 41 3 center_bottom_label bit (1) unal, /* TRUE if bottom label to be centered */ 5 42 3 esc bit (1) unal, /* version 5 TRUE if text escapes are to be processed */ 5 43 3 no_separator bit (1) unal, /* version 8 TRUE if the inner head and tail sheets are to be suppressed. */ 5 44 3 line_nbrs bit (1) unal, /* version 9, line numbers */ 5 45 3 padding bit (27) unal, 5 46 2 pad (30) fixed bin, 5 47 2 forms char (8), /* version 5 made this a pad - see form_name below */ 5 48 2 lmargin fixed bin, /* left margin */ 5 49 2 line_lth fixed bin, /* max line lth */ 5 50 /* limit of version 2 structure */ 5 51 2 class char (8), /* version 6 made this a pad - see request_type below */ 5 52 2 page_lth fixed bin, /* Paper length arg */ 5 53 /* limit of version 3 structure */ 5 54 2 top_label char (136), /* top-of-page label */ 5 55 2 bottom_label char (136), /* bottom-of-page label */ 5 56 /* limit of version 4 structure */ 5 57 2 bit_count fixed bin (35), /* segment bit count */ 5 58 2 form_name char (24), /* name of special forms needed - moved from forms */ 5 59 /* version 10 made this a pad - see forms_name below */ 5 60 2 destination char (24), /* the long destination - moved from dest */ 5 61 2 chan_stop_path char (168), /* path of user channel stops - future */ 5 62 /* limit of version 5 structure */ 5 63 2 request_type character (24) unaligned, /* request type for the request */ 5 64 /* limit of version 6 structure */ 5 65 2 defer_until_process_termination fixed bin, /* 1 = don't process request until requesting process terminates */ 5 66 2 forms_name char (64) unal; /* name of special forms needed - moved from form_name */ 5 67 /* limit of version 10 structure */ 5 68 5 69 dcl dprint_arg_version_1 fixed bin int static options (constant) init (1); 5 70 dcl dprint_arg_version_2 fixed bin int static options (constant) init (2); 5 71 dcl dprint_arg_version_3 fixed bin int static options (constant) init (3); 5 72 dcl dprint_arg_version_4 fixed bin int static options (constant) init (4); 5 73 dcl dprint_arg_version_5 fixed bin int static options (constant) init (5); 5 74 dcl dprint_arg_version_6 fixed bin int static options (constant) init (6); 5 75 dcl dprint_arg_version_7 fixed bin int static options (constant) init (7); 5 76 dcl dprint_arg_version_8 fixed bin int static options (constant) init (8); 5 77 dcl dprint_arg_version_9 fixed bin int static options (constant) init (9); 5 78 dcl dprint_arg_version_10 fixed bin int static options (constant) init (10); 5 79 /* current version */ 5 80 5 81 dcl ( 5 82 DP_PRINT init (1), 5 83 DP_PUNCH init (2), 5 84 DP_PLOT init (3) 5 85 ) fixed bin static options (constant); /* for dprint_arg.pt_pch */ 5 86 5 87 /* END INCLUDE FILE ... dprint_arg.incl.pl1 */ 185 186 187 /* receive_file_: procedure (a_root_dir, a_sw_info_p, a_station, a_test_mode, a_code); */ 188 189 a_code = 0; 190 root_dir = a_root_dir; 191 station = a_station; 192 receive_file_data_ptr = a_data_ptr; 193 194 if receive_file_data.version ^= receive_file_data_version_1 then do; 195 bad_version: code = error_table_$unimplemented_version; 196 return; 197 end; 198 199 sw_info_p = a_sw_info_p; /* setup automatic based references */ 200 if sw_info.version ^= sw_info_version_1 then go to bad_version; 201 202 /* set up iocb pointers we will use according to the conventions */ 203 204 data_idx = sw_info.n_iocb_ptrs; /* save index of the data iocbp - last one */ 205 if data_idx < 2 | data_idx > 10 then do; /* must have what we need */ 206 bad_arg: a_code = error_table_$bad_arg; /* reject immediately, no opr messages */ 207 return; 208 end; 209 210 master_iocbp = sw_info.iocbp (1); /* 1 = master console (user_io) required. */ 211 if data_idx > 2 then 212 slave_iocbp = sw_info.iocbp (2); /* 2 = slave console (if any - optional) */ 213 else slave_iocbp = null; /* be sure we mark it as undefined if not given */ 214 /* 3 = control console (also optional) - not used here */ 215 input_iocbp = sw_info.iocbp (data_idx); /* last one is the data input iocbp - required */ 216 217 if input_iocbp = null | master_iocbp = null then go to bad_arg; /* check out pointers */ 218 219 call INITIALIZE_STUFF; /* use the internal proc to make this cleaner */ 220 221 on record_quota_overflow call overflow_handler; 222 223 on cleanup begin; 224 code = 0; 225 if file_in_progress then /* should we tell the operator about this */ 226 call report ("receive_file_: Aborting file input." || NL, silent); /* don't tell user */ 227 call clean_up; /* delete any partial input */ 228 end; 229 230 start: 231 call RESET_PARAMETERS; 232 233 key_mode = "IDENT search"; /* this is for log debugging messages */ 234 235 /* check for command input or next file start */ 236 237 read_ident: 238 239 call find_input_switch_ (sw_info_p, "1"b, source, code); /* look for input, block if nothing waiting */ 240 if code ^= 0 then call abort (code, "Returning to command level."); 241 242 if source ^= data_idx then return; /* allow commands to have priority */ 243 244 /* We have some data coming in. If we don't require ++IDENT record, all must go into a segment */ 245 246 if file_data.no_ident then do; 247 call report ("Begin file: " || file_name || NL, silent); 248 go to get_pool_dir; 249 end; 250 251 call read_control_record (key, field (*), field_cnt, code); /* parse record into key and arg fields */ 252 if code = error_table_$eof_record then go to start; /* ignore an unexpected EOF record */ 253 254 if key ^= "++ident" then do; /* flush anything out of sync */ 255 key_mode = "IDENT flush"; /* show that we are dumping data */ 256 go to read_ident; 257 end; 258 259 key_mode = "IDENT found"; /* we matched on something */ 260 261 if field_cnt ^= 3 & field_cnt ^= 2 then 262 call abort_read (0, "Invalid ++IDENT record format: " || record, silent); 263 264 file_name = field (1); /* first field after ++IDENT is the file name */ 265 266 if field_cnt = 3 then do; /* next is person.project or person project */ 267 person = field (2); 268 project = field (3); 269 end; 270 else if field_cnt = 2 then do; 271 person = before (field (2), "."); 272 project = after (field (2), "."); 273 end; 274 275 if person = "*" | person = "" then /* a personid of * is illegal */ 276 call abort_read (0, "Invalid person name: " || record, silent); 277 if project = "*" | project = "" then 278 call abort_read (0, "Invalid project name: " || record, silent); 279 280 personid = rtrim (person) || "." || project; 281 282 user_defined = "1"b; /* we now have something we can identify */ 283 284 call ioa_$rsnnl ("Station ""^a"" receiving file ""^a"" for ^a." || NL, user_msg, len, 285 station, file_name, personid); 286 287 call report (rtrim (user_msg), silent); /* this is a log message */ 288 289 290 /* Look for any other control records, up to ++INPUT and digest them */ 291 292 done = "0"b; 293 do while (^done); 294 read_next_control_record: 295 call read_control_record (key, field (*), field_cnt, code); /* read and split into key + arg fields */ 296 if code = error_table_$eof_record then do; 297 call report ("Unexpected EOF record among control records." || NL, silent); 298 go to start; 299 end; 300 else if code ^= 0 then call abort (code, "Read error. Aborting"); 301 else if key = "++input" then done = "1"b; 302 else if key = "++format" then /* user defined format data */ 303 call decode_format_args (field (*), field_cnt); 304 else if key = "++control" then call decode_control_args (field (*), field_cnt); 305 else if key = "++ident" then call abort_read (0, "Out of sequence ++IDENT record", tell_user); 306 else call control_record_error (0, "Unrecognized control record ignored: " || record, tell_user); 307 end; 308 309 310 /* We now have all the control records for receiving the file. Get ready to read the file text. */ 311 /* First, we must have a place to write the data. Create an output file in the pool directory */ 312 313 get_pool_dir: 314 315 file_in_progress = "1"b; /* mark our progress for recovery */ 316 317 call pool_manager_$open_user_pool (root_dir, person, dirname, code); /* get dir path name for this person */ 318 if code ^= 0 then /* pool error is very bad */ 319 call abort (code, "Unable to open pool storage."); 320 pool_open = "1"b; /* be sure we close the pool on error */ 321 322 unspec (cb_info) = "0"b; 323 cb_info.version = create_branch_version_2; 324 cb_info.mode = "101"b; 325 cb_info.rings (1), cb_info.rings (2), cb_info.rings (3) = cu_$level_get (); 326 cb_info.userid = get_group_id_ (); 327 cb_info.access_class = proc_auth; 328 329 tag, code = -1; 330 do while (code ^= 0); /* loop on name dup errors */ 331 tag = tag + 1; /* change the name to "name.n" */ 332 if tag > 499 then /* avoid infinite loop, but try hard */ 333 call abort_read (0, "Aborting file: 500 duplicate files in " || dirname, tell_user); 334 335 call ioa_$rsnnl ("^a.^d", new_file_name, len, file_name, tag); 336 337 if len > 32 then 338 call abort_read (0, "File name too long: " || substr (new_file_name, 1, len), tell_user); 339 340 call hcs_$create_branch_ (dirname, new_file_name, addr (cb_info), code); 341 if code = error_table_$namedup & overwrite then code = 0; 342 if code ^= 0 & code ^= error_table_$namedup then /* also very bad */ 343 call abort_read (code, "Unable to create branch in pool dir: " || rtrim (dirname), silent); 344 end; 345 346 file_path = rtrim (dirname) || ">" || rtrim (new_file_name); /* make error msgs easier */ 347 348 call msf_manager_$open (dirname, new_file_name, fcbp, code); 349 if code ^= 0 then 350 call abort_read (code, "Unable to open new pool entry " || file_path, silent); 351 352 component = 0; /* start with the first component - 0 */ 353 call msf_manager_$get_ptr (fcbp, component, "0"b, filep, bc, code); 354 if filep = null then 355 call abort_read (code, "Unable to initiate new pool entry " || file_path, silent); 356 357 /* Set up the translation modes for the record text. */ 358 359 call ioa_$rsnnl ("^[^^^]trim,^[^^^]lower_case,^[^^^]add_nl,^[^^^]contin.", input_modes, len, 360 ^trim, ^lower_case, ^add_nl, ^contin); 361 362 call card_util_$modes (input_modes, input_mode_bits, "", code); 363 if code ^= 0 then call abort_read (code, "Unable to set file input modes", tell_user); 364 365 call iox_$control (input_iocbp, "reset", null, ignore); /* clear any accounting data */ 366 367 /* This procedure ASSUMES an element size of 9 bits, I.E. chars */ 368 369 element_size = 9; /* 9 bits per character */ 370 max_chars = divide ((sys_info$max_seg_size * 36), element_size, 35); /* get number of chars in a segment */ 371 chars_in_last_seg = 0; /* set the number of chars used in last MSF component */ 372 chars_left_in_seg = max_chars; /* set number of chars remaining in segment */ 373 374 read_next_record: 375 376 record_len = 0; 377 record_buffer = ""; 378 379 call iox_$get_chars (input_iocbp, addr (record_buffer), max_record_len, record_len, code); 380 if code ^= 0 then do; 381 if code = error_table_$eof_record then goto end_read_loop; /* NORMAL EXIT */ 382 383 else if code = error_table_$end_of_info | code = error_table_$short_record then code = 0; 384 385 else call abort_read (code, "Error while reading data. Aborting file.", silent); /* ERROR EXIT */ 386 end; 387 388 record = substr (record_buffer, 1, record_len); /* put into var string for translation */ 389 390 call card_util_$translate (input_mode_bits, record); 391 392 record_len = length (record); /* get the new length after translation */ 393 left = chars_left_in_seg - record_len; /* must be at least 1 char left to bump ptr */ 394 395 if left <= 0 then do; /* if not enough, put in part and start new component */ 396 string_len = chars_left_in_seg; /* set size of based string */ 397 filep -> string = substr (record, 1, chars_left_in_seg); 398 399 component = component + 1; /* start the next MSF component */ 400 401 if component = 1 then do; /* about to force conversion to MSF ... */ 402 call pool_manager_$add_quota (root_dir, 260, code); /* ... need extra quota during conversion */ 403 if code ^= 0 then do; /* couldn't get it: let the operator try to correct it ... */ 404 call report (NL || "Insufficient quota in pool to convert to MSF." || NL, silent); 405 signal command_level; 406 call pool_manager_$add_quota (root_dir, 260, code); /* ... and try again */ 407 end; 408 if code ^= 0 then 409 call abort_read (code, "Insufficient quota in pool to convert to MSF.", silent); 410 end; 411 412 call msf_manager_$get_ptr (fcbp, component, "1"b, filep, bc, code); 413 if filep = null then 414 call abort_read (code, "Unable to initiate next MSF component", silent); 415 416 if component = 1 then /* give back the quota we got temporarily */ 417 call pool_manager_$add_quota (root_dir, -260, (0)); 418 419 if left = 0 then record = ""; /* if it fit exactly.... */ 420 else record = substr (record, chars_left_in_seg + 1); /* set image to last part of record */ 421 422 string_len = length (record); /* set the based string size */ 423 filep -> string = record; /* write the record into the output file */ 424 filep = addr (filep -> based_chars (string_len + 1)); /* move output pointer to where the next char goes */ 425 chars_left_in_seg = max_chars - string_len; /* room left in this component */ 426 chars_in_last_seg = string_len; /* restart last component count */ 427 end; 428 else do; /* the full record (+ 1 char) will fit this MSF component */ 429 string_len = length (record); /* set the length of the based string */ 430 filep -> string = record; /* and write out the data */ 431 filep = addr (filep -> based_chars (string_len + 1)); /* move output pointer to where the next char goes */ 432 chars_left_in_seg = left; /* do the accounting */ 433 chars_in_last_seg = chars_in_last_seg + string_len; /* update the number received */ 434 end; 435 go to read_next_record; 436 437 /* - - - we don't fall through here - - - - */ 438 439 440 end_read_loop: 441 442 read_done = "1"b; /* tell abort handler not to look for EOF */ 443 444 bc = multiply (chars_in_last_seg, element_size, 24, 0); 445 446 /* set bitcount of last component ... all others are max_seg_size * 36 */ 447 448 call msf_manager_$adjust (fcbp, component, bc, "111"b, code); 449 if code ^= 0 then call abort_read (code, "Error setting bit-count.", silent); 450 451 unspec (acle) = "0"b; /* get the acl structure ready */ 452 acle (1).name = rtrim (personid) || ".*"; /* put the file sender on the acl */ 453 acle (1).mode = "100"b; /* read access only */ 454 aclec = 1; 455 456 call msf_manager_$acl_add (fcbp, addr (acle), aclec, code); 457 if code ^= 0 then call abort_read (code, "Error setting ACL.", silent); 458 459 if fcbp ^= null then 460 call msf_manager_$close (fcbp); 461 462 fcbp = null; 463 464 if pool_open then do; 465 call pool_manager_$close_user_pool (root_dir, person, 1, "100"b|| (33)"0"b, code); /* close the pool */ 466 if code ^= 0 then call abort_read (code, "Error closing user's pool dir.", silent); 467 end; 468 pool_open = "0"b; /* all is well */ 469 470 unspec (count_structure) = ""b; /* clear the value in case of non inplemented order */ 471 472 call iox_$control (input_iocbp, "get_count", addr (count_structure), ignore); /* get record total */ 473 /* this can be used for charging in the future */ 474 call ioa_$rsnnl ("End-of-file for: ^a ^[(^d records)^]^/", user_msg, len, file_name, 475 (count_structure.records > 0), count_structure.records); 476 477 call report (substr (user_msg, 1, len), silent); /* log the end of file input */ 478 479 if file_data.auto_queue then do; 480 substr (dprint_arg.destination, 1, length (dprint_arg.destination)) = 481 substr (personid, 1, length (dprint_arg.destination)); 482 substr (dprint_arg.request_type, 1, length (dprint_arg.request_type)) = 483 substr (file_data.request_type, 1, length (dprint_arg.request_type)); 484 dprint_arg.bit_count = (component * 36 * sys_info$max_seg_size) + bc; 485 if ^file_data.no_ident then /* user requested dprint/dpunch on ++CONTROL record ... */ 486 dprint_arg.delete = 0; /* ... so don't delete file before they can copy it */ 487 488 call dprint_ (dirname, new_file_name, dpap, code); 489 if code ^= 0 then go to let_it_stay; 490 491 call ioa_$rsnnl ("File ""^a"" from station ^a queued for ^[dprint^;dpunch^].^/", 492 user_msg, len, file_name, station, (file_data.device_type = printer_input_device)); 493 494 call notify_user (substr (user_msg, 1, len)); /* inform the user if defined */ 495 end; 496 else do; 497 let_it_stay: 498 call ioa_$rsnnl ("File ""^a"" from station ^a stored in ^a^/", user_msg, len, file_name, station, file_path); 499 500 call notify_user (substr (user_msg, 1, len)); /* inform the user if defined */ 501 end; 502 503 if testing then do; 504 call iox_$put_chars (test_iocbp, addr (user_msg), len, code); 505 if code ^= 0 then testing = "0"b; 506 end; 507 508 goto start; /* see if there is another file to read */ 509 510 511 abort_exit: 512 call clean_up; 513 514 a_code = code; 515 return; 516 517 518 abort: proc (code, message); 519 520 dcl message char (*); 521 dcl code fixed bin (35); 522 dcl abort_msg char (256); 523 dcl len fixed bin (24); 524 525 if code ^= 0 then call convert_status_code_ (code, short, long); 526 else long = ""; 527 528 call ioa_$rsnnl ("receive_file_: Unable to continue input function.^[^/^a^;^s^]^/^a^/", 529 abort_msg, len, (code ^= 0), long, message); 530 531 call report (rtrim (abort_msg), silent); /* tell just the operator */ 532 533 goto abort_exit; 534 535 end abort; 536 537 538 notify_user: proc (message); 539 dcl message char (*); 540 541 if user_defined then /* be sure user from ++IDENT is defined */ 542 call send_mail_ (personid, message, addr (send_mail_info), (0)); 543 544 return; 545 546 end notify_user; 547 548 abort_read: proc (code, message, tell_user); 549 550 dcl code fixed bin (35); 551 dcl message char (*); 552 dcl tell_user bit (1); 553 dcl abort_msg char (256); 554 dcl len fixed bin (24); 555 dcl count fixed bin (24); 556 557 if code ^= 0 then call convert_status_code_ (code, short, long); 558 else long = ""; 559 560 call ioa_$rsnnl ("Aborting input of file^[ ""^a"" (for ^a)^;^2s^] from station ^a.^/^[^a^/^;^s^]^a^/", 561 abort_msg, len, user_defined, file_name, personid, station, (code ^= 0), long, message); 562 563 call report (rtrim (abort_msg), tell_user); /* route the message as requested */ 564 565 call clean_up; 566 567 if read_done | ^file_in_progress then go to start; /* was the EOF already read? */ 568 569 call report ("Skipping to EOF record." || NL, silent); 570 571 code = 0; 572 do count = 0 by 1 while (code ^= error_table_$eof_record); 573 call iox_$get_chars (input_iocbp, addr (record_buffer), max_record_len, record_len, code); 574 if code ^= 0 then do; 575 if code = error_table_$end_of_info | code = error_table_$short_record then code = 0; 576 if code ^= error_table_$eof_record then 577 call abort (code, "Read error."); 578 end; 579 end; 580 if testing then do; 581 call ioa_$rsnnl ("Aborted ^d records before EOF.^/", log_msg, len, count); 582 call iox_$put_chars (test_iocbp, addr (log_msg), len, code); 583 if code ^= 0 then testing = "0"b; 584 end; 585 go to start; /* go back and check for commands and next ++IDENT */ 586 587 end abort_read; 588 589 /* Report a non-fatal error encountered during control record processing */ 590 591 control_record_error: 592 procedure (code, message, tell_user); 593 594 dcl code fixed binary (35) parameter; 595 dcl message character (*) parameter; 596 dcl tell_user bit (1) parameter; 597 dcl error_message character (256); 598 599 if code ^= 0 then /* include system error message in report */ 600 call convert_status_code_ (code, short, long); 601 else long = ""; /* just to be safe; it won't be in ioa_ string anyway */ 602 603 call ioa_$rsnnl ("During input of file ""^a"" (for ^a) from station ^a.^/^[^a^/^;^s^]^a^/", 604 error_message, (0b), 605 file_name, personid, station, (code ^= 0), long, 606 message); /* include supplied message */ 607 608 call report (rtrim (error_message), tell_user); /* issue the complaint */ 609 610 return; /* and that's all: it's not fatal... */ 611 612 end control_record_error; 613 614 report: proc (message, tell_user); 615 616 dcl code fixed bin (35); 617 dcl message char (*); 618 dcl tell_user bit (1); 619 dcl opr_iocbp ptr; 620 621 if tell_user then 622 call notify_user (message); 623 624 if slave_iocbp = null then opr_iocbp = master_iocbp; 625 else opr_iocbp = slave_iocbp; 626 write_msg: 627 call iox_$put_chars (opr_iocbp, addr (message), length (message), code); 628 if code ^= 0 then do; 629 if opr_iocbp = slave_iocbp then do; /* tell the master if slave gets error */ 630 opr_iocbp = master_iocbp; 631 go to write_msg; 632 end; 633 634 /* For other errors we can't do much, so just return. */ 635 636 end; 637 638 if testing then do; 639 call iox_$put_chars (test_iocbp, addr (message), length (message), code); 640 if code ^= 0 then testing = "0"b; 641 end; 642 643 return; 644 645 end report; 646 647 648 649 650 651 read_control_record: proc (key, field, field_cnt, code); 652 653 dcl key char (*) var parameter; 654 dcl field (40) char (80) var parameter; 655 dcl field_cnt fixed bin parameter; 656 dcl code fixed bin (35) parameter; 657 658 dcl arg_string char (160) var; 659 dcl scan_done bit (1); 660 dcl field_begin fixed bin; 661 dcl field_len fixed bin; 662 dcl i fixed bin; 663 dcl len fixed bin (24); 664 665 key = ""; /* clear the return parameters */ 666 field (*) = ""; 667 field_cnt = 0; 668 669 call iox_$get_chars (input_iocbp, addr (record_buffer), max_record_len, record_len, code); 670 if code ^= 0 then do; 671 if code = error_table_$eof_record then return; 672 else if code = error_table_$end_of_info | code = error_table_$short_record then code = 0; 673 else call abort (code, "Read error."); 674 end; 675 676 if record_len = 0 then do; 677 code = error_table_$end_of_info; 678 return; 679 end; 680 681 record = substr (record_buffer, 1, record_len); /* use varying string for translation */ 682 683 if testing then do; /* keep a log of all control records read */ 684 call ioa_$rsnnl ("CTL (^a):^21t^a^/", log_msg, len, key_mode, record); 685 call iox_$put_chars (test_iocbp, addr (log_msg), len, code); 686 if code ^= 0 then testing = "0"b; 687 code = 0; /* just in case, make it quiet */ 688 end; 689 690 i = index (record, ESC_c); /* check for slew control chars and flush them */ 691 692 if i = 1 then do; /* this is the pre-slew sequence */ 693 i = index (record, ETX); /* find the closing ETX */ 694 /* if not found, strip nothing */ 695 record = substr (record, i + 1); 696 end; 697 else if i > 1 then do; /* this is the post slew sequence */ 698 record = substr (record, 1, i - 1); /* take up to the slew, and junk the rest */ 699 end; 700 701 record = ltrim (record, NL || FF || SP); /* strip any other pad or slew control */ 702 record = rtrim (record, NL || FF || SP); 703 704 call card_util_$translate (control_mode_bits, record); 705 706 len = search (record, " "); /* find the first space char */ 707 if len = 0 then do; /* no spaces, maybe ++input */ 708 key = record; /* try it */ 709 return; 710 end; 711 712 key = substr (record, 1, len - 1); /* this is the ++ keyword */ 713 714 arg_string = ltrim (rtrim (substr (record, len))); /* args are the remainder of the record */ 715 716 field_begin = 1; 717 scan_done = "0"b; 718 719 do i = 1 to 40 while (^scan_done); /* 40 args max */ 720 field_len = search (substr (arg_string, field_begin), " "); 721 if field_len = 0 then do; 722 field_len = length (arg_string) - field_begin + 1; 723 scan_done = "1"b; 724 end; 725 else field_len = field_len - 1; 726 field (i) = substr (arg_string, field_begin, field_len); 727 field_begin = field_begin + field_len + verify (substr (arg_string, field_begin + field_len), " ") - 1; 728 field_cnt = i; 729 end; 730 731 return; 732 733 end read_control_record; 734 735 decode_format_args: proc (field, field_cnt); 736 737 dcl field (40) char (80) var; 738 dcl field_cnt fixed bin; 739 dcl i fixed bin; 740 741 if field_cnt < 1 then do; 742 call control_record_error (0, "Incorrect ++FORMAT record ignored: " || record, tell_user); 743 go to read_next_control_record; 744 end; 745 746 do i = 1 to field_cnt; 747 if field (i) = "trim" then trim = "1"b; 748 else if field (i) = "notrim" then trim = "0"b; 749 else if field (i) = "lowercase" then lower_case = "1"b; 750 else if field (i) = "noconvert" then lower_case = "0"b; 751 else if field (i) = "addnl" then add_nl = "1"b; 752 else if field (i) = "noaddnl" then add_nl = "0"b; 753 else if field (i) = "contin" then contin = "1"b; 754 else if field (i) = "nocontin" then contin = "0"b; 755 else call control_record_error (0, "Undefined mode ignored on ++FORMAT record: " || field (i), tell_user); 756 end; 757 758 return; 759 760 end decode_format_args; 761 762 /* Process ++CONTROL record */ 763 764 decode_control_args: 765 procedure (fields, n_fields); 766 767 dcl fields (40) character (80) varying parameter; 768 dcl n_fields fixed binary parameter; 769 dcl idx fixed binary; 770 dcl generic_type character (32); 771 dcl local_request_type character (24); 772 773 774 if n_fields < 1 then do; 775 call control_record_error (0, "Incorrect ++CONTROL record ignored: " || record, tell_user); 776 go to read_next_control_record; 777 end; 778 779 780 do idx = 1 to n_fields; 781 782 if (fields (idx) = "overwrite") then /* overwrite previous versions in compiler pool */ 783 overwrite = "1"b; 784 785 else if (fields (idx) = "auto_queue") then /* automatically queue file for printing/punching */ 786 file_data.auto_queue = "1"b; 787 788 else if ((fields (idx) = "request_type") | (fields (idx) = "rqt")) 789 then do; /* specific request type for automatic queuing */ 790 if (idx = n_fields) then do; 791 call control_record_error (error_table_$noarg, 792 "Request type name must follow ""request_type"" key on ++CONTROL record; the ""request_type"" key is ignored.", 793 tell_user); 794 return; /* this was the last field on the record */ 795 end; 796 idx = idx + 1; /* request type name is next field */ 797 if length (fields (idx)) > length (local_request_type) then do; 798 call control_record_error (error_table_$bigarg, 799 "Request type name must be less than 25 characters long; not """ || fields (idx) || """; the ""request_type"" key is ignored.", 800 tell_user); 801 go to check_next_control_field; 802 end; 803 local_request_type = fields (idx); 804 call iod_info_$generic_type (local_request_type, generic_type, code); 805 if code ^= 0 then do; 806 call control_record_error (code, 807 """" || fields (idx) || """; the ""request_type"" key is ignored.", 808 tell_user); 809 go to check_next_control_field; 810 end; 811 if ((file_data.device_type = printer_input_device) & (generic_type ^= "printer")) | 812 ((file_data.device_type = punch_input_device) & (generic_type ^= "punch")) 813 then do; /* wrong type of request type */ 814 call control_record_error (0, 815 "Request type """ || fields (idx) || """ specified on ++CONTROL record has incorrect generic type; the ""request_type"" key is ignored.", 816 tell_user); 817 go to check_next_control_field; 818 end; 819 file_data.request_type = local_request_type; /* got a valid one */ 820 end; 821 822 else call control_record_error (0, "Unknown key on ++CONTROL record ignored: " || fields (idx), 823 tell_user); 824 825 check_next_control_field: 826 end; 827 828 return; 829 830 end decode_control_args; 831 832 clean_up: proc; 833 834 dcl ignore fixed bin (35); 835 836 if fcbp ^= null then do; 837 call msf_manager_$close (fcbp); 838 fcbp = null; /* don't repeat this */ 839 call delete_$path (dirname, new_file_name, "100100"b, "", ignore); 840 end; 841 842 if pool_open then do; 843 call pool_manager_$close_user_pool (root_dir, person, 1, "100"b || (33)"0"b, ignore); 844 pool_open = "0"b; 845 end; 846 847 return; 848 849 end clean_up; 850 851 852 853 overflow_handler: proc; 854 855 dcl code fixed bin (35); 856 857 call pool_manager_$add_quota (root_dir, 10, code); /* add 10 pages and keep going */ 858 if code ^= 0 then do; 859 call report (NL ||"No available quota in pool." || NL, silent); 860 signal command_level; /* allow operator to respond */ 861 end; 862 863 return; /* restart where we stopped if it returns */ 864 865 end overflow_handler; 866 867 868 INITIALIZE_STUFF: proc; 869 870 file_data = receive_file_data; /* set up our working copy of the control data */ 871 testing = file_data.testing; /* grab this once, we may need to cancel it */ 872 873 default_personid = get_group_id_ (); /* get names to be used for no_ident case */ 874 default_person = before (default_personid, "."); 875 default_project = before (after (default_personid, "."), "."); 876 default_personid = rtrim (default_person) || "." || default_project; /* omit the instance tag */ 877 878 dpap = addr (dprint_arg_buf); /* where we build the message for dprint_ */ 879 dprint_arg.version = dprint_arg_version_9; 880 dprint_arg.copies = 1; 881 dprint_arg.queue = 0; /* use the drfault queue at all times */ 882 dprint_arg.delete = 1; /* always delete after print/punch */ 883 dprint_arg.pt_pch = file_data.device_type; /* they just happen to match */ 884 dprint_arg.notify = 0; 885 dprint_arg.heading = ""; /* later */ 886 if file_data.device_type = printer_input_device then 887 dprint_arg.output_module = 1; /* 1 = print */ 888 else dprint_arg.output_module = 3; /* 3 = MCC or character output */ 889 dprint_arg.dest = ""; /* obsolete, but initialize */ 890 dprint_arg.carriage_control = ""b; /* no options ... */ 891 if file_data.device_type = printer_input_device then do; /* (printer only) */ 892 dprint_arg.nep = "1"b; /* ... except -no_endpage */ 893 dprint_arg.esc = "1"b; /* ... and escape processing (logical channel skips) */ 894 end; 895 dprint_arg.forms = ""; 896 dprint_arg.lmargin = 0; 897 dprint_arg.line_lth = 0; /* again use the default */ 898 dprint_arg.class = ""; /* obsolete, but initialize */ 899 dprint_arg.page_lth = 0; 900 dprint_arg.top_label = ""; 901 dprint_arg.bottom_label = ""; 902 dprint_arg.bit_count = 0; 903 dprint_arg.form_name = ""; 904 dprint_arg.destination = ""; /* later */ 905 dprint_arg.chan_stop_path = ""; 906 substr (dprint_arg.request_type, 1, length (dprint_arg.request_type)) = 907 substr (file_data.request_type, 1, length (dprint_arg.request_type)); 908 dprint_arg.defer_until_process_termination = 0; 909 910 unspec (send_mail_info) = "0"b; 911 send_mail_info.version = send_mail_info_version_2; 912 send_mail_info.sent_from = station; 913 send_mail_info.wakeup = "1"b; 914 send_mail_info.always_add = "1"b; 915 send_mail_info.never_add = "0"b; 916 send_mail_info.notify = "0"b; 917 send_mail_info.acknowledge = "0"b; 918 919 proc_auth = get_authorization_ (); /* get caller's authorization to use for create_branch_ */ 920 921 call card_util_$modes (control_modes, control_mode_bits, "", code); /* get a bit string for control records */ 922 if code ^= 0 then 923 call abort (code, "Unable to set control modes."); 924 925 test_iocbp = null; /* no place to write log messages defined yet */ 926 927 if testing then do; /* see if we have a side file to log control records */ 928 929 /* Test mode for this procedure consists of writing control records and messages into a log file. */ 930 /* We assume that the IO switch "test_output" is attached through vfile_ to the log file. */ 931 /* Test mode is cancelled if this switch is not found or an error occurs while writing. */ 932 933 call iox_$look_iocb ("test_output", test_iocbp, code); 934 if code ^= 0 | test_iocbp = null then testing = "0"b; /* if not cancel test mode */ 935 else do; 936 call ioa_$rsnnl ("^/receive_file_: Entry initialization for station ^a.^2/", log_msg, len, station); 937 call iox_$put_chars (test_iocbp, addr (log_msg), len, code); 938 if code ^= 0 then testing = "0"b; /* cancel on errors */ 939 end; 940 end; 941 942 end INITIALIZE_STUFF; 943 944 945 RESET_PARAMETERS: proc; 946 947 file_data = receive_file_data; /* reset to caller's defaults */ 948 949 file_name = unique_chars_ (""b); /* in case of the no_ident option */ 950 dirname = ""; 951 person = default_person; 952 project = default_project; 953 personid = default_personid; 954 955 input_mode_bits = "0"b; 956 pool_open = "0"b; /* the user pool is not yet open */ 957 read_done = "0"b; 958 file_in_progress = "0"b; 959 user_defined = "0"b; 960 filep, fcbp = null; 961 962 add_nl = "0"b; /* set the default data translation modes */ 963 lower_case = "0"b; 964 overwrite = "0"b; 965 contin = "0"b; 966 trim = "0"b; 967 968 substr (dprint_arg.request_type , 1, length (dprint_arg.request_type )) = 969 substr (file_data.request_type, 1, length (dprint_arg.request_type)); 970 dprint_arg.heading = rtrim (station) || " Output OPERATOR PLEASE LOOK INSIDE FOR BANNER"; 971 dprint_arg.bit_count = 0; 972 973 return; 974 975 end RESET_PARAMETERS; 976 977 978 979 980 981 end receive_file_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 03/15/89 0800.0 receive_file_.pl1 >special_ldd>install>MR12.3-1025>receive_file_.pl1 177 1 10/30/80 1648.7 find_input_sw_info.incl.pl1 >ldd>include>find_input_sw_info.incl.pl1 179 2 10/30/80 1648.7 receive_file_data.incl.pl1 >ldd>include>receive_file_data.incl.pl1 181 3 03/15/89 0759.4 create_branch_info.incl.pl1 >special_ldd>install>MR12.3-1025>create_branch_info.incl.pl1 183 4 04/27/78 1504.4 send_mail_info.incl.pl1 >ldd>include>send_mail_info.incl.pl1 185 5 11/09/88 0759.7 dprint_arg.incl.pl1 >ldd>include>dprint_arg.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. ESC_c constant char(2) initial packed unaligned dcl 137 ref 690 ETX constant char(1) initial packed unaligned dcl 138 ref 693 FF constant char(1) initial packed unaligned dcl 142 ref 701 702 NL 010760 constant char(1) initial packed unaligned dcl 140 ref 225 247 284 297 404 404 569 701 702 859 859 SP constant char(1) initial packed unaligned dcl 139 ref 701 702 a_code parameter fixed bin(35,0) dcl 42 set ref 32 189* 206* 514* a_data_ptr parameter pointer dcl 41 ref 32 192 a_root_dir parameter char packed unaligned dcl 38 ref 32 190 a_station parameter char packed unaligned dcl 40 ref 32 191 a_sw_info_p parameter pointer dcl 39 ref 32 199 abort_msg 000100 automatic char(256) packed unaligned dcl 522 in procedure "abort" set ref 528* 531 531 abort_msg 000100 automatic char(256) packed unaligned dcl 553 in procedure "abort_read" set ref 560* 563 563 access_class 20 004153 automatic bit(72) level 2 dcl 121 set ref 327* acknowledge 11(05) 004225 automatic bit(1) level 3 packed packed unaligned dcl 4-5 set ref 917* acle 004125 automatic structure array level 1 dcl 115 set ref 451* 456 456 aclec 000100 automatic fixed bin(17,0) dcl 47 set ref 454* 456* add_nl 000101 automatic bit(1) packed unaligned dcl 48 set ref 359 751* 752* 962* addr builtin function dcl 109 ref 340 340 379 379 424 431 456 456 472 472 504 504 541 541 573 573 582 582 626 626 639 639 669 669 685 685 878 937 937 after builtin function dcl 109 ref 272 875 always_add 11(02) 004225 automatic bit(1) level 3 packed packed unaligned dcl 4-5 set ref 914* arg_string 004572 automatic varying char(160) dcl 658 set ref 714* 720 722 726 727 auto_queue 1(02) 004176 automatic bit(1) level 3 packed packed unaligned dcl 123 set ref 479 785* based_chars based char(1) array packed unaligned dcl 113 set ref 424 431 bc 000102 automatic fixed bin(24,0) dcl 49 set ref 353* 412* 444* 448* 484 before builtin function dcl 109 ref 271 874 875 bit_count 204 based fixed bin(35,0) level 2 dcl 5-24 set ref 484* 902* 971* bottom_label 142 based char(136) level 2 dcl 5-24 set ref 901* card_util_$modes 000032 constant entry external dcl 150 ref 362 921 card_util_$translate 000034 constant entry external dcl 151 ref 390 704 carriage_control 32 based structure level 2 dcl 5-24 set ref 890* cb_info 004153 automatic structure level 1 dcl 121 set ref 322* 340 340 chan_stop_path 221 based char(168) level 2 dcl 5-24 set ref 905* chars_in_last_seg 003511 automatic fixed bin(24,0) dcl 79 set ref 371* 426* 433* 433 444 chars_left_in_seg 001471 automatic fixed bin(24,0) dcl 53 set ref 372* 393 396 397 420 425* 432* class 75 based char(8) level 2 dcl 5-24 set ref 898* cleanup 004116 stack reference condition dcl 107 ref 223 code parameter fixed bin(35,0) dcl 521 in procedure "abort" set ref 518 525 525* 528 code parameter fixed bin(35,0) dcl 656 in procedure "read_control_record" set ref 651 669* 670 671 672 672 672* 673* 677* 685* 686 687* code parameter fixed bin(35,0) dcl 550 in procedure "abort_read" set ref 548 557 557* 560 571* 572 573* 574 575 575 575* 576 576* 582* 583 code parameter fixed bin(35,0) dcl 594 in procedure "control_record_error" set ref 591 599 599* 603 code 000100 automatic fixed bin(35,0) dcl 616 in procedure "report" set ref 626* 628 639* 640 code 001473 automatic fixed bin(35,0) dcl 55 in procedure "receive_file_" set ref 195* 224* 237* 240 240* 251* 252 294* 296 300 300* 317* 318 318* 329* 330 340* 341 341* 342 342 342* 348* 349 349* 353* 354* 362* 363 363* 379* 380 381 383 383 383* 385* 402* 403 406* 408 408* 412* 413* 448* 449 449* 456* 457 457* 465* 466 466* 488* 489 504* 505 514 804* 805 806* 921* 922 922* 933* 934 937* 938 code 000106 automatic fixed bin(35,0) dcl 855 in procedure "overflow_handler" set ref 857* 858 command_level 004110 stack reference condition dcl 107 ref 405 860 component 001474 automatic fixed bin(17,0) dcl 56 set ref 352* 353* 399* 399 401 412* 416 448* 484 contin 001475 automatic bit(1) packed unaligned dcl 57 set ref 359 753* 754* 965* control_mode_bits 003433 automatic bit(36) packed unaligned dcl 72 set ref 704* 921* control_modes 000000 constant char(32) initial packed unaligned dcl 136 set ref 921* convert_status_code_ 000042 constant entry external dcl 154 ref 525 557 599 copies 1 based fixed bin(17,0) level 2 dcl 5-24 set ref 880* count 000201 automatic fixed bin(24,0) dcl 555 set ref 572* 581* count_structure 004211 automatic structure level 1 dcl 125 set ref 470* 472 472 create_branch_info based structure level 1 dcl 3-17 create_branch_version_2 constant fixed bin(17,0) initial dcl 3-35 ref 323 cu_$level_get 000044 constant entry external dcl 155 ref 325 data_idx 004071 automatic fixed bin(17,0) dcl 100 set ref 204* 205 205 211 215 242 default_person 001565 automatic char(32) packed unaligned dcl 62 set ref 874* 876 951 default_personid 001605 automatic char(32) packed unaligned dcl 64 set ref 873* 874 875 876* 953 default_project 001575 automatic char(32) packed unaligned dcl 63 set ref 875* 876 952 defer_until_process_termination 301 based fixed bin(17,0) level 2 dcl 5-24 set ref 908* delete 2 based fixed bin(17,0) level 2 dcl 5-24 set ref 485* 882* delete_$path 000046 constant entry external dcl 156 ref 839 dest 27 based char(12) level 2 dcl 5-24 set ref 889* destination 213 based char(24) level 2 dcl 5-24 set ref 480 480* 480 904* device_type 2 004176 automatic fixed bin(17,0) level 2 dcl 123 set ref 491 811 811 883 886 891 dirname 001512 automatic char(168) packed unaligned dcl 60 set ref 317* 332 340* 342 346 348* 488* 839* 950* divide builtin function dcl 109 ref 370 done 001564 automatic bit(1) packed unaligned dcl 61 set ref 292* 293 301* dpap 004240 automatic pointer dcl 5-21 set ref 480 480 480 482 482 482 484 485 488* 878* 879 880 881 882 883 884 885 886 888 889 890 892 893 895 896 897 898 899 900 901 902 903 904 905 906 906 906 908 968 968 968 970 971 dprint_ 000050 constant entry external dcl 157 ref 488 dprint_arg based structure level 1 dcl 5-24 dprint_arg_buf 004242 automatic structure level 1 dcl 5-22 set ref 878 dprint_arg_version_9 constant fixed bin(17,0) initial dcl 5-77 ref 879 element_size 001615 automatic fixed bin(17,0) dcl 65 set ref 369* 370 444 error_message 000100 automatic char(256) packed unaligned dcl 597 set ref 603* 608 608 error_table_$bad_arg 000012 external static fixed bin(35,0) dcl 146 ref 206 error_table_$bigarg 000014 external static fixed bin(35,0) dcl 146 set ref 798* error_table_$end_of_info 000020 external static fixed bin(35,0) dcl 146 ref 383 575 672 677 error_table_$eof_record 000022 external static fixed bin(35,0) dcl 146 ref 252 296 381 572 576 671 error_table_$namedup 000024 external static fixed bin(35,0) dcl 146 ref 341 342 error_table_$noarg 000026 external static fixed bin(35,0) dcl 146 set ref 791* error_table_$short_record 000016 external static fixed bin(35,0) dcl 146 ref 383 575 672 error_table_$unimplemented_version 000030 external static fixed bin(35,0) dcl 146 ref 195 esc 32(06) based bit(1) level 3 packed packed unaligned dcl 5-24 set ref 893* fcbp 001616 automatic pointer dcl 66 set ref 348* 353* 412* 448* 456* 459 459* 462* 836 837* 838* 960* field 001620 automatic varying char(80) array dcl 67 in procedure "receive_file_" set ref 251* 264 267 268 271 272 294* 302* 304* field parameter varying char(80) array dcl 737 in procedure "decode_format_args" ref 735 747 748 749 750 751 752 753 754 755 field parameter varying char(80) array dcl 654 in procedure "read_control_record" set ref 651 666* 726* field_begin 004644 automatic fixed bin(17,0) dcl 660 set ref 716* 720 722 726 727* 727 727 field_cnt parameter fixed bin(17,0) dcl 738 in procedure "decode_format_args" ref 735 741 746 field_cnt parameter fixed bin(17,0) dcl 655 in procedure "read_control_record" set ref 651 667* 728* field_cnt 003330 automatic fixed bin(17,0) dcl 68 in procedure "receive_file_" set ref 251* 261 261 266 270 294* 302* 304* field_len 004645 automatic fixed bin(17,0) dcl 661 set ref 720* 721 722* 725* 725 726 727 727 fields parameter varying char(80) array dcl 767 ref 764 782 785 788 788 797 798 803 806 814 822 file_data 004176 automatic structure level 1 dcl 123 set ref 870* 947* file_in_progress 004072 automatic bit(1) initial packed unaligned dcl 101 set ref 101* 225 313* 567 958* file_name 001476 automatic varying char(32) dcl 58 set ref 247 264* 284* 335* 474* 491* 497* 560* 603* 949* file_path 003556 automatic varying char(168) dcl 87 set ref 346* 349 354 497* filep 001510 automatic pointer dcl 59 set ref 353* 354 397 412* 413 423 424* 424 430 431* 431 960* find_input_switch_ 000052 constant entry external dcl 158 ref 237 flags 1 004176 automatic structure level 2 dcl 123 form_name 205 based char(24) level 2 dcl 5-24 set ref 903* forms 71 based char(8) level 2 dcl 5-24 set ref 895* generic_type 004671 automatic char(32) packed unaligned dcl 770 set ref 804* 811 811 get_authorization_ 000054 constant entry external dcl 159 ref 919 get_group_id_ 000056 constant entry external dcl 160 ref 326 873 hcs_$create_branch_ 000070 constant entry external dcl 165 ref 340 heading 6 based char(64) level 2 dcl 5-24 set ref 885* 970* i 004646 automatic fixed bin(17,0) dcl 662 in procedure "read_control_record" set ref 690* 692 693* 695 697 698 719* 726 728* i 004660 automatic fixed bin(17,0) dcl 739 in procedure "decode_format_args" set ref 746* 747 748 749 750 751 752 753 754 755* idx 004670 automatic fixed bin(17,0) dcl 769 set ref 780* 782 785 788 788 790 796* 796 797 798 803 806 814 822* ignore 003331 automatic fixed bin(35,0) dcl 69 in procedure "receive_file_" set ref 365* 472* ignore 000100 automatic fixed bin(35,0) dcl 834 in procedure "clean_up" set ref 839* 843* index builtin function dcl 109 ref 690 693 input_iocbp 004100 automatic pointer dcl 105 set ref 215* 217 365* 379* 472* 573* 669* input_mode_bits 003432 automatic bit(36) packed unaligned dcl 71 set ref 362* 390* 955* input_modes 003332 automatic char(256) packed unaligned dcl 70 set ref 359* 362* ioa_$rsnnl 000072 constant entry external dcl 166 ref 284 335 359 474 491 497 528 560 581 603 684 936 iocbp 2 based pointer array level 2 dcl 1-7 ref 210 211 215 iod_info_$generic_type 000074 constant entry external dcl 167 ref 804 iox_$control 000104 constant entry external dcl 171 ref 365 472 iox_$get_chars 000100 constant entry external dcl 169 ref 379 573 669 iox_$look_iocb 000076 constant entry external dcl 168 ref 933 iox_$put_chars 000102 constant entry external dcl 170 ref 504 582 626 639 685 937 key parameter varying char dcl 653 in procedure "read_control_record" set ref 651 665* 708* 712* key 003434 automatic varying char(32) dcl 73 in procedure "receive_file_" set ref 251* 254 294* 301 302 304 305 key_mode 003445 automatic char(32) packed unaligned dcl 74 set ref 233* 255* 259* 684* left 001472 automatic fixed bin(24,0) dcl 54 set ref 393* 395 419 432 len 000200 automatic fixed bin(24,0) dcl 523 in procedure "abort" set ref 528* len 003455 automatic fixed bin(24,0) dcl 75 in procedure "receive_file_" set ref 284* 335* 337 337 359* 474* 477 477 491* 494 494 497* 500 500 504* 936* 937* len 000200 automatic fixed bin(24,0) dcl 554 in procedure "abort_read" set ref 560* 581* 582* len 004647 automatic fixed bin(24,0) dcl 663 in procedure "read_control_record" set ref 684* 685* 706* 707 712 714 length builtin function dcl 109 ref 392 422 429 480 480 482 482 626 626 639 639 722 797 797 906 906 968 968 line_lth 74 based fixed bin(17,0) level 2 dcl 5-24 set ref 897* lmargin 73 based fixed bin(17,0) level 2 dcl 5-24 set ref 896* local_request_type 004701 automatic char(24) packed unaligned dcl 771 set ref 797 803* 804* 819 log_msg 003765 automatic char(256) packed unaligned dcl 97 set ref 581* 582 582 684* 685 685 936* 937 937 long 003456 automatic char(100) packed unaligned dcl 76 set ref 525* 526* 528* 557* 558* 560* 599* 601* 603* lower_case 003507 automatic bit(1) packed unaligned dcl 77 set ref 359 749* 750* 963* ltrim builtin function dcl 109 ref 701 714 master_iocbp 004074 automatic pointer dcl 103 set ref 210* 217 624 630 max_chars 003510 automatic fixed bin(24,0) dcl 78 set ref 370* 372 425 max_record_len 000010 constant fixed bin(24,0) initial dcl 135 set ref 379* 573* 669* message parameter char packed unaligned dcl 595 in procedure "control_record_error" set ref 591 603* message parameter char packed unaligned dcl 520 in procedure "abort" set ref 518 528* message parameter char packed unaligned dcl 617 in procedure "report" set ref 614 621* 626 626 626 626 639 639 639 639 message parameter char packed unaligned dcl 539 in procedure "notify_user" set ref 538 541* message parameter char packed unaligned dcl 551 in procedure "abort_read" set ref 548 560* mode 2 004153 automatic bit(3) level 2 in structure "cb_info" packed packed unaligned dcl 121 in procedure "receive_file_" set ref 324* mode 10 004125 automatic bit(36) array level 2 in structure "acle" dcl 115 in procedure "receive_file_" set ref 453* msf_manager_$acl_add 000066 constant entry external dcl 164 ref 456 msf_manager_$adjust 000040 constant entry external dcl 153 ref 448 msf_manager_$close 000060 constant entry external dcl 161 ref 459 837 msf_manager_$get_ptr 000064 constant entry external dcl 163 ref 353 412 msf_manager_$open 000062 constant entry external dcl 162 ref 348 multiply builtin function dcl 109 ref 444 n_fields parameter fixed bin(17,0) dcl 768 ref 764 774 780 790 n_iocb_ptrs 1 based fixed bin(17,0) level 2 dcl 1-7 ref 204 name 004125 automatic char(32) array level 2 dcl 115 set ref 452* nep 32 based bit(1) level 3 packed packed unaligned dcl 5-24 set ref 892* never_add 11(03) 004225 automatic bit(1) level 3 packed packed unaligned dcl 4-5 set ref 915* new_file_name 003512 automatic char(32) packed unaligned dcl 80 set ref 335* 337 340* 346 348* 488* 839* no_ident 1(01) 004176 automatic bit(1) level 3 packed packed unaligned dcl 123 set ref 246 485 notify 11(04) 004225 automatic bit(1) level 3 in structure "send_mail_info" packed packed unaligned dcl 4-5 in procedure "receive_file_" set ref 916* notify 5 based fixed bin(17,0) level 2 in structure "dprint_arg" dcl 5-24 in procedure "receive_file_" set ref 884* null builtin function dcl 109 ref 213 217 217 354 365 365 413 459 462 624 836 838 925 934 960 opr_iocbp 000102 automatic pointer dcl 619 set ref 624* 625* 626* 629 630* output_module 26 based fixed bin(17,0) level 2 dcl 5-24 set ref 886* 888* overwrite 003522 automatic bit(1) packed unaligned dcl 81 set ref 341 782* 964* page_lth 77 based fixed bin(17,0) level 2 dcl 5-24 set ref 899* person 003523 automatic char(32) packed unaligned dcl 82 set ref 267* 271* 275 275 280 317* 465* 843* 951* personid 003533 automatic char(32) packed unaligned dcl 83 set ref 280* 284* 452 480 541* 560* 603* 953* pool_manager_$add_quota 000106 constant entry external dcl 172 ref 402 406 416 857 pool_manager_$close_user_pool 000110 constant entry external dcl 173 ref 465 843 pool_manager_$open_user_pool 000112 constant entry external dcl 174 ref 317 pool_open 003543 automatic bit(1) packed unaligned dcl 84 set ref 320* 464 468* 842 844* 956* printer_input_device constant fixed bin(17,0) initial dcl 2-18 ref 491 811 886 891 proc_auth 003544 automatic bit(72) packed unaligned dcl 85 set ref 327 919* project 003546 automatic char(32) packed unaligned dcl 86 set ref 268* 272* 277 277 280 952* pt_pch 4 based fixed bin(17,0) level 2 dcl 5-24 set ref 883* punch_input_device constant fixed bin(17,0) initial dcl 2-19 ref 811 queue 3 based fixed bin(17,0) level 2 dcl 5-24 set ref 881* read_done 003631 automatic bit(1) packed unaligned dcl 88 set ref 440* 567 957* receive_file_data based structure level 1 dcl 2-7 ref 870 947 receive_file_data_ptr 004222 automatic pointer dcl 2-5 set ref 192* 194 870 947 receive_file_data_version_1 constant fixed bin(17,0) initial dcl 2-16 ref 194 record 000503 automatic varying char(2000) dcl 51 set ref 261 275 277 306 388* 390* 392 397 419* 420* 420 422 423 429 430 681* 684* 690 693 695* 695 698* 698 701* 701 702* 702 704* 706 708 712 714 742 775 record_buffer 000103 automatic char(1024) dcl 50 set ref 377* 379 379 388 573 573 669 669 681 record_len 001470 automatic fixed bin(24,0) dcl 52 set ref 374* 379* 388 392* 393 573* 669* 676 681 record_quota_overflow 004102 stack reference condition dcl 107 ref 221 records 4 004211 automatic fixed bin(35,0) level 2 dcl 125 set ref 474 474* request_type 273 based char(24) level 2 in structure "dprint_arg" packed packed unaligned dcl 5-24 in procedure "receive_file_" set ref 482 482* 482 906 906* 906 968 968* 968 request_type 3 004176 automatic char(32) level 2 in structure "file_data" dcl 123 in procedure "receive_file_" set ref 482 819* 906 968 rings 3 004153 automatic fixed bin(3,0) array level 2 dcl 121 set ref 325* 325* 325* root_dir 003632 automatic char(168) packed unaligned dcl 89 set ref 190* 317* 402* 406* 416* 465* 843* 857* rtrim builtin function dcl 109 ref 280 287 287 342 346 346 452 531 531 563 563 608 608 702 714 876 970 scan_done 004643 automatic bit(1) packed unaligned dcl 659 set ref 717* 719 723* search builtin function dcl 109 ref 706 720 send_mail_ 000036 constant entry external dcl 152 ref 541 send_mail_info 004225 automatic structure level 1 dcl 4-5 set ref 541 541 910* send_mail_info_version_2 004224 automatic fixed bin(17,0) initial dcl 4-3 set ref 4-3* 911 sent_from 1 004225 automatic char(32) level 2 dcl 4-5 set ref 912* short 003716 automatic char(8) packed unaligned dcl 92 set ref 525* 557* 599* silent 000072 constant bit(1) initial packed unaligned dcl 134 set ref 225* 247* 261* 275* 277* 287* 297* 342* 349* 354* 385* 404* 408* 413* 449* 457* 466* 477* 531* 569* 859* slave_iocbp 004076 automatic pointer dcl 104 set ref 211* 213* 624 625 629 source 003704 automatic fixed bin(17,0) dcl 90 set ref 237* 242 station 003705 automatic varying char(32) initial dcl 91 set ref 91* 191* 284* 491* 497* 560* 603* 912 936* 970 string based char packed unaligned dcl 111 set ref 397* 423* 430* string_len 004124 automatic fixed bin(17,0) dcl 112 set ref 396* 397 422* 423 424 425 426 429* 430 431 433 substr builtin function dcl 109 set ref 337 388 397 420 477 477 480* 480 482* 482 494 494 500 500 681 695 698 712 714 720 726 727 906* 906 968* 968 sw_info based structure level 1 dcl 1-7 sw_info_p 004220 automatic pointer dcl 1-5 set ref 199* 200 204 210 211 215 237* sw_info_version_1 constant fixed bin(17,0) initial dcl 1-17 ref 200 switches 11 004225 automatic structure level 2 dcl 4-5 sys_info$max_seg_size 000010 external static fixed bin(35,0) dcl 144 ref 370 484 tag 003720 automatic fixed bin(17,0) dcl 93 set ref 329* 331* 331 332 335* tell_user parameter bit(1) packed unaligned dcl 596 in procedure "control_record_error" set ref 591 608* tell_user parameter bit(1) packed unaligned dcl 618 in procedure "report" ref 614 621 tell_user 000071 constant bit(1) initial packed unaligned dcl 133 in procedure "receive_file_" set ref 305* 306* 332* 337* 363* 742* 755* 775* 791* 798* 806* 814* 822* tell_user parameter bit(1) packed unaligned dcl 552 in procedure "abort_read" set ref 548 563* test_iocbp 004066 automatic pointer dcl 98 set ref 504* 582* 639* 685* 925* 933* 934 937* testing 1 004176 automatic bit(1) level 3 in structure "file_data" packed packed unaligned dcl 123 in procedure "receive_file_" set ref 871 testing 003721 automatic bit(1) packed unaligned dcl 94 in procedure "receive_file_" set ref 503 505* 580 583* 638 640* 683 686* 871* 927 934* 938* top_label 100 based char(136) level 2 dcl 5-24 set ref 900* trim 004070 automatic bit(1) packed unaligned dcl 99 set ref 359 747* 748* 966* unique_chars_ 000114 constant entry external dcl 175 ref 949 unspec builtin function dcl 109 set ref 322* 451* 470* 910* user_defined 003722 automatic bit(1) packed unaligned dcl 95 set ref 282* 541 560* 959* user_msg 003723 automatic char(136) packed unaligned dcl 96 set ref 284* 287 287 474* 477 477 491* 494 494 497* 500 500 504 504 userid 6 004153 automatic char(32) level 2 dcl 121 set ref 326* verify builtin function dcl 109 ref 727 version based fixed bin(17,0) level 2 in structure "sw_info" dcl 1-7 in procedure "receive_file_" ref 200 version based fixed bin(17,0) level 2 in structure "receive_file_data" dcl 2-7 in procedure "receive_file_" ref 194 version 004225 automatic fixed bin(17,0) level 2 in structure "send_mail_info" dcl 4-5 in procedure "receive_file_" set ref 911* version 004153 automatic fixed bin(17,0) level 2 in structure "cb_info" dcl 121 in procedure "receive_file_" set ref 323* version based fixed bin(17,0) level 2 in structure "dprint_arg" dcl 5-24 in procedure "receive_file_" set ref 879* wakeup 11 004225 automatic bit(1) level 3 packed packed unaligned dcl 4-5 set ref 913* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. DP_PLOT internal static fixed bin(17,0) initial dcl 5-81 DP_PRINT internal static fixed bin(17,0) initial dcl 5-81 DP_PUNCH internal static fixed bin(17,0) initial dcl 5-81 dprint_arg_version_1 internal static fixed bin(17,0) initial dcl 5-69 dprint_arg_version_10 internal static fixed bin(17,0) initial dcl 5-78 dprint_arg_version_2 internal static fixed bin(17,0) initial dcl 5-70 dprint_arg_version_3 internal static fixed bin(17,0) initial dcl 5-71 dprint_arg_version_4 internal static fixed bin(17,0) initial dcl 5-72 dprint_arg_version_5 internal static fixed bin(17,0) initial dcl 5-73 dprint_arg_version_6 internal static fixed bin(17,0) initial dcl 5-74 dprint_arg_version_7 internal static fixed bin(17,0) initial dcl 5-75 dprint_arg_version_8 internal static fixed bin(17,0) initial dcl 5-76 NAMES DECLARED BY EXPLICIT CONTEXT. INITIALIZE_STUFF 007733 constant entry internal dcl 868 ref 219 RESET_PARAMETERS 010400 constant entry internal dcl 945 ref 230 abort 004701 constant entry internal dcl 518 ref 240 300 318 576 673 922 abort_exit 004670 constant label dcl 511 ref 533 abort_read 005120 constant entry internal dcl 548 ref 261 275 277 305 332 337 342 349 354 363 385 408 413 449 457 466 bad_arg 001266 constant label dcl 206 ref 217 bad_version 001246 constant label dcl 195 ref 200 check_next_control_field 007516 constant label dcl 825 ref 801 809 817 clean_up 007523 constant entry internal dcl 832 ref 227 511 565 control_record_error 005524 constant entry internal dcl 591 ref 306 742 755 775 791 798 806 814 822 decode_control_args 007033 constant entry internal dcl 764 ref 304 decode_format_args 006614 constant entry internal dcl 735 ref 302 end_read_loop 004020 constant label dcl 440 ref 381 get_pool_dir 002352 constant label dcl 313 set ref 248 let_it_stay 004564 constant label dcl 497 ref 489 notify_user 005047 constant entry internal dcl 538 ref 494 500 621 overflow_handler 007644 constant entry internal dcl 853 ref 221 read_control_record 006033 constant entry internal dcl 651 ref 251 294 read_ident 001414 constant label dcl 237 ref 256 read_next_control_record 002154 constant label dcl 294 ref 743 776 read_next_record 003357 constant label dcl 374 ref 435 receive_file_ 001170 constant entry external dcl 32 report 005705 constant entry internal dcl 614 ref 225 247 287 297 404 477 531 563 569 608 859 start 001410 constant label dcl 230 ref 252 298 508 567 585 write_msg 005751 constant label dcl 626 ref 631 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 11464 11602 10766 11474 Length 12212 10766 116 373 475 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME receive_file_ 2840 external procedure is an external procedure. on unit on line 221 106 on unit on unit on line 223 86 on unit abort 186 internal procedure is called by several nonquick procedures. notify_user 86 internal procedure is called during a stack extension. abort_read 206 internal procedure is called during a stack extension. control_record_error 198 internal procedure is called during a stack extension. report 90 internal procedure is called during a stack extension. read_control_record internal procedure shares stack frame of external procedure receive_file_. decode_format_args internal procedure shares stack frame of external procedure receive_file_. decode_control_args internal procedure shares stack frame of external procedure receive_file_. clean_up 94 internal procedure is called by several nonquick procedures. overflow_handler internal procedure shares stack frame of on unit on line 221. INITIALIZE_STUFF internal procedure shares stack frame of external procedure receive_file_. RESET_PARAMETERS internal procedure shares stack frame of external procedure receive_file_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME abort 000100 abort_msg abort 000200 len abort abort_read 000100 abort_msg abort_read 000200 len abort_read 000201 count abort_read clean_up 000100 ignore clean_up control_record_error 000100 error_message control_record_error on unit on line 221 000106 code overflow_handler receive_file_ 000100 aclec receive_file_ 000101 add_nl receive_file_ 000102 bc receive_file_ 000103 record_buffer receive_file_ 000503 record receive_file_ 001470 record_len receive_file_ 001471 chars_left_in_seg receive_file_ 001472 left receive_file_ 001473 code receive_file_ 001474 component receive_file_ 001475 contin receive_file_ 001476 file_name receive_file_ 001510 filep receive_file_ 001512 dirname receive_file_ 001564 done receive_file_ 001565 default_person receive_file_ 001575 default_project receive_file_ 001605 default_personid receive_file_ 001615 element_size receive_file_ 001616 fcbp receive_file_ 001620 field receive_file_ 003330 field_cnt receive_file_ 003331 ignore receive_file_ 003332 input_modes receive_file_ 003432 input_mode_bits receive_file_ 003433 control_mode_bits receive_file_ 003434 key receive_file_ 003445 key_mode receive_file_ 003455 len receive_file_ 003456 long receive_file_ 003507 lower_case receive_file_ 003510 max_chars receive_file_ 003511 chars_in_last_seg receive_file_ 003512 new_file_name receive_file_ 003522 overwrite receive_file_ 003523 person receive_file_ 003533 personid receive_file_ 003543 pool_open receive_file_ 003544 proc_auth receive_file_ 003546 project receive_file_ 003556 file_path receive_file_ 003631 read_done receive_file_ 003632 root_dir receive_file_ 003704 source receive_file_ 003705 station receive_file_ 003716 short receive_file_ 003720 tag receive_file_ 003721 testing receive_file_ 003722 user_defined receive_file_ 003723 user_msg receive_file_ 003765 log_msg receive_file_ 004066 test_iocbp receive_file_ 004070 trim receive_file_ 004071 data_idx receive_file_ 004072 file_in_progress receive_file_ 004074 master_iocbp receive_file_ 004076 slave_iocbp receive_file_ 004100 input_iocbp receive_file_ 004124 string_len receive_file_ 004125 acle receive_file_ 004153 cb_info receive_file_ 004176 file_data receive_file_ 004211 count_structure receive_file_ 004220 sw_info_p receive_file_ 004222 receive_file_data_ptr receive_file_ 004224 send_mail_info_version_2 receive_file_ 004225 send_mail_info receive_file_ 004240 dpap receive_file_ 004242 dprint_arg_buf receive_file_ 004572 arg_string read_control_record 004643 scan_done read_control_record 004644 field_begin read_control_record 004645 field_len read_control_record 004646 i read_control_record 004647 len read_control_record 004660 i decode_format_args 004670 idx decode_control_args 004671 generic_type decode_control_args 004701 local_request_type decode_control_args report 000100 code report 000102 opr_iocbp report THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_g_a r_e_as 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_desc call_int_other return_mac tra_ext_1 signal_op enable_op shorten_stack ext_entry_desc int_entry int_entry_desc divide_fx3 verify_for_ltrim verify_for_rtrim THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. card_util_$modes card_util_$translate convert_status_code_ cu_$level_get delete_$path dprint_ find_input_switch_ get_authorization_ get_group_id_ hcs_$create_branch_ ioa_$rsnnl iod_info_$generic_type iox_$control iox_$get_chars iox_$look_iocb iox_$put_chars msf_manager_$acl_add msf_manager_$adjust msf_manager_$close msf_manager_$get_ptr msf_manager_$open pool_manager_$add_quota pool_manager_$close_user_pool pool_manager_$open_user_pool send_mail_ unique_chars_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_arg error_table_$bigarg error_table_$end_of_info error_table_$eof_record error_table_$namedup error_table_$noarg error_table_$short_record error_table_$unimplemented_version sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 32 001163 91 001210 101 001215 4 3 001216 189 001220 190 001222 191 001227 192 001240 194 001243 195 001246 196 001251 199 001252 200 001255 204 001260 205 001262 206 001266 207 001272 210 001273 211 001275 213 001302 215 001304 217 001310 219 001320 221 001321 223 001337 224 001353 225 001355 227 001402 228 001407 230 001410 233 001411 237 001414 240 001433 242 001454 246 001457 247 001462 248 001523 251 001525 252 001530 254 001534 255 001541 256 001544 259 001545 261 001550 264 001613 266 001624 267 001627 268 001633 269 001637 270 001640 271 001642 272 001653 275 001672 277 001740 280 002007 282 002047 284 002052 287 002114 292 002150 293 002152 294 002154 296 002157 297 002163 298 002205 300 002206 301 002230 302 002240 304 002250 305 002260 306 002312 307 002350 313 002352 317 002354 318 002400 320 002421 322 002423 323 002426 324 002430 325 002434 326 002447 327 002461 329 002464 330 002470 331 002472 332 002473 335 002525 337 002560 340 002620 341 002650 342 002657 344 002731 346 002733 348 003011 349 003037 352 003076 353 003100 354 003123 359 003164 362 003242 363 003267 365 003314 369 003344 370 003346 371 003355 372 003356 374 003357 377 003360 379 003363 380 003404 381 003406 383 003411 385 003417 388 003442 390 003452 392 003467 393 003471 395 003474 396 003475 397 003477 399 003503 401 003504 402 003507 403 003532 404 003534 405 003566 406 003572 408 003615 412 003642 413 003665 416 003714 419 003743 420 003747 422 003761 423 003763 424 003770 425 003773 426 003776 427 004000 429 004001 430 004003 431 004010 432 004013 433 004015 435 004017 440 004020 444 004022 448 004025 449 004045 451 004075 452 004100 453 004126 454 004131 456 004133 457 004152 459 004177 462 004212 464 004214 465 004216 466 004253 468 004300 470 004301 472 004304 474 004337 477 004402 479 004425 480 004431 482 004435 484 004440 485 004446 488 004452 489 004476 491 004500 494 004543 495 004562 497 004564 500 004623 501 004642 503 004643 504 004645 505 004664 508 004667 511 004670 514 004674 515 004677 518 004700 525 004714 526 004733 528 004737 531 005005 533 005042 538 005046 541 005062 544 005116 548 005117 557 005133 558 005152 560 005156 563 005243 565 005301 567 005307 569 005323 571 005346 572 005350 573 005357 574 005401 575 005404 576 005412 579 005436 580 005440 581 005443 582 005471 583 005513 585 005520 591 005523 599 005537 601 005556 603 005562 608 005644 610 005702 614 005704 621 005720 624 005737 625 005747 626 005751 628 005771 629 005773 630 006000 631 006002 638 006003 639 006006 640 006026 643 006032 651 006033 665 006044 666 006047 667 006063 669 006064 670 006105 671 006110 672 006114 673 006122 676 006142 677 006144 678 006150 681 006151 683 006160 684 006162 685 006216 686 006236 687 006242 690 006243 692 006255 693 006257 695 006271 696 006303 697 006304 698 006305 701 006312 702 006340 704 006352 706 006367 707 006402 708 006403 709 006415 712 006416 714 006430 716 006477 717 006501 719 006502 720 006511 721 006531 722 006532 723 006536 724 006540 725 006541 726 006543 727 006561 728 006607 729 006611 731 006613 735 006614 741 006616 742 006621 743 006657 746 006661 747 006667 748 006704 749 006713 750 006723 751 006732 752 006742 753 006751 754 006761 755 006770 756 007027 758 007032 764 007033 774 007035 775 007040 776 007076 780 007100 782 007107 785 007124 788 007134 790 007146 791 007151 794 007175 796 007176 797 007177 798 007205 801 007254 803 007256 804 007264 805 007305 806 007307 809 007360 811 007362 814 007377 817 007451 819 007453 820 007456 822 007457 825 007516 828 007521 832 007522 836 007530 837 007535 838 007543 839 007546 842 007601 843 007604 844 007641 847 007643 853 007644 857 007645 858 007671 859 007673 860 007726 863 007732 868 007733 870 007734 871 007740 873 007743 874 007752 875 007762 876 010005 878 010044 879 010047 880 010051 881 010053 882 010054 883 010055 884 010057 885 010060 886 010063 888 010070 889 010072 890 010075 891 010121 892 010124 893 010126 895 010130 896 010133 897 010134 898 010135 899 010137 900 010140 901 010143 902 010146 903 010147 904 010152 905 010155 906 010160 908 010163 910 010164 911 010167 912 010171 913 010175 914 010177 915 010201 916 010203 917 010205 919 010207 921 010216 922 010243 925 010264 927 010266 933 010270 934 010315 936 010325 937 010355 938 010374 942 010377 945 010400 947 010401 949 010405 950 010427 951 010432 952 010435 953 010440 955 010443 956 010444 957 010445 958 010446 959 010447 960 010451 962 010454 963 010455 964 010456 965 010457 966 010460 968 010461 970 010465 971 010514 973 010516 ----------------------------------------------------------- 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