check_password_.pl1 08/05/87 0817.7r 08/04/87 1538.8 27549 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /* format: style5,ind5 */ check_password_: procedure (Password, ErrorMessage, Code); /* Parameters */ dcl Password char (*) parameter; dcl ErrorMessage char (*) parameter; dcl Code fixed bin (35) parameter; /* Automatic */ dcl code fixed bin (35); dcl ip ptr; /* pointer to >sc1>installation_parms */ /* Entries */ dcl initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35)); dcl ioa_$rsnnl entry () options (variable); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35)); /* External */ dcl error_table_$bad_arg fixed bin (35) external; /* Constant */ dcl SC1 char (168) initial (">system_control_1") internal static options (constant); dcl INSTALLATION_PARMS char (32) initial ("installation_parms") internal static options (constant); /* Builtins */ dcl length builtin; dcl null builtin; dcl rtrim builtin; /* Conditions */ dcl cleanup condition; %page; /* Program */ ip = null (); /* setup for cleanup handler */ on condition (cleanup) call CLEAN_UP (); call initiate_file_ (SC1, INSTALLATION_PARMS, R_ACCESS, ip, (0), code); if code ^= 0 then call ioa_$rsnnl ( "Unable to check password_min_length parameter in ^a.", ErrorMessage, (0), pathname_ (SC1, INSTALLATION_PARMS)); else if length (rtrim (Password)) < installation_parms.password_min_length then do; call ioa_$rsnnl ("Password must be at least ^d characters long", ErrorMessage, (0), installation_parms.password_min_length); code = error_table_$bad_arg; end; else if Password = "help" | Password = "HELP" | Password = "?" | Password = "quit" | Password = "QUIT" then do; call ioa_$rsnnl ("""^a"" is reserved for special use during login", ErrorMessage, (0), Password); code = error_table_$bad_arg; end; else ErrorMessage = ""; call CLEAN_UP (); Code = code; return; %page; CLEAN_UP: procedure (); dcl temp_ptr ptr automatic; /* temporary so we don't have windows */ if ip ^= null () then do; temp_ptr = ip; ip = null (); call terminate_file_ (temp_ptr, 0, TERM_FILE_TERM, (0)); end; return; end CLEAN_UP; /* format: off */ %page; %include access_mode_values; %page; %include installation_parms; %page; %include terminate_file; /* format: on */ end check_password_;  encipher_.alm 11/04/82 1914.5rew 11/04/82 1632.1 35982 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " This procedure enciphers an arrya of double words, i.e., fixed bin(71), " using the key that is provided. It has entries to both encipher and decipher: " " call encipher_(key,input_array,output_array,array_length) " " call decipher_(key,input_array,output_array,array_length) " " where: key is fixed bin(71) key for coding " input_array(array_length) is fixed bin(71) array " output_array(array_length) is fixed bin(71) array " array_length is fixed bin(17) length (double words) of array " " Coded 1 April 1973 by Roger R. Schell, Major, USAF """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" entry encipher_ entry decipher_ equ key,2 equ input_array,4 equ output_array,6 equ array_length,8 " " Entry to encipher " encipher_: push epplp ap|output_array,* "LP -> cipher text tra setup_keys " " Entry to decipher " decipher_: push epplp ap|input_array,* "set LP -> cipher text setup_keys: "First create internal keying variables "Use Tausworth pseudo-random number generator on key equ shift,11 "Shift for generator equ size,36 "Word size used for generator tempd variables(12) "Internal keying variables eax6 0 "loop index in x6 ldaq ap|key,* "Start with input key mask_loop: "Create masks staq variables,6 "save copy of generator seed qrl shift "Now generate pseudo-random number arl shift eraq variables,6 staq variables,6 qls size-shift als size-shift eraq variables,6 staq variables,6 "Save result eax6 2,6 cmpx6 18,du "Generate 9 double words tnz mask_loop " "Next create 7-bit shift variables eax6 0 lrl 11 "First 7 bits to upper A-reg eax0 0 "Zero for clearing half word shift_loop: sta variables+A1,6 "Upper A-reg is shift variable sxl0 variables+A1,6 "Zero lower half word lls 7 ana =o000177777777 "Save 7 bits in upper A-reg eax6 1,6 cmpx6 7,du "Generate 7 shift variables tnz shift_loop " " Now that we have needed variables, aply the cipher " "Declaration of offsets of keying variables equ C0,0 "Initial cipher text from key equ M1,2 "Mask variables equ M2,4 equ M3,6 equ M4,8 equ M5,10 equ M6,12 equ M7,14 equ A1,16 "Amount of shift -- as address equ A2,17 equ A3,18 equ A4,19 equ A5,20 equ A6,21 equ A7,22 lxl5 ap|array_length,* "Get length (double words) eax5 -1,5 "Check for zero or negative tmi return eax6 0 "X6 is index into arrays eppbp variables+C0 "Initial cipher text from key cipher_loop: ldaq bp|0 "First compute select function llr variables+A6,* adlaq variables+M6 llr variables+A7,* eraq variables+M7 eax1 0,ql "Save select function " "Compute value " ldaq bp|0 llr variables+A1,* adlaq variables+M1 canx1 =o10,du tnz 2,ic llr variables+A2,* eraq variables+M2 canx1 =o4,du tnz 2,ic llr variables+A3,* adlaq variables+M3 canx1 =o2,du tnz 2,ic llr variables+A4,* eraq variables+M4 canx1 =o1,du tnz 2,ic llr variables+A5,* adlaq variables+M5 "AQ contains computed key eppbp lp|0,6 "set BP -> next cipher text autokey eraq ap|input_array,*6 staq ap|output_array,*6 "return ciphered value eax6 2,6 "Increment array offset eax5 -1,5 "Check for end of array tpl cipher_loop return: " "Clean up the 'dirty blackboard' before returning bool rpt,5202 "RPT instruction ldaq * " Load AQ with garbage eax6 0 vfd 8/11,2/0,1/1,7/0,12/rpt,6/2 "RPT instruction staq variables,6 "Overwrite keying variables return end  encode.pl1 11/12/82 1432.1rew 11/12/82 0953.8 93339 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ encode: code: proc; /* Commands encode and decode, for enciphering and deciphering files given a key. Usage: encode path1A {path2A ... path1N path2N} {-key STR} where: 1. path1A is the pathname of a segment. 2. path2A is the optional pathname of the encoded result, with the suffix .code assumed. The default is path1A.code. decode path1A {path2A ... path1N path2N} {-key STR} where: 1. path1A is the pathname of a segment, with .code suffix assumed. 2. path2A is the optional pathname of the decoded result. The default is path1A without .code suffix. Written 07/06/79 by Steve Herbst */ /* TR7458 Add -key 10/30/80 S. Herbst */ /* Fixed to check for w permission on target before asking for key 10/26/82 S. Herbst */ /* Enciphered and deciphered as arrays of fixed bin (71) word pairs */ dcl source_array (source_len) fixed bin (71) based (source_ptr); dcl target_array (source_len) fixed bin (71) based (target_ptr); dcl 1 entries (ecount) aligned based (eptr), /* for hcs_$star_ */ 2 type bit (2) unaligned, 2 nnames bit (16) unaligned, 2 nindex bit (18) unaligned; dcl names (99 /* arbitrary */) char (32) aligned based (nptr); /* names from hcs_$star_ */ dcl arg char (arg_len) based (arg_ptr); dcl (dn, source_dn, target_dn) char (168); dcl (en, equal_en, match_en, source_en, star_en, target_en) char (32); dcl command char (32); /* "encode" or "decode" */ dcl (buffer, buffer2) char (11); /* input key */ dcl (encode_sw, got_key_sw, path2_sw) bit (1); dcl error_table_$badopt fixed bin (35) ext; dcl area area based (area_ptr); dcl (area_ptr, arg_ptr, eptr, nptr, source_ptr, target_ptr) ptr; dcl key fixed bin (71); /* encipher/decipher key */ dcl bit_count fixed bin (24); dcl (arg_count, ecount, i, j, source_len) fixed bin; dcl arg_len fixed bin (21); dcl code fixed bin (35); dcl error_table_$badstar fixed bin (35) ext; dcl error_table_$entlong fixed bin (35) ext; dcl error_table_$moderr fixed bin (35) ext; dcl error_table_$no_w_permission fixed bin (35) ext; dcl error_table_$sameseg fixed bin (35) ext; dcl error_table_$zero_length_seg fixed bin (35) ext; dcl check_star_name_$entry entry (char (*), fixed bin (35)); dcl com_err_ entry options (variable); dcl com_err_$suppress_name entry options (variable); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); dcl decipher_ entry (fixed bin (71), dim (*) fixed bin (71), dim (*) fixed bin (71), fixed bin); dcl encipher_ entry (fixed bin (71), dim (*) fixed bin (71), dim (*) fixed bin (71), fixed bin); dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); dcl get_equal_name_ entry (char (*), char (*), char (32), fixed bin (35)); dcl get_system_free_area_ entry returns (ptr); dcl hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr, fixed bin (35)); dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); dcl hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)); dcl hcs_$star_ entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35)); dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); dcl hcs_$truncate_seg entry (ptr, fixed bin (19), fixed bin (35)); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl read_password_ entry (char (*), char (*)); dcl (divide, fixed, length, null, rtrim, substr, unspec) builtin; dcl cleanup condition; /* */ encode_sw = "1"b; command = "encode"; go to COMMON; decode: entry; encode_sw = "0"b; command = "decode"; COMMON: call cu_$arg_count (arg_count, code); if code ^= 0 then do; call com_err_ (code, command); return; end; if arg_count = 0 then do; call com_err_$suppress_name (0, command, "Usage: ^a path1A {path2A ... path1N path2N}", command); return; end; got_key_sw = "0"b; path2_sw = "0"b; do i = 1 to arg_count; call cu_$arg_ptr (i, arg_ptr, arg_len, code); if substr (arg, 1, 1) = "-" then if arg = "-key" then do; if got_key_sw then do; call com_err_ (0, command, "Attempt to specify two keys."); return; end; i = i + 1; if i > arg_count then do; call com_err_ (0, command, "No value specified for -key."); return; end; call cu_$arg_ptr (i, arg_ptr, arg_len, code); if arg_len > length (buffer) then do; call com_err_ (0, command, "Key longer than ^d characters.", length (buffer)); return; end; buffer = arg; /* Calculate fixed bin (71) key */ call build_key (buffer, key); arg_ptr = null; got_key_sw = "1"b; end; else do; call com_err_ (error_table_$badopt, command, "^a", arg); return; end; end; do i = 1 to arg_count; call cu_$arg_ptr (i, arg_ptr, arg_len, code); if substr (arg, 1, 1) = "-" then do; i = i + 1; go to END_LOOP; end; call expand_pathname_ (arg, dn, en, code); if code ^= 0 then do; call com_err_ (code, command, "^a", arg); return; end; if path2_sw then do; target_dn = dn; equal_en = en; call cipher_stars; path2_sw = "0"b; end; else do; source_dn = dn; star_en = en; path2_sw = "1"b; end; END_LOOP: end; if path2_sw then do; target_dn = dn; equal_en = "=="; call cipher_stars; end; RETURN: return; /* */ cipher_stars: proc; /* This internal procedure applies the star convention and calls cipher */ call check_star_name_$entry (star_en, code); if code = error_table_$badstar then do; call com_err_ (code, command, "^a", pathname_ (source_dn, star_en)); go to RETURN; end; else if code = 0 then do; /* no stars */ source_en = star_en; call cipher; return; end; /* Starname */ eptr, nptr = null; on condition (cleanup) call star_clean_up; area_ptr = get_system_free_area_ (); match_en = star_en; if ^encode_sw then call append_code (match_en); call hcs_$star_ (source_dn, match_en, 3 /* all */, area_ptr, ecount, eptr, nptr, code); if code ^= 0 then do; call com_err_ (code, command, "^a", pathname_ (source_dn, star_en)); return; end; do j = 1 to ecount; source_en = names (fixed (entries (j).nindex)); if ^encode_sw then /* remove .code suffix */ source_en = substr (source_en, 1, length (rtrim (source_en)) - 5); call cipher; end; call star_clean_up; star_clean_up: proc; if eptr ^= null then free entries in (area); if nptr ^= null then free names in (area); end star_clean_up; end cipher_stars; /* */ cipher: proc; /* This internal procedure applies the equal convention and processes a single segment */ call get_equal_name_ (source_en, equal_en, target_en, code); if code ^= 0 then do; call com_err_ (code, command, "^a", equal_en); return; end; if encode_sw then call append_code (target_en); else call append_code (source_en); call hcs_$initiate_count (source_dn, source_en, "", bit_count, 0, source_ptr, code); if source_ptr = null then do; SOURCE_ERROR: call com_err_ (code, command, "^a", pathname_ (source_dn, source_en)); return; end; source_len = divide (bit_count + 71, 72, 18, 0); /* number of double words in segment */ if source_len = 0 then do; code = error_table_$zero_length_seg; go to SOURCE_ERROR; end; call hcs_$make_seg (target_dn, target_en, "", 01010b, target_ptr, code); if target_ptr = null then do; TARGET_ERROR: call com_err_ (code, command, "^a", pathname_ (target_dn, target_en)); return; end; call hcs_$truncate_seg (target_ptr, 0, code); if code ^= 0 then do; if code = error_table_$moderr then code = error_table_$no_w_permission; go to TARGET_ERROR; end; if source_ptr = target_ptr then do; code = error_table_$sameseg; go to SOURCE_ERROR; end; if ^got_key_sw then do; buffer, buffer2 = ""; GET_KEY: call read_password_ ("Key:", buffer); if encode_sw then do; call read_password_ ("Verify:", buffer2); if buffer ^= buffer2 then do; /* twice to make sure */ call com_err_ (0, "encode", "Keys do not match. Please try again."); go to GET_KEY; end; end; /* Generate a fixed bin (71) key */ call build_key (buffer, key); buffer2 = ""; got_key_sw = "1"b; end; if encode_sw then call encipher_ (key, source_array, target_array, source_len); else call decipher_ (key, source_array, target_array, source_len); call hcs_$set_bc_seg (target_ptr, bit_count, code); call hcs_$terminate_noname (source_ptr, code); call hcs_$terminate_noname (target_ptr, code); end cipher; /* */ append_code: proc (a_en); /* This internal procedure appends a .code suffix and checks for entlong */ dcl a_en char (32); if length (rtrim (a_en)) + 5 > length (a_en) then do; call com_err_ (error_table_$entlong, command, "^a.code", a_en); go to RETURN; end; a_en = rtrim (a_en) || ".code"; end append_code; %page; build_key: proc (A_buffer, A_key); dcl A_buffer char (11); dcl A_key fixed bin (71); dcl k fixed bin; dcl buffer_bits bit(99) unaligned; dcl key_bits bit(72) unaligned; dcl 1 pack unaligned defined (key_bits), 2 bits (10) bit (7) unaligned, 2 pad bit (2) unaligned; dcl 1 strip unaligned defined (buffer_bits), 2 c (11) unaligned, 3 pad bit (2) unaligned, 3 bits bit (7) unaligned; unspec (buffer_bits) = unspec (A_buffer); do k = 1 to 10; pack.bits (k) = strip.c (k).bits; end; pack.pad = substr (strip.c (11).bits, 6, 2); unspec (A_key) = unspec (key_bits); A_buffer = ""; end build_key; end encode;  read_password_.pl1 08/26/83 0943.3rew 08/26/83 0941.0 51561 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* Read a password from the terminal */ /* Modified: 9 November 1981 by G. Palter to add the switch entry and not assume the last character read is a newline */ /* Modified: 1 August 1983 by Jim Lippard to use iox_signal_ rather than (the not externally available) ios_signal_ */ read_password_: procedure (P_prompt, P_password); /* Parameters */ dcl P_prompt character (*) parameter; /* message to prompt user for the password */ dcl P_password character (*) parameter; /* the returned password */ dcl P_tty_id character (4) aligned parameter; /* get_password_: no longer used */ dcl P_tty_type fixed binary parameter; /* get_password_: no longer used */ dcl P_output_switch pointer parameter; /* switch: -> switch to write prompt */ dcl P_input_switch pointer parameter; /* switch: -> switch to read password */ dcl P_code fixed binary (35) parameter; /* switch: status code if read fails */ dcl no_return_code bit (1) aligned; dcl (input_switch, output_switch) pointer; dcl (char_loc, indx, num_read) fixed binary (21); dcl err_code fixed binary (35); dcl line_buffer character (120); dcl temp_buffer character (120) varying; dcl (SP initial (" "), HT initial (" "), NL initial (" ")) character (1) static options (constant); dcl (TWO_POWER_THIRTYFIVE initial (34359738368), TWO_POWER_SIXTY initial (1152921504606846976)) fixed binary (71) static options (constant); dcl (iox_$user_input, iox_$user_output) pointer external; dcl error_table_$long_record fixed binary (35) external; dcl ioa_$ioa_switch entry () options (variable); dcl ioa_$ioa_switch_nnl entry () options (variable); dcl iox_signal_ entry (ptr, fixed binary (35)); dcl iox_$control entry (pointer, character (*), pointer, fixed binary (35)); dcl iox_$get_line entry (pointer, pointer, fixed binary (21), fixed binary (21), fixed binary (35)); dcl (addr, binary, bit, clock, collate, length, ltrim, mod, null, rtrim, search, substr, translate) builtin; dcl cleanup condition; /* */ /* Read a password from the user's terminal */ /* read_password_: entry (P_prompt, P_password); */ get_password_: /* old now obsolete entry */ entry (P_prompt, P_tty_id, P_tty_type, P_password); no_return_code = "1"b; input_switch = iox_$user_input; /* read from user_input ... */ output_switch = iox_$user_output; /* ... and put prompt on user_output */ go to READ_PASSWORD_COMMON; /* Read a password from a specified switch */ switch: entry (P_output_switch, P_input_switch, P_prompt, P_password, P_code); no_return_code = "0"b; /* have a return code */ P_code = 0; /* ... so initialize it */ input_switch = P_input_switch; output_switch = P_output_switch; READ_PASSWORD_COMMON: call ioa_$ioa_switch (output_switch, "^a", P_prompt); on condition (cleanup) call iox_$control (input_switch, "printer_on", null (), (0)); call iox_$control (input_switch, "printer_off", null (), err_code); if err_code ^= 0 then /* can't turn off printer: print a mask */ call print_garbage (); err_code = -1; do while (err_code ^= 0); call iox_$get_line (input_switch, addr (line_buffer), length (line_buffer), num_read, err_code); if err_code ^= 0 then do; /* something went wrong ... */ if (err_code = error_table_$long_record) then err_code = 0; /* ... use the first part of the line */ else if no_return_code then /* ... no nice way to inform caller */ call iox_signal_ (input_switch, err_code); else do; /* ... tell the caller about it */ P_code = err_code; return; end; end; end; num_read = length (rtrim (substr (line_buffer, 1, num_read), NL)); /* strip trailing newlines */ substr (line_buffer, 1, num_read) = translate (substr (line_buffer, 1, num_read), SP, HT); /* fudge the rest of canonicalization */ temp_buffer = ltrim (substr (line_buffer, 1, num_read)); /* trim leading whitespace */ char_loc = search (temp_buffer, SP); if char_loc ^= 0 then /* remove anything after first whitespace in the string */ temp_buffer = substr (temp_buffer, 1, char_loc - 1); if length (temp_buffer) = 0 then P_password = "*"; /* caller really wanted a blank password */ else P_password = temp_buffer; call iox_$control (input_switch, "printer_on", null (), (0)); return; /* */ /* Print a password mask (including a line of garbage) */ print_garbage: procedure (); dcl strange_number fixed binary (71); dcl strange_bits bit (60); dcl CR character (1); dcl garbage character (12); dcl MISC character (32) static options (constant) initial ("etaiosqwertyuioplkjhgfdsazxcvbnm"); CR = substr (collate (), 14, 1); /* be legal now */ strange_number = 1979339333 * mod (clock (), TWO_POWER_THIRTYFIVE); strange_bits = bit (binary (mod (strange_number, TWO_POWER_SIXTY), 60)); do indx = 1 by 1 to 12; substr (garbage, indx, 1) = substr (MISC, 1 + binary (substr (strange_bits, 1 - 5 + (indx * 5), 5)), 1); end; call ioa_$ioa_switch_nnl (output_switch, "YourPassword^aXWXWXWXWXWXW^a986986986986^a^a^a", CR, CR, CR, garbage, CR); return; end print_garbage; end read_password_; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- 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