
------------------------------------------------------------------
-- 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.
------------------------------------------------------------------

------------------------------------------------------------------
-- TokenAPI
--
-- Implementation Notes:
--    None.
--
------------------------------------------------------------------
with TcpIp,
     CommonTypes,
     MsgProc,
     Ada.Strings.Fixed,
     Ada.Strings;
with Unchecked_Conversion;

use type CommonTypes.Unsigned32T;

package body TokenAPI is


   PraxisCards : Boolean := False;

   ------------------------------------------------------------------
   -- Local subprograms
   ------------------------------------------------------------------
   ------------------------------------------------------------------
   -- ReaderTo32, CardTo32, CodeTo32
   --
   -- Description:
   --    Converts the enumerated type to a 32-bit unsigned value
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   function ReaderTo32 is new
      Unchecked_Conversion (Source => ReaderStateT,
                            Target => CommonTypes.Unsigned32T);

   function CardTo32 is new
      Unchecked_Conversion (Source => CardStateT,
                            Target => CommonTypes.Unsigned32T);

   function CodeTo32 is new
      Unchecked_Conversion (Source => ResponseCodeT,
                            Target => CommonTypes.Unsigned32T);


   ------------------------------------------------------------------
   -- GetStringHandle
   --
   -- Description:
   --    turns the handle into a string, prepends with a
   --    'p' if it is a praxis card. PXS cards are always 2 digits.
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   function GetStringHandle(CardHandle   : in     CommonTypes.Unsigned32T)
     return String
   is
       StringHandle : String := Ada.Strings.Fixed.Trim(
                                   CommonTypes.Unsigned32T'Image(
                                      CardHandle), Ada.Strings.Both);

      PStringHandle : String(1..3) := "p00";
   begin
      if PraxisCards then
         PStringHandle(PStringHandle'Last - StringHandle'Length + 1
                       ..PStringHandle'Last) := StringHandle;
         return PStringHandle;
      else
         return StringHandle;
      end if;

   end GetStringHandle;

   ------------------------------------------------------------------
   -- Exported subprograms
   ------------------------------------------------------------------
   ------------------------------------------------------------------
   -- ListReaders
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure ListReaders (List         :    out CommonTypes.String8ArrayT;
                          Number       : in out CommonTypes.Unsigned32T;
                          ResponseCode :    out CommonTypes.Unsigned32T)
   is
      InMsg     : TcpIp.MessageT;
      CommsIsOK : Boolean;
      OutMsg    : constant TcpIp.MessageT :=
                 (Data   => Ada.Strings.Fixed.Overwrite(
                                  Source   => TcpIp.NullMsg.Data,
                                  Position => 1,
                                  New_Item =>
                                       "tokenReader.listReaders('" &
                                       CommonTypes.Unsigned32T'Image(Number) &
                                       "',)"),
                  Length => 28 +
                            CommonTypes.Unsigned32T'Image(Number)'Length);


   begin
      List := (others => (others => ' '));

      TcpIp.SendAndReceive (IsAdmin  => False,
                            Outgoing => OutMsg,
                            Incoming => InMsg,
                            Success  => CommsIsOK);

      if CommsIsOK then
         -- InMsg.Data is ('OK[:..]', 'No', ('Name1', 'Name2', ..))
         declare Msg : String :=
                    MsgProc.GetResponseFromMsg(InMsg);

         begin

            Number := CommonTypes.Unsigned32T'Value(
                         MsgProc.GetStringByPos(Msg => Msg,
                                                Arg => 1));
            for i in CommonTypes.String8ArrayI'Range loop
               Ada.Strings.Fixed.Overwrite(List(i),
                                          1,
                                          MsgProc.GetStringByPos(Msg => Msg,
                                                                 Arg => i + 1));
               exit when i = CommonTypes.String8ArrayI(Number);
            end loop;

         end;
         ResponseCode := CodeTo32(Success);

      else
         -- Comms Fail - readers unavailable.
         Number := 0;
         ResponseCode := CodeTo32(ReaderUnavailable);
      end if;
   exception

      when E : others =>

         -- Exception - function cancelled
         Number := 0;
         ResponseCode := CodeTo32(Cancelled);

   end ListReaders;


   ------------------------------------------------------------------
   -- GetStatusChange
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure GetStatusChange (Timeout      : in     CommonTypes.Unsigned32T;
                              Reader       : in     CommonTypes.String8T;
                              CurrentState : in     ReaderStateT;
                              NewState     :    out CommonTypes.Unsigned32T;
                              ResponseCode :    out CommonTypes.Unsigned32T)
   is
      InMsg     : TcpIp.MessageT;
      CommsIsOK : Boolean;
      TrimReader : String := Ada.Strings.Fixed.Trim(Reader, Ada.Strings.Both);

      OutMsg : constant TcpIp.MessageT :=
                 (Data   => Ada.Strings.Fixed.Overwrite(
                                  Source   => TcpIp.NullMsg.Data,
                                  Position => 1,
                                  New_Item => "tokenReader.getState('" &
                                              TrimReader & "',)"),
                  Length => 25 + TrimReader'Length);

      NewStateEnum : ReaderStateT;

   begin
      TcpIp.SendAndReceive (IsAdmin  => False,
                            Outgoing => OutMsg,
                            Incoming => InMsg,
                            Success  => CommsIsOK);

      if CommsIsOK then
         -- InMsg.Data is ('OK[:..]', {Dict})
         declare Msg : String :=
                    MsgProc.GetResponseFromMsg(InMsg);
                 StateDict : MsgProc.DictionaryT :=
                                MsgProc.GetDictionary(Msg => Msg,
                                                      Arg => 1);

         begin

            NewStateEnum := ReaderStateT'Value(MsgProc.GetStringByKey(
                                                   Dic => StateDict,
                                                   Key => "rState"));
            NewState := ReaderTo32(NewStateEnum);

            if NewStateEnum = CurrentState then
               ResponseCode := CodeTo32(TimedOut);
            else
               ResponseCode := CodeTo32(Success);
            end if;

         end;

      else
         -- Comms Fail - reader unavailable.
         NewState := ReaderTo32(Unavailable);
         ResponseCode := CodeTo32(ReaderUnavailable);
      end if;

   exception

      when E : others =>

         -- Exception - function cancelled, NewState set to an invalid value
         NewState := 0;
         ResponseCode := CodeTo32(Cancelled);

   end GetStatusChange;


   ------------------------------------------------------------------
   -- Connect
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------
   procedure Connect (Reader       : in     CommonTypes.String8T;
                      CardHandle   :    out CommonTypes.Unsigned32T;
                      ResponseCode :    out CommonTypes.Unsigned32T)
   is
      InMsg     : TcpIp.MessageT;
      CommsIsOK : Boolean;
      TrimReader : String := Ada.Strings.Fixed.Trim(Reader, Ada.Strings.Both);

      OutMsg : constant TcpIp.MessageT :=
                 (Data   => Ada.Strings.Fixed.Overwrite(
                                  Source   => TcpIp.NullMsg.Data,
                                  Position => 1,
                                  New_Item => "tokenReader.connect('" &
                                              TrimReader & "',)"),
                  Length => 24 + TrimReader'Length);

   begin
      TcpIp.SendAndReceive (IsAdmin  => False,
                            Outgoing => OutMsg,
                            Incoming => InMsg,
                            Success  => CommsIsOK);

      if CommsIsOK then
         -- InMsg.Data is ('OK[:..]', 'Hndle')
         declare
            Msg : String :=
                    MsgProc.GetResponseFromMsg(InMsg);
            HandleStr : String := MsgProc.GetStringByPos(Msg => Msg,
                                                         Arg => 1);

         begin
            if HandleStr(HandleStr'First) = 'p' then
               PraxisCards := True;
               CardHandle := CommonTypes.Unsigned32T'Value(HandleStr(2..3));
            else
               PraxisCards := False;
               CardHandle := CommonTypes.Unsigned32T'Value(HandleStr);
            end if;

         end;

         ResponseCode := CodeTo32(Success);

      else
         -- Comms Fail - card unresponsive.
         CardHandle := 0;
         ResponseCode := CodeTo32(UnresponsiveCard);
      end if;
   exception

      when E : others =>

         -- Exception - function cancelled
         CardHandle := 0;
         ResponseCode := CodeTo32(Cancelled);

   end Connect;


   ------------------------------------------------------------------
   -- Status
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------

   procedure Status (CardHandle   : in     CommonTypes.Unsigned32T;
                     CState       :    out CommonTypes.Unsigned32T;
                     ATR          :    out AnswerToResetT;
                     ResponseCode :    out CommonTypes.Unsigned32T)
   is
      InMsg     : TcpIp.MessageT;
      CommsIsOK : Boolean;
      OutMsg : TcpIp.MessageT;

      NullATR : constant AnswerToResetT := (TokenID => 0,
                                            Padding => (others => 0));

      StringHandle : String := GetStringHandle(CardHandle);

   begin
      ATR := NullATR;

      OutMsg := (Data   => Ada.Strings.Fixed.Overwrite(
                                  Source   => TcpIp.NullMsg.Data,
                                  Position => 1,
                                  New_Item => "tokenReader.status('" &
                                              StringHandle & "',)"),
                  Length => 23 + StringHandle'Length);

      TcpIp.SendAndReceive (IsAdmin  => False,
                            Outgoing => OutMsg,
                            Incoming => InMsg,
                            Success  => CommsIsOK);

      if CommsIsOK then
         -- InMsg.Data is ('OK[:..]', 'Cstate', 'TokenID')
         declare Msg : String :=
                    MsgProc.GetResponseFromMsg(InMsg);

         begin

            CState := CardTo32(
                         CardStateT'Value(
                            MsgProc.GetStringByPos(Msg => Msg,
                                                   Arg => 1)));

            begin
               ATR.TokenID := CommonTypes.Unsigned32T'Value(
                                       MsgProc.GetStringByPos(Msg => Msg,
                                                              Arg => 2));
            exception
               when E : others =>
                  null;
            end;

         end;

         ResponseCode := CodeTo32(Success);

      else
         -- Comms Fail - card unresponsive.
         CState := CardTo32(Present);
         ResponseCode := CodeTo32(UnresponsiveCard);
      end if;
   exception

      when E : others =>

         -- Exception - function cancelled
         CState := CardTo32(Present);
         ResponseCode := CodeTo32(Cancelled);

   end Status;


   ------------------------------------------------------------------
   -- Disconnect
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------

   procedure Disconnect (CardHandle   : in     CommonTypes.Unsigned32T;
                         ResponseCode :    out CommonTypes.Unsigned32T)
   is
      InMsg     : TcpIp.MessageT;
      CommsIsOK : Boolean;
      StringHandle : String := GetStringHandle(CardHandle);

      OutMsg : TcpIp.MessageT;

   begin
      OutMsg := (Data   => Ada.Strings.Fixed.Overwrite(
                                  Source   => TcpIp.NullMsg.Data,
                                  Position => 1,
                                  New_Item => "tokenReader.disconnect('" &
                                              StringHandle & "',)"),
                  Length => 27 + StringHandle'Length);

      TcpIp.SendAndReceive (IsAdmin  => False,
                            Outgoing => OutMsg,
                            Incoming => InMsg,
                            Success  => CommsIsOK);

      if CommsIsOK then
         -- InMsg.Data is ('OK[:..]', )
         ResponseCode := CodeTo32(Success);

      else
         -- Comms Fail - unresponsive card.
         ResponseCode := CodeTo32(UnresponsiveCard);
      end if;
   exception

      when E : others =>

         -- Exception - function cancelled
         ResponseCode := CodeTo32(Cancelled);

   end Disconnect;


   ------------------------------------------------------------------
   -- GetIDCert
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------

   procedure GetIDCert (CardHandle   : in     CommonTypes.Unsigned32T;
                        RawIDCert    :    out GenericRawCertT;
                        StatusOK     :    out Boolean;
                        ResponseCode :    out CommonTypes.Unsigned32T)
   is
      InMsg     : TcpIp.MessageT;
      CommsIsOK : Boolean;
      StringHandle : String := GetStringHandle(CardHandle);

      OutMsg : TcpIp.MessageT;

   begin
      OutMsg := (Data   => Ada.Strings.Fixed.Overwrite(
                                  Source   => TcpIp.NullMsg.Data,
                                  Position => 1,
                                  New_Item => "tokenReader.getIDCert('" &
                                              StringHandle & "',)"),
                  Length => 26 + StringHandle'Length);

      RawIDCert := NullGenericRawCert;

      TcpIp.SendAndReceive (IsAdmin  => False,
                            Outgoing => OutMsg,
                            Incoming => InMsg,
                            Success  => CommsIsOK);

      if CommsIsOK then
         -- InMsg.Data is ('OK[:..]', 'StatusOK', {Dict})
         declare Msg : String :=
                    MsgProc.GetResponseFromMsg(InMsg);
                 RawCert : MsgProc.DictionaryT :=
                              MsgProc.GetDictionary(Msg => Msg,
                                                    Arg => 1);
         begin

            StatusOK := Boolean'Value(
                           MsgProc.GetStringByPos(Msg => Msg,
                                                  Arg => 1));
            if StatusOK then
               Ada.Strings.Fixed.Overwrite(
                             RawIDCert.CertData,
                             1,
                             String(RawCert));

               RawIDCert.CertLength := RawCert'Length;

               ResponseCode := CodeTo32(Success);
            else
               -- problems communicating with the card
               ResponseCode := CodeTo32(UnresponsiveCard);
            end if;
         end;

      else
         -- Comms Fail - reader unavailable.
         StatusOK := False;
         ResponseCode := CodeTo32(ReaderUnavailable);
      end if;
   exception

      when E : others =>

         -- Exception - function cancelled
         StatusOK := False;
         ResponseCode := CodeTo32(Cancelled);

   end GetIDCert;


   ------------------------------------------------------------------
   -- GetPrivCert
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------

   procedure GetPrivCert (CardHandle   : in     CommonTypes.Unsigned32T;
                          RawPrivCert  :    out GenericRawCertT;
                          StatusOK     :    out Boolean;
                          ResponseCode :    out CommonTypes.Unsigned32T)
   is
      InMsg     : TcpIp.MessageT;
      CommsIsOK : Boolean;
      StringHandle : String := GetStringHandle(CardHandle);

      OutMsg : TcpIp.MessageT;

   begin
      OutMsg := (Data   => Ada.Strings.Fixed.Overwrite(
                                  Source   => TcpIp.NullMsg.Data,
                                  Position => 1,
                                  New_Item => "tokenReader.getPrivCert('" &
                                              StringHandle & "',)"),
                  Length => 28 + StringHandle'Length);

      RawPrivCert := NullGenericRawCert;

      TcpIp.SendAndReceive (IsAdmin  => False,
                            Outgoing => OutMsg,
                            Incoming => InMsg,
                            Success  => CommsIsOK);

      if CommsIsOK then
         -- InMsg.Data is ('OK[:..]', 'StatusOK', {Dict})
         declare Msg : String :=
                    MsgProc.GetResponseFromMsg(InMsg);
                 RawCert : MsgProc.DictionaryT :=
                              MsgProc.GetDictionary(Msg => Msg,
                                                    Arg => 1);
         begin

            StatusOK := Boolean'Value(
                           MsgProc.GetStringByPos(Msg => Msg,
                                                  Arg => 1));
            if StatusOK then
               Ada.Strings.Fixed.Overwrite(
                             RawPrivCert.CertData,
                             1,
                             String(RawCert));

               RawPrivCert.CertLength := RawCert'Length;

               ResponseCode := CodeTo32(Success);
            else
               -- problems communicating with the card
               ResponseCode := CodeTo32(UnresponsiveCard);

            end if;
         end;
      else
         -- Comms Fail - reader unavailable.
         StatusOK := False;
         ResponseCode := CodeTo32(ReaderUnavailable);
      end if;
   exception

      when E : others =>

         -- Exception - function cancelled
         StatusOK := False;
         ResponseCode := CodeTo32(Cancelled);

   end GetPrivCert;


   ------------------------------------------------------------------
   -- GetIACert
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------

   procedure GetIACert (CardHandle   : in     CommonTypes.Unsigned32T;
                        RawIACert    :    out GenericRawCertT;
                        StatusOK     :    out Boolean;
                        ResponseCode :    out CommonTypes.Unsigned32T)
   is
      InMsg     : TcpIp.MessageT;
      CommsIsOK : Boolean;
      StringHandle : String := GetStringHandle(CardHandle);

      OutMsg : TcpIp.MessageT;

   begin
      OutMsg := (Data   => Ada.Strings.Fixed.Overwrite(
                                  Source   => TcpIp.NullMsg.Data,
                                  Position => 1,
                                  New_Item => "tokenReader.getIACert('" &
                                              StringHandle & "',)"),
                  Length => 26 + StringHandle'Length);

      RawIACert := NullGenericRawCert;

      TcpIp.SendAndReceive (IsAdmin  => False,
                            Outgoing => OutMsg,
                            Incoming => InMsg,
                            Success  => CommsIsOK);

      if CommsIsOK then
         -- InMsg.Data is ('OK[:..]', 'StatusOK', {Dict})
         declare Msg : String :=
                    MsgProc.GetResponseFromMsg(InMsg);
                 RawCert : MsgProc.DictionaryT :=
                              MsgProc.GetDictionary(Msg => Msg,
                                                    Arg => 1);
         begin

            StatusOK := Boolean'Value(
                           MsgProc.GetStringByPos(Msg => Msg,
                                                  Arg => 1));
            if StatusOK then
               Ada.Strings.Fixed.Overwrite(
                             RawIACert.CertData,
                             1,
                             String(RawCert));

               RawIACert.CertLength := RawCert'Length;

               ResponseCode := CodeTo32(Success);
            else
               -- problems communicating with the card
               ResponseCode := CodeTo32(UnresponsiveCard);

            end if;
         end;

      else
         -- Comms Fail - reader unavailable.
         StatusOK := False;
         ResponseCode := CodeTo32(ReaderUnavailable);
      end if;
   exception

      when E : others =>

         -- Exception - function cancelled
         StatusOK := False;
         ResponseCode := CodeTo32(Cancelled);

   end GetIACert;


   ------------------------------------------------------------------
   -- GetAuthCert
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------

   procedure GetAuthCert (CardHandle   : in     CommonTypes.Unsigned32T;
                          RawAuthCert  :    out GenericRawCertT;
                          Exists       :    out Boolean;
                          StatusOK     :    out Boolean;
                          ResponseCode :    out CommonTypes.Unsigned32T)
   is
      InMsg     : TcpIp.MessageT;
      CommsIsOK : Boolean;
      StringHandle : String := GetStringHandle(CardHandle);
      OutMsg : TcpIp.MessageT;

   begin
      OutMsg := (Data   => Ada.Strings.Fixed.Overwrite(
                                  Source   => TcpIp.NullMsg.Data,
                                  Position => 1,
                                  New_Item => "tokenReader.getAuthCert('" &
                                              StringHandle & "',)"),
                  Length => 28 + StringHandle'Length);
      RawAuthCert := NullGenericRawCert;

      TcpIp.SendAndReceive (IsAdmin  => False,
                            Outgoing => OutMsg,
                            Incoming => InMsg,
                            Success  => CommsIsOK);

      if CommsIsOK then
         -- InMsg.Data is ('OK[:..]', 'StatusOK', {Dict})
         declare Msg : String :=
                    MsgProc.GetResponseFromMsg(InMsg);
                 RawCert : MsgProc.DictionaryT :=
                              MsgProc.GetDictionary(Msg => Msg,
                                                    Arg => 1);
         begin

            StatusOK := Boolean'Value(
                           MsgProc.GetStringByPos(Msg => Msg,
                                                  Arg => 1));
            Exists := Boolean'Value(
                           MsgProc.GetStringByPos(Msg => Msg,
                                                  Arg => 2));

            if StatusOK and Exists then
               Ada.Strings.Fixed.Overwrite(
                             RawAuthCert.CertData,
                             1,
                             String(RawCert));

               RawAuthCert.CertLength := RawCert'Length;

               ResponseCode := CodeTo32(Success);
            else
               -- problems communicating with the card
               ResponseCode := CodeTo32(UnresponsiveCard);
            end if;
         end;

      else
         -- Comms Fail - reader unavailable.
         StatusOK := False;
         Exists   := False;
         ResponseCode := CodeTo32(ReaderUnavailable);
      end if;
   exception

      when E : others =>

         -- Exception - function cancelled
         StatusOK := False;
         Exists   := False;
         ResponseCode := CodeTo32(Cancelled);

   end GetAuthCert;


   ------------------------------------------------------------------
   -- UpdateAuthCert
   --
   -- Implementation Notes:
   --    None.
   --
   ------------------------------------------------------------------

   procedure UpdateAuthCert (CardHandle   : in     CommonTypes.Unsigned32T;
                             RawAuthCert  : in     GenericRawCertT;
                             StatusOK     :    out Boolean;
                             ResponseCode :    out CommonTypes.Unsigned32T)
   is
      InMsg,
      OutMsg    : TcpIp.MessageT;
      ValuesOK,
      CommsIsOK : Boolean;

      procedure ConstructUpdateMessage(Success : out Boolean)
      is

         StringHandle : String := GetStringHandle(CardHandle);
         StringData   : String := RawAuthCert.CertData(
                                     1..Integer(RawAuthCert.CertLength));

         NewItem      : String := "tokenReader.updateAuthCert('" &
                                   StringHandle &
                                   "', {" &
                                   StringData &
                                   "})";

      begin

         OutMsg.Data := Ada.Strings.Fixed.Overwrite(
                           Source   => TcpIp.NullMsg.Data,
                           Position => 1,
                           New_Item => NewItem);

         OutMsg.Length := NewItem'Length;
         Success := True;

      exception

         when E : others =>

            OutMsg  := TcpIp.NullMsg;
            Success := False;
      end ConstructUpdateMessage;

   begin

      ConstructUpdateMessage(Success => ValuesOK);

      if ValuesOk then
         TcpIp.SendAndReceive (IsAdmin  => False,
                               Outgoing => OutMsg,
                               Incoming => InMsg,
                               Success  => CommsIsOK);

         if CommsIsOK then
            -- InMsg.Data is ('OK[:..], 'StatusOK')
            declare Msg : String :=
                       MsgProc.GetResponseFromMsg(InMsg);
            begin
               StatusOK := Boolean'Value(
                              MsgProc.GetStringByPos(Msg => Msg,
                                                     Arg => 1));

               if StatusOK then
                  ResponseCode := CodeTo32(Success);
               else
                  -- problems communicating with the card
                  ResponseCode := CodeTo32(UnresponsiveCard);
               end if;
            end;

         else
            -- Comms Fail - reader unavailable.
            StatusOK := False;
            ResponseCode := CodeTo32(ReaderUnavailable);
         end if;

      else
         -- Problem Creating the Message
         StatusOK := False;
         ResponseCode := CodeTo32(InvalidValue);
      end if;

   exception

      when E : others =>

         -- Exception - function cancelled
         StatusOK := False;
         ResponseCode := CodeTo32(Cancelled);

   end UpdateAuthCert;

end TokenAPI;
