Ossa Sepia

February 7, 2019

Seppuku Job Market: Minimal Dynamic Tasking in Ada

Filed under: Coding — Diana Coman @ 10:44 p.m.

Eulora's server needs a reliable and robust way of performing - preferably in parallel whenever possible - various jobs for all the players that might connect to the game at any given time. Given the parallel requirement, there isn't really any way around the fact that multi-threading is needed. Nevertheless, since multi-threading is by its nature complex enough to give subtle errors and heavy headaches at any time, I'd really much rather make sure any implementation that deals with multiple threads of execution is as small, clear, plain and easy to follow as possible. In other words, if it has to be multi-threaded then it should better be minimal, self-healing, self-adjusting and ruthlessly functional with all and any bells and whistles chucked as far away from it as possible. To drive this point home and keep it in mind at all times1, I'll call this self-reliant unit of the server the Seppuku Job Market or SJM for short.

The list of requirements for the SJM is this:
1. Accept Jobs from all and sundry in a thread-safe manner and execute them in order of their priorities.
2. Generate and kill Worker tasks2 *dynamically* and on an *as-needed basis* to perform jobs as soon as possible but remaining at all times within a pre-set maximum number of Workers3.
3. Creation and destruction of Workers should be reliable and robust: in particular, SJM should run for ever unless explicitly stopped and it should re-spawn Workers as needed, even if they get killed from outside the code (cosmic-ray event or not).
4. Aim to perform jobs in order of their specified priority but taking into account that at most ONE job per player is actually executed at any given time. In other words: do NOT allow a player to hog the whole thing and run as many jobs as they want; this is parallelism aimed to increase the number of players served not merely the number of jobs performed!

Point 1 of requirements hints at the nature of SJM: as it needs to accept jobs from many, unknown sources, it is effectively a "server" of sorts and moreover it is essentially a resource from the point of view of job producers. The best Ada construct that readily fits this description is a protected unit (aka a passive entity that guarantees thread-safe access to the data it encapsulates - in this case to the queue of jobs waiting to be performed). One significant benefit of an Ada protected entity is the fact that it is specifically not a task itself nor is there a task associated with it. Instead, the mutually exclusive access to services provided by a protected unit is ensured by the run-time system and therefore the whole thing has at least one less headache to think of: while Worker tasks may get killed, the SJM itself at least cannot get killed unless the whole program (i.e the main thread of execution of the server itself) gets killed.

Point 2 of requirements (dynamic, self-adjusting number of tasks) means that I'll need to actually create and dispose of tasks programmatically - there is no way to have only statically allocated tasks. In turn, this means that a few restrictions have to go away: No_Allocators, No_Finalization, No_Task_Allocators, No_Tasking, No_Unchecked_Deallocation. The need to drop the No_Finalization and No_Unchecked_Deallocation restrictions comes from the way in which Ada handles memory allocated dynamically even when on the stack. Essentially, dynamically allocated tasks receive memory from a "pool". Once allocated, memory from a pool is reclaimed ONLY when the whole pool goes out of scope or in other words when it can be guaranteed that there is no piece of code left that can actually attempt to access that bit of memory. This is very robust and quite useful of course but in the case of dynamically allocated tasks it means that tasks that finish will STILL effectively occupy memory unless specifically deallocated (with unchecked_deallocation as that's the only way to do it as far as I can tell). In turn, this creates the undesirable but very real and quite horrible possibility that the code will run just fine *until* the pool in which tasks are created runs out of memory because of all previous tasks that finished long time ago but whose space was never reclaimed. To avoid this, the code has to keep track of terminated tasks and explicitly deallocate the memory they occupy before chucking away their pointer and/or re-spawning a replacement Worker (as there is no way to "restart" a task).

Point 3 means that Workers need to be effectively managed based on the evolution of the number of available jobs and the number of Workers themselves. One approach would be of course to have a Supervisor task but the problem then is twofold: first, the Supervisor needs to be aware of changes to the jobs queue as they happen; second, having a Supervisor task creates the potential problem of who supervises the supervisor (esp. with respect to recovery from killed thread since in this case the Supervisor itself might die unexpectedly). Given however that the SJM protected unit effectively guards precisely the jobs queue, it's also in the best position to react promptly to an increase or decrease in jobs and so it follows that it should in fact manage the Workers too. After all, it can do a bit more on receiving a job than merely chucking it into the queue: ideally it would in fact pass it on to a Worker immediately.

While at first sight "take job, spawn Worker, pass it on and let him do it" sounds precisely fine, in practice it's really not fine at all and not least because of the requirement at Point 4: passing a job on to a Worker requires some ordering of jobs (by priority) and even a sort of guarded access to a player since a new job cannot be accepted (and especially cannot be passed on to a Worker for execution) while an existing Worker may still be toiling away on a previous job for the same player. So the SJM needs to find out when a job is finished in order to accept again jobs for that specific player. As always, there are only a few ways to know when something finished: either look for it4 as one rather has to do when Workers are just passive executors of jobs or otherwise expect a signal to be sent back by a more active type of Worker task when it finished the job it had.

This distinction between active and passive Workers (or tasks in general) is quite significant. As passive entities, Workers can at most simply wait to be handed a job or any other signal. Typically, a Worker would be created and handed a job, they would do it and then they would quietly die keeping out of the way of everyone else. This can be a great fit in various cases but I can see several problems with this for Eulora's server: first, Workers cannot be reused even when jobs are available so there is a rather inefficient kill/create overhead5 precisely at busy time when one wants it even less than at any other time; second, the only way for the SJM to find out when a job finished is by a sort of polling i.e. going through the whole set of workers and checking which one is in a terminated state - note that it is not at all clear just *when* should this be done or how would it be triggered (sure, one can use a sort of scheduled event e.g. check it every 3 seconds or some such but it's more of a workaround than addressing the problem); third, the SJM needs to do both Worker creation and Job allocation (i.e. priority ordering + only one job per player at any given time) at the same time and while keeping a job creator waiting.

The first of the above issues (no reuse of Workers) is easily addressed by making Workers active rather than passive: they get created and then they actively ask for a job; once they got a job, they do it and then they go back and report it done, after which they queue again to get another job or perhaps the boot if there are no jobs to be had. And since such active Workers do not finish by default when a task is finished, they need to have rather suicidal tendencies and ask not merely for a job but rather for either a job or permission to seppuku (hopefully in a clean manner though!).

Making Workers active (if suicidal) neatly separates Worker creation from Job allocation: when jobs start pouring in, the SJM can simply create a bunch of Workers and release the job creators before it makes time to actually hand the jobs out to queuing workers. When the jobs keep pouring in, Workers keep working and there's no need to kill them now to only create them a few milliseconds later. Moreover, finished jobs are simply reported and marked as such without any need to poll. In the (hopefully rare) case when a Worker dies unexpectedly before sending the signal that it finished its job, they will be anyway observed sooner or later when the state of Workers is assessed to decide if more or fewer Workers are needed. Essentially the only trouble this approach brings is the added responsibility on the SJM: it controls access to the Job queue for job creators AND for Workers while ALSO effectively managing and keeping track of all Worker-related aspects. But then it's not a Seppuku Job Market for no reason: if it needs to do it, it will have to do it and do it well.

As a proof of concept of the above, I have implemented the SJM precisely as described: as a protected unit that encapsulates a Job queue and manages active Worker tasks, creating and destroying them as needed while also de-allocating memory of any terminated Workers, ensuring that only one Job per player is accepted at any given time and allowing a graceful stop that does not block any job producers that may come at a later time and does not leave dangling Worker tasks either. Jobs are simply record types with a discriminant that specifies their type and therefore the exact form a variable part of the record takes (since each Job type is likely to have specific data structures it requires). Note that I specifically avoided the Object-Oriented option (i.e. tagged type in Ada) with a hierarchy of Job types and reliance on polymorphism for "Complete" to do the right thing depending on the exact type of Job. The reason for this avoidance is mainly that there really isn't much to gain from it as far as I can see at the moment. Similarly, I prefer to not rely on generic containers (for the Job Queue for instance) unless they become clearly and absolutely needed. Finally, I am quite aware of Ada's relevant annexes such as Real-Time Systems and I know that it provides a whole infrastructure of worker pools and jobs with futures even (i.e. a way to provide results at a later time) but they are quite at odds with the significant aim of keeping it all as short6 and clear and easy to follow as possible (not to mention potential issues with the way in which some parts might be implemented using a secondary stack for instance which I specifically do not want to have).

The public part of the EuJobs package is this:

with Interfaces; use Interfaces;
with Data_Structs;
with Ada.Finalization;
with Ada.Unchecked_Deallocation; -- to clean up worker tasks if needed.

package EuJobs is

  pragma Elaborate_Body;

  -- knobs and constants
  Max_Workers : constant Natural := 64;
  Max_Idle_W  : constant Natural := Max_Workers;
  -- max jobs
  Max_Jobs    : constant Natural := Max_Workers * Max_Workers;

  -----------------------WORKERS--------------------
  -- Generic Eulora Workers type: simply perform given Jobs
  subtype Worker_Index is Natural range 1..Max_Workers;
  -- Those are to be FULLY managed (including created/ended) by the Job Market
  -- ACTIVE but suicidal elements:
  --   a worker will keep requesting jobs/permission to seppuku
  --     until allowed to terminate
  -- Pos is a token identifying Worker with the Job Market
  -- NB: ALL workers WILL use this Job Market
  -- NB: do NOT create workers from outside the Job Market!
  task type Worker( Pos: Worker_Index );

  -- needed to dynamically generate Workers
  type Worker_Address is access Worker;
  procedure Free is new Ada.Unchecked_Deallocation(Worker, Worker_Address);

  -- ALL the info that the Job Market holds on workers to manage them
  type Worker_Rec is
    record
      Assigned  : Boolean := False;
      Player_Id : Interfaces.Unsigned_64;
      WA        : Worker_Address;  -- actual pointer to worker
    end record;  

  -- for storing pointers to generated workers including if assigned and id
  type Worker_Array is array( Worker_Index'First ..
                              Worker_Index'Last) of Worker_Rec;

  -- limited controlled type that ensures no dangling workers at Finalize time
  type Controlled_Workers is new Ada.Finalization.Limited_Controlled with
    record
      Workers: Worker_Array;
    end record;

  overriding
  procedure Finalize( S: in out Controlled_Workers );
  overriding
  procedure Initialize( S: in out Controlled_Workers );

  -------------------------------JOBS-------------------
  -- Job types; NB: do NOT map (nor have to) directly on message types!
  type Job_Types is ( Do_Nothing,
                      Print_Job,
                      Create_Acct );

  -- Data structure with relevant information for each type of job
  type Job_Data ( T: Job_Types := Do_Nothing ) is
    record
      -- common information relating to the one requesting this job
      Player_ID: Interfaces.Unsigned_64 := 0;
      Source_IP: Interfaces.Unsigned_32 := 0;
      --NB: this is SOURCE port - reply WILL be sent here, whether RSA or S!
      Source_P : Interfaces.Unsigned_16 := 0;
      -- Message counter, as received
      Counter  : Interfaces.Unsigned_16 := 0;
      Priority : Natural := 0; --lowest possible priority
      case T is
        when Create_Acct =>
          Acct_Info: Data_Structs.Player_RSA;
        when Do_Nothing =>
          null;
        when Print_Job =>
          null;
      end case;
    end record;

  procedure Complete( JD   : in Job_Data );

  subtype Job_Count is Natural range 0..Max_Jobs;
  type Job_Array is array( 1..Max_Jobs ) of Job_Data;
  type Jobs_List is
    record
      Len  : Job_Count := 0;
      JA   : Job_Array;
    end record;

  ---------------------------Job_Market--------------------

  -- FULLY self-managed Job Market for euloran jobs:
  --   -- accepts jobs to do
  --   -- spawns, kills and managed workers that complete the jobs
  -- NB: Job_Market will DISCARD a new job when:
  --    -- it is FULL (i.e. can't handle anymore)
  --    -- it is stopping
  --    -- it already has a job for the same player
  -- Jobs are performed according to specific criteria (not strictly fifo):
  --   - FIFO but ensuring no more than 1 job per player served at any time
  --   - ALSO: there might be other priorities (e.g. type of job)
  protected Job_Market is
    -- adding a new job that needs to be done
    -- this can be ANY derivated type of Job_Data
    -- NB: Added will be true if J was indeed accepted and False otherwise
    entry Add_Job( J     : in Job_Data;
                   Added : out Boolean );

    -- workers request jobs when they are out of work
    -- workers need to provide their token (Pos)
    -- they can get to do: either a job OR seppuku signal.
    procedure Get_Job( Pos    : in Worker_Index;
                       J      : out Job_Data;
                       Seppuku: out Boolean );

    -- workers have to report back when a job is done
    -- (or they get sweeped up eventually if/when they abort).
    procedure Done_Job( Pos: in Worker_Index );

    -- sets in motion the process to stop gracefully:
    --   -- no more jobs received, existing discarded
    --   -- all workers will be given Seppuku signal
    -- NB: NO reverse for this.
    procedure Stop;

    -- for any external supervisors
    -- returns TRUE if it is NOT stopping
    -- returns False if it is stopping
    function Operating(  Waiting_Jobs: out Natural;
                         Idle_Workers: out Natural;
                         Active_Workers: out Natural;
                         Terminated_Workers: out Natural;
                         Is_Full: out Boolean)
      return Boolean;

  private

    -- internal storage of jobs and mgm of workers
    Board  : Jobs_List;

    -- NB: Workers are in the BODY of the package
    --   because they HAVE to be after the body of Finalize

    -- when stopping:
    -- discard new jobs; give out stop on get/done; empty jobs map
    Stopping : Boolean := False;
    Fullboard: Boolean := False;

    -- Retrieves next available job from the Board and returns it in JD
    -- Sets Found to True if an available job was found (i.e. JD is valid)
    -- Sets Found to False (and JD is undefined) if NO available job was found.
    -- NB: this DOES remove the element from the board!
    procedure Get_Available( JD    : out Job_Data;
                             Found : out Boolean );

    -- checks if the given player_id IS currently served by any worker
    function Is_Assigned( Player_ID: in Interfaces.Unsigned_64 )
             return Boolean;

    -- Checks in Board list ONLY if there is a job for this player
    -- Returns True if a job was found (i.e. a job waiting for a worker)
    -- Returns False otherwise.
    -- NB: Player might STILL have a job in progress (assigned to a worker)
    function Has_Waiting_Job( Player_ID: in Interfaces.Unsigned_64 )
             return Boolean;

    -- releases any player_id that might be stuck with aborted workers
    -- *creates* new workers if needed (specific conditions met)
    procedure Manage_Workers;

  end Job_Market;

private

  -- create new Worker with identification token (position) P
  function Create_Worker(P: in Worker_Index)
             return Worker_Address;

end EuJobs;

Workers are very simple tasks with an ID received at creation time to identify them within the Job_Market (very simply by position in the array of Worker addresses). They run a loop in which they request tasks or permission to Seppuku and when they receive either of them they proceed to do as instructed. Perhaps you noticed above that the array of Worker pointers is wrapped inside Controlled_Workers, which is a controlled type. A controlled type in Ada guarantees that the provided Initialize and Finalize routines are run precisely at the stages that their names suggest to enable the type to start off cleanly and to end up cleaning after itself. In the case of Controlled_Workers, the Initialize simply makes sure that the array has all pointers marked as null and moreover as not assigned any tasks while the Finalize goes one more time through the array and finishes off (with abort) any workers that are not null already. Note that the scope of Worker tasks is in fact the package level since the Worker_Address type is declared at this level (and that's how the scope is defined for such types in Ada). You might have noticed also that there is no concrete array of Workers defined anyhere so far: indeed, the array of workers is defined inside the package body for two main reasons: first, it should NOT be accessed by anyone from outside (not even potential children packages at a later time); second, it has to be defined after the bodies of Initialize and Finalize since otherwise it can't be created.

Jobs are barely sketched for now as Job_Data structures with a discriminant to distinguish different types and a variable part for specific data that each type of job needs. The Complete procedure then simply does different things for each type of job in a straightforward manner (at the moment it does something for the print job only for basic testing purposes).

The Job_Market itself is a protected object that offers a handfull of services (aka public entries, procedures or functions): entry Add_Job for job producers to provide their new jobs; procedure Get_Job for Workers who are looking for something to do; procedure Done_Job for Workers who report they finished their previously allocated job; procedure Stop for any higher-level caller who is in a position to turn off the whole Job_Market; function Operating that simply provides information on the current state (i.e. operating or stopping) and status (e.g. number of jobs and workers) of the Job_Market. Note that there are important differences between functions, procedures and entries: functions can only *read* protected data so they are effectively banned from modifying anything, hence Operating being exactly a function as it provides a snapshot of current state and metrics for the Job_Market; procedures can modify data but a call to them is unconditional meaning it gets accepted as soon as the protected object is available and the caller is first in queue for it, without any further restrictions - hence Stop, Done_Job and Get_Job are procedures since there is no constraint on them being called at any time; finally, entries can also modify data but they have entry barriers meaning they accept a call only when certain conditions are met - in this case Get_Job has the simple but necessary condition that either the Job_Market is stopping (in which case callers should not be blocked since it's pointless to wait anyway) or the Job queue is not full since it makes little sense to allow a job producer in just to discard their job for lack of space anyway. Note however that this is merely for completeness here since in practice there will be several other levels of measures taken so that the job queue does NOT become full since that is clearly not a sane way to have the server running.

In addition to the above public services, the Job_Market also has a private part where it keeps the job queue (as a basic array for now - this can easily change at a later time if there is a good reason for the change), a flag to know if it's stopping and one to register if/when the board is full as well as a few helper procedures and functions for its own use. The Get_Available procedure effectively implements the strategy of picking next Job to execute: it's here that priorities are considered really and it's here that there is another check to make sure that no two jobs of the same player are ever executed at the same time. The Is_Assigned procedure checks the set of Workers to see if any of them is performing a job for the specified player. The Has_Waiting_Job on the other hand checks the job queue to see if there is any job from the specified player waiting in the queue. Arguably the most important of those is "Manage_Workers" that does precisely what the name says: it does a headcount of Workers in various states, cleans up any aborted/unexpectedly dead ones, reclaims memory for terminated ones and then, if required, creates new Workers to match the current Job provision. Note that there really are only 64 workers in total (and at any rate this is unlikely to become a huge number) so this headcount of workers is not really terribly costly.

The overall package further has a private function that dynamically creates a new Worker task with the given ID, returning its address. This is more for convenience than anything else since one could easily call new directly so perhaps it will even go away at the next round of trimming the code.

The implementation in eujobs.adb starts with the Initialize and Finalize procedures, declares the Controlled_Workers object and then proceed with the internals of the Job_Market itself:

with Ada.Text_IO; use Ada.Text_IO;

package body EuJobs is

  procedure Finalize( S: in out Controlled_Workers ) is
    -- ALL this needs to do is to make SURE no worker is still running!
  begin
    for I in S.Workers'First .. S.Workers'Last loop
      if S.Workers(I).WA /= null then
        abort S.Workers(I).WA.all;
        S.Workers(I).WA := null;
        S.Workers(I).Assigned := False;
      end if;
    end loop;
  end Finalize;

  procedure Initialize( S: in out Controlled_Workers ) is
  begin
    for I in S.Workers'First .. S.Workers'Last loop
      S.Workers(I).WA := null;
      S.Workers(I).Assigned := False;
    end loop;
  end Initialize;

  -- actual workers slots; workers are managed internally here
  -- this type is needed though, to Finalize properly
  CW: Controlled_Workers;

  protected body Job_Market is
    -- adding a new job that needs to be done
    -- this can be ANY derivated type of Job_Data
    entry Add_Job( J     : in Job_Data;
                   Added : out Boolean )
      when Stopping or    --to unblock producers
           (not Fullboard) is
    begin
      -- if stopping, discard job -- allows callers to finish too...
      -- check Player_ID and add job ONLY if none exist for this player
      if (not Stopping) and
         (not Is_Assigned(J.Player_ID)) and
         (not Has_Waiting_Job(J.Player_ID)) then
        -- board is known to have space, so add to it
        Board.JA(Board.JA'First + Board.Len) := J;
        Board.Len := Board.Len + 1;

        -- job added may mean full board
        FullBoard := Board.Len >= Board.JA'Last;

        -- Quick worker management to adjust if needed
        Manage_Workers;
        -- Let caller know that job was indeed added
        Added := True;
      else
        Added := False; --not added, aka discarded
      end if;
    end Add_Job;

    -- workers request jobs or seppuku when they are out of work
    procedure Get_Job( Pos    : in Worker_Index;
                   J      : out Job_Data;
                   Seppuku: out Boolean ) is
      Found : Boolean;
    begin
      if Stopping then
        -- when stopping: all seppuku
        Seppuku := True;
      else
        -- try first to get some job that should be done
        Get_Available(J, Found);
        if (not Found) then
          Seppuku := True; --since no job is available..
        else
          -- have a job so no seppuku for now
          Seppuku := False;
          -- update Worker record to mark player as being served etc.
          CW.Workers(Pos).Assigned := True;
          CW.Workers(Pos).Player_ID := J.Player_ID;
          -- this SURELY means board is NOT full!
          Fullboard := False;
        end if;
      end if;
      -- LAST: manage workers in ANY CASE!
      Manage_Workers;
    end Get_Job;

    -- workers have to report back when a job is done
    procedure Done_Job( Pos: in Worker_Index ) is
    begin
      -- update record for this worker and let him go
      CW.Workers(Pos).Assigned := False;
    end Done_Job;

    -- aim to stop gracefully:
    --   -- no new jobs stored, existing discarded, workers killed.
    -- NB: NO reverse for this.
    procedure Stop is
    begin
      Stopping := True; -- NO need for anything else, really
    end Stop;

    function Operating(  Waiting_Jobs: out Natural;
                         Idle_Workers: out Natural;
                         Active_Workers: out Natural;
                         Terminated_Workers: out Natural;
                         Is_Full: out Boolean)
      return Boolean is
    begin
      Waiting_Jobs := Natural( Board.Len );
      Is_Full := Fullboard;
      Idle_Workers := 0;
      Active_Workers := 0;
      Terminated_Workers := 0;

      for I in CW.Workers'Range loop
        if CW.Workers(I).WA /= null then
          if CW.Workers(I).WA'Terminated then
            Terminated_Workers := Terminated_Workers+1;
          elsif CW.Workers(I).Assigned then
            Active_Workers := Active_Workers + 1;
          else
            Idle_Workers := Idle_Workers + 1;
          end if;
        end if;
      end loop;
      return (not Stopping);
    end Operating;

    -- anything needed for external load checking (?)

--private stuff

    procedure Get_Available( JD    : out Job_Data;
                             Found : out Boolean ) is
      Pos   : Job_Count;
      P     : Natural := 0; --priority of job found so far
    begin
      Found := False;
      -- ALWAYS walk the FULL set: higher priority might have come in later
      for I in 1 .. Board.Len loop
        if ( (not Found) or (Board.JA(I).Priority > P) ) and
           (not Is_Assigned(Board.JA(I).Player_ID) ) then
          Found := True;
          Pos   := I;
          P     := Board.JA(I).Priority;
          -- but don't copy just yet, as there might be higher priority further
        end if;
      end loop;
      -- retrieve the found job data but ONLY if found!
      if Found then
        JD := Board.JA(Pos);
        -- if not last job, shift to avoid gaps in the array
        if Pos < Board.Len then
          Board.JA(Pos..Board.Len-1) :=
              Board.JA(Pos + 1 .. Board.Len);
        end if;
        -- update count of jobs in the array
        Board.Len := Board.Len -1;
      end if;
    end Get_Available;

    function Is_Assigned( Player_ID: in Interfaces.Unsigned_64 )
             return Boolean is
      Found: Boolean := False;
    begin
      -- walk the array of workers and check
      for I in CW.Workers'Range loop
        if CW.Workers(I).WA /= null and
           CW.Workers(I).Assigned and
-- Will have to rely on .assigned being SET properly by the manager!
--  (not CW.Workers(I).WA'Terminated) and
           CW.Workers(I).Player_ID = Player_ID then
          -- found it!
          Found := True;
          exit;
        end if;
      end loop;
      return Found;
    end Is_Assigned;

    function Has_Waiting_Job( Player_ID: in Interfaces.Unsigned_64 )
             return Boolean is
      Found: Boolean := False;
    begin
      for I in Board.JA'First .. Board.JA'First + Board.Len loop
        if Board.JA(I).Player_ID = Player_ID then
          Found := True;
          exit;
        end if;
      end loop;
      return Found;
    end Has_Waiting_Job;

    procedure Manage_Workers is
      Active_W: Natural := 0;
      Idle_W  : Natural := 0;
      Total_W : Natural := 0;
      To_Create: Natural:= 0;
    begin
      -- release player ids if workers terminated
      -- count also precisely how many are active
      for I in CW.Workers'Range loop
        if CW.Workers(I).WA /= null then
          if CW.Workers(I).WA'Terminated then
            -- this terminated abnormally -> LOG?
            CW.Workers(I).Assigned := False;
            -- claim this space to restart a worker here if needed
            --CW.Workers(I).WA := null;
            -- deallocate it too as otherwise memory space slowly gets lost
            -- NB: Free proc sets it to null anyway
            Free(CW.Workers(I).WA);

          --if NOT null and NOT terminated-> idle or active
          elsif CW.Workers(I).Assigned then
              -- this is an active worker, count it
              Active_W := Active_W + 1;
          else
            -- this is an idle worker, count it
            Idle_W := Idle_W + 1;
          end if;
          -- null workers are simply empty spaces, no need to count them
        end if;
      end loop;
      -- calculate total workers
      Total_W := Active_W + Idle_W;

      if (not Stopping) and
         (Board.Len > Total_W) and
         (Total_W < Max_Workers ) and
         (Idle_W = 0) then
        -- need (perhaps) to create workers: how many?
        To_Create := Board.Len - Total_W;

        -- create them for as long as there is ANY space..
        -- NB: MORE workers MIGHT have terminated meanwhile,
        -- but they won't be null!
        for I in CW.Workers'Range loop
          if CW.Workers(I).WA = null then
            -- found a place, so create a worker
            CW.Workers(I).Assigned := False;
            CW.Workers(I).WA := Create_Worker(I);
            To_Create := To_Create - 1;
            Total_W := Total_W + 1;

            if To_Create <= 0 or Total_W >= Max_Workers then
              exit;
            end if;
          end if;
        end loop;
      end if;
     end Manage_Workers;

  end Job_Market;

  -- Worker body
  task body Worker is
    JD      : Job_Data;
    Seppuku : Boolean := False;
  begin
    -- main Loop: get a job or die, work and repeat.
    Work_Loop:
    loop
      -- ask the Job Market for a job or permission to seppuku
      Job_Market.Get_Job( Pos, JD, Seppuku );

      if Seppuku then
        exit Work_Loop;
      else
        -- do the job
        EuJobs.Complete( JD );
        -- report job done
        Job_Market.Done_Job( Pos );
      end if;
    end loop Work_Loop;
    -- worker is done and will die gracefully!
  end Worker;

  -- Jobs themselves
  procedure Complete( JD   : in Job_Data ) is
    Stop: Boolean;
  begin
     -- do different things for different types of jobs...
    case JD.T is
        when Create_Acct =>
          --Acct_Info: Data_Structs.Player_RSA;
          Stop := False;
        when Set_SKeys =>
          -- SKes: Data_Structs.Serpent_Keyset;
          Stop := False;
        when Mgm_SKeys =>
          --SMgm: Data_Structs.Keys_Mgm;
          Stop := False;
        when Print_Job =>
          Put_Line("Completing: job counter " &
                   Interfaces.Unsigned_16'Image(JD.Counter) &
                   " priority " & Natural'Image(JD.Priority) &
                   " for player " &
                   Interfaces.Unsigned_64'Image(JD.Player_ID) &
                   " from IP:P " & Interfaces.Unsigned_32'Image(JD.Source_IP) &
                   ":" & Interfaces.Unsigned_16'Image(JD.Source_P));
        when others =>
          -- no job or dubious at best, better stop.
          Stop := True;
    end case;
  end Complete;

  function Create_Worker(P: in Worker_Index)
             return Worker_Address is
  begin
    return new Worker(P);
  end;

end EuJobs;

Your thoughts, observations and critiques on the above are welcome below in the comments section. If there is a problem with the above approach or with the code itself I really want to hear of it sooner rather than later since it's of course easier to do something about it now - this is after all the whole reason why I'm publishing this proof of concept so go ahead and point out any faults you see.


  1. Also to reflect some suicidal tendencies of my Workers but that becomes clearer later. 

  2. "Threads" if you prefer non-Ada terminology. 

  3. There isn't much point in having more Workers than your underlying iron can actually support 

  4. blocking until it's done or checking at some intervals 

  5. Ada's documentation claims that dynamic creation of a task has a big overhead anyway so it's best avoided whenever possible but I can't say I have any idea just what "big overhead" means here. 

  6. The full .ads + .adb code+comments shown below is 500 lines, it uses no secondary stack, no heap and no containers or other similar external packages. Even the "use Ada.Text_IO" will go away as it's in there now strictly to allow the Print job to be seen as it completes for testing purposes. 

January 12, 2019

Compiling Ada Library for Use with Non-Ada Main

Filed under: Coding — Diana Coman @ 5:40 p.m.

Following a rather bumpy road of compilation troubles trying to link an Ada lib into a CPP main program, I found first a working solution to the task at hand and then a headache trying to disentangle the confusion of what is exactly a "standalone encapsulated dynamic" library, why is it needed and how exactly does it differ on the initialization front from a boring static library. Fortunately it turns out that my headache was due mainly to all that bumping into walls combined with the rather confusing terms used in .gpr files - there was at least nothing that a good dose of hands-on experimentation and several re-reading of the GNAT docs couldn't cure! Still, as I'd rather not repeat the whole process next time I need to mix Ada with others, I'll summarise here my notes on the options I found for compiling an Ada library1 so that it can be safely used from a non-Ada main program.

To use Ada code from a non-Ada main program, one needs to find a way to actually start the Ada run-time environment *before* any calls to Ada code. The Ada run-time does the crucial task of elaboration of Ada code (i.e. getting everything ready for executing code, so broadly speaking it takes care of initializing variables and constants as well as running any code found in the main body of packages that are used). Since elaboration is a concept entirely specific to Ada, there is no way to rely on the non-Ada main code (C, C++ or whatever it might be) to take care of this. Instead, the solution is to make sure that the Ada library itself contains and exposes an initialization procedure that does exactly this: starts the Ada run-time and performs the required elaboration for the library code. Once this exists, the non-Ada code simply has to make sure it calls this initialization procedure *before* calling *any* Ada code from that library and that's all2. This much was clear from the beginning - it's from here on that the headache and confusion started since not ALL Ada libraries actually contain/expose such an initialization routine. Essentially, in addition to the usual classification of libraries into static or dynamic, Ada has another parallel classification: standalone or not! And asking gprbuild to produce a standalone library is NOT done by using the "Library_Standlone" option but by defining an... interface for the library via the "Library_Interface" option in the .gpr file. Specifically, from the beginning:

  • To use an Ada library from a non-Ada main program, one needs to compile the library as "standalone". The standalone type of Ada library is the only one that contains and exposes for outside use an initialization routine that will start the Ada run-time and perform all elaboration tasks required for the library itself. NB: the initialization routine will be called libnameinit so if the library is called "eunet" then the routine will be "eunetinit".
  • To create a standalone Ada library with gprbuild, the corresponding .gpr file has to include the option "Library_Interface" that lists the packages that are actually exposed for use from outside the library. This option is enough by itself to obtain a standlone library and therefore to have the initialization routine! NB: you can build a standalone library as static or dynamic, as you want, simply specifying the kind, via "Library_Kind" - in both cases, the resulting .a or .so file will contain the initialization routine. For example:
      for Object_Dir use "obj";
      for Library_Dir use "lib";
      for Library_Name use "eunet";
      for Library_Kind use "static";
      for Library_Interface use ("Eunet", "Raw_Types");
    
  • Standalone libraries have subtypes too and it is actually the subtype that is specified via the option "Library_Standalone" in a .gpr file! According to GNAT's user guide, the Library_Standalone can take 3 values: standard (default), no, encapsulated.
    • The "standard" is the option used if your .gpr file does not even mention "Library_Standalone" (but DOES mention "Library_Interface"!) and it means that the initialization routine is contained and exposed.
    • The "encapsulated" option means in addition that the library will depend only on static libraries except for system libraries - so this option will effectively pull in everything the library needs, including the GNAT run-time. This makes for a significantly *easier* use and linkage further downstream BUT it forces the Library_Kind to... "dynamic". I could NOT find out any clear explanation as to WHY this is so but if I'm to guess I'd say it's probably a way of "protecting" users so that they don't encapsulate the Ada run-time in 10 separate libraries and then use all of them in the same program or something.
    • Finally, the "no" option means - surprisingly! - what you'd expect: the library is NOT to be a standalone library after all (and "Library_Interface" be damned)!
  • Summarizing the messy interplay between Library_Interface and Library_Standalone above: you can have a static or dynamic standalone library as long as you leave "Library_Standalone" option alone; you can have only a dynamic standalone library if you actually want to include the GNAT run-time. This item is called "encapsulated standalone library" and means that "Library_Standalone" is set to "encapsulated". You can - unclear why/when is it useful - specify explicitly that you do NOT want a standalone library by setting "Library_Standalone" to "no". Essentially the Library_Standlone chooses between "types" of standalone that include standard, encapsulated or... not standalone at all. I still get slightly nauseaous.
  • Assumming you did go for one sort or another of standalone library, there is a further option to ask the library to "automatically" run its initialization. This is done via "Library_Auto_Init" option being set to "true" (the default value). However, this is the sort of gun that can easily explode in your face since the actual behaviour is platform dependent so you can't rely on it for anything. As a result, I'd say this is best set to "false" clearly and explicitly so that one is not lulled into the idea that someone else will do the initialization auto-magically.
  • If you build a static standalone library, note that its linking into the main program requires also the linking of GNAT runtime as a minimum. The exact things you need depend on what your library really uses but things can get quite gnarly. For instance3 the line for a basic main.cpp test that does ~nothing but it does it with the whole smg_comms + some glue for handling net stuff of Eulora's client:

    gcc main.cpp -o main.o lib/libeunet.a
    -Wl,-z,origin,-rpath,/home/eu-test/eulora/eunet/c_wrappers/bin/:/home/eu-test/eulora/eunet
    /rsa/bin/:/home/eu-test/eulora/eunet/mpi/bin/
    -ldl -lpthread -lrt -L/home/eu-test/eulora/eunet/c_wrappers/bin/ -lC_Wrappers
    -L/home/eu-test/eulora/eunet/rsa/bin/ -lRSA -L/home/eu-test/eulora/eunet/mpi/bin/
    -lMPI
    /home/eu-test/x86_64-linux-musl-native/lib/gcc/x86_64-linux-musl/4.9.4/adalib/libgnarl.a
    /home/eu-test/x86_64-linux-musl-native/lib/gcc/x86_64-linux-musl/4.9.4/adalib/libgnat.a
    

On the bright side, the investigation that resulted in the above notes means that I'm now satisfied that I can in fact link an eunet Ada library both with Eulora's client (that links mainly with dynamic libs so possibly easier as encapsulated standalone) and with code that runs on GNAT with static libs only. In addition, I certainly got also a much better understanding of Ada's elaboration and elaboration order and how it should be handled for safe use of tasks from within a library. But a set of notes for that might be the topic for another time!


  1. even a rather complex one with tasks that start at elaboration time among other things 

  2. In principle there is also a symmetric finalization procedure that is to be called at the very end by the non-Ada code: this one shuts down the Ada run-time but in practice it doesn't seem to be required all that often. 

  3. Isn't "libgnarl.a" such a great name? 

December 17, 2018

SMG Comms Chapter 13: Sender and Receiver

Filed under: Coding, SMG_Comms — Diana Coman @ 1:39 p.m.

~ This is a work in progress towards an Ada implementation of Eulora's communication protocol. Start with Chapter 1.~

This chapter adds to SMG Comms a thin wrapper package that effectively rescues the queue of UDP messages from the IP stack (where it's relatively small) into memory (where it can be, by comparison, large). Once the decision has been clearly made as to what the sender/receiver should do and moreover I finally seem to have gotten my head around using Ada's threads1, the implementation is deliciously straightforward. Who could have predicted this ?! Let's see directly the new Snd_Rcv package as it's very easy to read indeed:

 --Sender and Receiver task types for Eulora's Communication Protocol
 --This is a THIN layer on top of UDP lib, mainly to move messages out
 -- of the small queue of the IP stack onto a bigger, in-memory queue.
 --There is NO processing of messages here: just read/write from/to UDP.
 --S.MG, 2018

with Interfaces;
with Msg_Queue;
with UDP;

generic
  -- exact length of payload aka whether RSA or Serpent
  Len: in Positive;

package Snd_Rcv is
  -- queue package with specified payload length
  package M_Q is new Msg_Queue( Payload_Len => Len);

  -- outbound and inbound messages queues
  -- those are meant to be accessed from outside the package too!
  out_q : M_Q.Queue;
  in_q  : M_Q.Queue;

  -- sender type of task: takes msgs out of out_q and sends them via UDP
  task type Sender( Port: Interfaces.Unsigned_16);

  -- receiver type of tasks: reads incoming msgs from UDP and puts them in in_q
  task type Receiver( Port: Interfaces.Unsigned_16);

private
  -- udp lib package with specified payload length
  package M_UDP is new UDP( Payload_Size => Len);

end Snd_Rcv;

As it can be seen above, the package simply packs in one place an outbound message queue (out_q), an inbound message queue (in_q) and the definitions of two types of tasks: the Sender and the Receiver. The two queues act effectively as mailboxes: all and any tasks from anywhere else are invited to just drop their outbound packages into out_q and /or get incoming packages from in_q. Note that both those queues are thread-safe so there is no concern here over who tries to read/write and when - at most, a task may end up blocked waiting on an empty queue (when trying to read a message) or on a full queue (when trying to write a message).

If the two out_q and in_q are mailboxes, then the two types of tasks, Sender and Receiver, are postmen. They share the same underlying UDP package that is private here (only postmen are allowed to use the UDP post van!) and has a fixed size of messages. Note that this fixed size is given as a parameter to the Snd_Rcv package itself and is then used both for the queues and for the UDP package. Essentially the snd_rcv package is a postal service that handles just one pre-defined length of messages. An application may use of course as many different lengths of message it requires - all it needs to do is to create a different snd_rcv package (i.e. "postal service") for each of those lengths. Note also that the actual ports used by the Sender and Receiver are given as parameters - an application can create as many Sender/Receiver tasks as it wants and even bind them to different ports or to the same port, as desired. This gives maximum flexibility: an application can listen for messages on one port and send them out on a different port, while still having everything in one single queue; or it can listen and send through the same port via any number of Sender/Receiver tasks. Each Sender and Receiver task will simply bind its own local socket and then enter an endless loop in which the Sender picks up messages from the out_q and sends them through its socket via UDP lib, while the Receiver picks up messages from its socket via the UDP lib and writes them into in_q. The corresponding code is short (and it's made slightly longer by my choice of having each Sender/Receiver use its own local socket):

 -- S.MG, 2018

package body snd_rcv is
  -- sender
  task body Sender is
    E       : M_UDP.Endpoint;
    S       : M_UDP.Socket;
    Payload : M_Q.Payload_Type;
    Dest    : M_UDP.Endpoint;
  begin
    -- open the socket on local interface, specified port
    E.Address := M_UDP.INADDR_ANY;
    E.Port := Port;
    M_UDP.Open_Socket( S, E );

    -- infinite loop reading from out queue and sending via udp
    -- caller will have to call abort to stop this!
    loop
      out_q.Get( Payload, Dest.Address, Dest.Port);
      M_UDP.Transmit( S, Dest, Payload);
    end loop;
  end Sender;

  -- receiver
  task body Receiver is
    E      : M_UDP.Endpoint;
    Source : M_UDP.Endpoint;
    S      : M_UDP.Socket;
    Payload: M_Q.Payload_Type;
    Valid  : Boolean;
  begin
    -- open the socket on local interface, specified port
    E.Address := M_UDP.INADDR_ANY;
    E.Port := Port;
    M_UDP.Open_Socket( S, E );

    -- infinite loop reading from out udp and writing to inbound queue
    -- caller will have to call abort to stop this!
    loop
      M_UDP.Receive( S, Source, Payload, Valid);
      -- store ONLY if valid, otherwise discard
      if Valid then
        in_q.Put( Payload, Source.Address, Source.Port);
      end if;
    end loop;

  end Receiver;

end snd_rcv;

An alternative approach to the above (and one that I have implemented at first) was to have a single task Snd_Rcv that bound one single socket and then started on it its own sub-tasks for the actual sender and receiver. However, I find such an approach needlessly complicated and inflexible: it creates an additional layer in the hierarchy of tasks for no clear benefit (perhaps it would make sense if one added some sort of additional management of the sender/receiver tasks in there but at the moment it's unclear that any such thing is actually needed or needed here of all places); it is harder to read with the single and so far unconvincing benefit of a shared socket (so no repeated binding code); it forces some choices on any application using this package: the sender/receiver are forced as a package so there is no more option of just listening on a port and/or just sending on it; there is also no option of listening on one port and sending on another or indeed of creating - if needed - more senders than receivers or the other way around. Sure, it can be argued that several senders and receivers are anyway not likely to be required or that binding too many is likely to just increase packet loss or any other trouble. This is however up to higher levels of the application rather than the concern of this thin sender/receiver and since this implementation offers both highest flexibility AND highest clarity, I think it's the best option so far. As usual, feel free to let me know in the comments your reasons for disagreeing with this and your better solution for implementing a sender/receiver layer.

The above tiny amount of code would be all for this chapter if it weren't for 3 things: the need to relax yet another few restrictions; an example/test of using the above sender/receiver package; my decision to include the UDP lib as just another package of SMG comms rather than keeping it as a separate lib. This last part concerning the UDP lib accounts for most lines in the .vpatch and is essentially some noise at this level (since vdiff is not yet bright enough to figure out a move of files). The reason for it is mainly the fact that the UDP code is really meant to be used from this snd_rcv package and from nowhere else so I can't quite see the justification in keeping it entirely separate, with a .gpr file and everything else of its own and moreover - perhaps more importantly from a practical point of view - unable to directly use the basic types of smg_comms in raw_types. Note that this move does *not* make it in any significant way more difficult to replace this UDP code with another at a later time if that becomes available - it's still one package and those pesky C files, nothing else.

Going back to the need to relax a few restrictions - those are mainly restrictions related to the use of tasks. As both Sender and Receiver work in infinite loops2, the caller has to ruthlessly abort them when it needs them to finish (in Ada a task has to wait for all its sub-tasks to finish before it can finish itself). So the "No_Abort_Statements" restriction needs to go. The use of Abort is illustrated in the test/example code I wrote aka test_client and test_server. Similarly, because of the queues that use protected objects, the "No_Local_Protected_Objects" restriction had to go too. Here I must say that I am not sure I fully grasp why would it be better to have protected objects only as global rather than local? They are of course meant to be accessed from many places and therefore in "global" but this doesn't mean that they don't still belong somewhere and/ or that "access from several places" has to mean "access from ALL places". Finally, the restriction "No_Nested_Finalization" also had to go to allow the testing code to create the snd_rcv packages with different length of messages.

The testing code itself provides more of an example of using the snd_rcv package rather than a test as such since UDP communications are unreliable and therefore one can't really say in advance what one should get on the other side of the connection. At any rate, the test_server package provides an example of a basic "echo server" end of the connection: there are 2 Sender and 2 Receiver tasks working with Serpent-length and RSA-length packages on 2 different ports, respectively; there is also a "consumer" task for each type of package, simply taking it out of the inbound queue, printing it at the console and then echoing it back to the source aka writing it into the outbound queue for the Sender to send. The example awaits for a pre-defined total number of packages so it may remain waiting if the other end sends fewer packages or fewer packages make it all the way. At any rate, once all the expected messages are received, the whole application (aka the main task) simply aborts all the tasks it created and then finishes itself:

 -- S.MG, 2018
with Ada.Text_IO; use Ada.Text_IO;
with Interfaces;
with Snd_Rcv;
with Raw_Types;

procedure Test_Server is
  PortRSA: Interfaces.Unsigned_16 := 44340;
  PortS  : Interfaces.Unsigned_16 := 44341;
  N_S    : Interfaces.Unsigned_8 := 105;
  N_RSA  : Interfaces.Unsigned_8 := 82;
  package Snd_Rcv_RSA is new Snd_Rcv(Raw_Types.RSA_Pkt'Length);
  package Snd_Rcv_S is new Snd_Rcv(Raw_Types.Serpent_Pkt'Length);

  -- sender/receiver tasks --
  -- sender RSA and Serpent
  Sender_RSA: Snd_Rcv_RSA.Sender( PortRSA );
  Sender_S  : Snd_Rcv_S.Sender( PortS );
  -- receiver RSA and Serpent
  Receiver_RSA: Snd_Rcv_RSA.Receiver( PortRSA );
  Receiver_S: Snd_Rcv_S.Receiver( PortS );

  -- Serpent Consumer
  task s_cons is
    Entry Finish;
  end s_cons;
  task body s_cons is
    Payload: Raw_Types.Serpent_Pkt;
    A: Interfaces.Unsigned_32;
    P: Interfaces.Unsigned_16;
  begin
    for I in 1..N_S loop
      -- consume one message and echo it back
      Snd_Rcv_S.in_q.Get(Payload, A, P);
      Put_Line("S msg " &
               Interfaces.Unsigned_8'Image(Payload(Payload'First)) &
               " from " & Interfaces.Unsigned_32'Image(A) &
               ":" & Interfaces.Unsigned_16'Image(P));
      -- echo it back
      Snd_Rcv_S.out_q.Put(Payload, A, P);
    end loop;

    accept Finish;
    Put_Line("S Cons got the finish.");
  end s_cons;

  -- RSA Consumer
  task rsa_cons is
    Entry Finish;
  end rsa_cons;
  task body rsa_cons is
    Payload: Raw_Types.RSA_Pkt;
    A: Interfaces.Unsigned_32;
    P: Interfaces.Unsigned_16;
  begin
    for I in 1..N_RSA loop
      -- consume one message and echo it back
      Snd_Rcv_RSA.in_q.Get(Payload, A, P);
      Put_Line("RSA msg " &
               Interfaces.Unsigned_8'Image(Payload(Payload'First)) &
               " from " & Interfaces.Unsigned_32'Image(A) &
               ":" & Interfaces.Unsigned_16'Image(P));
      -- echo it back
      Snd_Rcv_RSA.out_q.Put(Payload, A, P);
    end loop;

    accept Finish;
    Put_Line("RSA Cons got the finish.");
  end rsa_cons;

begin
  Put_Line("Test server");
  -- wait for consumers to finish
  rsa_cons.Finish;
  s_cons.Finish;

  -- abort the sender & receiver to be able to finish
  abort Sender_S, Receiver_S, Sender_RSA, Receiver_RSA;
end Test_Server;

Similarly to the server example code above, an example client sends both RSA and Serpent packages and has consumer and producer tasks for both:

 -- S.MG, 2018
with Snd_Rcv;
with Interfaces;
with Ada.Text_IO; use Ada.Text_IO;
with Raw_Types;
with UDP;

procedure Test_Client is
  PortRSA   : Interfaces.Unsigned_16 := 34340;
  PortS     : Interfaces.Unsigned_16 := 34341;
  N_S       : Interfaces.Unsigned_8 := 105;
  N_RSA     : Interfaces.Unsigned_8 := 82;

  Server    : String := "127.0.0.1";
  package test_udp is new UDP(10);
  ServerA   : Interfaces.Unsigned_32 :=
                test_udp.IP_From_String(Server);
  ServerRSA : Interfaces.Unsigned_16 := 44340;
  ServerS   : Interfaces.Unsigned_16 := 44341;
  package Snd_Rcv_RSA is new Snd_Rcv(Raw_Types.RSA_Pkt'Length);
  package Snd_Rcv_S is new Snd_Rcv(Raw_Types.Serpent_Pkt'Length);
  -- sender RSA and Serpent
  Sender_RSA: Snd_Rcv_RSA.Sender( PortRSA );
  Sender_S  : Snd_Rcv_S.Sender( PortS );
  -- receiver RSA and Serpent
  Receiver_RSA: Snd_Rcv_RSA.Receiver( PortRSA );
  Receiver_S: Snd_Rcv_S.Receiver( PortS );

  -- producer of serpent messages
  task s_prod is
    entry Finish;
  end s_prod;
  task body s_prod is
    Payload : Raw_Types.Serpent_Pkt := (others => 10);
  begin
    Put_Line("S Producer with " &
             Interfaces.Unsigned_8'Image(N_S) & "messages.");
    -- send the messages with first octet the number
    for I in 1..N_S loop
      Payload(Payload'First) := I;
      Snd_Rcv_S.out_q.Put( Payload, ServerA, ServerS);
      Put_Line("Sent S message " &
                Interfaces.Unsigned_8'Image(I));
    end loop;

    -- signal it's done
    accept Finish;
    Put_Line("S prod got the finish.");

  end s_prod;

  -- producer of RSA messages
  task rsa_prod is
    Entry Finish;
  end rsa_prod;
  task body rsa_prod is
    Payload : Raw_Types.RSA_Pkt := (others => 20);
  begin
    Put_Line("RSA Producer with " &
             Interfaces.Unsigned_8'Image(N_RSA) & "messages.");

    -- send the messages with first octet the number
    for I in 1..N_RSA loop
      Payload(Payload'First) := I;
      Snd_Rcv_RSA.out_q.Put( Payload, ServerA, ServerRSA);
      Put_Line("Sent RSA message " &
                Interfaces.Unsigned_8'Image(I));
    end loop;

    -- signal it's done
    accept Finish;
    Put_Line("RSA prod got the finish.");

  end rsa_prod;

  -- Serpent Consumer
  task s_cons is
    Entry Finish;
  end s_cons;
  task body s_cons is
    Payload: Raw_Types.Serpent_Pkt;
    A: Interfaces.Unsigned_32;
    P: Interfaces.Unsigned_16;
  begin
    for I in 1..N_S loop
      -- consume one message
      Snd_Rcv_S.in_q.Get(Payload, A, P);
      Put_Line("S msg " &
               Interfaces.Unsigned_8'Image(Payload(Payload'First)) &
               " from " & Interfaces.Unsigned_32'Image(A) &
               ":" & Interfaces.Unsigned_16'Image(P));
      -- do NOT echo it back
    end loop;

    accept Finish;
    Put_Line("S Cons got the finish.");
  end s_cons;

  -- RSA Consumer
  task rsa_cons is
    Entry Finish;
  end rsa_cons;
  task body rsa_cons is
    Payload: Raw_Types.RSA_Pkt;
    A: Interfaces.Unsigned_32;
    P: Interfaces.Unsigned_16;
  begin
    for I in 1..N_RSA loop
      -- consume one message
      Snd_Rcv_RSA.in_q.Get(Payload, A, P);
      Put_Line("RSA msg " &
               Interfaces.Unsigned_8'Image(Payload(Payload'First)) &
               " from " & Interfaces.Unsigned_32'Image(A) &
               ":" & Interfaces.Unsigned_16'Image(P));
      -- do NOT echo back
    end loop;

    accept Finish;
    Put_Line("RSA Cons got the finish.");
  end rsa_cons;
begin
  Put_Line("Test client");
  -- wait for producers/consumers to finish
  rsa_prod.Finish;
  s_prod.Finish;
  rsa_cons.Finish;
  s_cons.Finish;

  -- abort the sender & receiver to be able to finish
  abort Sender_S, Receiver_S, Sender_RSA, Receiver_RSA;
end Test_Client;

One important issue to note here is the way in which exceptions (hence: potential issues) will be handled in this specific implementation of the Snd_Rcv package: since the Sender and Receiver are tasks and don't handle any exceptions themselves, it means that an UDP "eggog" aka exception3 will have as effect the silent death of the Sender/Receiver in which it happens4. I did consider ways of handling such exceptions rather than letting them kill the task silently but so far at least I don't quite see what the task itself can do other than re-trying whatever it was trying to do when it failed. While this could perhaps be considered a better option than not handling exceptions at all, it's been pointed to me that UDP errors mean almost always some hardware failure and as such a re-try is not going to help at all. Moreover, re-trying means also that the failure remains hidden from the calling task since there is no way in which one would be able to tell whether a task is just stuck re-trying or actually proceeding with its work just fine. Considering all this, I decided to leave it for now to the higher level task to monitor its subtasks if/when desired and take action accordingly (e.g. check perhaps periodically if a Sender/Receiver is Terminated or in other abnormal state). This doesn't mean of course that the code can't be changed at a later date to provide a different approach to handling this - all it means is that currently this is the best decision I can see given what I know so far.

With this chapter, the SMG Comms code provides everything that is needed to build on top of it a basic client for Eulora that is compliant with the published communication protocol. So I'd suggest to anyone interested in this to give it a go since starting now means that they would have some time to tinker with it before everything else is in place! At any rate, the SMG Comms series takes at least a break for now (at a later stage there should be a few bits and pieces to add) as I'll focus for a while more on the server-side moving parts that need to be done before Eulora can finally fully work on a sane protocol. The full .vpatch for this chapter and my signature for it:


  1. It's a pleasure to use Ada's implementation of threads aka tasks. But it still can take me a while to be able to say I get something to some reasonable degree - even when the something in question is actually a good implementation of threads, what can I do. 

  2. And note that even if I'd implement this with a select to allow some sort of "Shutdown" option, the task could still be stuck waiting on a queue or on UDP since the calls to those are blocking when there is nothing to retrieve yet/no place to write to; so the caller would STILL have to do an abort or at least to be prepared to do abort if the shutdown is not obeyed within some interval. In a nutshell, a shutdown option would therefore still not work at *all times* and as a result I can't quite see why bother with it really. 

  3. There are currently 7 of those with clear names: UDP_Invalid_Text_IP, UDP_Failed_Open, UDP_Failed_SetOpt, UDP_Bind, UDP_Failed_Transmit, UDP_Truncated_Send, UDP_Failed_Receive. 

  4. In Ada the exceptions are not propagated to the parent task since they would be potentially too disruptive and I can see that quite clearly. 

December 13, 2018

SMG Comms Chapter 12: Thread-Safe Queues

Filed under: Coding, SMG_Comms — Diana Coman @ 4:53 p.m.

~ This is a work in progress towards an Ada implementation of Eulora's communication protocol. Start with Chapter 1.~

The various message types of Eulora's communication protocol are mostly implemented by now1 in chapters 1 - 11 of this series. What remains is the actual UDP communication and for this part I'm importing into SMG Comms Stanislav's neat UDP lib. Since Eulora effectively uses the size of the message to cheaply distinguish between RSA and UDP, it follows that any implementation of the protocol will have to support those two sizes (rather than one single fixed size as the original UDP lib imposes). There are several ways to do this2 but the main thing is that "any arbitrary size" is neither needed by SMG Comms as such nor worth the trouble. At the other extreme, copy/pasting the UDP lib code to have two packages that differ only by a constant is rather idiotic. So the middle ground is to use Ada's generic mechanism that allows one to parametrize code: the UDP lib package will expose the length as a parameter of the package as a whole and the client/server code will then simply create a UDP_RSA and a UDP_Serpent package types with their corresponding, fixed sizes. The only downside to this approach is that it breaks some of the existing restrictions but as previously stated, the point was not in having restrictions for the sake of having them but simply in having a good reason for any removal of any restriction. The need for UDP lib to handle those 2 different packet sizes counts in my eyes as a good reason to allow the generic mechanism.

With the UDP lib code, the most basic implementation of the protocol specification could be considered complete3. Basically the code provides everything that is needed to send and receive the messages in the format and through the communication means specified. However, in practice, Eulora will likely require a type of thread-safe queues for any processing of messages after they came in through the UDP socket and/or before they are sent. The reason for this is two-fold: first, it makes sense to decouple the send/receive via UDP from message processing; second, the encryption/decryption part required by the protocol can be relatively slow (especially for RSA) and as a result it's not the sort of thing that makes sense handled directly by the Sender/Receiver immediately on top of the UDP lib. Ideally, the Receiver would simply pass on a new message as soon as it gets it from UDP so that there is no queue forming at the lower level (since messages can then get lost/discarded simply). Arguably the Sender side can just fire the messages as soon as it receives a request to send them, since there is no additional delay there - although it could end up then either firing too many too quickly resulting in more losses than usual or otherwise becoming a bottleneck for the whole application on top of it. At any rate, the exact designs of Senders and Receivers are not part of the protocol itself - any Eulora client can implement those as it sees fit. Still, since I'm quite sure I'll need multiple tasks on the server, I'll include at least the means to decouple send/receive of rsa/serpent messages from any processing, namely a queue that can safely handle put/get calls from any number of tasks (e.g. the receiver will put messages into this queue while any number of worker tasks can then be created to process those messages in any way).

A thread-safe queue is of course nothing new and as such Ada seems to provide different mechanisms for implementation but the one that seems the most straightforward and adequate for this taks is the "protected variable": according to my Ada reference book4, the whole point of a protected variable is precisely to control the access to some protected resource. The resource itself (in this case the actual queue) is declared as private to the protected object and access to it is provided only through two procedures, Get and Put, with the important specific characteristic that calls to those procedures (and in general to any of the procedures of a protected object) are mutually exclusive. So no matter how many tasks call Get and Put and in what order, at any given time, only one task will proceed with one of Get or Put and moreover, no other task will get to enter either of those before the first task has finished. Moreover, the entry to both Get and Put can be effectively guarded by additional conditions: Get should proceed only when there is at least one item in the queue while Put should only proceed when the queue is NOT full. Using all this together with modular types for the index makes it quite easy to define a circular queue of fixed size that allows only mutually exclusive calls of Put and Get:

 -- FIFO queue of UDP messages with protected read/write (thread-safe).
 -- S.MG, 2018

with Raw_Types;
with Interfaces;

generic
  -- exact length of payload of items in the queue (1470 or 1472 in Eulora)
  Payload_Len: in Positive;

package Msg_Queue is

  -- payload type
  subtype Payload_Type is Raw_Types.Octets(1..Payload_Len);

  -- maximum length of the message queue
  Max_Q_Len: constant := 1024;

  -- index in the queue will be modular type
  type Index is mod Max_Q_Len;

  -- an item in the queue; IP/port stored only for the "other" (variable) end.
  type Msg is
    record
      Payload    : Raw_Types.Octets(1..Payload_Len);
      IP_Address : Interfaces.Unsigned_32;
      IP_Port    : Interfaces.Unsigned_16;
    end record;

  -- an array of messages
  type Msg_Array is array(Index) of Msg;

  -- the actual queue of messages, as a protected type
  protected type Queue is
    -- adds the given entry to the queue if there is space; BLOCKS if no space
    entry Put(Payload : in Payload_Type;
              Address : in Interfaces.Unsigned_32;
              Port    : in Interfaces.Unsigned_16);

    -- reads next entry from queue when available; BLOCKS if no entries
    entry Get(Payload : out Payload_Type;
              Address : out Interfaces.Unsigned_32;
              Port    : out Interfaces.Unsigned_16);

  private

    Q: Msg_Array;
    Read_Pos, Write_Pos: Index := Index'First;
    Count: Natural range 0..Max_Q_Len := 0;
  end Queue;

end Msg_Queue;

You might have noticed in the code above that I made the Msg_Queue type generic, with a single parameter that represents the length of the payload of a message that is stored in the queue: this is needed for the same reason as the generic at UDP lib previously - to allow one to store Serpent messages or RSA messages while maintaining them clearly differentiated5. Note that the package defines internally types for the items stored in the queue but the Put/Get methods use 3 parameters rather than the "Msg" record structure - the reason for this is that it makes it easier for callers to use the queue with existing types rather than having to create a new structure just for reading from the queue/writing to the queue. The corresponding implementation in msg_queue.adb:

 -- S.MG, 2018

package body Msg_Queue is
  protected body Queue is
    entry Put(Payload : in Payload_Type;
              Address : in Interfaces.Unsigned_32;
              Port    : in Interfaces.Unsigned_16)
          when Count < Max_Q_len is
      M: Msg;
    begin
      -- fill the Msg item structure
      M.Payload    := Payload;
      M.IP_Address := Address;
      M.IP_Port    := Port;
      -- add it to queue and update counter + pos
      Q( Write_Pos ) := M;
      Write_Pos := Write_Pos + 1;
      Count := Count + 1;
    end Put;

    entry Get(Payload : out Payload_Type;
              Address : out Interfaces.Unsigned_32;
              Port    : out Interfaces.Unsigned_16)
            when Count > 0 is
      M: Msg;
    begin
      M := Q( Read_Pos );
      Payload := M.Payload;
      Address := M.IP_Address;
      Port    := M.IP_Port;
      Read_Pos := Read_Pos + 1;
      Count := Count - 1;
    end Get;

  end Queue;
end Msg_Queue;

As you can see above, a call to Put may proceed only when Count < Max_Q_Len, meaning that the queue is NOT full. Symmetrically, a call to Get may proceed only when Count > 0, meaning that the queue is not empty. The Count variable is updated by both Put and Get to reflect at any given time the exact number of elements in the queue - note that this is needed as a separate variable because the queue is circular and so the indices in the queue are modular types. The modular type is very handy here as the indices will simply roll over when they get to the maximum value and so there is no possibility of attempting to read/write out of the queue boundaries. Combined with the guards for Get/Put on Count, there is no possibility of overwriting items in the queue either. Win.

The only potential downside to choosing this approach to implement the queue as a protected object is that there are yet more restrictions to relax: max_protected_entries can't be 0 anymore, since we are introducing... a protected object, yes; no_protected_types can't remain either for the obvious reason; simple_barriers can't remain because the code uses the variable Count to guard Put/Get (i.e. not a constant) - however, pure_barriers remains in place since the variable is local to Msg_Queue (and I think that how it should actually be at any rate). There are also the task-related restrictions that need to be relaxed when the Msg_Queue is used since there will be presumably some... tasks defined: max_task_entries, no_task_hierarchy, max_tasks, max_select_alternatives. Obviously, the exact list of task-related restrictions that you can keep depends on what tasks you define. The previous list is what I had to relax for some testing.

To see the above in action and at the same time to get a bit more practice with Ada tasks (aka threads), I wrote a basic test that just "reads" and "writes" stuff to a Msg_Queue. The test makes use of worker tasks but it doesn't throw delays in as well. At any rate, any "testing" for multi-threaded code is a rather dubious proposition since one can't even quite control what code gets called when exactly. So as I was saying: more of an exercise/example than a test but anyway, here's the definition of the Worker task type in tests/q_pkg.ads:

 --S.MG, 2018

with Msg_Queue;
with Ada.Text_IO; use Ada.Text_IO;
with Interfaces; use Interfaces;
with Raw_Types;
with RNG;

package Q_Pkg is
  procedure Start;
private
  package MQ is new Msg_Queue(Payload_Len => 10);
  Q: MQ.Queue;

  task type Worker is
    Entry Start(A: in Unsigned_32;
                P: in Unsigned_16;
            Times: in Positive;
            Write: in Boolean);
  end Worker;

  W: array(1..10) of Worker;

end Q_Pkg;

The corresponding implementation in tests/q_pkg.adb:


package body Q_Pkg is
  procedure Start is
    U32: Unsigned_32 := 100;
    U16: Unsigned_16 := 1;
    Write: Boolean;
  begin
    Put_Line("Start");
    for I in 1..W'Length loop
      if I mod 2 = 0 then
        Write := False;
      else
        Write := True;
      end if;
      W(I).Start(U32, U16, W'Length-I+10, Write);
      U32 := U32 + 1;
      U16 := U16 + 1;
    end loop;
  end Start;

  task body Worker is
    Pay: MQ.Payload_Type := (others => 0);
    Address: Unsigned_32;
    Port : Unsigned_16;
  begin
    accept Start(A: in Unsigned_32;
                 P: in Unsigned_16;
             Times: in Positive;
             Write: in Boolean) do
      if Write then
        for I in 1 .. Times loop
          Pay(Pay'First) := Unsigned_8( I mod 256 );
          Pay(Pay'First+1) := Unsigned_8( (I / 256) mod 256);
          Q.Put( Pay, A, P );
          Put_Line(Integer'Image(I) & "." &
                   Unsigned_32'Image(A) & "." & Unsigned_16'Image(P) &
                   " WROTE: " & Unsigned_8'Image(Pay(Pay'First)) &
                   Unsigned_8'Image(Pay(Pay'First+1)));
        end loop;
      else
        for I in 1 .. Times loop
          Q.Get( Pay, Address, Port );
          Put_Line(Integer'Image(I) & "." &
                   Unsigned_32'Image(A) & "." & Unsigned_16'Image(P) &
                   " read: " & Unsigned_8'Image(Pay(Pay'First)) &
                   Unsigned_8'Image(Pay(Pay'First+1)) &
                   " from " & Unsigned_32'Image(Address) & "." &
                   Unsigned_16'Image(Port));
        end loop;
      end if;
    end Start;
  end Worker;

end Q_Pkg;

The "test" itself simply calls Q_Pkg.Start that will iterate through a set of Worker tasks and ask those on even positions to read and those on odd positions to write to the queue (the address/ip parts of "messages" are used here to identify the workers so that one can follow the whole output):

 -- Basic example of using a message Queue with multiple readers/writers
 -- S.MG, 2018

with Q_Pkg;
procedure Test_Queue is
begin
  Q_Pkg.Start;
end Test_Queue;

The next step would now be to actually implement an example of sender/receiver. I've been thinking on this for a while but it's still not very clear to me what would be most useful here or how the sender and receiver should exactly look like. For starters, I'm not even sure whether a sender/receiver should be in fact part of smg_comms or whether it's better to leave them out, as they are strictly speaking outside of the communication protocol itself and a matter for the client/server to decide. The argument for including them (or at least some version/example of them) is that some version of them will be needed at any rate so having an example to start from is likely to help anyone who wants to implement a client. However, what is "basic" version can be a thorny issue and moreover, once some "basic" version is there, there's also a great pull towards using that one as "default" rather than basic. As to more specific questions: should both the sender and the receiver use their own Msg_Queue (i.e. outbound queue for sender to read from and inbound queue for receiver to write into) and otherwise share a socket? Or should just the receiver use a queue since sending is a much thinner layer here (messages are already fully prepared so it's just a call to the UDP lib with the already bound socket)? What should sender/receiver even do with exceptions thrown by the UDP lib, should they handle them all/ just some/none? How should sender/receiver handle potential blocks on writing to/reading from the queues (do they wait a certain amount of time, do they check and signal when queue is fuller than some percentage, so they do something else - what)?

In a word, the sender/receiver part still requires some discussion it would seem since some choices need to be made even if just for now. At any rate, here's the .vpatch for this chapter, together with my signature for it, as usual:


  1. The few that are not yet implemented are also not yet fully specified - some practical experience with an implementation, even partial, can help to flesh those out better too. 

  2. The way it's usually done in C being the least beneficial one - it forces upon the code all the potential issues of "any size *could* be fine" without much advantage to claim for it since no program is really likely to use all possible sizes at the same time anyway. 

  3. And it's about time, too! Looking at the date for Chapter 1, it's been 3 months almost to the day already. 

  4. John Barnes, "Programming in Ada 2012", Cambridge University Press, 2014, p. 515 

  5. Since sizes are quite similar, one could otherwise simply use the larger size when defining the item type and then just fill in only as much as needed. The unpleasant effect of this however is that one then needs to also store somewhere else the actual used length. And given that I'm already using generic for the UDP lib, there's really no point in going to such lengths to avoid it here. So the Msg_Queue is a generic type - any code using it will first have to create a specific type out of it by providing a concrete length of payloads stored. 

December 6, 2018

SMG Comms Chapter 11: Arbitrary Size of Public Exponent

Filed under: Coding, SMG_Comms — Diana Coman @ 10:59 a.m.

~ This is a work in progress towards an Ada implementation of Eulora's communication protocol. Start with Chapter 1.~

The change from fixed-size to arbitrary size of the public exponent "e" of RSA keys1 turned out to be of course more than just introducing a parameter for e's size - all I can say about it is that I was rather ready for this development by now, given the known mess that is the MPI lib. So the only surprise here was the exact way in which MPI fails rather than the fact that it does fail. Let's take it slowly and in detail since it is - like everything else related to encryption - rather important to have it as clear as one can make it.

On the SMG Comms side, a shorter "e" is really no trouble at all: basically there is no such thing as "shorter" since it can perfectly be the same size as it always was, only starting with whatever number of 0s it needs to make up to the expected length, big deal. And this is in fact already handled and handled well in the wrappers I wrote previously for the RSA and MPI C code, since it was already clear that yes, any set of octets might start at any time with 0s but that doesn't make them fewer octets or anything of the sort. So at first look, there really isn't any need to change anything, since the "change" required is neatly and natively handled as what it is - just a specific case of the more general operation that is implemented. Still, for clarity and further use downstream, I decided to add a constant and a new subtype to Raw_Types simply for the purpose of providing an explicit way of using the exactly-8-octets-long e (neither the new constant nor the new subtype are put to use so far by any of the message pack/unpack or read/write methods):

    -- RSA public exponent (e) size in octets
    -- NB: this should normally match the E_LENGTH_OCTETS in smg_rsa.h
    -- NOT imported here for the same reason given at RSA_KEY_OCTETS above
  E_LENGTH_OCTETS : constant Positive := 8;

  subtype RSA_e is Octets( 1 .. E_LENGTH_OCTETS);

On the RSA side, the same constant "length of e in octets" goes into include/smg_rsa.h since it is not exactly a knob of the whole thing but rather a parameter for RSA key generation:

/**
 * This is the length of the public exponent e, given in octets.
 * TMSR standard e has KEY_LENGTH_OCTETS / 2 octets.
 * Eulora's communication protocol uses however e with 8 octets length.
 * New keypairs generated will have e precisely this length.
 * Change this to your preferred size of e for generating new keys with that size of e.
 * NB: this impacts key generation ONLY! (i.e. NOT encrypt/decrypt).
 */
static const int E_LENGTH_OCTETS = 8;

As the comments above stress, the "length of e" should normally be a concern in the code only when generating a new key pair; at all other times (encrypt/decrypt), the e that is provided will be used, whatever length it might be. Looking at the key generation code, the change to make is minimal since the code is sane - simply replace a local variable that specified the length of the required prime with the new global constant that now specifies the user's choice of length for e (in rsa/rsa.c, function gen_keypair):

	/* choose random prime e, public exponent, with 3 < e < phi */
	/* because e is prime, gcd(e, phi) is always 1 so no need to check it */
	do {
		gen_random_prime( E_LENGTH_OCTETS, sk->e);
	} while ( (mpi_cmp_ui(sk->e, 3) < 0) || (mpi_cmp(sk->e, phi) > 0));

Following the changes above, a re-read of all my rsa and smg_comms code confirmed that no, there is nothing else to change - it is after all just a matter of exposing a constant to the user, not any change of the underlying algorithm, so that's surely all, right? Well, no, of course it's not, because at the lower level, all those 0-led smaller "e" go into the MPI lib of gnarly entrails. And as it turns out, a quick test whipped out to see the whole thing in action got...stuck, going on for ever somewhere in the MPI code. Where? Well, the stack trace goes 8 levels deep into the MPI code and it looks (at times, as it rather depends on where one stops the neverending run...) like this:

#0  0x000000000040b492 in mpihelp_addmul_1 ()
#1  0x0000000000407cd4 in mpih_sqr_n_basecase ()
#2  0x0000000000407e68 in mpih_sqr_n ()
#3  0x0000000000408098 in mpih_sqr_n ()
#4  0x0000000000407d6b in mpih_sqr_n ()
#5  0x0000000000408098 in mpih_sqr_n ()
#6  0x0000000000407d6b in mpih_sqr_n ()
#7  0x0000000000405693 in mpi_powm ()

Claiming that one fully knows what goes on in 8 piled levels of MPI calls is rather disingenous at best so I won't even go there. However, a closer look at all that code, starting with mpi_powm and following the code seems to suggest that the issue at hand is that MPI simply can't handle correctly 0-led numbers. To which one should add of course "in some cases" so that one can't just say fine, wtf is it doing permitting any 0-led numbers then?? No, that would be too easy so the reality is that it permits and it probably even *requires* in places 0-led numbers but *in other places* it gets stuck2 on them. Aren't you happy to have followed this mess so far to such amazing conclusion? At any rate, going through the MPI code yields some more fun of course, such as this fragment in mpi-pow.c:

    /* Normalize MOD (i.e. make its most significant bit set) as required by
     * mpn_divrem.  This will make the intermediate values in the calculation
     * slightly larger, but the correct result is obtained after a final
     * reduction using the original MOD value.  */
    mp = mp_marker = mpi_alloc_limb_space(msize, msec);
    count_leading_zeros( mod_shift_cnt, mod->d[msize-1] );
    if( mod_shift_cnt )
  mpihelp_lshift( mp, mod->d, msize, mod_shift_cnt );
    else
  MPN_COPY( mp, mod->d, msize );

The obvious clue there is that at least one culprit of "can't handle 0-led numbers" is that divrem function that is indeed called as part of the exponentiation. But the added joke that's for insiders only is that the normalization there is done ad-hoc although there exists a function precisely for...normalizing aka trimming the leading 0s from an mpi! Eh, so what if it exists - by the time something gets as big and tangled as MPI, chances are nobody remembers everything there is but that's not a problem at all, right? But wait, just ~10 lines further down, there is another normalization and at *that* place, the author somehow remembered that there is even a macro defined for this purpose! And oh, another ~10 lines further, there is yet another way in which normalization is done on the spot (shifting the bits directly!). So what is it already that makes one write code like this, some misplaced purple-prose inclination, let's not repeat the same expression or what exactly? Frankly the only logical answer is that it's done on purpose - anything and everything to increase the number of lines of code. Increase productivity3 !!

Moving further, it turns out that this very same function actually *does* trim the leading 0s off the exponent at some point! Which of course begs now the question of just how and why is then a problem to give it a 0-led exponent? Essentially it trims it but too late/not fully/not for everything and not everywhere that it should do it, that's the best I can say about it. And overall, the fact of the matter is simply that MPI just doesn't correctly handle 0-led MPI values4, end of story. To quote from MPI code and comments themselves, the author's explanation:

/****************
 * Sometimes we have MSL (most significant limbs) which are 0;
 * this is for some reasons not good, so this function removes them.
 */

So it is "for some reasons not good", mmkay? It reminds me of the other display of great expertise in "reasons". Without wasting even more time on the MPI code of wonders5, the solution for SMG Comms is essentially a work around: the C wrappers get another job, namely to ensure that the values passed on to MPI are normalized. Note that the symmetrical opposite of this, namely adding missing leading 0s is already implemmented where needed (in the Ada code that actually deals perfectly fine with 0-led values since they are not oh-so-special, really). Thankfully, this is a very simple thing to do: instead of using directly the mpi_set_buffer method to set the value of an mpi number, define an mpi_set_normalized method that calls mpi_set_buffer + mpi_normalize:

void mpi_set_normalized(MPI m, const char *buffer,
                        unsigned int noctets, int sign) {
  mpi_set_buffer( m, buffer, noctets, sign );
  mpi_normalize( m );
}

Using the above code, all the mpi_set_buffer calls in c_wrappers are replaced by mpi_set_normalized calls and so there are no more 0-led mpi values passed on to the C code when calling rsa from Ada (since this is the purpose of those c_wrappers: to provide a sane interface for Ada to work with the insanity of C for RSA needs). Obviously, if you insist on calling the C rsa encrypt/decrypt methods directly, it's up to you to make sure you don't pass them 0-led values. While I could change the encrypt/decrypt methods themselves to normalize all the keys' components before doing anything, I think that's a very ugly and ultimately incorrect thing to do: the encrypt/decrypt should use precisely what they are given, not go about tampering with the inputs, regardless of "reasons". Yes, it is ugly and incorrect that MPI forces this normalization nonsense but that's not a justification for messing the encrypt/decrypt functions to cover up for it.

Note also that I specifically chose NOT to include the normalization in the existing method mpi_set_buffer because on one hand it's not the job of mpi_set_buffer to trim its inputs and on the other hand there is a need for mpi_set_buffer precisely as it is: there is code in there relying on being able to set the buffer of an mpi to anything, including 0-led vectors (even if at times, that doesn't remain 0-led for long). So no, modifying mpi_set_buffer is not a good option, even without considering the fact that MPI is better thrown away6 than changed.

The rest of the .vpatch for this chapter of SMG Comms contains simply the 2 additional tests (and changes needed for them in the test environment) that I wrote: one for the RSA c code, to flag the issue and one for the Ada code to ensure that there is at least one test with an exponent of 8 octets. I've used first the rsa code with the length of e set to 8 to generate a pair of RSA keys that are used then for the new test. So there is now a new file, "8_keys.txt" containing this new set of keys and the Ada test is simply another call with different parameters to read its input from this file as opposed to another.

Given that the arbitrary size of e touches essentially EuCrypt code, I also packed those minimal changes to smg_rsa.h and to key generation, together with the new test using a shorter e, into a .vpatch for EuCrypt. I've also added in there stern warnings at the encrypt/decrypt regarding the 0-led issue since it is the responsibility of the caller to either make sure they don't provide 0-led values or otherwise deal with a potentially-blocking call. Both .vpatch files and their corresponding signatures are on my Reference Code Shelf as well as linked here for your convenience:


  1. In practice this is more like 8-octets size for Eulora and otherwise 256 octets for TMSR rather than all sorts of sizes. Nevertheless, the big change is from one single size to ~anything more than one size since that means that the size can't be relied on to be anything specific at any given time. 

  2. Or as good as stuck: I did not have the patience to wait on it for more than 3 minutes, given that the operation in question should have barely taken a couple of seconds at maximum. 

  3. And probably surpass the 5-years plan too, since it's hardly distinguishable already. 

  4. Or, apparently, only values with "too many" 0 at the front aka at least one limb. 

  5. Yes, I did actually dig even deeper into the MPI code following this because I don't really have a choice not to as long as MPI remains part of SMG Comms and EuCrypt. The conclusion however is still the same, so I'm jumping here to the conclusion and you are free to tell me in detail in the comments section the results of your investigation on this. 

  6. Hopefully there will soon be a replacement for it and so it WILL be thrown away, I can't wait for that! 

November 30, 2018

SMG Comms Chapter 10: Actions and RSA Keys

Filed under: Coding, SMG_Comms — Diana Coman @ 1:57 p.m.

~ This is a work in progress towards an Ada implementation of Eulora's communication protocol. Start with Chapter 1.~

Eulora's communication protocol uses RSA keys only for new players who don't yet have a set of Serpent keys agreed on for communication with the server. The main reason for not using RSA for all client-server communications is simply that RSA is essentially too expensive for that. As it happens, it turns out that republican RSA with its fixed-size 256 octets (2048 bits) public exponent is anyway too expensive even for this reduced role - communicating all those octets to the server inside a RSA package takes quite a lot of space. As a result, Eulora will use a smaller e, on only 8 octets (64 bits) that fit neatly into the message structure for requesting a new account in the game (5.1 RSA key set). This means of course that I'll also have to patch EuCrypt to allow arbitrary size of the public exponent in order to have a way to actually generate such RSA key pairs but this will have to be the next step and another post on its own. For now, at the level of read/write from/to SMG Comms messages, there's no direct concern with the crypto lib itself: the e will simply be 8 octets long at its specified place in the message and that is that.

Since the RSA Key Set message includes also some client information (protocol version and subversion, client hash, preferred padding), I've first defined a new data structure (in data_structs.ads) to hold all this in one place:

  type Player_RSA is
    record
      -- communication protocol Version number
      Proto_V    : Interfaces.Unsigned_8;

      -- communication protocol Subversion number
      Proto_Subv : Interfaces.Unsigned_16;

      -- Keccak hash of client binary
      Client_Hash: Raw_Types.Octets_8;

      -- public exponent (e) of RSA key (64 bits precisely)
      -- nb: this is protocol-specific e, aka shorter than TMSR e...
      e          : Raw_Types.Octets_8;

      -- public modulus (n) of RSA key (490 bits precisely)
      n          : Raw_Types.RSA_len;

      -- preferred padding; magic value 0x13370000 means random padding
      Padding    : Raw_Types.Octets_8;

    end record;

The choice to have the new structure shown above comes mainly from the fact that all the information in there is on one hand related (as it belongs to and describes one specific player at any given time) and on the other hand of no direct concern to this part of code. In other words, this part of the code reads and writes that information together but it has no idea regarding its use (nor should it have). It's for this same reason also that I preferred to keep e and n simply as members like any others of the Player_RSA record rather than having them stored already inside a RSA_pkey structure. For one thing there's no need for the read/write part to even know about the RSA_pkey structure (which is defined in rsa_oaep.ads where it belongs). And for another thing, having e and n as members of the record just like any others keeps the code both clear and easy to change in principle at a later time. Basically the read/write do as little as they can get away with - there is even no attempt to interpret e for instance as a number although its reduced size makes that possible here. Note that the protocol version and subversion are however interpreted as integers but in their case there's no point to keep them as raw octets. On the other hand, the choice of padding is kept as raw octets precisely because this is how it will be needed and used anyway.

Choosing the correct place for storing the padding option also gave me a bit to think about because it's not fully clear to me at this stage exactly where the padding belongs. Strictly speaking, padding is entirely the job of this level so there shouldn't normally be any leaking outside/upwards of anything to do with it. However, having the ability to choose types of padding means that the protocol itself effectively pushes this particular aspect upwards since it's the user ultimately who makes this choice. As a result, I decided to keep the mechanics of padding local (i.e. actual padding of messages + the magic value for requesting random padding + the interpretation of a padding parameter) while providing this Padding value in the Player_RSA record and otherwise refactoring all the Write procedures to require a Padding parameter indicating the desired choice of padding for that write. Moreover, to have this padding stuff in one single place, I also extracted the writing of counter+padding into its own procedure and then refactored all the Write procedures to call this one (since ALL messages always have at the end precisely a counter + padding). The main benefit to this is that it reduces the chances of making an error in one of the multiple places where otherwise one has to write the counter and then check the requested padding and then pad (if needed) accordingly. Other than this benefit, there isn't necessarily a big reduction in number of code lines nor really much an increase in clarity of the code since there is another procedure call to follow in there. Nevertheless, the alternative is worse: having copy-pasted same stuff in every write procedure and having to change all of it if anything changes. So here's the new Write_End procedure which is private to the Messages package since this is just a helper for all the other Write procedures:

  -- Writes Counter and padding (rng or otherwise) into Msg starting from Pos.
  procedure Write_End( Msg     : in out Raw_Types.Octets;
                       Pos     : in out Natural;
                       Counter : in Interfaces.Unsigned_16;
                       Padding : in Raw_Types.Octets_8) is
  begin
    -- check that there is space for Counter at the very least
    if Pos > Msg'Last - 1 then
      raise Invalid_Msg;
    end if;

    -- write counter
    Write_U16( Msg, Pos, Counter );

    -- pad to the end of the message
    if Pos <= Msg'Last then
      if Padding = RNG_PAD then
        RNG.Get_Octets( Msg( Pos..Msg'Last ) );
      else
        -- repeat the Padding value itself
        for I in Pos..Msg'Last loop
          Msg(I) := Padding( Padding'First + (I - Pos) mod Padding'Length );
        end loop;
      end if;
      -- either rng or fixed, update Pos though
      Pos := Msg'Last + 1;
    end if;
  end Write_End;

After the above changes, the read/write procedures for RSA key set from/to RSA messages are quite straightforward to write:

  procedure Write_RKeys_RMsg( K       : in Player_RSA;
                              Counter : in Interfaces.Unsigned_16;
                              Pad     : in Raw_Types.Octets_8;
                              Msg     : out Raw_Types.RSA_Msg) is
    Pos : Natural := Msg'First + 1;
  begin
    -- write correct message type
    Msg( Msg'First ) := RKeys_R_Type;

    -- write protocol version and subversion
    Msg( Pos ) := K.Proto_V;
    Pos := Pos + 1;
    Write_U16( Msg, Pos, K.Proto_Subv );

    -- write keccak hash of client binary
    Msg( Pos..Pos + K.Client_Hash'Length-1 ) := K.Client_Hash;
    Pos := Pos + K.Client_Hash'Length;

    -- write e of RSA key
    Msg( Pos..Pos + K.e'Length - 1 ) := K.e;
    Pos := Pos + K.e'Length;

    -- write n of RSA key
    Msg( Pos..Pos + K.n'Length - 1 ) := K.n;
    Pos := Pos + K.n'Length;

    -- write preferred padding
    Msg( Pos..Pos + K.Padding'Length - 1 ) := K.Padding;
    Pos := Pos + K.Padding'Length;

    -- write counter + padding
    Write_End( Msg, Pos, Counter, Pad );

  end Write_RKeys_RMsg;

  -- Reads a RSA Keyset (Player_RSA structures) from the given RSA Message.
  -- Opposite of Write_RKeys_RMsg above
  procedure Read_RKeys_RMsg( Msg      : in Raw_Types.RSA_Msg;
                             Counter  : out Interfaces.Unsigned_16;
                             K        : out Player_RSA) is
    Pos : Natural := Msg'First + 1;
  begin
    -- check type id and raise exception if incorrect
    if Msg(Msg'First) /= RKeys_R_Type then
      raise Invalid_Msg;
    end if;

    -- read protocol version and subversion
    K.Proto_V := Msg( Pos );
    Pos := Pos + 1;
    Read_U16( Msg, Pos, K.Proto_Subv );

    -- read Keccak hash of client binary
    K.Client_Hash := Msg( Pos..Pos+K.Client_Hash'Length - 1 );
    Pos := Pos + K.Client_Hash'Length;

    -- read e
    K.e := Msg( Pos .. Pos + K.e'Length - 1 );
    Pos := Pos + K.e'Length;

    -- read n
    K.n := Msg( Pos .. Pos + K.n'Length - 1 );
    Pos := Pos + K.n'Length;

    -- read choice of padding
    K.Padding := Msg( Pos .. Pos+K.Padding'Length - 1 );
    Pos := Pos + K.Padding'Length;

    -- read message counter
    Read_U16( Msg, Pos, Counter );

    -- the rest is message padding, so ignore it

  end Read_RKeys_RMsg;

As usual, I also wrote the tests for all the new procedures, including the private Write_End. However, the testing package as it was could not directly call this private procedure from Messages. My solution to this is to change the declaration of the testing package so that it is effectively derived from Messages - at the end of the day it makes sense that the tester simply needs to get to all the private bits and pieces. This change makes however for a lot of noise in the .vpatch but that's how it is. The new test procedure for the counter+padding is - quite as usual - longer than the code it tests1 :

  procedure Test_Padding is
    Msg     : Raw_Types.Serpent_Msg := (others => 12);
    Old     : Raw_Types.Serpent_Msg := Msg;
    Pos     : Natural := 16;
    NewPos  : Natural := Pos;
    Counter : Interfaces.Unsigned_16;
    U16     : Interfaces.Unsigned_16;
    O2      : Raw_Types.Octets_2;
    Pad     : Raw_Types.Octets_8;
    Pass    : Boolean;
  begin
    -- get random counter
    RNG.Get_Octets( O2 );
    Counter := Raw_Types.Cast( O2 );

    -- test with random padding
    Pad := RNG_PAD;
    Write_End( Msg, NewPos, Counter, Pad );
    -- check NewPos and counter
    Pass := True;
    if NewPos /= Msg'Last + 1 then
      Put_Line("FAIL: incorrect Pos value after Write_End with rng.");
      Pass := False;
    end if;
    Read_U16(Msg, Pos, U16);
    if U16 /= Counter then
      Put_Line("FAIL: incorrect Counter by Write_End with rng.");
      Pass := False;
    end if;
    -- check that the padding is at least different...
    if Msg(Pos..Msg'Last) = Old(Pos..Old'Last) or
       Msg(Pos..Pos+Pad'Length-1) = Pad then
      Put_Line("FAIL: no padding written by Write_End with rng.");
      Pass := False;
    end if;
    if Pass then
      Put_Line("PASS: Write_End with rng.");
    end if;

    -- prepare for the next test
    Pass   := True;
    Pos    := Pos - 2;
    NewPos := Pos;
    Msg    := Old;

    -- get random padding
    RNG.Get_Octets( Pad );

    -- write with fixed padding and check
    Write_End( Msg, NewPos, Counter, Pad );
    Pass := True;

    if NewPos = Msg'Last + 1 then
      -- check counter + padding
      Read_U16( Msg, Pos, U16 );
      if U16 /= Counter then
        Put_Line("FAIL: Counter was not written by Write_End.");
        Pass := False;
      end if;
      for I in Pos..Msg'Last loop
        if Msg( I ) /= Pad( Pad'First + (I - Pos) mod Pad'Length ) then
          Put_Line("FAIL: Msg(" & Natural'Image(I) & ")=" &
                    Unsigned_8'Image(Msg(I)) & " /= Pad(" &
                    Natural'Image(Pad'First+(I-Pos) mod Pad'Length) &
                    ") which is " &
                    Unsigned_8'Image(Pad(Pad'First+(I-Pos) mod Pad'Length)));
          Pass := False;
        end if;
      end loop;
    else
      Put_Line("FAIL: Pos is wrong after call to Write_End.");
      Pass := False;
    end if;
    if Pass then
      Put_Line("PASS: test for Write_End with fixed padding.");
    end if;
  end Test_Padding;

With the above read/write of a RSA key set, all the RSA messages specified in the protocol are provided. Of the Serpent messages, those not implemented are the Client Action, World Bulletin, Object Request and Object Info. All of those still require some details to be filled in but for the moment I went ahead and implemented read/write for Client Action based on a text representation of the action itself (i.e. precisely as specified in the protocol for 4.5 although the action can be/is in principle a fully specified structure by itself as described in section 7 of the specification). At this stage I'm not yet sure whether to provide another layer of read/write for that action text or whether to attempt to read/write directly the Action structures. So this will have to wait and as details are becoming clearer, the code will get changed /added to, no big deal. Anyway, the Write_Action and Read_Action for now:

  -- writes the action (octets+length) into the specified Serpent message
  procedure Write_Action( A       : in Raw_Types.Text_Octets;
                          Counter : in Interfaces.Unsigned_16;
                          Pad     : in Raw_Types.Octets_8;
                          Msg     : out Raw_Types.Serpent_Msg) is
    Pos    : Natural := Msg'First + 1;
    MaxPos : Natural := Msg'Last - 1; --2 octets reserved for counter at end
    U16    : Interfaces.Unsigned_16;
  begin
    -- check whether given action FITS into a Serpent message
    if Pos + 2 + A.Len > MaxPos then
      raise Invalid_Msg;
    end if;

    -- write correct type ID
    Msg( Msg'First ) := Client_Action_S_Type;

    -- write action's TOTAL length
    U16 := Interfaces.Unsigned_16(A.Len + 2);
    Write_U16( Msg, Pos, U16 );

    -- write the action itself
    Msg( Pos..Pos+A.Len-1 ) := A.Content;
    Pos := Pos + A.Len;

    -- write counter + padding
    Write_End( Msg, Pos, Counter, Pad );

  end Write_Action;

  -- reads a client action as octets+length from the given Serpent message
  procedure Read_Action( Msg      : in Raw_Types.Serpent_Msg;
                         Counter  : out Interfaces.Unsigned_16;
                         A        : out Raw_Types.Text_Octets) is
    Pos : Natural := Msg'First + 1;
    U16 : Interfaces.Unsigned_16;
  begin
    -- read and check message type ID
    if Msg( Msg'First ) /= Client_Action_S_Type then
      raise Invalid_Msg;
    end if;

    -- read size of action (content+ 2 octets the size itself)
    Read_U16( Msg, Pos, U16 );

    -- check size
    if U16 < 3 or Pos + Natural(U16) - 2 > Msg'Last - 1 then
      raise Invalid_Msg;
    else
      U16 := U16 - 2;  --size of content only
    end if;

    -- create action, read it from message + assign to output variable
    declare
      Act : Raw_Types.Text_Octets( Raw_Types.Text_Len( U16 ) );
    begin
      Act.Content := Msg( Pos..Pos+Act.Len-1 );
      Pos := Pos + Act.Len;
      A := Act;
    end;

    -- read counter
    Read_U16( Msg, Pos, Counter );

  end Read_Action;

As previously with the components of a RSA key, I chose to keep the "action" as raw octets rather than "text" aka String. This can be easily changed later if needed but for now I fail to see any concrete benefit in doing the conversion to and from String. The new Text_Octets type is defined in Raw_Types and I moved there the definition of Text_Len (previously in Messages) as well since it's a better place for it2:

  -- length of a text field (i.e. 16 bits, strictly > 0)
  subtype Text_Len is Positive range 1..2**16-1;

  -- "text" type has a 2-byte header with total length
  -- Len here is length of actual content ONLY (i.e. it needs + 2 for total)
  type Text_Octets( Len: Text_Len := 1 ) is
    record
      -- actual octets making up the "text"
      Content: Octets( 1..Len ) := (others => 0);
    end record;

There is of course new testing code for the read/write action procedures as well:

  procedure Serialize_Action is
    O2 : Raw_Types.Octets_2;
    U16: Interfaces.Unsigned_16;
    Len: Raw_Types.Text_Len;
    Counter: Interfaces.Unsigned_16;
  begin
    Put_Line("Generating a random action for testing.");
    -- generate random counter
    RNG.Get_Octets( O2 );
    Counter := Raw_Types.Cast( O2 );

    -- generate action length
    RNG.Get_Octets( O2 );
    U16 := Raw_Types.Cast( O2 );
    if U16 < 1 then
      U16 := 1;
    else
      if U16 + 5 > Raw_Types.Serpent_Msg'Length then
        U16 := Raw_Types.Serpent_Msg'Length - 5;
      end if;
    end if;
    Len := Raw_Types.Text_Len( U16 );

    declare
      A: Raw_Types.Text_Octets( Len );
      B: Raw_Types.Text_Octets;
      Msg: Raw_Types.Serpent_Msg;
      ReadC : Interfaces.Unsigned_16;
    begin
      RNG.Get_Octets( A.Content );
      begin
        Write_Action( A, Counter, RNG_PAD, Msg );
        Read_Action( Msg, ReadC, B );
        if B /= A then
          Put_Line("FAIL: read/write of Action.");
        else
          Put_Line("PASS: read/write of Action.");
        end if;
      exception
        when Invalid_Msg =>
          if Len + 5 > Raw_Types.Serpent_Msg'Length then
            Put_Line("PASS: exception correctly raised for Action too long");
          else
            Put_Line("FAIL: exception INCORRECTLY raised at action r/w!");
          end if;
      end;
    end;
  end Serialize_Action;

The (rather lengthy) .vpatch for all the above and my signature for it can be found on my Reference Code Shelf as usual or through those links:

The next step now is to patch the rsa/oaep part of SMG Comms to use the 8-octets public exponent and then to get back to EuCrypt and patch it to allow arbitrary size public exponent - so much for fixed size. In other words, it's a very good opportunity to re-read and review EuCrypt!


  1. It is also true that I spend waaaay less time on the tests than on the main code. In writing code like in any other writing, the result of less time spent on it is... longer writing rather than shorter, who'd have thought it, right? I mean who other than Samuel Clemens and pretty much everyone else who actually thought at all. 

  2. This is even more refactoring and therefore noise in the .vpatch, yes! It does say work in progress on the whole thing and in every post on this, right at the top. What did you think that meant? 

November 24, 2018

Proposed Change to W_Borrow (FFA)

Filed under: Coding — Diana Coman @ 8:32 p.m.

After more than half a year since last time I really looked at it, FFA (Finite Field Arithmetic) finally made its way back up on my list of tasks. Given the rather large break I took on this and the regrind of the original vpatches1, I've carved time out to re-start from the very beginning, as if I had never seen it before. So far, I went in detail through Chapter 1 and Chapter 2 and I am satisfied that I know them to the extent that I could re-write them (I actually did, even though by bits and pieces as I went). So I've updated the files on my Reference Code Shelf with the new .vpatches (using Keccak checksums) and my signatures for them. I'll link them here as well, for easy reference:

The break I took from FFA turns out to have been for the better in at least one way - it is actually easier for me to read the code now, mainly because of all the stuff I've been doing during this "break", of course2. Anyway, with Ada itself a bit more in the background rather than foreground for me, I had more time to actually explore those sort of things that popped out to me this time like the last time under the heading "I've checked it and it's correct so I can sign it but it still seems to be perhaps a bit less clear than it could be." Specifically, I'm talking of the expression introduced in Chapter 1 in the W_Borrow function for obtaining the borrow bit based on the two operands and the borrow bit from a previous operation (see word_ops.adb):

   -- Find the Borrow, from a subtraction where it is known that A - B == D:
   function W_Borrow(A : in Word; B : in Word; D : in Word)
                    return WBool is
   begin
      return WBool(Shift_Right( ( (not A) and B) or ( ( (not A) or B) and D),
                               Bitness - 1) );
   end W_Borrow;
   pragma Inline_Always(W_Borrow);

For comparison, have a look at the W_Carry function in the same word_ops.adb:

   -- Find the Carry, from an addition where it is known that A + B == S:
   function W_Carry(A : in Word; B : in Word; S : in Word)
                   return WBool is
   begin
      return WBool(Shift_Right( (A and B) or ( (A or B) and (not S) ),
                               Bitness - 1) );
   end W_Carry;

I don't know about you, but I can actually follow the boolean expression in W_Carry while at the same time I find that the W_Borrow thing pokes me in the eye repeatedly and I have a hell of a time to picture exactly wtf it says. Making the truth table for it and following the thing revealed that the result is indeed the intended one so I'm satisfied that the expression is correct. However, I still think that there is actually a simpler way to write the same thing, in a manner that even looks similar to the one in W_Carry, namely:

   -- Find the Borrow, from a subtraction where it is known that A - B == D:
   function W_Borrow(A : in Word; B : in Word; D : in Word)
                    return WBool is
   begin
      return WBool(Shift_Right( (B and D) or ( (B or D) and (not A) ),
                               Bitness - 1) );
   end W_Borrow;

To make sure that the new expression does indeed the same thing as the original one, I did both the truth tables and the actual transformation from one to another via Boolean algebra. I'll leave the truth tables as exercise for the interested reader but here's my working for transforming the original expression into mine:

  ( (not A) and B) or ( ( (not A) or B) and D) =

= ( (not A) and B) or ( (not A) and D) or (B and D)

= ( (not A) and (B or D) ) or (B and D)

= (B and D) or ( (not A) and (B or D) )

Given the above, I'm quite satisfied that the two expressions are equivalent and as a result I guess it is a matter of preference whether one chooses my version or Stanislav's. Unless there is some other reason that escapes me for using the original expression there, I find mine easier to understand and so preferable. Note that mine makes sense simply read as it is: there will be a borrow bit if either there are already 2 bits to take away from A (i.e. B and D) or otherwise if there is only one but A is 0. At any rate, since the W_Borrow function is present in the latest Chapter of FFA (12B) precisely as it was introduced in Chapter 1, I made a .vpatch on top of Chapter 12B with my proposed change to W_Borrow:

Note that I've added the corresponding line in the MANIFEST file but I followed the format described by Trinque in the V Manifest specification i.e. including the author name while Stanislav seems to have either forgotten that bit or preferred to not include it.

As a result of Stanislav's blog missing any sort of working comments currently, I wasn't able to simply add all this as a comment to his own Chapter 1 post, where I think it actually belongs. So I'm publishing it here as a post instead and I guess I'll host any further discussion on it too so feel free to leave a comment below.


  1. The regrinds are due to changing the checksums from SHA to Keccak; the content stays the same. However, one needs to read the new vpatches again before one can sign them in any meaningful way. 

  2. All the additional experience I gained with Ada shows when reading code and the difference is apparently large enough to be quite obvious - even hard to ignore basically. 

November 22, 2018

SMG Comms Chapter 9: Files (Transfers and Requests)

Filed under: Coding, SMG_Comms — Diana Coman @ 9:42 p.m.

~ This is a work in progress towards an Ada implementation of Eulora's communication protocol. Start with Chapter 1.~

One significant goal of Eulora's communication protocol is to allow the client to request and obtain from the server absolutely *any* file that it might be missing so that there is effectively no need for an "update" of the client anymore. Two of the protocol's current messages target precisely this goal: File Transfer and File Request. The File Transfer message carries chunks of a file while the File Request carries a request from the client for files specified by their names (separated with ';'). And that means of course that one needs to do at least some sort of parsing to extract file names from that list while also handling at any time a set of unknown size containing strings of unknown length. In short: a mess.

My initial stab at the previously-mentioned mess was a rather ugly parametrized record (number of filenames) containing an array of ...parametrized records (each filename having its own length as a parameter). As you might imagine, this is not exactly the sort of thing that "fits in head" - at least not without a bigger hammer. And unsurprisingly, working with such a structure ended up in errors and trouble quite quickly (not to mention it felt about as pleasant as stabbing one's toe at every step). So I threw that first attempt to the bin and decided to store instead the filenames as one single long string (i.e. glued together into one string), alongside an array containing the starting positions of each separate filename in this long string. Basically instead of having separators in the string itself and mixed with the content, there is the content in one place and then neatly to the side the way to access directly any desired filename from the set. This keeps the protocol formatting (separators and the like) here in smg.comms where it belongs rather than pushing it higher up and at the same time it reduces the number of parameters to precisely 2: the number of filenames in there (hence the length of the array of start positions) and the total length of the resulting string (i.e. all filenames lengths added up together). The result is certainly an improvement over the first attempt but I can't say I am terribly fond of it as it is so if you have a better solution to this, go ahead and describe it in the comments below, including why and how it really is the better option - I'll gladly read it.

Using this approach of single string + start positions solved the issue of multiple variable lengths for strings. However, the File Request message still has all sorts of potential troublesome cases, including the case when the given set of filenames ends up longer than one message can carry (at write time) or there are multiple consecutive separators (at read time). My overall approach for such troubles with messages is to check whenever possible and effectively reject a message as invalid if a check fails. Anyway, working with an unknown bunch of unknown strings still remains at all times a sort of ugly spot, no matter what, so those read/write methods still look to me hairier than others so far and there isn't at the moment something specific that I can see to drastically improve them (short of fixing the size of filenames perhaps but I think that's more likely to just push the issue somewhere else as filenames will get padded/trimmed to size). Anyway, the new data structures for this chapter are defined in data_structs.ads:

  -- length of a text field (i.e. 16 bits, strictly > 0)
  subtype Text_Len is Positive range 1..2**16-1;

  -- A set of file names glued into a single string
  -- NB: there IS at least ONE filename and one character
  -- Upper limit for Text_Len is due to protocol's spec of text basic type
  type U16_Array is array (Text_Len range <> ) of Interfaces.Unsigned_16;
  type Filenames( F_No: Text_Len := 1; Sz: Text_Len := 1 ) is
    record
      -- filenames glued together into 1 single string
      S : String( 1 .. Sz ) := (others => '0');
      -- indices in S, at which each filename starts
      Starts: U16_Array( 1 .. F_No ) := (others => 1);
    end record;  

  -- A chunk of a file (for file transfer)
  type File_Chunk( Len     : Text_Len := 1;
                   Count   : Interfaces.Unsigned_16 := 1;
                   Name_Len: Text_len := 1) is
    record
      Filename: String(1..Name_Len);
      Content : Raw_Types.Octets(1..Len);
    end record;

In addition to the data structures above, this chapter adds the following:

  • Read/Write from/to Serpent Message for the File_Chunk structure (i.e. File Transfer message).
  • Read/Write from/to Serpent Message for the Filenames structure (i.e. File Request message).
  • Conversion methods from String to Octets and back. Those are private methods in the Messages packages and are meant for internal use only since messages use raw octets, while filenames and the like are meant as text/strings.
  • Read/Write from/to Octets for a 16 bits unsigned value. Similar to the conversion methods above, these are private methods in the Messages package and meant for internal use only. The reason for them to exist in the first place is that 16 bits values are relatively frequent in the protocol (counters and sizes) and their read/write requires an additional step to address potential endianness issues. Since this step is always the same and otherwise easy to forget + hard to debug if/when forgotten, it makes much more sense to have it packed together in one single procedure that can be called wherever needed.
  • Refactoring to replace all read/writes of 16-bit values by the new Read_U16/Write_U16 methods.
  • Tests for read/write of File Request and File Transfer messages.
  • Tests for converters from/to string/octets.
  • Small change to the test of pack/unpack RSA messages to ensure that "mangled" message is indeed always different from a valid package1.

The new read/write methods for File Transfer and File Request, described in messages.ads:

  ----------------- File Transfer ----------------------

  -- Writes the given File Chunk to a File Transfer type of message
  -- Chunk - chunk of file to write; contains counter, filename, content
  procedure Write_File_Transfer( Chunk   : in File_Chunk;
                                 Msg     : out Raw_Types.Serpent_Msg);

  -- The opposite of Write_File_Transfer method above.
  -- Chunk will contain the counter, filename and content
  procedure Read_File_Transfer( Msg     : in Raw_Types.Serpent_Msg;
                                Chunk   : out File_Chunk);

  ----------------- File Request  ----------------------
  -- Writes a message to request the files specified through their names
  -- Written parameter will hold the number of filenames actually written
  -- NB: this can be less than the number of filenames provided!
  -- When Written < FR.F_No, the FIRST Written filenames were written; the rest
  -- did not fit into the message and it's up to caller to decide what to do.
  procedure Write_File_Request( FR      : in Filenames;
                                Counter : in Interfaces.Unsigned_16;
                                Msg     : out Raw_Types.Serpent_Msg;
                                Written : out Natural);

  -- Reads a request for files; the opposite of Write_File_Request above
  -- Raises Invalid_Msg exception if the provided message fails checks.
  procedure Read_File_Request( Msg      : in Raw_Types.Serpent_Msg;
                               Counter  : out Interfaces.Unsigned_16;
                               FR       : out Filenames);

The implementation of those methods in messages.adb:

  ------ File Transfer ------
  procedure Write_File_Transfer( Chunk   : in File_Chunk;
                                 Msg     : out Raw_Types.Serpent_Msg) is
    Pos: Integer := Msg'First;
    U16: Interfaces.Unsigned_16;
  begin
    -- write type ID
    Msg(Pos) := File_Transfer_S_Type;
    Pos := Pos + 1;

    -- write filename as text field (size+2, text)
    -- check against overflows
    if Chunk.Name_Len > Text_Len'Last - 2 or
       Pos + Integer(Chunk.Name_Len) + 2 > Msg'Last then
      raise Invalid_Msg;
    end if;

    -- write total size: filename size + 2
    U16 := Interfaces.Unsigned_16( Chunk.Name_Len + 2 );
    Write_U16( Msg, Pos, U16 );

    -- write filename
    String_To_Octets( Chunk.Filename,
                      Msg(Pos..Pos+Integer(Chunk.Name_Len)-1) );
    Pos := Pos + Integer(Chunk.Name_Len);

    --write content
    -- check against overflow, including the 2 octets for counter at the end
    if Chunk.Len > Text_Len'Last - 2 or
       Pos + Integer(Chunk.Len) + 4 > Msg'Last then
      raise Invalid_Msg;
    end if;

    -- write total size for this text field
    U16 := Interfaces.Unsigned_16( Chunk.Len + 2 );
    Write_U16( Msg, Pos, U16 );

    -- write actual content
    Msg(Pos..Pos+Chunk.Content'Length-1) := Chunk.Content;
    Pos := Pos + Chunk.Content'Length;

    -- write counter
    Write_U16( Msg, Pos, Chunk.Count );

    -- write padding if needed
    if Pos <= Msg'Last then
      RNG.Get_Octets( Msg(Pos..Msg'Last) );
    end if;

  end Write_File_Transfer;

  -- The opposite of Write_File_Transfer method above.
  -- Counter will contain the message counter
  -- Chunk will contain the chunk counter, filename and content
  procedure Read_File_Transfer( Msg     : in Raw_Types.Serpent_Msg;
                                Chunk   : out File_Chunk) is
    Pos: Integer := Msg'First;
    U16: Interfaces.Unsigned_16;
    S_Name, E_Name: Integer; --start/end for filename in Msg
    S_Len: Text_Len; -- length of filename (needed as Text_Len anyway)
    S_Content, E_Content: Integer; --start/end for content in Msg
    Content_Len: text_Len; -- length of content (needed as Text_Len anyway)
  begin
    -- read and check type ID
    if Msg(Pos) /= File_Transfer_S_Type then
      raise Invalid_Msg;
    end if;
    Pos := Pos + 1;

    -- read filename size
    Read_U16( Msg, Pos, U16 );

    -- check for overflow and underflow; filename size >= 1
    if Pos + Integer(U16) - 2 > Msg'Last or
       U16 < 3 then
      raise Invalid_Msg;
    end if;
    U16 := U16 - 2;
    S_Len := Text_Len(U16);

    -- set start + end for reading filename later, when ready
    S_Name := Pos;
    E_Name := Pos + Integer(U16)-1;
    Pos := Pos + S_Len;

    -- read size of content
    Read_U16( Msg, Pos, U16 );
    -- check for overflow and underflow; content >=1; counter =2 octets
    if Pos + Integer(U16) - 1 > Msg'Last or
       U16 < 3 then
      raise Invalid_msg;
    end if;
    U16 := U16 - 2;
    Content_Len := Text_Len(U16);
    -- set start and end for reading content later, when ready
    S_Content := Pos;
    E_Content := Pos + Integer(U16) - 1;
    Pos := Pos + Content_Len;

    -- read counter
    Read_U16( Msg, Pos, U16 );
    -- check chunking validity i.e. if counter>0 then no padding
    if U16 /= 0 and Pos /= Msg'Last then
      raise Invalid_Msg;
    end if;

    -- create File_Chunk structure and fill it with data from Msg
    declare
      FC : File_Chunk( Len      => Content_Len,
                       Count    => U16,
                       Name_Len => S_Len);
    begin
      -- read from Msg
      FC.Content  := Msg( S_Content..E_Content );
      Octets_To_String( Msg( S_Name..E_Name ), FC.Filename);
      -- copy to output var
      Chunk := FC;
    end;

  end Read_File_Transfer;

  ---- File Requests ----
  procedure Write_File_Request( FR      : in Filenames;
                                Counter : in Interfaces.Unsigned_16;
                                Msg     : out Raw_Types.Serpent_Msg;
                                Written : out Natural) is
    Pos    : Integer := Msg'First;
    Max_Pos: Integer := Msg'Last - 2; -- 2 octets at end for counter
    Text_Sz: Integer;
    Max_Sz : Integer;
  begin
    -- write ID for File Request type
    Msg( Pos ) := File_Req_S_Type;
    Pos := Pos + 1;

    -- write Text size: filenames + separators
    -- consider fewer filenames if they don't ALL fit
    -- 2 octets are taken by size itself
    Max_Sz := Max_Pos - Pos - 1;
    Text_Sz := FR.Sz + FR.F_No - 1;
    if Text_Sz > Max_Sz then
      -- walk the array of filenames backwards and stop when they fit
      Written := FR.F_No - 1;
      -- calculate actual size written based on start of first discarded
        -- filename and (Written -1) octets for needed separators
      Text_Sz := Integer(FR.Starts(Written+1)) - FR.Starts'First +
                   (Written - 1);

      -- loop until either fits or nothing left
      while Written > 0 and Text_Sz > Max_Sz loop
        Written := Written - 1;
        Text_Sz := Integer(FR.Starts(Written+1))- FR.Starts'First +
                     (Written - 1);
      end loop;
      -- check that there is what to write, since nothing -> invalid message
      if Written = 0 then
        raise Invalid_Msg;
      end if;

    else --from if Text_Sz > Max_Sz
      -- ALL are written
      Written := FR.F_No;
    end if;

    -- write Text_Sz + 2 (i.e. TOTAL size)
    if Text_Sz + 2 > Integer(Interfaces.Unsigned_16'Last) then
      raise Invalid_Msg;
    end if;

    Write_U16( Msg, Pos, Interfaces.Unsigned_16(Text_Sz+2) );

    -- write filenames separated by Sep
    for I in 1..Written loop
      declare
        Start_Pos : Positive;
        End_Pos   : Positive;
        Len       : Positive;
      begin
        -- current start pos in FR.S
        Start_Pos := Positive( FR.Starts( FR.Starts'First + I - 1));

        -- calculate end based on start of next name or last
        if I < FR.F_No then
          End_Pos := Positive( FR.Starts( FR.Starts'First + I)) - 1;
        else
          End_Pos := FR.S'Last;
        end if;

        -- NB: this WILL fail if starting positions are not in order!
        Len := End_Pos - Start_Pos + 1;
        if Len <= 0 then
          raise Invalid_Msg;
        end if;

        --write the actual filename
        String_To_Octets( FR.S( Start_Pos..End_Pos ), Msg(Pos..Pos+Len-1) );
        Pos := Pos + Len;

        --if it's not the last one, write a separator
        if I < Written then
          Msg(Pos) := Sep;
          Pos := Pos + 1;
        end if;
      end;
    end loop;

    -- write the message counter in little endian at all times
    Write_U16( Msg, Pos, Counter );

    -- write padding if needed
    if Pos <= Msg'Last then
      Rng.Get_Octets( Msg(Pos..Msg'Last) );
    end if;
  end Write_File_Request;

  -- Reads a request for files; the opposite of Write_File_Request above
  procedure Read_File_Request( Msg      : in Raw_Types.Serpent_Msg;
                               Counter  : out Interfaces.Unsigned_16;
                               FR       : out Filenames) is
    Pos       : Integer := Msg'First;
    Max_Pos   : Integer := Msg'Last - 2; --at least 2 reserved for counter
    Text_Sz   : Integer;
    Max_Sz    : Integer := Max_Pos - Pos - 1; --text only i.e. w.o. size itself
    F_No      : Integer;
    U16       : Interfaces.Unsigned_16;
  begin
    -- read type ID and check
    if Msg(Pos) /= File_Req_S_Type then
      raise Invalid_Msg;
    end if;
    Pos := Pos + 1;

    -- read total size of filenames+separators
    Read_U16( Msg, Pos, U16 );
    Text_Sz := Integer(U16);
    -- take away the 2 octets for size itself
    Text_Sz := Text_Sz - 2;

    -- check that Text_Sz is not overflowing/underflowing
    if Text_Sz < 1 or Text_Sz > Max_Sz then
      raise Invalid_Msg;
    end if;

    -- count first the separators to know how many filenames
    -- NB: there is always at least 1 filename as Text_Sz > 0
    F_No := 1;
    for I in Pos .. Pos + Text_Sz - 1 loop
      if Msg(I) = Sep then
        F_No := F_No + 1;
      end if;
    end loop;

    -- create the output structure and discard separators
    -- text without separators should be Text_Sz - F_No + 1
    -- (because ONLY one separator between 2 filenames allowed)
    -- if it's not that => Invalid_Msg
    -- F_No and Text_Sz are not overflow (earlier check + calc)
    declare
      F     : Filenames(Text_Len(F_No), Text_Len(Text_Sz-F_No+1));
      S_Pos : Positive;
      Index : Positive;
    begin
      S_Pos := F.S'First;
      Index := F.Starts'First;
      F.Starts(Index) := Interfaces.Unsigned_16(S_Pos);

      for I in Pos .. Pos + Text_Sz - 1 loop
        -- copy over to F.S anything that is not separator
        if Msg(I) /= Sep then
          F.S( S_Pos ) := Character'Val(Msg(I));
          S_Pos := S_Pos + 1;
        else
          -- if it's separator, check and if ok, add next as start
          if I = Pos + Text_Sz or -- separator as last character is error
               Msg(I+1) = Sep or  -- 2 consecutive separators is error
               Index >= F.Starts'Last then -- too many separators is error
            raise Invalid_Msg;
          else
            Index := Index + 1;
            F.Starts( Index ) := Interfaces.Unsigned_16(S_Pos);
          end if;
        end if;
      end loop;

      -- copy the whole structure to output variable
      FR := F;
    end;

    -- read message counter now
    Pos := Pos + Text_Sz;
    Read_U16( Msg, Pos, Counter );

  end Read_File_Request;

The converters between String and Octets (messages.adb):

  -- String to Octets conversion
  procedure String_To_Octets(Str: in String; O: out Raw_Types.Octets) is
  begin
    Assert( Str'Length = O'Length );
    for I in 1..Str'Length loop
      O( O'First+I-1 ) := Character'Pos(Str(Str'First + I - 1 ));
    end loop;
  end String_To_Octets;

  -- Octets to string conversion
  -- NB: Str'Length has to be EQUAL to Octets'Length!
  procedure Octets_To_String(O: in Raw_Types.Octets; Str: out String) is
  begin
    Assert( O'Length = Str'Length );
    for I in 1..O'Length loop
      Str( Str'First+I-1 ) := Character'Val(O(O'First + I - 1 ));
    end loop;
  end Octets_To_String;

The read/write utilities for values on 16 bits (messages.adb):

  -- Write a 16 bits value to Octets at Pos; Pos increases by 2.
  procedure Write_U16( Msg: in out Raw_Types.Octets;
                       Pos: in out Natural;
                       U16: in Interfaces.Unsigned_16) is
  begin
    Msg(Pos..Pos+1) := Raw_Types.Cast(U16);
    Cast_LE(Msg(Pos..Pos+1));
    Pos := Pos + 2;
  end Write_U16;

  -- Read a 16-bits values from Octets from Pos; Pos increases by 2.
  procedure Read_U16( Msg: in Raw_Types.Octets;
                      Pos: in out Natural;
                      U16: out Interfaces.Unsigned_16) is
    O2  : Raw_Types.Octets_2;
  begin
    O2  := Msg(Pos..Pos+1);
    Cast_LE(O2);
    U16 := Raw_Types.Cast(O2);
    Pos := Pos + 2;
  end Read_U16;

The .vpatch and my signature for it can be found on my Reference Code Shelf as usual or through those links:


  1. Yes, I managed to fall during one of various testing sessions upon the one case where it was not, such are some of my talents, what can I tell you. 

November 17, 2018

SMG Comms Chapter 8: Keys Management

Filed under: Coding, SMG_Comms — Diana Coman @ 1:47 p.m.

~ This is a work in progress towards an Ada implementation of Eulora's communication protocol. Start with Chapter 1.~

This chapter makes a few changes to previous code and adds a new part to handle read/write of messages concerning keys management (4.2 and 5.3 in the current protocol specification):

  • (Changed): I've refactored the code for read/write of messages transporting Serpent keys (i.e. the code from Chapter 7 of the SMG Comms series). At the time I wrote those for Chapter 7 I wasn't even sure that I'll continue with that approach to serializing the data structure so I did not bother too much/too early with other considerents. As it turned out that the approach implemented was indeed the most appropriate for the task at hand, the next focus was on making the best use of it given that both Serpent and RSA messages that transport keys effectively have the same structure and differ only in their ID (first octet) and length of padding (due to different sizes). So there clearly was no point in repeating the actual serialization code in 2 separate places, one for Serpent messages and one for RSA messages. Instead, the common core is now done by methods that are private to the Messages package and are called with the correct parameters by the read/write methods for Serpent and RSA messages. Having previously defined RSA and Serpent message types to reflect precisely what they are, namely subtypes of the generic, raw, "Octets" type helped significantly, of course: the private read/write simply take/provide Octets and ID, focusing on the common core and ignoring the rest (which is handled by the caller since that's the point at which Serpent/RSA is a concern). As a result, the public methods are now very short since the actual work is done in the private methods:
    package body Messages is
    
      ----------------------
      -- Serpent Messages --
      ----------------------
    
      procedure Write_SKeys_SMsg( Keyset  : in Serpent_Keyset;
                                  Counter : in Interfaces.Unsigned_16;
                                  Msg     : out Raw_Types.Serpent_Msg) is
      begin
        -- call internal write on Octets with correct type id
        Write_SKeys( Keyset, Counter, SKeys_S_Type, Msg );
      end Write_SKeys_SMsg;
    
      -- Reads a Serpent keyset from given Serpent Message
      procedure Read_SKeys_SMsg( Msg     : in Raw_Types.Serpent_Msg;
                                 Counter : out Interfaces.Unsigned_16;
                                 Keyset  : out Serpent_Keyset) is
      begin
        -- check type id and call internal Read_SKeys if correct
        if Msg(Msg'First) /= SKeys_S_Type then
          raise Invalid_Msg;
        else
          Read_SKeys( Msg, Counter, Keyset );
        end if;
      end Read_SKeys_SMsg;
    
      -- writes given key mgm structure into a Serpent message
      procedure Write_KMgm_SMsg( KMgm    : in Keys_Mgm;
                                 Counter : in Interfaces.Unsigned_16;
                                 Msg     : out Raw_Types.Serpent_Msg) is
      begin
        -- call internal write of key mgm with correct type ID
        Write_KMgm( KMgm, Counter, Key_Mgm_S_Type, Msg );
      end Write_KMgm_SMsg;
    
      -- reads a key mgm structure from the given Serpent message
      procedure Read_KMgm_SMsg( Msg     : in Raw_Types.Serpent_Msg;
                                Counter : out Interfaces.Unsigned_16;
                                KMgm    : out Keys_Mgm) is
      begin
        -- check type id and call internal Read_KMgm if correct
        if Msg(Msg'First) /= Key_Mgm_S_Type then
          raise Invalid_Msg;
        else
          Read_KMgm( Msg, Counter, KMgm );
        end if;
      end Read_KMgm_SMsg;
    
      ------------------
      -- RSA Messages --
      ------------------
    
      procedure Write_SKeys_RMsg( Keyset  : in Serpent_Keyset;
                                  Counter : in Interfaces.Unsigned_16;
                                  Msg     : out Raw_Types.RSA_Msg) is
      begin
        -- call internal write of Serpent keys with correct type ID
        Write_SKeys( Keyset, Counter, SKeys_R_Type, Msg );
      end Write_SKeys_RMsg;
    
      procedure Read_SKeys_RMsg( Msg     : in Raw_Types.RSA_Msg;
                                 Counter : out Interfaces.Unsigned_16;
                                 Keyset  : out Serpent_Keyset) is
      begin
        -- check type id and call internal Read_SKeys if correct
        if Msg(Msg'First) /= SKeys_R_Type then
          raise Invalid_Msg;
        else
          Read_SKeys( Msg, Counter, Keyset );
        end if;
      end Read_SKeys_RMsg;
    
      procedure Write_KMgm_RMsg( KMgm    : in Keys_Mgm;
                                 Counter : in Interfaces.Unsigned_16;
                                 Msg     : out Raw_Types.RSA_Msg) is
      begin
        -- call internal write of key mgm with correct type ID
        Write_KMgm( KMgm, Counter, Key_Mgm_R_Type, Msg );
      end Write_KMgm_RMsg;
    
      procedure Read_KMgm_RMsg( Msg     : in Raw_Types.RSA_Msg;
                                Counter : out Interfaces.Unsigned_16;
                                KMgm    : out Keys_Mgm) is
      begin
        -- check type id and call internal Read_KMgm if correct
        if Msg(Msg'First) /= Key_Mgm_R_Type then
          raise Invalid_Msg;
        else
          Read_KMgm( Msg, Counter, KMgm );
        end if;
      end Read_KMgm_RMsg;
    
      ------------------
      -- private part --
      ------------------
      procedure Cast_LE( LE: in out Raw_Types.Octets ) is
      begin
        -- flip octets ONLY if native is big endian.
        if System.Default_Bit_Order = System.High_Order_First then
          declare
            BE: constant Raw_Types.Octets := LE;
          begin
            for I in 1..LE'Length loop
              LE(LE'First+I-1) := BE(BE'Last-I+1);
            end loop;
          end;
        end if;
        -- NOTHING to do for native little endian
      end Cast_LE;
    
      procedure Write_SKeys( Keyset  : in Serpent_Keyset;
                             Counter : in Interfaces.Unsigned_16;
                             Type_ID : in Interfaces.Unsigned_8;
                             Msg     : out Raw_Types.Octets) is
        Pos   : Integer := Msg'First;
        Check : CRC32.CRC32;
        PadLen: Integer;
        K     : Serpent.Key;
      begin
        -- write Type ID
        Msg(Pos) := Type_ID;
        Pos := Pos + 1;
    
        -- write count of keys (NB: this IS 8 bits by definition)
        Msg(Pos) := Keyset.Keys'Length;
        Pos := Pos + 1;
    
        -- write keys
        for I in Keyset.Keys'Range loop
          -- retrieve Key to write
          K := Keyset.Keys( I );
    
          -- write key itself
          Msg(Pos..Pos+K'Length-1) := K;
          -- ensure little endian order in message
          Cast_LE(Msg(Pos..Pos+K'Length-1));
          Pos := Pos + K'Length;
    
          -- write CRC of key
          Check := CRC32.CRC( K );
          Msg(Pos..Pos+3) := Raw_Types.Cast(Check);
          Cast_LE(Msg(Pos..Pos+3));
          Pos := Pos + 4;
        end loop;
    
        -- write flag
        Msg(Pos) := Keyset.Flag;
        Pos := Pos + 1;
    
        -- write message counter
        Msg(Pos..Pos+1) := Raw_Types.Cast(Counter);
        Cast_LE(Msg(Pos..Pos+1));
        Pos := Pos + 2;
    
        -- write padding as needed; endianness is irrelevant here
        PadLen := Msg'Last - Pos + 1;
        if PadLen > 0 then
          declare
            Pad : Raw_Types.Octets(1..PadLen);
          begin
            RNG.Get_Octets( Pad );
            Msg(Pos..Pos+PadLen-1) := Pad;
          end;
        end if;
    
      end Write_SKeys;
    
      procedure Read_SKeys( Msg     : in Raw_Types.Octets;
                            Counter : out Interfaces.Unsigned_16;
                            Keyset  : out Serpent_Keyset) is
        Pos: Integer := Msg'First;
      begin
        -- read type and check
        if Msg(Pos) = SKeys_S_Type or
           Msg(Pos) = SKeys_R_Type then
          Pos := Pos + 1;
        else
          raise Invalid_Msg;
        end if;
    
        -- read count of keys and check
        if Msg(Pos) in Keys_Count'Range then
          declare
            N     : Keys_Count := Keys_Count(Msg(Pos));
            KS    : Serpent_Keyset(N);
            K     : Serpent.Key;
            Check : CRC32.CRC32;
            O4    : Raw_Types.Octets_4;
            O2    : Raw_Types.Octets_2;
          begin
            Pos := Pos + 1;
            --read keys and check crc for each
            for I in 1 .. N loop
              -- read key and advance pos
              K := Msg(Pos..Pos+K'Length-1);
              Cast_LE(K);
              Pos := Pos + K'Length;
              -- read crc and compare to crc32(key)
              O4 := Msg(Pos..Pos+3);
              Cast_LE(O4);
              Check   := Raw_Types.Cast(O4);
              Pos := Pos + 4;
              if Check /= CRC32.CRC(K) then
                raise Invalid_Msg;
              end if;
              -- if it got here, key is fine so add to set
              KS.Keys(KS.Keys'First + I -1) := K;
            end loop;
            -- read and set flag
            KS.Flag := Msg(Pos);
            Pos := Pos + 1;
            -- read and set message counter
            O2 := Msg(Pos..Pos+1);
            Cast_LE(O2);
            Counter := Raw_Types.Cast(O2);
            -- rest of message is padding so it's ignored
            -- copy keyset to output variable
            Keyset := KS;
          end;
        else
          raise Invalid_Msg;
        end if;
      end Read_SKeys;
    
      -- writes given key management structure to the given octets array
      procedure Write_KMgm( KMgm    : in Keys_Mgm;
                            Counter : in Interfaces.Unsigned_16;
                            Type_ID : in Interfaces.Unsigned_8;
                            Msg     : out Raw_Types.Octets) is
        Pos   : Integer := Msg'First;
      begin
        -- write given type id
        Msg(Pos) := Type_ID;
        Pos := Pos + 1;
    
        -- write count of server keys requested
        Msg(Pos) := KMgm.N_Server;
        Pos := Pos + 1;
    
        -- write count of client keys requested
        Msg(Pos) := KMgm.N_Client;
        Pos := Pos + 1;
    
        -- write id of key preferred for further inbound Serpent messages
        Msg(Pos) := KMgm.Key_ID;
        Pos := Pos + 1;
    
        -- write count of burnt keys in this message
        Msg(Pos..Pos) := Cast( KMgm.N_Burnt );
        Pos := Pos + 1;
    
        -- if there are any burnt keys, write their ids
        if KMgm.N_Burnt > 0 then
          Msg( Pos .. Pos + KMgm.Burnt'Length - 1 ) := KMgm.Burnt;
          Pos := Pos + KMgm.Burnt'Length;
        end if;
    
        -- write the message count
        Msg(Pos..Pos+1) := Raw_Types.Cast( Counter );
        Cast_LE( Msg(Pos..Pos+1) );
        Pos := Pos + 2;
    
        -- pad with random octets until the end of Msg
        RNG.Get_Octets( Msg(Pos..Msg'Last) );
    
      end Write_KMgm;
    
      -- attempts to read from the given array of octets a key management structure
      procedure Read_KMgm( Msg     : in Raw_Types.Octets;
                           Counter : out Interfaces.Unsigned_16;
                           KMgm    : out Keys_Mgm) is
        Pos       : Integer := Msg'First;
        Burnt_Pos : Integer := Msg'First + 4;
      begin
        -- read type and check
        if Msg(Pos) = Key_Mgm_S_Type or
           Msg(Pos) = Key_Mgm_R_Type then
          Pos := Pos + 1;
        else
          raise Invalid_Msg;
        end if;
    
        -- read the count of burnt keys and check
        -- NB: Burnt_Pos IS in range of Counter_8bits since it's an octet
        declare
          N_Burnt : Counter_8bits := Counter_8bits(Msg(Burnt_Pos));
          Mgm     : Keys_Mgm(N_Burnt);
          O2      : Raw_Types.Octets_2;
        begin
          -- read count of server keys requested
          Mgm.N_Server := Msg(Pos);
          Pos := Pos + 1;
    
          -- read count of client keys requested
          Mgm.N_Client := Msg(Pos);
          Pos := Pos + 1;
    
          -- read ID of Serpent key preferred for further inbound messages
          Mgm.Key_ID   := Msg(Pos);
          Pos := Pos + 2; --skip the count of burnt keys as it's read already
    
          -- read ids of burnt keys, if any
          if N_Burnt > 0 then
            Mgm.Burnt := Msg(Pos..Pos+N_Burnt-1);
            Pos := Pos + N_Burnt;
          end if;
    
          -- read and set message counter
          O2 := Msg(Pos..Pos+1);
          Cast_LE(O2);
          Counter := Raw_Types.Cast(O2);
          -- rest of message is padding so it's ignored
          -- copy the keys mgm structure to output param
          KMgm := Mgm;
        end;
      end Read_KMgm;
    
    end Messages;
    
  • (Changed): The Keys_Mgm record in Data_Structs.ads:
    • (Changed): The array of burnt keys was initially declared as holding the actual keys rather than just the ids. I've corrected this so that now the "Burnt" part of Keys_Mgm is simply an array of Unsigned_8 (i.e. Octets type)
    • (Changed): The parameter N_Burnt (the number of IDs of burnt keys in the structure) was initially declared as Unsigned_8. However, after changing the array to the correct Octets type, there was a bit of type-trouble: on one hand, the Octets type can have any length, so the type of its range can't be limited to Unsigned_8 and Unsigned_8 is NOT a subtype of Integer (it's a modular type instead); on the other hand, N_Burnt has to appear by itself in the definition of the record type since it is a discriminant so it couldn't be cast to an Integer subtype that Octets would accept. To address this, I defined the type Counter_8bit to match precisely the meaning of N_Burnt (or any other similar counter): values between 0 and 255.
    • (Changed): Since the N_Burns counter can be 0, it follows that the array of burnt ids should *not* always be present in the record (the only way to have an array of length 0 is effectively to not have it at all). Consequently, I further changed the Keys_Mgm record declaration to reflect this:
        ------------------------------
        -- Serpent Keys Management
        subtype Counter_8bits is Natural range 0..255;
        function Cast is new Ada.Unchecked_Conversion( Counter_8bits,
                                                       Raw_Types.Octets_1 );
        function Cast is new Ada.Unchecked_Conversion( Raw_Types.Octets_1,
                                                       Counter_8bits );
        type Keys_Mgm (N_Burnt: Counter_8bits := 0) is
          record
            -- count of server keys requested
            N_Server: Interfaces.Unsigned_8;
            -- count of client keys requested
            N_Client: Interfaces.Unsigned_8;
            -- ID of Serpent key preferred for further inbound Serpent msgs.
            Key_ID  : Interfaces.Unsigned_8;
            -- IDs of Serpent keys burnt by this message
            case N_Burnt is
              when 0 =>
                null;
              when others =>
                Burnt   : Raw_Types.Octets( 1..N_Burnt );
            end case;
          end record;
      
  • (Added): I've used the Keys_Mgm record from above and the same approach as for keys messages (common core serialization in private methods that are called by public read/write with correct IDs and Octets parameters) to implement the read/write from/to messages for keys management, whether Serpent or RSA messages.
  • (Added): New tests for the new read/write methods for key management messages.
  • (Changed): The existing tests for read/write of messages transporting keys are now updated to test also the read/write to/from RSA messages of the relevant type.

The .vpatch and my signature for it is on the Reference Code Shelf as well as linked here for your convenience:

November 13, 2018

V with VTools, Keccak Hashes and Its Own Tree

Filed under: Coding, TMSR — Diana Coman @ 10:49 p.m.

The republican versioning control system, V for Victory, is very much used, very much needed but nevertheless not yet versioned itself. As this has caused already way more talk in the logs than it's worth it, I promised I'll do a write-up of my own V setup and publish it, with a proper versioning for V itself included. So I've dug up old versions as well as my current setup and packaged everything in 2 different ways:

  1. A V-tree (using Keccak hashes) that captures the changes to v.pl code1 from the first version that I ever used, namely 999942. To use this, simply download the .vpatches, the .sig files and my signature, check them and then press the tree with either a different V that you might have or otherwise semi-manually with phf's vtools (vpatch more precisely). Note that you WILL need vtools (or equivalent) at any rate! Once you pressed V itself successfuly, you should have a v.pl that you can run - it will check its dependencies and complain if it doesn't find something (most notably the vtools parts namely vpatch and ksum).
  2. A signed .zip meant as a starter package for someone who hears of V for the first time in their life. Download starter_v.zip and starter_v.zip.diana_coman.sig. Check the signature! If and ONLY IF the check passes, unzip and then read the scripts in there. The build.sh script will simply build3 the vtools that are included in this starter pack and it will copy to the starter_v directory all the executables that are needed (v.pl renamed as vk.pl to make it clear it uses Keccak hashes, vdiff, vpatch and ksum). The included vtools are the code obtained from pressing current vtools tree up to and including the ksum .vpatch.

My changes to Mod6's v.pl simply replace older sha-based dependencies and calls with the vtools-based ones. Note that you'll need to have ksum and vpatch in your PATH or otherwise ready and accessible as v.pl will simply try to call them when it needs them.

For potential reference, here's my usual workflow to make a .vpatch:
mkdir a
mkdir b
cp -r old_stuff a/stuff
cp -r new_sutff b/stuff
vdiff a b > newpatch.vpatch
gpg --armor --output newpatch.vpatch.diana_coman.sig --detach-sig newpatch.vpatch

To check / press a V tree:
mkdir patches
mkdir .wot
mkdir .seals
cp some_patches patches/
cp corresponding_sig_files .seals
cp corresponding_trusted_pubkeys .wot
vk4 f
vk l
vk p v testdir chosen_patch.vpatch
cd testdir
read, compile, run etc

The .vpatches and .sig files:

The .zip file and corresponding .sig file:

For something to test your new shiny V on, head over to my Reference Code Shelf and take your pick. For trouble and questions, use the comments box below.


  1. Note that you are warmly invited to implement your own V! This version here is mod6's V implementation that was much discussed and iterated upon in the early days. 

  2. Note that V's versions DECREASE rather than increase, as per the explanation

  3. It requires GNAT. If you have no idea what that is, dig around, read the logs, ask humbly. 

  4. As I have all sorts of V implementations living side by side, I tend to give them different names - this is the vk for V-Keccak! 

« Newer PostsOlder Posts »

Theme and content by Diana Coman