OpenVMS Source-Code Demos

WWW_PASSWORD_CHANGE

1000	%title "www_password_change_xxx.bas"
	%ident			    "version_105.2"				! <<<---***
	declare string constant k_version = "105.2"			,	!						&
				k_program = "www_password_change"		! NQ_BERTULFO MX_CARRANO
	!=========================================================================================================================
	! Title  : www_password_change_xxx.BAS
	! Author : Neil Rieck ( mailto:n.rieck@sympatico.ca - http://www3.sympatico.ca/n.rieck )
	! Created: 2013-01-09
	! History:
	! Ver Who When   What
	! --- --- ------ ---------------------------------------------------------------------------------------------------------
	! 100 NSR 130109 1. original program
	!     NSR 130110 2. more work
	!     NSR 130114 3. more work
	! 101 NSR 130115 1. started coding sys$setuai (the password change)
	! 102 NSR 130115 1. inserted code to receive i/o directly from Apache (no external cgi glue required)
	! 103 NSR 130121 1. added support for a second (verification) password called PASS3
	!		 2. now log all successful password changes
	! 104 NSR 130206 1. started adding code to allow supervisor-oriented changes
	!	  130207 2. more work
	!		 3. ran this file through my source code formatter
	!		 4. inserted some cool JavaScript
	!	  130211 5. added a few more JavaScript bells and whistles (including blocking the submit button)
	!		 6. added a quick lookup to our profile-db (manager go-nogo test)
	! 105 NSR 130212 1. now restrict profiled managers to only modifying profiled users
	!		 2. added some event logging
	!=========================================================================================================================
	option type=explicit							! cuz tricks are for kids...
	declare string	constant k_lock_fs$ = "csmis$dat:"+ k_program +".lck"	! lock file specification
	declare string  constant k_log_seq_fs$ = "csmis$dat:"+ k_program +".seq"! sequential log file specification
	declare string  constant k_log_idx_fs$ = "csmis$dat:"+ k_program +".idx"! indexed log file specification
	declare long	constant k_max_loop = 5					!
	declare long	constant k_max_params = 19				!
	set no prompt								!
	!
	!	external declarations
	!
	%nolist
	%include "starlet"	%from %library "sys$library:basic$starlet"      ! system services
	%include "$ssdef"	%from %library "sys$library:basic$starlet"      ! ss$
	%include "$syidef"	%from %library "sys$library:basic$starlet"	! syi$
	%include "$uaidef"	%from %library "sys$library:basic$starlet"      ! uai$
	%include "$rmsdef"	%from %library "sys$library:basic$starlet"	! rms$
	%include "lib$routines"	%from %library "sys$library:basic$starlet"	! lib$spawn
	%include "$libdef"	%from %library "sys$library:basic$starlet"	! eg. lib$_normal
	%include "$iledef"	%from %library "sys$library:basic$starlet"	! ile3$ (Item List Entry 3 structures)
	%list
	!
	record ItemRec								! structure of item record
	    variant
		case
		    group zero							! new code
			ILE3	myILE3						! from sys$library:basic$starlet
		    end group zero						!
		case
		    group one							! legacy code
			word	BuffLen						! length
			word	ItemCode					! code
			long	BuffAddr					! address of buffer
			long	RtnLenAdr					! address of word for returned length
		    end group one						!
		case
		    group two							!
			long	List_Terminator					!
			long	Junk1						!
			long	Junk2						!
		    end group two						!
	    end variant								!
	end record ItemRec							!
	!
	!	home brewed functions
	!
	external string function wcsm_trnlnm (string, string)			! translate logical names
	external string function wcsm_dt_stamp					! generates a timestamp: ccyymmddhhmmss
	external string function fix_html_data (string)				!
	!
	!	local constants
	!
	declare string constant dq		= '34'C				! double quote
	declare string constant sq		= '39'C				! single quote
	declare string constant	k_legal_pw_chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$"
	declare string constant k_error_severity$ = "wseif???"			! warning, success, error, informational, etc.
	!
	!	local variables
	!
	declare long		handler_error%				,	!			&
				display_blank_page%			,	!			&
				blocked%				,	!			&
				lock_count%				,	!			&
				dvlp%					,	!			&
				junk%					,	!			&
				file_open91%				,	!			&
				trace%					,	!			&
				feedback%				,	!			&
				status%					,	!			&
				debug%					,	!			&
				p_num%					,	!			&
				amper_pos%				,	!			&
				amper_remember%				,	!			&
				equal_pos%				,	!			&
				rc%					,	!			&
				i%, j%, k%				,	!			&
				param%					,	!			&
				www_length%				,	!			&
				data_length%				,	!			&
				mgr_mode%				,	!			&
		string		out$					,	!			&
				stdin$					,	!			&
				fake_fs1$				,	!			&
				fake_fs2$				,	!			&
				query$					,	!			&
				node_name$				,	!			&
				msg$					,	!			&
				alt$					,	!			&
				dbg$					,	!			&
				url$					,	!			&
				junk$					,	!			&
				default_node$				,	! required during profile open &
				noun$					,	!			&
				verb$					,	!			&
				user1$					,	! user			&
				pass1$					,	! old p/w		&
				pass2$					,	! new p/w		&
				pass3$					,	! confirm p/w		&
				user4$					,	! manager		&
				pass4$					,	! manager p/w		&
				request_method$				,	!			&
				http_host$				,	!			&
				path$					,	!			&
				path_info$				,	!			&
				path_translated$			,	!			&
				query_string$				,	!			&
				server_addr$				,	!			&
				server_port$				,	!			&
				remote_addr$				,	!			&
				remote_port$				,	!			&
				script_filename$			,	!			&
				script_name$				,	!			&
				script_uri$				,	!			&
				www_length$					!
	!
	dim string 		param$(k_max_params)				!
	!
	!	this stuff will be used in my system calls
	!
	declare	basic$quadword	uai_hashed_pw				,	!			&
				pass1_hash				,	!			&
				pass4_hash				,	!			&
				quad_time				,	!			&
		ItemRec		myItems(9)				,	!			&
		long		rc_bits%				,	!			&
		long		uai_flags1%				,	!			&
				uai_flags2%				,	!			&
		word		uai_salt				,	!			&
		byte		uai_encrytion_type%			,	!			&
				uai_min_pwd_length%				!
	!
	!====================================================================================================
	!	main (receive data from Apache)
	!====================================================================================================
	main:									!
2000	margin #0, 1999888777							! no implied EOL
	!
	!       Apache Implementation Notes:
	!       1. Most of the time, Apache will be set up to produce DCL symbols but it can be set up to use LOGICAL NAMES
	!       2. Sometimes Apache will be set up to produce symbols (or logicals) with a prefix of "WWW_"
	!
	call lib$get_symbol("REQUEST_METHOD"	,request_method$	)	! "POST" or "GET"
	call lib$get_symbol("HTTP_HOST"		,http_host$		)	! eg. kawc15.on.bell.ca
	call lib$get_symbol("PATH"		,path$			)	! eg. apache$root:[000000]
	call lib$get_symbol("PATH_INFO"		,path_info$		)	!	always blank?
	call lib$get_symbol("PATH_TRANSLATED"	,path_translated$	)	!	always blank?
	call lib$get_symbol("QUERY_STRING"	,query_string$		)	!
	call lib$get_symbol("SERVER_ADDR"	,server_addr$		)	! eg. 142.180.39.15
	call lib$get_symbol("SERVER_PORT"	,server_port$		)	! eg. 80
	call lib$get_symbol("SCRIPT_FILENAME"	,script_filename$	)	! eg. /apache$documents/scripts/www_password_change.com
	call lib$get_symbol("SCRIPT_NAME"	,script_name$		)	! eg. /scripts/www_password_change
	call lib$get_symbol("SCRIPT_URI"	,script_uri$		)	! eg. https://kawc09.on.bell.ca/scripts/www_password_change
	call lib$get_symbol("REMOTE_ADDR"	,remote_addr$		)	! eg. may want this for logging purposes
	call lib$get_symbol("REMOTE_PORT"	,remote_port$		)	! eg. may want this for logging purposes
	!
    %let %noglue = 1								! do not depend upon external glue
    %if  %noglue = 1 %then							! we will talk directly to Apache
	!-----------------------------------------------------------------------
	!	this block of code will talk directly to Apache
	!-----------------------------------------------------------------------
	mat param$ = nul$							! init parameter array
	param% = 0								! init
	declare string		a$, b$, p$,					&
				q_string$, html_data$				!
	!
	!	support QUERY_STRING (but data is not used by this program)
	!
	select request_method$							!
	    case    "GET", "POST"						!
		!
		!	Notes:
		!	1. contrary to popular belief, it is possible to use QUERY_STRING in both GET + POST modes
		!	2. URL: www.server.com/scripts/vms_basic_apache_demo?a=1&b=2&c=3&d=4
		!	                                                    |+--- argument list starts here
		!                                                           +---- start of delimiter list
		!	3. Example Argument list (form #1): a=1&b=2&c=3&d=4
		!	4. Example Argument list (form #2): 1&2&3&4
		!
		q_string$ = query_string$					! copy the Apache data
!~~~		p$ = "GET_"							x (tack on this optional prefix)
		if  q_string$ <> "" then					! if query_string is not blank
		    q_string$ = fix_html_data(q_string$)			!
		    !
		    get_next_qs_param:
		    param% = param% + 1	if param% < k_max_params		! prep to store the parameter
		    amper_pos% = pos(q_string$,"&",1)				! locate the amper delimiter
		    if amper_pos% = 0 then					! if no amper found
			param$(param%) = p$+ q_string$				!
		    else							!
			param$(param%) = p$+ left$(q_string$, amper_pos%-1)	! save first segment
			q_string$      =     right$(q_string$,amper_pos%+1)	! isolate second segment
			goto get_next_qs_param					!
		    end if							!
		end if								!
	end select								!
	!
	!	read POSTed data from Apache
	!
	select request_method$							!
	    case    "POST"							! someone clicked SUBMIT on form with method=POST
		!
		!	we want to read from Apache's STDIN device
		!
		junk% = lib$get_symbol("CONTENT_LENGTH",www_length$)		!
		www_length% = integer(www_length$, long)			!
		!
		stdin$ = WCSM_TrnLnm("SYS$COMMAND", "LNM$PROCESS_TABLE")	!
		junk% = pos(stdin$, "_", 0%)					! locate the underscore in the BG device
		stdin$ = right$(stdin$, junk%+1%)    				!
		!
		when error in							!
		    trace%	= 1						!
		    open stdin$+":" for input as #1				! connect to browser stream
		    trace%	= 2						!
		    margin #1,0							! disable implied EOL after 78 characters
		    handler_error% = 0						! cool
		use								!
		    handler_error% = err					! oops
		end when							!
		!
		select  handler_error%						!
		    case    0							!
		    case else							!
			msg$ =								&
			    "Error: "+ str$(handler_error%) +" during POST read"+cr+lf+	&
			    "Ert  : "+ ert$(handler_error%)			+cr+lf+	&
			    "Trace: "+ str$(trace%)				+cr+lf
			goto send_response					! exit thru here
		end select							!
		!
		get_more_data:
		when error in							!
		    trace%	= 3						!
		    while 1							! read until EOF
			linput #1, a$						! read directly from the browser
			b$ = b$ + a$						! question: won't this overflow at 32767?
			cause error 50 if len(b$) > 32000			! oops, b$ is getting rather large
		    next							!
		use								!
		    handler_error% = err					!
		end when							!
		select  handler_error%						!
		    case    11							! EOF
		    case    50							! Exceeded 32000 byte limit
		    case    252							! FILE ACP failure (input)
		    case else							!
			msg$ =								&
			    "Error: "+ str$(handler_error%) +" during POST read"+cr+lf+	&
			    "Ert  : "+ ert$(handler_error%)			+cr+lf+	&
			    "Trace: "+ str$(trace%)				+cr+lf
			goto send_response					! exit thru here
		end select							!
		!
		data_length% = data_length% + len(b$)				! remember total bytes received
		html_data$ = fix_html_data(b$)	if b$ <> ""			!
		!
    %let %debugdata = 0								! disabled for now
    %if  %debugdata = 1 %then							!
		msg$ = html_data$						!
		goto send_response						!
    %end %if									!
		!
!~~~		p$ = "POST_"							x (tack on this optional prefix)
		if html_data$ <> "" then					! if query_string is not blank
		    !
		    get_next_param:
		    param% = param% + 1	if param% < k_max_params		! prep to store the parameter
		    amper_pos% = pos(html_data$,"&",1)				! locate the amper delimiter
		    if amper_pos% = 0 then					! if no amper found (must be on the last param)
			param$(param%)	= p$+ html_data$			!
		    else							!
			amper_remember%	= amper_pos%				! save for buffer trimming
			param$(param%)	= p$+	left$(html_data$, amper_pos%-1)	! save first segment
			html_data$ 	=	right$(html_data$,amper_pos%+1)	! isolate second segment
			goto get_next_param					!
		    end if							!
		end if								!
		!
		!	future work (requires development for POSTs over 32767 bytes)
		!
    %let %future = 0								! disabled for now
    %if  %future = 1 %then							!
		if www_length% > data_length% then				! if we haven't received everything
		    if	amper_remember% > 0 then				! if non-zero
			html_data$ = right$(html_data$,amper_remember%-1)	! reduce size of html_data$
			amper_remember% = 0					! zap
			goto get_more_data					! loop back
		    end if							!
		end if
    %end %if
		!
		display_blank_page% = 0						!
	    case    "GET"							!
		display_blank_page% = 1						!
	end select								!
	!
	!	let's scan the POSTed params and transfer them to variables
	!
	for i% = 1 to param%							!
	    equal_pos% = pos(param$(i%),"=",1)					!
	    if equal_pos% = 0 then						!
		noun$ = param$(i%)						!
		verb$ = ""							!
	    else								!
		noun$ = left$ (param$(i%),	equal_pos%-1)			!
		verb$ = right$(param$(i%),	equal_pos%+1)			!
	    end if								!
	    !
	    select noun$							!
		case    "USER1"							! USER NAME
		    user1$  = verb$						!
		case    "PASS1"							! current p/w
		    pass1$ = verb$						!
		case    "PASS2"							! new p/w
		    pass2$ = verb$						!
		case    "PASS3"							! verify p/w
		    pass3$ = verb$						!
		case    "USER4"							! MANAGER NAME
		    user4$ = verb$						!
		case    "PASS4"							! manager p/w
		    pass4$ = verb$						!
		case    "DEBUG","debug","HACK","hack"				!
		    debug% = 1							!
	    end select								!
	next i%									!
	if debug% = 1 then							!
	    msg$ = "-i-Apache Symbols:"+			 &
		"<br>REQUEST_METHOD: "+	request_method$		+&
		"<br>HTTP_HOST: "+	http_host$		+&
		"<br>PATH: "+		path$			+&
		"<br>PATH_INFO: "+	path_info$		+&
		"<br>PATH_TRANSLATED: "+path_translated$	+&
		"<br>QUERY_STRING: "+	query_string$		+&
		"<br>SERVER_ADDR: "+	server_addr$		+&
		"<br>SERVER_PORT: "+	server_port$		+&
		"<br>SCRIPT_FILENAME: "+script_filename$	+&
		"<br>SCRIPT_NAME: "+	script_name$
	    goto send_response							!
	end if									!
    %else									! an external glue file is required
	!-----------------------------------------------------------------------
	! this block of code requires that our CGI script first called a glue program
	! which will read POSTed HTML data then convert it to DCL symbols
	!
	! Note: our cgi glue program adds the prefix "FORM_FLD_" to all variables
	!-----------------------------------------------------------------------
	call lib$get_symbol("REQUEST_METHOD",request_method$)			!
	print "-i-REQUEST_METHOD: "+request_method$	if debug% > 0		!
	select request_method$							!
	    case    "POST"							! "POST" via SUBMIT button
		call lib$get_symbol("FORM_FLD_USER1"		,user1$)	!
		call lib$get_symbol("FORM_FLD_PASS1"		,pass1$)	!
		call lib$get_symbol("FORM_FLD_PASS2"		,pass2$)	!
		call lib$get_symbol("FORM_FLD_PASS3"		,pass3$)	!
		call lib$get_symbol("FORM_FLD_USER4"		,user4$)	!
		call lib$get_symbol("FORM_FLD_PASS4"		,pass4$)	!
		if debug% > 0 then						!
		    print "-i-FORM_FLD_USER1>"+ user1$		+"<"		!
		    print "-i-FORM_FLD_PASS1>"+ pass1$		+"<"		!
		    print "-i-FORM_FLD_PASS2>"+ pass2$		+"<"		!
		    print "-i-FORM_FLD_PASS3>"+ pass3$		+"<"		!
		    print "-i-FORM_FLD_USER4>"+ user4$		+"<"		!
		    print "-i-FORM_FLD_PASS4>"+ pass4$		+"<"		!
		    sleep 1							!
		end if								!
		display_blank_page% = 0						!
	    case else								! "GET" via the URL string
		display_blank_page% = 1						!
	end select								!
    %end %if
	!=======================================================================
	!	what is the user trying to do? GET or POST?
	!=======================================================================
	main2:
	rc% = lib$getsyi( syi$_nodename,,node_name$ )				!
!~~~	node_name$ = edit$(node_name$,32+2)					x superfluous since always up case
	select node_name$							!
	    case    "KAWC15", "KAWC96"						! my production platforms
		blocked% = 0							! not blocked
	    case    "KAWC09"							! my development platform
		blocked% = 0							! not blocked
		dvlp% = 1							!
	    case else								!
		blocked% = 1							! blocked by default
	end select								!
	fake_fs1$ = "file"+ wcsm_dt_stamp +".txt"				! use this in MIME headers		bf_108.3
	fake_fs2$ = "file"+ wcsm_dt_stamp +".html"				! use this in MIME headers		bf_108.3
	junk$ = WCSM_TrnLnm("CSMIS$DEBUG", "LNM$PROCESS_TABLE")			! this may be set by the CGI
	junk$ = "0" if junk$ = ""						!
	when error in								!
	    debug% = integer(junk$)						! 0=Off, 1=On(basic), 2=On(extreme)	<<<---***
	use									!
	    debug% = 0								!
	end when								!
	if debug% > 0 then							!
	    print "Status: 200"							! start of HTML response header
	    print 'Cache-Control: no-cache, no-store'				! this is better than HTML META
	    print "Content-type: text/plain"					!
	    print "Content-disposition: inline; filename="+ dq + fake_fs1$ +dq	!					bf_108.3
	    print ""								! end of HTML response header
	    print "-i-program: "+ k_program +"."+ k_version			!
	    print "-i-debug level: "+str$(debug%)				!
	end if									!
	!
	!	web implementation notes:
	!	1. the first time through here we use GET mode so will send back a web page
	!	2. when the button is clicked, we use POST mode and read the HTML data
	!	3. let's hope the system admin set this up to only allow HTTPS
	!
	call sys$setpri(,,3% by value,,,)					! drop back to below interactive default
	!
	!	<<< do inits >>>
	!
	junk% = pos(script_uri$,"//",1)						! https://kawc09.on.bell.ca/scripts/www_password_change
	if junk% = 0 then							!
	    url$ = script_uri$							! use whole uri
	else									!
	    url$ = right$(script_uri$,junk%+2)					!
	end if									!
	!
	goto process_http_request	if display_blank_page% = 0		! must have done HTTP-POST so jump
	!-----------------------------------------------------------------------
	!	user must have done HTTP-GET so...
	!	create a blank page, display it, then exit
	!-----------------------------------------------------------------------
	out$ =	'Status: 200'									+cr+lf+	! good response		&
	    'Cache-Control: no-cache, no-store'							+cr+lf+	! better than HTML meta	&
	    'Content-type: text/html'								+cr+lf+	!			&
	    'Content-disposition: inline; filename='+ dq + fake_fs2$ +dq			+cr+lf	!			&
	    											+cr+lf+	! end of HTTP header	&
	    '<!DOCTYPE html>'									+cr+lf+	!			&
	    '<html lang="en-us">'								+cr+lf+	!			&
	    '<head>'										+cr+lf+	!			&
	    '<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">'		+cr+lf+	!			&
	    '<title>ICSIS Password Change</title>'						+cr+lf+	!			&
	    '<style type="text/css">'								+cr+lf+	!			&
	    ' body	{ font-family: Calibri, "Trebuchet MS", Verdana, sans-serif;'		+	!			&
	    ' font-size: 12pt; background-color: #fff; }'     		             	  	+cr+lf+	!			&
	    ' .title	{ color: red; font-size: 14pt; font-weight:bold }'			+cr+lf+	!			&
	    ' .copy	{ color: black; font-size: 13pt; font-weight:bold }'			+cr+lf+	!			&
	    ' a:link	{ color: blue }'							+cr+lf+	!			&
	    ' a:visited	{ color: blue }'							+cr+lf+	!			&
	    ' a:hover	{ color: blue; background-color: #ffa; cursor: pointer }'		+cr+lf+	!			&
	    ' a:active	{ color: blue }'							+cr+lf+	!			&
	    ' pre	{ font-weight:700 }'							+cr+lf+	!			&
	    ' form	{ font-family: "Courier New", Courier, monospace; font-size:12pt; color: black }'	+cr+lf+	!	&
	    ' input	{ font-family: "Courier New", Courier, monospace; font-size:12pt; color: black }'	+cr+lf+	!	&
	    ' .wb	{ background-color: #00f; color: #fff; font-weight: bold }'		+cr+lf+	! white-on-blue		&
	    ' .wr	{ background-color: #f00; color: #fff; font-weight: bold }'		+cr+lf+	! white-on-red		&
	    ' .y	{ background-color: #ff0; font-weight: bold }'				+cr+lf+	! yellow bold		&
	    ' .g	{ background-color: #9e9; font-weight: bold }'				+cr+lf+	! green  bold		&
	    ' .b	{ color: blue }'							+cr+lf+	! blue			&
	    ' .r	{ color: red }'								+cr+lf+	! blue			&
	    ' .yellow	{ background-color: #ff0 }'						+cr+lf+ ! yellow		&
	    '</style>'										+cr+lf+	!			&
	    '<script type="text/javascript">'							+cr+lf+	!			&
	    'var gbl_mode = 0; // init'								+cr+lf+	!			&
	    'function flip(){'									+cr+lf+	!			&
	    ' if (document.getElementById("USER4").value!=""){'					+cr+lf+	!			&
	    '  document.getElementById("PASS1").value="";'					+cr+lf+	!			&
	    '  document.getElementById("PASS1").style.backgroundColor="#d8d8d8";'		+cr+lf+	!			&
	    '  document.getElementById("PASS1").readOnly=true;'					+cr+lf+	! same as disabled	&
	    '  document.getElementById("PASS4").style.backgroundColor="#ffffff";'		+cr+lf+	!			&
	    '  document.getElementById("PASS4").readOnly=false;'				+cr+lf+	! same as enabled	&
	    '  gbl_mode = 1; // manager'							+cr+lf+	!			&
	    ' }else{'										+cr+lf+	!			&
	    '  document.getElementById("PASS4").value="";'					+cr+lf+	!			&
	    '  document.getElementById("PASS4").style.backgroundColor="#d8d8d8";'		+cr+lf+	!			&
	    '  document.getElementById("PASS4").readOnly=true;'					+cr+lf+	! same as disabled	&
	    '  document.getElementById("PASS1").style.backgroundColor="#ffffff";'		+cr+lf+	!			&
	    '  document.getElementById("PASS1").readOnly=false;'				+cr+lf+	! same as enabled	&
	    '  gbl_mode = 2; // user'								+cr+lf+	!			&
	    ' }'										+cr+lf+	!			&
	    ' validate();	// display messages'						+cr+lf+	!			&
	    '}'											+cr+lf+	!			&
	    'function validate(){'								+cr+lf+	!			&
	    ' var gonogo=1;	// init to go'							+cr+lf+	!			&
	    ' var p1=document.getElementById("PASS1").value;'					+cr+lf+	!			&
	    ' var p2=document.getElementById("PASS2").value;'					+cr+lf+	!			&
	    ' var p3=document.getElementById("PASS3").value;'					+cr+lf+	!			&
	    ' var p4=document.getElementById("PASS4").value;'					+cr+lf+	!			&
	    ' var u1=document.getElementById("USER1").value;'					+cr+lf+	!			&
	    ' var u4=document.getElementById("USER4").value;'					+cr+lf+	!			&
	    ' document.getElementById("MSGP1").innerHTML="";'					+cr+lf+	!			&
	    ' document.getElementById("MSGP2").innerHTML="";'					+cr+lf+	!			&
	    ' document.getElementById("MSGP3").innerHTML="";'					+cr+lf+	!			&
	    ' document.getElementById("MSGP4").innerHTML="";'					+cr+lf+	!			&
	    ' document.getElementById("MSGU1").innerHTML="";'					+cr+lf+	!			&
	    ' document.getElementById("MSGU4").innerHTML="";'					+cr+lf+	!			&
	    ' document.getElementById("DEBUG1").innerHTML="";'					+cr+lf+	!			&
	    ' document.getElementById("DEBUG2").innerHTML="";'					+cr+lf+	!			&
	    ' switch(gbl_mode){'								+cr+lf+	!			&
	    ' case 1:	// manager mode'							+cr+lf+	!			&
	    '  if (p4.length<6){'								+cr+lf+	!			&
	    '   document.getElementById("MSGP4").innerHTML="too small";'			+cr+lf+	!			&
	    '   gonogo=0;'									+cr+lf+	!			&
	    '  }'										+cr+lf+	!			&
	    '  if (u4.length<4){'								+cr+lf+	!			&
	    '   document.getElementById("MSGU4").innerHTML="too small";'			+cr+lf+	!			&
	    '   gonogo=0;'									+cr+lf+	!			&
	    '  }'										+cr+lf+	!			&
	    '  if (u1==u4){'									+cr+lf+	!			&
	    '   document.getElementById("MSGU4").innerHTML="Error, MANAGER same as USER";'	+cr+lf+	!			&
	    '   gonogo=0;'									+cr+lf+	!			&
	    '  }'										+cr+lf+	!			&
	    '  break;'										+cr+lf+	!			&
	    ' case 2:	// user mode'								+cr+lf+	!			&
	    '  if (u1.length<4){'								+cr+lf+	!			&
	    '   document.getElementById("MSGU1").innerHTML="too small";'			+cr+lf+	!			&
	    '   gonogo=0;'									+cr+lf+	!			&
	    '  }'										+cr+lf+	!			&
	    '  if (p1.length<6){'								+cr+lf+	!			&
	    '   document.getElementById("MSGP1").innerHTML="too small";'			+cr+lf+	!			&
	    '   gonogo=0;'									+cr+lf+	!			&
	    '  }'										+cr+lf+	!			&
	    '  break;'										+cr+lf+	!			&
	    ' default:'										+cr+lf+	!			&
	    '  gonogo=0;'									+cr+lf+	!			&
	    '  break;'										+cr+lf+	!			&
	    ' }'										+cr+lf+	!			&
	    ' // code common to all modes'							+cr+lf+	!			&
	    ' if (p2.length<6){'								+cr+lf+	!			&
	    '  document.getElementById("MSGP2").innerHTML="too small";'				+cr+lf+	!			&
	    '  gonogo=0;'									+cr+lf+	!			&
	    ' }'										+cr+lf+	!			&
	    ' if (p3.length<6){'								+cr+lf+	!			&
	    '  document.getElementById("MSGP3").innerHTML="too small";'				+cr+lf+	!			&
	    '  gonogo=0;'									+cr+lf+	!			&
	    ' }'										+cr+lf+	!			&
	    ' if ((p1==p2)&&(p1.length>0)){'							+cr+lf+	!			&
	    '  document.getElementById("MSGP2").innerHTML="error: same as CURRENT PASSWORD";'	+cr+lf+	!			&
	    '  gonogo=0;'									+cr+lf+	!			&
	    ' }'										+cr+lf+	!			&
	    ' if ((p2!=p3)&&(p3.length>0)){'							+cr+lf+	!			&
	    '  document.getElementById("MSGP3").innerHTML="error: different than NEW PASSWORD";'+cr+lf+	!			&
	    '  gonogo=0;'									+cr+lf+	!			&
	    ' }'										+cr+lf+	!			&
	    ' document.getElementById("DEBUG1").innerHTML="Mode: "+gbl_mode;'			+cr+lf+	!			&
	    ' if (gonogo==0){'									+cr+lf+	!			&
	    '  document.getElementById("B1").style.backgroundColor="#ff0000";'			+cr+lf+	! red			&
	    '  return(false);'									+cr+lf+	! block submit		&
	    ' }else{'										+cr+lf+	!			&
	    '  document.getElementById("B1").style.backgroundColor="#00ff00";'			+cr+lf+	! green			&
	    '  return(true);'									+cr+lf+	! allow submit		&
	    ' };'										+cr+lf+	!			&
	    '}'											+cr+lf+	!			&
	    '</script>'										+cr+lf+	!			&
	    '</head><body onload="flip();">'							+cr+lf+	!			&
	    '<noscript><p>Oops, JavaScript is not enabled in your browser</p></noscript>'	+cr+lf+	!			&
	    '<span class="title">ICSIS Password Change Tool</span>'				+	!			&
	    '<span class="copy"> Copyright &copy; 2000-2013, Bell Canada</span>'		+cr+lf+	!			&
	    '<form class="font14" id="FORM1" name="FORM1" method="POST"'			+	!			&
	    ' action="/scripts/'+ k_program +'" >'						+	!			&
	    '<p>'										+	!			&
	    '<b>User Name&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</b>'			+	! Line #1		&
	    ' <input size="12" type="text" name="USER1" id="USER1" onkeyup="flip();">'		+	!			&
	    ' <span name="MSGU1" id="MSGU1"></span><br>'					+cr+lf+	!			&
	    '<b>Current Password</b>'								+	! Line #2		&
	    ' <input size="32" type="password" name="PASS1" id="PASS1" onkeyup="validate();">'	+	!			&
	    ' <span name="MSGP1" id="MSGP1"></span><br>'					+cr+lf+	!			&
	    '<b>New&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Password</b>'					+	! Line #3		&
	    ' <input size="32" type="password" name="PASS2" id="PASS2" onkeyup="validate();">'	+	!			&
	    ' <span name="MSGP2" id="MSGP2"></span><br>'					+cr+lf+	!			&
	    '<b>Verify&nbsp;&nbsp;Password</b>'							+	! Line #4		&
	    ' <input size="32" type="password" name="PASS3" id="PASS3" onkeyup="validate();">'	+	!			&
	    ' <span name="MSGP3" id="MSGP3"></span><br>'					+cr+lf+	!			&
	    '&nbsp;<input type="submit" value="Change" name="B1" id="B1" '			+	!			&
	    '	onclick="JavaScript:return validate();">'+						! enable/disable submit	&
	    '<input type="hidden" name="hidden_name" value="web"></p>'				+	!			&
	    '<pre>Caveat: ICSIS user names are of the form xx_xxxxxx'				+cr+lf+	!			&
	    '        passwords must be letters and or numbers only'				+cr+lf+	!			&
	    '        passwords must be a least 8 characters long'				+cr+lf+	!			&
	    '        nothing is case sensitive (for now)'					+cr+lf+	!			&
	    '        this process always invokes a 5 second delay for security purposes'	+cr+lf+	!			&
	    '        all activities (including your I/P address) are logged'			+cr+lf+	!			&
	    '</pre><hr>'									+	!			&
	    '<b>=== For use by managers changing passwords for their employees ===</b>'		+	!			&
	    '<br><br>'										+cr+lf+	!			&
	    '<b>Manager Name&nbsp;&nbsp;&nbsp;&nbsp;</b>'					+	! Line #5		&
	    ' <input size="12" type="text" name="USER4" id="USER4" onkeyup="flip();">'		+cr+lf+	!			&
	    ' <span name="MSGU4" id="MSGU4"></span><br>'					+cr+lf+	!			&
	    '<b>Manager Password</b>'								+	! Line #6		&
	    ' <input size="32" type="password" name="PASS4" id="PASS4" onkeyup="validate();">'	+	!			&
	    ' <span name="MSGP4" id="MSGP4"></span><br>'					+cr+lf+	!			&
	    '</form><hr>'									+	!			&
	    '<span name="DEBUG1" id="DEBUG1"></span><br>'					+	!			&
	    '<span name="DEBUG2" id="DEBUG2"></span><br>'					+	!			&
	    '<p><img src="/images/valid-html401.gif" '						+	!			&
	    'alt="Valid HTML 4.01 Transitional" style="border:0; width:88px">'			+	!			&
	    '</p></body></html>'									!
	print out$										! bam...
	!
	goto fini										!
	!=======================================================================
	!	process the user request
	!=======================================================================
	main3:
	process_http_request:							!
	!
	!	okay, now for some basic sanity tests
	!
	if blocked% = 1 then							!
	    msg$ = "-e-password changes are blocked on this node"		!
	    goto send_response							!
	end if									!
	!
	!	Caveat: starting with OpenVMS-7.3-2 (I think), passwords can be case sensitive.
	!	So we must test UAI$M_PWDMIX to see if we should also upcase PASS1 and PASS2
	!
	user1$	= edit$(user1$	,32+2)						! upcase, no w/s
	pass1$	= edit$(pass1$	,128+8)						! no trailing w/s, no leading w/s
	pass2$	= edit$(pass2$	,128+8)						! no trailing w/s, no leading w/s
	pass3$	= edit$(pass3$	,128+8)						! no trailing w/s, no leading w/s
	!
	user4$	= edit$(user4$	,32+2)						! upcase, no w/s
	pass4$	= edit$(pass4$	,128+8)						! no trailing w/s, no leading w/s
	!
	if (user1$ = user4$) and (user1$ <> "") then				!
	    msg$ = "-e-Error, MANAGER NAME same as USER NAME"			!
	    goto send_response							!
	end if									!
	!-----------------------------------------------------------------------
	!	test the manager name and p/w first (added with version 104.1)
	!-----------------------------------------------------------------------
	mgr_mode% = 0								!					bf_104.1
	select len(user4$)							! test MANAGER name
	    case    0								! if none...
		pass4$ = ""							! then zap this just in case
	    case    < 4								!
		msg$ = "-e-Error, MANAGER NAME is too small"			!
	    case else								!
		select user4$							!
		    case    "NEIL","STEVE","DAVE","KARIM"			!
			mgr_mode% = 1						! enable manager logic below
			pass1$ = ""						! zap this just in case
			select len(pass4$)					!
			    case    0						!
				msg$ = "-e-Error, MANAGER PASSWORD is blank"	!
			    case    < 4						! a system manager might have set it this short
				msg$ = "-e-Error, MANAGER PASSWORD is too small"!
			    case    > UAI$C_MAX_PWD_LENGTH			!
				msg$ = "-e-Error, MANAGER PASSWORD is too large"!
			end select						!
		    case else							!
  %let %externaldb = 1								! 1=enable, 0=none, 1=ICSIS, 2=other
  %if  %externaldb = 0 %then							! -------------------------------------------------
			msg$ = "-e-Error, MANAGER: "+ user4$ +" was not found in profile-db"	! lie to hackers
  %end %if									! -------------------------------------------------
										!
  %if  %externaldb = 1 %then							! -------------------------------------------------
			! ICSIS System Notes:
			! 1) The ICSIS system requires profiled user names of the form "xy_zzzzzzz"
			!    (where x and y are first and middle initials; people without a middle name get "X")
			! 2) The key#0 of the current version of profile-db is based on surname
			! 3) We will only allow a profiled manager to change the VMS password of a profiled user
			! 4) A profiled manager will not be allowed to change the VMS password of accounts like SYSTEM + DECNET.
			!
			%include "[.fil]profiledb_92.rec"			! record map declarations
			!
			!	is the MANAGER NAME profiled in ICSIS?
			!
			when error in						!
			    %include "[.fil]profiledb_92_open91.opn"		! open the file
			    if mid$(user4$,3,1)="_" then			! our profiled names are of the form: xy_zzzzzzz
				junk$ = right$(user4$,4)			! get profiled surname
			    else						!
				cause error 155					! RNF
			    end if						!
			    find #92, key#0 ge junk$, regardless		! set key of reference (w/o lock)
			    while 1						!
				get #92, regardless				! read a record w/o lock
				if edit$(d91_last_name,32+2) <> junk$ then	! if we lost our key of reference...
				    cause error 155				! ...then exit with RNF
				end if						!
				!
				! remember, there may be more than one "SMITH"
				!
				if user4$ = edit$(d91_csmis_id,32+2) then	! if we found the specified user
				    if d91_title = "MGR" then			! if this user is also a manager
					handler_error% = 0			! then we'll allow it
					goto exit_profile_search_mgr		! so jump
				    else					!
					cause error 50				! pretend it is a DATA FORMAT ERROR
				    end if					!
				end if						!
			    next						!
			use							!
			    handler_error% = err				! oops
			end when						!
			!
			exit_profile_search_mgr:				!
			select handler_error%					!
			    case 0						!
			    case 50						!
				msg$ = "-e-Error, MANAGER: "+ user4$ +" is not a manager"
			    case 155						!
				msg$ = "-e-Error, MANAGER: "+ user4$ +" was not found in profile-db"
			    case else						!
				msg$ = "-e-Error, MANAGER: "+ user4$ +" caused BASIC error :"+ str$(handler_error%)
			end select						!
			!
			!	is USER NAME (target of action by MASTER NAME) profiled in ICSIS?
			!
			when error in						!
			    if mid$(user1$,3,1)="_" then			! our profiled names are of the form: xy_zzzzzzz
				junk$ = right$(user1$,4)			! get profiled surname
			    else						!
				cause error 155					! RNF
			    end if						!
			    find #92, key#0 ge junk$, regardless		! set key of reference (w/o lock)
			    while 1						!
				get #92, regardless				! read a record w/o lock
				if edit$(d91_last_name,32+2) <> junk$ then	! if we lost our key of reference...
				    cause error 155				! ...then exit with RNF
				end if						!
				!
				! remember, there may be more than one "SMITH"
				!
				if user1$ = edit$(d91_csmis_id,32+2) then	! if we found the specified user
				    if d91_title <> "MGR" then			! if this user is NOT a manager
					handler_error% = 0			! then we'll allow it
					goto exit_profile_search_usr		! so jump
				    else					!
					cause error 50				! pretend it is a DATA FORMAT ERROR
				    end if					!
				end if						!
			    next						!
			use							!
			    handler_error% = err				! oops
			end when						!
			!
			exit_profile_search_usr:				!
			select handler_error%					!
			    case 0						!
			    case 50						!
				msg$ = "-e-Error, USER: "+ user1$ +" is a manager (peers cannot change peer authentication)"
			    case 155						!
				msg$ = "-e-Error, USER: "+ user1$ +" was not found in profile-db"
			    case else						!
				msg$ = "-e-Error, USER: "+ user1$ +" caused BASIC error :"+ str$(handler_error%)
			end select						!
  %end %if									!
										!
  %if  %externaldb = 2 %then							! -------------------------------------------------
			insert your own code here
  %end %if
		end select							! -------------------------------------------------
		if user1$ = user4$ then						!
		    msg$ = "-e-Error, MANAGER NAME same as USER NAME"		!
		end if								!
	end select								!
	goto send_response if msg$ <> ""					!
	!
	if  mgr_mode% = 1 then
	    !
	    !	prep for call to sys$getuai (fetch hashed password of manager)
	    !
	    myItems(0)::BuffLen		= 4					! size of uai_encrytion_type% in bytes
	    myItems(0)::ItemCode	= UAI$_ENCRYPT				!
	    myItems(0)::BuffAddr	= loc(uai_encrytion_type%)		! addr of uai_encrytion_type%
	    myItems(0)::RtnLenAdr	= 0					! location of bytes returned (don't care)
	    !
	    myItems(1)::BuffLen		= 8					! size of hashed_password in bytes (64-bit)
	    myItems(1)::ItemCode	= UAI$_PWD				!
	    myItems(1)::BuffAddr	= loc(uai_hashed_pw)			! addr of hashed_password
	    myItems(1)::RtnLenAdr	= 0					! location of bytes returned (don't care)
	    !
	    myItems(2)::BuffLen		= 2					! size of uai_salt in bytes
	    myItems(2)::ItemCode	= UAI$_SALT				!
	    myItems(2)::BuffAddr	= loc(uai_salt)				! addr of uai_salt
	    myItems(2)::RtnLenAdr	= 0					! location of bytes returned (don't care)
	    !
	    myItems(3)::BuffLen		= 4					! size of uai_flags1 in bytes (UAI$S_FLAGS)
	    myItems(3)::ItemCode	= UAI$_FLAGS				!
	    myItems(3)::BuffAddr	= loc(uai_flags1%)			! addr of uai_flags1
	    myItems(3)::RtnLenAdr	= 0					! location of bytes returned (don't care)
	    !
	    myItems(4)::List_Terminator	= 0					!
	    !
	    !	SYS$GETUAI [nullarg] ,[contxt] ,usrnam ,itmlst ,[nullarg] ,[nullarg] ,[nullarg]
	    !
	    rc% = sys$getuai(,,user4$,myItems(0),,,)				!
	    rc_bits% = (rc% and 7%)						!
	    if rc_bits% <> 1% then						!
		select rc%							!
		    case    RMS$_RNF						!
			msg$ = "-e-Error, MANAGER NAME and/or PASSWORD are invalid"
		    case else							!
			msg$ = "-e-getuai-"+ mid$(k_error_severity$, rc_bits%+1, 1) +"-rc: "+str$(rc%)
		end select							!
		goto send_response						!
	    end if								!
	    !
	    if (uai_flags1% and UAI$M_PWDMIX) = 0 then				! if mixed-case passwords are not allowed
		pass4$ = edit$(pass4$ ,32)					! upcase
	    end if								!
	    !
	    !	now get a hash for PASS4 and make sure it matches the hashed password retrieved from sys$getuai
	    !
	    !	SYS$HASH_PASSWORD pwd ,alg ,[salt] ,usrnam ,hash
	    !
	    rc% = sys$hash_password(pass4$,uai_encrytion_type%,uai_salt,user4$,pass4_hash)
	    rc_bits% = (rc% and 7%)						!
	    if rc_bits% <> 1% then						!
		msg$ = "-e-hash_password1-"+ mid$(k_error_severity$, rc_bits%+1%, 1%) +"-rc: "+str$(rc%)
		goto send_response						!
	    end if								!
	    !
	    !	do hashes match?
	    !
	    if pass4_hash <> uai_hashed_pw then					! NO
		msg$ = "-e-Error, MANAGER NAME and/or PASSWORD are invalid"	!
		goto send_response						!
	    end if								!
	end if									!

	!-----------------------------------------------------------------------
	!	pre-104 code resumes
	!-----------------------------------------------------------------------
	select len(user1$)							!
	    case    0								!
		msg$ = "-e-Error, USER NAME is blank"				!
	    case    < 4								!
		msg$ = "-e-Error, USER NAME is to small"			!
	end select								!
	goto send_response if msg$ <> ""					!
	!
	select edit$(user1$,32+2)						! upcase for tests
	    case    "SYSTEM","DEFAULT","MANAGER","SSHD","DECNET"		!
		msg$ = "-e-Error, you can't user this web tool to modify the password of a reserved account"
		goto send_response						!
	    case else								!
		junk$ = edit$(user1$,32+2)					! upcase for tests
		junk% = 0							! init test
		junk% = 1 if pos(junk$,"SSH"	,1)				!
		junk% = 1 if pos(junk$,"SHARE"	,1)				!
		junk% = 1 if pos(junk$,"SERVER"	,1)				!
		if junk% = 1 then						!
		    msg$ = "-e-Error, you can't user this web tool to modify the password of a reserved account"
		    goto send_response						!
		end if								!
	end select								!
	!
	!	in user mode we first validate USER1/PASS1
	!
	if mgr_mode% = 0 then							! USER
	    select len(pass1$)							!
		case    0							!
		    msg$ = "-e-Error, CURRENT PASSWORD is blank"		!
		case    < 4							! a system manager might have set it this short
		    msg$ = "-e-Error, CURRENT PASSWORD is too small"		!
		case    > UAI$C_MAX_PWD_LENGTH					!
		    msg$ = "-e-Error, CURRENT PASSWORD is too large"		!
	    end select								!
	else									! MANAGER
	end if									!
	goto send_response if msg$ <> ""					!
	!-----------------------------------------------------------------------
	!	for security reasons, we only allow one transaction at a time
	!	so apply an exclusive lock on a specific file (others can wait)
	!-----------------------------------------------------------------------
	lock_count% = 0								! init
	!
	lock_loop:								!
	sleep 1									! 1 second delay to prevent probing
	lock_count% = lock_count% + 1						! incr
	if lock_count% >= k_max_loop then					!
	    msg$ = "-e-Error, could not acquire a lock within "+str$(k_max_loop)+" seconds. Please try again later"
	    goto send_response							! print and exit
	end if									!
	!
	map(xyz)string	d99_ccyymmddhhmmss = 14		,			! (future use)					&
		long    d99_transaction_counter%				! (future use)
	!
	when error in								!
	    open k_lock_fs$ as #99						!						&
		,access modify							! we want full access				&
		,allow none							! no one else may access this (for now)		&
		,organization relative						!						&
		,map xyz							!
	    get #99, record 1							! get the record
	    d99_ccyymmddhhmmss = wcsm_dt_stamp					! update the time stamp
	    update #99								! write back (but the file is still locked)
	    handler_error% = 0							! cool
	use									!
	    handler_error% = err						! oops
	end when								!
	!
	select handler_error%							!
	    case    0								! lock was applied
	    case    154, 138, 19						! various lock-related errors
		goto lock_loop							!
	    case    155								! RNF
		d99_ccyymmddhhmmss = wcsm_dt_stamp				! for future use
		d99_transaction_counter% = 1					! for future use
		when error in							!
		    put #99, record 1						!
		    handler_error% = 0						! cool
		use								!
		    handler_error% = err					!
		    msg$ = "-e-Error: "+str$(handler_error%)+" during lock file mtce 123"
		end when							!
		goto lock_loop if msg$ = ""					!
	    case    160								! File attributes not matched
		close #99							!
		when error in							!
		    kill k_lock_fs$						! delete the file
		    handler_error% = 0						! cool
		use								!
		    handler_error% = err					! oops
		    msg$ = "-e-Error: "+str$(handler_error%)+" during lock file mtce 456"
		end when							!
		goto lock_loop if msg$ = ""					!
	    case else								!
		msg$ = "-e-Error, application error "+ str$(handler_error%)	!
	end select								!
	goto send_response if msg$ <> ""					! print and exit
	!-----------------------------------------------------------------------
	!	processing continues
	!-----------------------------------------------------------------------
	!
	!	prep for call to sys$getuai (fetch hashed password of desired user)
	!
	myItems(0)::BuffLen		= 4					! size of uai_encrytion_type% in bytes
	myItems(0)::ItemCode		= UAI$_ENCRYPT				!
	myItems(0)::BuffAddr		= loc(uai_encrytion_type%)		! addr of uai_encrytion_type%
	myItems(0)::RtnLenAdr		= 0					! location of bytes returned (don't care)
	!
	myItems(1)::BuffLen		= 8					! size of hashed_password in bytes (64-bit)
	myItems(1)::ItemCode		= UAI$_PWD				!
	myItems(1)::BuffAddr		= loc(uai_hashed_pw)			! addr of hashed_password
	myItems(1)::RtnLenAdr		= 0					! location of bytes returned (don't care)
	!
	myItems(2)::BuffLen		= 2					! size of uai_salt in bytes
	myItems(2)::ItemCode		= UAI$_SALT				!
	myItems(2)::BuffAddr		= loc(uai_salt)				! addr of uai_salt
	myItems(2)::RtnLenAdr		= 0					! location of bytes returned (don't care)
	!
	myItems(3)::BuffLen		= 1					! size of uai_min_pwd_length in bytes
	myItems(3)::ItemCode		= UAI$_PWD_LENGTH			!
	myItems(3)::BuffAddr		= loc(uai_min_pwd_length%)		! addr of uai_min_pwd_length
	myItems(3)::RtnLenAdr		= 0					! location of bytes returned (don't care)
	!
	myItems(4)::BuffLen		= 4					! size of uai_flags1 in bytes (UAI$S_FLAGS)
	myItems(4)::ItemCode		= UAI$_FLAGS				!
	myItems(4)::BuffAddr		= loc(uai_flags1%)			! addr of uai_flags1
	myItems(4)::RtnLenAdr		= 0					! location of bytes returned (don't care)
	!
	myItems(5)::List_Terminator	= 0					!
	!
	!	SYS$GETUAI [nullarg] ,[contxt] ,usrnam ,itmlst ,[nullarg] ,[nullarg] ,[nullarg]
	!
	rc% = sys$getuai(,,user1$,myItems(0),,,)				!
	rc_bits% = (rc% and 7%)							!
	if rc_bits% <> 1% then							!
	    select rc%								!
		case    RMS$_RNF						! USER not found
		    msg$ = "-e-Error, USER NAME and/or CURRENT PASSWORD are invalid"	! but don't tip off hackers
		case else							!
		    msg$ = "-e-getuai-"+ mid$(k_error_severity$, rc_bits%+1, 1) +"-rc: "+str$(rc%)
	    end select								!
	    goto send_response							!
	end if									!
	!
	if (uai_flags1% and UAI$M_PWDMIX) = 0 then				! if mixed-case passwords are not allowed
	    pass1$ = edit$(pass1$ ,32)						! upcase
	    pass2$ = edit$(pass2$ ,32)						! upcase
	    pass3$ = edit$(pass3$ ,32)						! upcase
	end if									!
	!
	!	now get a hash for PASS1 and make sure it matches the hashed password retrieved from sys$getuai
	!
	!	SYS$HASH_PASSWORD pwd ,alg ,[salt] ,usrnam ,hash
	!
	if mgr_mode% = 0 then							! USER
	    rc% = sys$hash_password(pass1$,uai_encrytion_type%,uai_salt,user1$,pass1_hash)
	    rc_bits% = (rc% and 7%)						!
	    if rc_bits% <> 1% then						!
		msg$ = "-e-hash_password1-"+ mid$(k_error_severity$, rc_bits%+1%, 1%) +"-rc: "+str$(rc%)
		goto send_response						!
	    end if								!
	    !
	    !	do hashes match?
	    !
	    if pass1_hash <> uai_hashed_pw then					! NO
		msg$ = "-e-Error, USER NAME and/or CURRENT PASSWORD are invalid"!
		goto send_response						!
	    end if								!
	    !-----------------------------------------------------------------------
	    !	PASS1 is valid (so now test some other stuff)
	    !-----------------------------------------------------------------------
	    msg$ = "-i-USER NAME + CURRENT PASSWORD are valid"			!
	else									! MANAGER
	    msg$ = "-i-MANAGER + PASSWORD are valid and USER NAME exists"		!
	end if									!
	!
	alt$	= ""								! init
	dbg$	= ""								! init
	status%	= 0								! init to success (1=warning, 2=error)
	!-----------------------------------------------------------------------
	!	display bit details to programmer (output to dbg$)
	!-----------------------------------------------------------------------
	dbg$ = dbg$ +"<br>-i-UAI-Encryption Type: "				!
	select uai_encrytion_type%						!
	    case    UAI$C_AD_II							!
		dbg$ = dbg$ +"UAI$C_AD_II"					!
	    case    UAI$C_PURDY							!
		dbg$ = dbg$ +"UAI$C_PURDY"					!
	    case    UAI$C_PURDY_V						!
		dbg$ = dbg$ +"UAI$C_PURDY_V"					!
	    case    UAI$C_PURDY_S						!
		dbg$ = dbg$ +"UAI$C_PURDY_S"					!
	    case else								!
		dbg$ = dbg$ +"<br>???"						!
	end select								!
	!
	dbg$ = dbg$ +"<br>-i-UAI-Flags1: "+str$(uai_flags1%)			!
	!
	if (uai_flags1% and UAI$M_PWDMIX) = 0 then				!
	    dbg$ = dbg$ +"<br>-i-UAI$M_PWDMIX = 0"				!
	else									!
	    dbg$ = dbg$ +"<br>-i-UAI$M_PWDMIX = 1"				!
	end if									!
	!
	if (uai_flags1% and UAI$M_DISPWDHIS) = 0 then				!
	    dbg$ = dbg$ +"<br>-i-UAI$M_DISPWDHIS = 0"				!
	else									!
	    dbg$ = dbg$ +"<br>-i-UAI$M_DISPWDHIS = 1"				!
	end if									!
	!
	if (uai_flags1% and UAI$M_DISPWDDIC) = 0 then				!
	    dbg$ = dbg$ +"<br>-i-UAI$M_DISPWDDIC = 0"				!
	else									!
	    dbg$ = dbg$ +"<br>-i-UAI$M_DISPWDDIC = 1"				!
	end if									!
	!
	if (uai_flags1% and UAI$M_DISFORCE_PWD_CHANGE) = 0 then			!
	    dbg$ = dbg$ +"<br>-i-UAI$M_DISFORCE_PWD_CHANGE = 0"			!
	else									!
	    dbg$ = dbg$ +"<br>-i-UAI$M_DISFORCE_PWD_CHANGE = 1"			!
	end if									!

	!-----------------------------------------------------------------------
	!	now test flags (output to alt$)
	!-----------------------------------------------------------------------
	if (uai_flags1% and UAI$M_DISACNT) <> 0 then				!
	    alt$ = alt$ +"<br>"+ "-e-account disabled"				!
	    status% = 2								! error
	end if									!
	!
	if (uai_flags1% and UAI$M_GENPWD) <> 0 then				!
	    alt$ = alt$ +"<br>"+ "-e-user is requires to use generated passwords"
	    status% = 2								! error
	end if									!
	!
	if (uai_flags1% and UAI$M_LOCKPWD) <> 0 then				!
	    alt$ = alt$ +"<br>"+ "-e-the password is locked (can't be changed)"	!
	    status% = 2								! error
	end if									!
	!
	if (uai_flags1% and UAI$M_LOCKPWD) <> 0 then				!
	    alt$ = alt$ +"<br>"+ "-e-the password is locked (can't be changed)"	!
	    status% = 2								! error
	end if									!
	!
	if (uai_flags1% and UAI$M_LOCKPWD) <> 0 then				!
	    alt$ = alt$ +"<br>"+ "-w-the password is expired"			!
	    status% = 1								! warning
	end if									!
	!
	select status%								!
	    case    0								! ok
	    case    1								! warning
	    case else								! error
		goto send_response						! exit now
	end select								!
	!
    %let %dvlpexit = 0								! disabled for now
    %if  %dvlpexit = 1 %then							!
	goto send_response							! PROGRAMMER early exit
    %end %if									!
	!-----------------------------------------------------------------------
	!	keep going (prep to change)
	!-----------------------------------------------------------------------
	if pass1$ = pass2$ then							!
	    msg$ = "-e-Error, CURRENT PASSWORD = NEW PASSWORD"			!
	    goto send_response							!
	end if									!
	if len(pass2$) < uai_min_pwd_length% then				!
	    msg$ = "-e-Error, NEW PASSWORD is smaller than "+ str$(uai_min_pwd_length%) +" characters (from SYSUAF)"
	    goto send_response							!
	end if									!
	if len(pass2$) > UAI$C_MAX_PWD_LENGTH then				!
	    msg$ = "-e-Error, NEW PASSWORD is larger than "+ str$(UAI$C_MAX_PWD_LENGTH) +" characters (from STARLET)"
	    goto send_response							!
	end if									!
	if pass2$ <> pass3$ then						!
	    msg$ = "-e-Error, NEW PASSWORD <> VERIFY PASSWORD"			!
	    goto send_response							!
	end if									!

	!-----------------------------------------------------------------------
	!	OPTIONAL
	!	modify some flags (may need to do this BEFORE we change the password)
	!-----------------------------------------------------------------------
	uai_flags2% = uai_flags1%						! copy flags for COS tests
	!
	if (uai_flags2% and UAI$M_DISPWDHIS) = 0 then				! if clear
	    uai_flags2% = uai_flags2% or UAI$M_DISPWDHIS			! then set
	end if									!
	if (uai_flags2% and UAI$M_DISPWDDIC) = 0 then				! if clear
	    uai_flags2% = uai_flags2% or UAI$M_DISPWDDIC			! then set
	end if									!
	if (uai_flags2% and UAI$M_GENPWD) <> 0 then				! if set
	    uai_flags2% = uai_flags2%  and (-1% - UAI$M_GENPWD)			! then clear
	end if									!
	dbg$ = dbg$ +"<br>-i-UAI-Flags2: "+str$(uai_flags2%)			!
	!
	if uai_flags1% = uai_flags2% then					! if flags are the same...
	    dbg$ = dbg$ +" (same as Flags1)"					!
	    goto skip_flags_modify						!	JUMP
	else									! else...
	    dbg$ = dbg$ +" (different than Flags1)"				!
	end if									!
	!
	!	prep for first call to $setuai
	!
	myItems(0)::BuffLen		= 4					! size of uai_flags2 in bytes (UAI$S_FLAGS)
	myItems(0)::ItemCode		= UAI$_FLAGS				!
	myItems(0)::BuffAddr		= loc(uai_flags2%)			! addr of uai_flags2
	myItems(0)::RtnLenAdr		= 0					! location of bytes returned (don't care)
	!
	myItems(1)::List_Terminator	= 0					!
	!
	!	SYS$SETUAI [nullarg] ,[contxt] ,usrnam ,itmlst ,[nullarg] ,[nullarg] ,[nullarg]
	!
	rc% = sys$setuai(,,user1$,myItems(0),,,)				!
	rc_bits% = (rc% and 7%)							!
	if rc_bits% <> 1% then							!
	    select rc%								!
		case    RMS$_RSZ 						!
		    msg$ = "-e-Error, The UAF record is smaller than required; the SYSUAF is likely corrupt."
		case    SS$_NOGRPPRV						!
		    msg$ = "-e-Error, Insufficient GROUP privs (for Apache)"	!
		case    SS$_NOSYSPRV						!
		    msg$ = "-e-Error, Insufficient SYSTEM privs (for Apache)"	!
		case else							!
		    msg$ = "-e-setuai-"+ mid$(k_error_severity$, rc_bits%+1, 1) +"-rc: "+str$(rc%)
	    end select								!
	    goto send_response							!
	end if									!
	skip_flags_modify:							!

	!-----------------------------------------------------------------------
	!	prep to change the password
	!	note:	by leaving quad_time initialized, PWD LIFETIME will be cleared
	!-----------------------------------------------------------------------
	!
	!	prep for call to sys$getuai (fetch hashed password of desired user)
	!
	map(pass2)string new_password	= 32					!
	new_password			= pass2$				! xfer descriptor to fixed
	!
	myItems(0)::BuffLen		= len(pass2$)				! size of actual data
	myItems(0)::ItemCode		= UAI$_PASSWORD				!
	myItems(0)::BuffAddr		= loc(new_password)			! addr of new password
	myItems(0)::RtnLenAdr		= 0					! location of bytes returned (don't care)
	!
	myItems(1)::BuffLen		= 8					! size of actual data
	myItems(1)::ItemCode		= UAI$_PWD_LIFETIME			!
	myItems(1)::BuffAddr		= loc(quad_time)			! addr of new password
	myItems(1)::RtnLenAdr		= 0					! location of bytes returned (don't care)
	!
	myItems(2)::List_Terminator	= 0					!
	!
	!	SYS$SETUAI [nullarg] ,[contxt] ,usrnam ,itmlst ,[nullarg] ,[nullarg] ,[nullarg]
	!
	rc% = sys$setuai(,,user1$,myItems(0),,,)				!
	rc_bits% = (rc% and 7%)							!
	if rc_bits% <> 1% then							!
	    select rc%								!
		case    RMS$_RSZ 						!
		    msg$ = "-e-Error, The UAF record is smaller than required; the SYSUAF is likely corrupt."
		case    SS$_NOGRPPRV						!
		    msg$ = "-e-Error, Insufficient GROUP privs (for Apache)"	!
		case    SS$_NOSYSPRV						!
		    msg$ = "-e-Error, Insufficient SYSTEM privs (for Apache)"	!
		case else							!
		    msg$ = "-e-setuai-"+ mid$(k_error_severity$, rc_bits%+1, 1) +"-rc: "+str$(rc%)
	    end select								!
	    goto send_response							!
	end if									!
	!
	!-----------------------------------------------------------------------
	!	horray...
	!-----------------------------------------------------------------------
	msg$ = "-i-success. Password changed for user: "+ user1$		!
	goto send_response							!
	!
	!=======================================================================
	!	send a response to the browser
	!=======================================================================
	send_response:
	!
	!	prep messages for exit
	!
	select user1$								!
	    case    "CUSTODIAN","PAGER"						! if my development accounts
		if (dbg$ <> "") and (dvlp% = 1) then				! if any debug messages...
		    msg$ = msg$ + dbg$						! ...then let's see them
		end if								!
	end select								!
	!
	if alt$ <> "" then							! if any alternative messages
	    msg$ = msg$ + alt$							! then let's see them
	end if									!
	!
	out$ =	'Status: 200'								+cr+lf+	! good response		&
	    'Cache-Control: no-cache, no-store'						+cr+lf+	! better than HTML meta	&
	    'Content-type: text/html'							+cr+lf+	!			&
	    'Content-disposition: inline; filename='+ dq + fake_fs2$ +dq		+cr+lf	!			&
											+cr+lf+	! end of HTTP header	&
	    '<!DOCTYPE html>'								+cr+lf+	!			&
	    '<html lang="en-us">'							+cr+lf+	!			&
	    '<head>'									+cr+lf+	!			&
	    '<title>ICSIS Password Change</title>'					+cr+lf+	!			&
	    '<style type="text/css">'							+cr+lf+	!			&
	    ' body	{ font-family: Calibri, "Trebuchet MS", Verdana, sans-serif;'	+cr+lf+	!			&
	    '	font-size: 12pt; background-color: #fff; }'				+cr+lf+	!			&
	    ' .title	{ color: red; font-size: 14pt; font-weight:bold }'		+cr+lf+	!			&
	    ' .copy	{ color: black; font-size: 13pt; font-weight:bold }'		+cr+lf+	!			&
	    ' a:link	{ color: blue }'						+cr+lf+	!			&
	    ' a:visited	{ color: blue }'						+cr+lf+	!			&
	    ' a:hover	{ color: blue; background-color: #ffa; cursor: pointer }'	+cr+lf+	!			&
	    ' a:active	{ color: blue }'						+cr+lf+	!			&
	    ' pre	{ font-weight:700 }'						+cr+lf+	!			&
	    ' form  { font-family: "courier new" }'					+cr+lf+	!			&
	    ' .wb	{ background-color: #00f; color: #fff; font-weight: bold }'	+cr+lf+	! white-on-blue		&
	    ' .wr	{ background-color: #f00; color: #fff; font-weight: bold }'	+cr+lf+	! white-on-red		&
	    ' .y	{ background-color: #ff0; font-weight: bold }'			+cr+lf+	! yellow bold		&
	    ' .g	{ background-color: #9e9; font-weight: bold }'			+cr+lf+	! green  bold		&
	    ' .b	{ color: blue }'						+cr+lf+	! blue			&
	    ' .r	{ color: red }'							+cr+lf+	! blue			&
	    ' .yellow { background-color: #ff0 }'					+cr+lf+ ! yellow		&
	    '</style>'									+cr+lf+	!			&
	    '</head><body>'								+cr+lf+	!			&
	    '<span class="title">ICSIS Password Change Tool</span>'			+	!			&
	    '<span class="copy"> Copyright &copy; 2000-2013, Bell Canada</span>'	+	!			&
	    '<p>'									+	!			&
	    msg$									+	!			&
	    '</p>'									+	!			&
	    'link: <a href="'+ script_uri$ +'">'+ url$ + "</a>"				+	!			&
	    '<p>'									+	!			&
	    '<img src="/images/valid-html401.gif" '					+	!			&
	    'alt="Valid HTML 4.01 Transitional" style="border:0; width:88px">'		+	!			&
	    '</p></body></html>'								!
	print out$										! bam...
	!
    %let %logactivity=2								! 0=off, 1=sequential, 2=indexed
    %if  %logactivity=1 %then							! sequential event log
	!
	!	output a simple one-liner data record
	!
	when error in								!
	    open k_log_idx_fs$ as #108						!					&
		,organization sequential					!					&
		,recordsize 32767						! only limit the maximum record size	&
		,access append							!
	    user4$ = "<blank>"	if if user4$ = ""				!
	    print #108, wcsm_dt_stamp +" manager: "+ user4$ +" user: "+ user1$ +" from ip: "+ remote_addr$ +" text: "+ msg$
	use									!
	end when								!
	close #108								!
	!
    %end %if									!
    %if  %logactivity=2 %then							! indexed event log
	!
	map(event109)string	d109_whole_buffer	= 155	,		!&
				d109_align		= 0			!
	map(event109)string	d109_stamp		= 14	,		!&
				d109_user		= 20	,		!&
				d109_manager		= 20	,		!&
				d109_remote_address	= 20	,		!&
				d109_remote_port	=  5	,		!&
				d109_server_address	= 20	,		!&
				d109_server_port	=  5	,		!&
				d109_flag		=  1	,		!&
				d109_msg		= 50	,		!&
				d109_align		=  0			! enforce alignment
	when error in								!
	    open k_log_idx_fs$ as #109			&
		,organization indexed			&
		,map event109				&
		,primary key d109_stamp
	    !
	    d109_whole_buffer	= ""						! init buffer
	    d109_stamp		= wcsm_dt_stamp					!
	    d109_user		= user1$					!
	    d109_manager	= user4$					! this might be blank
	    d109_remote_address	= remote_addr$					!
	    d109_remote_port	= remote_port$					!
	    d109_server_address	= server_addr$					!
	    d109_server_port	= server_port$					!
	    d109_msg		= msg$						!
	    select edit$( mid$(junk$,1,3), 32)					!
		case "-E-"							!
		    d109_flag = "e"						!
		case "-I-"							!
		    d109_flag = "i"						!
		case else							!
		    d109_flag = "?"						!
	    end select								!
	    put #109
	use									!
	end when								!
    %end %if
	!
	!=======================================================================
	!	<<< that's all folks >>>
	!=======================================================================
30000	fini:
	close #99								! release the lock
	print "-i-exiting www_password_change_xxx.bas"	if debug% > 0		!
	end									! <<<------***
	!########################################################################################################################
	!
	!	<<< external functions >>>
	!
32010	%include "[.fun]wcsm_trnlnm.fun"
	! FUNCTION STRING WCSM_TRNLNM(LOGICAL_NAME, TABLE_NAME$)
	!
32020	%include "[.fun]wcsm_dt_stamp.fun"
	! FUNCTION STRING wcsm_dt_stamp
	!
	!========================================================================================================================
	!	<<< fix html data >>>
	!========================================================================================================================
32030	function string fix_html_data(string html_input$)				!
	option type=explicit								! no kid stuff
	declare long	x%, y%, z%, handler_error%,					&
		string	html$								!
	!
	html$ = html_input$								! copy passed data string
	!
	!	replace plus signs with spaces
	!
	strip_plus_sign:								!
	x% = pos(html$, "+", 1)								! locate "+"
	if x% > 0% then									! if we found one...
	    mid$(html$, x%, 1) = " "							! replace with a space
	    goto strip_plus_sign							! look for more
	end if										!
	!
	!	dehexify (eg. %0d -> chr$(13))
	!
	dehexify:									!
	declare string	constant hex_string$ = "0123456789ABCDEF"			!
	x% = pos(html$, "%", 1)								! locate "%" (first time)
	while x% <> 0									!
	    when error in								!
		y% = pos(hex_string$, mid$(html$, x%+1, 1) ,1)				! isolate char 1 and enumerate
		z% = pos(hex_string$, mid$(html$, x%+2, 1), 1)				! isolate char 2 and enumerate
		goto dehexify_exit if (y% = 0) or (z% = 0)				! danger Wil Robinson...
		y% = (y% - 1) * 16							! adjust tens digit
		z% = (z% - 1)								! adjust ones digit
		select (y% + z%)							! test the ASCII code
		    case    < 32							! control character?
    %let %method = 2
    %if  %method = 1 %then								!
			html$ = seg$(html$, 1, x%-1) + seg$(html$, x%+3, len(html$))	! then ignore all 3 chars
    %else										!
			mid$(html$, x%, 1) = " "					! replace "%" with <space>
			html$ = seg$(html$, 1, x%  ) + seg$(html$, x%+3, len(html$))	! and ignore the next two chars
			x% = x% + 1							! advance (incase we just decoded a percent)
    %end %if										!
		    case else								! not a control character
			mid$(html$, x%, 1) = chr$(y% + z%)				! replace "%" with replacement character
			html$ = seg$(html$, 1, x%  ) + seg$(html$, x%+3, len(html$))	! and ignore the next two chars
			x% = x% + 1							! advance (incase we just decoded a percent)
		end select								!
		handler_error% = 0							! cool
	    use										!
		handler_error% = err							! oops
	    end when									!
	    goto dehexify_exit if handler_error% <> 0					!
	    x% = pos(html$,"%",x%)							! locate "%" (for next pass)
	next										!
	html$ = edit$(html$, 128+16+8)							! no trail, compress to one, no lead
	dehexify_exit:									!
	!
	fix_html_data = html$								!
	end function									!
	!