Create Domino One Touch Setup JSON via Lotus Script

create_domino_ots_json.lss

' Helper routines to create a Domino OTS JSON file
' Example code to add to your own applications
' Not intended as to be a complete solution.
'
' Copyright Nash!Com, Daniel Nashed
'
' Licensed under the Apache License, Version 2.0 (the "License");
' you may not use this file except in compliance with the License.
' You may obtain a copy of the License at
'
' http://www.apache.org/licenses/LICENSE-2.0
'
' Unless required by applicable law or agreed to in writing, software
' distributed under the License is distributed on an "AS IS" BASIS,
' WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
' See the License for the specific language governing permissions and
' limitations under the License.

Option Declare

Sub GenerateServerSetup

    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim result As String

    Set db = session.CurrentDatabase

    result = WriteOTSFile (db, "@All", True, True, "d:/ots.json")

    If (result <> "") then
        MessageBox result
    Else
        MessageBox "Done"
    End If

End Sub


Function WriteServerSetup (obj As NotesJSONNavigator) As String

    Dim ret As Variant
    Dim item As NotesItem
    Dim serverSetupObj As NotesJSONObject
    Dim serverObj As NotesJSONObject
    Dim networkObj As NotesJSONObject
    Dim orgObj As NotesJSONObject
    Dim adminObj As NotesJSONObject
    Dim notesINIObj As NotesJSONObject
    Dim securityObj As NotesJSONObject
    Dim TLSSetupObj As NotesJSONObject
    Dim ACLObj As NotesJSONObject

    WriteServerSetup = ""

    Set serverSetupObj = obj.Appendobject ("serverSetup")

    Set serverObj = serverSetupObj.Appendobject ("server")
    Call serverObj.AppendElement ("first", "type")
    Call serverObj.AppendElement ("{{ SERVERSETUP_SERVER_NAME }}", "name")
    Call serverObj.AppendElement ("{{ SERVERSETUP_SERVER_DOMAINNAME }}", "domainName")
    Call serverObj.AppendElement ("{{ SERVERSETUP_SERVER_TITLE }}", "title")

    Set networkObj = serverSetupObj.Appendobject  ("network")
    Call networkObj.AppendElement ("{{ SERVERSETUP_NETWORK_HOSTNAME }}", "hostName")
    Call networkObj.AppendElement (True, "enablePortEncryption")
    Call networkObj.AppendElement (True, "enablePortCompression")

    Set orgObj = serverSetupObj.Appendobject ("org")
    Call orgObj.AppendElement ("{{ SERVERSETUP_ORG_ORGNAME }}", "orgName")
    Call orgObj.AppendElement ("{{ SERVERSETUP_ORG_CERTIFIERPASSWORD }}", "certifierPassword")

    ' Call orgObj.AppendElement (True, "useExistingCertifierID")
    ' Call orgObj.AppendElement ("/local/notesdata/cert.id", "certifierIDFilePath")

    Set adminObj = serverSetupObj.Appendobject ("admin")
    Call adminObj.AppendElement ("{{ SERVERSETUP_ADMIN_FIRSTNAME }}", "firstName")
    Call adminObj.AppendElement ("{{ SERVERSETUP_ADMIN_LASTNAME }}", "lastName")
    Call adminObj.AppendElement ("{{ SERVERSETUP_ADMIN_PASSWORD }}", "password")
    Call adminObj.AppendElement ("{{ SERVERSETUP_ADMIN_IDFILEPATH }}", "IDFilePath")

    Set notesINIObj = serverSetupObj.Appendobject ("notesINI")
    Call notesINIObj.AppendElement ("41943040", "EVENT_POOL_SIZE")

    Set securityObj = serverSetupObj.Appendobject ("security")

    Set ACLObj = securityObj.Appendobject ("ACL")
    Call ACLObj.AppendElement (true, "prohibitAnonymousAccess")
    Call ACLObj.AppendElement (True, "addLocalDomainAdmins")

    Set TLSSetupObj = securityObj.Appendobject  ("TLSSetup")
    Call TLSSetupObj.AppendElement ("dominoMicroCA", "method")

End Function


Function WriteOTSFile (db As NotesDatabase, FormulaTxt As String, bComputeWithForm As Boolean, bExtendedItems As Boolean, FileName As String) As String

    Dim session As New NotesSession
    Dim nc As NotesNoteCollection
    Dim nid As String
    Dim doc As NotesDocument
    Dim count As Integer
    Dim PublishDateTime As New NotesDateTime ("")

    Dim stream As NotesStream
    Dim pathname As String

    Dim JSON_Nav As NotesJSONNavigator
    Dim appConfigurationObj As NotesJSONObject
    Dim databasesArray As NotesJSONArray
    Dim databaseObj As NotesJSONObject
    Dim documentsArray As NotesJSONArray

    On Error GoTo error_handler

    WriteOTSFile = ""

    If ("" = FileName) Then
        Exit Function
    End If

    Call PublishDateTime.Setnow()

    Set nc = db.CreateNoteCollection (False)

    nc.Selectdocuments = True
    nc.Selectionformula = FormulaTxt
    Call nc.BuildCollection

    Set JSON_Nav = session.CreateJSONNavigator ("")

    Call WriteServerSetup (JSON_Nav)

    Set appConfigurationObj = JSON_Nav.Appendobject ("appConfiguration")
    Set databasesArray = appConfigurationObj.appendarray ("databases")
    Set databaseObj = databasesArray.Appendobject

    Call databaseObj.AppendElement ("names.nsf", "filePath")
    Call databaseObj.AppendElement ("update", "action")

    Set documentsArray = databaseObj.appendarray ("documents")

    nid = nc.GetFirstNoteId

    While ("" <> nid)

        Set doc = db.GetDocumentByID (nid)
        WriteOTSFile = WriteDocObject (documentsArray, doc, bComputeWithForm, bExtendedItems)
        If ("" <> WriteOTSFile) Then
            Exit Function
        End If
        nid = nc.Getnextnoteid (nid)
    Wend

    Set stream = session.CreateStream

    If Not stream.Open (FileName, "UTF-8") Then
        WriteOTSFile = "Cannot open output file " + FileName
        Exit Function
    End If

    If (stream.Bytes <> 0) Then
        Call stream.Truncate
    End If

    Call stream.WriteText (JSON_Nav.Stringify)
    Call stream.Close

    Exit Function

error_handler:

    WriteOTSFile = Error()

    Exit Function

End Function


Sub WriteExtendedJSONValue (DocObj As NotesJSONObject, item As NotesItem)

    Dim elements As Integer
    Dim ItemArr As NotesJSONArray
    Dim ItemObj As NotesJSONObject

    Set ItemObj = DocObj.Appendobject (item.name)

    If (768 = item.Type) Then
        Call ItemObj.AppendElement ("number", "type")
    Else
        Call ItemObj.AppendElement ("text", "type")
    End If

    elements = UBound (item.Values)

    If (elements > 0) Then

        Set ItemArr = DocObj.appendarray ("value")

        ForAll x In item.Values
            Call ItemArr.AppendElement (x)
        End ForAll

    Else
        Call ItemObj.AppendElement (item.Values(0), "value")
    End If

    If (item.Isnames) Then
        Call ItemObj.AppendElement ("true", "names")
    End If

    If (item.Isreaders) Then
        Call ItemObj.AppendElement ("true", "readers")
    End If

    If (item.Isauthors) Then
        Call ItemObj.AppendElement ("true", "authors")
    End If

    If (item.Isprotected) Then
        Call ItemObj.AppendElement ("true", "protected")
    End If

    If (item.Issigned) Then
        Call ItemObj.AppendElement ("true", "sign")
    End If

    If (item.Isencrypted) Then
        Call ItemObj.AppendElement ("true", "encrypt")
    End If

    If (Not Item.Issummary) Then
        Call ItemObj.AppendElement ("true", "nonSummary")
    End If

End Sub


Function WriteDocObject (documentsArray As NotesJSONArray, doc As NotesDocument, bComputeWithForm As Boolean, bExtendedItems As Boolean) As String

    Dim ret As Variant
    Dim item As NotesItem
    Dim DocObj As NotesJSONObject
    Dim ItemsObj As NotesJSONObject

    WriteDocObject = ""

    Set DocObj = documentsArray.Appendobject

    Call DocObj.AppendElement ("create", "action")

    If (bComputeWithForm) Then
        Call DocObj.AppendElement (True, "computeWithForm")
    End If

    Set ItemsObj = DocObj.Appendobject ("items")

    ForAll x In doc.Items
        Set item = x
        Call AppendJSONValue (ItemsObj, item, bExtendedItems)
    End ForAll

End Function


Sub AppendJSONValue (DocObj As NotesJSONObject, item As NotesItem, bExtendedItems As Boolean)

    Dim elements As Integer
    Dim ItemArr As NotesJSONArray

    If (item Is Nothing) Then
        Exit Sub
    End If

    If (ExcludedItemName (item.name)) Then
        Exit Sub
    End If

    If (1024 = item.Type) Then
        Call AppendJSONDateTime (DocObj, item)
        Exit Sub
    End If

    ' Skip attachments
    If (1084 = item.Type) Then
        Exit Sub
    End If

    ' Richtext
    If (1 = item.Type) Then
        Call DocObj.AppendElement (item.Text, item.Name)
        Exit Sub
    End If

    If (bExtendedItems) Then
        If (item.Isnames Or item.Isreaders Or item.Isauthors Or item.Isprotected Or item.Isencrypted Or item.Issigned Or (False = Item.Issummary) ) Then
            Call  WriteExtendedJSONValue (DocObj, item)
            Exit Sub
        End If
    End If

    ' Text, Number, Names, Readers, Authors
    If ( (1280 = item.Type) Or (768 = item.Type) Or (1074 = item.Type) Or (1075 = item.Type) Or (1076 = item.Type)) Then

        elements = UBound (item.Values)

        If (elements > 0) Then

            Set ItemArr = DocObj.appendarray (item.Name)

            ForAll x In item.Values
                Call ItemArr.AppendElement (x)
            End ForAll

        Else
            Call DocObj.AppendElement (item.Values(0), item.Name)
        End If

        Exit Sub
    End If

    ' RFC822Text
    If (1282 = item.Type) Then
        Call DocObj.AppendElement (item.Text, item.Name)
        Exit Sub
    End If

    ' OID
    If (4 = item.Type) Then
        Call DocObj.AppendElement (item.Text, item.Name)
        Exit Sub
    End If

    ' Try to add any other type as text
    Call DocObj.AppendElement (item.Text, item.Name+ "-" + CStr (item.Type))
    Exit Sub

End Sub


Sub AppendJSONDateTime (Obj As NotesJSONObject, item As NotesItem)

    Dim DateString As String
    Dim dateTime As NotesDateTime

    Set dateTime = item.DateTimeValue

    If (dateTime Is Nothing) Then
        Call obj.AppendElement ("", item.name)
        Exit Sub
    End If

    DateString = Format$ (dateTime.LSGMTTime, "YYYYMMDDTHHNNSS")

    Call obj.AppendElement (DateString, item.name)

End Sub


Function ExcludedItemName (ItemName As String) As Boolean

    ExcludedItemName = True

    If ("$UpdatedBy" = ItemName) Then
        Exit Function
    End If

    ExcludedItemName = False

End Function