gnatprove_13.2.1_28fc3583/share/examples/spark/tokeneer/certproc.adb

------------------------------------------------------------------
-- Tokeneer ID Station Support Software
--
-- Copyright (2003) United States Government, as represented
-- by the Director, National Security Agency. All rights reserved.
--
-- This material was originally developed by Praxis High Integrity
-- Systems Ltd. under contract to the National Security Agency.
------------------------------------------------------------------

------------------------------------------------------------------
-- CertProc
--
-- Implementation Notes:
--    None.
--
------------------------------------------------------------------

with CommonTypes;
with MsgProc;
with CryptoTypes;
with Ada.Strings.Fixed;
with Ada.Strings;

use type CommonTypes.Unsigned32T;
use type CryptoTypes.AlgorithmT;
use type CryptoTypes.IssuerT;

package body CertProc
  with SPARK_Mode => Off  --  exception handlers
is

   ------------------------------------------------------------------
   -- Types
   --
   ------------------------------------------------------------------
   ------------------------------------------------------------------
   -- State
   --
   ------------------------------------------------------------------
   CryptoControlData : CryptoControlDataT := NullCryptoControl;

   subtype RoleValues is Integer range 0..3;
   type RoleFromT is array(RoleValues) of PrivTypes.PrivilegeT;
   type RoleToT is array(PrivTypes.PrivilegeT) of RoleValues;

   subtype ClassValues is Integer range 0..5;
   type ClassFromT is array(ClassValues) of PrivTypes.ClassT;
   type ClassToT is array (PrivTypes.ClassT) of ClassValues;

   RoleFrom : constant RoleFromT := (
       0 => PrivTypes.UserOnly,
       1 => PrivTypes.Guard,
       2 => PrivTypes.SecurityOfficer,
       3 => PrivTypes.AuditManager
      );

   RoleTo : constant RoleToT := (
       PrivTypes.UserOnly        => 0,
       PrivTypes.Guard           => 1,
       PrivTypes.SecurityOfficer => 2,
       PrivTypes.AuditManager    => 3
      );

   ClassFrom : constant ClassFromT := (
       0 => PrivTypes.Unmarked,
       1 => PrivTypes.Unclassified,
       2 => PrivTypes.Restricted,
       3 => PrivTypes.Confidential,
       4 => PrivTypes.Secret,
       5 => PrivTypes.Topsecret
      );

   ClassTo : constant ClassToT := (
       PrivTypes.Unmarked => 0,
       PrivTypes.Unclassified => 1,
       PrivTypes.Restricted => 2,
       PrivTypes.Confidential => 3,
       PrivTypes.Secret => 4,
       PrivTypes.Topsecret => 5
      );

   ------------------------------------------------------------------
   -- Local Subprograms
   ------------------------------------------------------------------
   ------------------------------------------------------------------
   -- Extractname
   --
   -- Description:
   --    Extracts the values from TheDict and checks the values are
   --    in type. If values are invalid, or there is a problem extracting
   --    the values, then NullIssuer is returned.
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure ExtractName(TheDict : in     MsgProc.DictionaryT;
                         TheName :    out CryptoTypes.IssuerT)
   is
      TheNameString : String := MsgProc.GetStringByKey(
                                     Dic => TheDict,
                                     Key => "Text");
      TheNameLength : Integer;
   begin
      TheNameLength := Integer'Value(
                          MsgProc.GetStringByKey(
                                     Dic => TheDict,
                                     Key => "TextLength"));

      if TheNameLength <= CryptoTypes.NameI'Last then

         TheName.NameLength := TheNameLength;
         TheName.Name :=
                -- Truncate the name if it is longer than the length
                -- given
                Ada.Strings.Fixed.Overwrite(
                           CryptoTypes.BlankName,
                           1,
                           Ada.Strings.Fixed.Head(TheNameString,
                                                  TheNameLength));

         TheName.ID := CryptoTypes.IssuerIDT'Value(
                          MsgProc.GetStringByKey(
                                Dic => TheDict,
                                Key => "ID"));
      else
         TheName := CryptoTypes.NullIssuer;
      end if;

   exception
      when E : others =>
         TheName := CryptoTypes.NullIssuer;
   end ExtractName;

   ------------------------------------------------------------------
   -- ExtractValidity
   --
   -- Description:
   --    Extracts the NotBefore and NotAfter dictionaries from TheDict
   --    and checks the values are in type. If values are invalid, or
   --    there is a problem extracting the values, then
   --    a default value is set, and success is set False
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure ExtractValidity(TheDict     : in     MsgProc.DictionaryT;
                             TheValidity :    out ValidityT;
                             Ok          :    out Boolean)
   is
      NB : MsgProc.DictionaryT :=
              MsgProc.GetDictionaryByKey(Dic => TheDict,
                                         Key => "NotBefore");
      NA : MsgProc.DictionaryT :=
              MsgProc.GetDictionaryByKey(Dic => TheDict,
                                         Key => "NotAfter");

      ------------------------------------------------------------------
      -- DateNotInType
      --
      -- Description:
      --    Checks that the values are appropriate.
      --       Minute in 0..59
      --       Hour   in 0..23
      --       Day    in 1..31
      --       Month  in 1..12
      --       Year   in 1901..2099
      --    NB does not check that values are consistent with each other
      --    (e.g. if Month is April, does not check that Day is 1..30)
      --
      -- Implementation Notes:
      --    None.
      --
      ------------------------------------------------------------------
      function DateNotInType(TheDate : TimeT) return Boolean
      is
      begin
         return TheDate.Year < 1901 or
                TheDate.Year > 2099 or
                   TheDate.Month < 1 or
                   TheDate.Month > 12 or
                      TheDate.Day < 1 or
                      TheDate.Day > 31 or
                         TheDate.Hour > 23 or
                            TheDate.Minute > 59;
      end DateNotInType;

   begin
      TheValidity.NotBefore.Minute := CommonTypes.Unsigned32T'Value(
                                         MsgProc.GetStringByKey(
                                             Dic => NB,
                                             Key => "Minute"));
      TheValidity.NotBefore.Hour   := CommonTypes.Unsigned32T'Value(
                                         MsgProc.GetStringByKey(
                                             Dic => NB,
                                             Key => "Hour"));
      TheValidity.NotBefore.Day    := CommonTypes.Unsigned32T'Value(
                                         MsgProc.GetStringByKey(
                                             Dic => NB,
                                             Key => "Day"));
      TheValidity.NotBefore.Month  := CommonTypes.Unsigned32T'Value(
                                         MsgProc.GetStringByKey(
                                             Dic => NB,
                                             Key => "Month"));
      TheValidity.NotBefore.Year   := CommonTypes.Unsigned32T'Value(
                                         MsgProc.GetStringByKey(
                                             Dic => NB,
                                             Key => "Year"));

      TheValidity.NotAfter.Minute := CommonTypes.Unsigned32T'Value(
                                         MsgProc.GetStringByKey(
                                             Dic => NA,
                                             Key => "Minute"));
      TheValidity.NotAfter.Hour   := CommonTypes.Unsigned32T'Value(
                                         MsgProc.GetStringByKey(
                                             Dic => NA,
                                             Key => "Hour"));
      TheValidity.NotAfter.Day    := CommonTypes.Unsigned32T'Value(
                                         MsgProc.GetStringByKey(
                                             Dic => NA,
                                             Key => "Day"));
      TheValidity.NotAfter.Month  := CommonTypes.Unsigned32T'Value(
                                         MsgProc.GetStringByKey(
                                             Dic => NA,
                                             Key => "Month"));
      TheValidity.NotAfter.Year   := CommonTypes.Unsigned32T'Value(
                                         MsgProc.GetStringByKey(
                                             Dic => NA,
                                             Key => "Year"));

      if DateNotInType(TheValidity.NotAfter) or
         DateNotInType(TheValidity.NotBefore) then

         Ok := False;
         TheValidity := (NotBefore => (Minute => 0,
                                       Hour   => 0,
                                       Day    => 1,
                                       Month  => 1,
                                       Year   => 1901),
                         NotAfter  => (Minute => 0,
                                       Hour   => 0,
                                       Day    => 1,
                                       Month  => 1,
                                       Year   => 1901));
      else
         Ok := True;
      end if;
   end ExtractValidity;


   ------------------------------------------------------------------
   -- RemoveHolder
   --
   -- Description:
   --    Removes the Holder dictionary from the certificate.
   --    Required when attempting to extract the Issuer, or the
   --    SerialNumber.
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure RemoveHolder(TheCert : in out CertTypes.RawCertificateT)
   is
      HolderDict : MsgProc.DictionaryT :=
                      MsgProc.GetDictionaryByKey(
                              Dic => MsgProc.DictionaryT(TheCert),
                              Key => "Holder");
      HolderStart : Natural;
   begin
      HolderStart := Ada.Strings.Fixed.Index(TheCert,
                                             String(HolderDict));
      -- leave both braces, to ensure any further searches
      -- will not be broken.
      Ada.Strings.Fixed.Delete(TheCert,
                               HolderStart,
                               HolderStart + HolderDict'Length - 1);

   exception
      when E : others =>
         TheCert := (others => ' ');
   end RemoveHolder;


   ------------------------------------------------------------------
   -- CheckCertLength
   --
   -- Description:
   --    Checks the CertLength is consistent with the length
   --    of the CertData dictionary.
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure CheckCertLength (TheCert  : in     CertTypes.RawCertificateT;
                              Success  :    out Boolean)
   is
      TheCertLength : Integer;
      TheCertData : constant String :=
                       String(MsgProc.GetDictionaryByKey(
                                 MsgProc.DictionaryT(TheCert),
                                 "CertDataT"));
   begin
      -- The CertLength field includes the braces enclosing the CertData dictionary
      -- so subtract 2 from the length.
      TheCertLength  := Integer'Value(MsgProc.GetStringByKey(
                                          MsgProc.DictionaryT(TheCert),
                                          "CertLength")) - 2;
      Success := TheCertData'Length = TheCertLength;
   exception
      when E : others =>
         Success := False;
   end CheckCertLength;


   ------------------------------------------------------------------
   -- GetCertType
   --
   -- Description:
   --    Determines the Certificate Type.
   --    If Actual CertType found is not the same as the Expected
   --    CertType, Success is set to False.
   --    If the CertType is not found, Actual is set to an invalid
   --    value, and Success is set to False.
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure GetCertType (TheCert  : in     CertTypes.RawCertificateT;
                          Expected : in     CommonTypes.Unsigned32T;
                          Actual   :    out CommonTypes.Unsigned32T;
                          Success  :    out Boolean)
   is
   begin
      Actual  := CommonTypes.Unsigned32T'Value(
                    MsgProc.GetStringByKey(
                              Dic => MsgProc.DictionaryT(TheCert),
                              Key => "CertType"));
      Success := Expected = Actual;
   exception
      when E : others =>
         Actual  := CommonTypes.Unsigned32T'Last;
         Success := False;
   end GetCertType;


   ------------------------------------------------------------------
   -- GetSerialNumber
   --
   -- Description:
   --    Attempts to extract the Certificate's Serial Number.
   --    Success is set False if it is not found, or if it is invalid.
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure GetSerialNumber (TheCert  : in     CertTypes.RawCertificateT;
                              CertType : in     CommonTypes.Unsigned32T;
                              SerialNo :    out CommonTypes.Unsigned32T;
                              Success  :    out Boolean)
   is
      LocalCert : CertTypes.RawCertificateT := TheCert;
   begin
      if CertType /= IDCertType then
         -- Need to remove the 'Holder' dictionary from the certificate,
         -- since this also contains a 'SerialNumber'.
         RemoveHolder(LocalCert);
      end if;

      SerialNo := CommonTypes.Unsigned32T'Value(
                    MsgProc.GetStringByKey(
                              Dic => MsgProc.DictionaryT(LocalCert),
                              Key => "SerialNumber"));
      Success  := True;
   exception
      when E : others =>
         SerialNo := CommonTypes.Unsigned32T'Last;
         Success  := False;
   end GetSerialNumber;


   ------------------------------------------------------------------
   -- GetSigAlgID
   --
   -- Description:
   --    Attempts to extract the Certificate's SigAlgID field.
   --    A check is made that it is equal to the AlgorithmID held in
   --    the SignatureDate field.
   --    Success is set False if it is not found, or if it is not
   --    equal to the 'SignatureData' algorithm.
   --    If either algortihm ID is not found, ID is set to 'First, and
   --    Success to false.
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure GetSigAlgID (TheCert  : in     CertTypes.RawCertificateT;
                          ID       :    out CryptoTypes.AlgorithmT;
                          Success  :    out Boolean)
   is
      SigDict : MsgProc.DictionaryT :=
                   MsgProc.GetDictionaryByKey(
                            Dic => MsgProc.DictionaryT(TheCert),
                            Key => "SignatureData");
      IDFromSig : CryptoTypes.AlgorithmT;
   begin
      ID       := CryptoTypes.AlgorithmT'Value(
                     MsgProc.GetStringByKey(
                               Dic => MsgProc.DictionaryT(TheCert),
                               Key => "SigAlgID"));

      IDFromSig := CryptoTypes.AlgorithmT'Value(
                      MsgProc.GetStringByKey(
                                Dic => SigDict,
                                Key => "AlgoRithmID"));

      Success := ID = IDFromSig;
   exception
      when E : others =>
         ID := CryptoTypes.AlgorithmT'First;
         Success  := False;
   end GetSigAlgID;


   ------------------------------------------------------------------
   -- GetName
   --
   -- Description:
   --    Attempts to extract the Certificate's Issuer field, or
   --    Subject field, depending on CertType and IsSubject.
   --    If values are invalid, or there is a problem extracting
   --    the values, then NullIssuer is returned, and Success is set
   --    to False.
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure GetName (TheCert   : in     CertTypes.RawCertificateT;
                      CertType  : in     CommonTypes.Unsigned32T;
                      IsSubject : in     Boolean;
                      TheName   :    out CryptoTypes.IssuerT;
                      Success   :    out Boolean)
   is
      LocalCert : CertTypes.RawCertificateT := TheCert;
   begin
      if CertType /= IDCertType and
         not IsSubject then
         -- Need to remove the 'Holder' dictionary from the certificate,
         -- since this also contains an 'Issuer'.
         RemoveHolder(LocalCert);
      end if;

      if IsSubject then
         declare
            TheDict : MsgProc.DictionaryT :=
                         MsgProc.GetDictionaryByKey(
                                    Dic => MsgProc.DictionaryT(LocalCert),
                                    Key => "Subject");
         begin
            ExtractName(TheDict, TheName);
         end;
      else
         declare
            TheDict : MsgProc.DictionaryT :=
                         MsgProc.GetDictionaryByKey(
                                    Dic => MsgProc.DictionaryT(LocalCert),
                                    Key => "Issuer");
         begin
            ExtractName(TheDict, TheName);
         end;
      end if;
      Success := TheName /= CryptoTypes.NullIssuer;
   end GetName;


   ------------------------------------------------------------------
   -- GetHolder
   --
   -- Description:
   --    Attempts to extract the Certificate's Holder field.
   --    If values are invalid, or there is a problem extracting
   --    the values, then a Null holder is returned, and Success is set
   --    to False.
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure GetHolder (TheCert   : in     CertTypes.RawCertificateT;
                        TheHolder :    out CertTypes.IDT;
                        Success   :    out Boolean)
   is
      HolderDict : MsgProc.DictionaryT :=
                      MsgProc.GetDictionaryByKey(
                              Dic => MsgProc.DictionaryT(TheCert),
                              Key => "Holder");
   begin
      ExtractName(HolderDict, TheHolder.Issuer);
      TheHolder.SerialNumber := CertTypes.SerialNumberT'Value(
                                   MsgProc.GetStringByKey(
                                      Dic => HolderDict,
                                      Key => "SerialNumber"));
      Success  := TheHolder.Issuer /= CryptoTypes.NullIssuer;
   exception
      when E : others =>
         TheHolder := (Issuer       => CryptoTypes.NullIssuer,
                       SerialNumber => CertTypes.SerialNumberT'Last);
         Success  := False;
   end GetHolder;


   ------------------------------------------------------------------
   -- GetValidity
   --
   -- Description:
   --    Attempts to extract the Certificate's Validity field, or
   --    AttCertValidity field, depending on CertType.
   --    If values are invalid, or there is a problem extracting
   --    the values, then each value is set to 'First, and Success is
   --    set to False.
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure GetValidity (TheCert   : in     CertTypes.RawCertificateT;
                          CertType  : in     CommonTypes.Unsigned32T;
                          Validity  :    out ValidityT;
                          Success   :    out Boolean)
   is
   begin
      if CertType = IDCertType then
         declare
            TheDict : MsgProc.DictionaryT :=
                         MsgProc.GetDictionaryByKey(
                                    Dic => MsgProc.DictionaryT(TheCert),
                                    Key => "Validity");
         begin
            ExtractValidity(TheDict, Validity, Success);
         end;
      else
         declare
            TheDict : MsgProc.DictionaryT :=
                         MsgProc.GetDictionaryByKey(
                                    Dic => MsgProc.DictionaryT(TheCert),
                                    Key => "AttCertValidity");
         begin
            ExtractValidity(TheDict, Validity, Success);
         end;
      end if;
   exception
      when E : others =>
         Success := False;
         Validity := (NotBefore => (Minute => 0,
                                    Hour   => 0,
                                    Day    => 1,
                                    Month  => 1,
                                    Year   => 1901),
                      NotAfter  => (Minute => 0,
                                    Hour   => 0,
                                    Day    => 1,
                                    Month  => 1,
                                    Year   => 1901));
   end GetValidity;


   ------------------------------------------------------------------
   -- GetKeyInfo
   --
   -- Description:
   --    Attempts to extract the Certificate's SubjectPublicKeyInfo
   --    field.
   --    If there is a problem extracting the values, then 'First values
   --    are returned, and Success is set to False.
   --    If the KeyLength field is not in range, then Success is set
   --    to False.
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure GetKeyInfo (TheCert : in     CertTypes.RawCertificateT;
                         TheKey  :    out PublicKeyInfoT;
                         Success :    out Boolean)
   is
      KeyDict : MsgProc.DictionaryT :=
                      MsgProc.GetDictionaryByKey(
                              Dic => MsgProc.DictionaryT(TheCert),
                              Key => "SubjectPublicKeyInfo");
   begin
      TheKey.AlgorithmID := CryptoTypes.AlgorithmT'Value(
                               MsgProc.GetStringByKey(
                                  Dic => KeyDict,
                                  Key => "AlgoRithmID"));
      TheKey.KeyLength   := CommonTypes.Unsigned32T'Value(
                               MsgProc.GetStringByKey(
                                  Dic => KeyDict,
                                  Key => "KeyLength"));
      TheKey.KeyID       := CommonTypes.Unsigned32T'Value(
                               MsgProc.GetStringByKey(
                                  Dic => KeyDict,
                                  Key => "KeyID"));
      if TheKey.KeyLength <= 128 then
         Success := True;
      else
         Success := False;
         TheKey.KeyLength := CommonTypes.Unsigned32T'First;
      end if;
   exception
      when E : others =>
         Success := False;
         TheKey := (AlgorithmID => CryptoTypes.AlgorithmT'First,
                    KeyLength   => CommonTypes.Unsigned32T'First,
                    KeyID       => CommonTypes.Unsigned32T'First);
   end GetKeyInfo;


   ------------------------------------------------------------------
   -- GetPrivilege
   --
   -- Description:
   --    Attempts to extract the Certificate's Privilege
   --    field.
   --    If there is a problem extracting the values, then 'First values
   --    are returned, and Success is set to False.
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure GetPrivilege(TheCert : in     CertTypes.RawCertificateT;
                          ThePriv :    out PrivilegeT;
                          Success :    out Boolean)
   is
      PrivDict : MsgProc.DictionaryT :=
                    MsgProc.GetDictionaryByKey(
                            Dic => MsgProc.DictionaryT(TheCert),
                            Key => "Privilege");
   begin
      ThePriv.Role  := RoleFrom(
                          RoleValues'Value(
                             MsgProc.GetStringByKey(
                                Dic => PrivDict,
                                Key => "Role")));
      ThePriv.Class := ClassFrom(
                          ClassValues'Value(
                             MsgProc.GetStringByKey(
                                Dic => PrivDict,
                                Key => "Class")));
      Success := True;
   exception
      when E : others =>
         ThePriv := (PrivTypes.PrivilegeT'First,
                     PrivTypes.ClassT'First);
         Success := False;
   end GetPrivilege;


   ------------------------------------------------------------------
   -- GetPrivilege
   --
   -- Description:
   --    Attempts to extract the Certificate's Fingerprint Template
   --    field.
   --    If there is a problem extracting the values, then 'First values
   --    are returned, and Success is set to False.
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure GetTemplate(TheCert  : in     CertTypes.RawCertificateT;
                         Template :    out IandATypes.TemplateT;
                         Success  :    out Boolean)
   is
      TemplateDict : MsgProc.DictionaryT :=
                        MsgProc.GetDictionaryByKey(
                              Dic => MsgProc.DictionaryT(TheCert),
                              Key => "Template");
   begin

      Template.ID  := Ada.Strings.Fixed.Overwrite(
                          IandATypes.TemplateIDT'(others => ' '),
                          1,
                          MsgProc.GetStringByKey(
                             Dic => TemplateDict,
                             Key => "TemplateID"));
      Template.Length := CommonTypes.Unsigned32T'Value(
                          MsgProc.GetStringByKey(
                             Dic => TemplateDict,
                             Key => "TemplateLength"));
      Template.RequiredMaxFAR := IandATypes.FarT'Value(
                                    MsgProc.GetStringByKey(
                                       Dic => TemplateDict,
                                       Key => "RequiredMaxFAR"));
      Success := True;
   exception
      when E : others =>
         Template := IandATypes.NullTemplate;
         Success := False;
   end GetTemplate;


   ------------------------------------------------------------------
   -- OverwriteDigestID
   --
   -- Description:
   --    Overwrites the DigestID in the Crypto string with NewID.
   --    If there is a problem, then the Crypto string remains
   --    unchanged.
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure OverwriteDigestID(Crypto : in out String;
                               NewID  : in     CommonTypes.Unsigned32T)
   is
      LocalCrypto : String := Crypto;
      DigestIDKeyEnd,
      DigestIDStart,
      DigestIDEnd : Natural := 0;
   begin
      -- Delete the old DigestID
      DigestIDKeyEnd := Ada.Strings.Fixed.Index(LocalCrypto,
                                                  "DigestID") +
                        9;
      for i in DigestIDKeyEnd..LocalCrypto'Length loop
         if LocalCrypto(i) = ''' then
            if DigestIDStart = 0 then
               DigestIDStart := i + 1;
            else
               DigestIDEnd := i - 1;
               exit;
            end if;
         end if;
      end loop;

      Ada.Strings.Fixed.Delete(LocalCrypto,
                               DigestIDStart,
                               DigestIDEnd);

      -- and insert 'NewID'
      Ada.Strings.Fixed.Insert(LocalCrypto,
                               DigestIDStart,
                               MsgProc.StringFrom32(NewID));
      Crypto := LocalCrypto;
   exception
      when E : others =>
         Null;
   end OverwriteDigestID;


   ------------------------------------------------------------------
   -- ExtractCryptoControlData
   --
   -- Description:
   --    Attempts to extract the Certificate's Fictional Crypto Control
   --    Data, and overwrites the DigestID with 0.
   --    If there is a problem extracting the values, then null
   --    values are returned.
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure ExtractCryptoControlData(ThePrivCert : CertTypes.RawCertificateT)
   is
      CryptoDict : MsgProc.DictionaryT :=
                      MsgProc.GetDictionaryByKey(
                              Dic => MsgProc.DictionaryT(ThePrivCert),
                              Key => "CryptoControlData");
   begin
      CryptoControlData := Ada.Strings.Fixed.Overwrite(
                                 NullCryptoControl,
                                 1,
                                 String(CryptoDict));

      OverwriteDigestID(CryptoControlData, 0);

   exception
      when E : others =>
         CryptoControlData := NullCryptoControl;
   end ExtractCryptoControlData;


   ------------------------------------------------------------------
   -- Exported Subprograms
   ------------------------------------------------------------------
   ------------------------------------------------------------------
   -- ExtractIDCertData
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------

   procedure ExtractIDCertData(
                   RawIDCert      : in     CertTypes.RawCertificateT;
                   IDCert         :    out IDCertDataT;
                   ExtractSuccess :    out Boolean
                   )
   is
      LengthOK,
      TypeOK,
      SerialOK,
      AlgOK,
      IssuerOK,
      ValidityOK,
      SubjectOK,
      KeyOK      : Boolean;

      TheCertType     : CommonTypes.Unsigned32T;
      TheSerialNumber : CommonTypes.Unsigned32T;
      TheSigAlgId     : CryptoTypes.AlgorithmT;
      TheIssuer       : CryptoTypes.IssuerT;
      TheValidity     : ValidityT;
      TheSubject      : CryptoTypes.IssuerT;
      TheSubjectPublicKey : PublicKeyInfoT;

   begin
      CheckCertLength(RawIDCert, LengthOK);
      GetCertType (RawIDCert, IDCertType, TheCertType, TypeOK);
      GetSerialNumber (RawIDCert, IDCertType, TheSerialNumber, SerialOK);
      GetSigAlgID (RawIDCert, TheSigAlgID, AlgOK);
      GetName (RawIDCert, IDCertType, False, TheIssuer, IssuerOK);
      GetValidity (RawIDCert, IDCertType, TheValidity, ValidityOK);
      GetName (RawIDCert, IDCertType, True, TheSubject, SubjectOK);
      GetKeyInfo (RawIDCert, TheSubjectPublicKey, KeyOK);

      IDCert := (CertType     => TheCertType,
                 SerialNumber => TheSerialNumber,
                 SigAlgId     => TheSigAlgID,
                 Issuer       => TheIssuer,
                 Validity     => TheValidity,
                 Subject      => TheSubject,
                 SubjectPublicKeyInfo => TheSubjectPublicKey);

      ExtractSuccess := LengthOK and
                        TypeOK and
                        SerialOK and
                        AlgOK and
                        IssuerOK and
                        ValidityOK and
                        SubjectOK and
                        KeyOK;
   end ExtractIDCertData;


   ------------------------------------------------------------------
   -- ExtractPrivCertData
   --
   -- Description:
   --    Takes the raw certificate data extracted from the user's token, and
   --    converts into the correct (Priv) certificate structure.
   --
   ------------------------------------------------------------------

   procedure ExtractPrivCertData(
                   RawPrivCert    : in     CertTypes.RawCertificateT;
                   PrivCert       :    out PrivCertDataT;
                   ExtractSuccess :    out Boolean
                   )
   is
      LengthOK,
      TypeOK,
      SerialOK,
      AlgOK,
      IssuerOK,
      ValidityOK,
      HolderOK,
      PrivilegeOK     : Boolean;

      TheCertType     : CommonTypes.Unsigned32T;
      TheSerialNumber : CommonTypes.Unsigned32T;
      TheSigAlgId     : CryptoTypes.AlgorithmT;
      TheIssuer       : CryptoTypes.IssuerT;
      TheValidity     : ValidityT;
      TheHolder       : CertTypes.IDT;
      ThePrivilege    : PrivilegeT;

   begin

      CheckCertLength(RawPrivCert, LengthOK);
      GetCertType (RawPrivCert, PrivCertType, TheCertType, TypeOK);
      GetSerialNumber (RawPrivCert, PrivCertType, TheSerialNumber, SerialOK);
      GetSigAlgID (RawPrivCert, TheSigAlgID, AlgOK);
      GetName (RawPrivCert, PrivCertType, False, TheIssuer, IssuerOK);
      GetValidity (RawPrivCert, PrivCertType, TheValidity, ValidityOK);
      GetHolder (RawPrivCert, TheHolder, HolderOK);
      GetPrivilege (RawPrivCert, ThePrivilege, PrivilegeOK);

      PrivCert := (CertType        => TheCertType,
                   SerialNumber    => TheSerialNumber,
                   SigAlgId        => TheSigAlgID,
                   Issuer          => TheIssuer,
                   AttCertValidity => TheValidity,
                   Holder          => TheHolder,
                   Privilege       => ThePrivilege);

      ExtractSuccess := LengthOK and
                        TypeOK and
                        SerialOK and
                        AlgOK and
                        IssuerOK and
                        ValidityOK and
                        HolderOK and
                        PrivilegeOK;

      -- Now we need to extract the CryptoControl data, to insert
      -- into the next created auth cert.
      ExtractCryptoControlData(RawPrivCert);

   end ExtractPrivCertData;


   ------------------------------------------------------------------
   -- ExtractIACertData
   --
   -- Description:
   --    Takes the raw certificate data extracted from the user's token, and
   --    converts into the correct (I&A) certificate structure.
   --
   ------------------------------------------------------------------

   procedure ExtractIACertData(
                   RawIACert      : in     CertTypes.RawCertificateT;
                   IACert         :    out IACertDataT;
                   ExtractSuccess :    out Boolean
                   )
   is
      LengthOK,
      TypeOK,
      SerialOK,
      AlgOK,
      IssuerOK,
      ValidityOK,
      HolderOK,
      TemplateOK     : Boolean;

      TheCertType     : CommonTypes.Unsigned32T;
      TheSerialNumber : CommonTypes.Unsigned32T;
      TheSigAlgId     : CryptoTypes.AlgorithmT;
      TheIssuer       : CryptoTypes.IssuerT;
      TheValidity     : ValidityT;
      TheHolder       : CertTypes.IDT;
      TheTemplate     : IandATypes.TemplateT;

   begin
      CheckCertLength(RawIACert, LengthOK);
      GetCertType (RawIACert, IACertType, TheCertType, TypeOK);
      GetSerialNumber (RawIACert, IACertType, TheSerialNumber, SerialOK);
      GetSigAlgID (RawIACert, TheSigAlgID, AlgOK);
      GetName (RawIACert, IACertType, False, TheIssuer, IssuerOK);
      GetValidity (RawIACert, IACertType, TheValidity, ValidityOK);
      GetHolder (RawIACert, TheHolder, HolderOK);
      GetTemplate (RawIACert, TheTemplate, TemplateOK);

      IACert := (CertType        => TheCertType,
                 SerialNumber    => TheSerialNumber,
                 SigAlgId        => TheSigAlgID,
                 Issuer          => TheIssuer,
                 AttCertValidity => TheValidity,
                 Holder          => TheHolder,
                 Template        => TheTemplate);

      ExtractSuccess := LengthOK and
                        TypeOK and
                        SerialOK and
                        AlgOK and
                        IssuerOK and
                        ValidityOK and
                        HolderOK and
                        TemplateOK;
   end ExtractIACertData;


   ------------------------------------------------------------------
   -- ExtractAuthCertData
   --
   -- Description:
   --    Takes the raw certificate data extracted from the user's token, and
   --    converts into the correct (Auth) certificate structure.
   --
   ------------------------------------------------------------------

   procedure ExtractAuthCertData(
                   RawAuthCert    : in     CertTypes.RawCertificateT;
                   AuthCert       :    out AuthCertDataT;
                   ExtractSuccess :    out Boolean
                   )
   is
      LengthOK,
      TypeOK,
      SerialOK,
      AlgOK,
      IssuerOK,
      ValidityOK,
      HolderOK,
      PrivilegeOK     : Boolean;

      TheCertType     : CommonTypes.Unsigned32T;
      TheSerialNumber : CommonTypes.Unsigned32T;
      TheSigAlgId     : CryptoTypes.AlgorithmT;
      TheIssuer       : CryptoTypes.IssuerT;
      TheValidity     : ValidityT;
      TheHolder       : CertTypes.IDT;
      ThePrivilege    : PrivilegeT;

   begin
      CheckCertLength(RawAuthCert, LengthOK);
      GetCertType (RawAuthCert, AuthCertType, TheCertType, TypeOK);
      GetSerialNumber (RawAuthCert, AuthCertType, TheSerialNumber, SerialOK);
      GetSigAlgID (RawAuthCert, TheSigAlgID, AlgOK);
      GetName (RawAuthCert, AuthCertType, False, TheIssuer, IssuerOK);
      GetValidity (RawAuthCert, AuthCertType, TheValidity, ValidityOK);
      GetHolder (RawAuthCert, TheHolder, HolderOK);
      GetPrivilege (RawAuthCert, ThePrivilege, PrivilegeOK);

      AuthCert := (CertType        => TheCertType,
                   SerialNumber    => TheSerialNumber,
                   SigAlgId        => TheSigAlgID,
                   Issuer          => TheIssuer,
                   AttCertValidity => TheValidity,
                   Holder          => TheHolder,
                   Privilege       => ThePrivilege);

      ExtractSuccess := LengthOK and
                        TypeOK and
                        SerialOK and
                        AlgOK and
                        IssuerOK and
                        ValidityOK and
                        HolderOK and
                        PrivilegeOK;

   end ExtractAuthCertData;



   ------------------------------------------------------------------
   -- ObtainRawData
   --
   -- Implementation Notes:
   --    Raw Data is determined by removing the SignatureData from
   --    the CertData dictionary.
   --    The signature may be anywhere in the certificate(!), so need
   --    to find the signature, and delete this along with its key.
   --    If the SignatureData is not found, then return the whole certificate
   --    (it may not have been signed).
   --
   ------------------------------------------------------------------

   procedure ObtainRawData(
                   RawCert       : in     CertTypes.RawCertificateT;
                   RawData       :    out CertTypes.RawDataT;
                   ObtainSuccess :    out Boolean
                   )
   is
      -- Without enclosing braces...
      SigDict      : MsgProc.DictionaryT :=
                        MsgProc.GetDictionaryByKey(
                            Dic => MsgProc.DictionaryT(RawCert),
                            Key => "SignatureData");
      SigDictStart,
      SigKeyStart  : Integer := 0;
      CertData     : MsgProc.DictionaryT :=
                        MsgProc.GetDictionaryByKey(
                            Dic => MsgProc.DictionaryT(RawCert),
                            Key => "CertDataT");

   begin
      SigDictStart := Ada.Strings.Fixed.Index(String(CertData),
                                              String(SigDict));

      SigKeyStart := Ada.Strings.Fixed.Index(String(CertData),
                                             "'SignatureData'");

      if SigKeyStart /= 0 and SigDictStart /= 0 then
         Ada.Strings.Fixed.Delete(String(CertData),
                                  -- From 'SignatureData': ...
                                  SigKeyStart,
                                  -- ... to the enclosing }
                                  SigDictStart + SigDict'Length);
      end if;

      -- If signature data not found, return all of CertData
      RawData.RawData := Ada.Strings.Fixed.Overwrite(
                                CertTypes.NullRawCertificate,
                                1,
                                String(CertData));

      RawData.DataLength := Ada.Strings.Fixed.Trim(
                                      RawData.RawData,
                                      Ada.Strings.Right)'Length;
      ObtainSuccess := True;
   exception
      when E : others =>
         -- return whole certificate
         ObtainSuccess := True;
         RawData := (RawCert,
                     Ada.Strings.Fixed.Trim(
                            RawCert,
                            Ada.Strings.Right)'Length);
   end ObtainRawData;


   ------------------------------------------------------------------
   -- ObtainSignatureData
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------

   procedure ObtainSignatureData(
                   RawCert       : in     CertTypes.RawCertificateT;
                   SignatureData :    out CertTypes.SignatureT;
                   ObtainSuccess :    out Boolean
                   )
   is
      SigDict : MsgProc.DictionaryT :=
                   MsgProc.GetDictionaryByKey(
                            Dic => MsgProc.DictionaryT(RawCert),
                            Key => "SignatureData");
   begin
      SignatureData := (SigData   => (others => ' '),
                        SigLength => CertTypes.SigDataI'First);

      if SigDict'Length /= 0 then
         Ada.Strings.Fixed.Overwrite(SignatureData.SigData,
                                     1,
                                     String(SigDict));
         if SigDict'Length <= CertTypes.SigDataI'Last then
            SignatureData.SigLength := SigDict'Length;
         else
            SignatureData.SigLength := CertTypes.SigDataI'Last;
         end if;
         ObtainSuccess := True;
      else
         ObtainSuccess := False;
      end if;
   end ObtainSignatureData;



   ------------------------------------------------------------------
   -- ConstructAuthCert
   --
   -- Implementation Notes:
   --    Adds the fictional Crypto dictionary (copied from the Priv Cert)
   --
   ------------------------------------------------------------------

   procedure ConstructAuthCert(
                   AuthCert            : in     AuthCertDataT;
                   UnsignedRawAuthCert :    out CertTypes.RawCertificateT
                   )
   is
      CertTypeString : String :=
                          "'CertType': '" &
                          MsgProc.StringFrom32(AuthCert.CertType) &
                          "', ";
      SerialNoString : String :=
                          "'SerialNumber': '" &
                          MsgProc.StringFrom32(AuthCert.SerialNumber) &
                          "', ";
      SigAlgIDString : String :=
                          "'SigAlgID': '" &
                          CryptoTypes.AlgorithmT'Image(AuthCert.SigAlgID) &
                          "', ";
      IssuerString   : String :=
                          "'Issuer': {'Text': '" &
                          AuthCert.Issuer.Name(1..AuthCert.Issuer.NameLength) &
                          "', 'ID': '" &
                          MsgProc.StringFrom32(CommonTypes.Unsigned32T(AuthCert.Issuer.ID)) &
                          "', 'TextLength': '" &
                          MsgProc.StringFromInt(AuthCert.Issuer.NameLength) &
                          "'}, ";
      ValidityString : String :=
                          "'AttCertValidity': {'NotBefore': {'Minute': '" &
                          MsgProc.StringFrom32(
                             AuthCert.AttCertValidity.NotBefore.Minute) &
                          "', 'Hour': '" &
                          MsgProc.StringFrom32(
                             AuthCert.AttCertValidity.NotBefore.Hour) &
                          "', 'Day': '" &
                          MsgProc.StringFrom32(
                             AuthCert.AttCertValidity.NotBefore.Day) &
                          "', 'Month': '" &
                          MsgProc.StringFrom32(
                             AuthCert.AttCertValidity.NotBefore.Month) &
                          "', 'Year': '" &
                          MsgProc.StringFrom32(
                             AuthCert.AttCertValidity.NotBefore.Year) &
                          "'}, 'NotAfter': {'Minute': '" &
                          MsgProc.StringFrom32(
                             AuthCert.AttCertValidity.NotAfter.Minute) &
                          "', 'Hour': '" &
                          MsgProc.StringFrom32(
                             AuthCert.AttCertValidity.NotAfter.Hour) &
                          "', 'Day': '" &
                          MsgProc.StringFrom32(
                             AuthCert.AttCertValidity.NotAfter.Day) &
                          "', 'Month': '" &
                          MsgProc.StringFrom32(
                             AuthCert.AttCertValidity.NotAfter.Month) &
                          "', 'Year': '" &
                          MsgProc.StringFrom32(
                             AuthCert.AttCertValidity.NotAfter.Year) &
                          "'}}, ";
      HolderString   : String :=
                          "'Holder': {'SerialNumber': '" &
                          MsgProc.StringFrom32(CommonTypes.Unsigned32T(
                             AuthCert.Holder.SerialNumber)) &
                          "', 'Issuer': {'Text': '" &
                          AuthCert.Holder.Issuer.Name(
                                    1..AuthCert.Holder.Issuer.NameLength) &
                          "', 'ID': '" &
                          MsgProc.StringFrom32(CommonTypes.Unsigned32T(
                                    AuthCert.Holder.Issuer.ID)) &
                          "', 'TextLength': '" &
                          MsgProc.StringFromInt(AuthCert.Holder.Issuer.NameLength) &
                          "'}}, ";
      PriviString    : String :=
                          "'Privilege': {'Pad': '??????????', 'Role': '" &
                          MsgProc.StringFrom32(CommonTypes.Unsigned32T(
                            RoleTo(AuthCert.Privilege.Role))) &
                          "', 'Class': '" &
                          MsgProc.StringFrom32(CommonTypes.Unsigned32T(
                            ClassTo(AuthCert.Privilege.Class))) &
                          "'}, ";
      CryptoString   : String :=
                          "'CryptoControlData': {" &
                          Ada.Strings.Fixed.Trim(CryptoControlData, Ada.Strings.
                          Both) &
                          "}, ";
      SigString      : String :=
                          "'SignatureData': {}";

      TheAuthData    : String :=
                          CertTypeString &
                          SerialNoString &
                          SigAlgIDString &
                          IssuerSTring   &
                          ValidityString &
                          HolderString   &
                          PriviString    &
                          CryptoString   &
                          SigString;

      -- Include braces in length, so add 2
      TheAuthLength  : String :=
                          "'CertLength': '" &
                          MsgProc.StringFromInt(TheAuthData'Length + 2) &
                          "', ";

      TheAuthString  : String :=
                          TheAuthLength &
                          "'CertDataT': {" &
                          TheAuthData &
                          "}";


   begin
      UnsignedRawAuthCert := Ada.Strings.Fixed.Overwrite(
                                  CertTypes.NullRawCertificate,
                                  1,
                                  TheAuthString);
   end ConstructAuthCert;



   ------------------------------------------------------------------
   -- AddAuthSignature
   --
   -- Implementation Notes:
   --    Adds the SignatureData to the empty dictionary created in
   --    ConstructAuthCert.
   --    Digest ID in SignatureData is the 'correct' ID - i.e. the ID created
   --    from digesting the unsigned cert. This needs to overwrite the
   --    DigestID in the fictional Crypto dictionary.
   --
   ------------------------------------------------------------------

   procedure AddAuthSignature(
                   UnsignedRawAuthCert : in     CertTypes.RawCertificateT;
                   SignatureData       : in     CertTypes.SignatureT;
                   SignedRawAuthCert   :    out CertTypes.RawCertificateT)
   is
      NewID : CommonTypes.Unsigned32T;

      SigDataString  : String := SignatureData.SigData(
                                    1..SignatureData.SigLength);
      SigDictStart   : Natural;

      CertLengthKey  : String := "'CertLength':";

      LengthKeyStart : Natural;
      LengthValStart,
      LengthValEnd   : Natural := 0;

   begin
      SignedRawAuthCert := UnsignedRawAuthCert;

      -- Attempt to replace the old DigestID with the new one
      begin
         NewID := CommonTypes.Unsigned32T'Value(
                     MsgProc.GetStringByKey(
                        MsgProc.DictionaryT(SigDataString),
                        "DigestID"));
         OverwriteDigestID(SignedRawAuthCert, NewID);
      exception
         when E : others =>
            Null;
      end;

      -- Find and overwrite the blank signature
      SigDictStart := Ada.Strings.Fixed.Index(SignedRawAuthCert, "{}");

      if SigDictStart /= 0 then
         Ada.Strings.Fixed.Insert(SignedRawAuthCert,
                                  SigDictStart + 1,
                                  SigDataString,
                                  Ada.Strings.Right);
      end if; -- else would only occur if UnsignedRawAuthCert is
              -- not that contructed by ConstructAuthCert

      -- Determine the new CertLength, and overwrite old one
      declare
         TheCertData  : MsgProc.DictionaryT :=
                           MsgProc.GetDictionaryByKey(
                              MsgProc.DictionaryT(SignedRawAuthCert),
                              "CertDataT");

      begin
         LengthKeyStart := Ada.Strings.Fixed.Index(SignedRawAuthCert,
                                                   CertLengthKey);

         for i in CertTypes.RawCertificateI range
            LengthKeyStart + CertLengthKey'Length-1 .. CertTypes.RawCertificateI'Last loop
            if SignedRawAuthCert(i) = ''' then
               if LengthValStart = 0 then
                  LengthValStart := i + 1;
               else
                  LengthValEnd := i - 1;
                  exit;
               end if;
            end if;
         end loop;

         -- Include braces in length, so add 2
         Ada.Strings.Fixed.Replace_Slice(SignedRawAuthCert,
                                        LengthValStart,
                                        LengthValEnd,
                                        MsgProc.StringFromInt(TheCertData'Length + 2),
                                        Ada.Strings.Right);
      end;

   end AddAuthSignature;

end CertProc;