File : adagio-g2-packet.ads
------------------------------------------------------------------------------
-- ADAGIO - ADALID - AENEA. --
-- --
-- Copyright (C) 2003 --
-- A. Mosteo. --
-- --
-- Authors: A. Mosteo. (adagio@mosteo.com) --
-- --
-- If you have any questions in regard to this software, please address --
-- them to the above email. --
-- --
-- This program is free software; you can redistribute it and/or modify --
-- it under the terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 2 of the License, or (at --
-- your option) any later version. --
-- --
-- This program is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public License --
-- along with this library; if not, write to the Free Software Foundation, --
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- You are not allowed to use any part of this code to develop a program --
-- whose output would be used to harass or prosecute other users of the --
-- networks Adagio connects with. All data collected with Adagio or a tool --
-- containing Adagio code about other network users must remain --
-- confidential and cannot be made public by any mean, nor be used to --
-- harass or legally prosecute these users. --
------------------------------------------------------------------------------
-- $Id: adagio-g2-packet.ads,v 1.9 2004/01/21 21:05:26 Jano Exp $
-- Types for G2 packets
-- Note that this G2 implementation violates the G2 draft in the sense that
-- each child takes its endianness from its control parent, not the topmost
-- packet.
-- This lead to erroneous results for packets with mixed endianness.
with Adagio.Safe_access;
with Agpl.Dynamic_vector;
with Ada.Calendar;
with Ada.Finalization; use Ada;
with Ada.Streams;
with Ada.Strings; use Ada.Strings;
with Ada.Strings.Bounded;
with System;
package Adagio.G2.Packet is
-- We'll allow a max of children for any packet:
MAX_CHILDREN : Constant := 1024;
-- Max packet size in bytes.
Max_packet_size : Natural := 12 * 1024;
-- Absolute max. Packets over this size will cause connection drop
Max_admisible_size : Natural := 128 * 1024;
Max_admisible_size_error : exception;
-- We'll use a bounded string for the packet type:
package BStrings is new Bounded.Generic_bounded_length (8);
function B (
S : in String;
Drop : in Truncation := Error) return BStrings.Bounded_string
renames BStrings.To_Bounded_String;
function S (B : in BStrings.Bounded_string) return String
renames BStrings.To_String;
Nul : BStrings.Bounded_string renames BStrings.Null_bounded_string;
-- Control byte of all G2 packets:
type Control_byte_type is record
Len_len : Natural range 0 .. 3;
Name_len : Natural range 0 .. 7;
Compound_flag : Boolean := false;
Big_endian : Boolean := false;
Reserved : Integer range 0 .. 1 := 0;
end record;
for Control_byte_type'Bit_order use System.Low_order_first;
for Control_byte_type use record
Len_len at 0 range 6 .. 7;
Name_len at 0 range 3 .. 5;
Compound_flag at 0 range 2 .. 2;
Big_endian at 0 range 1 .. 1;
Reserved at 0 range 0 .. 0;
end record;
for Control_byte_type'Size use 8;
-- Serialization of that control byte:
procedure Write (
Stream : access Streams.Root_stream_type'Class;
this : Control_byte_type);
for Control_byte_type'Write use Write;
-- Fully reads a packet from a stream. Allocates it.
procedure Read(
Stream : access Streams.Root_stream_type'Class;
this : out Control_byte_type);
for Control_byte_type'Read use Read;
-- A full G2 packet:
type Child;
type Child_access is access all Child;
-- for Child_access'Storage_pool use Debug_pool;
package Children_vector is new
Agpl.Dynamic_vector (Child_access, Initial_Size => MAX_CHILDREN);
type Child is new Finalization.Limited_Controlled with record
Control_byte : Control_byte_type;
Len : Natural range 0 .. 2 ** 24 - 1 := 0;
Type_name : BStrings.Bounded_string := Nul;
Payload : UString;
Children : Children_vector.Object (First => 1);
Arrival_time : Calendar.Time := Calendar.Clock;
end record;
Null_payload : Constant UString;
-- Delete a packet:
procedure Free (this : in out Child_access);
-- Debug only:
procedure Initialize (This : in out Child);
pragma Inline (Initialize);
-- Recursively frees any children
procedure Finalize (this : in out Child);
-- Adds a child to a packet:
-- May raise exception if too many childs
-- Doesn't check for duplicates.
-- Check null additions (no effect).
-- The child packet is set to NULL!
procedure Add_child (
Parent : in Child_access;
New_child : in out Child_access);
pragma Inline (Add_child);
-- Get a given child from an object
-- Name is in the form "xx/yy/zz"
-- Must be unique
function Get_child (
this : in Child_access;
Name : in String) return Child_access;
-- Full size of a packet, including:
-- control byte, len, name, children, payload.
-- Only valid for received packets, not created ones.
function Full_size (this : in Child_access) return Natural;
pragma Inline (Full_size);
-- Full size of children packets of a packet:
-- Only valid for received packets, not created ones.
function Children_size (this : in Child_access) return Natural;
pragma Inline (Children_size);
-- Is_a: says if a packet qualifies for some kind.
-- Should have initial / (i.e: /PI/UDP)
function Is_a (this : in Child_access; Kind : in String) return Boolean;
pragma Inline (Is_a);
-- Returns the expected length of child + payload
-- That's the length of CHILDREN + \0 SEPARATOR IF NEEDED + PAYLOAD
function Computed_length (this : in Child) return Natural;
-- Returns the expected full length (control + len_len + name_len + etc)
-- That's the FULL LENGTH OF THIS CHILD, HEADERS PLUS ITS CHILDREN
function Full_length (this : in Child) return Natural;
-- Return the number of bytes neccesaries to carry this number:
function Len_len (N : Natural) return Natural;
pragma Inline (Len_len);
-- Writing to stream.
procedure Write (
Stream : access Streams.Root_stream_type'Class; this : in Child);
for Child'Write use Write;
-- Deep copy: Clone a child and all its children
function Clone (this : in Child_access) return Child_access;
------------
-- OBJECT --
------------
-- We'll use safe accesses for this thing:
package Safe_child is new Safe_access (Child, Child_access);
subtype Object is Safe_child.Object;
type Object_array is array (integer range <>) of Object;
-- Create a packet with given name and payload:
-- Returns an allocated object
function Create (Name : in String; Payload : in String := "")
return Object;
-- Makes an object into child of another one.
-- May raise exception if too many childs
-- Doesn't check for duplicates.
-- Check null additions (no effect).
-- Check for /TO child, to put it the first.
-- The child packet is set to NULL!
procedure Add_child (
Parent : in Object;
New_child : in out Object);
pragma Inline (Add_child);
-- Returns a child as an object
-- Will raise Constraint_error if that child appears multiple times
-- Name is in the form "xx/yy/zz"
-- Null_packet returned if it doesn't exists.
function Get_child (this : in Object; Name : in String) return Object;
-- Get children of a given type. Inmediate depth only.
function Get_children (this : in Object; Name : in String)
return Object_array;
-- Root name of a packet:
function Name (this : in Object) return String;
pragma Inline (Name);
-- Root payload as a string:
function Payload (this : in Object) return String;
pragma Inline (Payload);
-- Arrival time:
function Arrival_time (this : in Object) return Calendar.Time;
pragma Inline (Arrival_time);
-- Big endian?
function Big_endian (this: in Object) return Boolean;
pragma Inline (Big_endian);
-- Returns the expected full length (control + len_len + name_len + etc)
function Full_length (this : in Object) return Natural;
-- Hex representation of a packet:
function To_hex (this : in Object; Interleaving : String := " ")
return String;
-- Enumeration of children in a packet:
function To_Text (This : in Object; Show_Payloads : Boolean := false) return String;
-- Is_a: says if a packet qualifies for some kind.
-- Should have initial / (i.e: /PI/UDP)
function Is_a (this : in Object; Kind : in String) return Boolean;
Null_Object : Constant Object;
Null_Packet : Constant Object; -- They are both the same thing.
-- Writing to stream.
procedure Write (
Stream : access Streams.Root_stream_type'Class; this : in Object);
pragma Inline (Write);
-- Atomic writing to a socket stream. It guarantees that the entire
-- packet is written (or not a byte) in a non-blocking socket stream.
procedure Atomic_Write (
Stream : access Streams.Root_stream_type'Class;
This : in Object;
Success : out Boolean);
-- Deep copy: Clone an object and all its children
function Clone (this : in Object) return Object;
private
Null_payload : Constant UString := U ("");
Null_Object : Constant Object := Safe_Child.Null_access;
Null_Packet : Constant Object := Safe_child.Null_access;
end Adagio.G2.Packet;