/* REXX */
/*                                                                  */
/*    EXEC NAME = DRQCERTL                                          */
/*                                                                  */
/*    DESCRIPTIVE NAME = Generate certificate list                  */
/*                                                                  */
/*    PROPRIETARY STATEMENT =                                       */
/*                                                                  */
/*      Licensed Materials - Property of IBM                        */
/*                                                                  */
/*      5698-AMZ                                                    */
/*      (C) Copyright IBM Corp. 2002.                               */
/*      All Rights Reserved.                                        */
/*                                                                  */
/*      STATUS = HDMQ110                                            */
/*                                                                  */
/*    FUNCTION: Generates a certificate list which is used to       */
/*              prime the Tivoli Access Manager for Business        */
/*              Integration Host Edition Configurastion Wizard      */
/*                                                                  */
/*    DEPENDENCIES: None                                            */
/*                                                                  */
/*    COMMAND SYNTAX =                                              */
/*                                                                  */
/*      drqcertl dsnqual ( DEBUG debug TRACE traceopt               */
/*                                                                  */
/*                                                                  */
/*      Examples:                                                   */
/*                                                                  */
/*        1. Create certificate list using default output file      */
/*           of userid.DRQCERTL.XML:                                */
/*                                                                  */
/*             drqcertl                                             */
/*                                                                  */
/*                                                                  */
/*        2. Create certificate list changing output file name      */
/*           to userid.MYCERT.XML:                                  */
/*                                                                  */
/*             drqcertl mycert                                      */
/*                                                                  */
/*        3. Create certificate list in debug mode for problem      */
/*           diagnosis:                                             */
/*                                                                  */
/*             drqcertl ( DEBUG 1                                   */
/*                                                                  */
/*        3. Create certificate list in trace mode for problem      */
/*           diagnosis:                                             */
/*                                                                  */
/*             drqcertl ( TRACE r                                   */
/*                                                                  */
/*                                                                  */
/*    INPUT =                                                       */
/*                                                                  */
/*      dsnqual - Names the middle qualifier for data sets          */
/*                created by the exec.                              */
/*                                                                  */
/*                Default: drqcertl                                 */
/*                                                                  */
/*                                                                  */
/*      debug    - Names a debug level in the range 0-9.            */
/*                                                                  */
/*                 Default: 0 (debug off)                           */
/*                                                                  */
/*      traceopt - Names a trace level valid for the trace          */
/*                 statement                                        */
/*                                                                  */
/*                 Default: o (trace off)                           */
/*                                                                  */
/*    OUTPUT =                                                      */
/*                                                                  */
/*      This exec will create an xml file containing the            */
/*      certificate list.  The default data set name is             */
/*      userid.DRQCERTL.XML, where the middle qualifier can         */
/*      be changed using the dsnqual argument to the exec.          */
/*                                                                  */
/*      This file must be transferred to the workstation for        */
/*      use by the configuration wizard.                            */
/*                                                                  */
/*      Follow the instructions in the wizard for transferring      */
/*      the file and making it available to the wizard.             */
/*                                                                  */
/*                                                                  */
/*    INTERDEPENDENCIES = None                                      */
/*                                                                  */
/*    CHANGES =                                                     */
/*                                                                  */
/*      $L0=WIZARD,HDMQ110,020531,KDKJ: Configuration wizard     1.5*/
/*                                                                  */
/********************************************************************/
Arg dsnqual "(" .
Arg . "(" . "DEBUG" debug
Arg . "(" . "TRACE" traceopt

if traceopt = "" then
  trace o
else
  interpret 'trace' traceopt

Parse source opsys invoke_type exec_name .

if exec_name = "?" then
  exec_name = "DRQCERTL"
else nop

if dsnqual = "" then ,   /* If data set name not specified */
  dsnqual = exec_name
else nop

DEBUG_OFF = 0
DEBUG_MIN = 1
DEBUG_MAX = 9

if datatype(debug) = "NUM" & ,   /* If numeric */
   debug >= DEBUG_OFF & ,
   debug <= DEBUG_MAX then
  do
    debug = space(debug)
    Say mid(18) "Debug level set to" debug"."
  end
else
  debug = DEBUG_OFF    /* debug levels: 0=off 9=max */

SUCCESS = 0
ERROR = 8
SEVERE = 12

VERS = "1.5"    /* Exec version */

line. = ""      /* Output from racdcert command */

xml. = ""    /* Generated xml output */
xml.0 = 0    /* Number of generated xml statements */

userlist. = ""      /* List of user cert ids */
userlist.0 = 0

certCount = 0       /* Number of generated certs */
authCertCount = 0   /* Number of certauths */
siteCertCount = 0   /* Number of site certs */
userCertCount = 0   /* Number of user certs */

indent = 0         /* XML nest level */
firstControlTag = 0     /* First control tag line number */

xmlStarted = 0            /* 1=initial xml tags generated */
certStarted = 0           /* 1=cert tags started */
serialNumberStarted = 0   /* 1=Serial number title line found */
issuerNameStarted = 0     /* 1=Issuer name title line found */
subjectNameStarted = 0    /* 1=Subject name title line found */
subjectAltNamesStarted = 0    /* 1=Subject altnames title line found */
ringAssociationsStarted = 0  /* 1=Ring associations title found */

ringStarted = 0           /* 1=ring tag started */
ringNameStarted = 0       /* 1=ring name tag started */
associationsStarted = 0   /* 1=associations tag started */

appldataStarted = 0       /* 1=appldata title found */

issuer = ""
subject = ""
serial = ""
ringname = ""

certtype = ""             /* Type of cert being generated */

retc = SUCCESS

Say mid(1) "Processing started (version" VERS") ..."

     /*********************************/
     /* Delete any prior output files */
     /*********************************/
call deleteFiles

     /************************************************/
     /* Get a list of all certauths and process them */
     /************************************************/
Say mid(3) "Processing certauth certificates ..."
call getCertAuthList
call processCertAuthCerts

     /*************************************************/
     /* Get a list of all site certs and process them */
     /*************************************************/
Say mid(4) "Processing site certificates ..."
call getSiteCertList
call processSiteCerts

     /*************************************************/
     /* Get a list of all user certs and process them */
     /*************************************************/
Say mid(5) "Processing user certificates ..."
call getUserCertList
call processUserCerts

     /*************************/
     /* Write ending xml tags */
     /*************************/
call xmlEnd

     /***************************************/
     /* Prune the xml to only required tags */
     /***************************************/
call pruneXML

     /*********************/
     /* Write xml to file */
     /*********************/
call writeXML

     /****************/
     /* Program exit */
     /****************/
Say mid(2) "Processing complete:"
Say mid(2) "  Total certificates:   " certCount
Say mid(2) "  Certauth certificates:  " authCertCount
Say mid(2) "  Site certificates:      " siteCertCount
Say mid(2) "  User certificates:      " userCertCount

exit retc



 /**
  * getCertAuthList: obtains list of certauth certs
  */
getCertAuthList:

lrc = SUCCESS

x = OUTTRAP("line.")
"racdcert list certauth"
x = OUTTRAP("OFF")

call writeDebugFile "txt1" "noappend"

if line.0 = 0 then
  Say mid(6) "No certauth certificates have been found."
else nop

return lrc


 /**
  * processCertAuthCerts: process certauth certs and generate xml
  */
processCertAuthCerts:
call processCerts

call finalClosePendingActions
return



 /**
  * getSiteCertList: get list of site certs
  */
getSiteCertList:

lrc = SUCCESS

line. = ""
line.0 = 0

x = OUTTRAP("line.")
"racdcert list site"
x = OUTTRAP("OFF")

call writeDebugFile "txt2" "noappend"   /* Write output to file */

if line.0 = 0 then
  Say mid(9) "No site certificates have been found."
else nop

return lrc


 /**
  * processSiteCerts: process site certs and generate xml
  */
processSiteCerts:

lrc = SUCCESS
call processCerts
call finalClosePendingActions

return lrc


 /**
  * getUserCertList: get list of each user that owns certs
  */
getUserCertList:

lrc = SUCCESS

line. = ""
line.0 = 0

x = OUTTRAP("line.")
"rlist digtcert *"
x = OUTTRAP("OFF")

call writeDebugFile "txt3" "noappend"  /* Write output to file */

do ix = 1 to line.0
  select
    when pos("APPLICATION DATA",line.ix) = 1 then
      appldataStarted = 1

    when appldataStarted = 1 & ,
         pos("----------------",line.ix) = 1 then
      nop

    when appldataStarted = 1 then
      do
        call addUser line.ix
        appldataStarted = 0
      end

    otherwise nop
  end
end

if debug = DEBUG_MAX & ,
   userList.0 > 0 then
  do ix = 1 to userList.0
    Say mid(7) "Userlist:" userlist.ix
  end
else
  nop

if userlist.0 = 0 then
  Say mid(8) "No user certificates have been found."
else nop

return lrc


 /**
  * processUserCerts: obtains certs for each user in user list
  *                   and generates xml
  */
processUserCerts:

lrc = SUCCESS

do jx = 1 to userList.0

  line. = ""
  line.0 = 0

  x = OUTTRAP("line.")
  "racdcert id("userList.jx") list"
  x = OUTTRAP("OFF")

  call writeDebugFile "txt4" "append"   /* Write output to file */

  call processCerts
  call closePendingActions

end

call finalClosePendingActions
return lrc



 /**
  * processCerts: common routine to process output of racdcert list
  */
processCerts:

lrc = SUCCESS


do ix = 1 to line.0
  select

    when line.ix = " " then nop

    when pos("Digital certificate information",line.ix) > 0 then
      call xmlStart line.ix

    when pos("Label:",line.ix) = 3 then
      do
        call closePendingActions
        call buildLabelXML line.ix
      end

    when pos("Certificate ID:",line.ix) = 3 then
      do
        call closePendingActions
        call buildCertIdXML line.ix
      end

    when pos("Status:",line.ix) = 3 then
      do
        call closePendingActions
        call buildStatusXML line.ix
      end

    when pos("Start Date:",line.ix) = 3 then
      do
        call closePendingActions
        call buildStartDateXML line.ix
      end

    when pos("End Date:",line.ix) = 3 then
      do
        call closePendingActions
        call buildEndDateXML line.ix
      end

    when pos("Serial Number:",line.ix) = 3 then
      do
        call closePendingActions
        call startSerialNumberXML
      end

    when serialNumberStarted = 1 & pos(">",line.ix) = 8 then
      call buildSerialNumberXML line.ix

    when pos("Issuer's Name:",line.ix) = 3 then
      do
        call closePendingActions
        call startIssuerNameXML
      end

    when issuerNameStarted = 1 & pos(">",line.ix) = 8 then
      call buildIssuerNameXML line.ix

    when pos("Subject's Name:",line.ix) = 3 then
      do
        call closePendingActions
        call startSubjectNameXML line.ix
      end

    when subjectNameStarted = 1 & pos(">",line.ix) = 8 then
      call buildSubjectNameXML line.ix

    when pos("Subject's AltNames:",line.ix) = 3 then
      do
        call closePendingActions
        call startSubjectAltNamesXML line.ix
      end

    when subjectAltNamesStarted = 1 & ,
         pos("IP",line.ix) = 5 then
      do
        call buildAltNameIPXML line.ix
      end

    when subjectAltNamesStarted = 1 & ,
         pos("Domain",line.ix) = 5 then
      do
        call buildAltNameDomainXML line.ix
      end

    when subjectAltNamesStarted = 1 & ,
         pos("EMail",line.ix) = 5 then
      do
        call buildAltNameEmailXML line.ix
      end

    when subjectAltNamesStarted = 1 & ,
         pos("URI",line.ix) = 5 then
      do
        call buildAltNameURIXML line.ix
      end

    when pos("Key Usage:",line.ix) = 3 then
      do
        call closePendingActions
        call buildKeyUsageXML line.ix
      end

    when pos("Private Key Size:",line.ix) = 3 then
      do
        call closePendingActions
        call buildPrivateKeySizeXML line.ix
      end

    when pos("Private Key Type:",line.ix) = 3 then
      do
        call closePendingActions
        call buildPrivateKeyTypeXML line.ix
      end

    when pos("Ring Associations:",line.ix) = 3 then
      do
        call closePendingActions
        call startRingAssociationsXML line.ix
      end

    when ringAssociationsStarted = 1 & ,
         pos("*** No rings associated ***",line.ix) = 3 then
      call closePendingActions

    when ringAssociationsStarted = 1 & ,
         pos("Ring Owner:",line.ix) = 5 then
      call buildRingOwnerXML line.ix

    when ringAssociationsStarted = 1 & ,
         pos("Ring:",line.ix) = 5 then
      call startRingNameXML

    when ringAssociationsStarted = 1 & ,
         ringStarted = 1 & ,
         pos(">",line.ix) = 8 then
      call buildRingNameXML line.ix

    otherwise
      do
        Say mid(10) "Unrecognized line ignored:" line.ix"."
      end
  end
end


return lrc



 /**
  * xmlStart: Processes new cert and generates initial xml tags
  */
xmlStart:
Parse arg "Digital certificate information for " certinfo

select
  when pos("CERTAUTH", certinfo) > 0 then
    do
      certuser = "CERTAUTH"
      certtype = "certauth"
    end
  when pos("SITE", certinfo) > 0 then
    do
      certuser = "SITE"
      certtype = "site"
    end
  otherwise
    do
      Parse var certinfo with . "user" certuser ":" .
      certtype = "user"
    end
end

certuser = space(certuser)

if xmlStarted = 0 then
  do
    xmlStarted = 1

    call genXML indent '<?xml version="1.0" encoding="ISO-8859-1">'

    call genXML indent " "

    call genXML indent ,
                 "<!-- Generated by" exec_name VERS,
                 "at" time('N') "on" date('N') "-->"

    call genXML indent ,
            "<!-- User" userid() "  System" mvsvar("SYSNAME") "-->"

    call genXML indent " "

    /************************************/
    /* Reserve 4 slots for control tags */
    /************************************/
    call genXML indent " "
    firstControlTag = xml.0   /* Save starting line number */
    call genXML indent " "
    call genXML indent " "
    call genXML indent " "

    call genXML indent " "   /* Blank line */
  end
else
  nop

Say mid(11) "Processing certs for:" certuser "..."

return


 /**
  * xmlEnd: process end of all xml statements.
  *
  *         Add control tags to appropriate point in file.
  */
xmlEnd:

call genXMLAtLine firstControlTag ,
                     "<control type=total>"certCount"</control>"

call genXMLAtLine firstControlTag+1 ,
                     "<control type=authtotal>"authCertCount"</control>"

call genXMLAtLine firstControlTag+2 ,
                     "<control type=sitetotal>"siteCertCount"</control>"

call genXMLAtLine firstControlTag+3 ,
                     "<control type=usertotal>"userCertCount"</control>"

return


 /**
  * startCertXML: generate new cert xml
  *
  */
startCertXML:

if certStarted = 1 then   /* If prior cert in progress */
  do
    call closePendingActions
    call endCertXML
  end
else nop

call genXML indent "<cert type="certtype">"

certStarted = 1

certCount = certCount + 1

select
  when certtype = "certauth" then
    authCertCount = authCertCount + 1
  when certtype = "site" then
    siteCertCount = siteCertCount + 1
  when certtype = "user" then
    userCertCount = userCertCount + 1
  otherwise nop
end

indent = indent + 2
if certtype = "user" then
  call genXML indent "<user>"certuser"</user>"
else nop

return


 /**
  * endCertXML: complete new cert xml
  *
  */
endCertXML:
if certStarted = 1 then
  do
    indent = indent - 2
    call genXML indent "</cert>"

    certStarted = 0
  end
else nop
return


 /**
  * buildLabelXML: Start a new cert and process label
  *
  */
buildLabelXML:
  Parse arg . "Label: " labelval

call startCertXML

if certuser != "CERTAUTH" & certuser != "SITE" then
  call genXML indent "<user>"certuser"</user>"
else
  nop

call genXML indent "<label>"labelval"</label>"

return


 /**
  * buildCertIdXML: process cert id
  *
  */
buildCertIdXML:

Parse arg . "Certificate ID: " certidval

call genXML indent "<id>"certidval"</id>"

return


 /**
  * buildStatusXML: process cert status
  *
  */
buildStatusXML:
Parse arg . "Status: " statusval

call genXML indent "<status>"statusval"</status>"

return



 /**
  * buildStartDateXML: process start date and time
  *
  */
buildStartDateXML:

Parse arg . "Start Date: " sdate stime

call genXML indent ,
            "<startdate type=date>"sdate"</startdate>"

call genXML indent ,
            "<startdate type=time>"stime"</startdate>"

return



 /**
  * buildEndDateXML: process end date and time
  *
  */
buildEndDateXML:

Parse arg . "End Date: " edate etime

call genXML indent "<enddate type=date>"edate"</enddate>"

call genXML indent "<enddate type=time>"etime"</enddate>"

return


 /**
  * startSerialNumberXML: process start of serial number
  *
  */
startSerialNumberXML:

serialNumberStarted = 1

return



 /**
  * buildSerialNumberXML: process serial number continuations
  *
  */
buildSerialNumberXML:

Parse arg . ">" serialval "<"

if serial = "" then   /* If serial not started yet */
  serial = "<serial>"serialval
else
  serial = serial||serialval   /* Append to existing tag */

return



 /**
  * endSerialNumberXML: generate serial number XML
  *
  */
endSerialNumberXML:

serial = serial"</serial>"

call genXML indent serial

serialNumberStarted = 0
serial = ""

return



 /**
  * startIssuerNameXML: process start of cert issuer
  *
  */
startIssuerNameXML:

issuerNameStarted = 1

return


 /**
  * buildIssuerNameXML: process cert issuer continuations
  *
  */
buildIssuerNameXML:

Parse arg . ">" issuerval "<"

if issuer = "" then   /* If issuer not started yet */
  issuer = "<issuer>"issuerval
else
  issuer = issuer||issuerval   /* Append to existing tag */

return


 /**
  * endIssuerNameXML: generate cert issuer xml
  *
  */
endIssuerNameXML:

issuer = issuer"</issuer>"

call genXML indent issuer

issuerNameStarted = 0
issuer = ""

return



 /**
  * startSubjecterNameXML: process start of subject name
  *
  */
startSubjectNameXML:

subjectNameStarted = 1

return



 /**
  * buildSubjectNameXML: process subject name continuations
  *
  */
buildSubjectNameXML:

Parse arg . ">" subjectval "<"

if subject = "" then   /* If subject not started yet */
  subject = subjectval
else
  subject = subject||subjectval   /* Append to existing tag */

return


 /**
  * endSubjectNameXML: generate subject name xml
  *
  *                      The subject name is decomposed into its
  *                      separate components.
  */
endSubjectNameXML:

call genXML indent "<subject>"
indent = indent + 2

call genXML indent "<name>"subject"</name>"

subjectdn = space(subject)

cn = ""
title = ""
ou = ""
org = ""
loc = ""
sp = ""
country = ""

     /********************************************/
     /* Each component is separated by a period. */
     /* Strip off any trailing period.           */
     /********************************************/
subjectdn = reverse(subjectdn)

select
  when lastpos("=C",subjectdn) > 0 & lastpos("=C.",subjectdn) = 0 then
    subjectdn = subjectdn"."

  when lastpos("=PS",subjectdn) > 0 & lastpos("=PS.",subjectdn) = 0 then
    subjectdn = subjectdn"."

  when lastpos("=L",subjectdn) > 0 & lastpos("=L.",subjectdn) = 0 then
    subjectdn = subjectdn"."

  when lastpos("=O",subjectdn) > 0 & lastpos("=O.",subjectdn) = 0 then
    subjectdn = subjectdn"."

  when lastpos("=UO",subjectdn) > 0 & lastpos("=UO.",subjectdn) = 0 then
    subjectdn = subjectdn"."

  when lastpos("=T",subjectdn) > 0 & lastpos("=T.",subjectdn) = 0 then
    subjectdn = subjectdn"."

  when lastpos("=NC",subjectdn) > 0 & lastpos("=NC.",subjectdn) = 0 then
    subjectdn = subjectdn"."

  otherwise
end

     /****************************************/
     /* Isolate the component and its value, */
     /* and delete it from the string.       */
     /****************************************/
start = lastpos("=C.",subjectdn)
if start > 1 then
  do
    country = reverse(substr(subjectdn,1,start-1))
    subjectdn = delstr(subjectdn,1,start+2)
  end
else nop

start = lastpos("=PS.",subjectdn)
if start > 1 then
  do
    sp = reverse(substr(subjectdn,1,start-1))
    subjectdn = delstr(subjectdn,1,start+3)
  end
else nop

start = lastpos("=L.",subjectdn)
if start > 1 then
  do
    loc = reverse(substr(subjectdn,1,start-1))
    subjectdn = delstr(subjectdn,1,start+2)
  end
else nop

start = lastpos("=O.",subjectdn)
if start > 1 then
  do
    org = reverse(substr(subjectdn,1,start-1))
    subjectdn = delstr(subjectdn,1,start+2)
  end
else nop

start = lastpos("=UO.",subjectdn)
if start > 1 then
  do
    ou = reverse(substr(subjectdn,1,start-1))
    subjectdn = delstr(subjectdn,1,start+3)
  end
else nop

start = lastpos("=T.",subjectdn)
if start > 1 then
  do
    title = reverse(substr(subjectdn,1,start-1))
    subjectdn = delstr(subjectdn,1,start+2)
  end
else nop

start = lastpos("=NC.",subjectdn)
if start > 1 then
  do
    cn = reverse(substr(subjectdn,1,start-1))
    subjectdn = delstr(subjectdn,1,start+3)
  end
else nop

if length(subjectdn) > 0 then    /* If anything left over */
  call genXML indent "<text>"reverse(subjectdn)"</text>"
else nop

if length(cn) > 0 then
  call genXML indent "<cn>"cn"</cn>"
else nop

if length(title) > 0 then
  call genXML indent "<t>"title"</t>"
else nop

if length(ou) > 0 then
  call genXML indent "<ou>"ou"</ou>"
else nop

if length(org) > 0 then
  call genXML indent "<org>"org"</org>"
else nop

if length(loc) > 0 then
  call genXML indent "<l>"loc"</l>"
else nop

if length(sp) > 0 then
  call genXML indent "<sp>"sp"</sp>"
else nop

if length(country) > 0 then
  call genXML indent "<c>"country"</c>"
else nop

indent = indent - 2
call genxml indent "</subject>"

subjectNameStarted = 0
subject = ""

return



 /**
  * startSubjectAltNamesXML: process start of subject alt names
  *
  */
startSubjectAltNamesXML:

subjectAltNamesStarted = 1

call genXML indent "<altname>"
indent = indent + 2

return



 /**
  * buildAltNameIPXML: generate IP alt name xml
  *
  */
buildAltNameIPXML:

Parse arg . "IP: " ipval

ipval = space(ipval)
call genXML indent "<ip>"ipval"</ip>"

return




 /**
  * buildAltNameDomainXML: generate domain alt name xml
  *
  */
buildAltNameDomainXML:

Parse arg . "Domain: " domainval

domainval = space(domainval)
call genXML indent "<domain>"domainval"</domain>"

return


 /**
  * buildAltNameEMailXML: generate email alt name xml
  *
  */
buildAltNameEMailXML:

Parse arg . "EMail: " emailval

emailval = space(emailval)
call genXML indent "<email>"emailval"</email>"

return


 /**
  * buildAltNameURIXML: generate URI alt name xml
  *
  */
buildAltNameURIXML:

Parse arg . "URI: " urival

urival = space(urival)
call genXML indent "<uri>"urival"</uri>"

return


 /**
  * endSubjectAltNamesXML: processes end of subject alt names
  *
  */
endSubjectAltNamesXML:

if subjectAltNamesStarted = 1 then
  do
    indent = indent - 2
    call genXML indent "</altname>"

    subjectAltNamesStarted = 0
  end
else nop

return


 /**
  * buildKeyUsageXML: generates key usage xml
  *
  */
buildKeyUsageXML:

Parse arg . "Key Usage: " usageval

call genXML indent "<keyusage>"usageval"</keyusage>"

return


 /**
  * buildPrivateKeySizeXML: generates key size xml
  *
  */
buildPrivateKeySizeXML:

Parse arg . "Private Key Size: " keysizeval

keysizeval = space(keysizeval)

call genXML indent  "<privatekeysize>"keysizeval"</privatekeysize>"

return



 /**
  * buildPrivateKeyTypeXML: generates key type xml
  *
  */
buildPrivateKeyTypeXML:

Parse arg . "Private Key Type: " privatekeyval

call genXML indent  "<privatekeytype>"privatekeyval"</privatekeytype>"

return



 /**
  * startRingAssociationsXML: processes start of ring associations
  *
  */
startRingAssociationsXML:

ringAssociationsStarted = 1

return



 /**
  * endRingAssociationsXML: processes end of ring associations
  *
  */
endRingAssociationsXML:

if ringNameStarted = 1 then
  call endRingNameXML
else nop

if ringStarted = 1 then
  call endRingXML
else nop

if associationsStarted = 1 then
  do
    indent = indent - 2
    call genXML indent "</associations>"

    associationsStarted = 0
  end
else nop

ringAssociationsStarted = 0

return


 /**
  * startAssociationsXML: processes start of associations
  *
  */
startAssociationsXML:

call genXML indent "<associations>"
indent = indent + 2

associationsStarted = 1
return


 /**
  * buildRingOwnerXML: generates ring owner XML
  *
  */
buildRingOwnerXML:

Parse arg . "Ring Owner: " ownerval

ownerval = space(ownerval)

if associationsStarted = 0 then
  call startAssociationsXML
else nop

if ringNameStarted = 1 then
  call endRingNameXML
else nop

if ringStarted = 1 then
  call endRingXML
else nop

if ringStarted = 0 then
  call startRingXML
else nop

call genXML indent "<owner>"ownerval"</owner>"

return

startRingXML:

call genXML indent "<ring>"
indent = indent + 2

ringStarted = 1
return

 /**
  * buildRingXML: process ring XML
  *
  */
buildRingXML:

return


 /**
  * endRingXML: generates end of ring XML
  *
  */
endRingXML:

if ringStarted = 1 then
  do
    indent = indent - 2

    call genXML indent "</ring>"
  end
else nop

ringStarted = 0
return


 /**
  * startRingNameXML: processes start of ring names
  *
  */
startRingNameXML:

ringNameStarted = 1

return



 /**
  * biuldRingNameXML: processes start of ring names
  *
  */
buildRingNameXML:

Parse arg . ">" ringnameval "<"

if ringname = "" then   /* If ring name not started yet */
  ringname = "<name>"ringnameval
else
  ringname = ringname||ringnameval   /* Append to existing tag */

return



 /**
  * endRingNameXML: generates ring name XML
  *
  */
endRingNameXML:

if length(ringname) > 0 then
  call genXML indent ringname"</name>"
else nop

ringNameStarted = 0
ringname = ""
ring = ""

return


 /**
  * addUser: adds a unique user to the userid list.  Each
  *          entry in the list contains a user owning certs.
  */
addUser:
Parse arg user .

upperUser = translate(user)

if user = upperUser then   /* If not lower case */
  do
    if userList.0 = 0 then   /* If this is first user */
      do
        userList.0 = 1
        userList.1 = user
      end
    else    /* Not first user */
      do
        /*****************************/
        /* Search for duplicate user */
        /*****************************/
        found = 0
        do jx = 1 to userList.0 ,
           while found = 0
          if user = userList.jx then
            found = 1
          else
            nop
        end
        if found = 0 then  /* If not a duplicate */
          do
            userList.0 = userList.0 + 1
            x = value('userList.'userList.0,user)
          end
        else
          nop
      end
  end
else
  nop

return


 /**
  * finalClosePendingActions: closes any open tags and completes
  *                           XML generation of the cert
  */
finalClosePendingActions:
call closePendingActions
call endCertXML
return


 /**
  * closePendingActions: closes any open tags
  */
closePendingActions:

if serialNumberStarted = 1 then
  call endSerialNumberXML
else nop

if issuerNameStarted = 1 then
  call endIssuerNameXML
else nop

if subjectNameStarted = 1 then
  call endSubjectNameXML
else nop

if subjectAltNamesStarted = 1 then
  call endSubjectAltNamesXML
else nop

if ringAssociationsStarted = 1 then
  call endRingAssociationsXML
else nop


return



 /**
  * genXML: generates an XML statement
  */
genXML:
Parse arg ind line

xml.0 = xml.0 + 1
x = value('xml.'xml.0,copies(" ",ind)line)
return



 /**
  * genXMLAtLine: generates an XML statement at a specific line in
  *               the file
  */
genXMLAtLine:
Parse arg lineno line

xml.lineno = line
return



 /**
  * pruneXML: removes all XML tags not used by the wizard
  */
pruneXML:

reqTag. = ""
reqTag.1  = "<?xml"
reqTag.2  = "<!"
reqTag.3  = "<cert type="
reqTag.4  = "</cert>"
reqTag.5  = "<label>"
reqTag.6  = "<status>"
reqTag.7  = "<subject>"
reqTag.8  = "</subject>"
reqTag.9  = "<name>"
reqTag.10 = "<cn>"
reqTag.11 = "<t>"
reqTag.12 = "<ou>"
reqTag.13 = "<org>"
reqTag.14 = "<l>"
reqTag.15 = "<sp>"
reqTag.16 = "<c>"
reqTag.17 = "<startdate"
reqTag.18 = "<enddate"
reqTag.19 = "<keyusage>"
reqTag.20 = "<user>"
reqTag.21 = "<privatekeytype>"
reqTag.22 = "<control"
reqTag.0 = 22

xmlp. = ""    /* Pruned xml */
xmlp.0 = 0

do ix = 1 to xml.0

  do jx = 1 to reqTag.0
    if xml.ix = " " | ,   /* If all blanks */
       pos(reqTag.jx, xml.ix) > 0 then   /* .. or tag is present */
      do
        xmlp.0 = xmlp.0 + 1
        x = value('xmlp.'xmlp.0, xml.ix)
        leave jx
      end
    else
      nop
  end
end

return



 /**
  * writeXML: writes the XML statements to a file
  */
writeXML:


dsn = dsnqual".xml"
lrc = LISTDSI(dsn)
if lrc < ERROR then
  disp = "SHR"
else
  disp = "MOD"

"ALLOC FI(XML) DA("dsn") REUS" disp ,
  " RECFM(V B) LRECL(1024) BLKSIZE(0)" ,
  " TRACKS SPACE(50 50) RELEASE"
"EXECIO * DISKW XML (STEM xmlp. FINIS"
"FREE FI(XML)"

lrc = LISTDSI(dsn)
if lrc < ERROR then
  fulldsn = SYSDSNAME
else nop

Say mid(12) "Output has been written to" fulldsn"."

xmlsize = 0
do ix = 1 to xmlp.0
  xmlsize = xmlsize + length(xmlp.ix)
end

Say mid(16) "The size of" fulldsn "is" xmlsize "bytes."
if xmlsize > 32750 then
  Say mid(17 "W") "Warning: the file is too large for the Netscape",
                  "browser.  Refer to the instructions for using",
                  "large files in the wizard help."
else
  nop
return



 /**
  * writeDebugFile: writes a statement to the debug file
  */
writeDebugFile:
Parse arg ft app

if debug = DEBUG_MAX then
  do ix = 1 to line.0
    Say mid(13) line.ix
  end
else nop

if debug >= DEBUG_MIN & ,
   line.0 > 0 then
  do
    certdsn = dsnqual"."ft
    lrc = LISTDSI(certdsn)
    if lrc < ERROR then
      if app = "append" then
        disp = "MOD"
      else
        disp = "SHR"
    else
      disp = "MOD"

    "ALLOC FI(CERTOUT) DA("certdsn") REUS" disp ,
       " RECFM(V B) LRECL(1024) BLKSIZE(0)" ,
       " TRACKS SPACE(10 10) RELEASE"

    if rc = SUCCESS then   /* If alloc worked */
      do
        "EXECIO * DISKW CERTOUT (STEM line. FINIS"

        lrc = LISTDSI(certdsn)
        if disp = "MOD" & app = "append" then
          Say mid(14) "Diagnostic output appended to" SYSDSNAME"."
        else
          Say mid(15) "Diagnostic output written to" SYSDSNAME"."

        "FREE FI(CERTOUT)"
      end
    else
      lrc = SEVERE

  end
else nop

return



 /**
  * deleteFiles: deletes all output and debug files
  */
deleteFiles:

x = MSG("OFF")
"delete" dsnqual".xml"
"delete" dsnqual".txt1"
"delete" dsnqual".txt2"
"delete" dsnqual".txt3"
"delete" dsnqual".txt4"
x = MSG("ON")

return


 /**
  * mid: formats a message identifier
  */
mid:
Parse arg msgno sev

if sev = "" then
  sev = "I"
else nop

select
  when msgno = "" then nop
  when length(msgno) = 1 then
    msgno = "000"msgno||sev
  when length(msgno) = 2 then
    msgno = "00"msgno||sev
  when length(msgno) = 3 then
    msgno = "0"msgno||sev
  otherwise
    msgno = msgno||sev
end

return "DRQZW"msgno