Programmatic access to IDVAULT ( incl. new V10 methods )

Language

LotusScript

Tags

Author

Ulrich Krause

Submitted on

September 7, 2018 at 1:10 AM

Rating

Downloads

174

Notes

The code allows programmatic access to the IDVAULT. It uses the NotesIdVault class ( new with 901 FP9 ) and also extends the class to extract an ID from the vault without knowing its password.
The code also includes new features that come with V10 to archive, revert archived Ids and to delete Ids that have been archived to reinforce sync.

SAMPLE USAGE:

This sample shows how to extract an ID from the vault document. It will apply a new password to the ID but leaves the ID in the document untouched.

Option Declare
Use "IDVault"

Sub Initialize
Dim idv_db As NotesIdVaultDb
Dim bck_db As NotesIdVaultDb
Dim vaultServer As String
Dim vaultDb As String
Dim vaultDb_backup As String

vaultServer = "develop1/gotham"
vaultDb = "IBM_ID_VAULT\batcave.nsf"
vaultDb_backup = "IBM_ID_VAULT\batcave_bck.nsf"

Dim idv_doc As NotesIdVaultDocument

Set idv_db = New NotesIdVaultDb(vaultServer, vaultDb)

If ( idv_db.IsConnected() ) then
Set idv_doc = New NotesIdVaultDocument(idv_db.db,nothing)
Set bck_db = New NotesIdVaultDb(vaultServer, vaultDb_backup)

If ( bck_db.IsConnected() ) Then
Set idv_doc = New NotesIdVaultDocument(idv_db.db, bck_db.db)
Else
Set idv_doc = New NotesIdVaultDocument(idv_db.db, Nothing)
End If

idv_doc.ServerName = vaultServer
idv_doc.UserName = "cn=Harvey Dent/o=gotham"
idv_doc.Password = "hdent003"
idv_doc.IdFilePathName = "C:\Notes\Data\ids\people\backup\hdent_with_new_pwd.id"
'Call idv_doc.ResetPassword()
'Call idv_doc.archiveIDFile()
'Call idv_doc.revertArchivedIDFile()
'Call idv_doc.deleteArchivedIDFile()
'Call idv_doc.IdFileGet()
'Call idv_doc.IdFileSync()
'Call idv_doc.IdFilePut()

Call idv_doc.IdFileExtract()
'Call idv_doc.markInactive()
'Call idv_doc.markActive()
MsgBox idv_doc.LastErrorString

End if

End Sub

Option Declare


Private Const ERR_OPEN_IDV_DB = 3000
Private Const ERR_OPEN_BCK_DB = 3001
Private Const ERR_MISSING_SERVER_NAME = 3002
Private Const ERR_MISSING_USER_NAME = 3003
Private Const ERR_MISSING_FILE_NAME = 3004
Private Const ERR_MISSING_PWD = 3005
Private Const ERR_DOC_MARKED_INACTIVE = 3006
Private Const ERR_DOC_MARKED_ACTIVE = 3007
Private Const ERR_DOC_DELETE_ARCHIVED = 3008
Private Const ERR_DOC_REVERT_ARCHIVED = 3009
Private Const ERR_DOC_ARCHIVE = 3010

Private Const ERR_OPEN_IDV_DB_MSG = "Unable to open IDVault database "
Private Const ERR_OPEN_BCK_DB_MSG = "Unable to open backup database"
Private Const ERR_MISSING_SERVER_NAME_MSG = "ServerName must not be empty"
Private Const ERR_MISSING_USER_NAME_MSG = "UserName must not be empty"
Private Const ERR_MISSING_FILE_NAME_MSG = "IdFilePathName must not be empty"
Private Const ERR_MISSING_PWD_MSG = "Password must not be empty"
Private Const ERR_DOC_MARKED_INACTIVE_MSG = "Document is already marked inactive"
Private Const ERR_DOC_MARKED_ACTIVE_MSG = "Document is already marked active"
Private Const ERR_DOC_NOT_ARCHIVED_MSG = "No archived document found"
Private Const ERR_DOC_NOT_FOUND_OR_ARCHIVED_MSG = "Document not found or already archived"

Private Const OPERATION_CANCELLED_MSG = ". Operation cancelled" 

Private Const NO_ERROR = "no error"
Private Const TILDE = "~"

Private Const ITEM_INACTIVE_ID = "inactiveid"
Private Const ITEM_INACTIVE_ID_TIME = "inactiveidtime"
Private Const ITEM_PWD_MOD_TIME = "IDPWModTime"
Private Const ITEM_ID_OWNER = "IdOwner"

Private Const IDV_VIEW = "($IDFile)"


Public Class NotesIdVaultDocument
	Private ret As Integer
	
	Private m_session As NotesSession

	Private m_vault_db As NotesDatabase
	Private m_vault_view As NotesView
	Private m_vault_doc As NotesDocument
	
	Private m_backup_db As NotesDatabase
	Private m_backup_view As NotesView
	Private m_backup_doc As NotesDocument
	
	Private m_IdFilePathName As String
	Private m_hKFC As Long
	Private m_hId As long
	Private m_ServerName As NotesName
	Private m_UserName As NotesName
	Private m_Password As String
	Private m_LastError As Integer
	Private m_LastErrorString As String
	Private m_notes_idvault As NOTESIDVAULT

	Public Sub New (vault_db As NotesDatabase, backup_db As NotesDatabase)
		Set me.m_session = New NotesSession
		
		Call me.init()
		
		Set me.m_vault_db = vault_db
		Set me.m_backup_db = backup_db
		
		If (Not me.m_vault_db is Nothing) Then
			Set me.m_vault_view = me.m_vault_db.Getview(IDV_VIEW)
			Set me.m_notes_idvault = me.m_session.Getidvault(me.m_vault_db.Server)
		End If
		
		If (Not me.m_backup_db Is Nothing) Then
			Set me.m_backup_view = me.m_backup_db.Getview(IDV_VIEW)
		End If		
		
	End Sub

	Private Sub init()
		Set me.m_serverName = New NotesName("")
		Set me.m_UserName = New NotesName("")
		me.m_Password = ""
		me.m_IdFilePathName = ""	
	End Sub

	Public Sub getDocumentByKey(key As String)
		Set me.m_vault_doc = me.m_vault_view.Getdocumentbykey(key, true)
	End Sub

	Public Sub getBackupDocumentByKey(key As String)
		Set me.m_backup_doc = me.m_backup_view.Getdocumentbykey(key, True)
	End Sub

	Public Property Get doc As NotesDocument
		Set doc = me.m_vault_doc
	End Property

	Public Sub IdFilePut
		Call me.resetError()
		
		On Error GoTo catch		
try:
		If me.m_ServerName.common = "" Then
			Error ERR_MISSING_SERVER_NAME, _
			ERR_MISSING_SERVER_NAME_MSG + OPERATION_CANCELLED_MSG
		End If
		
		If me.m_UserName.common = "" Then
			Error ERR_MISSING_USER_NAME,_
			ERR_MISSING_USER_NAME_MSG + OPERATION_CANCELLED_MSG
		End If	
		
		If Me.m_IdFilePathName = "" Then
			Error ERR_MISSING_FILE_NAME,_
			ERR_MISSING_FILE_NAME_MSG + OPERATION_CANCELLED_MSG
		End If		

		If Me.m_Password = "" Then
			Error ERR_MISSING_PWD,_
			ERR_MISSING_PWD_MSG + OPERATION_CANCELLED_MSG
		End If	
		
		Call m_notes_idvault.Putuseridfile(me.m_IdFilePathName, me.m_UserName.Canonical, me.m_Password, me.m_ServerName.Canonical)
		
		Call me.m_vault_view.Refresh()

finally:
		
		Exit sub
catch:		
		me.m_LastError = Err
		me.m_LastErrorString = Error$
		Resume finally
		
	End Sub

	Public Sub IdFileSync
		
		Call me.resetError()
		
		On Error GoTo catch
try:
		If me.m_ServerName.common = "" Then
			Error ERR_MISSING_SERVER_NAME, _
			ERR_MISSING_SERVER_NAME_MSG + OPERATION_CANCELLED_MSG
		End If
		
		If me.m_UserName.common = "" Then
			Error ERR_MISSING_USER_NAME,_
			ERR_MISSING_USER_NAME_MSG + OPERATION_CANCELLED_MSG
		End If	
		
		If Me.m_IdFilePathName = "" Then
			Error ERR_MISSING_FILE_NAME,_
			ERR_MISSING_FILE_NAME_MSG + OPERATION_CANCELLED_MSG
		End If		

		If Me.m_Password = "" Then
			Error ERR_MISSING_PWD,_
			ERR_MISSING_PWD_MSG + OPERATION_CANCELLED_MSG
		End If	

		Call m_notes_idvault.Syncuseridfile(me.m_IdFilePathName, me.m_UserName.Canonical, me.m_Password, me.m_ServerName.Canonical)

finally:
		
		Exit Sub		
catch:
		me.m_LastError = Err
		me.m_LastErrorString = Error$
		Resume finally			
	End Sub

	Public Sub IdFileGet
		
		Call me.resetError()
		
		On Error goto catch
try:
		If me.m_ServerName.common = "" Then
			Error ERR_MISSING_SERVER_NAME, _
			ERR_MISSING_SERVER_NAME_MSG + OPERATION_CANCELLED_MSG
		End If
		
		If me.m_UserName.common = "" Then
			Error ERR_MISSING_USER_NAME,_
			ERR_MISSING_USER_NAME_MSG + OPERATION_CANCELLED_MSG
		End If	
			
		If Me.m_IdFilePathName = "" Then
			Error ERR_MISSING_FILE_NAME,_
			ERR_MISSING_FILE_NAME_MSG + OPERATION_CANCELLED_MSG
		End If		

		If Me.m_Password = "" Then
			Error ERR_MISSING_PWD,_
			ERR_MISSING_PWD_MSG + OPERATION_CANCELLED_MSG
		End If	

		call m_notes_idvault.Getuseridfile(me.m_IdFilePathName, me.m_UserName.Canonical, me.m_Password, me.m_ServerName.Canonical)

finally:
		
		Exit sub		
catch:
		me.m_LastError = Err
		me.m_LastErrorString = Error$
		Resume finally			
	End Sub

	Public Sub IdFileExtract

		Call me.resetError()
		
		On Error GoTo catch
		
		If (me.m_backup_db Is Nothing) Then
			Error ERR_OPEN_BCK_DB, ERR_OPEN_BCK_DB_MSG
		End If
		
		Call me.backupDocument()
		Call me.ResetPassword()
		Call me.IdFileGet()
		Call me.restoreDocument()
		Call me.m_vault_view.Refresh()
		Call me.m_backup_view.Refresh()
		
finally: 
		Exit Sub
		
catch:
		me.m_LastError = err
		me.m_LastErrorString = Error$
		Resume finally				
	End Sub

	Public Sub ResetPassword
		
		Call me.resetError()
		On Error GoTo catch
try:
		If me.m_ServerName.common = "" Then
			Error ERR_MISSING_SERVER_NAME, _
			ERR_MISSING_SERVER_NAME_MSG + OPERATION_CANCELLED_MSG
		End If
		
		If me.m_UserName.common = "" Then
			Error ERR_MISSING_USER_NAME,_
			ERR_MISSING_USER_NAME_MSG + OPERATION_CANCELLED_MSG
		End If	

		If Me.m_Password = "" Then
			Error ERR_MISSING_PWD,_
			ERR_MISSING_PWD_MSG + OPERATION_CANCELLED_MSG
		End If	

		Call m_notes_idvault.Resetuserpassword(me.m_UserName.Canonical, me.m_Password, me.m_ServerName.Canonical, 1)
		
		If (me.m_vault_doc Is Nothing) Then
			Call me.getDocumentByKey(me.UserName)
			
			Dim dt As New NotesDateTime( "" )
			Call dt.SetNow
			Call me.m_vault_doc.Replaceitemvalue(ITEM_PWD_MOD_TIME, dt)
			Call me.m_vault_doc.save(True, False)
		End If
finally:
		
		Exit Sub		
catch:
		me.m_LastError = Err
		me.m_LastErrorString = Error$
		Resume finally	
	End Sub
	
	Public Sub archiveIDFile
		Call me.resetError()
		On Error GoTo catch
		If (me.m_vault_doc Is Nothing) Then
			Call me.getDocumentByKey(me.UserName)
			If Not (me.m_vault_doc Is Nothing) Then
				Dim idOwner As String
				idOwner = TILDE + me.m_vault_doc.IdOwner(0)
				me.m_vault_doc.idOwner = idOwner
				Call me.m_vault_doc.Save(True, False)
				Call me.m_vault_view.Refresh()
			Else 
				Error ERR_DOC_ARCHIVE,_
				ERR_DOC_NOT_FOUND_OR_ARCHIVED_MSG + OPERATION_CANCELLED_MSG
			End If
		End If
		

		
finally:
		
		Exit Sub		
catch:
		me.m_LastError = Err
		me.m_LastErrorString = Error$
		Resume finally			
	End Sub
	
	
	Public Sub revertArchivedIDFile
		Call me.resetError()
		
		On Error GoTo catch
		If (me.m_vault_doc Is Nothing) Then
			Call me.getDocumentByKey(TILDE + me.UserName)
			If Not (me.m_vault_doc Is Nothing) Then
				Dim idOwner As String
				idOwner = Replace( me.m_vault_doc.IdOwner(0),TILDE,"")
				
				me.m_vault_doc.idOwner = idOwner
				Call me.m_vault_doc.Save(True, False)
				Call me.m_vault_view.Refresh()
			Else 
				Error ERR_DOC_REVERT_ARCHIVED,_
				ERR_DOC_NOT_ARCHIVED_MSG + OPERATION_CANCELLED_MSG
			End If
		End If


		
finally:
		
		Exit Sub		
catch:
		me.m_LastError = Err
		me.m_LastErrorString = Error$
		Resume finally			
	End Sub

	Public Sub deleteArchivedIDFile
		Call me.resetError()
		
		On Error GoTo catch
		If (me.m_vault_doc Is Nothing) Then
			Call me.getDocumentByKey(TILDE + me.UserName)
			If Not (me.m_vault_doc Is Nothing) then
				me.m_vault_doc.Remove(true)
			Else 
				Error ERR_DOC_DELETE_ARCHIVED,_
				ERR_DOC_NOT_ARCHIVED_MSG + OPERATION_CANCELLED_MSG
			End if
		End If

		Call me.m_vault_view.Refresh()
		
finally:
		
		Exit Sub		
catch:
		me.m_LastError = Err
		me.m_LastErrorString = Error$
		Resume finally			
	End Sub

	Public Sub markActive
		Call me.resetError()
		On Error GoTo catch
		If (me.m_vault_doc Is Nothing) Then
			Call me.getDocumentByKey(me.UserName)
		End If
		If (not me.m_vault_doc.hasItem(ITEM_INACTIVE_ID) ) Then
				Error ERR_DOC_MARKED_ACTIVE,_
				ERR_DOC_MARKED_ACTIVE_MSG + OPERATION_CANCELLED_MSG
		End If
		Call me.m_vault_doc.Removeitem(ITEM_INACTIVE_ID)
		Call me.m_vault_doc.Removeitem(ITEM_INACTIVE_ID_TIME)
		Call me.m_vault_doc.Save(True, False)
		Call me.m_vault_view.Refresh()
		
finally:
		
		Exit Sub		
catch:
		me.m_LastError = Err
		me.m_LastErrorString = Error$
		Resume finally			
	End Sub

	Public Sub markInactive
		Call me.resetError()
		On Error GoTo catch
		If (me.m_vault_doc Is Nothing) Then
			Call me.getDocumentByKey(me.UserName)
		End If
		If ( me.m_vault_doc.hasItem(ITEM_INACTIVE_ID) ) Then
			If (me.m_vault_doc.getFirstItem(ITEM_INACTIVE_ID).Text = "1" ) Then
				Error ERR_DOC_MARKED_INACTIVE,_
				ERR_DOC_MARKED_INACTIVE_MSG + OPERATION_CANCELLED_MSG
			End If
		End If
		
		Call me.m_vault_doc.ReplaceItemValue(ITEM_INACTIVE_ID,"1")
		Call me.m_vault_doc.ReplaceItemValue(ITEM_INACTIVE_ID_TIME,CStr(Now))
		Call me.m_vault_doc.Save(True, False)
		Call me.m_vault_view.Refresh()
		
finally:
		
		Exit Sub		
catch:
		me.m_LastError = Err
		me.m_LastErrorString = Error$
		Resume finally			
	End Sub

	Public Sub deleteDocument
		Call me.m_vault_doc.remove(True)
	End Sub

	Public property Set backupDb As NotesDatabase
		Set me.m_backup_db = backupDb
	End Property

	private Sub backupDocument()
		If (me.m_vault_doc Is Nothing) Then
			Call me.getDocumentByKey(me.UserName)
		End If
		Call me.m_vault_doc.CopyToDatabase(me.m_backup_db)
	End Sub

	private Sub restoreDocument()
		Call me.getBackupDocumentByKey(me.UserName)
		Call me.m_backup_doc.CopyToDatabase(me.m_vault_db)
		me.m_vault_doc.Remove(True)
		me.m_backup_doc.Remove(True)
	End Sub

	Public Property Set ServerName As String
		Set me.m_ServerName = New NotesName(ServerName)
	End Property

	Public Property Set Password As String
		me.m_Password  = Password
	End Property

	Public Property Set UserName As String
		Set me.m_UserName = New NotesName(UserName)
	End Property

	Public Property Get UserName As String
		UserName = me.m_UserName.Canonical
	End Property

	Public Property Set IdFilePathName As String
		me.m_IdFilePathName = IdFilePathName
	End Property

	Public Property Get LastError As Integer
		LastError = m_LastError
	End Property

	Public Property Get LastErrorString As String
		LastErrorString = m_LastErrorString
	End Property	

	Private Sub resetError
		me.m_LastError = 0
		me.m_LastErrorString = NO_ERROR
	End Sub	
End Class
Public Class NotesIdVaultDb
	Private m_session As NotesSession
	Private m_ServerName As String
	Private m_DbName As String
	Private m_isConnected As Boolean
	Private m_IdVaultDb As NotesDatabase
	Private m_LastError As Integer
	Private m_LastErrorString As String

	Public Sub New (ServerName As String, DbName As String)

		Call me.resetError()
		Set me.m_session = New NotesSession
		me.m_ServerName = ServerName
		me.m_DbName = DbName
		If me.m_ServerName <> "" Then
			If me.m_DbName <> "" Then
				Call me.connect()
			End If
		End If
		
	End Sub
	

	Public Sub connect
		
		Call me.resetError()
		
		On Error GoTo catch

		me.m_isConnected = false
		
		Set me.m_IdVaultDb = me.m_session.GetDatabase(me.m_ServerName,me.m_DbName)
		If (me.m_IdVaultDb.IsOpen) Then
			me.m_isConnected = True
		Else
			Error ERR_OPEN_IDV_DB, ERR_OPEN_IDV_DB_MSG
		End If
		
finally:
		Exit Sub
		
catch:
		me.m_LastError = Err
		me.m_LastErrorString = Error$
				
		me.m_isConnected = False
		Resume finally
		
	End Sub

	Public Property Set Servername As String
		m_ServerName = ServerName
	End Property

	Public Property Set DbName As String
		m_DbName = DbName
	End Property

	Public Property Get IsConnected As Boolean
		IsConnected = me.m_isConnected
	End Property

	Public Property Get db As NotesDatabase
		Set db = me.m_IdVaultDb
	End Property

	Public Property Get LastError As Integer
		LastError = m_LastError
	End Property

	Public Property Get LastErrorString As String
		LastErrorString = m_LastErrorString
	End Property	

	Private Sub resetError
		me.m_LastError = 0
		me.m_LastErrorString = "No Error"
	End Sub
End Class
Sub Terminate
	
End Sub

All code submitted to OpenNTF XSnippets, whether submitted as a "Snippet" or in the body of a Comment, is provided under the Apache License Version 2.0. See Terms of Use for full details.

No comments yetLogin first to comment...