



		    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
