Lotus Domino Webサーバーを安全に: 新しいインターネット・ロックアウト機能について

javascript:changePwd();

function changePwd(){
	var uname = document.forms[0].Username.value; 
	window.location = '/PwdMgt.nsf/PwdQuery?OpenAgent&QueryString=' + uname;
}

Sub Initialize
%REM
Purpose - This agent is for demo/sample purposes only and is not intended to be 
implemented in a production environment.  This agent createsa random password and sets 
the HTTPPassword and HTTPPasswordChangeDate fields with appropriate values. Then an 
email is sent to the user with the new password.  Please note that it may take a few 
minutes for the user to use new password after the agent has be executed.
Input. Abbreviated Lotus Notes name that is used to look up the person document in 
the Lotus Domino Public Directory.
Output.  The Print statement in this agent writes to the browser and shows the user 
that the agent has been processed as the password has been changed.  The output of 
this agent is only a sample and is limited in nature but could be expanded on greatly.
Instantiated.  This is agent is to be executed by a URL with the user name of the 
person to have the password change appended to the URLusing  QueryString.  
The URL should conform to this standard for the agent to execute properly:
http://domain/PwdMgt.nsf/PwdQuerySave?OpenAgent&QueryString=Abbreviated Name
%END REM
	
' Setup the Agent Log
Dim errStr As String     'Error string variables
Dim agentLog As New NotesLog("Agent log")     'Used to write to the Agent Log
Call agentLog.OpenAgentLog
Call agentLog.LogAction("Entering the Initialize")
	
On Error Goto ErrorHandler
	
' Setup the variable to be used to process the Admin P Request
Dim session As New NotesSession     'Domino Session object
Dim dbDirectory As NotesDatabase     'Database object for the Domino directory
Dim db As NotesDatabase     'Database object for this database
Dim viewDirectory As NotesView	     'View object in the Domino Directory to look up 
the person document
Dim personDoc As NotesDocument     'Person document related to the User 
Name password to be changed
Dim userName As String     'User Name of the end user to be processed
Dim dirName As String     'Domino Directory file name (normally names.nsf)
Dim vwName As String     'View name used in the Domino Directory to 
look up the person document
Dim password As String     'New random password to be used on the 
Person document in the HTTPPassword field
Dim docContext As NotesDocument     'Web document used to get the 
QueryString / User Name variable
Dim queryString As String     'Variable from the URL that executes 
this agent containing the user name	
	
'set variables for the agent
Set docContext = session.DocumentContext
If Not(docContext Is Nothing) Then
	queryString = docContext.QUERY_STRING(0)
	agentLog.LogAction("QueryString = " + queryString)
Else
	agentLog.LogAction("There is no docContext for
	QueryString variable. 
	Must execute this agent from a URL with 
	'/PwdMgt.nsf/PwdQuerySave?OpenAgent&QueryString=Abbreviated Name'")
	errStr = "There is no docContext for QueryString variable. Must execute this 
	agent from a URL with 
	'/PwdMgt.nsf/PwdQuerySave?OpenAgent&QueryString=Abbreviated Name'"
	Goto ErrorHandler
End If
	
'get the username to be processed
userName = getUserName(agentLog, queryString)
	
'variables to run code below
dirName = "names.nsf"
vwName = "($VIMPeople)"
	
'create a unqiue password to be reset
password = createUniquePwd(agentLog)
	
'open the directory and the custom pwd change mgt tool
Set dbDirectory = session.GetDatabase("", dirName)
Set db = session.CurrentDatabase
	
If dbDirectory.IsOpen Then
	'set the vew to lookup the person document with
	Call agentLog.LogAction("Opened the directory")
	Set viewDirectory = dbDirectory.GetView(vwName)
		
	If Not(viewDirectory Is Nothing) Then
		Call agentLog.LogAction("Set the Directory View")		
			
		'set the person document in the view
		Call agentLog.LogAction("viewName is " + viewDirectory.Name)
		Set personDoc =  viewDirectory.GetDocumentByKey(userName, True)
			
	If Not(personDoc Is Nothing) Then
		Call agentLog.LogAction("Set the person document")
				
		'set the HTTP Password field to a unique random value
		personDoc.HTTPPassword = password				
				
				
		'set the date time value that the HTTP Password was set
		personDoc.HTTPPasswordChangeDate = Now
				
				
		'save the person document
		Call personDoc.Save(True, False)		
		Call agentLog.LogAction("Saved the persondocument")
				
		'send email using the DisplayName field in the person document
		Dim emailDoc As NotesDocument				
		Dim sendToName As String
		sendToName = personDoc.InternetAddress(0)
		Call agentLog.LogAction("SendTo:  " + sendToName )	
				
		Set emailDoc = New NotesDocument( db )
		Call agentLog.LogAction("Created new email document")
				
		'create the email fields and associated values
		emailDoc.Form = "Memo"
		emailDoc.SendTo = sendToName
		emailDoc.Subject = "URGENT:  HTTP Password Change Request"
		emailDoc.Body = "Your HTTP Password was changed to: " + password
		Call agentLog.LogAction("Set fields on email document")
				
		'route the document to the end user

		Call emailDoc.Send( False )
		Call agentLog.LogAction("Sent the email to " + sendToName)
				
	Else
		'couldn't open the person document
		errStr = "Could not get the person document in the Directory.  Probably 
		need to use the Abbreviated name instead of Common Name."
		Call agentLog.LogAction("Could not get the person document in the 
		Directory.  Probably didn't use the Abbreviated name.")
		Goto ErrorHandler
	End If		
			
Else
	'couldn't open the view in the directory
	errStr = "Could not get the view in the directory"
	Call agentLog.LogAction("Could not get the view in the directory")
	Goto ErrorHandler
End If
		
Else
	'could not open the Domino Directory
	errStr = "Could not open the Domino Directory"
	Call agentLog.LogAction(errStr)
	Goto ErrorHandler
End If
	
' Close out the Agent
Call agentLog.LogAction("Existing Intialize")
Call agentLog.Close
	
'Print out to the browser to notify the end user
Print "Password has been changed for " + UserName + ".  Please check your 
email via a Notes Client for the password."
	
Exit Sub
	
ErrorHandler:
	If errStr = "" Then
		errStr =  "Error in Initialize: " & Err() & ": " & Error()
	End If
	
	Call agentLog.LogAction(errStr)
	Call agentLog.Close
	
	Print "An error occured please check the Agent Log for details.  
	<br><br> Description of what occured is: <br>" + errStr
	
End Sub

Function createUniquePwd(agentLog As NotesLog) As String
	
Call agentLog.LogAction("entering createUniquePwd function")
	
Dim pwdunique As Variant     'contains the new unique password to be created
from the @Unique @function
Dim password As String			'contains the string form of the unique password
Dim i As Integer						'counter
Dim r As String						'used for string parsing
Dim l As String						'used for string parsing
Dim errStr As String				'used for error handling
	
On Error Goto ErrorHandler
	
'create the unique password for the end user
pwdunique = Evaluate("@Unique")
password = pwdunique(0)
Call agentLog.LogAction(password)
	
'parse the password to remove the - character
i = Instr(password, "-")
Call agentLog.LogAction(i)
l = Left(password, i - 1)
r = Right(password, i + 1)
Call agentLog.LogAction("l = " + l )
Call agentLog.LogAction("r = " + r )
	
'return the new unique password back to the main function
createUniquePwd = l + r
	
Call agentLog.LogAction("exiting createUniquePwd function")
	
Exit Function
	
ErrorHandler:
	
	errStr =  "Error in createUniquePwd: " & Err() & ": " & Error()
	Call agentLog.LogAction(errStr)
	
End Function

Function getUserName(agentLog As NotesLog, queryString As String) As String
	
	Dim i As Integer				'used as a counter
	Dim strTemp As String	'used to get the username as a string without %20 
	and replaced with blank spaces
	Dim qStr As Variant		'used with the @ReplaceSubString @function to 
	replace any %20 's in the string with black spaces
	Dim errStr As String		'used for error handling
	
	On Error Goto ErrorHandler
	
	'retrieve just the username from the QueryString
	agentLog.LogAction(queryString + " - in getUserName function")
	i = Instr(queryString, "=")
	agentLog.LogAction("i = " + Str(i))
	queryString = Right(queryString, Len(queryString) - i)
	
	'used for testing the @function so that the agent log
	agentLog.LogAction(queryString + " - In getUserName")
	agentLog.LogAction("@ReplaceSubString(""" + queryString + """, ""%20"", "" "")")
	
	'use the @ReplaceSubString @function to replace the %20 with black spaces
	qStr = Evaluate("@ReplaceSubString(""" + queryString + """; ""%20""; "" "")" )
	strTemp = qStr(0)
	agentLog.LogAction(strTemp + " - after Evaluate")
	
	'assign the name with appropriate blanks as a string
	queryString = strTemp
	
	'return the user name back to the main routine
	getUserName = queryString
	
	agentLog.LogAction("exiting getUserName function")
	
	Exit Function
	
ErrorHandler:
	
	errStr =  "Error in getUserName: " & Err() & ": " & Error()
	Call agentLog.LogAction(errStr)
	
End Function

Sub deleteLockoutRecord(session As NotesSession, agentLog As NotesLog, 
UserName As String)
%REM
This subroutine was included as a sample if someone wanted to delete the Locked Out 
records.  Just add this routine to the main 
Initialize of this agent and pass in the appropriate parameters	
%END REM
	
	Dim db As NotesDatabase     'dabase object for the Internet Locked Out database
	Dim view As NotesView     'view object to loop through the document in the 
	Locked Out database
	Dim doc As NotesDocument     'document object for each document while looping 
	through the document of the view
	Dim tmpdoc As NotesDocument     'temporary document set if there is a match so
	it can be deleted after the next document has been retrieved
	Dim item As NotesItem     'object for the ILUserName field on the document 
	which holds the users' name
	Dim notesname As NotesName     'object to change the name to abbreviated
	Dim abbrevName As String     'string that represents the appreviated user 
	name on the Locked Out document
	Dim deleteDoc As Boolean     'boolean true or false to flag a document to 
	be deleted
	Dim viewName As String     'variable that references the view name in the 
	Locked Out database
	Dim dbFileName As String     'variable that references the file name of the 
	Locked Out database
	Dim fieldName As String     'variable that references the field name 
	in the locked out document
	Dim errStr As String     'used in error handling
	
	On Error Goto ErrorHandler
	
	'set the variables
	dbFileName = "inetlockout.nsf"	
	viewName = "Locked Out Users"
	fieldName = "ILUserName"
	
	'set up the objects to be used in the subroutine
	Set db = session.GetDatabase("", dbFileName)
	agentLog.LogAction("opened the Locked Out database")
	Set view = db.GetView(viewName)
	agentLog.LogAction("opened the view " + viewName)
	Set doc = view.GetFirstDocument
	If doc Is Nothing Then
		agentLog.LogAction("There are no Locked Out documents to be processed")
	Else
		agentLog.LogAction("opened the first document")
	End If
	deleteDoc = False
	
	'loop through the view and delete any documents with the user name passed in
	While Not( doc Is Nothing )
		'get the user name on the Locked Out document
		Set item = doc.GetFirstItem( fieldName )
		'change it to an abbreviated form

		Set notesname = session.CreateName(item.Text)
		abbrevName = notesname.Abbreviated
		agentLog.LogAction("processing for: " + abbrevName)
		
	'check to see if there is a match and if true then save the document and flag 
	that this needs to be deleted
	If Ucase(UserName) = Ucase(abbrevName) Then
		agentLog.LogAction(Ucase(UserName) + " = " + Ucase(abbrevName))
		Set tmpdoc = doc
		deleteDoc = True
		agentLog.LogAction("deteleDoc = " + Str(deleteDoc))
	End If
		
		'get the next document in the view
		Set doc = view.GetNextDocument( doc )
		
		'delete the document from the Locked Out database
		If deleteDoc Then
			Call tmpdoc.Remove(True)
			Set tmpdoc = Nothing
			deleteDoc = False
		End If
		
	Wend
	
	Exit Sub
	
ErrorHandler:
	
	errStr =  "Error in deleteLockedOutRecord: " & Err() & ": " & Error()
	Call agentLog.LogAction(errStr)
	
End Sub