COMPILATION LISTING OF SEGMENT hcom_default_validate_ Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 06/05/86 1121.2 mst Thu Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1985 * 4* * * 5* *********************************************************** */ 6 7 /****^ HISTORY COMMENTS: 8* 1) change(85-09-03,LJAdams), approve(85-11-06,MCR7278), 9* audit(86-02-19,Gilcrease), install(86-02-19,MR12.0-1021): 10* The default validation program. 11* 2) change(86-05-01,LJAdams), approve(86-05-19,MCR7386), 12* audit(86-05-19,Gilcrease), install(86-06-05,MR12.0-1071): 13* Added error message parameter. 14* END HISTORY COMMENTS */ 15 16 hcom_default_validate_: 17 proc (P_caller, P_field_name, P_input_value, P_result, P_canonical_value, P_field_type, P_err_msg); 18 19 /* * HCOM_DEFAULT_VALIDATE_ 20* * 21* * This is the default procedure used to validate values placed in 22* * fields of a history comment or installation description. 23* * 24* * The validation procedure takes an input value to validate, and 25* * returns a bit indicating the validity. The name of the field is 26* * supplied to determine what sort of validation will be applied, 27* * and the name of the calling procedure is supplied for use in 28* * error messages and questions. An error message is always printed 29* * when the field value is invalid, so the caller of the validation 30* * routine need never print one. 31* * 32* * In addition to the valid/invalid result, this procedure also 33* * returns the canonical form of the field value (making appropriate 34* * case translations, etc.), the field type (a character string 35* * whose value depends on the field itself). 36* * 37* * The DEFAULT validation procedure makes the following checks: 38* * 39* * "author" field 40* * Validated for "correct" syntax and length restriction 41* * "approval" field 42* * Validated for "correct" syntax and length restriction 43* * "audit" field 44* * Validated for "correct" syntax and length restriction 45* * "install" field 46* * At present, validated for syntax only: MRnn.n-#### 47* * Other fields 48* * Always rejected. 49* */ 50 51 /* 85-06-04, Sibert: Initial coding */ 52 /* 85-06-21, Sibert: Name change, creation of $check and $check_long, 53* syntactic validation of person IDs */ 54 /* 85-07-01, Adams: Creation of default version for individual sites */ 55 56 declare P_caller char (*) varying parameter; /* INPUT: Name of validation procedure's caller */ 57 declare P_field_name char (*) varying parameter; /* INPUT: Name of field to be validated */ 58 declare P_input_value char (*) varying parameter; /* INPUT: Value to be checked for validity */ 59 declare P_result bit (1) aligned parameter; /* OUTPUT: Whether input was valid or not */ 60 61 declare P_canonical_value char (*) varying parameter; /* OUTPUT: Canonical text form of above */ 62 declare P_err_msg char (100) varying parameter; /* OUTPUT: Error message */ 63 declare P_field_type char (*) varying parameter; /* OUTPUT: Character prefix of approval value */ 64 65 declare UPPERCASE char (26) internal static options (constant) init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"); 66 declare LOWERCASE char (26) internal static options (constant) init ("abcdefghijklmnopqrstuvwxyz"); 67 declare NAMECASE char (53) internal static options (constant) init 68 ("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'"); 69 declare DIGITS char (10) internal static options (constant) init ("0123456789"); 70 declare HYPHEN char (1) internal static options (constant) init ("-"); 71 72 declare (after, before, index, length, reverse, substr, translate, verify) builtin; 73 74 /* */ 75 76 77 CHECK_COMMON: 78 P_result = "0"b; /* Initialize output values */ 79 P_canonical_value = P_input_value; /* Just return the input in case of error */ 80 P_field_type = ""; /* Type-dependent values are returned null */ 81 P_err_msg = ""; 82 83 /* Call the appropriate (internal) validation procedure, depending on the 84* field name. These procedures are responsible for setting all output 85* parameters, issuing all error messages, and asking questions. When 86* they return, all the results should be set appropriately, since the 87* external procedure just returns at that point. In particular, they must 88* all set P_result, since that has been initialized to "0"b already, above. 89* */ 90 91 if (P_field_name = AUTHOR_FIELD_NAME) then 92 call validate_personid (AUTHOR_FIELD_NAME); 93 else if (P_field_name = APPROVAL_FIELD_NAME) then 94 call validate_approval (); 95 else if (P_field_name = AUDIT_FIELD_NAME) then 96 call validate_personid (AUDIT_FIELD_NAME); 97 else if (P_field_name = INSTALL_FIELD_NAME) then 98 call validate_install (); 99 else 100 P_err_msg = "Invalid field name"; 101 102 103 CHECK_RETURNS: 104 return; /* All done */ 105 106 107 validate_personid: 108 procedure (P_type); 109 110 declare P_type char (*) varying parameter; /* "author" or "audit" -- not used in this implementation */ 111 112 /* Ideally, perhaps, this would check the person ID against a little database of valid 113* values, giving the updater the opportunity to accept or reject one that wasn't 114* found. It could even translate initials or nicknames to the real name. For now, 115* though, all it does is make a trivial syntactic check that isn't even correct 116* in all cases (deJong, for instance). This represents an opportunity for people 117* to modify this routine to be spiffier. */ 118 119 120 if (length (P_input_value) < 2) then /* Between 2 and 24 characters */ 121 P_result = "0"b; 122 else if (length (P_input_value) > 24) then 123 P_result = "0"b; 124 else if verify (P_input_value, NAMECASE) ^= 0 then 125 P_result = "0"b; /* And be all alphabetic or contain ' */ 126 else P_result = "1"b; /* Otherwise, it's OK */ 127 128 return; 129 end validate_personid; 130 131 /* */ 132 133 validate_approval: 134 procedure (); 135 136 137 if (length (P_input_value) = 0) then 138 call invalid_approval ("Approval must not be null"); 139 else 140 if (length (P_input_value) > 24) then 141 call invalid_approval ("Approval must not be longer than 24"); 142 143 P_result = "1"b; /* It's valid */ 144 145 return; 146 end validate_approval; 147 148 149 /* */ 150 151 invalid_approval: 152 procedure (P_message); 153 154 declare P_message char (*) parameter; 155 156 /* This procedure prints an error message and returns a false result, 157* for use when the value is invalid */ 158 159 160 P_err_msg = P_message; 161 P_result = "0"b; /* Invalid */ 162 goto CHECK_RETURNS; 163 164 end invalid_approval; 165 166 167 /* */ 168 169 validate_install: 170 procedure (); 171 172 declare install_id char (24) varying; 173 declare part_1 char (24) varying; 174 declare part_2 char (24) varying; 175 declare release_suffix char (1) varying; 176 177 /* Validate syntax of installation ID: 178* - Must begin with "MR" 179* - Must be followed by a number, optional decimal point and decimal, 180* and optional suffix letter. 181* - Must then be followed by a hyphen and following decimal number. 182* */ 183 184 185 install_id = translate (P_input_value, UPPERCASE, LOWERCASE); 186 if (index (install_id, HYPHEN) = 0) then /* Be sure it's hyphenated somewhere */ 187 goto INVALID_INSTALL_ID; 188 189 part_1 = before (install_id, HYPHEN); /* And that it has something before and after the hyphen */ 190 part_2 = after (install_id, HYPHEN); 191 192 if (length (part_1) < 3) then /* Must have enough room for MRn, at least */ 193 goto INVALID_INSTALL_ID; 194 195 if (substr (part_1, 1, 2) ^= "MR") then /* Must start with MR release identifier */ 196 goto INVALID_INSTALL_ID; 197 198 /* Here, we check to see whether there is a suffix letter (as in MR7.0a), 199* and if so, we strip it out, translate to lowercase, and continue. */ 200 201 if (index (UPPERCASE, substr (reverse (part_1), 1, 1)) ^= 0) then do; 202 release_suffix = substr (reverse (part_1), 1, 1); 203 release_suffix = translate (release_suffix, LOWERCASE, UPPERCASE); 204 part_1 = substr (part_1, 1, (length (part_1) - 1)); 205 if (length (part_1) < 3) then /* Must still be something besides "MR" left */ 206 goto INVALID_INSTALL_ID; 207 end; 208 else release_suffix = ""; /* None, otherwise */ 209 210 if (verify (substr (part_1, 3), "0123456789.") ^= 0) then 211 goto INVALID_INSTALL_ID; /* Only digits and decimal point "MR" */ 212 213 if (part_2 = "") then /* Must be something there */ 214 goto INVALID_INSTALL_ID; 215 216 if (verify (part_2, DIGITS) ^= 0) then 217 goto INVALID_INSTALL_ID; 218 219 P_canonical_value = part_1 || release_suffix || HYPHEN || part_2; 220 P_result = "1"b; /* It's valid; there is no other info to return */ 221 return; 222 223 224 225 INVALID_INSTALL_ID: 226 P_err_msg = "Installation id must be of the form MRxx.y-nnnn."; 227 P_result = "0"b; /* Invalid, sorry */ 228 return; 229 end validate_install; 230 231 /* BEGIN INCLUDE FILE ... hcom_field_names.incl.pl1 */ 1 2 1 3 1 4 /****^ HISTORY COMMENTS: 1 5* 1) change(85-09-20,LJAdams), approve(85-11-06,MCR7278), 1 6* audit(86-02-19,Gilcrease), install(86-02-19,MR12.0-1021): 1 7* Created September 1985. 1 8* END HISTORY COMMENTS */ 1 9 1 10 declare AUTHOR_FIELD_NAME char (24) varying internal static options (constant) init ("author"); 1 11 declare APPROVAL_FIELD_NAME char (24) varying internal static options (constant) init ("approval"); 1 12 declare AUDIT_FIELD_NAME char (24) varying internal static options (constant) init ("audit"); 1 13 declare INSTALL_FIELD_NAME char (24) varying internal static options (constant) init ("install"); 1 14 1 15 /* END INCLUDE FILE ... hcom_field_names.incl.pl1 */ 231 232 233 end hcom_default_validate_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 06/05/86 1121.2 hcom_default_validate_.pl1 >special_ldd>install>MR12.0-1071>hcom_default_validate_.pl1 231 1 02/19/86 1535.3 hcom_field_names.incl.pl1 >ldd>include>hcom_field_names.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. APPROVAL_FIELD_NAME 000016 constant varying char(24) initial dcl 1-11 ref 93 AUDIT_FIELD_NAME 000007 constant varying char(24) initial dcl 1-12 set ref 95 95* AUTHOR_FIELD_NAME 000025 constant varying char(24) initial dcl 1-10 set ref 91 91* DIGITS 000034 constant char(10) initial unaligned dcl 69 ref 216 HYPHEN 002170 constant char(1) initial unaligned dcl 70 ref 186 189 190 219 INSTALL_FIELD_NAME 000000 constant varying char(24) initial dcl 1-13 ref 97 LOWERCASE 000055 constant char(26) initial unaligned dcl 66 ref 185 203 NAMECASE 000037 constant char(53) initial unaligned dcl 67 ref 124 P_caller parameter varying char dcl 56 ref 16 P_canonical_value parameter varying char dcl 61 set ref 16 79* 219* P_err_msg parameter varying char(100) dcl 62 set ref 16 81* 99* 160* 225* P_field_name parameter varying char dcl 57 ref 16 91 93 95 97 P_field_type parameter varying char dcl 63 set ref 16 80* P_input_value parameter varying char dcl 58 ref 16 79 120 122 124 137 139 185 P_message parameter char unaligned dcl 154 ref 151 160 P_result parameter bit(1) dcl 59 set ref 16 77* 120* 122* 124* 126* 143* 161* 220* 227* P_type parameter varying char dcl 110 ref 107 UPPERCASE 000064 constant char(26) initial unaligned dcl 65 ref 185 201 203 after builtin function dcl 72 ref 190 before builtin function dcl 72 ref 189 index builtin function dcl 72 ref 186 201 install_id 000130 automatic varying char(24) dcl 172 set ref 185* 186 189 190 length builtin function dcl 72 ref 120 122 137 139 192 204 205 part_1 000137 automatic varying char(24) dcl 173 set ref 189* 192 195 201 202 204* 204 204 205 210 219 part_2 000146 automatic varying char(24) dcl 174 set ref 190* 213 216 219 release_suffix 000156 automatic varying char(1) dcl 175 set ref 202* 203* 203 208* 219 reverse builtin function dcl 72 ref 201 202 substr builtin function dcl 72 ref 195 201 202 204 210 translate builtin function dcl 72 ref 185 203 verify builtin function dcl 72 ref 124 210 216 NAMES DECLARED BY EXPLICIT CONTEXT. CHECK_COMMON 000213 constant label dcl 77 CHECK_RETURNS 000305 constant label dcl 103 ref 162 INVALID_INSTALL_ID 000727 constant label dcl 225 ref 186 192 195 205 210 213 216 hcom_default_validate_ 000154 constant entry external dcl 16 invalid_approval 000402 constant entry internal dcl 151 ref 137 139 validate_approval 000352 constant entry internal dcl 133 ref 93 validate_install 000430 constant entry internal dcl 169 ref 97 validate_personid 000306 constant entry internal dcl 107 ref 91 95 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2220 2230 2171 2230 Length 2422 2171 10 155 27 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME hcom_default_validate_ 140 external procedure is an external procedure. validate_personid internal procedure shares stack frame of external procedure hcom_default_validate_. validate_approval internal procedure shares stack frame of external procedure hcom_default_validate_. invalid_approval internal procedure shares stack frame of external procedure hcom_default_validate_. validate_install internal procedure shares stack frame of external procedure hcom_default_validate_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME hcom_default_validate_ 000130 install_id validate_install 000137 part_1 validate_install 000146 part_2 validate_install 000156 release_suffix validate_install THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs return shorten_stack ext_entry_desc reverse_cs set_cs_eis NO EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 16 000146 77 000213 79 000215 80 000227 81 000231 91 000233 93 000246 95 000256 97 000270 99 000300 103 000305 107 000306 120 000317 122 000326 124 000332 126 000347 128 000351 133 000352 137 000353 139 000366 143 000376 145 000401 151 000402 160 000413 161 000426 162 000427 169 000430 185 000431 186 000451 189 000464 190 000501 192 000524 195 000527 201 000533 202 000552 203 000566 204 000605 205 000614 207 000617 208 000620 210 000621 213 000635 216 000642 219 000655 220 000723 221 000726 225 000727 227 000735 228 000736 ----------------------------------------------------------- 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